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;