From 5cbbec255c9fbbd127a7c6ed07fedec3b6de8d01 Mon Sep 17 00:00:00 2001 From: Dave Brown Date: Wed, 20 Nov 2019 17:45:16 +0000 Subject: [PATCH] Debug dump of parse tree --- src/compiler/OPP.Mod | 315 ++++++++++++++++++++++++++++++++++++++++++- src/compiler/OPT.Mod | 15 ++- 2 files changed, 323 insertions(+), 7 deletions(-) mode change 100644 => 100755 src/compiler/OPP.Mod mode change 100644 => 100755 src/compiler/OPT.Mod diff --git a/src/compiler/OPP.Mod b/src/compiler/OPP.Mod old mode 100644 new mode 100755 index 2b9fb0b1..c723b9f5 --- a/src/compiler/OPP.Mod +++ b/src/compiler/OPP.Mod @@ -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(""); ll + ELSIF struct = OPT.notyp THEN ls(""); ll + ELSIF struct = OPT.stringtyp THEN ls(""); ll + ELSIF struct = OPT.niltyp THEN ls(""); ll + ELSIF struct = OPT.bytetyp THEN ls(""); ll + ELSIF struct = OPT.sysptrtyp THEN ls(""); ll + ELSIF struct = OPT.adrtyp THEN ls("
"); ll + ELSIF struct = OPT.int8typ THEN ls(""); ll + ELSIF struct = OPT.int16typ THEN ls(""); ll + ELSIF struct = OPT.int32typ THEN ls(""); ll + ELSIF struct = OPT.int64typ THEN ls(""); ll + ELSIF struct = OPT.set32typ THEN ls(""); ll + ELSIF struct = OPT.set64typ THEN ls(""); ll + ELSIF struct = OPT.booltyp THEN ls(""); ll + ELSIF struct = OPT.chartyp THEN ls(""); ll + ELSIF struct = OPT.realtyp THEN ls(""); ll + ELSIF struct = OPT.lrltyp THEN ls(""); ll + ELSIF struct = OPT.hinttyp THEN ls(""); ll + ELSIF struct = OPT.cpbytetyp THEN ls(""); 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 ; diff --git a/src/compiler/OPT.Mod b/src/compiler/OPT.Mod old mode 100644 new mode 100755 index 2641703e..bfada949 --- a/src/compiler/OPT.Mod +++ b/src/compiler/OPT.Mod @@ -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;