|
|
@@ -897,6 +897,231 @@ PROCEDURE EndModule;
|
|
|
(* ---------------- expression lowering ---------------- *)
|
|
|
|
|
|
|
|
|
+(* ---------------- backend listing (step 7) ---------------- *)
|
|
|
+(* Symbolic dump of the assembled image: global layout, procedure
|
|
|
+ table, then disassembled code with resolved labels. Unknown
|
|
|
+ bytes degrade to DB (never fail the listing). *)
|
|
|
+
|
|
|
+PROCEDURE WrS (s: ARRAY OF CHAR);
|
|
|
+ BEGIN
|
|
|
+ FileIO.WriteString(FileIO.StdOut, s)
|
|
|
+ END WrS;
|
|
|
+
|
|
|
+PROCEDURE WrI (v: INTEGER);
|
|
|
+ BEGIN
|
|
|
+ FileIO.WriteInt(FileIO.StdOut, v, 0)
|
|
|
+ END WrI;
|
|
|
+
|
|
|
+PROCEDURE WrHex2 (b: CARDINAL);
|
|
|
+ VAR hi, lo: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ hi := b DIV 16; lo := b MOD 16;
|
|
|
+ IF hi < 10 THEN FileIO.Write(FileIO.StdOut, CHR(ORD("0") + hi))
|
|
|
+ ELSE FileIO.Write(FileIO.StdOut, CHR(ORD("A") + hi - 10)) END;
|
|
|
+ IF lo < 10 THEN FileIO.Write(FileIO.StdOut, CHR(ORD("0") + lo))
|
|
|
+ ELSE FileIO.Write(FileIO.StdOut, CHR(ORD("A") + lo - 10)) END
|
|
|
+ END WrHex2;
|
|
|
+
|
|
|
+PROCEDURE WrHexQ (at: CARDINAL);
|
|
|
+(* 8 little-endian bytes as 16 hex digits (immW payloads). *)
|
|
|
+ VAR i: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE i < 8 DO
|
|
|
+ WrHex2(VAL(CARDINAL, ORD(code[at + i])));
|
|
|
+ INC(i)
|
|
|
+ END
|
|
|
+ END WrHexQ;
|
|
|
+
|
|
|
+PROCEDURE WrOp (b: CARDINAL);
|
|
|
+(* Mnemonic for a single-byte opcode; unknown -> DB hh. *)
|
|
|
+ BEGIN
|
|
|
+ CASE b OF
|
|
|
+ 020H : WrS("dup")
|
|
|
+ | 021H : WrS("swap")
|
|
|
+ | 02CH : WrS("loadLocal")
|
|
|
+ | 02DH : WrS("loadGlb")
|
|
|
+ | 03CH : WrS("storeLocal")
|
|
|
+ | 03DH : WrS("storeGlb")
|
|
|
+ | 011H : WrS("loadOuter")
|
|
|
+ | 041H : WrS("loadIndir")
|
|
|
+ | 051H : WrS("storeIndir")
|
|
|
+ | 060H : WrS("loadIndir0")
|
|
|
+ | 070H : WrS("storeIndir0")
|
|
|
+ | 080H : WrS("localAddr")
|
|
|
+ | 081H : WrS("globalAddr")
|
|
|
+ | 082H : WrS("stkAddr")
|
|
|
+ | 0D4H : WrS("enter")
|
|
|
+ | 0EDH : WrS("procCall")
|
|
|
+ | 0ECH : WrS("nestedCall")
|
|
|
+ | 0EEH : WrS("callFrame")
|
|
|
+ | 084H : WrS("procLeave")
|
|
|
+ | 085H : WrS("fctLeave")
|
|
|
+ | 08DH : WrS("immB")
|
|
|
+ | 08EH : WrS("immW")
|
|
|
+ | 0A6H : WrS("add")
|
|
|
+ | 0A7H : WrS("sub")
|
|
|
+ | 0A8H : WrS("umul")
|
|
|
+ | 0A9H : WrS("udiv")
|
|
|
+ | 0AAH : WrS("umod")
|
|
|
+ | 0ABH : WrS("aeq0")
|
|
|
+ | 0ACH : WrS("inc")
|
|
|
+ | 0ADH : WrS("dec")
|
|
|
+ | 0A0H : WrS("eq")
|
|
|
+ | 0A1H : WrS("ne")
|
|
|
+ | 0B2H : WrS("ilt")
|
|
|
+ | 0B3H : WrS("igt")
|
|
|
+ | 0B4H : WrS("ile")
|
|
|
+ | 0B5H : WrS("ige")
|
|
|
+ | 0B6H : WrS("not")
|
|
|
+ | 0B8H : WrS("imul")
|
|
|
+ | 0B9H : WrS("idiv")
|
|
|
+ | 0BDH : WrS("intToLong")
|
|
|
+ | 0BEH : WrS("longToReal")
|
|
|
+ | 0D5H : WrS("realCmp")
|
|
|
+ | 0D6H : WrS("realAdd")
|
|
|
+ | 0D7H : WrS("realSub")
|
|
|
+ | 0D8H : WrS("realMul")
|
|
|
+ | 0D9H : WrS("realDiv")
|
|
|
+ | 0E6H : WrS("or")
|
|
|
+ | 0E7H : WrS("bitIn")
|
|
|
+ | 0E8H : WrS("and")
|
|
|
+ | 0E9H : WrS("bitXor")
|
|
|
+ | 0EAH : WrS("power2")
|
|
|
+ | 0E0H : WrS("jp")
|
|
|
+ | 0E1H : WrS("jpfalse")
|
|
|
+ | 0C3H : WrS("sys")
|
|
|
+ | 050H : WrS("end")
|
|
|
+ | 030H : WrS("copyBlock")
|
|
|
+ | 0C4H : WrS("strComp")
|
|
|
+ | 003H : WrS("loadParam1")
|
|
|
+ | 004H : WrS("loadParam2")
|
|
|
+ | 005H : WrS("loadParam3")
|
|
|
+ | 006H : WrS("loadParam4")
|
|
|
+ | 007H : WrS("loadParam5")
|
|
|
+ | 01DH : WrS("storeIdxByte")
|
|
|
+ | 0D2H : WrS("reserve")
|
|
|
+ ELSE WrS("DB "); WrHex2(b)
|
|
|
+ END
|
|
|
+ END WrOp;
|
|
|
+
|
|
|
+PROCEDURE OpLen (b: CARDINAL): CARDINAL;
|
|
|
+(* Instruction size: 1, 2 (u8/ext), or 9 (u64/i64). *)
|
|
|
+ BEGIN
|
|
|
+ IF (b = 02CH) OR (b = 02DH) OR (b = 03CH) OR (b = 03DH)
|
|
|
+ OR (b = 011H) OR (b = 080H) OR (b = 081H) OR (b = 082H)
|
|
|
+ OR (b = 0D4H) OR (b = 0EDH) OR (b = 0ECH) OR (b = 0EEH)
|
|
|
+ OR (b = 08DH) OR (b = 040H) OR (b = 084H) OR (b = 085H) THEN
|
|
|
+ RETURN 2
|
|
|
+ ELSIF (b = 08EH) OR (b = 0E0H) OR (b = 0E1H) THEN
|
|
|
+ RETURN 9
|
|
|
+ END;
|
|
|
+ RETURN 1
|
|
|
+ END OpLen;
|
|
|
+
|
|
|
+PROCEDURE LabelAt (addr: CARDINAL): INTEGER;
|
|
|
+(* Label id defined at addr, or -1. *)
|
|
|
+ VAR id: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ id := 0;
|
|
|
+ WHILE VAL(CARDINAL, id) < nLab DO
|
|
|
+ IF (labs[id] >= 0) & (VAL(CARDINAL, labs[id]) = addr) THEN
|
|
|
+ RETURN id
|
|
|
+ END;
|
|
|
+ INC(id)
|
|
|
+ END;
|
|
|
+ RETURN -1
|
|
|
+ END LabelAt;
|
|
|
+
|
|
|
+PROCEDURE DumpImage;
|
|
|
+ VAR pc, i, j: CARDINAL;
|
|
|
+ b, sb, lo: CARDINAL;
|
|
|
+ id: INTEGER;
|
|
|
+ rel: INTEGER;
|
|
|
+ BEGIN
|
|
|
+ FileIO.WriteLn(FileIO.StdOut);
|
|
|
+ WrS("--- Code "); WrS(modName); WrS(" ---"); FileIO.WriteLn(FileIO.StdOut);
|
|
|
+ WrS("code "); WrI(VAL(INTEGER, nCode)); WrS(" bytes, ");
|
|
|
+ WrI(VAL(INTEGER, nGlb)); WrS(" global slots"); FileIO.WriteLn(FileIO.StdOut);
|
|
|
+ (* global layout per scope *)
|
|
|
+ i := 0;
|
|
|
+ WHILE i < nScopes DO
|
|
|
+ WrS("scope "); WrI(VAL(INTEGER, i)); WrS(" ");
|
|
|
+ WrS(scopes[i].tag); WrS(" depth "); WrI(VAL(INTEGER, scopes[i].depth));
|
|
|
+ FileIO.WriteLn(FileIO.StdOut);
|
|
|
+ j := 0;
|
|
|
+ WHILE j < nV DO
|
|
|
+ IF vars[j].scope = VAL(INTEGER, i) THEN
|
|
|
+ WrS(" var "); WrS(vars[j].name);
|
|
|
+ WrS(" slot "); WrI(vars[j].slot);
|
|
|
+ WrS(" size "); WrI(VAL(INTEGER, vars[j].size));
|
|
|
+ FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ END;
|
|
|
+ INC(j)
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ (* procedure table *)
|
|
|
+ i := 1;
|
|
|
+ WHILE i <= maxNum DO
|
|
|
+ IF procAddr[i] >= 0 THEN
|
|
|
+ WrS("proc "); WrI(VAL(INTEGER, i));
|
|
|
+ WrS(" at "); WrI(procAddr[i]);
|
|
|
+ WrS(" depth "); WrI(VAL(INTEGER, procDepth[i]));
|
|
|
+ FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ END;
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ (* disassembly with resolved labels *)
|
|
|
+ pc := 0;
|
|
|
+ WHILE pc < nCode DO
|
|
|
+ id := LabelAt(pc);
|
|
|
+ IF id >= 0 THEN
|
|
|
+ WrS("L"); WrI(id); WrS(":"); FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ END;
|
|
|
+ b := VAL(CARDINAL, ORD(code[pc]));
|
|
|
+ WrI(VAL(INTEGER, pc)); WrS(" ");
|
|
|
+ IF (b >= 090H) & (b <= 09FH) THEN
|
|
|
+ WrS("imm "); WrI(VAL(INTEGER, b - 090H)); pc := pc + 1
|
|
|
+ ELSIF (b = 0E0H) OR (b = 0E1H) THEN
|
|
|
+ IF b = 0E0H THEN WrS("jp ") ELSE WrS("jpfalse ") END;
|
|
|
+ (* 8-byte rel, always fits 32 bits: fold the low 4 bytes *)
|
|
|
+ lo := VAL(CARDINAL, ORD(code[pc + 1]))
|
|
|
+ + VAL(CARDINAL, ORD(code[pc + 2])) * 256
|
|
|
+ + VAL(CARDINAL, ORD(code[pc + 3])) * 65536
|
|
|
+ + VAL(CARDINAL, ORD(code[pc + 4])) * 16777216;
|
|
|
+ IF lo >= 2147483648 THEN
|
|
|
+ rel := VAL(INTEGER, lo - 2147483648) - 2147483647 - 1
|
|
|
+ ELSE
|
|
|
+ rel := VAL(INTEGER, lo)
|
|
|
+ END;
|
|
|
+ id := LabelAt(VAL(CARDINAL, VAL(INTEGER, pc) + 9 + rel));
|
|
|
+ IF id >= 0 THEN WrS("L"); WrI(id)
|
|
|
+ ELSE WrS("+"); WrI(rel)
|
|
|
+ END;
|
|
|
+ pc := pc + 9
|
|
|
+ ELSIF b = 08EH THEN
|
|
|
+ WrS("immW "); WrHexQ(pc + 1); pc := pc + 9
|
|
|
+ ELSIF OpLen(b) = 2 THEN
|
|
|
+ sb := VAL(CARDINAL, ORD(code[pc + 1]));
|
|
|
+ IF b = 040H THEN
|
|
|
+ IF sb = 0 THEN WrS("drop") ELSE WrS("ext "); WrI(VAL(INTEGER, sb)) END
|
|
|
+ ELSE
|
|
|
+ WrOp(b); WrS(" ");
|
|
|
+ IF ((b = 02CH) OR (b = 03CH)) & (sb > 127) THEN
|
|
|
+ WrI(VAL(INTEGER, sb) - 256)
|
|
|
+ ELSE
|
|
|
+ WrI(VAL(INTEGER, sb))
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ pc := pc + 2
|
|
|
+ ELSE
|
|
|
+ WrOp(b); pc := pc + 1
|
|
|
+ END;
|
|
|
+ FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ END
|
|
|
+ END DumpImage;
|
|
|
+
|
|
|
PROCEDURE IsRealTyp (t: INTEGER): BOOLEAN;
|
|
|
BEGIN
|
|
|
RETURN SymTab.ClassOf(t) = SymTab.ClReal
|