external;

{
	Stanfuncs.p (of PCQ Pascal)
	Copyright (c) 1989 Patrick Quaid

	This module handles all the standard functions.
}

const
{$I "pasconst.i"}

type

{$I "pastype.i"}

var

{$I "pasvar.i"}

	function loadaddress(): integer;
	    forward;
	function match(s : integer): boolean;
	    forward;
	function typecheck(t1, t2 : integer): boolean;
	    forward;
	procedure error(s : string);
	    forward;
	function expression() : integer;
	    forward;
	function numbertype(i : integer): boolean;
	    forward;
	procedure needleftparent;
	    forward;
	procedure needrightparent;
	    forward;
	procedure neednumber;
	    forward;
	function getlabel(): integer;
	    forward;
	procedure printlabel(l : integer);
	    forward;
	function suffix(s : integer) : char;
	    forward;

procedure doopen(nametype, accessmode : integer);

{
	This routine handles both open and reopen, depending on the
accessmode sent to it.  This is just passed on to the DOS routine.
}

var
    filetype	: integer;
    bufsize	: integer;
begin
    if typecheck(nametype, stringtype) then begin
	writeln(output, "\tmove.l\td0,-(sp)");
	if match(comma1) then begin
	    filetype := loadaddress();
	    if idents[filetype].offset = vfile then begin
		writeln(output, "\tmove.l\t(sp)+,d0");
		writeln(output, "\tmove.l\t#", accessmode, ',d2');
		bufsize := idents[filetype].vtype;
		bufsize := idents[bufsize].size;
		writeln(output, "\tmove.l\t#", bufsize, ',8(a0)');
		writeln(output, "\tjsr\t_p%open");
	    end else
		error("Need a file variable");
	end else
	    error("Expecting a comma");
    end else
	error("Expecting a string (the file name).");
end;

procedure stdfunc(varindex : integer);

{
	This routine handles all the standard functions.  All but
open and reopen are handled in-line.
}

var
    exprtype	: integer;
    lab		: integer;
begin
    needleftparent;
    if idents[varindex].offset < 10 then
	exprtype := expression();
    if idents[varindex].offset = 1 then begin { ord }
	if idents[exprtype].offset = vordinal then begin
	    if idents[exprtype].size = 1 then
		idents[varindex].vtype := bytetype
	    else if idents[exprtype].size = 2 then
		idents[varindex].vtype := shorttype
	    else
		idents[varindex].vtype := inttype;
	end else
	    error("Must be a simple type");
    end else if idents[varindex].offset = 2 then begin { chr }
	if not numbertype(exprtype) then
	    neednumber;
    end else if idents[varindex].offset = 3 then begin { odd }
	if not numbertype(exprtype) then
	    neednumber;
	writeln(output, "\tand.", suffix(idents[exprtype].size), "\t#1,d0");
	writeln(output, "\tsne\td0");
    end else if idents[varindex].offset = 4 then begin { abs }
	if not numbertype(exprtype) then
	    neednumber;
	lab := getlabel();
	writeln(output, "\ttst.", suffix(idents[exprtype].size), "\td0");
	write(output, "\tbpl.s\t");
	printlabel(lab);
	writeln(output);
	writeln(output, "\tneg.", suffix(idents[exprtype].size), "\td0");
	printlabel(lab);
	writeln(output);
    end else if idents[varindex].offset = 5 then begin { succ }
	if idents[exprtype].offset <> vordinal then
	    error("expecting an ordinal type");
	writeln(output, "\taddq.", suffix(idents[exprtype].size), "\t#1,d0");
	idents[varindex].vtype := exprtype;
    end else if idents[varindex].offset = 6 then begin { pred }
	if idents[exprtype].offset <> vordinal then
	    error("expecting an ordinal type");
	writeln(output, "\tsubq.", suffix(idents[exprtype].size), "\t#1,d0");
	idents[varindex].vtype := exprtype;
    end else if idents[varindex].offset = 7 then begin { reopen }
	doopen(exprtype, 1005)
    end else if idents[varindex].offset = 8 then begin { open }
	doopen(exprtype, 1006)
    end else if idents[varindex].offset = 9 then begin { eof }
	if idents[exprtype].offset = vfile then begin
	    writeln(output, "\tmove.l\td0,a0");
	    writeln(output, "\tmove.b\t12(a0),d0");
	end else
	    error("Expecting a file type");
    end else if idents[varindex].offset = 10 then begin { adr }
	exprtype := loadaddress();
	writeln(output, "\tmove.l\ta0,d0");
    end;
    needrightparent;
end;