perm filename EPAR3B.2[EAL,HE]1 blob sn#674804 filedate 1982-09-27 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Editor: Aux parser routines }
C00006 00003	(* idGet & ePlistParse *)
C00015 00004	(* labelParse & eClabelParse *)
C00018 ENDMK
C⊗;
{$NOMAIN	Editor: Aux parser routines }

%include eparse.hdr;

{ Externally defined routines from elsewhere: }

	(* From ALLOC *)
function newNode: nodep;					external;
procedure relNode(n: nodep);					external;
function newIdent: identp;					external;
procedure relIdent(n: identp);					external;
procedure relStrng(n: strngp);					external;

	(* From EROOT:  Inter-overlay calls *)
function e3bExprParse: nodep;					external;

	(* From PAUX1 *)
function checkArg(n: nodep; d: datatypes): nodep;		external;

	(* From PAUX2 *)
procedure relExpr(n: nodep);					external;
procedure eGetDelim(char: ascii);				external;
function evalOrder(what,last: nodep; pcons: boolean): nodep;	external;

	(* From EAUX1A *)
function eEqStrng(s1: strngp; s2,len: integer): boolean;	external;

	(* From EPUT *)
function getExprLength(n: nodep): integer;			external;

	(* From EAUX2C *)
procedure deleteLines(start,number,coff: integer);		external;
procedure insertLines(start,number,coff: integer);		external;

	(* From EEXPED *)
function exprEditor(line,lstart,llength,estart: integer;
	var elength: integer; off: integer): ascii;		external;

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

	(* From ETOKEN *)
procedure eGetToken;						external;

	(* From PP *)
procedure relLine(l: linerecp);					external;
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 ppInt(i: integer); 					external;
procedure ppReal(r: real); 					external;
procedure ppStrng(length: integer; s: strngp); 			external;
procedure ppDtype(d: datatypes);				external;
procedure ppDelChar; 						external;


procedure ePar3bGet; external;
procedure ePar3bGet;  begin end;

(* idGet & ePlistParse *)

function idGet(st: statementp; indent,l: integer): ascii; external;
function idGet;
 var id1,id2: identp; b: boolean; i,elen: integer; strg,strp: strngp;
     sp: statementp; ch: ascii;
 begin
 with st↑ do
  begin
  if stype = coblocktype then
    begin i := indent + 8; id1 := cblkid end
   else
    begin
    if stype = endtype then i := indent + 4
     else i := indent + 6;
    id1 := blkid;
    end;
  if id1 = nil then elen := 0
   else
    begin
    i := i + 1;
    elen := id1↑.length;
    strg := id1↑.name;
    while strg <> nil do		(* release old string *)
     begin strp := strg↑.next; relStrng(strg); strg := strp end;
    end;
  if l > 0 then 				(* so addStmnt can use this *)
    with lines[l]↑ do				(* go edit it *)
     ch := exprEditor(l-firstDline+1,start,length,i,elen,0)
   else begin i := curChar + 1; elen := 1 end;
  if id1 <> nil then
    begin
    curChar := i - 1;
    maxChar := maxChar + 1;
    id1↑.name := nil;	(* assume no block id *)
    end;
  if elen > 0 then
    begin
    eGetToken;		(* get the new block id *)
    with eCurToken do
     begin					(* yup - grab the id string *)
     b := l > 0;
     if ttype = constype then 
       begin
       if cons↑.ltype = strngtype then
	 begin		(* yup - grab the id string *)
	 if id1 = nil then id1 := newIdent;
	 id1↑.length := cons↑.length;
	 id1↑.name := cons↑.str;
	 b := false;
	 end;
       relNode(cons);
       end
      else if l = 0 then eBackup := true;
     if b and (not endOfLine) and ((ttype <> delimtype) or (ch <> ';')) then
       begin
       pp20L(' Need a string here ',19); ppLine;
       end;
     end;
    end;
  if id1 <> nil then
    if id1↑.name = nil then begin relIdent(id1); id1 := nil end;
  if stype = coblocktype then
    begin
    cblkid := id1;
    id2 := threads↑.cstmnt↑.next↑.blkid;
    end
   else
    begin
    blkid := id1;
    if stype = blocktype then
      begin
      sp := bcode;
      while sp↑.next <> nil do sp := sp↑.next; (* move to END *)
      id2 := sp↑.blkid;
      end
     else id2 := bparent↑.blkid;
    end;
  if (id1 <> nil) and (id2 <> nil) then
    begin			(* now compare the two ids *)
    b := id1↑.length = id2↑.length;
    i := 3;
    while listing[i] <> '"' do i := i + 1;
    if b then b := eEqStrng(id2↑.name,i+1,id1↑.length);
    if not b then
      begin
      pp20L(' Block ids do not ma',20); pp5('tch  ',3); ppLine;
      end;
    end;
  end;
 idGet := ch;
 end;

function ePlistParse(st: statementp; e0,indent,l,ocur: integer): ascii; external;
function ePlistParse;
 var i,j,elen: integer; n,no,np: nodep; b: boolean; ch: ascii;
 begin
 if fieldNum > 1 then
   begin
   no := st↑.plist;
   for i := 1 to fieldNum-2 do no := no↑.next;
   n := no↑.next
   end
  else
   begin
   n := st↑.plist;
   if n = nil then e0 := e0 - 1;
   no := nil
   end;
 b := true;
 np := nil;
 i := e0;
 while b and (n <> nil) do
  begin
  j := i + getExprLength(n↑.lval);
  if j > 78 then b := false
   else
    begin
    np := n↑.next;
    if np = nil then i := j else i := j+1;	(* account for "," *)
    relExpr(n↑.lval);				(* flush the old expression *)
    relNode(n);					(* & the plist node too *)
    n := np;
    end
  end;
 elen := i - e0;
 with lines[l]↑ do
  ch := exprEditor(l-firstDline+1,start,length,e0,elen,0);
 repeat
  n := newNode;
  n↑.ntype := listnode;
  n↑.lval := e3bExprParse;		(* parse the modified exprs *)
  if n↑.lval <> nil then
    begin
    if no = nil then st↑.plist := n else no↑.next := n;
    no := n;
    end
   else relNode(n);
  b := false;
  eGetToken;			(* check for "," or ")" *)
  with eCurToken do		(* *** should be smarter *** *)
   begin
   b := (ttype <> delimtype) or (ch <> ',');
   if b and ((ttype = identtype) or
      ((ttype = reswdtype) and (rtype = optype))) then
     begin
     pp20L(' Inserting missing c',20); pp5('omma ',4); ppLine;
     eBackup := true;
     b := false;
     end;
   end;
 until endOfLine or b;
 if no = nil then st↑.plist := np else no↑.next := np;
 with st↑ do
  begin
  if plist = nil then exprs := nil else exprs := evalOrder(plist,nil,false);
  curLine := 1;
  setUp := true;
  setCursor := false;
  j := nlines;				(* how long were we *)
  putStmnt(st,indent,99);		(* possibly reformat us *)
  setUp := false;
  if j <> nlines then
    begin		(* if necessary correct for any change in nlines *)
    if j < nlines then insertLines(ocur,nlines-j,1)	(* fix up screen *)
     else if j > nlines then deleteLines(ocur,j-nlines,1);
    end;
  curLine := cursorStack[cursor].cline - 1;
  firstLine := curLine + 1;
  lastLine := firstLine + nlines - 1;
  end;
 if firstline < topDLine then firstLine := topDline;
 if botDline < lastLine then
   if botDline > topDline + firstDline + dispHeight - 2 then
     lastLine := botDline		(* it's definitely off screen *)
    else botDline := lastLine;		(* should be ok.... *)
 for i := firstLine - topDline + 1 to lastLine - topDline + 1 do
  begin		(* flush old lines before redrawing stmnt *)
  relLine(lines[i]);
  lines[i] := nil;
  end;
 ePlistParse := ch;
 end;

(* labelParse & eClabelParse *)

procedure labelParse; external;
procedure labelParse;
 var i: integer;
 begin
 eGetToken;			(* get new label *)
 with eCurToken, cursorStack[cursor] do
  if (ttype = delimtype) and (ch = chr(15B)) and endOfLine then
    begin				(* delete the old label *)
    st↑.stlab↑.s := nil;
    st↑.stlab := nil;
    deleteLines(cursorLine,1,0);
    end
   else if ttype = labeldeftype then
    begin
    st↑.stlab↑.s := nil;	(* old label no longer points here *)
    st↑.stlab := lab;
    lab↑.s := st;
    end
   else
    begin pp20L(' Expecting a label h',20); pp5('ere  ',3); ppLine end;
 end;

procedure eClabelParse(n: nodep); external;
procedure eClabelParse;
 var np: nodep;
 begin
 eGetToken;
 with n↑, eCurToken do
  if (ttype = delimtype) and (ch = '[') then
    begin
    np := checkArg(e3bExprParse,svaltype);	(* get constant value *)
    if np↑.ntype <> leafnode then
      begin
      pp20L(' Must have constant ',20); pp5('here ',4); ppLine;
      cval := -2;
      end
     else cval := round(np↑.s);
    relExpr(np);
    with cursorStack[cursor-1].st↑ do
     if cval > -range then range := -cval;
    eGetDelim(']');
    end
   else if (ttype = reswdtype) and (rtype = filtype) and
	   (filler = elsetype) then cval := -1
   else
    begin
(* *** maybe should recognize null line & delete the old label *** *)
    pp20L(' Need a case number ',20); pp5('here.',5); ppLine;
    cval := -2;			(* use a garbage one *)
    end
 end;