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;