|
@@ -0,0 +1,526 @@
|
|
|
|
|
+(* NATIVE.MOD — DRAFT v1, assembled 2026-10-04, NOT verified.
|
|
|
|
|
+ MCode reader core + patch/label/driver, co-linked with INTELL (GENZ80.MOD)
|
|
|
|
|
+ in genz80.mcd. Reconstructed from docs/compiler/disasm/native.txt
|
|
|
|
|
+ (4499 lines) by two parallel passes (group 1 reader/labels/writers,
|
|
|
|
|
+ group 2 patch/gen/driver). MCD diff pending.
|
|
|
|
|
+
|
|
|
|
|
+ Globals merged: group-1 names win; group-2 g-names mapped (g3 flagW3,
|
|
|
|
|
+ g6 rdCursor, g25 anchorChain, g27 opStack, g2/g5/g8/g9/g10 aux w2aux,
|
|
|
|
|
+ w5aux, auxTab8/9/10; IWord2/3/4 = INTELL.word2/3/4).
|
|
|
|
|
+ INTELL.* emitter calls need INTELL import (no INTELL DEF recovered).
|
|
|
|
|
+ N-prefix = NATIVE-local procs (FORWARD work list); NProc16 = Fatal,
|
|
|
|
|
+ NProc27 = WriteA mapped. Original linkage (co-linked same file) differs
|
|
|
|
|
+ from this two-file layout — TBD in verification. *)
|
|
|
|
|
+
|
|
|
|
|
+IMPLEMENTATION MODULE Native;
|
|
|
|
|
+IMPORT Compiler, Scanner, Texts, Files, INTELL;
|
|
|
|
|
+FROM SYSTEM IMPORT ADDRESS, WORD;
|
|
|
|
|
+FROM STORAGE IMPORT ALLOCATE, DEALLOCATE;
|
|
|
|
|
+
|
|
|
|
|
+TYPE Words = POINTER TO ARRAY [0..4095] OF WORD;
|
|
|
|
|
+
|
|
|
|
|
+VAR
|
|
|
|
|
+ opTable: ADDRESS; (* word12: opcode info table *)
|
|
|
|
|
+ patchTab: ADDRESS; (* word13: patch/operand word table *)
|
|
|
|
|
+ patchBase: ADDRESS; (* word14: patch list base *)
|
|
|
|
|
+ patchCnt: CARDINAL; (* word15: patch count (<512) *)
|
|
|
|
|
+ tmpIdx: CARDINAL; (* word16 *)
|
|
|
|
|
+ curByt: CARDINAL; (* word17: last fetched byte *)
|
|
|
|
|
+ outMode: CARDINAL; (* word18: writer mode/width *)
|
|
|
|
|
+ rdBase: ADDRESS; (* word19: MCode input window base *)
|
|
|
|
|
+ outWr: ADDRESS; (* word20: writer staging write ptr *)
|
|
|
|
|
+ outRd: ADDRESS; (* word21: writer staging read ptr *)
|
|
|
|
|
+ outBase: ADDRESS; (* word22: output buffer base *)
|
|
|
|
|
+ outAux: ARRAY [0..7] OF BYTE; (* word23: 8-byte header *)
|
|
|
|
|
+ outCol: CARDINAL; (* word24 *)
|
|
|
|
|
+ rdPos: CARDINAL; (* word6: read offset (= group2 g6 cursor) *)
|
|
|
|
|
+ rdLeft: CARDINAL; (* word7: bytes remaining *)
|
|
|
|
|
+ flagW3: CARDINAL; (* word3: aux flag (group2 g3) *)
|
|
|
|
|
+ anchorChain: ADDRESS; (* word25: base-anchor chain *)
|
|
|
|
|
+ opStack: CARDINAL; (* word27: operand stack (node links) *)
|
|
|
|
|
+ w2aux: CARDINAL; (* word2: role TBD *)
|
|
|
|
|
+ w5aux: CARDINAL; (* word5: role TBD *)
|
|
|
|
|
+ auxTab8: ADDRESS; (* word8: table TBD *)
|
|
|
|
|
+ auxMask9: CARDINAL; (* word9: mask TBD *)
|
|
|
|
|
+ auxTab10: ADDRESS; (* word10: table TBD *)
|
|
|
|
|
+ objFile: ADDRESS; (* file handle TBD *)
|
|
|
|
|
+
|
|
|
|
|
+(* ---- NATIVE-local FORWARD work list ---- *)
|
|
|
|
|
+PROCEDURE NProc2(a, b: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc3(x: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc5(x: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc8; FORWARD;
|
|
|
|
|
+PROCEDURE NProc12(x: ADDRESS); FORWARD;
|
|
|
|
|
+PROCEDURE NProc13; FORWARD;
|
|
|
|
|
+PROCEDURE NProc17(a, b: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc18(a: ADDRESS; b: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc19(x: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc20(a, b: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc21(): CARDINAL; FORWARD;
|
|
|
|
|
+PROCEDURE NProc22(): CARDINAL; FORWARD;
|
|
|
|
|
+PROCEDURE NProc28(x: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc30(a, b: ADDRESS; c: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc31(x: CARDINAL): CARDINAL; FORWARD;
|
|
|
|
|
+PROCEDURE NProc32(a, b: CARDINAL; c: ADDRESS; d: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE NProc33; FORWARD;
|
|
|
|
|
+PROCEDURE IProc12(a, b, c: CARDINAL); FORWARD; (* INTELL-local, arity TBD *)
|
|
|
|
|
+PROCEDURE IProc13; FORWARD;
|
|
|
|
|
+PROCEDURE IProc14(x: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE IProc18(a: ADDRESS; b: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE IProc19(x: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE IProc23(x: ADDRESS); FORWARD;
|
|
|
|
|
+PROCEDURE ExtWrite(f: ADDRESS; buf: ADDRESS; n: CARDINAL); FORWARD; (* FIXME *)
|
|
|
|
|
+PROCEDURE ExtClose(f: ADDRESS; n: CARDINAL); FORWARD; (* FIXME *)
|
|
|
|
|
+PROCEDURE ConWrite(t: CARDINAL; s: ARRAY OF CHAR; n: CARDINAL); FORWARD; (* FIXME *)
|
|
|
|
|
+PROCEDURE ConLn(t: CARDINAL); FORWARD; (* FIXME *)
|
|
|
|
|
+PROCEDURE RaiseTrap(a, b, c: CARDINAL); FORWARD; (* MCode RAISE emulation TBD *)
|
|
|
|
|
+
|
|
|
|
|
+(* NATIVE group 1 — reader core + labels + writers.
|
|
|
|
|
+ Proc numbering = header-table order: 1 ASSERT, 16 FATAL, 17 OPFILL,
|
|
|
|
|
+ 18 INIT, 19 WRITEP, 20 GETBYT, 21 NEXTBY, 22 NEXTWO, 23 LOOKAH,
|
|
|
|
|
+ 24 NEWLIN, 25 WRITEH, 26 WRITET, 27 WRITEA. *)
|
|
|
|
|
+
|
|
|
|
|
+(* ASSERT {0016}: trap unless cond; prints "nlc =" + INTELL cursor. *)
|
|
|
|
|
+PROCEDURE Assert(cond: BOOLEAN);
|
|
|
|
|
+BEGIN (* {0016} *)
|
|
|
|
|
+ IF NOT cond THEN (* {0018..001a} *)
|
|
|
|
|
+ (* FIXME: console WriteString("nlc =") *)
|
|
|
|
|
+ (* FIXME: console WriteCard(INTELL.word2) *)
|
|
|
|
|
+ (* FIXME: console WriteLn *)
|
|
|
|
|
+ RAISE 271; (* {0030..0035} FIXME code *)
|
|
|
|
|
+ END;
|
|
|
|
|
+END Assert;
|
|
|
|
|
+
|
|
|
|
|
+(* FATAL {003d}: print "ERROR: " + msg, newline, abort.
|
|
|
|
|
+ Stack: param1 = msgLen (last pushed), param2 = msgAddr. *)
|
|
|
|
|
+PROCEDURE Fatal(msgAddr: ADDRESS; msgLen: CARDINAL);
|
|
|
|
|
+BEGIN (* {003d} *)
|
|
|
|
|
+ (* FIXME: reserve_string build *)
|
|
|
|
|
+ (* FIXME: WriteString("ERROR: ") + WriteString(msgAddr, msgLen) + WriteLn *)
|
|
|
|
|
+ (* FIXME: close/abort; HALT *)
|
|
|
|
|
+END Fatal;
|
|
|
|
|
+
|
|
|
|
|
+(* OPSIZ {0067}: operand size field of opcode. *)
|
|
|
|
|
+PROCEDURE OpSize(op: CARDINAL): CARDINAL;
|
|
|
|
|
+BEGIN (* {0067} *)
|
|
|
|
|
+ RETURN (opTable^[op] DIV 4) MOD 16;
|
|
|
|
|
+END OpSize;
|
|
|
|
|
+
|
|
|
|
|
+(* OPERAN {0083}: operand-kind field; must not be 7. *)
|
|
|
|
|
+PROCEDURE Operand(op: CARDINAL): CARDINAL;
|
|
|
|
|
+VAR k: CARDINAL;
|
|
|
|
|
+BEGIN (* {0083} *)
|
|
|
|
|
+ k := (opTable^[op] DIV 64) MOD 8;
|
|
|
|
|
+ Assert(k <> 7); (* call proc1 *)
|
|
|
|
|
+ RETURN k;
|
|
|
|
|
+END Operand;
|
|
|
|
|
+
|
|
|
|
|
+(* INTERP {00a6}: interp key; must be non-zero. *)
|
|
|
|
|
+PROCEDURE Interp(op: CARDINAL);
|
|
|
|
|
+VAR k: CARDINAL;
|
|
|
|
|
+BEGIN (* {00a6} *)
|
|
|
|
|
+ k := opTable^[op] DIV 512;
|
|
|
|
|
+ Assert(k <> 0);
|
|
|
|
|
+ (* FIXME: INTELL.proc6(205, 1072 + k*5) *)
|
|
|
|
|
+END Interp;
|
|
|
|
|
+
|
|
|
|
|
+(* RUNTIM {00c6}: runtime class TRUE iff =1. *)
|
|
|
|
|
+PROCEDURE IsRuntim(op: CARDINAL): BOOLEAN;
|
|
|
|
|
+VAR k: CARDINAL;
|
|
|
|
|
+BEGIN (* {00c6} *)
|
|
|
|
|
+ k := opTable^[op] MOD 4;
|
|
|
|
|
+ Assert(k <> 0);
|
|
|
|
|
+ RETURN k = 1;
|
|
|
|
|
+END IsRuntim;
|
|
|
|
|
+
|
|
|
|
|
+(* RELOP {00e3}: relop class, must =3. *)
|
|
|
|
|
+PROCEDURE IsRelop(op: CARDINAL): BOOLEAN;
|
|
|
|
|
+VAR k: CARDINAL;
|
|
|
|
|
+BEGIN (* {00e3} *)
|
|
|
|
|
+ k := opTable^[op] MOD 4;
|
|
|
|
|
+ Assert(k <> 0);
|
|
|
|
|
+ RETURN k = 3;
|
|
|
|
|
+END IsRelop;
|
|
|
|
|
+
|
|
|
|
|
+(* OPFILL {0100} = proc17: fill opTable range. Pushes (base, count, op);
|
|
|
|
|
+ param1 = op (last). *)
|
|
|
|
|
+PROCEDURE OpFill(base, count, op: CARDINAL);
|
|
|
|
|
+VAR hi, i, n: CARDINAL;
|
|
|
|
|
+BEGIN (* {0100} *)
|
|
|
|
|
+ hi := op DIV 512;
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ n := count - 1;
|
|
|
|
|
+ WHILE i <= n DO (* {010b..010e} *)
|
|
|
|
|
+ opTable^[base + i] := op; (* {0110..0118} *)
|
|
|
|
|
+ IF hi <> 0 THEN op := op + 512 END; (* {0119..0122} *)
|
|
|
|
|
+ INC(i);
|
|
|
|
|
+ END;
|
|
|
|
|
+END OpFill;
|
|
|
|
|
+
|
|
|
|
|
+(* INIT {012f} = proc18: build opTable. Takes table address. *)
|
|
|
|
|
+PROCEDURE Init(table: ADDRESS);
|
|
|
|
|
+VAR i: CARDINAL;
|
|
|
|
|
+BEGIN (* {012f} *)
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ WHILE i <= 255 DO
|
|
|
|
|
+ table^[i] := 504; (* default fill *)
|
|
|
|
|
+ INC(i);
|
|
|
|
|
+ END;
|
|
|
|
|
+ table^[1] := 732; table^[8] := 1500; table^[9] := 2012;
|
|
|
|
|
+ table^[15] := 2193; table^[18] := 3036; table^[24] := 3548;
|
|
|
|
|
+ table^[25] := 4060; table^[31] := 4316; table^[34] := 97;
|
|
|
|
|
+ table^[40] := 161; table^[48] := 4828; table^[49] := 5404;
|
|
|
|
|
+ table^[64] := 6108; table^[65] := 6225; table^[67] := 9;
|
|
|
|
|
+ table^[68] := 92; table^[69] := 81; table^[70] := 137;
|
|
|
|
|
+ table^[71] := 156; table^[72] := 156; table^[73] := 92;
|
|
|
|
|
+ table^[74] := 92; table^[75] := 9; table^[76] := 156;
|
|
|
|
|
+ table^[77] := 220; table^[78] := 284; table^[79] := 156;
|
|
|
|
|
+ table^[80] := 6684; table^[81] := 7324; table^[82] := 220;
|
|
|
|
|
+ table^[83] := 220; table^[84] := 74; table^[85] := 156;
|
|
|
|
|
+ table^[86] := 137; table^[102] := 74; table^[103] := 72;
|
|
|
|
|
+ OpFill(123, 3, 82);
|
|
|
|
|
+ table^[135] := 10204; table^[145] := 94; table^[146] := 157;
|
|
|
|
|
+ table^[147] := 138;
|
|
|
|
|
+ OpFill(160, 6, 139); OpFill(166, 2, 138); table^[168] := 10378;
|
|
|
|
|
+ OpFill(169, 2, 10889); OpFill(176, 2, 138); OpFill(178, 4, 139);
|
|
|
|
|
+ table^[182] := 75; table^[183] := 74;
|
|
|
|
|
+ OpFill(184, 2, 11913); OpFill(186, 3, 12873); OpFill(189, 2, 14417);
|
|
|
|
|
+ table^[191] := 15441; OpFill(192, 2, 138);
|
|
|
|
|
+ table^[194] := 16009; table^[195] := 16540;
|
|
|
|
|
+ OpFill(196, 2, 17033); OpFill(198, 5, 18065); table^[204] := 20561;
|
|
|
|
|
+ OpFill(208, 2, 138); table^[210] := 21577; table^[211] := 22153;
|
|
|
|
|
+ table^[212] := 29660; table^[213] := 22665;
|
|
|
|
|
+ OpFill(214, 4, 23185); OpFill(218, 2, 25225);
|
|
|
|
|
+ table^[220] := 26249; table^[221] := 26697;
|
|
|
|
|
+ OpFill(222, 2, 139); table^[230] := 138; table^[231] := 27275;
|
|
|
|
|
+ OpFill(232, 2, 138); table^[234] := 27721; table^[235] := 28636;
|
|
|
|
|
+ table^[239] := 29148;
|
|
|
|
|
+END Init;
|
|
|
|
|
+(* {0339..033d}: module-body tail: Init(opTable); GOTO driver@18d3. *)
|
|
|
|
|
+
|
|
|
|
|
+(* GETBYT {03e4} = proc20: fetch byte, advance, decr left. *)
|
|
|
|
|
+PROCEDURE GetByt;
|
|
|
|
|
+BEGIN (* {03e4} *)
|
|
|
|
|
+ curByt := rdBase^[rdPos];
|
|
|
|
|
+ INC(rdPos);
|
|
|
|
|
+ DEC(rdLeft);
|
|
|
|
|
+END GetByt;
|
|
|
|
|
+
|
|
|
|
|
+(* NEXTBY {03fd} = proc21: fetch + return byte. *)
|
|
|
|
|
+PROCEDURE NextBy(): CARDINAL;
|
|
|
|
|
+BEGIN (* {03fd} *)
|
|
|
|
|
+ curByt := rdBase^[rdPos];
|
|
|
|
|
+ INC(rdPos);
|
|
|
|
|
+ DEC(rdLeft);
|
|
|
|
|
+ RETURN curByt;
|
|
|
|
|
+END NextBy;
|
|
|
|
|
+
|
|
|
|
|
+(* NEXTWO {0420} = proc22: little-endian word. *)
|
|
|
|
|
+PROCEDURE NextWo(): CARDINAL;
|
|
|
|
|
+VAR lo, hi: CARDINAL;
|
|
|
|
|
+BEGIN (* {0420} *)
|
|
|
|
|
+ lo := NextBy();
|
|
|
|
|
+ hi := NextBy();
|
|
|
|
|
+ RETURN lo + 256 * hi;
|
|
|
|
|
+END NextWo;
|
|
|
|
|
+
|
|
|
|
|
+(* LOOKAH {0435} = proc23: peek without advancing. *)
|
|
|
|
|
+PROCEDURE Lookah(): CARDINAL;
|
|
|
|
|
+BEGIN (* {0435} *)
|
|
|
|
|
+ RETURN rdBase^[rdPos];
|
|
|
|
|
+END Lookah;
|
|
|
|
|
+
|
|
|
|
|
+(* NEWLIN {044b} = proc24: low-level newline emit (1 instr). *)
|
|
|
|
|
+PROCEDURE NewLin;
|
|
|
|
|
+BEGIN (* {044b} *)
|
|
|
|
|
+ (* FIXME: newline primitive TBD *)
|
|
|
|
|
+END NewLin;
|
|
|
|
|
+
|
|
|
|
|
+(* WRITEH {0454} = proc25: hex dump of emitted window (sketch). *)
|
|
|
|
|
+PROCEDURE WriteH;
|
|
|
|
|
+VAR delta, tab, n: CARDINAL;
|
|
|
|
|
+BEGIN (* {0454} *)
|
|
|
|
|
+ delta := INTELL.word2 - rdPos; (* FIXME: INTELL cursor *)
|
|
|
|
|
+ tab := outRd;
|
|
|
|
|
+ n := 1;
|
|
|
|
|
+ WHILE n <= Words(tab)^[3] DO (* FIXME field *)
|
|
|
|
|
+ Words(tab)^[5] := Words(tab)^[5] + delta; (* FIXME *)
|
|
|
|
|
+ tab := tab + 12;
|
|
|
|
|
+ INC(n);
|
|
|
|
|
+ END;
|
|
|
|
|
+ (* FIXME: address arithmetic + file-write calls *)
|
|
|
|
|
+END WriteH;
|
|
|
|
|
+
|
|
|
|
|
+(* WRITET {04b3} = proc26: print stats + trailer (sketch). *)
|
|
|
|
|
+PROCEDURE WriteT;
|
|
|
|
|
+VAR loc: ARRAY [0..3] OF WORD;
|
|
|
|
|
+BEGIN (* {04b3} *)
|
|
|
|
|
+ (* FIXME: staging via WRITEP; WriteString("Compiled bytes:"); WriteCard; *)
|
|
|
|
|
+ (* FIXME: WriteString("Native-code file ") + TEXTS.word4 + " produced" *)
|
|
|
|
|
+END WriteT;
|
|
|
|
|
+
|
|
|
|
|
+(* WRITEA {0581} = proc27: finish listing. *)
|
|
|
|
|
+PROCEDURE WriteA;
|
|
|
|
|
+BEGIN (* {0581} *)
|
|
|
|
|
+ WriteH; (* proc25 *)
|
|
|
|
|
+ (* FIXME: INTELL.proc8 flush emitter? *)
|
|
|
|
|
+ WriteT; (* proc26 *)
|
|
|
|
|
+END WriteA;
|
|
|
|
|
+
|
|
|
|
|
+(* NATIVE module-body init {058c..05c2} (not a proc):
|
|
|
|
|
+ rdBase := Z.word21 + 16; rdPos := 0; rdLeft := 6;
|
|
|
|
|
+ outBase := Z.word21; outWr := rdBase + INTELL.word1;
|
|
|
|
|
+ outRd := rdBase + INTELL.word2; outMode := outWr^[1];
|
|
|
|
|
+ outWr^[8..] := outAux[0..7]; GOTO 18d9 (driver). *)
|
|
|
|
|
+(* NATIVE group 2 — patch/label/driver.
|
|
|
|
|
+ patchCnt=patchCnt, patchBase=patchBase, patchTab=patchTab, anchorChain=anchorChain, opStack=opStack,
|
|
|
|
|
+ flagW3=flagW3, rdPos=rdPos, w2aux/w5aux/auxTab8/auxMask9/auxTab10=w2aux/w5aux/auxTab8/auxMask9/auxTab10.
|
|
|
|
|
+ INTELL.word2/3/4=INTELL.word2/3/4. NextByte/NextWord=NextBy/NextWo.
|
|
|
|
|
+ INTELL.* = cross-module emitter calls (no INTELL DEF recovered). *)
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE PatchWord; (* PATCH {0346}: append fixup; fatal on overflow. *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF patchCnt >= 512 THEN
|
|
|
|
|
+ Fatal("INTERNAL TABLE OVERFLOW", 22); (* FIXME: NProc16 *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ Words(patchBase)^[patchCnt] := INTELL.word2 - 2;
|
|
|
|
|
+ INC(patchCnt);
|
|
|
|
|
+END PatchWord;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE PatchWordIndexed(i: INTEGER; val: CARDINAL): CARDINAL; (* DPATCH {0381} *)
|
|
|
|
|
+VAR old: CARDINAL;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ i := i DIV 2;
|
|
|
|
|
+ old := Words(patchTab)^[i + 40]; (* FIXME range [-40..295] *)
|
|
|
|
|
+ Words(patchTab)^[i + 40] := val;
|
|
|
|
|
+ RETURN old;
|
|
|
|
|
+END PatchWordIndexed;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE WritePatch; (* WRITEP {03ae}: flush patch table. *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ ExtWrite(objFile, patchBase, patchCnt * 2); (* FIXME file/callee/order *)
|
|
|
|
|
+END WritePatch;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE PushBase; (* PUSHBA {05cb} *)
|
|
|
|
|
+VAR r: ADDRESS; dummy: CARDINAL;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ dummy := 0;
|
|
|
|
|
+ IProc18(ADR(dummy), 1); (* FIXME purpose *)
|
|
|
|
|
+ ALLOCATE(r, 12);
|
|
|
|
|
+ Words(r)^[1] := 0;
|
|
|
|
|
+ Words(r)^[2] := rdPos;
|
|
|
|
|
+ Words(r)^[3] := INTELL.word2;
|
|
|
|
|
+ Words(r)^[4] := INTELL.word3;
|
|
|
|
|
+ Words(r)^[5] := anchorChain;
|
|
|
|
|
+ anchorChain := r;
|
|
|
|
|
+END PushBase;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE SetLabel(lab: ADDRESS); (* SETLAB {05f6} *)
|
|
|
|
|
+VAR p: ADDRESS;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF Words(lab)^[0] = NIL THEN
|
|
|
|
|
+ ALLOCATE(Words(lab)^[0], 12); (* FIXME VAR shape *)
|
|
|
|
|
+ Words(Words(lab)^[0])^[1] := INTELL.word3;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ p := Words(lab)^[0]; (* {060d-0610} *)
|
|
|
|
|
+ WHILE p # NIL DO (* FIXME exit shape *)
|
|
|
|
|
+ p := INTELL.PutCode(p, INTELL.word2); (* {0615-0618} FIXME: INTELL.proc7 2-item site *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ Words(Words(lab)^[0])^[0] := INTELL.word2; (* stamp *)
|
|
|
|
|
+ Words(Words(lab)^[0])^[2] := 0;
|
|
|
|
|
+ flagW3 := 0;
|
|
|
|
|
+END SetLabel;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE GenBlas(p1, p2, p3, p4: CARDINAL); (* GENBLA {062f} FIXME order *)
|
|
|
|
|
+VAR base: CARDINAL; q, prev: ADDRESS;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ flagW3 := 0;
|
|
|
|
|
+ base := rdPos - p4;
|
|
|
|
|
+ Assert((anchorChain # NIL) AND (q^[2] = base)); (* FIXME cond/read order; q use-before-def? *)
|
|
|
|
|
+ q := anchorChain;
|
|
|
|
|
+ WHILE (q # NIL) AND (Words(q)^[2] # base) DO
|
|
|
|
|
+ prev := q; q := Words(q)^[5];
|
|
|
|
|
+ END;
|
|
|
|
|
+ Assert(q # NIL);
|
|
|
|
|
+ IF q = anchorChain THEN anchorChain := Words(q)^[5]
|
|
|
|
|
+ ELSE Words(prev)^[5] := Words(q)^[5];
|
|
|
|
|
+ END;
|
|
|
|
|
+ DEALLOCATE(q, 12); (* FIXME addr-of-local *)
|
|
|
|
|
+ ALLOCATE(p2, 12); (* FIXME target is param slot *)
|
|
|
|
|
+ p2^[0] := Words(q)^[0]; p2^[1] := Words(q)^[3]; (* FIXME field map; p2 ADDRESS deref *)
|
|
|
|
|
+ p2^[2] := 0; p2^[3] := 0;
|
|
|
|
|
+END GenBlas;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE ExHandle(fr: ADDRESS); (* EXHAND {0699} FIXME arity *)
|
|
|
|
|
+VAR n, b, lo, hi: CARDINAL; t: ADDRESS;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ flagW3 := 0; n := 0; b := 0;
|
|
|
|
|
+ t := Words(fr)^[2]; DEALLOCATE(Words(fr)^[2], 12); (* FIXME shape *)
|
|
|
|
|
+ n := INTELL.PutCode(t, INTELL.word2 - t - 1); (* FIXME *)
|
|
|
|
|
+ b := NextBy();
|
|
|
|
|
+ INTELL.EmitByte(b);
|
|
|
|
|
+ b := 0;
|
|
|
|
|
+ WHILE b # 0 DO (* FIXME inverted *)
|
|
|
|
|
+ lo := NextWo(); INTELL.EmitWord(lo);
|
|
|
|
|
+ hi := NextWo();
|
|
|
|
|
+ IF hi # b + 4 THEN
|
|
|
|
|
+ IF n # 0 THEN DEALLOCATE(ADR(n), 12); END;
|
|
|
|
|
+ NProc30(ADR(n), ADR(b), 0);
|
|
|
|
|
+ END;
|
|
|
|
|
+ INTELL.EmitWord(INTELL.word2 + 1 - t);
|
|
|
|
|
+ DEC(b);
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF n # 0 THEN DEALLOCATE(ADR(n), 12); END;
|
|
|
|
|
+END ExHandle;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE GenLabel12(p1: ADDRESS; p2: ADDRESS; p3: CARDINAL); (* GEN1L2 {07ed} FIXME order *)
|
|
|
|
|
+VAR a, b, c, d: CARDINAL; isOne: BOOLEAN;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF flagW3 THEN RETURN END;
|
|
|
|
|
+ isOne := Words(p2)^[0] = 0;
|
|
|
|
|
+ IF isOne THEN
|
|
|
|
|
+ ALLOCATE(Words(p2)^[0], 12); (* FIXME target shape *)
|
|
|
|
|
+ Words(Words(p2)^[0])^[0] := 0; Words(Words(p2)^[0])^[1] := INTELL.word3; Words(Words(p2)^[0])^[2] := 1;
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF p1 # NIL THEN
|
|
|
|
|
+ IProc18(Words(p2)^[0], ORD(NOT isOne));
|
|
|
|
|
+ END;
|
|
|
|
|
+ a := Words(Words(p2)^[0])^[0]; b := Words(Words(p2)^[0])^[1];
|
|
|
|
|
+ c := INTELL.PutCode(a, b);
|
|
|
|
|
+ d := INTELL.PutCode(a, c);
|
|
|
|
|
+ IF Words(Words(p2)^[0])^[2] # 0 THEN
|
|
|
|
|
+ INTELL.MakeHandle(b); (* 1 arg fits FIXME *)
|
|
|
|
|
+ Words(Words(p2)^[0])^[0] := INTELL.word2 + 1;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ IF TRUE THEN (* FIXME andjp fallthrough *)
|
|
|
|
|
+ INC(a); b := NOT b;
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ INTELL.MakeHandle(b);
|
|
|
|
|
+ INTELL.EmitOpWord(p3, a);
|
|
|
|
|
+ NProc8;
|
|
|
|
|
+END GenLabel12;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE PushIt(x: CARDINAL); (* PUSHIT {098f} *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ x := x; opStack := x; (* FIXME node link *)
|
|
|
|
|
+END PushIt;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE PopIt(VAR out: CARDINAL); (* POPIT {099f} FIXME VAR shape *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ Assert(opStack # NIL);
|
|
|
|
|
+ out := opStack; opStack := Words(opStack)^[0]; (* FIXME link field *)
|
|
|
|
|
+ Words(out)^[0] := 0; (* FIXME stale-link clear; CARDINAL deref *)
|
|
|
|
|
+END PopIt;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE PushOp(op: CARDINAL); (* PUSHOP {09b9} FIXME locals *)
|
|
|
|
|
+VAR r: ADDRESS; n, i: CARDINAL;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ ALLOCATE(r, 12);
|
|
|
|
|
+ Words(r)^[2] := 2; Words(r)^[3] := op;
|
|
|
|
|
+ n := OpSize(op);
|
|
|
|
|
+ i := 2;
|
|
|
|
|
+ WHILE i > n DO
|
|
|
|
|
+ Words(r)^[i - 1] := 0; DEC(i); (* FIXME index bias *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ WHILE i # 0 DO
|
|
|
|
|
+ Words(r)^[i * 2 - 1] := 0; DEC(i); (* FIXME NATIVE.proc12 *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ Words(r)^[1] := NProc3(op); (* FIXME *)
|
|
|
|
|
+ Words(r)^[0] := opStack; opStack := r;
|
|
|
|
|
+END PushOp;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE StackEnd; (* STACKE {0b01}: assert empty, fall into driver. *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF opStack # 0 THEN
|
|
|
|
|
+ RaiseTrap(9, 0, 0); (* FIXME trap code *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ opStack := 0;
|
|
|
|
|
+ (* jp 18df: falls into module driver epilogue, not a return *)
|
|
|
|
|
+END StackEnd;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE GenCall(w: CARDINAL); (* GENCAL {0b18} FIXME: w = param1 + stack words *)
|
|
|
|
|
+VAR kind, mode, lo, flg: CARDINAL; i: CARDINAL;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ kind := w DIV 4096;
|
|
|
|
|
+ mode := (w MOD 4096) DIV 256;
|
|
|
|
|
+ lo := w MOD 256;
|
|
|
|
|
+ flg := Words(auxTab8)^[lo]; (* FIXME auxTab8 table *)
|
|
|
|
|
+ IF kind IN BITSET{17} THEN
|
|
|
|
|
+ IF COMPILER.word26 THEN flg := -255 ELSE flg := -195 END; (* FIXME: COMPILER word26 = CARDINAL? pun *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF (kind = 1) AND (1 IN BITSET{flg}) THEN (* FIXME set pun *)
|
|
|
|
|
+ IProc13;
|
|
|
|
|
+ ELSIF w2aux = 0 THEN (* FIXME w2aux *)
|
|
|
|
|
+ i := 2;
|
|
|
|
|
+ WHILE i <= 5 DO
|
|
|
|
|
+ IF i IN BITSET{flg} THEN (* FIXME *)
|
|
|
|
|
+ IProc12(5, i * 2, 2); (* FIXME arity *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ INC(i);
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ INTELL.PushOperand; (* proc9 SECURE *)
|
|
|
|
|
+ IProc14(flg DIV 256);
|
|
|
|
|
+ IF Words(w)^[4] # 0 THEN (* FIXME: CARDINAL deref *)
|
|
|
|
|
+ IProc23(Words(w)^[4]); DEALLOCATE(Words(w)^[4], 12);
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF kind = 0 THEN
|
|
|
|
|
+ IProc23(Words(w)^[5]); DEALLOCATE(Words(w)^[5], 12);
|
|
|
|
|
+ END;
|
|
|
|
|
+ INTELL.MakeHandle(0);
|
|
|
|
|
+ CASE kind OF
|
|
|
|
|
+ 90: INTELL.PopOperand; INTELL.word4 := 0; (* FIXME: INTELL word4 undefined *)
|
|
|
|
|
+ | 91: INTELL.PushOperand; INTELL.EmitBytes3(221, 229, 193);
|
|
|
|
|
+ | 92: INTELL.PushOperand; INTELL.EmitOpWord(1, 0);
|
|
|
|
|
+ | 93: IF Words(w)^[2] = 4 THEN
|
|
|
|
|
+ INTELL.PushOperand; INTELL.EmitBytes3(221, 78, 0);
|
|
|
|
|
+ INTELL.EmitBytes3(221, 70, 1);
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ IProc23(Words(w)^[5]); INTELL.PopOperand; INTELL.word4 := 0;
|
|
|
|
|
+ INTELL.EmitBytes2(77, 68);
|
|
|
|
|
+ END;
|
|
|
|
|
+ DEALLOCATE(Words(w)^[5], 12);
|
|
|
|
|
+ | 94: INTELL.PushOperand;
|
|
|
|
|
+ NProc2(42, INTELL.word2 + 1, mode * 2 - 18); (* FIXME *)
|
|
|
|
|
+ INTELL.EmitOpWord(30, (-lo - 1) MOD 256); (* FIXME neg wrap *)
|
|
|
|
|
+ ELSE RaiseTrap(13, 0, 0);
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF kind IN BITSET{14} THEN
|
|
|
|
|
+ INTELL.EmitOpWord(205, Words(w5aux)^[lo]); (* FIXME w5aux table *)
|
|
|
|
|
+ NProc8;
|
|
|
|
|
+ IF (lo MOD 16 IN BITSET{Words(auxTab10)^[lo DIV 16]}) = FALSE THEN (* FIXME *)
|
|
|
|
|
+ Words(w5aux)^[lo] := INTELL.word2 - 2; (* FIXME patch *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE NProc5(kind + 235);
|
|
|
|
|
+ END;
|
|
|
|
|
+ IProc19(flg DIV 256);
|
|
|
|
|
+ Assert(Words(w)^[1] IN BITSET{277}); (* FIXME set *)
|
|
|
|
|
+ IF Words(w)^[1] # 0 THEN Words(w)^[2] := 1 (* FIXME stack word2 *)
|
|
|
|
|
+ ELSE NProc13; Assert(TRUE); DEALLOCATE(ADR(Words(w)^[3]), 12);
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF (kind IN BITSET{17}) OR (lo # w2aux) THEN (* FIXME w2aux *)
|
|
|
|
|
+ auxMask9 := auxMask9 + BITSET{flg}; (* FIXME variable elem *)
|
|
|
|
|
+ END;
|
|
|
|
|
+END GenCall;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE NativeMain; (* DRIVER {18ce} FIXME: module body, not a proc *)
|
|
|
|
|
+VAR i: CARDINAL;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ WHILE i <= 255 DO
|
|
|
|
|
+ Words(auxTab8)^[i] := -1; Words(w5aux)^[i] := -1; INC(i); (* FIXME tables *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ WHILE i <= 15 DO
|
|
|
|
|
+ Words(auxTab10)^[i] := 0; INC(i); (* FIXME *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ConWrite(2, "NAME START LEN", 17); (* FIXME console callee *)
|
|
|
|
|
+ ConLn(2);
|
|
|
|
|
+ NProc49; ConLn(2); (* FIXME report *)
|
|
|
|
|
+ WriteA; (* FIXME close *)
|
|
|
|
|
+ ExtClose(objFile, 19); (* FIXME file callee *)
|
|
|
|
|
+END NativeMain;
|
|
|
|
|
+
|
|
|
|
|
+END Native.
|