mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-05 22:12:24 +00:00
Debug dump of parse tree
This commit is contained in:
Dave Brown
parent
b04514a198
commit
5cbbec255c
2 changed files with 323 additions and 7 deletions
315
src/compiler/OPP.Mod
Normal file → Executable file
315
src/compiler/OPP.Mod
Normal file → Executable file
|
|
@ -893,6 +893,317 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
|
|||
END
|
||||
END StatSeq;
|
||||
|
||||
(* Debug ---------------------------------------------------------- *)
|
||||
|
||||
PROCEDURE ls(s: ARRAY OF CHAR); BEGIN OPM.LogWStr(s) END ls;
|
||||
PROCEDURE lc(c: CHAR); BEGIN OPM.LogW(c) END lc;
|
||||
PROCEDURE li(i: SYSTEM.INT64); BEGIN OPM.LogWNum(i,1) END li;
|
||||
PROCEDURE ll; BEGIN OPM.LogWLn END ll;
|
||||
|
||||
PROCEDURE lAssert(truth: BOOLEAN; msg: ARRAY OF CHAR);
|
||||
BEGIN IF ~truth THEN ll; ls(msg); ll; HALT(99) END
|
||||
END lAssert;
|
||||
|
||||
PROCEDURE lLabel(indent: INTEGER; string: ARRAY OF CHAR);
|
||||
VAR i: INTEGER;
|
||||
BEGIN FOR i := 1 TO indent DO OPM.LogW(" ") END ;
|
||||
ls(string);
|
||||
END lLabel;
|
||||
|
||||
PROCEDURE lForm(form: SHORTINT);
|
||||
BEGIN
|
||||
CASE form OF
|
||||
| 0: ls("Undef")
|
||||
| 1: ls("Byte")
|
||||
| 2: ls("Bool")
|
||||
| 3: ls("Char")
|
||||
| 4: ls("int")
|
||||
| 5: ls("Real")
|
||||
| 6: ls("LReal")
|
||||
| 7: ls("Set")
|
||||
| 8: ls("String")
|
||||
| 9: ls("NilTyp")
|
||||
| 10: ls("NoTyp")
|
||||
| 11: ls("Pointer")
|
||||
| 12: ls("ProcTyp")
|
||||
| 13: ls("Comp")
|
||||
| ELSE li(form)
|
||||
END ;
|
||||
END lForm;
|
||||
|
||||
PROCEDURE lComp(comp: SHORTINT);
|
||||
BEGIN
|
||||
CASE comp OF
|
||||
| 1: ls("Basic")
|
||||
| 2: ls("Array")
|
||||
| 3: ls("DynArr")
|
||||
| 4: ls("Record")
|
||||
| ELSE li(comp)
|
||||
END ;
|
||||
END lComp;
|
||||
|
||||
PROCEDURE lMode(mode: SHORTINT);
|
||||
BEGIN
|
||||
CASE mode OF
|
||||
| 1: ls("Var")
|
||||
| 2: ls("VarPar")
|
||||
| 3: ls("Con")
|
||||
| 4: ls("Fld")
|
||||
| 5: ls("Typ")
|
||||
| 6: ls("LProc")
|
||||
| 7: ls("XProc")
|
||||
| 8: ls("SProc")
|
||||
| 9: ls("CProc")
|
||||
| 10: ls("IProc")
|
||||
| 11: ls("Mod")
|
||||
| 12: ls("Head")
|
||||
| 13: ls("TProc")
|
||||
| ELSE li(mode)
|
||||
END ;
|
||||
END lMode;
|
||||
|
||||
PROCEDURE ^lStruct(indent: INTEGER; struct: OPT.Struct; skipobj: OPT.Object);
|
||||
|
||||
PROCEDURE IsNamedObject(obj, tree: OPT.Object): BOOLEAN;
|
||||
VAR result: BOOLEAN;
|
||||
BEGIN
|
||||
IF tree = NIL THEN result := FALSE
|
||||
ELSIF tree = obj THEN result := TRUE
|
||||
ELSIF IsNamedObject(obj, tree.left) THEN result := TRUE
|
||||
ELSE
|
||||
result := IsNamedObject(obj, tree.right)
|
||||
END;
|
||||
RETURN result & (obj.name[0] # 0X)
|
||||
END IsNamedObject;
|
||||
|
||||
PROCEDURE lObject(indent: INTEGER; obj, skipobj: OPT.Object);
|
||||
VAR global: OPT.Object;
|
||||
BEGIN
|
||||
IF (IsNamedObject(obj, OPT.universe) OR IsNamedObject(obj, OPT.syslink)) THEN
|
||||
ls(obj.name); ll
|
||||
ELSIF obj = NIL THEN ls("NIL"); ll
|
||||
ELSIF obj = skipobj THEN ls("skipping: points back to parent."); ll
|
||||
ELSE
|
||||
lMode(obj.mode); ls(", '"); ls(obj.name);
|
||||
IF (obj.typ # NIL) & (obj.typ # OPT.undftyp) & (obj.typ # OPT.notyp) THEN
|
||||
ls("', typ: "); lStruct(indent+2, obj.typ, obj)
|
||||
ELSE lc("'"); ll
|
||||
END;
|
||||
END
|
||||
END lObject;
|
||||
|
||||
PROCEDURE lStruct(indent: INTEGER; struct: OPT.Struct; skipobj: OPT.Object);
|
||||
BEGIN
|
||||
IF struct = NIL THEN ls("NIL"); ll
|
||||
ELSIF struct = OPT.undftyp THEN ls("<undftyp>"); ll
|
||||
ELSIF struct = OPT.notyp THEN ls("<notyp>"); ll
|
||||
ELSIF struct = OPT.stringtyp THEN ls("<stringtyp>"); ll
|
||||
ELSIF struct = OPT.niltyp THEN ls("<niltyp>"); ll
|
||||
ELSIF struct = OPT.bytetyp THEN ls("<BYTE>"); ll
|
||||
ELSIF struct = OPT.sysptrtyp THEN ls("<PTR>"); ll
|
||||
ELSIF struct = OPT.adrtyp THEN ls("<ADDRESS>"); ll
|
||||
ELSIF struct = OPT.int8typ THEN ls("<INT8>"); ll
|
||||
ELSIF struct = OPT.int16typ THEN ls("<INT16>"); ll
|
||||
ELSIF struct = OPT.int32typ THEN ls("<INT32>"); ll
|
||||
ELSIF struct = OPT.int64typ THEN ls("<INT64>"); ll
|
||||
ELSIF struct = OPT.set32typ THEN ls("<SET32>"); ll
|
||||
ELSIF struct = OPT.set64typ THEN ls("<SET64>"); ll
|
||||
ELSIF struct = OPT.booltyp THEN ls("<BOOLEAN>"); ll
|
||||
ELSIF struct = OPT.chartyp THEN ls("<CHAR>"); ll
|
||||
ELSIF struct = OPT.realtyp THEN ls("<REAL>"); ll
|
||||
ELSIF struct = OPT.lrltyp THEN ls("<LONGREAL>"); ll
|
||||
ELSIF struct = OPT.hinttyp THEN ls("<HUGEINT>"); ll
|
||||
ELSIF struct = OPT.cpbytetyp THEN ls("<BYTE@>"); ll
|
||||
ELSE
|
||||
ls("form "); lForm(struct.form);
|
||||
ls(", comp "); lComp(struct.comp);
|
||||
ls(", size "); li(struct.size);
|
||||
ls(", sysflag "); li(struct.sysflag);
|
||||
IF (struct.strobj = NIL) OR (struct.strobj = skipobj) THEN ll ELSE
|
||||
ls(", strobj "); lObject(indent+2, struct.strobj, skipobj);
|
||||
END;
|
||||
INC(indent, 2);
|
||||
IF (struct.link # NIL) & (struct.link # skipobj) THEN
|
||||
lLabel(indent, "struct.link: "); lObject(indent+2, struct.link, skipobj);
|
||||
END;
|
||||
IF (struct.BaseTyp # NIL) & (struct.BaseTyp.form # OPT.Undef) & (indent < 40) THEN
|
||||
lLabel(indent, "struct.BaseTyp: "); lStruct(indent+2, struct.BaseTyp, skipobj)
|
||||
END
|
||||
END
|
||||
END lStruct;
|
||||
|
||||
PROCEDURE lClass(class: SHORTINT);
|
||||
BEGIN
|
||||
CASE class OF
|
||||
| OPT.Nvar: ls("Nvar")
|
||||
| OPT.Nvarpar: ls("Nvarpar")
|
||||
| OPT.Nfield: ls("Nfield")
|
||||
| OPT.Nderef: ls("Nderef")
|
||||
| OPT.Nindex: ls("Nindex")
|
||||
| OPT.Nguard: ls("Nguard")
|
||||
| OPT.Neguard: ls("Neguard")
|
||||
| OPT.Nconst: ls("Nconst")
|
||||
| OPT.Ntype: ls("Ntype")
|
||||
| OPT.Nproc: ls("Nproc")
|
||||
| OPT.Nupto: ls("Nupto")
|
||||
| OPT.Nmop: ls("Nmop")
|
||||
| OPT.Ndop: ls("Ndop")
|
||||
| OPT.Ncall: ls("Ncall")
|
||||
| OPT.Ninittd: ls("Ninittd")
|
||||
| OPT.Nif: ls("Nif")
|
||||
| OPT.Ncaselse: ls("Ncaselse")
|
||||
| OPT.Ncasedo: ls("Ncasedo")
|
||||
| OPT.Nenter: ls("Nenter")
|
||||
| OPT.Nassign: ls("Nassign")
|
||||
| OPT.Nifelse: ls("Nifelse")
|
||||
| OPT.Ncase: ls("Ncase")
|
||||
| OPT.Nwhile: ls("Nwhile")
|
||||
| OPT.Nrepeat: ls("Nrepeat")
|
||||
| OPT.Nloop: ls("Nloop")
|
||||
| OPT.Nexit: ls("Nexit")
|
||||
| OPT.Nreturn: ls("Nreturn")
|
||||
| OPT.Nwith: ls("Nwith")
|
||||
| OPT.Ntrap: ls("Ntrap")
|
||||
| ELSE li(class)
|
||||
END ;
|
||||
END lClass;
|
||||
|
||||
PROCEDURE lSubclass(subclass: SHORTINT);
|
||||
BEGIN
|
||||
CASE subclass OF
|
||||
| OPT.assign: ls("assign")
|
||||
| OPT.super: ls("super")
|
||||
| OPT.eql: ls("sym-eql")
|
||||
| OPT.neq: ls("sym-neq")
|
||||
| OPT.lss: ls("sym-lss")
|
||||
| OPT.leq: ls("sym-leq")
|
||||
| OPT.gtr: ls("sym-gtr")
|
||||
| OPT.geq: ls("sym-geq")
|
||||
| OPT.ash: ls("fn-ash")
|
||||
| OPT.msk: ls("fn-msk")
|
||||
| OPT.len: ls("fn-len")
|
||||
| OPT.conv: ls("fn-conv")
|
||||
| OPT.abs: ls("fn-abs")
|
||||
| OPT.cap: ls("fn-cap")
|
||||
| OPT.odd: ls("fn-odd")
|
||||
| OPT.adr: ls("sys-adr")
|
||||
| OPT.cc: ls("sys-cc")
|
||||
| OPT.bit: ls("sys-bit")
|
||||
| OPT.lsh: ls("sys-lsh")
|
||||
| OPT.rot: ls("sys-rot")
|
||||
| OPT.val: ls("sys-val")
|
||||
| ELSE li(subclass)
|
||||
END ;
|
||||
END lSubclass;
|
||||
|
||||
PROCEDURE lBoolean(b: BOOLEAN);
|
||||
BEGIN IF b THEN ls("true") ELSE ls("false") END END lBoolean;
|
||||
|
||||
PROCEDURE lSet(s: SYSTEM.SET64);
|
||||
VAR i: INTEGER;
|
||||
BEGIN
|
||||
lc("{");
|
||||
FOR i := 0 TO 63 DO
|
||||
IF i IN s THEN li(i); EXCL(s, i) END
|
||||
END;
|
||||
IF s # {} THEN lc(",") END;
|
||||
lc("}");
|
||||
END lSet;
|
||||
|
||||
PROCEDURE lConstValue(indent: INTEGER; c: OPT.Const);
|
||||
BEGIN
|
||||
IF c = NIL THEN ls("NIL") ELSE
|
||||
ls("(");
|
||||
IF c.ext #NIL THEN ls("'"); ls(c.ext^); ls("', ") END;
|
||||
li(c.intval); ls(",");
|
||||
li(c.intval2); ls(",");;
|
||||
lSet(c.setval); ls(")");;
|
||||
(*lLabel(indent, "realval: ); lReal(c.realVal); ll; *)
|
||||
END;
|
||||
END lConstValue;
|
||||
|
||||
PROCEDURE lNodeDetail(indent: INTEGER; node: OPT.Node);
|
||||
BEGIN
|
||||
IF node = NIL THEN ls("NIL"); ll ELSE
|
||||
lClass(node.class);
|
||||
IF node.subcl # 0 THEN lc(" "); lSubclass(node.subcl) END;
|
||||
IF node.readonly THEN ls(", r/o") ELSE ls(", r/w") END;
|
||||
IF node.conval # NIL THEN ls(", "); lConstValue(indent, node.conval) END;
|
||||
IF node.obj # NIL THEN ls(", obj: "); lObject(indent, node.obj, NIL)
|
||||
ELSE ll END;
|
||||
INC(indent,2);
|
||||
IF (node.typ # NIL) & (node.typ # OPT.notyp) THEN lLabel(indent, "node.typ: "); lStruct(indent, node.typ, NIL) END;
|
||||
IF node.link # NIL THEN lLabel(indent, "node.link: "); lNodeDetail(indent, node.link) END;
|
||||
END;
|
||||
END lNodeDetail;
|
||||
|
||||
PROCEDURE lNodeTree(indent: INTEGER; node: OPT.Node);
|
||||
BEGIN
|
||||
lNodeDetail(indent, node);
|
||||
IF node.left # NIL THEN lLabel(indent, "Left:"); ll; lLabel(indent+2, ""); lNodeTree(indent+2, node.left) END;
|
||||
IF node.right # NIL THEN lLabel(indent, "Right:"); ll; lLabel(indent+2, ""); lNodeTree(indent+2, node.right) END;
|
||||
END lNodeTree;
|
||||
|
||||
PROCEDURE lProcHeader(indent: INTEGER; VAR obj: OPT.Object);
|
||||
VAR parms: OPT.Object;
|
||||
BEGIN
|
||||
lAssert((obj # NIL) & (obj.mode = OPT.LProc), "lProcHeader expected obj.mode = LProc");
|
||||
lLabel(indent, "PROCEDURE "); ls(obj.name);
|
||||
parms := obj.link;
|
||||
IF (obj.typ # OPT.notyp) OR ((parms # NIL) & (parms.mode # OPT.LProc)) THEN
|
||||
ls("(");
|
||||
WHILE (parms # NIL) & (parms.mode # OPT.LProc) DO
|
||||
lMode(parms.mode); ls(" "); ls(parms.name); ls(": ");
|
||||
IF parms.typ = NIL THEN ls("*NIL*") ELSE lForm(parms.typ.form) END;
|
||||
parms := parms.link;
|
||||
IF (parms # NIL) & (parms.mode # OPT.LProc) THEN ls("; ") END;
|
||||
END;
|
||||
ls(")");
|
||||
IF obj.typ # OPT.notyp THEN ls(": "); lStruct(indent+2, obj.typ, obj) ELSE ll END;
|
||||
END;
|
||||
obj := parms
|
||||
END lProcHeader;
|
||||
|
||||
PROCEDURE lBlock(indent: INTEGER; nenter: OPT.Node);
|
||||
VAR obj: OPT.Object; defs: OPT.Node;
|
||||
BEGIN obj := nenter.obj;
|
||||
IF obj = NIL THEN lLabel(indent, "MODULE"); ll;
|
||||
ELSE WHILE obj # NIL DO lProcHeader(indent, obj) END;
|
||||
END;
|
||||
defs := nenter.left;
|
||||
WHILE defs # NIL DO
|
||||
IF (defs.obj # NIL) & (defs.obj.mode = OPT.LProc) THEN
|
||||
lBlock(indent+2, defs)
|
||||
ELSE
|
||||
ls("*UNEXPECTED* "); lNodeDetail(indent, defs)
|
||||
END;
|
||||
defs := defs.link;
|
||||
END;
|
||||
END lBlock;
|
||||
|
||||
(* ---------------------------------------------------------------- *)
|
||||
|
||||
PROCEDURE lObjectTree(obj: OPT.Object);
|
||||
BEGIN
|
||||
IF obj.left # NIL THEN lObjectTree(obj.left) END;
|
||||
lObject(2, obj, NIL);
|
||||
IF obj.right # NIL THEN lObjectTree(obj.right) END;
|
||||
END lObjectTree;
|
||||
|
||||
PROCEDURE OptimizeUnmodifiableStructuredValueParameters(procdec, statseq: OPT.Node);
|
||||
(* Scan and report content of procdec and statseq with a view to detecting
|
||||
writes to value array/record parameters *)
|
||||
(* TODO This should run just once after the OPP.Block call in OPP.Module *)
|
||||
VAR obj: OPT.Object;
|
||||
BEGIN
|
||||
IF OPM.verbose IN OPM.Options THEN
|
||||
ll; ls("procdec: "); ll; lNodeTree(0, procdec);
|
||||
ll; ls("procdec as block:"); ll; lBlock(0, procdec);
|
||||
ll;
|
||||
END;
|
||||
END OptimizeUnmodifiableStructuredValueParameters;
|
||||
|
||||
|
||||
PROCEDURE Block(VAR procdec, statseq: OPT.Node);
|
||||
VAR typ: OPT.Struct;
|
||||
obj, first, last: OPT.Object;
|
||||
|
|
@ -1027,7 +1338,9 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
|
|||
CheckSym(OPS.semicolon)
|
||||
END ;
|
||||
IF OPM.noerr THEN TDinit := NIL; lastTDinit := NIL; c := OPM.errpos;
|
||||
Block(procdec, statseq); OPB.Enter(procdec, statseq, NIL); prog := procdec;
|
||||
Block(procdec, statseq); OPB.Enter(procdec, statseq, NIL);
|
||||
OptimizeUnmodifiableStructuredValueParameters(procdec, statseq);
|
||||
prog := procdec;
|
||||
prog^.conval := OPT.NewConst(); prog^.conval^.intval := c;
|
||||
IF sym = OPS.ident THEN
|
||||
IF OPS.name # OPT.SelfName THEN err(4) END ;
|
||||
|
|
|
|||
15
src/compiler/OPT.Mod
Normal file → Executable file
15
src/compiler/OPT.Mod
Normal file → Executable file
|
|
@ -118,11 +118,14 @@ TYPE
|
|||
|
||||
CONST
|
||||
(* Node.class values *)
|
||||
Nvar* = 0; Nvarpar* = 1; Nfield* = 2; Nderef* = 3; Nindex* = 4; Nguard* = 5; Neguard* = 6;
|
||||
Nconst* = 7; Ntype* = 8; Nproc* = 9; Nupto* = 10; Nmop* = 11; Ndop* = 12; Ncall* = 13;
|
||||
Ninittd* = 14; Nif* = 15; Ncaselse* = 16; Ncasedo* = 17; Nenter* = 18; Nassign* = 19;
|
||||
Nifelse* = 20; Ncase* = 21; Nwhile* = 22; Nrepeat* = 23; Nloop* = 24; Nexit* = 25;
|
||||
Nreturn* = 26; Nwith* = 27; Ntrap* = 28;
|
||||
Nvar* = 0; Nvarpar* = 1; Nfield* = 2; Nderef* = 3;
|
||||
Nindex* = 4; Nguard* = 5; Neguard* = 6; Nconst* = 7;
|
||||
Ntype* = 8; Nproc* = 9; Nupto* = 10; Nmop* = 11;
|
||||
Ndop* = 12; Ncall* = 13; Ninittd* = 14; Nif* = 15;
|
||||
Ncaselse* = 16; Ncasedo* = 17; Nenter* = 18; Nassign* = 19;
|
||||
Nifelse* = 20; Ncase* = 21; Nwhile* = 22; Nrepeat* = 23;
|
||||
Nloop* = 24; Nexit* = 25; Nreturn* = 26; Nwith* = 27;
|
||||
Ntrap* = 28;
|
||||
|
||||
|
||||
(* Node.subcl values - general *)
|
||||
|
|
@ -197,7 +200,7 @@ TYPE
|
|||
END;
|
||||
|
||||
VAR
|
||||
universe, syslink: Object;
|
||||
universe*, syslink*: Object;
|
||||
impCtxt: ImpCtxt;
|
||||
expCtxt: ExpCtxt;
|
||||
nofhdfld: LONGINT;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue