perm filename EADD1.2[EAL,HE]1 blob
sn#676504 filedate 1982-09-27 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {$NOMAIN Editor: Aux routines for addStmnt }
C00004 00003 procedure addst1(sp: statementp) external
C00008 ENDMK
C⊗;
{$NOMAIN Editor: Aux routines for addStmnt }
%include eedit.hdr;
{ Externally defined routines from elsewhere: }
(* From ALLOC *)
function newNode: nodep; external;
(* From PAUX1 *)
procedure appendEnd(s,so: statementp); external;
function checkArg(n: nodep; d: datatypes): nodep; external;
(* From PAUX2 *)
function evalOrder(what,last: nodep; pcons: boolean): nodep; external;
(* From ETOKEN *)
procedure eGetToken; external;
(* From EEXPAR *)
function eExprParse: nodep; external;
(* From EPAR3A *)
procedure eForParse(st: statementp); external;
(* From EPAR3F *)
procedure eReturnParse(st: statementp); external;
(* From EAUX3C - addStmnt aux routines *)
function getEmptyStmnt(sp:statementp): statementp; external;
function getBlkId: identp; external;
(* From PP *)
procedure ppLine; external;
procedure ppOutNow; external;
procedure ppChar(ch: ascii); external;
procedure pp5(ch: c5str; length: integer); external;
procedure pp10(ch: cstring; length: integer); external;
procedure pp10L(ch: cstring; length: integer); external;
procedure pp20(ch: c20str; length: integer); external;
procedure pp20L(ch: c20str; length: integer); external;
procedure addst1(sp: statementp); external;
procedure addst1;
var i: integer; n: nodep;
begin
with eCurToken, sp↑ do
case stmnt of
blocktype: begin
nlines := nlines + 1;
bparent := next; (* save next pointer *)
appendEnd(sp,sp);
bcode := next;
next := bparent;
bparent := curBlock;
level := curBlock↑.level + 1;
numvars := 0;
variables := nil;
blkid := getBlkId;
curBlock := sp;
end;
coblocktype: begin
nlines := nlines + 2;
cblkid := getBlkId;
nthreads := 1;
threads := newNode;
with threads↑ do
begin
ntype := colistnode;
prev := nil;
next := nil;
cstmnt := getEmptyStmnt(sp);
cstmnt↑.next↑.stype := coendtype;
end;
end;
iftype: begin
icond := checkArg(eExprParse,svaltype);
exprs := evalOrder(icond,nil,true);
els := nil;
thn := getEmptyStmnt(sp);
nlines := nlines + 1;
eGetToken;
if not endOfLine then
if (ttype <> reswdtype) or (rtype <> filtype) or
(filler <> thentype) then
begin
pp20L(' Need a "THEN" here ',19); ppLine;
eBackup := true
end;
end;
fortype,
whiletype: begin
nlines := nlines + 1;
if stype = fortype then
begin
fbody := getEmptyStmnt(sp);
eForParse(sp);
end
else
begin
body := getEmptyStmnt(sp);
cond := checkArg(eExprParse,svaltype);
exprs := evalOrder(cond,nil,true);
end;
eGetToken;
if not endOfLine then
if (ttype <> reswdtype) or (rtype <> filtype) or
(filler <> dotype) then
begin
pp20L(' Need a "DO" here ',17); ppLine;
eBackup := true
end;
end;
casetype: begin (* caseParse(sp); *) end;
returntype: begin
i := cursor;
n := nil;
repeat (* find def of procedure we're in, if any *)
with cursorStack[i] do
if stmntp then
if (st↑.stype = coblocktype) or (st↑.stype = cmtype) then
i := 0
else i := i - 1
else if nd↑.ntype = procdefnode then n := nd else i := i - 1;
until (i <= 2) or (n <> nil);
sp↑.rproc := n;
sp↑.retval := nil;
eReturnParse(sp);
end;
otherwise {do nothing};
end;
end;