perm filename EADDST.2[EAL,HE] blob sn#712019 filedate 1983-05-25 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Editor: Routine to add a statement }
C00007 00003	(* addStmnt: main body *)
C00012 ENDMK
CāŠ—;
{$NOMAIN	Editor: Routine to add a statement }

%include eedit.hdr;

{ Externally defined routines from elsewhere: }

	(* From EAUX1A *)
procedure borderLines;						external;

	(* From EAUX1C *)
procedure errPrnt;						external;

	(* From ETOKEN *)
procedure getToken;						external;

	(* From EPUTST *)
procedure putstmnt(s: statementp; indent, plevel: integer);	external;

	(* From EAUX3C - addStmnt aux routines *)
procedure addNSt(sty: stmntypes; nextLine: cursorpp;
	var sp: statementp; slabel: varidefp;
	emptyp,stok: boolean; var nogood,flushp: boolean);	external;

	(* From the EADDn modules - aux routines for addStmnt *)

	(* From EADD1 *)
procedure addst1(sp: statementp);				external;

	(* From EADD2 *)
procedure addst2 (nextLinep: cursorpp; sp: statementp);		external;

	(* From EADD3 *)
procedure addSetup(nextLinep: cursorpp; 
	var emptyp,stok,clok: boolean; 	var l,elen: integer; 
	firstTime: boolean; var echar: ascii; 
	var viaCl: nodep);					external;

	(* From EADD4 *)
procedure add1Aux (var l,lcur: integer; nextLinep: cursorpp; 
	var sp: statementp; var slabel: varidefp; 
	var emptyp,stok,clok,nogood,labp: boolean);		external;

	(* From EADD5 *)
procedure addEndStmnt (nextLinep: cursorpp; 
	var nogood,emptyp,flushp: boolean; 
	var l,ocur: integer);					external;
procedure add2Aux (nextLinep: cursorpp; 
	var l,ocur,lcur: integer; var nogood,flushp: boolean; 
	slabel: varidefp; labp: boolean);			external;
procedure add4Aux (sp: statementp; var lcur,ocur: integer; 
	slabel: varidefp; nextLinep: cursorpp; 
	nogood,stOk,clOk: boolean; 
	var emptyp,firstTime,flushp: boolean);			external;

	(* From EADD6 *)
procedure add1Filler(nextLinep: cursorpp; var l,lcur: integer;
	var emptyp,stok,clok,nogood,flushp: boolean; 
	var sp: statementp; slabel: varidefp; 
	var viaCl: nodep);					external;

	(* From EADD7 *)
procedure add3Aux (nextLinep: cursorpp; var sp: statementp; 
	slabel: varidefp; 
	var emptyp,stok,nogood,labp,flushp: boolean; 
	var lcur: integer);					external;

	(* From EADD8 *)
procedure addCmon(defer: boolean; nextLinep: cursorpp; 
	var sp: statementp; slabel: varidefp; 
	emptyp,clok,stok: boolean; var nogood,flushp: boolean);	external;

	(* From PP *)
procedure pp20(ch: c20str; length: integer); 			external;
procedure pp20L(ch: c20str; length: integer); 			external;

(* addStmnt: main body *)

procedure addStmnt(firstTime: boolean); external;
procedure addStmnt;
 var l,elen,ocur,lcur: integer; nextLine: cursorp;
     viaCl: nodep; sp: statementp; echar: ascii; slabel: varidefp;
     emptyp,stOk,clOk,nogood,again,labp,flushp: boolean;

 begin
 setExpr := true;
 repeat
  echar := chr(15B);
  repeat
   if not sParse then newDeclarations := nil;
   sp := nil;
   nogood := false;
   flushp := false;
   labp := false;
   ocur := cursorLine;
   lcur := ocur;
   addSetup(ref(nextLine),emptyp,stok,clok,l,elen,firstTime,echar,viaCl);
   slabel := nil;

   with curToken do
    begin
    add1Aux (l,lcur,ref(nextLine),sp,slabel,emptyp,stok,clok,nogood,labp);
    if (ttype = reswdtype) and (rtype = stmnttype) then
      begin
      if stmnt = cmtype then	(* Condition monitors are special *)
	addCmon(false,ref(nextLine),sp,slabel,emptyp,clok,stok,nogood,flushp)
       else if (stmnt = endtype) or (stmnt = coendtype) then
 	addEndStmnt (ref(nextLine),nogood,emptyp,flushp,l,ocur) (* END/COEND addition *)
       else if (stmnt = definetype) or (stmnt = requiretype) then
	begin
	pp20L('Can''t handle DEFINE ',20); pp20('or REQUIRE yet...   ',17);
	errprnt;
	flushp := true;
	nogood := true;
	end
       else	(* A regular kind of statement - add it *)
	begin
	addNSt(stmnt,ref(nextLine),sp,slabel,emptyp,stok,nogood,flushp);
	if stOk then
	  if stmnt <= returntype then addst1(sp)
	   else addst2(ref(nextLine),sp);
	end
      end
     else if (ttype = reswdtype) and (rtype = filtype) then
      begin
      if filler in [untltype,dotype,totype,viatype,withtype,thentype,wheretype] then
	add1Filler(ref(nextLine),l,lcur,emptyp,stok,clok,nogood,flushp,sp,slabel,viaCl)
       else if filler = defertype then
	begin
	getToken;
	if (ttype = reswdtype) and (rtype = stmnttype) and (stmnt = cmtype) 
	  then addCmon(true,ref(nextLine),sp,slabel,emptyp,clok,stok,nogood,flushp)
	  else add2Aux(ref(nextLine),l,ocur,lcur,nogood,flushp,slabel,labp);
	end
      end
     else add3Aux(ref(nextLine),sp,slabel,emptyp,stok,nogood,labp,flushp,lcur);

    add4Aux(sp,lcur,ocur,slabel,ref(nextLine),nogood,stOk,clOk,
	    emptyp,firstTime,flushp);
    end

  until endOfLine;
  flushcomments := true;		(* don't allow comments anywhere else *)

  if ((echar = 'U') or (echar = 'P')) and (not nogood) then
    cursorLine := cursorLine - 2;			(* U or P *)
  again := (echar = 'N') or (echar = 'P');		(* keep going if N or P *)
  if not sParse then
    begin
    firstTime := true;
    firstLine := 0;
    lastLine := -1;
    setCursor := true;
    curLine := 0;
    putStmnt(dProg,0,99);
    setCursor := false;
    end;
 until not again;

 borderLines;
 setExpr := false;
 end;