second commit

Console.def

@@ -0,0 +1,21 @@
+DEFINITION MODULE Console ;
+
+(* Host console output for the MC64 virtual machine. *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED WriteChar, WriteString, WriteN, WriteLn, WriteInt,
+  WriteLongInt, WriteLongCard, WriteBool, WriteReal, Fatal ;
+
+PROCEDURE WriteChar (c: CHAR) ;
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+PROCEDURE WriteN (p: ADDRESS; n: CARDINAL) ;
+PROCEDURE WriteLn ;
+PROCEDURE WriteInt (i: INTEGER) ;
+PROCEDURE WriteLongInt (l: LONGINT) ;
+PROCEDURE WriteLongCard (u: LONGCARD) ;
+PROCEDURE WriteBool (b: BOOLEAN) ;
+PROCEDURE WriteReal (r: REAL) ;
+PROCEDURE Fatal (msg: ARRAY OF CHAR) ;
+
+END Console.

Console.mod

@@ -0,0 +1,102 @@
+IMPLEMENTATION MODULE Console ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM StdChans IMPORT StdOutChan ;
+FROM IOChan IMPORT ChanId, TextWrite ;
+FROM RealStr IMPORT RealToStr ;
+FROM Strings IMPORT Length ;
+
+VAR
+  outChan : ChanId ;
+  inited : BOOLEAN ;
+
+PROCEDURE Out () : ChanId ;
+BEGIN
+  IF NOT inited THEN
+    outChan := StdOutChan () ;
+    inited := TRUE ;
+  END ;
+  RETURN outChan ;
+END Out ;
+
+PROCEDURE WriteChar (c: CHAR) ;
+BEGIN
+  TextWrite (Out (), ADR (c), 1) ;
+END WriteChar ;
+
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+BEGIN
+  TextWrite (Out (), ADR (s), HIGH (s) + 1) ;
+END WriteString ;
+
+PROCEDURE WriteN (p: ADDRESS; n: CARDINAL) ;
+BEGIN
+  TextWrite (Out (), p, n) ;
+END WriteN ;
+
+PROCEDURE WriteLn ;
+VAR nl: CHAR ;
+BEGIN
+  nl := 12C ;   (* LF *)
+  TextWrite (Out (), ADR (nl), 1) ;
+END WriteLn ;
+
+PROCEDURE WriteLongCard (u: LONGCARD) ;
+VAR tmp : ARRAY [0..31] OF CHAR ; n, i: CARDINAL ;
+BEGIN
+  n := 0 ;
+  REPEAT
+    tmp [n] := CHR (ORD ('0') + VAL (CARDINAL, u MOD 10)) ;
+    u := u DIV 10 ;
+    INC (n) ;
+  UNTIL u = 0 ;
+  i := n ;
+  WHILE i > 0 DO
+    DEC (i) ;
+    WriteChar (tmp [i]) ;
+  END ;
+END WriteLongCard ;
+
+PROCEDURE WriteLongInt (l: LONGINT) ;
+VAR u: LONGCARD ;
+BEGIN
+  IF l < 0 THEN
+    WriteChar ('-') ;
+    u := VAL (LONGCARD, l) ;
+    u := 0 - u ;
+    WriteLongCard (u) ;
+  ELSE
+    WriteLongCard (VAL (LONGCARD, l)) ;
+  END ;
+END WriteLongInt ;
+
+PROCEDURE WriteInt (i: INTEGER) ;
+BEGIN
+  WriteLongInt (VAL (LONGINT, i)) ;
+END WriteInt ;
+
+PROCEDURE WriteBool (b: BOOLEAN) ;
+BEGIN
+  IF b THEN
+    WriteString ("TRUE") ;
+  ELSE
+    WriteString ("FALSE") ;
+  END ;
+END WriteBool ;
+
+PROCEDURE WriteReal (r: REAL) ;
+VAR buf : ARRAY [0..63] OF CHAR ; n: CARDINAL ;
+BEGIN
+  RealToStr (r, buf) ;
+  n := Length (buf) ;
+  TextWrite (Out (), ADR (buf), n) ;
+END WriteReal ;
+
+PROCEDURE Fatal (msg: ARRAY OF CHAR) ;
+BEGIN
+  WriteString (msg) ;
+  WriteLn ;
+  HALT (1) ;
+END Fatal ;
+
+END Console.

Extended.def

@@ -0,0 +1,9 @@
+DEFINITION MODULE Extended ;
+
+(* 0x40 extended sub-opcode dispatch (§10.2 of the spec). *)
+
+EXPORT QUALIFIED Execute ;
+
+PROCEDURE Execute ;
+
+END Extended.

Extended.mod

@@ -0,0 +1,167 @@
+IMPLEMENTATION MODULE Extended ;
+
+FROM Instruction IMPORT Fetch ;
+FROM Stack IMPORT Pop, Push, PopReal, PushReal ;
+FROM Memory IMPORT CopyBytes, FillBytes, WriteSlot, ReadSlot,
+  TopOfMemory ;
+FROM Local IMPORT GetSP, SetSP ;
+FROM Console IMPORT Fatal ;
+
+VAR
+  hp : LONGCARD ;
+
+PROCEDURE HeapPtr () : LONGCARD ;
+BEGIN
+  IF hp = 0 THEN
+    hp := TopOfMemory () ;
+  END ;
+  RETURN hp ;
+END HeapPtr ;
+
+PROCEDURE Shl64 (u: LONGCARD; n: CARDINAL) : LONGCARD ;
+VAR i: CARDINAL ;
+BEGIN
+  IF n >= 64 THEN
+    RETURN 0 ;
+  END ;
+  FOR i := 1 TO n DO
+    u := u * 2 ;
+  END ;
+  RETURN u ;
+END Shl64 ;
+
+PROCEDURE Mul64 (a, b: LONGCARD) : LONGCARD ;
+VAR ah, al, bh, bl, lolo, mid: LONGCARD ;
+BEGIN
+  ah := a DIV 4294967296 ;
+  al := a MOD 4294967296 ;
+  bh := b DIV 4294967296 ;
+  bl := b MOD 4294967296 ;
+  lolo := al * bl ;
+  mid := VAL (LONGCARD, VAL (CARDINAL, ah * bl + al * bh)) ;
+  RETURN lolo + mid * 4294967296 ;
+END Mul64 ;
+
+PROCEDURE AllocateHeap (size: LONGCARD) : LONGCARD ;
+VAR sz: LONGCARD ;
+BEGIN
+  sz := size ;
+  IF (sz MOD 8) # 0 THEN
+    sz := sz + 8 - (sz MOD 8) ;
+  END ;
+  hp := HeapPtr () - sz ;
+  RETURN hp ;
+END AllocateHeap ;
+
+PROCEDURE Execute ;
+VAR sfun, hbit, lbit: CARDINAL ;
+    dst, src, size, a, b, v, mark: LONGCARD ;
+    nw, i, sp: LONGCARD ;
+BEGIN
+  sfun := Fetch () ;
+  CASE sfun OF
+  | 0 :  (* drop *)
+      v := Pop () ;
+  | 1, 2 :  (* enter/leave monitor : no-op *)
+  | 3 :  (* long_negate *)
+      v := Pop () ;
+      Push (0 - v) ;
+  | 4 :  (* build_field_mask : (1<<hi) - (1<<lo) *)
+      hbit := VAL (CARDINAL, Pop ()) ;
+      lbit := VAL (CARDINAL, Pop ()) ;
+      Push (Shl64 (1, hbit MOD 64) - Shl64 (1, lbit MOD 64)) ;
+  | 5 :  (* ALLOCATE *)
+      size := Pop () ;
+      dst := Pop () ;
+      WriteSlot (dst, AllocateHeap (size)) ;
+  | 6 :  (* DEALLOCATE (no-op free) *)
+      size := Pop () ;
+      dst := Pop () ;
+      WriteSlot (dst, 0) ;
+  | 7 :  (* MARK *)
+      dst := Pop () ;
+      WriteSlot (dst, HeapPtr ()) ;
+  | 8 :  (* RELEASE *)
+      dst := Pop () ;
+      mark := ReadSlot (dst) ;
+      hp := mark ;
+      WriteSlot (dst, 0) ;
+  | 9 :  (* FREEMEM *)
+      Push (TopOfMemory () - HeapPtr ()) ;
+  | 0AH, 0BH, 0CH :  (* TRANSFER/IOTRANSFER/NEWPROCESS *)
+      Fatal ("extended: processes unimplemented") ;
+  | 0DH :  (* BIOS (no-op) *)
+      sfun := VAL (CARDINAL, Pop ()) ;
+      v := Pop () ;
+  | 0EH :  (* MOVE *)
+      size := Pop () ;
+      dst := Pop () ;
+      src := Pop () ;
+      CopyBytes (src, dst, size) ;
+  | 0FH :  (* FILL *)
+      v := Pop () ;
+      size := Pop () ;
+      src := Pop () ;
+      FillBytes (src, size, VAL (CARDINAL, v)) ;
+  | 10H :  (* INP (no-op) *)
+      Push (0) ;
+  | 11H :  (* OUT (no-op) *)
+      sfun := VAL (CARDINAL, Pop ()) ;
+      v := Pop () ;
+  | 12H :  (* reserve_string *)
+      src := Pop () ;
+      size := Pop () ;
+      nw := (size + 7) DIV 8 ;
+      dst := GetSP () - nw * 8 ;
+      SetSP (dst) ;
+      i := 0 ;
+      WHILE i < nw DO
+        WriteSlot (dst + i * 8, ReadSlot (src + i * 8)) ;
+        i := i + 1 ;
+      END ;
+      Push (dst) ;
+  | 13H :  (* assert : pop 0 -> raise RangeError *)
+      v := Pop () ;
+      IF v = 0 THEN
+        Fatal ("assertion failed") ;
+      END ;
+  | 14H :  (* uc_less *)
+      b := Pop () ; a := Pop () ;
+      IF a < b THEN Push (1) ELSE Push (0) END ;
+  | 15H :  (* uc_less_eq *)
+      b := Pop () ; a := Pop () ;
+      IF a <= b THEN Push (1) ELSE Push (0) END ;
+  | 16H :  (* uc_greater *)
+      b := Pop () ; a := Pop () ;
+      IF a > b THEN Push (1) ELSE Push (0) END ;
+  | 17H :  (* uc_greater_eq *)
+      b := Pop () ; a := Pop () ;
+      IF a >= b THEN Push (1) ELSE Push (0) END ;
+  | 18H :  (* uc_add *)
+      b := Pop () ; a := Pop () ;
+      Push (a + b) ;
+  | 19H :  (* uc_sub *)
+      b := Pop () ; a := Pop () ;
+      Push (a - b) ;
+  | 1AH :  (* uc_mul *)
+      b := Pop () ; a := Pop () ;
+      Push (Mul64 (a, b)) ;
+  | 1BH :  (* uc_div *)
+      b := Pop () ; a := Pop () ;
+      IF b = 0 THEN Fatal ("divide by zero") END ;
+      Push (a DIV b) ;
+  | 1CH :  (* uc_mod *)
+      b := Pop () ; a := Pop () ;
+      IF b = 0 THEN Fatal ("divide by zero") END ;
+      Push (a MOD b) ;
+  | 1DH :  (* uc_to_real *)
+      v := Pop () ;
+      PushReal (FLOAT (VAL (LONGINT, v))) ;
+  | 1EH :  (* real_to_uc *)
+      Push (VAL (LONGCARD, VAL (INTEGER, TRUNC (PopReal ())))) ;
+  ELSE
+      Fatal ("extended: illegal sub-opcode") ;
+  END ;  (* CASE *)
+END Execute ;
+
+END Extended.

FileIO.def

@@ -0,0 +1,12 @@
+DEFINITION MODULE FileIO ;
+
+(* Whole-file read/write for the MC64 machine.  Raw binary access. *)
+
+EXPORT QUALIFIED ReadFile, WriteFile ;
+
+PROCEDURE ReadFile (name: ARRAY OF CHAR; VAR data: ARRAY OF CHAR;
+                    VAR got: CARDINAL) : BOOLEAN ;
+PROCEDURE WriteFile (name: ARRAY OF CHAR; VAR data: ARRAY OF CHAR;
+                     n: CARDINAL) : BOOLEAN ;
+
+END FileIO.

FileIO.mod

@@ -0,0 +1,40 @@
+IMPLEMENTATION MODULE FileIO ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM StreamFile IMPORT Open, Close ;
+FROM IOChan IMPORT ChanId, RawRead, RawWrite ;
+FROM ChanConsts IMPORT FlagSet, OpenResults, readFlag, writeFlag,
+  oldFlag, rawFlag, opened ;
+
+VAR
+  fs : FlagSet ;
+  cid : ChanId ;
+  res : OpenResults ;
+
+PROCEDURE ReadFile (name: ARRAY OF CHAR; VAR data: ARRAY OF CHAR;
+                    VAR got: CARDINAL) : BOOLEAN ;
+BEGIN
+  fs := FlagSet {readFlag, oldFlag, rawFlag} ;
+  Open (cid, name, fs, res) ;
+  IF res # opened THEN
+    RETURN FALSE ;
+  END ;
+  RawRead (cid, ADR (data), HIGH (data) + 1, got) ;
+  Close (cid) ;
+  RETURN TRUE ;
+END ReadFile ;
+
+PROCEDURE WriteFile (name: ARRAY OF CHAR; VAR data: ARRAY OF CHAR;
+                     n: CARDINAL) : BOOLEAN ;
+BEGIN
+  fs := FlagSet {writeFlag, rawFlag} ;
+  Open (cid, name, fs, res) ;
+  IF res # opened THEN
+    RETURN FALSE ;
+  END ;
+  RawWrite (cid, ADR (data), n) ;
+  Close (cid) ;
+  RETURN TRUE ;
+END WriteFile ;
+
+END FileIO.

Global.def

@@ -0,0 +1,23 @@
+DEFINITION MODULE Global ;
+
+(* MC64 module table: data window base, procedure table address and
+   flag byte for every loaded module index 0..99. *)
+
+EXPORT QUALIFIED MaxModules, InitModuleTable, GetModuleBase, SetModuleBase,
+  GetModuleProcs, SetModuleProcs, GetModuleFlag, SetModuleFlag,
+  GetCurrentModule, SetCurrentModule, FindModuleByBase ;
+
+CONST MaxModules = 101 ;
+
+PROCEDURE InitModuleTable ;
+PROCEDURE GetModuleBase (m: CARDINAL) : LONGCARD ;
+PROCEDURE SetModuleBase (m: CARDINAL; base: LONGCARD) ;
+PROCEDURE GetModuleProcs (m: CARDINAL) : LONGCARD ;
+PROCEDURE SetModuleProcs (m: CARDINAL; procs: LONGCARD) ;
+PROCEDURE GetModuleFlag (m: CARDINAL) : CARDINAL ;
+PROCEDURE SetModuleFlag (m: CARDINAL; f: CARDINAL) ;
+PROCEDURE GetCurrentModule () : CARDINAL ;
+PROCEDURE SetCurrentModule (m: CARDINAL) ;
+PROCEDURE FindModuleByBase (base: LONGCARD) : CARDINAL ;
+
+END Global.

Global.mod

@@ -0,0 +1,76 @@
+IMPLEMENTATION MODULE Global ;
+
+FROM Memory IMPORT WriteSlot, WriteByte ;
+
+VAR
+  moduleBase : ARRAY [0 .. MaxModules - 1] OF LONGCARD ;
+  moduleProcs : ARRAY [0 .. MaxModules - 1] OF LONGCARD ;
+  moduleFlags : ARRAY [0 .. MaxModules - 1] OF CHAR ;
+  currentModule : CARDINAL ;
+
+PROCEDURE InitModuleTable ;
+VAR i: CARDINAL ;
+BEGIN
+  FOR i := 0 TO MaxModules - 1 DO
+    moduleBase [i] := 0 ;
+    moduleProcs [i] := 0 ;
+    moduleFlags [i] := CHR (0) ;
+  END ;
+  currentModule := 0 ;
+END InitModuleTable ;
+
+PROCEDURE GetModuleBase (m: CARDINAL) : LONGCARD ;
+BEGIN
+  RETURN moduleBase [m] ;
+END GetModuleBase ;
+
+PROCEDURE SetModuleBase (m: CARDINAL; base: LONGCARD) ;
+BEGIN
+  moduleBase [m] := base ;
+END SetModuleBase ;
+
+PROCEDURE GetModuleProcs (m: CARDINAL) : LONGCARD ;
+BEGIN
+  RETURN moduleProcs [m] ;
+END GetModuleProcs ;
+
+PROCEDURE SetModuleProcs (m: CARDINAL; procs: LONGCARD) ;
+BEGIN
+  moduleProcs [m] := procs ;
+END SetModuleProcs ;
+
+PROCEDURE GetModuleFlag (m: CARDINAL) : CARDINAL ;
+BEGIN
+  RETURN ORD (moduleFlags [m]) ;
+END GetModuleFlag ;
+
+PROCEDURE SetModuleFlag (m: CARDINAL; f: CARDINAL) ;
+BEGIN
+  moduleFlags [m] := CHR (f MOD 256) ;
+END SetModuleFlag ;
+
+PROCEDURE GetCurrentModule () : CARDINAL ;
+BEGIN
+  RETURN currentModule ;
+END GetCurrentModule ;
+
+PROCEDURE SetCurrentModule (m: CARDINAL) ;
+BEGIN
+  currentModule := m ;
+END SetCurrentModule ;
+
+PROCEDURE FindModuleByBase (base: LONGCARD) : CARDINAL ;
+VAR i: CARDINAL ;
+BEGIN
+  i := 0 ;
+  WHILE (i < MaxModules) AND (moduleBase [i] # base) DO
+    INC (i) ;
+  END ;
+  IF i >= MaxModules THEN
+    RETURN 0 ;
+  ELSE
+    RETURN i ;
+  END ;
+END FindModuleByBase ;
+
+END Global.

Instruction.def

@@ -0,0 +1,19 @@
+DEFINITION MODULE Instruction ;
+
+(* Instruction fetch and frame primitives shared by the interpreter. *)
+
+EXPORT QUALIFIED Fetch, FetchSignedByte, FetchWord, FetchSignedWord,
+  FetchQuad, LoadString, ProcedureAddress, CallProcedure, Enter, Leave ;
+
+PROCEDURE Fetch () : CARDINAL ;
+PROCEDURE FetchSignedByte () : INTEGER ;
+PROCEDURE FetchWord () : CARDINAL ;
+PROCEDURE FetchSignedWord () : INTEGER ;
+PROCEDURE FetchQuad () : LONGCARD ;
+PROCEDURE LoadString (n: CARDINAL) ;
+PROCEDURE ProcedureAddress (mod, obj: CARDINAL) : LONGCARD ;
+PROCEDURE CallProcedure (mod, obj: CARDINAL) ;
+PROCEDURE Enter (k: CARDINAL) ;
+PROCEDURE Leave (n: CARDINAL) ;
+
+END Instruction.

Instruction.mod

@@ -0,0 +1,94 @@
+IMPLEMENTATION MODULE Instruction ;
+
+FROM Memory IMPORT ReadByte, ReadWord, ReadSlot, WriteSlot ;
+FROM Local IMPORT GetIP, SetIP, GetSP, SetSP, GetFP, SetFP, GetGP, SetGP,
+  GetOFP, SetOFP ;
+FROM Stack IMPORT Push, Pop, Reserve ;
+FROM Global IMPORT GetModuleProcs, GetCurrentModule, SetCurrentModule,
+  FindModuleByBase, GetModuleBase ;
+
+PROCEDURE Fetch () : CARDINAL ;
+VAR b: CARDINAL ;
+BEGIN
+  b := ReadByte (GetIP ()) ;
+  SetIP (GetIP () + 1) ;
+  RETURN b ;
+END Fetch ;
+
+PROCEDURE FetchSignedByte () : INTEGER ;
+VAR b: CARDINAL ;
+BEGIN
+  b := Fetch () ;
+  IF b >= 128 THEN
+    RETURN VAL (INTEGER, b) - 256 ;
+  ELSE
+    RETURN VAL (INTEGER, b) ;
+  END ;
+END FetchSignedByte ;
+
+PROCEDURE FetchWord () : CARDINAL ;
+VAR v: CARDINAL ;
+BEGIN
+  v := ReadWord (GetIP ()) ;
+  SetIP (GetIP () + 4) ;
+  RETURN v ;
+END FetchWord ;
+
+PROCEDURE FetchSignedWord () : INTEGER ;
+BEGIN
+  RETURN VAL (INTEGER, FetchWord ()) ;
+END FetchSignedWord ;
+
+PROCEDURE FetchQuad () : LONGCARD ;
+VAR v: LONGCARD ;
+BEGIN
+  v := ReadSlot (GetIP ()) ;
+  SetIP (GetIP () + 8) ;
+  RETURN v ;
+END FetchQuad ;
+
+PROCEDURE LoadString (n: CARDINAL) ;
+BEGIN
+  Push (GetIP ()) ;
+  SetIP (GetIP () + VAL (LONGCARD, n)) ;
+END LoadString ;
+
+PROCEDURE ProcedureAddress (mod, obj: CARDINAL) : LONGCARD ;
+VAR slot, rel: LONGCARD ;
+BEGIN
+  slot := GetModuleProcs (mod) + VAL (LONGCARD, obj) * 8 ;
+  rel := ReadSlot (slot) ;
+  RETURN slot + VAL (LONGCARD, VAL (LONGINT, rel)) ;
+END ProcedureAddress ;
+
+PROCEDURE CallProcedure (mod, obj: CARDINAL) ;
+BEGIN
+  Push (ProcedureAddress (mod, obj)) ;
+END CallProcedure ;
+
+PROCEDURE Enter (k: CARDINAL) ;
+BEGIN
+  Push (GetFP ()) ;
+  Push (GetOFP ()) ;
+  SetFP (GetSP ()) ;
+  Push (GetIP ()) ;
+  SetSP (GetSP () - VAL (LONGCARD, 255 - k) * 8) ;
+END Enter ;
+
+PROCEDURE Leave (n: CARDINAL) ;
+BEGIN
+  SetSP (GetFP ()) ;
+  SetOFP (Pop ()) ;
+  SetFP (Pop ()) ;
+  SetIP (Pop ()) ;
+  IF (n MOD 128) # 0 THEN
+    SetSP (GetSP () + VAL (LONGCARD, n MOD 128) * 8) ;
+  END ;
+  IF n >= 128 THEN
+    SetGP (GetOFP ()) ;
+    SetCurrentModule (FindModuleByBase (GetGP ())) ;
+    SetGP (GetModuleBase (GetCurrentModule ())) ;
+  END ;
+END Leave ;
+
+END Instruction.

Interpreter.def

@@ -0,0 +1,9 @@
+DEFINITION MODULE Interpreter ;
+
+(* MC64 execution engine: runs until opcode 50H (end_program). *)
+
+EXPORT QUALIFIED Run ;
+
+PROCEDURE Run ;
+
+END Interpreter.

Interpreter.mod

@@ -0,0 +1,761 @@
+IMPLEMENTATION MODULE Interpreter ;
+
+FROM Local IMPORT GetIP, SetIP, GetSP, SetSP, GetFP, GetGP, GetOFP, SetOFP, SetGP ;
+FROM Memory IMPORT ReadByte, WriteByte, ReadSlot, WriteSlot,
+  ReadWord, WriteWord, CopyBytes, FillBytes, ArenaBase, MaxMem ;
+FROM Stack IMPORT Push, Pop, PopBool, PopReal, PushReal, Reserve ;
+FROM Instruction IMPORT Fetch, FetchSignedByte, FetchQuad, LoadString,
+  ProcedureAddress, Enter, Leave ;
+FROM Global IMPORT GetModuleBase, GetModuleProcs, GetCurrentModule,
+  SetCurrentModule, FindModuleByBase ;
+FROM Console IMPORT Fatal, WriteChar ;
+FROM Extended IMPORT Execute ;
+FROM StdChans IMPORT StdInChan ;
+FROM IOChan IMPORT Look, Skip ;
+FROM IOConsts IMPORT ReadResults, endOfLine, endOfInput ;
+
+PROCEDURE PushBool (b: BOOLEAN) ;
+BEGIN
+  IF b THEN Push (1) ELSE Push (0) END ;
+END PushBool ;
+
+PROCEDURE Shl64 (u: LONGCARD; n: CARDINAL) : LONGCARD ;
+VAR i: CARDINAL ;
+BEGIN
+  IF n >= 64 THEN
+    RETURN 0 ;
+  END ;
+  FOR i := 1 TO n DO
+    u := u * 2 ;
+  END ;
+  RETURN u ;
+END Shl64 ;
+
+PROCEDURE ShrLog (u: LONGCARD; n: CARDINAL) : LONGCARD ;
+VAR i: CARDINAL ;
+BEGIN
+  IF n >= 64 THEN
+    RETURN 0 ;
+  END ;
+  FOR i := 1 TO n DO
+    u := u DIV 2 ;
+  END ;
+  RETURN u ;
+END ShrLog ;
+
+PROCEDURE Mul64 (a, b: LONGCARD) : LONGCARD ;
+VAR ah, al, bh, bl, lolo, mid: LONGCARD ;
+BEGIN
+  ah := a DIV 4294967296 ;
+  al := a MOD 4294967296 ;
+  bh := b DIV 4294967296 ;
+  bl := b MOD 4294967296 ;
+  lolo := al * bl ;
+  mid := VAL (LONGCARD, VAL (CARDINAL, ah * bl + al * bh)) ;
+  RETURN lolo + mid * 4294967296 ;
+END Mul64 ;
+
+PROCEDURE Low32 (u: LONGCARD) : CARDINAL ;
+BEGIN
+  RETURN VAL (CARDINAL, u) ;
+END Low32 ;
+
+PROCEDURE BitOp (a, b: LONGCARD; mode: CARDINAL) : LONGCARD ;
+VAR res, m: LONGCARD ; p: CARDINAL ; ba, bb: CARDINAL ;
+BEGIN
+  res := 0 ;
+  m := 1 ;
+  FOR p := 0 TO 63 DO
+    ba := VAL (CARDINAL, (a DIV m) MOD 2) ;
+    bb := VAL (CARDINAL, (b DIV m) MOD 2) ;
+    IF mode = 0 THEN  (* AND *)
+      IF (ba = 1) AND (bb = 1) THEN res := res + m END ;
+    ELSIF mode = 1 THEN  (* OR *)
+      IF (ba = 1) OR (bb = 1) THEN res := res + m END ;
+    ELSE  (* XOR *)
+      IF ba # bb THEN res := res + m END ;
+    END ;
+    m := m * 2 ;
+  END ;
+  RETURN res ;
+END BitOp ;
+
+PROCEDURE ReadLine (dst: LONGCARD) ;
+(* SYSTEM service 2 : read one line from the host standard input.
+   Characters up to (but not including) the line mark, or end of input,
+   are stored at dst; a NUL terminator is appended and the VM stack
+   receives the number of bytes read (excluding the terminator).
+   An empty line or immediate end of input yields 0. *)
+VAR p: LONGCARD ; ch: CHAR ; res: ReadResults ;
+    done, over: BOOLEAN ;
+BEGIN
+  p := dst ;
+  done := FALSE ;
+  over := FALSE ;
+  WHILE NOT done DO
+    Look (StdInChan (), ch, res) ;
+    IF res = endOfInput THEN
+      done := TRUE ;
+    ELSIF res = endOfLine THEN
+      Skip (StdInChan ()) ;
+      done := TRUE ;
+    ELSIF over THEN
+      Skip (StdInChan ()) ;
+    ELSIF p >= VAL (LONGCARD, MaxMem) THEN
+      over := TRUE ;
+    ELSE
+      WriteByte (p, ORD (ch)) ;
+      p := p + 1 ;
+      Skip (StdInChan ()) ;
+    END ;
+  END ;
+  IF p < VAL (LONGCARD, MaxMem) THEN
+    WriteByte (p, 0) ;
+    p := p + 1 ;
+  END ;
+  Push (p - dst - 1) ;
+END ReadLine ;
+
+PROCEDURE Service (id, param: LONGCARD) ;
+VAR c: CARDINAL ; p: LONGCARD ;
+BEGIN
+  CASE id OF
+  | 0 :  (* EXIT *)
+      RETURN ;
+  | 1 :  (* write NUL-terminated string at param *)
+      p := param ;
+      c := ReadByte (p) ;
+      WHILE c # 0 DO
+        WriteChar (CHR (c)) ;
+        p := p + 1 ;
+        c := ReadByte (p) ;
+      END ;
+  | 2 :  (* read line into buffer at param *)
+        ReadLine (param) ;
+  ELSE
+      Fatal ("system: unknown service") ;
+  END ;
+END Service ;
+
+PROCEDURE Run ;
+VAR opc, n, m, tm, lo, hi, nw: CARDINAL ;
+    v, w, a, b, p, q, sz, sz2, ssz, t, off, cell, loww, highw, last,
+    st, dv, src, dst, first, eot, np, rel, md: LONGCARD ;
+    sgn: LONGINT ;
+    gl, bl: LONGINT ;
+    r1, r2: REAL ;
+    i64: LONGCARD ;
+    i: LONGCARD ;
+    done: BOOLEAN ;
+BEGIN
+  done := FALSE ;
+  LOOP
+    opc := Fetch () ;
+    CASE opc OF
+    | 00H :  (* reserved -> IllegalInstruction *)
+        Fatal ("illegal instruction 00H") ;
+    | 01H :  (* RAISE : unimplemented *)
+        Fatal ("RAISE unimplemented") ;
+    | 02H :  (* load_proc_addr u8 *)
+        n := Fetch () ;
+        Push (ProcedureAddress (GetCurrentModule (), n)) ;
+    | 03H .. 07H :  (* load_param n : push FP[op] for params 1..5 *)
+        Push (ReadSlot (GetFP () + VAL (LONGCARD, opc) * 8)) ;
+    | 08H :  (* load_local_dw i8 *)
+        Push (ReadSlot (GetFP () + VAL (LONGCARD, FetchSignedByte ()) * 8)) ;
+    | 09H :  (* load_global_dw u8 *)
+        Push (ReadSlot (GetGP () + VAL (LONGCARD, Fetch ()) * 8)) ;
+    | 0AH :  (* load_stack_dw u8 *)
+        p := Pop () ;
+        Push (ReadSlot (p + VAL (LONGCARD, Fetch ()) * 8)) ;
+    | 0BH :  (* load_extern_dw mod,var *)
+        m := Fetch () ;
+        Push (ReadSlot (GetModuleBase (m) + VAL (LONGCARD, Fetch ()) * 8)) ;
+    | 0CH :  (* load_extern_w nibble *)
+        nw := Fetch () ;
+        Push (ReadSlot (GetModuleBase (nw DIV 16) + VAL (LONGCARD, nw MOD 16) * 8)) ;
+    | 0DH :  (* load_indexed_byte *)
+        v := Pop () ; p := Pop () ;
+        Push (VAL (LONGCARD, ReadByte (p + v))) ;
+    | 0EH :  (* load_indexed_w *)
+        v := Pop () ; p := Pop () ;
+        Push (ReadSlot (p + v * 8)) ;
+    | 0FH :  (* load_indexed_q *)
+        v := Pop () ; p := Pop () ;
+        Push (ReadSlot (p + v * 8 + 8)) ;
+        Push (ReadSlot (p + v * 8)) ;
+    | 10H :  (* load_outer : push enclosing frame pointer *)
+        Push (GetOFP ()) ;
+    | 11H :  (* load_outer_n u8 : walk the display *)
+        np := Fetch () ;
+        p := GetOFP () ;
+        i := 0 ;
+        WHILE i < VAL (LONGCARD, np) DO
+          p := ReadSlot (p) ;
+          i := i + 1 ;
+        END ;
+        Push (p) ;
+    | 12H :  (* LONGREAL/quad sub-opcode dispatch ... *)
+        nw := Fetch () ;
+        CASE nw OF
+        | 0 :  (* load_local_q i8 *)
+            sgn := VAL (LONGINT, FetchSignedByte ()) ;
+            Push (ReadSlot (GetFP () + (VAL (LONGCARD, sgn) + 1) * 8)) ;
+            Push (ReadSlot (GetFP () + VAL (LONGCARD, sgn) * 8)) ;
+        | 1 :  (* load_global_q u8 *)
+            n := Fetch () ;
+            Push (ReadSlot (GetGP () + (VAL (LONGCARD, n) + 1) * 8)) ;
+            Push (ReadSlot (GetGP () + VAL (LONGCARD, n) * 8)) ;
+        | 2 :  (* load_i_q u8 *)
+            n := Fetch () ;
+            p := Pop () ;
+            Push (ReadSlot (p + (VAL (LONGCARD, n) + 1) * 8)) ;
+            Push (ReadSlot (p + VAL (LONGCARD, n) * 8)) ;
+        | 3 :  (* load_extern_q mod,var *)
+            m := Fetch () ;
+            n := Fetch () ;
+            Push (ReadSlot (GetModuleBase (m) + (VAL (LONGCARD, n) + 1) * 8)) ;
+            Push (ReadSlot (GetModuleBase (m) + VAL (LONGCARD, n) * 8)) ;
+        | 4 :  (* store_local_q i8 *)
+            sgn := VAL (LONGINT, FetchSignedByte ()) ;
+            loww := Pop () ; a := Pop () ;
+            WriteSlot (GetFP () + VAL (LONGCARD, sgn) * 8, loww) ;
+            WriteSlot (GetFP () + (VAL (LONGCARD, sgn) + 1) * 8, a) ;
+        | 5 :  (* store_global_q u8 *)
+            n := Fetch () ;
+            q := Pop () ;
+            WriteSlot (GetGP () + VAL (LONGCARD, n) * 8, q) ;
+            q := Pop () ;
+            WriteSlot (GetGP () + (VAL (LONGCARD, n) + 1) * 8, q) ;
+        | 6 :  (* store_i_q u8 *)
+            n := Fetch () ;
+            p := Pop () ;
+            q := Pop () ;
+            WriteSlot (p + VAL (LONGCARD, n) * 8, q) ;
+            q := Pop () ;
+            WriteSlot (p + (VAL (LONGCARD, n) + 1) * 8, q) ;
+        | 7 :  (* store_extern_q mod,var *)
+            m := Fetch () ;
+            n := Fetch () ;
+            q := Pop () ;
+            WriteSlot (GetModuleBase (m) + VAL (LONGCARD, n) * 8, q) ;
+            q := Pop () ;
+            WriteSlot (GetModuleBase (m) + (VAL (LONGCARD, n) + 1) * 8, q) ;
+        | 8 :  (* load_indexed_q *)
+            v := Pop () ; p := Pop () ;
+            Push (ReadSlot (p + v * 8 + 8)) ;
+            Push (ReadSlot (p + v * 8)) ;
+        | 9 :  (* store_indexed_q *)
+            loww := Pop () ; a := Pop () ; v := Pop () ; p := Pop () ;
+            WriteSlot (p + v * 8, loww) ;
+            WriteSlot (p + v * 8 + 8, a) ;
+        | 0AH :  (* quad_fct_leave u8 *)
+            n := Fetch () ;
+            q := Pop () ;
+            Leave (n) ;
+            Push (q) ;
+        ELSE
+            Fatal ("quad sub-opcode illegal") ;
+        END ;  (* inner CASE *)
+    | 13H .. 17H :  (* store_param n : FP[op] := value *)
+        WriteSlot (GetFP () + VAL (LONGCARD, opc) * 8, Pop ()) ;
+    | 18H :  (* store_local_dw i8 *)
+        WriteSlot (GetFP () + VAL (LONGCARD, FetchSignedByte ()) * 8, Pop ()) ;
+    | 19H :  (* store_global_dw u8 *)
+        WriteSlot (GetGP () + VAL (LONGCARD, Fetch ()) * 8, Pop ()) ;
+    | 1AH :  (* store_stack_dw u8 *)
+        p := Pop () ;
+        WriteSlot (p + VAL (LONGCARD, Fetch ()) * 8, Pop ()) ;
+    | 1BH :  (* store_extern_dw mod,var *)
+        m := Fetch () ;
+        WriteSlot (GetModuleBase (m) + VAL (LONGCARD, Fetch ()) * 8, Pop ()) ;
+    | 1CH :  (* store_extern_w nibble *)
+        nw := Fetch () ;
+        WriteSlot (GetModuleBase (nw DIV 16) + VAL (LONGCARD, nw MOD 16) * 8, Pop ()) ;
+    | 1DH :  (* store_indexed_byte *)
+        v := Pop () ; i64 := Pop () ; p := Pop () ;
+        WriteByte (p + i64, Low32 (v)) ;
+    | 1EH :  (* store_indexed_w *)
+        v := Pop () ; i64 := Pop () ; p := Pop () ;
+        WriteSlot (p + i64 * 8, v) ;
+    | 1FH :  (* store_indexed_q *)
+        loww := Pop () ; a := Pop () ; i64 := Pop () ; p := Pop () ;
+        WriteSlot (p + i64 * 8, loww) ;
+        WriteSlot (p + i64 * 8 + 8, a) ;
+
+    | 20H :  (* dup *)
+        v := Pop () ;
+        Push (v) ; Push (v) ;
+    | 21H :  (* swap *)
+        a := Pop () ; b := Pop () ;
+        Push (a) ; Push (b) ;
+    | 22H .. 2BH :  (* load_local_n *)
+        Push (ReadSlot (GetFP () - VAL (LONGCARD, opc MOD 16) * 8)) ;
+    | 2CH :  (* load_local i8 *)
+        Push (ReadSlot (GetFP () + VAL (LONGCARD, FetchSignedByte ()) * 8)) ;
+    | 2DH :  (* load_global u8 *)
+        Push (ReadSlot (GetGP () + VAL (LONGCARD, Fetch ()) * 8)) ;
+    | 2EH :  (* load_stack u8 *)
+        p := Pop () ;
+        Push (ReadSlot (p + VAL (LONGCARD, Fetch ()) * 8)) ;
+    | 2FH :  (* load_extern mod,var *)
+        m := Fetch () ;
+        Push (ReadSlot (GetModuleBase (m) + VAL (LONGCARD, Fetch ()) * 8)) ;
+    | 30H :  (* copy_block *)
+        sz := Pop () ; src := Pop () ; dst := Pop () ;
+        CopyBytes (src, dst, sz) ;
+    | 31H :  (* copy_string *)
+        ssz := Pop () ; sz := Pop () ; src := Pop () ; dst := Pop () ;
+        n := 0 ;
+        np := 0 ;
+        WHILE np < sz DO
+          IF ReadByte (src + np) = 0 THEN EXIT END ;
+          IF np >= ssz THEN EXIT END ;
+          WriteByte (dst + np, ReadByte (src + np)) ;
+          np := np + 1 ;
+        END ;
+    | 32H .. 3BH :  (* store_local_n *)
+        WriteSlot (GetFP () - VAL (LONGCARD, opc MOD 16) * 8, Pop ()) ;
+    | 3CH :  (* store_local i8 *)
+        WriteSlot (GetFP () + VAL (LONGCARD, FetchSignedByte ()) * 8, Pop ()) ;
+    | 3DH :  (* store_global u8 *)
+        WriteSlot (GetGP () + VAL (LONGCARD, Fetch ()) * 8, Pop ()) ;
+    | 3EH :  (* store_stack u8 *)
+        p := Pop () ;
+        WriteSlot (p + VAL (LONGCARD, Fetch ()) * 8, Pop ()) ;
+    | 3FH :  (* store_extern mod,var *)
+        m := Fetch () ;
+        WriteSlot (GetModuleBase (m) + VAL (LONGCARD, Fetch ()) * 8, Pop ()) ;
+
+    | 40H :
+        Execute () ;
+    | 41H :  (* load_stack_d0 *)
+        p := Pop () ;
+        Push (ReadSlot (p)) ;
+    | 42H .. 4FH :  (* load_global_n *)
+        Push (ReadSlot (GetGP () + VAL (LONGCARD, opc MOD 16) * 8)) ;
+    | 50H :  (* end_program *)
+        RETURN ;
+    | 51H :  (* store_stack_d0 *)
+        p := Pop () ;
+        WriteSlot (p, Pop ()) ;
+    | 52H .. 5FH :  (* store_global_n *)
+        WriteSlot (GetGP () + VAL (LONGCARD, opc MOD 16) * 8, Pop ()) ;
+
+    | 60H .. 6FH :  (* load_i_n *)
+        p := Pop () ;
+        Push (ReadSlot (p + VAL (LONGCARD, opc MOD 16) * 8)) ;
+    | 70H .. 7FH :  (* store_i_n *)
+        v := Pop () ; p := Pop () ;
+        WriteSlot (p + VAL (LONGCARD, opc MOD 16) * 8, v) ;
+
+    | 80H :  (* load_local_addr i8 *)
+        Push (GetFP () + VAL (LONGCARD, FetchSignedByte ()) * 8) ;
+    | 81H :  (* load_global_addr u8 *)
+        Push (GetGP () + VAL (LONGCARD, Fetch ()) * 8) ;
+    | 82H :  (* load_stack_addr u8 *)
+        p := Pop () ;
+        Push (p + VAL (LONGCARD, Fetch ()) * 8) ;
+    | 83H :  (* load_extern_addr mod,var *)
+        m := Fetch () ;
+        Push (GetModuleBase (m) + VAL (LONGCARD, Fetch ()) * 8) ;
+    | 84H :  (* proc_leave *)
+        Leave (Fetch ()) ;
+    | 85H :  (* fct_leave *)
+        v := Pop () ;
+        Leave (Fetch ()) ;
+        Push (v) ;
+    | 86H :  (* longfct_leave *)
+        q := Pop () ;
+        Leave (Fetch ()) ;
+        Push (q) ;
+    | 87H :  (* asmcode *)
+        Fatal ("asmcode unimplemented") ;
+    | 88H .. 8BH :  (* leave 0..3, outer return *)
+        Leave (128 + (opc MOD 4)) ;
+    | 8CH :  (* call_rel u8 *)
+        LoadString (Fetch ()) ;
+    | 8DH :  (* load_imm_byte *)
+        Push (VAL (LONGCARD, Fetch ())) ;
+    | 8EH :  (* load_imm_word u64 *)
+        Push (FetchQuad ()) ;
+    | 8FH :  (* load_imm_quad (16 bytes) : high word first, low on top *)
+        a := FetchQuad () ;
+        b := FetchQuad () ;
+        Push (a) ; Push (b) ;
+    | 90H .. 9FH :  (* load_imm 0..15 *)
+        Push (VAL (LONGCARD, opc MOD 16)) ;
+
+    | 0A0H :  (* equal *)
+        b := Pop () ; a := Pop () ;
+        PushBool (a = b) ;
+    | 0A1H :  (* not_equal *)
+        b := Pop () ; a := Pop () ;
+        PushBool (a # b) ;
+    | 0A2H :  (* uless *)
+        b := Pop () ; a := Pop () ;
+        PushBool (Low32 (a) < Low32 (b)) ;
+    | 0A3H :  (* ugreater *)
+        b := Pop () ; a := Pop () ;
+        PushBool (Low32 (a) > Low32 (b)) ;
+    | 0A4H :  (* uless_eq *)
+        b := Pop () ; a := Pop () ;
+        PushBool (Low32 (a) <= Low32 (b)) ;
+    | 0A5H :  (* ugreater_eq *)
+        b := Pop () ; a := Pop () ;
+        PushBool (Low32 (a) >= Low32 (b)) ;
+    | 0A6H :  (* add (CARDINAL mod 2^32) *)
+        b := Pop () ; a := Pop () ;
+        Push (VAL (LONGCARD, Low32 (a) + Low32 (b))) ;
+    | 0A7H :  (* sub *)
+        b := Pop () ; a := Pop () ;
+        Push (VAL (LONGCARD, Low32 (a) - Low32 (b))) ;
+    | 0A8H :  (* umul *)
+        b := Pop () ; a := Pop () ;
+        Push (VAL (LONGCARD, Low32 (a) * Low32 (b))) ;
+    | 0A9H :  (* udiv *)
+        b := Pop () ; a := Pop () ;
+        IF Low32 (b) = 0 THEN Fatal ("divide by zero") END ;
+        Push (VAL (LONGCARD, Low32 (a) DIV Low32 (b))) ;
+    | 0AAH :  (* umod *)
+        b := Pop () ; a := Pop () ;
+        IF Low32 (b) = 0 THEN Fatal ("divide by zero") END ;
+        Push (VAL (LONGCARD, Low32 (a) MOD Low32 (b))) ;
+    | 0ABH :  (* eq0 *)
+        PushBool (Pop () = 0) ;
+    | 0ACH :  (* inc *)
+        Push (VAL (LONGCARD, Low32 (Pop ()) + 1)) ;
+    | 0ADH :  (* dec *)
+        Push (VAL (LONGCARD, Low32 (Pop ()) - 1)) ;
+    | 0AEH :  (* add_imm u8 *)
+        Push (VAL (LONGCARD, Low32 (Pop ()) + Fetch ())) ;
+    | 0AFH :  (* sub_imm u8 *)
+        Push (VAL (LONGCARD, Low32 (Pop ()) - Fetch ())) ;
+    | 0B0H :  (* shl_imm u8 *)
+        n := Fetch () ;
+        v := Pop () ;
+        IF n >= 32 THEN
+          Push (0) ;
+        ELSE
+          Push (VAL (LONGCARD, Low32 (v) * VAL (CARDINAL, Shl64 (1, n)))) ;
+        END ;
+    | 0B1H :  (* shr_imm *)
+        n := Fetch () ;
+        v := Pop () ;
+        IF n >= 32 THEN
+          Push (0) ;
+        ELSE
+          Push (VAL (LONGCARD, Low32 (v) DIV VAL (CARDINAL, Shl64 (1, n)))) ;
+        END ;
+    | 0B2H :  (* iless *)
+        b := Pop () ; a := Pop () ;
+        PushBool (VAL (INTEGER, Low32 (a)) < VAL (INTEGER, Low32 (b))) ;
+    | 0B3H :  (* igreater *)
+        b := Pop () ; a := Pop () ;
+        PushBool (VAL (INTEGER, Low32 (a)) > VAL (INTEGER, Low32 (b))) ;
+    | 0B4H :  (* iless_eq *)
+        b := Pop () ; a := Pop () ;
+        PushBool (VAL (INTEGER, Low32 (a)) <= VAL (INTEGER, Low32 (b))) ;
+    | 0B5H :  (* igreater_eq *)
+        b := Pop () ; a := Pop () ;
+        PushBool (VAL (INTEGER, Low32 (a)) >= VAL (INTEGER, Low32 (b))) ;
+    | 0B6H :  (* not *)
+        PushBool (NOT PopBool ()) ;
+    | 0B7H :  (* complement (32-bit ~) *)
+        Push (VAL (LONGCARD, 0FFFFFFFFH - Low32 (Pop ()))) ;
+    | 0B8H :  (* imul (INTEGER mod 2^32) *)
+        b := Pop () ; a := Pop () ;
+        Push (VAL (LONGCARD, Low32 (a) * Low32 (b))) ;
+    | 0B9H :  (* idiv *)
+        b := Pop () ; a := Pop () ;
+        IF Low32 (b) = 0 THEN Fatal ("divide by zero") END ;
+        Push (VAL (LONGCARD, VAL (INTEGER, Low32 (a)) DIV VAL (INTEGER, Low32 (b)))) ;
+    | 0BAH :  (* long_to_card *)
+        Push (VAL (LONGCARD, Low32 (Pop ()))) ;
+    | 0BBH :  (* long_to_int *)
+        v := Pop () ;
+        Push (VAL (LONGCARD, VAL (INTEGER, Low32 (v)))) ;
+    | 0BCH :  (* abs *)
+        v := Pop () ;
+        IF VAL (INTEGER, Low32 (v)) < 0 THEN
+          Push (VAL (LONGCARD, 0 - VAL (INTEGER, Low32 (v)))) ;
+        ELSE
+          Push (v) ;
+        END ;
+    | 0BDH :  (* int_to_long *)
+        Push (VAL (LONGCARD, VAL (INTEGER, Low32 (Pop ())))) ;
+    | 0BEH :  (* long_to_real *)
+        PushReal (FLOAT (VAL (LONGINT, Pop ()))) ;
+    | 0BFH :  (* real_to_long *)
+        Push (VAL (LONGCARD, VAL (INTEGER, TRUNC (PopReal ())))) ;
+
+    | 0C0H :  (* uadd_checked *)
+        b := Pop () ; a := Pop () ;
+        IF Low32 (a) + Low32 (b) < Low32 (a) THEN Fatal ("overflow") END ;
+        Push (VAL (LONGCARD, Low32 (a) + Low32 (b))) ;
+    | 0C1H :  (* usub_checked *)
+        b := Pop () ; a := Pop () ;
+        IF Low32 (a) < Low32 (b) THEN Fatal ("overflow") END ;
+        Push (VAL (LONGCARD, Low32 (a) - Low32 (b))) ;
+    | 0C2H :  (* umul_checked *)
+        b := Pop () ; a := Pop () ;
+        w := VAL (LONGCARD, Low32 (a)) * VAL (LONGCARD, Low32 (b)) ;
+        IF w > 0FFFFFFFFH THEN Fatal ("overflow") END ;
+        Push (VAL (LONGCARD, Low32 (a) * Low32 (b))) ;
+    | 0C3H :  (* system host call *)
+        v := Pop () ;
+        Service (v, Pop ()) ;
+    | 0C4H :  (* string_comp *)
+        ssz := Pop () ; sz := Pop () ; src := Pop () ; dst := Pop () ;
+        np := 0 ;
+        last := 0 ;
+        done := FALSE ;
+        WHILE NOT done DO
+          IF (np >= sz) OR (np >= ssz) THEN done := TRUE
+          ELSIF ReadByte (src + np) = 0 THEN done := TRUE
+          ELSIF ReadByte (src + np) > ReadByte (dst + np) THEN
+            last := 1 ; done := TRUE
+          ELSIF ReadByte (src + np) < ReadByte (dst + np) THEN
+            last := 2 ; done := TRUE
+          ELSE
+            np := np + 1 ;
+          END ;
+        END ;
+        IF last = 1 THEN
+          Push (1) ; Push (0) ;
+        ELSIF last = 2 THEN
+          Push (0) ; Push (1) ;
+        ELSE
+          Push (0) ; Push (0) ;
+        END ;
+    | 0C5H :  (* long_compare : push (a>b) then (a<b) *)
+        b := Pop () ; a := Pop () ;
+        gl := VAL (LONGINT, a) ; bl := VAL (LONGINT, b) ;
+        IF gl > bl THEN Push (1) ELSE Push (0) END ;
+        IF gl < bl THEN Push (1) ELSE Push (0) END ;
+    | 0C6H :  (* long_add *)
+        b := Pop () ; a := Pop () ;
+        Push (a + b) ;
+    | 0C7H :  (* long_sub *)
+        b := Pop () ; a := Pop () ;
+        Push (a - b) ;
+    | 0C8H :  (* long_mul *)
+        b := Pop () ; a := Pop () ;
+        Push (Mul64 (a, b)) ;
+    | 0C9H :  (* long_div *)
+        b := Pop () ; a := Pop () ;
+        IF b = 0 THEN Fatal ("divide by zero") END ;
+        Push (VAL (LONGCARD, VAL (LONGINT, a) DIV VAL (LONGINT, b))) ;
+    | 0CAH :  (* long_mod *)
+        b := Pop () ; a := Pop () ;
+        IF b = 0 THEN Fatal ("divide by zero") END ;
+        Push (VAL (LONGCARD, VAL (LONGINT, a) MOD VAL (LONGINT, b))) ;
+    | 0CBH :  (* not_zero *)
+        PushBool (Pop () # 0) ;
+    | 0CCH :  (* long_abs *)
+        v := Pop () ;
+        IF VAL (LONGINT, v) < 0 THEN
+          Push (0 - v) ;
+        ELSE
+          Push (v) ;
+        END ;
+    | 0CDH :  (* switch *)
+        v := Pop () ;
+        loww := FetchQuad () ;
+        highw := FetchQuad () ;
+        t := FetchQuad () ;  (* retOffset, must be 0 *)
+        first := GetIP () ;
+        eot := first + (highw - loww + 1) * 8 ;
+        IF (v < loww) OR (v > highw) THEN
+          SetIP (eot) ;
+        ELSE
+          cell := first + (v - loww) * 8 ;
+          off := ReadSlot (cell) ;
+          IF VAL (LONGINT, off) < 0 THEN
+            Push (eot + t) ;
+          END ;
+          SetIP (cell + 8 + off) ;
+        END ;
+    | 0CEH :  (* jump_stack : computed jump *)
+        SetIP (Pop ()) ;
+    | 0CFH :  (* push_code_addr u64 *)
+        off := FetchQuad () ;
+        Push (GetIP () - 1 + off) ;
+    | 0D0H :  (* iadd_checked *)
+        b := Pop () ; a := Pop () ;
+        tm := VAL (INTEGER, Low32 (a)) + VAL (INTEGER, Low32 (b)) ;
+        IF ((VAL (INTEGER, Low32 (a)) > 0) AND (VAL (INTEGER, Low32 (b)) > 0)
+            AND (tm < 0)) OR
+           ((VAL (INTEGER, Low32 (a)) < 0) AND (VAL (INTEGER, Low32 (b)) < 0)
+            AND (tm >= 0)) THEN
+          Fatal ("overflow") ;
+        END ;
+        Push (VAL (LONGCARD, tm)) ;
+    | 0D1H :  (* isub_checked *)
+        b := Pop () ; a := Pop () ;
+        tm := VAL (INTEGER, Low32 (a)) - VAL (INTEGER, Low32 (b)) ;
+        IF ((VAL (INTEGER, Low32 (a)) > 0) AND (VAL (INTEGER, Low32 (b)) < 0)
+            AND (tm < 0)) OR
+           ((VAL (INTEGER, Low32 (a)) < 0) AND (VAL (INTEGER, Low32 (b)) > 0)
+            AND (tm >= 0)) THEN
+          Fatal ("overflow") ;
+        END ;
+        Push (VAL (LONGCARD, tm)) ;
+    | 0D2H :  (* reserve *)
+        sz := Pop () ;
+        IF GetSP () < sz THEN Fatal ("stack overflow") END ;
+        SetSP (GetSP () - sz) ;
+        Push (GetSP ()) ;
+    | 0D3H :  (* reserve_string *)
+        st := Pop () ;
+        sz := Pop () ;
+        nw := VAL (CARDINAL, (sz + 7) DIV 8) ;
+        dst := GetSP () - VAL (LONGCARD, nw) * 8 ;
+        SetSP (dst) ;
+        i := 0 ;
+        WHILE i < VAL (LONGCARD, nw) DO
+          WriteSlot (dst + i * 8, ReadSlot (st + i * 8)) ;
+          i := i + 1 ;
+        END ;
+        Push (dst) ;
+    | 0D4H :  (* enter u8 *)
+        Enter (Fetch ()) ;
+    | 0D5H :  (* real_compare *)
+        r2 := PopReal () ; r1 := PopReal () ;
+        IF r1 > r2 THEN Push (1) ELSE Push (0) END ;
+        IF r1 < r2 THEN Push (1) ELSE Push (0) END ;
+    | 0D6H :  (* real_add *)
+        r2 := PopReal () ; r1 := PopReal () ;
+        PushReal (r1 + r2) ;
+    | 0D7H :  (* real_sub *)
+        r2 := PopReal () ; r1 := PopReal () ;
+        PushReal (r1 - r2) ;
+    | 0D8H :  (* real_mul *)
+        r2 := PopReal () ; r1 := PopReal () ;
+        PushReal (r1 * r2) ;
+    | 0D9H :  (* real_div *)
+        r2 := PopReal () ; r1 := PopReal () ;
+        PushReal (r1 / r2) ;
+    | 0DAH :  (* urange_check *)
+        sz := Pop () ; loww := Pop () ; v := Pop () ;
+        IF (v < loww) OR (v >= loww + sz) THEN Fatal ("range error") END ;
+    | 0DBH :  (* irange_check *)
+        sz := Pop () ; loww := Pop () ; v := Pop () ;
+        IF (VAL (INTEGER, Low32 (v)) < VAL (INTEGER, Low32 (loww))) OR
+           (VAL (INTEGER, Low32 (v)) >=
+            VAL (INTEGER, Low32 (loww)) + VAL (INTEGER, Low32 (sz))) THEN
+          Fatal ("range error") ;
+        END ;
+    | 0DCH :  (* limit_check u8 *)
+        n := Fetch () ;
+        v := Pop () ; Push (v) ;
+        IF v > VAL (LONGCARD, n) THEN Fatal ("range error") END ;
+    | 0DDH :  (* check_positive *)
+        v := Pop () ; Push (v) ;
+        IF VAL (INTEGER, Low32 (v)) < 0 THEN Fatal ("range error") END ;
+    | 0DEH :  (* and_jp u8 *)
+        n := Fetch () ;
+        IF NOT PopBool () THEN
+          Push (0) ;
+          SetIP (GetIP () + VAL (LONGCARD, n)) ;
+        END ;
+    | 0DFH :  (* or_jp u8 *)
+        n := Fetch () ;
+        IF PopBool () THEN
+          Push (1) ;
+          SetIP (GetIP () + VAL (LONGCARD, n)) ;
+        END ;
+
+    | 0E0H :  (* jp i64 *)
+        rel := FetchQuad () ;
+        SetIP (GetIP () + rel) ;
+    | 0E1H :  (* jpfalse i64 *)
+        rel := FetchQuad () ;
+        IF NOT PopBool () THEN
+          SetIP (GetIP () + rel) ;
+        END ;
+    | 0E2H :  (* jp_fwd i8 *)
+        SetIP (GetIP () + VAL (LONGCARD, FetchSignedByte ())) ;
+    | 0E3H :  (* jpfalse_fwd i8 *)
+        n := FetchSignedByte () ;
+        IF NOT PopBool () THEN
+          SetIP (GetIP () + VAL (LONGCARD, n)) ;
+        END ;
+    | 0E4H :  (* jp_back u8 *)
+        SetIP (GetIP () - VAL (LONGCARD, Fetch ())) ;
+    | 0E5H :  (* jpfalse_back u8 *)
+        n := Fetch () ;
+        IF NOT PopBool () THEN
+          SetIP (GetIP () - VAL (LONGCARD, n)) ;
+        END ;
+    | 0E6H :  (* bit_or *)
+        b := Pop () ; a := Pop () ;
+        Push (BitOp (a, b, 1)) ;
+    | 0E7H :  (* bit_in *)
+        b := Pop () ; a := Pop () ;
+        IF b < 64 THEN
+          PushBool (BitOp (a, Shl64 (1, VAL (CARDINAL, b)), 0) # 0) ;
+        ELSE
+          Push (0) ;
+        END ;
+    | 0E8H :  (* bit_and *)
+        b := Pop () ; a := Pop () ;
+        Push (BitOp (a, b, 0)) ;
+    | 0E9H :  (* bit_xor (OR minus AND) *)
+        b := Pop () ; a := Pop () ;
+        Push (BitOp (a, b, 2)) ;
+    | 0EAH :  (* power2 *)
+        v := Pop () ;
+        Push (Shl64 (1, VAL (CARDINAL, v) MOD 64)) ;
+    | 0EBH :  (* extern_proc_call *)
+        v := Pop () ;
+        p := Pop () ;
+        SetOFP (GetGP ()) ;
+        SetGP (p) ;
+        SetCurrentModule (FindModuleByBase (p)) ;
+        Push (GetIP ()) ;
+        SetIP (v) ;
+    | 0ECH :  (* nested_call u8 *)
+        n := Fetch () ;
+        SetOFP (GetFP ()) ;
+        Push (GetIP ()) ;
+        SetIP (ProcedureAddress (GetCurrentModule (), n)) ;
+    | 0EDH :  (* proc_call u8 *)
+        n := Fetch () ;
+        SetOFP (0) ;
+        Push (GetIP ()) ;
+        SetIP (ProcedureAddress (GetCurrentModule (), n)) ;
+    | 0EEH :  (* call_with_frame u8 *)
+        p := Pop () ;
+        n := Fetch () ;
+        SetOFP (p) ;
+        Push (GetIP ()) ;
+        SetIP (ProcedureAddress (GetCurrentModule (), n)) ;
+    | 0EFH :  (* extern_call mod,proc *)
+        m := Fetch () ;
+        n := Fetch () ;
+        SetOFP (GetGP ()) ;
+        SetGP (GetModuleBase (m)) ;
+        SetCurrentModule (m) ;
+        Push (GetIP ()) ;
+        SetIP (ProcedureAddress (m, n)) ;
+    | 0F0H :  (* extern_call_nib nibble *)
+        nw := Fetch () ;
+        m := nw DIV 16 ;
+        n := nw MOD 16 ;
+        SetOFP (GetGP ()) ;
+        SetGP (GetModuleBase (m)) ;
+        SetCurrentModule (m) ;
+        Push (GetIP ()) ;
+        SetIP (ProcedureAddress (m, n)) ;
+    | 0F1H .. 0FFH :  (* call 1..15 *)
+        SetOFP (0) ;
+        Push (GetIP ()) ;
+        SetIP (ProcedureAddress (GetCurrentModule (), opc MOD 16)) ;
+    ELSE
+        Fatal ("internal: opcode not handled") ;
+    END ;  (* CASE *)
+  END ;  (* LOOP *)
+END Run ;
+
+END Interpreter.

Loader2.def

@@ -0,0 +1,10 @@
+DEFINITION MODULE Loader2 ;
+
+(* MC64 loader: reads a .mc4 module file, maps it into the arena,
+   and runs the module initializer if flagged TOINIT. *)
+
+EXPORT QUALIFIED Call ;
+
+PROCEDURE Call (name: ARRAY OF CHAR) ;
+
+END Loader2.

Loader2.mod

@@ -0,0 +1,106 @@
+IMPLEMENTATION MODULE Loader2 ;
+
+FROM SYSTEM IMPORT ADR ;
+IMPORT FIO ;
+FROM FIO IMPORT OpenToRead, ReadNBytes, Close, IsNoError ;
+FROM Memory IMPORT ArenaBase, LoadImage, ReadByte, ReadWord, ReadSlot,
+  FillBytes, ReadLong ;
+FROM Global IMPORT SetModuleBase, SetModuleProcs, SetModuleFlag,
+  SetCurrentModule ;
+FROM Local IMPORT Init, SetGP, SetIP ;
+FROM Instruction IMPORT ProcedureAddress ;
+FROM Interpreter IMPORT Run ;
+FROM Console IMPORT Fatal ;
+
+CONST
+  HeaderSize = 64 ;
+  DescDeps = 0 ;
+  DescLink = 256 ;
+  DescName = 264 ;
+  DescLoadAddr = 280 ;
+  DescChecksum = 288 ;
+  DescFlags = 292 ;
+  DescVarCount = 293 ;
+  DescDepCount = 294 ;
+  DescPad = 295 ;
+  DescProcs = 296 ;
+  DescVarSizes = 304 ;
+
+VAR
+  buf : ARRAY [0 .. 65535] OF CHAR ;
+  f : FIO.File ;
+
+PROCEDURE Call (name: ARRAY OF CHAR) ;
+VAR
+  got : CARDINAL ;
+  i : CARDINAL ;
+  imgLen, desc, procsAbs, dataWin, vnext, sz : LONGCARD ;
+  chk, sum : CARDINAL ;
+  fl, vcnt, dcnt : CARDINAL ;
+  j : CARDINAL ;
+BEGIN
+  f := OpenToRead (name) ;
+  IF NOT IsNoError (f) THEN
+    Fatal ("loader: cannot open module file") ;
+  END ;
+  got := ReadNBytes (f, HIGH (buf) + 1, ADR (buf)) ;
+  Close (f) ;
+  IF got <= 64 THEN
+    Fatal ("loader: file too short") ;
+  END ;
+
+  imgLen := VAL (LONGCARD, got) - HeaderSize ;
+  desc := ArenaBase () ;
+  LoadImage (buf, HeaderSize, desc, got - HeaderSize) ;
+
+  dcnt := ReadByte (desc + VAL (LONGCARD, DescDepCount)) ;
+  IF dcnt # 0 THEN
+    Fatal ("loader: dependencies not supported yet") ;
+  END ;
+
+  chk := ReadLong (desc + VAL (LONGCARD, DescChecksum)) ;
+  sum := 0 ;
+  FOR i := HeaderSize TO got - 1 DO
+    IF NOT ((i >= 352) AND (i <= 355)) THEN
+      sum := sum + ORD (buf [i]) ;
+    END ;
+  END ;
+  IF chk # sum THEN
+    Fatal ("loader: checksum mismatch") ;
+  END ;
+
+  procsAbs := desc + ReadSlot (desc + VAL (LONGCARD, DescProcs)) ;
+  fl := ReadByte (desc + VAL (LONGCARD, DescFlags)) ;
+  vcnt := ReadByte (desc + VAL (LONGCARD, DescVarCount)) ;
+
+  dataWin := desc + imgLen ;
+  IF (dataWin MOD 8) # 0 THEN
+    dataWin := dataWin + 8 - (dataWin MOD 8) ;
+  END ;
+
+  vnext := dataWin ;
+  FOR j := 1 TO vcnt DO
+    sz := ReadSlot (desc + (VAL (LONGCARD, DescVarSizes) +
+                            (VAL (LONGCARD, j) - 1) * 8)) ;
+    IF (sz MOD 8) # 0 THEN
+      sz := sz + 8 - (sz MOD 8) ;
+    END ;
+    FillBytes (vnext, sz, 0) ;
+    vnext := vnext + sz ;
+  END ;
+
+  SetModuleBase (0, dataWin) ;
+  SetModuleProcs (0, procsAbs) ;
+  SetModuleFlag (0, fl) ;
+  SetCurrentModule (0) ;
+
+  Init () ;
+  SetGP (dataWin) ;
+
+  IF (fl DIV 4) MOD 2 # 0 THEN  (* TOINIT : run the module initializer *)
+    SetIP (ProcedureAddress (0, 0)) ;
+    Run () ;
+  END ;
+END Call ;
+
+END Loader2.

Local.def

@@ -0,0 +1,21 @@
+DEFINITION MODULE Local ;
+
+(* Machine registers of the MC64 virtual machine.  All are LONGCARD
+   offsets into the linear memory array. *)
+
+EXPORT QUALIFIED Init, GetSP, SetSP, GetFP, SetFP, GetGP, SetGP,
+  GetOFP, SetOFP, GetIP, SetIP ;
+
+PROCEDURE Init ;
+PROCEDURE GetSP () : LONGCARD ;
+PROCEDURE SetSP (v: LONGCARD) ;
+PROCEDURE GetFP () : LONGCARD ;
+PROCEDURE SetFP (v: LONGCARD) ;
+PROCEDURE GetGP () : LONGCARD ;
+PROCEDURE SetGP (v: LONGCARD) ;
+PROCEDURE GetOFP () : LONGCARD ;
+PROCEDURE SetOFP (v: LONGCARD) ;
+PROCEDURE GetIP () : LONGCARD ;
+PROCEDURE SetIP (v: LONGCARD) ;
+
+END Local.

Local.mod

@@ -0,0 +1,67 @@
+IMPLEMENTATION MODULE Local ;
+
+FROM Memory IMPORT TopOfMemory ;
+
+VAR
+  SP, FP, GP, OFP, IP : LONGCARD ;
+
+PROCEDURE Init ;
+BEGIN
+  SP := TopOfMemory () ;
+  FP := 0 ;
+  GP := 0 ;
+  OFP := 0 ;
+  IP := 0 ;
+END Init ;
+
+PROCEDURE GetSP () : LONGCARD ;
+BEGIN
+  RETURN SP ;
+END GetSP ;
+
+PROCEDURE SetSP (v: LONGCARD) ;
+BEGIN
+  SP := v ;
+END SetSP ;
+
+PROCEDURE GetFP () : LONGCARD ;
+BEGIN
+  RETURN FP ;
+END GetFP ;
+
+PROCEDURE SetFP (v: LONGCARD) ;
+BEGIN
+  FP := v ;
+END SetFP ;
+
+PROCEDURE GetGP () : LONGCARD ;
+BEGIN
+  RETURN GP ;
+END GetGP ;
+
+PROCEDURE SetGP (v: LONGCARD) ;
+BEGIN
+  GP := v ;
+END SetGP ;
+
+PROCEDURE GetOFP () : LONGCARD ;
+BEGIN
+  RETURN OFP ;
+END GetOFP ;
+
+PROCEDURE SetOFP (v: LONGCARD) ;
+BEGIN
+  OFP := v ;
+END SetOFP ;
+
+PROCEDURE GetIP () : LONGCARD ;
+BEGIN
+  RETURN IP ;
+END GetIP ;
+
+PROCEDURE SetIP (v: LONGCARD) ;
+BEGIN
+  IP := v ;
+END SetIP ;
+
+END Local.

MC64.mod

@@ -0,0 +1,14 @@
+MODULE MC64 ;
+
+FROM Memory IMPORT Init ;
+FROM Global IMPORT InitModuleTable ;
+FROM Loader2 IMPORT Call ;
+FROM Console IMPORT WriteString, WriteLn ;
+
+BEGIN
+  Init () ;
+  InitModuleTable () ;
+  Call ("boot.mc4") ;
+  WriteString ("[vm end]") ;
+  WriteLn ;
+END MC64.

Memory.def

@@ -0,0 +1,32 @@
+DEFINITION MODULE Memory ;
+
+(* MC64 virtual machine memory: a single linear byte array.
+   Machine addresses (IP, SP, FP, GP, OFP) are LONGCARD offsets
+   into this array.  No host allocation is performed. *)
+
+EXPORT QUALIFIED MaxMem, Init, ArenaBase, TopOfMemory, heapPointer,
+  ReadByte, WriteByte, ReadSlot, WriteSlot, ReadWord, WriteWord,
+  ReadLong, WriteLong, CopyBytes, FillBytes, LoadImage ;
+
+CONST MaxMem = 16777216 ;  (* 16 MiB *)
+
+VAR heapPointer: LONGCARD ;
+
+PROCEDURE Init ;
+PROCEDURE ArenaBase () : LONGCARD ;
+PROCEDURE TopOfMemory () : LONGCARD ;
+
+PROCEDURE ReadByte (a: LONGCARD) : CARDINAL ;
+PROCEDURE WriteByte (a: LONGCARD; b: CARDINAL) ;
+PROCEDURE ReadSlot (a: LONGCARD) : LONGCARD ;
+PROCEDURE WriteSlot (a: LONGCARD; v: LONGCARD) ;
+PROCEDURE ReadWord (a: LONGCARD) : CARDINAL ;
+PROCEDURE WriteWord (a: LONGCARD; v: CARDINAL) ;
+PROCEDURE ReadLong (a: LONGCARD) : LONGINT ;
+PROCEDURE WriteLong (a: LONGCARD; v: LONGINT) ;
+
+PROCEDURE CopyBytes (src, dst: LONGCARD; n: LONGCARD) ;
+PROCEDURE FillBytes (dst: LONGCARD; n: LONGCARD; b: CARDINAL) ;
+PROCEDURE LoadImage (VAR data: ARRAY OF CHAR; off: CARDINAL; dst: LONGCARD; n: CARDINAL) ;
+
+END Memory.

Memory.mod

@@ -0,0 +1,139 @@
+IMPLEMENTATION MODULE Memory ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+  SlotRec = RECORD CASE : BOOLEAN OF
+              | TRUE: b : ARRAY [0..7] OF CHAR ;
+              | FALSE: q : LONGCARD ;
+            END ;
+          END ;
+  WordRec = RECORD CASE : BOOLEAN OF
+              | TRUE: b : ARRAY [0..3] OF CHAR ;
+              | FALSE: w : CARDINAL ;
+            END ;
+          END ;
+  LongRec = RECORD CASE : BOOLEAN OF
+              | TRUE: b : ARRAY [0..7] OF CHAR ;
+              | FALSE: l : LONGINT ;
+            END ;
+          END ;
+
+VAR
+  ms : ARRAY [0 .. MaxMem - 1] OF CHAR ;
+  arenaBase : LONGCARD ;
+
+PROCEDURE Init ;
+BEGIN
+  arenaBase := 1048576 ;
+  heapPointer := TopOfMemory () ;
+END Init ;
+
+PROCEDURE ArenaBase () : LONGCARD ;
+BEGIN
+  RETURN arenaBase ;
+END ArenaBase ;
+
+PROCEDURE TopOfMemory () : LONGCARD ;
+BEGIN
+  RETURN VAL (LONGCARD, MaxMem) ;
+END TopOfMemory ;
+
+PROCEDURE ReadByte (a: LONGCARD) : CARDINAL ;
+BEGIN
+  RETURN ORD (ms [VAL (CARDINAL, a)]) ;
+END ReadByte ;
+
+PROCEDURE WriteByte (a: LONGCARD; b: CARDINAL) ;
+BEGIN
+  ms [VAL (CARDINAL, a)] := CHR (b MOD 256) ;
+END WriteByte ;
+
+PROCEDURE ReadSlot (a: LONGCARD) : LONGCARD ;
+VAR sr: SlotRec ; i: CARDINAL ;
+BEGIN
+  sr.q := 0 ;
+  FOR i := 0 TO 7 DO
+    sr.b [i] := ms [VAL (CARDINAL, a) + i] ;
+  END ;
+  RETURN sr.q ;
+END ReadSlot ;
+
+PROCEDURE WriteSlot (a: LONGCARD; v: LONGCARD) ;
+VAR sr: SlotRec ; i: CARDINAL ;
+BEGIN
+  sr.q := v ;
+  FOR i := 0 TO 7 DO
+    ms [VAL (CARDINAL, a) + i] := sr.b [i] ;
+  END ;
+END WriteSlot ;
+
+PROCEDURE ReadWord (a: LONGCARD) : CARDINAL ;
+VAR wr: WordRec ; i: CARDINAL ;
+BEGIN
+  wr.w := 0 ;
+  FOR i := 0 TO 3 DO
+    wr.b [i] := ms [VAL (CARDINAL, a) + i] ;
+  END ;
+  RETURN wr.w ;
+END ReadWord ;
+
+PROCEDURE WriteWord (a: LONGCARD; v: CARDINAL) ;
+VAR wr: WordRec ; i: CARDINAL ;
+BEGIN
+  wr.w := v ;
+  FOR i := 0 TO 3 DO
+    ms [VAL (CARDINAL, a) + i] := wr.b [i] ;
+  END ;
+END WriteWord ;
+
+PROCEDURE ReadLong (a: LONGCARD) : LONGINT ;
+VAR lr: LongRec ; i: CARDINAL ;
+BEGIN
+  lr.l := 0 ;
+  FOR i := 0 TO 7 DO
+    lr.b [i] := ms [VAL (CARDINAL, a) + i] ;
+  END ;
+  RETURN lr.l ;
+END ReadLong ;
+
+PROCEDURE WriteLong (a: LONGCARD; v: LONGINT) ;
+VAR lr: LongRec ; i: CARDINAL ;
+BEGIN
+  lr.l := v ;
+  FOR i := 0 TO 7 DO
+    ms [VAL (CARDINAL, a) + i] := lr.b [i] ;
+  END ;
+END WriteLong ;
+
+PROCEDURE CopyBytes (src, dst: LONGCARD; n: LONGCARD) ;
+VAR i: LONGCARD ;
+BEGIN
+  i := 0 ;
+  WHILE i < n DO
+    ms [VAL (CARDINAL, dst + i)] := ms [VAL (CARDINAL, src + i)] ;
+    i := i + 1 ;
+  END ;
+END CopyBytes ;
+
+PROCEDURE FillBytes (dst: LONGCARD; n: LONGCARD; b: CARDINAL) ;
+VAR i: LONGCARD ;
+BEGIN
+  i := 0 ;
+  WHILE i < n DO
+    ms [VAL (CARDINAL, dst + i)] := CHR (b MOD 256) ;
+    i := i + 1 ;
+  END ;
+END FillBytes ;
+
+PROCEDURE LoadImage (VAR data: ARRAY OF CHAR; off: CARDINAL; dst: LONGCARD; n: CARDINAL) ;
+VAR i: CARDINAL ; j: LONGCARD ;
+BEGIN
+  i := 0 ; j := 0 ;
+  WHILE i < n DO
+    ms [VAL (CARDINAL, dst + j)] := data [off + i] ;
+    INC (i) ; j := j + 1 ;
+  END ;
+END LoadImage ;
+
+END Memory.

SESSION.md

@@ -0,0 +1,33 @@
+# Session checkpoint — Turbo-Modula-2 16→64 MCD translator + mc4x VM
+
+Date: 13 sept. 17:4x. Working dir: `/home/eric/Projets/Projets-Modula2/MyWork/M2compiler/Resources/mc64`
+(real absolute roots vary; use `find` when resolving .MCD inputs).
+
+## State: WORKING
+- `trans8to64` : 16-bit `Foo.MCD` -> 64-bit `Foo64.MCD` (mc64 VM image).
+  - Build: `gm2 -fiso -o trans8to64 trans8to64.mod FileIO.o Console.o` (add `-g` for dbg build).
+  - `Extended.MCD` -> clean rc=0 now (was aborting rc=134). All 9 spec modules translate;
+    only `MCODE.MCD` fails BY DESIGN (114-B entry stub, no 304-byte descriptor plane).
+- `mcint` : 64-bit VM that loads a translated image and runs it.
+  - Build (full object set — do NOT prune):
+    `gm2 -fiso -o mcint mcint.mod Loader2.o Interpreter.o Instruction.o Local.o Stack.o
+          Memory.o Global.o Extended.o Console.o FileIO.o`
+  - Verified: `mcint /tmp/Stack64h.MCD` -> rc=0 (end-to-end).
+
+## Last bug fixed (this session)
+gm2 `FOR j := 0 TO vcnt - 1` with `vcnt = 0` underflows an binds loop 65536x ->
+`Get16`/descriptor overrun on `Extended.MCD` (rc=134). Fix: wrap each of the two
+var-sizes loops in `IF vcnt > 0 THEN ... END` in `trans8to64.mod` (read+write both),
+and the proc-scan loop in `IF nEnt >= 2 THEN`. Also patched `Interpreter.mod` 0CDH:
+default/out-of-range case now `Push (eot + t)` (was `Push (eot)`) — honours 16-bit
+return offset.
+
+## Known limits / next
+- `Extended64`/`Array`/`Local` translate but are `dcnt=1` (depend on loader-chain
+  modules); cannot run standalone under `mcint` yet -> needs dependency-chain loading.
+- Original 16-bit stack images themselves run under the 16-bit VM, not `mcint`.
+
+## Files
+- `mc64/trans8to64.mod`, `mc64/Interpreter.mod`, `mc64/mcint.mod` — the code.
+- Binaries: `trans8to64`, `trans8to64dbg`, `mcint`.
+- Test outputs: `/tmp/Stack64h.MCD`, `/tmp/Extended64g.MCD`, `/tmp/Array64*.MCD`...

Stack.def

@@ -0,0 +1,28 @@
+DEFINITION MODULE Stack ;
+
+(* MC64 evaluation / activation stack.  One element is one 8-byte slot.
+   The stack grows downwards from TopOfMemory towards the heap/arena. *)
+
+EXPORT QUALIFIED Push, Pop, PushInt, PopInt, PushCard, PopCard,
+  PushBool, PopBool, PushLongInt, PopLongInt, PushLongCard, PopLongCard,
+  PushReal, PopReal, PushQuad, PopQuad, Reserve ;
+
+PROCEDURE Push (v: LONGCARD) ;
+PROCEDURE Pop () : LONGCARD ;
+PROCEDURE PushInt (v: INTEGER) ;
+PROCEDURE PopInt () : INTEGER ;
+PROCEDURE PushCard (v: CARDINAL) ;
+PROCEDURE PopCard () : CARDINAL ;
+PROCEDURE PushBool (v: BOOLEAN) ;
+PROCEDURE PopBool () : BOOLEAN ;
+PROCEDURE PushLongInt (v: LONGINT) ;
+PROCEDURE PopLongInt () : LONGINT ;
+PROCEDURE PushLongCard (v: LONGCARD) ;
+PROCEDURE PopLongCard () : LONGCARD ;
+PROCEDURE PushReal (v: REAL) ;
+PROCEDURE PopReal () : REAL ;
+PROCEDURE PushQuad (v: LONGREAL) ;
+PROCEDURE PopQuad () : LONGREAL ;
+PROCEDURE Reserve (n: CARDINAL) ;
+
+END Stack.

Stack.mod

@@ -0,0 +1,121 @@
+IMPLEMENTATION MODULE Stack ;
+
+FROM Memory IMPORT WriteSlot, ReadSlot ;
+FROM Local IMPORT GetSP, SetSP ;
+
+TYPE
+  RealView = RECORD CASE : BOOLEAN OF
+               | TRUE: r : REAL ;
+               | FALSE: v : LONGCARD ;
+             END ;
+           END ;
+  QuadView = RECORD CASE : BOOLEAN OF
+               | TRUE: r : LONGREAL ;
+               | FALSE: lo, hi : LONGCARD ;
+             END ;
+           END ;
+
+VAR
+  rv : RealView ;
+  qv : QuadView ;
+
+PROCEDURE Push (v: LONGCARD) ;
+BEGIN
+  SetSP (GetSP () - 8) ;
+  WriteSlot (GetSP (), v) ;
+END Push ;
+
+PROCEDURE Pop () : LONGCARD ;
+VAR v: LONGCARD ;
+BEGIN
+  v := ReadSlot (GetSP ()) ;
+  SetSP (GetSP () + 8) ;
+  RETURN v ;
+END Pop ;
+
+PROCEDURE PushInt (v: INTEGER) ;
+BEGIN
+  Push (VAL (LONGCARD, v)) ;
+END PushInt ;
+
+PROCEDURE PopInt () : INTEGER ;
+BEGIN
+  RETURN VAL (INTEGER, VAL (CARDINAL, Pop ())) ;
+END PopInt ;
+
+PROCEDURE PushCard (v: CARDINAL) ;
+BEGIN
+  Push (VAL (LONGCARD, v)) ;
+END PushCard ;
+
+PROCEDURE PopCard () : CARDINAL ;
+BEGIN
+  RETURN VAL (CARDINAL, Pop ()) ;
+END PopCard ;
+
+PROCEDURE PushBool (v: BOOLEAN) ;
+BEGIN
+  IF v THEN
+    Push (1) ;
+  ELSE
+    Push (0) ;
+  END ;
+END PushBool ;
+
+PROCEDURE PopBool () : BOOLEAN ;
+BEGIN
+  RETURN Pop () # 0 ;
+END PopBool ;
+
+PROCEDURE PushLongInt (v: LONGINT) ;
+BEGIN
+  Push (VAL (LONGCARD, v)) ;
+END PushLongInt ;
+
+PROCEDURE PopLongInt () : LONGINT ;
+BEGIN
+  RETURN VAL (LONGINT, Pop ()) ;
+END PopLongInt ;
+
+PROCEDURE PushLongCard (v: LONGCARD) ;
+BEGIN
+  Push (v) ;
+END PushLongCard ;
+
+PROCEDURE PopLongCard () : LONGCARD ;
+BEGIN
+  RETURN Pop () ;
+END PopLongCard ;
+
+PROCEDURE PushReal (v: REAL) ;
+BEGIN
+  rv.r := v ;
+  Push (rv.v) ;
+END PushReal ;
+
+PROCEDURE PopReal () : REAL ;
+BEGIN
+  rv.v := Pop () ;
+  RETURN rv.r ;
+END PopReal ;
+
+PROCEDURE PushQuad (v: LONGREAL) ;
+BEGIN
+  qv.r := v ;
+  Push (qv.hi) ;
+  Push (qv.lo) ;
+END PushQuad ;
+
+PROCEDURE PopQuad () : LONGREAL ;
+BEGIN
+  qv.lo := Pop () ;
+  qv.hi := Pop () ;
+  RETURN qv.r ;
+END PopQuad ;
+
+PROCEDURE Reserve (n: CARDINAL) ;
+BEGIN
+  SetSP (GetSP () - VAL (LONGCARD, n) * 8) ;
+END Reserve ;
+
+END Stack.

docs/m-code-summary-64.md

@@ -0,0 +1,64 @@
+# MC64 — Summary
+
+A 64-bit generalization of the Turbo Modula-2 MCode virtual machine (see `mc64-spec.md`).
+
+## Core model
+- **Word = 64 bits**; flat, byte-addressable, little-endian address space.
+- Stack machine, single stack shared by values and frames; **grows down** (`Push` = `SP -= 8`).
+- State: `IP`, `SP`, `FP` (frame), `GP` (current module data window), `OFP` (static link), `MTBL` (256 module pointers).
+
+## Data types
+| Type | Width | Stack slots |
+|---|---|---|
+| BYTE/CHAR/BOOLEAN | 8 bits (in a slot) | 1 |
+| CARDINAL | 32 bits (zero-extended) | 1 |
+| INTEGER | 32 bits (sign-extended) | 1 |
+| SET | 64 bits | 1 |
+| LONGINT / LONGCARD | 64 bits | 1 |
+| REAL | 64-bit binary64 | 1 |
+| LONGREAL | 128-bit | 2 (quad) |
+| pointer | 64 bits | 1 |
+
+Slots are always 64 bits; 32-bit values live in the low 32 bits, so 32↔64-bit widening is a value no-op.
+
+## Frames & calls
+- Locals at `FP[-1], FP[-2], …`; param *k* at `FP[k+2]`; args pushed in reverse order.
+- `ENTER k` reserves `(255−k)×8` bytes of locals (k=0FFH → none).
+- `PROC_LEAVE n`: drops `n & 0x7F` words; bit 7 re-enters the outer module (reloads `GP` from `OFP`).
+
+## Addressing
+Local (FP) / Global (GP) / Extern (`MTBL[mod]`) / Indirect (popped ptr) / Indexed (ptr + index). Word offsets = bytes × 8.
+
+## Opcode map
+All **256 opcodes preserved 1:1**, positions from MCode/16:
+- `00–1F` params, legacy dword (slot) loads/stores, indexed byte/slot/quad
+- `20–3F` dup/swap, local/global/extern load+store, memcpy/string copy
+- `40` extended sub-dispatch (ALLOCATE/MARK/MOVE/FILL/BIOS…, LONGCARD `uc_*` arithmetic, `long_negate`), `41/51` slot0 aliases, global 2–15
+- `60–7F` indirect load/store offsets 0–15
+- `80–9F` addresses, leaves, strings, immediates (byte / 8-byte / 16-byte)
+- `A0–BF` comparisons & arithmetic on the **32-bit** CARDINAL/INTEGER types, LONGINT↔CARDINAL/INTEGER/REAL conversions, shifts
+- `12H` sub-opcode: the only **128-bit LONGREAL** (quad) load/store/compare/arith family
+- `C0–DF` checked 32-bit arithmetic, SYSTEM host calls, **64-bit LONGINT** (`long_*`) compare/arith, switch, reserve, range checks, short-circuit `and_jp`/`or_jp`
+- `E0–FF` jumps, bitset ops (64-bit SET), procedure calls (`call 1..15`, extern, nested)
+
+The old MCode/16 "dword/long" (32-bit LONGINT/REAL) groups become the 64-bit LONGINT
+family; 64-bit unsigned (LONGCARD) `uc_*` primitives move to the `40H` extended
+dispatch.
+
+## Complex instructions
+- **Switch (0CDH)**: low/high u64 bounds + i64 jump table; offset relative to its cell end; negative offset = call-switch (pushes return = end of table).
+- **String compare (0C4H)**: pushes `(s1>s2)` then `(s1<s2)`.
+- **reserve_string**: copies pc-relative string const onto the stack, pushes its address.
+- **SYSTEM (0C3H)**: host ABI (0 exit, 1 write string, 2 read line, 3+ host-defined).
+
+## Modules & loader
+- `.MC4` file: magic header (8) + fileSize, moduleStart, depsOffset, nbDependencies, reserved — then image blob + dependency records (16-char name, version, fixup location).
+- In-memory `ModuleDesc`: dependencies[32], link, name, loadAddr, checksum, procsAddr, flags/varCount/depCount.
+- Proc k address = `procsAddr + k*8 + offset[k]`.
+- Load: relocate module chain, init globals (zero-filled), run `TOINIT` initializers in order — the requested module's init runs last.
+
+## Exceptions
+IllegalInstruction, Unimplemented, Overflow, RangeError, DivideByZero, StackOverflow, OutOfMemory, StringTooLong, LoadError; processes/`TRANSFER` out of baseline scope.
+
+## Key differences from MCode/16
+Word 16→64 bits; encoded fields that were 16-bit words widened 2→8 bytes; local addressing in words; `MTBL` replaces the global-window module table trick; `.MCD` → `.MC4` (magic, 64-bit fields); `Enter` reserve ×8.

docs/m-code-summary.md

@@ -0,0 +1,58 @@
+# Turbo Modula-2 MCode Machine — Summary
+
+## Overview
+MCode is the bytecode for Borland's Turbo Modula-2 (CP/M). It's a **16-bit word-addressed stack machine** with a single stack shared by evaluation values and call frames. The spec here is an interpreter written in Modula-2 (`Interpreter.mod`'s `Run` loop) that reads `.MCD` bytecode files, loads them, and executes them. In the original system, this dispatch loop was hand-written Z80 for speed.
+
+## Timeline of a program
+```
+Call(modName)              # Loader2.mod:313
+  LoadWithDependencies     # load .MCD, read module desc, relocate addresses
+  TranslateAddresses       # fix up internal/external references
+  allocate module globals
+  for each TOINIT module:  ProcCall(0,1); Interpreter.Run   # run its init
+```
+A `.MCD` file: header (fileSize, moduleStart, codeSize, nbDependencies, reserved) + code blob + dependency records (8-char name, version, location). One file can bundle several interlinked modules (chain via `link`).
+
+## Machine state
+- `instructionPointer` — current bytecode address
+- `sp` — word stack pointer (grows **down**; push = `DEC(sp,2)`)
+- `Local.framePointer` — current frame base (0-relative word indexing)
+- `Global.globalPointer` — current module's global data base
+- `old frame pointer` / `outer frame pointer` — link for display/static chain
+
+## Data types on the stack
+| Size | Stack representation |
+|---|---|
+| 1 word | CARDINAL, INTEGER, BOOLEAN, CHAR, address |
+| 2 words | LONGINT (`DPush`), REAL (`FPush`) |
+| 4 words | LONGREAL (`QPush`) |
+
+Multi-word values are little-endian: high word pushed first.
+
+## Calling convention
+- `Enter n` (0D4H): push new frame (old FP, outer FP), return-IP, reserve `255-n` bytes of locals (Instruction.mod:89). Stack order from low to high: **locals → return IP → outer FP → old FP → [caller data]**, so the frame pointer indexes params positively and locals negatively.
+- Calls: `ProcCall` pushes return address and jumps to the proc's code (resolved through a proc-address table stored just before the module base).
+- `ProcLeave n` (0E0x…): pops IP, FP, outer FP; discards `n` words; `n ≥ 80H` means the proc re-enters its outer module (sets `globalPointer`).
+
+## Addressing families
+| Mnemonic | Meaning | Base |
+|---|---|---|
+| Local | FP-relative; params +n, locals −n | `Local.framePointer[n]` |
+| Global | current module's data | `globalPointer[n]` |
+| Extern | other module's data (mod#, var#), resolved via module table | `Global.Module(modNum)` |
+| Indirect (Stack) | load via address popped from stack | `mem[ptr+n]` |
+| Array | base address (stack) + index | `mem[base+idx]` |
+
+Full opcode map is the `CASE` in `Interpreter.mod:84`; `00H`–`FFH` covers: 0D0H-series real arith, 0C0H-series checked arith + long arith, 0E0H-series jumps/short-circuit (`AndThen`/`OrElse`), 0CDH switch tables, 0EBH-0FFH procedure calls, `40H` extended opcodes (ALLOCATE/MOVE/FILL/BIOS/Transfer…), and `12H` LONGREAL sub-dispatch.
+
+## Highlights
+- **Switch tables** (0CDH): low/high bounds + jump table; uses a `+8000H` offset for unsigned comparison; tables can double as call-tables (`Push(returnAddr)`).
+- **Short-circuit evaluated** `AND THEN` / `OR ELSE` via `0DEH`/`0DFH` with jump offsets.
+- Stack doubles as the heap arena; `reserve`/`reserve_string` allocate locals/strings on it.
+- Not implemented in the spec interpreter: processes/coroutines (`TRANSFER`), `ASM`, `IOTRANSFER`, exception raise (0): these raise catchable exceptions instead.
+
+## Tooling in the repo
+- `unassemble.c` — disassembles any `.MCD` (or the original `M2.COM`); prints the mnemonic names + a jump/switch-aware listing.
+- `MCode_disassembly/*.txt` — full disassembly of the original system (KERNEL, COMPILER, EDITOR, SHELL, system libs).
+
+This gives you a complete, executable description of Turbo Modula-2's bytecode — a clean reference if you want your compiler to emit (or a VM to run) it.

docs/mc64-spec.md

@@ -0,0 +1,809 @@
+# MC64 — A 64-Bit Stack Machine
+
+**Instruction-Set Specification, derived from the Turbo Modula-2 MCode bytecode**
+
+MC64 is a 64-bit generalization of the MCode virtual machine that Borland Turbo Modula-2
+for CP/M executed on Z80. Where MCode/16 is a 16-bit *word*-addressed stack machine with
+all scalars 16 bits wide, MC64 keeps the stack slot (word) at 64 bits but preserves
+Modula-2's type ladder: CARDINAL and INTEGER are **32 bits**, SET is **64 bits**,
+LONGINT and LONGCARD are **64 bits**, REAL is a **64-bit float** and LONGREAL is a
+**128-bit quad**.
+
+The 256-entry opcode map is preserved 1:1. The scalar word-op families (0A0H–0BFH and
+the checked forms) now operate on the 32-bit types; the "long"/"dword" families
+(0C5H–0CCH) operate on the 64-bit LONGINT type. Unsigned 64-bit (LONGCARD) arithmetic
+is provided by the extended sub-dispatch (§10.2).
+
+---
+
+## 1. Naming and document purpose
+
+- **word (slot)** = 8 bytes = 64 bits — the unit of the stack, frame cells and global cells.
+- **scalar** = a typed value held in one slot: 32-bit types (CARDINAL, INTEGER, and
+  8-bit BYTE/CHAR/BOOLEAN) or 64-bit types (LONGINT, LONGCARD, SET, REAL, pointer).
+- **quad** = two slots = 16 bytes = 128 bits (the LONGREAL type).
+- Operands that in MCode/16 were *16-bit words* are here *64-bit words*; *byte* operands
+  stay bytes unless stated otherwise.
+
+This document is the normative reference for a VM implementation (e.g. as a C port)
+and for a compiler code generator that emits MC64.
+
+---
+
+## 2. Memory model
+
+- Flat, byte-addressable address space; all addresses are 64-bit little-endian.
+- Basic storage unit is the **byte**; the machine word is 8 bytes; words are naturally
+  aligned (address % 8 == 0) unless stated otherwise.
+- Little-endian everywhere, including stack entries, code operands and multibyte values.
+- Memory layout convention (shared by the loader, not enforced by the ISA):
+
+```
+ high address
+ +-----------------------------+  ^
+ |      stack region           |  |  grows DOWN toward globals/heap
+ |  (SP moves toward lower adr)|
+ +-----------------------------+
+ |      heap region            |  |
+ +-----------------------------+  |  grows UP (ALLOCATE/MARK/RELEASE)
+ |      module images + globals|
+ +-----------------------------+  v
+ |      system tables          |
+  low address
+```
+
+The evaluation stack and the heap share the middle; the loader places module images at
+low addresses and lets the stack come down from the top.
+
+---
+
+## 3. Registers / machine state
+
+| Register     | Meaning                                                        |
+|--------------|----------------------------------------------------------------|
+| `IP`         | instruction pointer — byte address of next opcode              |
+| `SP`         | stack pointer — byte address of the *top* word (lowest used)    |
+| `FP`         | frame pointer — base of the current activation frame           |
+| `GP`         | global pointer — base of the current module's data window      |
+| `OFP`        | outer frame pointer — static chain / display link              |
+| `MTBL`       | module table — `MTBL[i]` = data base of loaded module `i`      |
+
+The stack **grows down**: `Push(w)` = `SP -= 8; *(u64*)SP = w`.
+
+---
+
+## 4. Data types
+
+| Modula-2 type | Width   | Stack slots | Notes                             |
+|---------------|---------|-------------|------------------------------------|
+| BYTE, CHAR, BOOLEAN | 8 bits  | 1 slot | held in the low bits of a slot     |
+| CARDINAL      | 32 bits | 1 slot | unsigned arithmetic, zero-extended |
+| INTEGER       | 32 bits | 1 slot | two's complement, sign-extended    |
+| SET           | 64 bits | 1 slot | bit set, elements 0..63            |
+| LONGINT       | 64 bits | 1 slot | two's complement signed arithmetic |
+| LONGCARD      | 64 bits | 1 slot | unsigned 64-bit arithmetic (new)   |
+| REAL          | 64 bits | 1 slot | IEEE 754 binary64 (double)         |
+| LONGREAL      | 128 bits| 2 slots| IEEE 754 binary128 (quad)          |
+| pointer/address | 64 bits | 1 slot | byte address                    |
+
+Storage convention: stack slots are always 64 bits. 32-bit values live in the *low* 32
+bits of their slot — CARDINAL is kept zero-extended, INTEGER is kept sign-extended —
+while SET and the 64-bit types occupy the full slot. Conversion between a 32-bit type
+and a 64-bit type is a value no-op. ALL loads and stores move a full slot; the *width*
+is a semantic property of the arithmetic and comparison opcodes, not of memory access.
+
+Stack representation of a quad (little-endian):
+
+```
+ memory:  [ low word ... high word ]      low word on top (at SP)
+```
+
+Push order for a quad constant or a quad load: high word first, low word last, so the
+low word ends up on top of the stack.
+
+---
+
+## 5. Stack and frames
+
+One stack holds evaluation data and activation frames.
+
+### 5.1 Frame layout
+
+```
+              byte offset from FP               stack slot
+  FP - N*8  ........  first local word           FP[-N]
+  FP - 8    ........  last (shallowest) local    FP[-1]
+  FP + 0    ........  OPF (outer frame pointer)  FP[0]
+  FP + 8    ........  OLD FP (dynamic link)      FP[1]
+  FP + 16   ........  return IP                  FP[2]
+  FP + 24   ........  parameter 1                FP[3]
+  FP + 32   ........  parameter 2                FP[4]
+  ...
+```
+
+- **Locals** use negative word offsets: `FP[-1]`, `FP[-2]`, … The last reserved word
+  (adjacent to the frame link) is offset `-1`.
+- **Parameters** use positive word offsets: parameter *k* is at `FP[k+2]`.
+- The caller pushes arguments in **reverse declaration order** (last parameter pushed
+  first), so parameter 1 is the deepest argument and lands at `FP[3]`.
+
+### 5.2 Call sequence
+
+```
+  ; evaluate actuals, push them (right to left)
+  PROCCALL n                ; push return IP, jump to proc n  (OFP set as needed)
+  ENTER k                   ; callee prologue (below)
+  ...
+  LEAVE0 / PROC_LEAVE n     ; callee epilogue (below)
+```
+
+`ENTER k`:
+```
+  push OLD FP; push OFP ; FP := SP          ; NewFrame
+  push IP                                   ; procedure start address
+  Reserve( (255-k) * 8 )                    ; locals, in bytes (k=0FFH => none)
+```
+
+`PROC_LEAVE n` (and the leave family):
+```
+  SP := FP                  ; discard frame + locals
+  OFP := pop                ; outer frame pointer
+  FP  := pop                ; OLD FP (restore caller FP)
+  IP  := pop                ; return address
+  drop n words              ; discard parameter area (n is 7-bit; see below)
+  if (bit 7 of n) and (OFP ≠ NIL): GP := OFP   ; re-enter outer module
+```
+
+Function returns:
+- `FCT_LEAVE n`: `res := pop; PROC_LEAVE n; push res`
+- `LONGREAL_FCT_LEAVE n`: same with a quad (two words) preserved across the leave.
+
+The low 7 bits of `n` in leave opcodes count **words** to drop from the caller's
+parameter area. Bit 7 is a flag: when set the procedure returns *into its outer
+(statically enclosing) module*, so `GP` is reloaded from `OFP`.
+
+---
+
+## 6. Addressing families
+
+| Family    | Base                          | Word offset n from                |
+|-----------|-------------------------------|-----------------------------------|
+| Local     | `FP`                          | immediate (s8) or tiny code       |
+| Global    | `GP` (current module window)  | immediate (u8) — `GP[n]`          |
+| Extern    | `MTBL[moduleNumber]`          | `mod` and `var` operands          |
+| Indirect  | a pointer popped from the stack | immediate (u8) — `*(ptr + n)`   |
+| Indexed   | a pointer popped from stack + index popped from stack | `*(ptr + index)` |
+
+Word offset *n* means byte offset `n*8`. Exceptions: the indexed *byte* ops (0DH/1DH)
+address single bytes (CHAR/BYTE arrays, strings), and the indexed *quad* ops (0FH/1FH)
+address two-slot LONGREAL elements.
+
+The `GP` window is an array of at least 65536 words; modules loaded so far live in it.
+`MTBL` is a system-wide array of 256 64-bit module data bases. `EXTERN mod,var`
+operations read `MTBL[mod][var]`.
+
+---
+
+## 7. Modules, procedures and linkage
+
+### 7.1 Module descriptor (in-memory)
+
+```
+ModuleDesc (offsets are image-relative; u64 fields little-endian):
+   0      dependencies : ARRAY[0..31] OF ADDRESS   ; 256 bytes (module base pointers)
+   256    link         : ADDRESS                   ; next module in chain
+   264    name         : ARRAY[0..15] OF CHAR      ; 16-char, NUL-padded
+   280    loadAddr     : ADDRESS                   ; base of module data image
+   288    checksum     : u32   (32-bit; see §8.3 for the coverage rule)
+   292    flags        : u8    (bit0 OVERLAY, bit1 Z80/NATIVE, bit2 TOINIT, bit3 RECURSE)
+   293    varCount     : u8    (number of global variable entries)
+   294    depCount     : u8    (number of dependencies)
+   295    pad          : u8    (reserved, zero)
+   296    procsAddr    : ADDRESS                      ; location of the proc table
+   304    varSizes     : varCount × ADDRESS   (u64 global variable sizes in bytes)
+```
+
+The descriptor lives at **image offset 0** (i.e. immediately after the 64-byte file
+header). In a single-module file the whole image is a bare descriptor + code + data, so
+`moduleStart` (file header, §8.1) is taken as 0.
+
+### 7.2 Procedure address resolution
+
+Each module has a **procedure table** at `procsAddr`: `N` contiguous 64-bit **relative
+byte offsets**, one per procedure.
+
+```
+procedureAddress(k) = procsAddr + k*8  +  (i64) table[k]
+```
+
+The offset is relative to the *end* of the entry cell, so entry `0` can point directly
+after its own cell. The table consecutive cells live just below (or beside) the module
+data; `procsAddr` is fixed up by the loader.
+
+### 7.3 External calls
+
+`EXTERN_CALL mod,proc`:
+```
+  OFP := GP                 ; remember current module
+  GP  := MTBL[mod]          ; switch to callee module
+  push IP
+  IP  := procedureAddress(mod, proc)
+```
+
+`EXTERN_CALL1` (address+proc number on the stack) does the same with
+`procsNum = pop; modBase = pop; GP = modBase`.
+
+---
+
+## 8. Loader and on-disk format
+
+A module file ("\*.MC4") holds one or several linked modules plus their dependencies.
+
+### 8.1 File header (64 bytes)
+
+| Offset | Size | Field            | Meaning                              |
+|--------|------|------------------|--------------------------------------|
+| 0      | 8    | magic            | `"MC64\0\0\0\0"` (constant `0x_4D_43_36_34`) |
+| 8      | 8    | fileSize         | bytes of the image block (not header)|
+| 16     | 8    | moduleStart      | offset of the module descriptor within the image |
+| 24     | 8    | depsOffset       | offset of the dependency table within the image |
+| 32     | 8    | nbDependencies   | number of dependencies               |
+| 40     | 24   | reserved         | zero                                  |
+
+### 8.2 Dependency record (32 bytes each)
+
+| Size | Field         | Meaning                       |
+|------|---------------|-------------------------------|
+| 16   | name          | module name, NUL-padded       |
+| 8    | version       | import version (0 = any)      |
+| 8    | location      | offset of the fixup that must point at the module data base after load |
+
+### 8.3 Load sequence
+
+```
+LoadWithDependencies(modName, referencer, version):
+  open file; read header
+  origin := allocAddr; load image blob at origin
+  read dependency records (depsOffset + i*32)
+  walk the module chain starting at origin + moduleStart:
+      add origin to loadAddr, procsAddr, each non-NIL dependency pointer
+      set RECURSEFLAG
+  verify checksum of the requested (last) module
+  if not already loaded:
+      relocation pass: for each fixup pair (location,count) in the descriptor,
+          add origin to the target pointed by the (relocated) location
+      translate dependency fixups: moduleBase := loadModule(dep); *(location+origin) := moduleBase
+  init module globals (varCount × sizes), zero-filled
+```
+
+**Checksum rule (as implemented):** the module checksum is the plain 32-bit sum of the
+image bytes (file offsets `HeaderSize..fileSize-1`) **excluding** the four checksum
+bytes themselves (file `352..355` = image `288..291`). For the reference loader the
+image is placed at `ArenaBase` (1 MiB) with the descriptor at image offset 0, and the
+module's data window (`dataWin`) is allocated right after the image, 8-byte aligned, and
+zero-filled; `dependencies`, `link` and multi-module relocation are currently
+unsupported (`depCount > 0` is rejected).
+
+### 8.4 Global variable allocation
+
+After loading, the loader allocates `varSize` bytes for each entry, fills them with
+zeros and records the allocated base in the module descriptor's var-size table slot.
+
+---
+
+## 9. Execution
+
+### 9.1 Run loop
+
+```
+Run:
+  loop
+    opcode := NextByte()
+    dispatch opcode
+  loop forever
+```
+
+`NextByte` reads one byte and advances `IP`. `NextWord` reads a 64-bit little-endian
+word (8 bytes). `NextSigned` reads a signed 8-bit value.
+
+### 9.2 Exceptions
+
+| Exception               | Raised by                                        |
+|-------------------------|--------------------------------------------------|
+| IllegalInstruction      | opcode 00                                        |
+| Unimplemented           | opcodes 01, 87, native-stub services             |
+| Overflow                | checked arithmetic (0C0H–0C2H, 0D0H–0D1H)        |
+| RangeError              | 0DAH, 0DBH, 0DCH, 0DDH                           |
+| DivideByZero            | DIV/MOD with zero divisor                        |
+| StackOverflow           | reserve crossing the stack/heap limit            |
+| OutOfMemory             | ALLOCATE breathing the stack                     |
+| StringTooLong           | copy_string overflow                             |
+| LoadError               | loader (module not found / version conflict)     |
+
+A raising opcode aborts the current `Run` and unwinds to the nearest handler
+(register via `RAISE`/handler services). If no handler exists, the VM terminates the
+current module and reports the exception record (name, kind, `IP`), then returns to the
+caller of `Call`. Concurrency/process support (`TRANSFER`, `NEWPROCESS`) is out of
+scope for the baseline machine and raises `Unimplemented`.
+
+### 9.3 Host interface (0C3H `SYSTEM`)
+
+`SYSTEM` is the escape hatch to the host environment (successor to the CP/M BDOS):
+
+```
+  id    := pop           ; service number
+  param := pop           ; address (or scalar)
+```
+
+Baseline services (implementation provided by the VM):
+
+| id | Service            |
+|----|--------------------|
+| 0  | EXIT (param = status ignored)  |
+| 1  | write NUL-terminated string at param |
+| 2  | read line into buffer at param |
+| 3+ | host-defined extensions |
+
+Service 2 (`read line`) pulls characters from the host standard input up to
+(but not including) the line mark, or until end of input.  The bytes are stored at
+`param`, a NUL terminator is appended, and the byte count read (excluding the
+terminator) is pushed onto the operand stack.  An empty line or immediate end of
+input pushes 0.  A guest therefore reads a line with:
+`load_imm_word buf; load_imm_byte 2; system;` and may echo it straight back with
+`service 1` because the buffer is NUL-terminated.
+
+---
+
+## 10. Sub-opcode dispatches
+
+Two opcodes delegate to a secondary byte:
+
+### 10.1 Sub-opcode `0x12` — LONGREAL (quad) operations
+
+| sub | mnemonic        | operands | effect                                          |
+|-----|-----------------|----------|-------------------------------------------------|
+| 00  | load_local_q    | s8 n     | push quad `FP[n]`..`FP[n+1]` (local)            |
+| 01  | load_global_q   | u8 n     | push quad `GP[n]`..`GP[n+1]` (global)           |
+| 02  | load_i_q        | u8 n     | pop p; push quad `p[n]`..`p[n+1]` (indirect)    |
+| 03  | load_extern_q   | mod, var | push quad `MTBL[mod][var..var+1]`               |
+| 04  | store_local_q   | s8 n     | store quad of stack into local                  |
+| 05  | store_global_q  | u8 n     | store quad into global                          |
+| 06  | store_i_q       | u8 n     | pop p; store quad into `p[n..]`                 |
+| 07  | store_extern_q  | mod, var | store quad into external module                 |
+| 08  | load_indexed_q  | —        | pop i (index), pop p; push quad `p[i]`          |
+| 09  | store_indexed_q | —        | pop q (quad); pop i; pop p; store quad `p[i]`   |
+| 0A  | quad_fct_leave  | u8 n     | q:=pop; proc_leave n; push q  (quad fct leave)  |
+| others            | illegal  |          |                                                |
+
+(`0x40 0x12` is `reserve_string`, see extended table.)
+
+### 10.2 `0x40` — extended operations
+
+| sub | mnemonic          | effect                                              |
+|-----|-------------------|-----------------------------------------------------|
+| 00  | drop              | pop 1 word                                          |
+| 01  | enter_monitor     | no-op (host hook for preemption)                    |
+| 02  | leave_monitor     | no-op                                               |
+| 03  | long_negate       | pop LONGINT; push -LONGINT (64-bit signed negate) |
+| 04  | build_field_mask  | pop hi; pop lo; push (1<<hi) - (1<<lo)              |
+| 05  | ALLOCATE          | pop size; pop p; alloc; *p := block                |
+| 06  | DEALLOCATE        | pop size; pop p; free *p; *p := NIL                |
+| 07  | MARK              | pop p; *p := heapMark                              |
+| 08  | RELEASE           | pop p (mark addr); release; *p := NIL              |
+| 09  | FREEMEM           | push bytes free                                   |
+| 0A  | TRANSFER          | unimplemented (processes)                          |
+| 0B  | IOTRANSFER        | unimplemented                                      |
+| 0C  | NEWPROCESS        | unimplemented                                      |
+| 0D  | BIOS              | host call: fct:=pop; param:=pop; BIOS(fct,param)  |
+| 0E  | MOVE             | pop size; pop dst; pop src; memcpy(dst,src,size)  |
+| 0F  | FILL             | pop value; pop size; pop addr; memset(addr,value,size) |
+| 10  | INP               | host I/O read port                                |
+| 11  | OUT               | host I/O write port                               |
+| 12  | reserve_string    | see §13                                           |
+| 13  | assert            | assertion: pop 0 → raise RangeError               |
+| 14  | uc_less           | pop b; pop a; push (a < b)  (LONGCARD)           |
+| 15  | uc_less_eq        | pop b; pop a; push (a <= b) (LONGCARD)           |
+| 16  | uc_greater        | pop b; pop a; push (a > b)  (LONGCARD)           |
+| 17  | uc_greater_eq     | pop b; pop a; push (a >= b) (LONGCARD)           |
+| 18  | uc_add            | pop b; pop a; push (a + b)  mod 2^64 (LONGCARD)  |
+| 19  | uc_sub            | pop b; pop a; push (a - b)  mod 2^64 (LONGCARD)  |
+| 1A  | uc_mul            | pop b; pop a; push (a * b)  mod 2^64 (LONGCARD)  |
+| 1B  | uc_div            | pop b; pop a; push (a DIV b) (raise DivideByZero)|
+| 1C  | uc_mod            | pop b; pop a; push (a MOD b) (raise DivideByZero)|
+| 1D  | uc_to_real        | pop LONGCARD; push REAL (rounded; optional)      |
+| 1E  | real_to_uc        | pop REAL; push LONGCARD (truncated; optional)    |
+| others |                  | illegal                                           |
+
+---
+
+## 11. Instruction set reference
+
+Notation: stack effects are written bottom…top → result. `pop` reads the top word.
+`u8/i8/u64/i64` are operand encodings. Multi-word quads are noted as *q*.
+
+### 11.1 0x00–0x1F — loads, stores, params, indexed
+
+| Hex | Mnemonic        | Operand | Effect                                        |
+|-----|-----------------|---------|-----------------------------------------------|
+| 00  | reserved        | —       | raise IllegalInstruction                      |
+| 01  | RAISE           | —       | unimplemented (see §9.2)                      |
+| 02  | load_proc_addr  | u8 n    | push procedureAddress(current_mod, n)         |
+| 03–07 | load_param (1–5) | —     | push `FP[3..7]` (param 1..5)                  |
+| 08  | load_local_dw    | i8 n    | push slot `FP[n]` (legacy 64-bit slot / LONGINT)|
+| 09  | load_global_dw   | u8 n    | push slot `GP[n]` (LONGINT/LONGCARD)            |
+| 0A  | load_stack_dw    | u8 n    | pop p; push slot `p[n]` (64-bit)                |
+| 0B  | load_extern_dw   | mod,var | push slot `MTBL[mod][var]` (64-bit)             |
+| 0C  | load_extern_w    | nibble  | push slot `MTBL[m][n]` (nibble m,n)             |
+| 0D  | load_indexed_byte | —    | pop i; pop p; push (u8)`p[i]`                   |
+| 0E  | load_indexed_w   | —       | pop i; pop p; push `p[i*8]` (one slot)          |
+| 0F  | load_indexed_q   | —       | pop i; pop p; push quad `p[i*8]`,`p[i*8+1]` (LONGREAL) |
+| 10  | load_outer      | —       | push `FP` of enclosing frame (display +1)     |
+| 11  | load_outer_n    | u8 n    | push frame pointer n display-steps up         |
+| 12  | LONGREAL op     | sub     | secondary dispatch (§10.1)                    |
+| 13–17 | store_param (1–5) | —     | pop; `FP[3..7]` := value                      |
+| 18  | store_local_dw   | i8 n    | pop; store slot into `FP[n]`                    |
+| 19  | store_global_dw  | u8 n    | pop; store slot into `GP[n]`                    |
+| 1A  | store_stack_dw   | u8 n    | pop; pop p; store slot into `p[n]`              |
+| 1B  | store_extern_dw  | mod,var | pop; store slot into `MTBL[mod][var]`           |
+| 1C  | store_extern_w   | nibble  | pop; store slot into `MTBL[m][n]`               |
+| 1D  | store_indexed_byte | —     | pop v; pop i; pop p; `p[i] := v (byte)`        |
+| 1E  | store_indexed_w  | —       | pop v; pop i; pop p; `p[i*8] := v`              |
+| 1F  | store_indexed_q  | —       | pop q; pop i; pop p; store quad at `p[i*8]`     |
+
+### 11.2 0x20–0x3F — stack ops, local/global loads & stores, copies
+
+| Hex | Mnemonic        | Operand | Effect                                        |
+|-----|-----------------|---------|-----------------------------------------------|
+| 20  | dup             | —       | push top                                      |
+| 21  | swap            | —       | exchange top two words                        |
+| 22–2B | load_local_n  | —       | push `FP[-(op & 0x0F)]`  (offsets +2..−11)    |
+| 2C  | load_local      | i8 n    | push `FP[n]` (n<0 local, n>0 param)           |
+| 2D  | load_global     | u8 n    | push `GP[n]`                                  |
+| 2E  | load_stack      | u8 n    | pop p; push `p[n]`                            |
+| 2F  | load_extern     | mod,var | push `MTBL[mod][var]`                         |
+| 30  | copy_block      | —       | pop size; pop src; pop dst; memcpy            |
+| 31  | copy_string     | —       | pop srcSize; pop dstSize; pop src; pop dst; copy NUL-terminated |
+| 32–3B | store_local_n | —       | pop; `FP[-(op & 0x0F)] := value` (s2..−11)    |
+| 3C  | store_local     | i8 n    | pop; `FP[n] := value`                         |
+| 3D  | store_global    | u8 n    | pop; `GP[n] := value`                         |
+| 3E  | store_stack     | u8 n    | pop; pop p; `p[n] := value`                   |
+| 3F  | store_extern    | mod,var | pop; `MTBL[mod][var] := value`                |
+
+### 11.3 0x40–0x5F — extended dispatch, global 2–15
+
+| Hex | Mnemonic        | Effect                                        |
+|-----|-----------------|-----------------------------------------------|
+| 40  | extended        | secondary dispatch (§10.2)                    |
+| 41  | load_stack_d0   | pop p; push slot `p[0]` (alias of 60H, retained) |
+| 42–4F | load_global_n | push `GP[op & 0x0F]` (offsets 2–15)           |
+| 50  | end_program     | return control to the loader/kernel           |
+| 51  | store_stack_d0  | pop v; pop p; store slot `p[0]` (alias of 70H)|
+| 52–5F | store_global_n | pop; `GP[op & 0x0F] := value` (2–15)          |
+
+### 11.4 0x60–0x7F — indirect loads/stores (offsets 0–15)
+
+| Hex | Mnemonic     | Effect                                             |
+|-----|--------------|----------------------------------------------------|
+| 60–6F | load_i_n  | pop p; push `p[op & 0x0F]` (one slot)            |
+| 70–7F | store_i_n  | pop v; pop p; `p[op & 0x0F] := v` (one slot)     |
+
+### 11.5 0x80–0x9F — addresses, leaves, strings, immediates
+
+| Hex | Mnemonic        | Operand | Effect                                        |
+|-----|-----------------|---------|-----------------------------------------------|
+| 80  | load_local_addr | i8 n    | push byte addr `FP + n*8`                      |
+| 81  | load_global_addr| u8 n    | push byte addr `GP + n*8`                      |
+| 82  | load_stack_addr | u8 n    | pop p; push `p + n*8`                          |
+| 83  | load_extern_addr| mod,var | push byte addr `MTBL[mod] + var*8`             |
+| 84  | proc_leave      | u8 n    | leave: drop `n & 0x7F` words; re-enter if bit7  |
+| 85  | fct_leave       | u8 n    | res:=pop; proc_leave n; push res               |
+| 86  | longfct_leave   | u8 n    | q:=pop; proc_leave n; push q (quad)            |
+| 87  | asmcode         | u8 n    | native code block; unimplemented in baseline   |
+| 88–8B | leave (0..3)   | —       | leave, drop 0..3 words, bit7 set (outer return)|
+| 8C  | call_rel        | u8 n    | push `IP`; `IP += n` (pc-relative string ptr)  |
+| 8D  | load_imm_byte   | u8      | push zero-extended u8                          |
+| 8E  | load_imm_word   | u64     | push 64-bit immediate (8 bytes)                |
+| 8F  | load_imm_quad   | 16 bytes| push quad constant (low word on top)           |
+| 90–9F | load_imm 0–15  | —       | push small constant `op & 0x0F`                |
+
+### 11.6 0xA0–0xBF — comparisons, integer arithmetic, conversions
+
+| Hex | Mnemonic        | Effect                                        |
+|-----|-----------------|-----------------------------------------------|
+| A0  | equal           | pop b; push (pop = b)   (full slot, any width)|
+| A1  | not_equal       | pop b; push (pop # b)                         |
+| A2  | uless           | pop b; push (pop < b)     (CARDINAL, 32-bit)  |
+| A3  | ugreater        | pop b; push (pop > b)     (CARDINAL)          |
+| A4  | uless_eq        | pop b; push (pop <= b)    (CARDINAL)          |
+| A5  | ugreater_eq     | pop b; push (pop >= b)    (CARDINAL)          |
+| A6  | add             | pop b; push (pop + b)  (CARDINAL, mod 2^32)   |
+| A7  | sub             | pop b; push (pop - b)  (CARDINAL, mod 2^32)   |
+| A8  | umul            | pop b; push (pop * b)     (CARDINAL)          |
+| A9  | udiv            | pop b; push (pop DIV b)  (raise DivideByZero) |
+| AA  | umod            | pop b; push (pop MOD b)  (raise DivideByZero) |
+| AB  | eq0             | push (pop = 0)                                |
+| AC  | inc             | push (pop + 1)        (32-bit)               |
+| AD  | dec             | push (pop - 1)        (32-bit)               |
+| AE  | add_imm         | u8 n; push (pop + n)      (CARDINAL)          |
+| AF  | sub_imm         | u8 n; push (pop - n)      (CARDINAL)          |
+| B0  | shl_imm         | u8 n; push (pop << n)      (CARDINAL, logical)|
+| B1  | shr_imm         | u8 n; push (pop >> n)      (logical)          |
+| B2  | iless           | pop b i32; push (pop < b)   (INTEGER)          |
+| B3  | igreater        | pop b i32; push (pop > b)   (INTEGER)          |
+| B4  | iless_eq        | pop b i32; push (pop <= b)  (INTEGER)          |
+| B5  | igreater_eq     | pop b i32; push (pop >= b)  (INTEGER)          |
+| B6  | not             | push (¬ bool(pop))                            |
+| B7  | complement      | push (0xFFFFFFFF − pop)  (32-bit bitwise NOT) |
+| B8  | imul            | pop b i32; push (pop * b)  (INTEGER)           |
+| B9  | idiv            | pop b i32; push (pop DIV b) (raise DivideByZero) |
+| BA  | long_to_card    | pop LONGINT; push CARDINAL (low 32 bits, zero-extended) |
+| BB  | long_to_int     | pop LONGINT; push INTEGER (low 32 bits, sign-extended) |
+| BC  | abs             | pop i32; push |v|                             |
+| BD  | int_to_long     | pop INTEGER; push LONGINT (sign-extended)     |
+| BE  | long_to_real    | pop LONGINT; push REAL (rounded)              |
+| BF  | real_to_long    | pop REAL; push LONGINT (truncated)            |
+
+Notes: `CARDINAL`-`LONGCARD` and `LONGCARD`-`LONGINT` widenings are value no-ops (all are
+one slot; see §4). Because 32-bit errors would be silent, CARDINAL/INTEGER arithmetic
+uses the *checked* forms of §11.7 when `CHECK`-range diagnostics are enabled.
+
+### 11.7 0xC0–0xDF — checked/long/real arithmetic, switch, short-circuit
+
+| Hex | Mnemonic        | Effect                                        |
+|-----|-----------------|-----------------------------------------------|
+| C0  | uadd_checked    | pop b; push (pop + b)  (CARDINAL; raise Overflow on wrap) |
+| C1  | usub_checked    | pop b; push (pop - b)  (CARDINAL; raise on borrow) |
+| C2  | umul_checked    | pop b; push (pop * b)  (CARDINAL; raise on overflow) |
+| C3  | system          | host call (§9.3)                              |
+| C4  | string_comp     | see §12.1                                     |
+| C5  | long_compare    | pop b; pop a; push (a>b), push (a<b) (LONGINT, signed 64) |
+| C6  | long_add        | pop b; pop a; push a + b (LONGINT)            |
+| C7  | long_sub        | pop b; pop a; push a − b                      |
+| C8  | long_mul        | pop b; pop a; push a × b                      |
+| C9  | long_div        | pop b; pop a; push a DIV b (signed; raise on 0)|
+| CA  | long_mod        | pop b; pop a; push a MOD b (signed; raise on 0)|
+| CB  | not_zero        | push (pop # 0)                                |
+| CC  | long_abs        | pop a; push |a| (LONGINT)                     |
+| CD  | switch          | §12.2 (case tables)                           |
+| CE  | jump_stack      | pop; IP := value (computed jump/return)       |
+| CF  | push_code_addr  | u64; push (IP - 1 + off)  (pc-relative)       |
+| D0  | iadd_checked    | pop b i32; push (pop + b); raise Overflow (INTEGER) |
+| D1  | isub_checked    | pop b i32; push (pop - b); raise Overflow (INTEGER) |
+| D2  | reserve         | pop size; check limit; SP -= size; push new SP|
+| D3  | reserve_string  | see §13                                     |
+| D4  | enter           | u8 k — prologue, reserve (255−k)*8 bytes      |
+| D5  | real_compare    | pop r2; pop r1; push r1>r2, push r1<r2 (REAL) |
+| D6  | real_add        | pop r2; pop r1; push r1+r2        (REAL)      |
+| D7  | real_sub        | pop r2; pop r1; push r1−r2                    |
+| D8  | real_mul        | pop r2; pop r1; push r1×r2                    |
+| D9  | real_div        | pop r2; pop r1; push r1/r2                    |
+| DA  | urange_check    | pop low; pop size; Top in [low, low+size]?  (CARDINAL) |
+| DB  | irange_check    | pop low i32; pop size; Top in [low, low+size]?  (INTEGER) |
+| DC  | limit_check     | u8 n; if Top() > n raise RangeError (CARDINAL) |
+| DD  | check_positive  | if (i32)Top() < 0 raise RangeError (INTEGER)  |
+| DE  | and_jp          | u8 n; if not pop then push false; IP += n     |
+| DF  | or_jp           | u8 n; if pop then push true; IP += n          |
+
+### 11.8 0xE0–0xFF — jumps, bit sets, calls
+
+| Hex | Mnemonic        | Operand | Effect                                        |
+|-----|-----------------|---------|-----------------------------------------------|
+| E0  | jp              | i64     | IP += rel                                      |
+| E1  | jpfalse         | i64     | if not pop then IP += rel                      |
+| E2  | jp_fwd          | i8      | IP += rel                                      |
+| E3  | jpfalse_fwd     | i8      | if not pop then IP += rel                      |
+| E4  | jp_back         | u8      | IP -= rel                                      |
+| E5  | jpfalse_back    | u8      | if not pop then IP -= rel                      |
+| E6  | bit_or          | —       | pop b; push bitset(pop) ∪ bitset(b)            |
+| E7  | bit_in          | —       | pop b; push (pop ∈ bitset(b))                  |
+| E8  | bit_and         | —       | pop b; push bitset(pop) ∩ bitset(b)            |
+| E9  | bit_xor         | —       | pop b; push bitset(pop) △ bitset(b)            |
+| EA  | power2          | —       | push (1 << pop)                                |
+| EB  | extern_proc_call| —       | n:=pop; base:=pop; call via MTBL (base=addr)   |
+| EC  | nested_call     | u8 n    | call proc n with OFP = FP (static nesting)     |
+| ED  | proc_call       | u8 n    | call proc n, OFP = NIL                          |
+| EE  | call_with_frame | u8 n    | pop f; call proc n with OFP = f                 |
+| EF  | extern_call     | mod,proc| call proc in module `mod` (2 operands)         |
+| F0  | extern_call_nib | nibble  | call proc `n` in module `m` (high/low nibbles) |
+| F1–FF | call 1..15   | —       | call proc `op & 0x0F`, OFP = NIL               |
+
+Jump offsets are relative to the address **after** the operand(s). All jumps except
+`E0/E1` are byte offsets; `E0/E1` carry a full 64-bit signed offset.
+
+SET operations (0E6H–0EAH) operate on the 64-bit `SET` type; element indices are
+0..63 and `power2` computes `1 << pop` (mod 2^64).
+
+---
+
+## 12. Complex instructions
+
+### 12.1 String compare (0C4H)
+
+```
+pop size2; pop size1        ; buffer lengths (bytes)
+pop str2; pop str1
+compare char-by-char up to a NUL terminator or exhausted size
+push (str1 > str2)          ; boolean
+push (str1 < str2)          ; boolean
+```
+
+The caller consumes the two booleans (typically `or_jp` / `and_jp` to build lexicographic
+ordering tests).
+
+### 12.2 Switch / case statement (0CDH)
+
+Encoding after the opcode:
+
+```
+lowBound        u64
+highBound       u64
+retOffset       i64   ; reserved; must be 0
+jumpTable       (highBound − lowBound + 1) × i64
+```
+
+Dispatch:
+
+```
+N := high − low + 1
+first := address of the first table cell
+endOfTable := first + N*8
+if value < lowBound or value > highBound:
+    IP := endOfTable                       ; default code follows the table
+else:
+    cell := first + (value − lowBound)*8
+    off  := (i64)*cell
+    if off < 0:                            ; call-switch form
+        push endOfTable                    ; return address after the table
+    IP := cell + 8 + off
+```
+
+Entry offsets are relative to the *end* of their own cell; a negative offset denotes a
+call-switch (each case is a procedure, returning to the code after the table).
+`retOffset` is retained for encoding compatibility with MCode/16 and must be 0.
+
+### 12.3 `reserve_string` (0D3H and `0x40 0x12`)
+
+```
+src     := pop                  ; byte address of the string data
+nBytes  := pop
+nWords  := (nBytes + 7) DIV 8
+copy nWords words from src onto the stack (stack limit checked)
+push the address of the copy    ; top of the copied region
+```
+
+Used by the compiler to materialize a local owned copy of a string constant (the
+constant itself lives in the code area at a pc-relative address).
+
+---
+
+## 13. Initialization sequence
+
+```
+Call(modName):
+  save current module chain and caller frame
+  MARK(heap)
+  LoadWithDependencies(modName)
+  for each newly loaded module:
+      allocate + zero global variables
+  for each module flagged TOINIT, in load order:
+      GP := module base
+      FP := fresh frame            ; reference frame
+      IP := procedureAddress(module, 0)        ; its initializer
+      Run()
+  RELEASE(heap mark)
+  restore caller module chain
+```
+
+The *last* module initialized is the requested one; this is how the system boots the
+target module and returns to the shell when it ``end_program``s.
+
+---
+
+## 14. Differences from MCode/16 (migration notes)
+
+| MCode/16                              | MC64                                  |
+|---------------------------------------|---------------------------------------|
+| word = 16 bits, address space 64 KB   | word = 64 bits, address space 2^64    |
+| scalar types 16 bits; LONGINT/REAL 32 bits (2 words); LONGREAL 64 (4 words) | CARDINAL/INTEGER 32 bits; SET/LONGINT/LONGCARD 64 bits; REAL 64-bit float; LONGREAL 128 bits (2 slots) |
+| byte/nibble operands (bytes, # args, depths) | byte operands unchanged; all *word* operand fields widened 2→8 bytes |
+| local addressing in bytes (F+2n)      | local addressing in words (FP ± n*8)   |
+| global window 64 K words, module table in top entries | window of ≥64 K words + dedicated 256-slot module table `MTBL` |
+| module baseline tables relative to base−2/−18/−14 | explicit `procsAddr`, `loadAddr`, `dependencies[]` fields (module descriptor) |
+| `Enter` reserves 255−n **bytes**      | `Enter` reserves (255−n)×**8** bytes    |
+| immediates: byte / 2-byte word / 4-byte dword | byte / 8-byte word / 16-byte quad   |
+| switch tables: 16-bit offsets, +8000H unsigned trick | 64-bit signed offsets, plain unsigned compare, `retOffset` reserved |
+| proc table: `base-2` cell, +1+offset   | `procsAddr` + k*8 + offset             |
+| BDOS 0C3H                              | `SYSTEM` host-call ABI (§9.3)          |
+| `.MCD` (no magic, CP/M 8-char names)   | `.MC4` (magic header, 16-char names, 64-bit fields) |
+
+All 256 opcodes keep their MCode/16 *position* in the map; only operand widths and the
+scalar→(32/64/128-bit) mapping differ. The scalar word-op families (0A0H–0BFH) are
+32-bit; the "long" families (0C5H–0CCH) are 64-bit; LONGCARD arithmetic is provided by
+the extended sub-dispatch (§10.2).
+
+---
+
+## 15. Minimal encoding example
+
+A procedure `P(x: CARDINAL): CARDINAL` that computes `2*x + 1` (32-bit CARDINAL ops):
+
+```
+  d4 fe      enter -2                     ; prologue: reserve (255-0xFE)*8 = 8 bytes (1 slot)
+  8d 02      load_imm_byte 2
+  3c fe      store_local -2               ; tmp := 2
+  03         load_param1                  ; x   (FP[3])
+  2c fe      load_local -2                ; tmp
+  a8         umul                         ; CARDINAL multiply (32-bit)
+  8d 01      load_imm_byte 1
+  a6         add                          ; CARDINAL add (32-bit)
+  85 01      fct_leave 1                  ; return; drop 1 word (the parameter)
+```
+
+Provenance: transcribed from the reverse-engineering of Borland Turbo Modula-2 (CP/M
+Z80), the `MCode_specification` bytecode interpreter in `Reversing-Turbo-Modula2`.
+
+---
+
+## 16. GNU Modula-2 (ISO) implementation notes
+
+The reference interpreter in `mc64/` is written in **pure ISO Modula-2** and compiled
+exclusively with `gm2 -fiso`. These notes record the GNU M2 idioms and constraints the
+source relies on.
+
+### 16.1 Build rules
+
+- Every module is compiled with `gm2 -fiso -c <module>.mod`.
+- Only a **program module** is passed to the link step; library modules are given as
+  pre-compiled `.o`. Passing several `.mod` files at once makes gm2 emit one `main` per
+  module and the link fails on duplicate `main`.
+- Deterministic build: `Memory Local Global Stack Instruction Extended Interpreter
+  Loader2 Console FileIO` (each `.mod`), then `MC64.mod` and `mkdemo.mod`, then
+  `gm2 -fiso -o mc64 MC64.mod <12 .o>` and `gm2 -fiso -o mkdemo mkdemo.mod <12 .o>`.
+
+### 16.2 Language constraints observed
+
+- **`AND`/`OR` are Boolean-only**: gm2's ISO front end has no integer bitwise `AND`/`OR`.
+  Integer bitwise ops are done with a `BitOp(a, b, mode)` loop (64 iterations of
+  `DIV 2^k`/`MOD 2`); bit *masking* uses `MOD`/`DIV` arithmetic (`opc MOD 16`,
+  `(fl DIV 4) MOD 2` for the TOINIT bit). A stray integer `AND` typically surfaces as a
+  misleading *"is not a boolean expression"* diagnostic pointed at a `VAR` declaration
+  several lines earlier.
+- **Ignored function results are errors**: a bare `Pop () ;` (return value discarded)
+  does not compile; always capture into a variable.
+- **Variant records**: the tag must be an exhaustive choice; `CASE : BOOLEAN OF |
+  TRUE: ... | FALSE: ...` works, `CASE : CARDINAL OF` is rejected ("not all variant
+  record alternatives"). This is the mechanism used to reinterpret a 64-bit slot as
+  `REAL`/`LONGCARD` and a 128-bit `LONGREAL` as two slots.
+- **No import alias**: `FROM m IMPORT x AS y` is a parse error. Name clashes (e.g.
+  `IOChan.WriteLn` vs a local `WriteLn`) are avoided by not importing the colliding name
+  (the module writes `LF` itself).
+- **Set constructors**: an inline `FlagSet{...}` argument can crash gm2
+  ("internal compiler error: expecting ConstVar symbol"); assign the constructor to a
+  local `VAR` and pass the variable instead.
+- **Definition modules**: an `IMPORT` must precede `EXPORT QUALIFIED`.
+- **`HALT(n)`** works under `-fiso` and is used for fatal host errors (`THROW` aborts
+  with `SIGABRT`).
+
+### 16.3 Host services
+
+- No libc: no `DEFINITION MODULE FOR "C"`, no M2PIM legacy modules (`Args`,
+  `UnixArgs`, …). Vendor `m2pim` modules fail to link against `-fiso` objects.
+- `System.ProgramArgs.ArgChan` is **not usable** in this gm2 build: `TextRead` on it
+  blocks forever and `Look` returns a `'.'` filler instead of `endOfInput`. The VM
+  therefore boots a fixed `boot.mc4` (generated by `mkdemo`) instead of parsing argv.
+- File I/O uses `StreamFile.Open/Close` + `IOChan.RawRead/RawWrite` (`ChanConsts`
+  `FlagSet{readFlag, oldFlag, rawFlag}` / `{writeFlag, rawFlag}`).
+- Screens output writes go to the ISO standard output channel
+  (`StdChans.StdOutChan`) with `IOChan.TextWrite`; LC real values go out via
+  `RealStr.RealToStr`.
+
+### 16.4 Machine representation
+
+- Slots are 64-bit Little-Endian, addressed through a 16 MiB static `CHAR` arena
+  (`Memory.ms`, `MaxMem = 16777216`) with byte-assembling readers/writers
+  (`ReadSlot/WriteSlot`, `ReadLong/WriteLong`, `ReadWord/WriteWord`).
+- The image is loaded at `ArenaBase = 1048576` via `LoadImage(data, off, dst, n)`
+  (images start at file offset 64, hence the source offset parameter). 32-bit descriptor
+  fields (e.g. `checksum`) must be read with `ReadLong`, never with the 8-byte reader.
+- `LONGCARD` is used for addresses, stack slots and 64-bit arithmetic; untyped literals,
+  `H`-suffixed hex constants and `VAL` conversions all compile under `-fiso`.

docs/session-summary.md

@@ -0,0 +1,106 @@
+# Modula-2 VM/Interpreter — session summary
+
+Goal: reproduce, in GNU Modula-2 (`gm2 -fiso`) running on real hardware, the classic
+Turbo Modula-2 Z80 interpreter as a **64-bit MC64** machine, driven by `mc64-spec.md`.
+Constraints honored so far: no analysis/disassembly of `.MCD` binaries — work from
+`.mod`/`.def` sources and the spec; module library compiled separately with `-c`.
+
+## Project layout
+- `M2compiler/mc64/` — all VM code:
+  `Memory, Local, Stack, Console, FileIO, Global, Instruction, Extended, Interpreter,
+  Loader2` (.def + .mod);
+  programs `MC64.mod` (REPL harness), `mkdemo.mod` (`boot.mc4`), `mcint.mod`
+  (`mcint file.MCD` launcher), `mkdtest.mod` (`example.MCD` generator);
+  built: `mkdemo`, `mc64`, `mcint`, `mkdtest`, `boot.mc4`, `example.MCD`.
+- `M2compiler/mc64-spec.md` — normative spec (§5.2 frames, §7.1 descriptor layout,
+  §8.3 checksum rule, §9.3 SYSTEM ABI, §10 0x12/0x40 sub-dispatches, §11 opcode table,
+  §12 switch/strings, §16 GNU-M2 ISO implementation notes).
+- `M2compiler/m-code-summary-64.md`, `m-code-summary.md` — opcode summaries.
+- `M2compiler/Resources/Turbo-reloaded/Reversing-Turbo-Modula2-main/MCode_specification/`
+  — reference Turbo M2 sources (used only as Modula-2 sources, never binary analysis).
+- gm2 ISO libs at `.../gcc/x86_64-pc-linux-gnu/16.0.1/m2/m2iso/`; `FIO` at `m2/m2pim/`.
+
+## Build recipes
+Libraries are pre-compiled and linked as `.o` (only the program `.mod` is passed to the
+link step — multiple `.mod` files would collide on `main`):
+```
+for m in Memory Local Global Stack Instruction Extended Interpreter Loader2 Console FileIO; do
+  gm2 -fiso -c $m.mod; done
+gm2 -fiso -o mkdemo mkdemo.mod FileIO.o Console.o
+gm2 -fiso -o mc64   MC64.mod   Stack.o Memory.o Console.o ...   # library set only
+gm2 -fiso -o mcint  mcint.mod Loader2.o Interpreter.o Extended.o Instruction.o \
+        Stack.o Global.o Local.o Memory.o Console.o FileIO.o
+gm2 -fiso -o mkdtest mkdtest.mod FileIO.o Console.o
+```
+
+## Verification status (all green)
+- `./mkdemo` -> `boot.mc4` ; `./mc64` -> `Hello MC64!` + `[vm end]` (0) ;
+  `./mcint boot.mc4` -> `Hello MC64!` (0) ; `./mcint` -> usage (0) ;
+  `./mcint nope.MCD` -> Fatal (1).
+- `./mkdtest` -> `example.MCD` (1350 B, MC64 format) ; `./mcint example.MCD` — 24/24
+  opcode-checks pass (exit 0):
+  loop g:=2g+1 x10 = 2047; add/sub/mul/div/mod; bit_and/or/xor & power2;
+  extended 0x40: drop, uc_add, uc_mul, uc_div, uc_mod, long_negate, build_field_mask;
+  load_imm_word; real_add 3.5+2.25 -> 5 (real_to_long); dup/swap;
+  copy_block -> "abc"; global/local_dw load/store; load_global_dw;
+  forward jp_fwd; jpfalse_back loops; proc_call into decimal `print_num`
+  (enter/fct_leave, load_param, reserve, udiv/umod, store_indexed_byte).
+  - `./mkread` -> `readtest.MCD` (453 B) ; `./mcint readtest.MCD` — SYSTEM service 2
+  reads stdin lines: `printf 'first line\nsecond line\n' | ./mcint readtest.MCD`
+  echoes `you said: first line` then `again: second line` (0). Edge cases verified:
+  EOF without trailing newline still echoes; empty line -> count 0; immediate EOF -> 0;
+  two consecutive reads prove the line mark is consumed (Skip) so the next read starts fresh.
+- `./mcint boot.mc4` -> `Hello MC64!` (0) ; `./mcint example.MCD` — 24/24 (0).
+- Public-dollar checks: `::` VM accepts THE-SPEC–conformant images only.
+
+## Key technical facts learned
+- `AND`/`OR` are BOOLEAN-only under `-fiso`; integer bitwise ops run through
+  `BitOp(a,b,mode)` (64 iterations of DIV/MOD) in `Interpreter.mod`. Masks use
+  `MOD`/`DIV` (e.g. `opc MOD 16`, `(fl DIV 4) MOD 2`), never integer `AND`.
+- A stray integer `AND` in a program printed a misleading “is not a boolean expression”
+  diagnostic pointing at a VAR declaration.
+- Standalone `Pop();` (ignored return value) is a compile error.
+- Variant records need BOOLEAN tags (`CASE : BOOLEAN OF | TRUE: | FALSE:`);
+  `FROM m IMPORT x AS y` aliases not supported; set constructors inline can ICE gm2
+  (assign to a VAR first); `HALT` works.
+- `argv` works via `TextIO.ReadString(ArgChan(), s)` after `NextArg` (one arg per call,
+  program name excluded; a trailing empty argument means “no argument”).
+- `FIO` (m2pim) links fine under `-fiso`: `OpenToRead`, `ReadNBytes(f,n,ADR(buf))`,
+  `IsNoError`, `Close`. `Loader2.mod` reads images with it.
+- Linking: only the program `.mod` goes to the link step; libraries are `.o` files.
+- On-disk image: file bytes 0..63 header, magic `"MC64"`; image starts at file 64;
+  descriptor image offsets: DescDeps=0, DescLink=256, DescName=264, DescLoadAddr=280,
+  DescChecksum=288 (u32), DescFlags=292, DescVarCount=293, DescDepCount=294,
+  DescPad=295, DescProcs=296, DescVarSizes=304.
+- Checksum = 32-bit sum of file bytes 64..(size-1) excluding file 352..355
+  (the checksum field itself).
+- `LoadImage(VAR data; off; dst; n)` gained an offset (`off=64`) since images start at
+  file offset 64; 32-bit fields read with `ReadLong`, not 8-byte `ReadWord`/`ReadSlot`.
+- Loader: image copied to `ArenaBase`=1048576; `dataWin = desc+imgLen` (8-aligned);
+  `GP = dataWin`; `procAddr(k) = procsAddr + k*8 + cell[k]` (cell relative to its slot;
+  negative when the target precedes the table); TOINIT = `flags` bit 2 ⇒
+  `SetIP(ProcedureAddress(0,0)); Run()`; `Run` returns on opcode 0x50.
+- Stack machine stack grows downward; `Push` = `SetSP(SP-8)` then write slot;
+  params land at callee `FP[3..7]` (param 1 = the value on top at the call).
+- `store_indexed_byte` (0x1D) pops `(value, index, ptr)` — push `(addr, 0, val)`;
+  `copy_block` (0x30) pops `(size, src, dst)` — push `dst, src, size`;
+  `build_field_mask` pops high/low — push low first, then high.
+- Proc table must not overlap code (put it after the code).
+- SYSTEM service 2 (read line) implemented via ISO `StdChans.StdInChan` +
+  `IOChan.Look/Skip` char loop (avoids `TextRead`'s "current line" blocking);
+  stores chars up to (not incl.) line mark or EOF, NUL-terminates, pushes byte count.
+  Documented in spec §9.3; readtest.MCD exercises it.
+
+## Current task state
+- Writing an **MCD example file** to exercise the interpreter: **DONE** —
+  `mkdtest.mod` -> `example.MCD`, 24 opcode-checks pass under `./mcint`.
+- **stdin support for SYSTEM service 2**: **DONE** — implemented in `Interpreter.mod`
+  (`ReadLine`), `mc64-spec.md` §9.3 updated, `mkread.mod` -> `readtest.MCD` proves
+  line reads + line-mark consumption under piped input.
+
+## Next steps / open ideas
+- 16→64 translation pass so classic 16-bit Z80 `.MCD` binaries can run on `mcint`
+  (widening MCode operands 2→8 bytes and descriptor fields); currently unimplemented.
+- Hardware traps 0x45 (button/joystick/audio — currently no-ops), `0x08` output with
+  cursor positioning, more `.mod` demos (blocks/frames/0x40-calls), cross-check vs the
+  Turbo-reloaded reference interpreter.

mcint.mod

@@ -0,0 +1,29 @@
+MODULE mcint ;
+
+(* Standalone launcher for the MC64 interpreter.
+   usage: mcint module.MCD
+   The first program argument is treated as the module file to boot. *)
+
+FROM Loader2 IMPORT Call ;
+FROM ProgramArgs IMPORT ArgChan, NextArg ;
+FROM TextIO IMPORT ReadString ;
+FROM STextIO IMPORT WriteString, WriteLn ;
+
+VAR
+  fname : ARRAY [0 .. 511] OF CHAR ;
+
+PROCEDURE Usage ;
+BEGIN
+  WriteString ("usage: mcint module.MCD") ;
+  WriteLn ;
+END Usage ;
+
+BEGIN
+  NextArg ;
+  ReadString (ArgChan (), fname) ;
+  IF fname [0] = 0C THEN
+    Usage ;
+  ELSE
+    Call (fname) ;
+  END ;
+END mcint.

mkdemo.mod

@@ -0,0 +1,108 @@
+MODULE mkdemo ;
+
+(* Generates boot.mc4, a single-module MC64 image that prints
+   "Hello MC64!" via the SYSTEM write-string service (§9.3). *)
+
+FROM FileIO IMPORT WriteFile ;
+FROM Console IMPORT Fatal ;
+FROM SYSTEM IMPORT ADR ;
+
+CONST
+  HeaderSize = 64 ;
+  DescDeps = 0 ;
+  DescLink = 256 ;
+  DescName = 264 ;
+  DescLoadAddr = 280 ;
+  DescChecksum = 288 ;
+  DescFlags = 292 ;
+  DescVarCount = 293 ;
+  DescDepCount = 294 ;
+  DescPad = 295 ;
+  DescProcs = 296 ;
+  ProcTable = 304 ;
+  CodeOff = 312 ;
+  FileSize = 396 ;
+  StrOff = 314 ;        (* image offset of the string *)
+  StrLen = 14 ;         (* 11 chars + CR + LF + NUL *)
+
+VAR
+  buf : ARRAY [0 .. FileSize - 1] OF CHAR ;
+  i : CARDINAL ;
+  sum : CARDINAL ;
+
+PROCEDURE Put32 (off, v : CARDINAL) ;
+BEGIN
+  buf [off] := CHR (v MOD 256) ;
+  buf [off + 1] := CHR ((v DIV 256) MOD 256) ;
+  buf [off + 2] := CHR ((v DIV 65536) MOD 256) ;
+  buf [off + 3] := CHR (v DIV 16777216) ;
+END Put32 ;
+
+PROCEDURE Put64 (off : CARDINAL; v : LONGCARD) ;
+VAR j : CARDINAL ;
+BEGIN
+  FOR j := 0 TO 7 DO
+    buf [off + j] := CHR (VAL (CARDINAL, v MOD 256)) ;
+    v := v DIV 256 ;
+  END ;
+END Put64 ;
+
+BEGIN
+  FOR i := 0 TO FileSize - 1 DO
+    buf [i] := 0C ;
+  END ;
+
+  (* file header (64 bytes) : magic *)
+  buf [0] := 'M' ;
+  buf [1] := 'C' ;
+  buf [2] := '6' ;
+  buf [3] := '4' ;
+
+  (* descriptor *)
+  buf [HeaderSize + DescName] := 'd' ;
+  buf [HeaderSize + DescName + 1] := 'e' ;
+  buf [HeaderSize + DescName + 2] := 'm' ;
+  buf [HeaderSize + DescName + 3] := 'o' ;
+  buf [HeaderSize + DescFlags] := CHR (4) ;      (* TOINIT *)
+  buf [HeaderSize + DescVarCount] := CHR (0) ;
+  buf [HeaderSize + DescDepCount] := CHR (0) ;
+  Put64 (HeaderSize + DescProcs, 304) ;          (* proc table image offset *)
+
+  (* procedure table : proc0 at image offset 312 *)
+  Put64 (HeaderSize + ProcTable, 8) ;
+
+  (* code : call_rel 14 ; "Hello MC64!\r\n\0" ; load_imm_byte 1 ; system ; end *)
+  buf [HeaderSize + CodeOff] := CHR (8CH) ;      (* call_rel *)
+  buf [HeaderSize + CodeOff + 1] := CHR (14) ;
+  buf [HeaderSize + StrOff] := 'H' ;
+  buf [HeaderSize + StrOff + 1] := 'e' ;
+  buf [HeaderSize + StrOff + 2] := 'l' ;
+  buf [HeaderSize + StrOff + 3] := 'l' ;
+  buf [HeaderSize + StrOff + 4] := 'o' ;
+  buf [HeaderSize + StrOff + 5] := ' ' ;
+  buf [HeaderSize + StrOff + 6] := 'M' ;
+  buf [HeaderSize + StrOff + 7] := 'C' ;
+  buf [HeaderSize + StrOff + 8] := '6' ;
+  buf [HeaderSize + StrOff + 9] := '4' ;
+  buf [HeaderSize + StrOff + 10] := '!' ;
+  buf [HeaderSize + StrOff + 11] := 13C ;        (* CR *)
+  buf [HeaderSize + StrOff + 12] := 12C ;        (* LF *)
+  buf [HeaderSize + StrOff + 13] := 0C ;         (* NUL *)
+  buf [HeaderSize + CodeOff + 16] := CHR (8DH) ; (* load_imm_byte *)
+  buf [HeaderSize + CodeOff + 17] := CHR (1) ;
+  buf [HeaderSize + CodeOff + 18] := CHR (0C3H) ; (* system *)
+  buf [HeaderSize + CodeOff + 19] := CHR (50H) ;  (* end_program *)
+
+  (* checksum over the image, excluding the checksum field itself *)
+  sum := 0 ;
+  FOR i := HeaderSize TO FileSize - 1 DO
+    IF NOT ((i >= 352) AND (i <= 355)) THEN
+      sum := sum + ORD (buf [i]) ;
+    END ;
+  END ;
+  Put32 (HeaderSize + DescChecksum, sum) ;
+
+  IF NOT WriteFile ("boot.mc4", buf, FileSize) THEN
+    Fatal ("mkdemo: cannot write boot.mc4") ;
+  END ;
+END mkdemo.

mkdtest.mod

@@ -0,0 +1,347 @@
+MODULE mkdtest ;
+
+(* Generates example.MCD, a single-module MC64 image that exercises far
+   more of the interpreter than boot.mc4 :
+
+     proc0 (TOINIT, main) :
+       - a CARDINAL do-while loop  g := g*2+1  (10 iterations)  -> 2047
+       - 32-bit arithmetic : add sub mul div mod
+       - bit set ops / power2 (BitOp, Shl64)
+       - 0x40 extended dispatch : drop, uc_add, uc_mul, uc_div, uc_mod,
+         long_negate, build_field_mask
+       - load_imm_word (0x8E), real arithmetic (real_add -> real_to_long)
+       - dup / swap / copy_block
+       - control flow : jp_fwd (0xE2), jpfalse_back (0xE5), jp_back (0xE4)
+       - load/store global (0x2D/0x3D), global_dw (0x09), local_dw
+         (0x08/0x18), proc_call (0xED) to proc1
+
+     proc1 (print_num) :
+       prints the CARDINAL in FP[3] as decimal text followed by CRLF via
+       the SYSTEM write-string service.  Exercises Enter/Leave (0xD4/0x85),
+       load_param (0x03), reserve (0xD2), udiv/umod (0xA9/0xAA),
+       store_indexed_byte (0x1D) and a do-while digit loop. *)
+
+FROM FileIO IMPORT WriteFile ;
+FROM Console IMPORT Fatal ;
+FROM SYSTEM IMPORT ADR ;
+
+CONST
+  HeaderSize = 64 ;
+  DescName = 264 ;
+  DescChecksum = 288 ;
+  DescFlags = 292 ;
+  DescVarCount = 293 ;
+  DescDepCount = 294 ;
+  DescProcs = 296 ;
+  ProcTable = 304 ;
+  CodeOff = 312 ;
+  BufSize = 4096 ;
+
+VAR
+  buf : ARRAY [0 .. BufSize - 1] OF CHAR ;
+  pcimg : CARDINAL ;        (* image-relative cursor into the code *)
+  i, sum : CARDINAL ;
+  lp : CARDINAL ;           (* loop label *)
+  p1, pt : CARDINAL ;       (* image offsets of proc1 and the proc table *)
+
+TYPE
+  RealView = RECORD CASE : BOOLEAN OF
+               | TRUE : r : REAL ;
+               | FALSE : w : LONGCARD ;
+             END ;
+           END ;
+
+VAR
+  rv : RealView ;
+
+PROCEDURE Op (o : CARDINAL) ;
+BEGIN
+  buf [HeaderSize + pcimg] := CHR (o MOD 256) ;
+  INC (pcimg) ;
+END Op ;
+
+PROCEDURE OpB (o, b : CARDINAL) ;
+BEGIN
+  Op (o) ;
+  buf [HeaderSize + pcimg] := CHR (b MOD 256) ;
+  INC (pcimg) ;
+END OpB ;
+
+PROCEDURE Put32 (off, v : CARDINAL) ;
+BEGIN
+  buf [off] := CHR (v MOD 256) ;
+  buf [off + 1] := CHR ((v DIV 256) MOD 256) ;
+  buf [off + 2] := CHR ((v DIV 65536) MOD 256) ;
+  buf [off + 3] := CHR (v DIV 16777216) ;
+END Put32 ;
+
+PROCEDURE Put64 (off : CARDINAL ; v : LONGCARD) ;
+VAR j : CARDINAL ;
+BEGIN
+  FOR j := 0 TO 7 DO
+    buf [off + j] := CHR (VAL (CARDINAL, v MOD 256)) ;
+    v := v DIV 256 ;
+  END ;
+END Put64 ;
+
+PROCEDURE ImmB (b : CARDINAL) ;
+BEGIN
+  OpB (8DH, b) ;             (* load_imm_byte *)
+END ImmB ;
+
+PROCEDURE ImmU64 (v : LONGCARD) ;
+BEGIN
+  Op (8EH) ;                 (* load_imm_word, 8-byte immediate *)
+  Put64 (HeaderSize + pcimg, v) ;
+  INC (pcimg, 8) ;
+END ImmU64 ;
+
+PROCEDURE Cg (n : CARDINAL) ;
+BEGIN
+  OpB (2DH, n) ;             (* load_global *)
+END Cg ;
+
+PROCEDURE Sg (n : CARDINAL) ;
+BEGIN
+  OpB (3DH, n) ;             (* store_global *)
+END Sg ;
+
+PROCEDURE Mark (VAR m : CARDINAL) ;
+BEGIN
+  m := pcimg ;
+END Mark ;
+
+PROCEDURE JBack (o : CARDINAL ; m : CARDINAL) ;
+BEGIN
+  Op (o) ;
+  buf [HeaderSize + pcimg] := CHR (pcimg + 1 - m) ;
+  INC (pcimg) ;
+END JBack ;
+
+PROCEDURE EStr (s : ARRAY OF CHAR ; nl : BOOLEAN) ;
+VAR len, i2 : CARDINAL ;
+BEGIN
+  Op (8CH) ;                 (* call_rel : pc-relative string pointer *)
+  IF nl THEN
+    len := LENGTH (s) + 3 ;
+  ELSE
+    len := LENGTH (s) + 1 ;
+  END ;
+  buf [HeaderSize + pcimg] := CHR (len) ;
+  INC (pcimg) ;
+  IF LENGTH (s) > 0 THEN
+    FOR i2 := 0 TO LENGTH (s) - 1 DO
+      buf [HeaderSize + pcimg + i2] := s [i2] ;
+    END ;
+  END ;
+  INC (pcimg, LENGTH (s)) ;
+  IF nl THEN
+    buf [HeaderSize + pcimg] := CHR (13) ;   (* CR *)
+    buf [HeaderSize + pcimg + 1] := CHR (10) ;   (* LF *)
+    INC (pcimg, 2) ;
+  END ;
+  buf [HeaderSize + pcimg] := 0C ;           (* NUL *)
+  INC (pcimg) ;
+END EStr ;
+
+PROCEDURE PrintStr ;
+BEGIN
+  ImmB (1) ;                 (* system id = write NUL-terminated string *)
+  Op (0C3H) ;                (* system *)
+END PrintStr ;
+
+PROCEDURE Label (s : ARRAY OF CHAR) ;
+BEGIN
+  EStr (s, FALSE) ;
+  PrintStr ;
+END Label ;
+
+PROCEDURE Nl ;
+BEGIN
+  EStr ("", TRUE) ;
+  PrintStr ;
+END Nl ;
+
+PROCEDURE CallPrint ;
+BEGIN
+  OpB (0EDH, 1) ;            (* proc_call 1 *)
+END CallPrint ;
+
+PROCEDURE RealBits (v : REAL) ;
+BEGIN
+  rv.r := v ;
+  Op (8EH) ;
+  Put64 (HeaderSize + pcimg, rv.w) ;
+  INC (pcimg, 8) ;
+END RealBits ;
+
+BEGIN
+  FOR i := 0 TO BufSize - 1 DO
+    buf [i] := 0C ;
+  END ;
+
+  (* file header : magic *)
+  buf [0] := 'M' ;
+  buf [1] := 'C' ;
+  buf [2] := '6' ;
+  buf [3] := '4' ;
+
+  (* descriptor *)
+  buf [HeaderSize + DescName] := 'e' ;
+  buf [HeaderSize + DescName + 1] := 'x' ;
+  buf [HeaderSize + DescName + 2] := 'a' ;
+  buf [HeaderSize + DescName + 3] := 'm' ;
+  buf [HeaderSize + DescName + 4] := 'p' ;
+  buf [HeaderSize + DescName + 5] := 'l' ;
+  buf [HeaderSize + DescName + 6] := 'e' ;
+  buf [HeaderSize + DescFlags] := CHR (4) ;      (* TOINIT *)
+  buf [HeaderSize + DescVarCount] := CHR (0) ;
+  buf [HeaderSize + DescDepCount] := CHR (0) ;
+  (* DescProcs is filled in once the table position is known *)
+
+  pcimg := CodeOff ;
+
+  (* ================= proc0 : main *)
+
+  OpB (0D4H, 250) ;          (* enter : 5 local slots *)
+
+  Label ("mc64 test vm :: opcode exercise") ;  Nl ;
+
+  (* --- CARDINAL do-while loop : g := g*2+1, 10 iterations -> 1023 *)
+  ImmB (1) ; Sg (0) ;        (* g := 1 *)
+  ImmB (10) ; Sg (2) ;       (* i := 10 *)
+  Mark (lp) ;
+  Cg (0) ; ImmB (2) ; Op (0A8H) ; OpB (0AEH, 1) ; Sg (0) ;   (* g := g*2+1 *)
+  Cg (2) ; Op (0ADH) ; Sg (2) ;                              (* i := i-1 *)
+  Cg (2) ; Op (0ABH) ;                                       (* (i = 0)? *)
+  JBack (0E5H, lp) ;         (* jpfalse_back while i # 0 *)
+
+  Label ("g after 10*2+1 = ") ;  Cg (0) ; CallPrint ;
+
+  Label ("add 10+6 = ") ;      ImmB (10) ; ImmB (6) ; Op (0A6H) ; CallPrint ;
+  Label ("sub 20-7 = ") ;      ImmB (20) ; ImmB (7) ; Op (0A7H) ; CallPrint ;
+  Label ("mul 6*7 = ") ;       ImmB (6) ; ImmB (7) ; Op (0A8H) ; CallPrint ;
+  Label ("div 100/8 = ") ;     ImmB (100) ; ImmB (8) ; Op (0A9H) ; CallPrint ;
+  Label ("mod 100%8 = ") ;     ImmB (100) ; ImmB (8) ; Op (0AAH) ; CallPrint ;
+
+  Label ("bitand FF&0F = ") ;  ImmB (255) ; ImmB (15) ; Op (0E8H) ; CallPrint ;
+  Label ("bitor F0|0F = ") ;   ImmB (240) ; ImmB (15) ; Op (0E6H) ; CallPrint ;
+  Label ("bitxor FF^0F = ") ;  ImmB (255) ; ImmB (15) ; Op (0E9H) ; CallPrint ;
+  Label ("power2 2^6 = ") ;    ImmB (6) ; Op (0EAH) ; CallPrint ;
+
+  Label ("uc_add (2^32-1)+2 = ") ;
+    ImmU64 (0FFFFFFFFH) ; ImmB (2) ; Op (40H) ; Op (18H) ;
+    Op (0BAH) ; CallPrint ;
+
+  Label ("uc_mul 1234567890*2 = ") ;
+    ImmU64 (1234567890) ; ImmB (2) ; Op (40H) ; Op (1AH) ;
+    Op (0BAH) ; CallPrint ;
+
+  Label ("uc_div 2^36/2^16 = ") ;
+    ImmU64 (1000000000H) ;
+    ImmU64 (65536) ;
+    Op (40H) ; Op (1BH) ; Op (0BAH) ; CallPrint ;
+
+  Label ("uc_mod (2^32+6) rem 16 = ") ;
+    ImmU64 (100000006H) ; ImmB (16) ;
+    Op (40H) ; Op (1CH) ; Op (0BAH) ; CallPrint ;
+
+  Label ("long_negate F0F0F0F0 low = ") ;
+    ImmU64 (4042322160) ; Op (40H) ; Op (03H) ;
+    Op (0BAH) ; CallPrint ;
+
+  Label ("field_mask (1<<8)-(1<<2) = ") ;
+    ImmB (2) ; ImmB (8) ; Op (40H) ; Op (04H) ; CallPrint ;
+
+  Label ("real_add 3.5+2.25 = ") ;
+    RealBits (3.5) ; RealBits (2.25) ; Op (0D6H) ; Op (0BFH) ; CallPrint ;
+
+  Label ("dup+add check = ") ;
+    ImmB (2) ; Op (20H) ; Op (0A6H) ; ImmB (1) ; Op (0A6H) ; CallPrint ;
+
+  Label ("swap check = ") ;
+    ImmB (1) ; ImmB (2) ; Op (21H) ; Op (0A6H) ; CallPrint ;
+
+  Label ("load_global_dw g = ") ;
+    Op (09H) ; Op (00H) ; CallPrint ;
+
+  Label ("local_dw FP[-2] = ") ;
+    ImmB (99) ; OpB (18H, 0FEH) ;        (* store_local_dw -2 *)
+    OpB (08H, 0FEH) ; CallPrint ;        (* load_local_dw -2 *)
+
+  Label ("drop then 12 = ") ;
+    ImmB (11) ; Op (40H) ; Op (00H) ;    (* drop *)
+    ImmB (12) ; CallPrint ;
+
+  Label ("jp_fwd skip -> 7 = ") ;
+    Op (0E2H) ; Op (03H) ;               (* forward jump over 3 bytes *)
+    ImmB (5) ; Op (0A6H) ;               (* skipped at run time *)
+    ImmB (7) ; CallPrint ;
+
+  Label ("copy_block -> ") ;
+  ImmB (4) ; Op (0D2H) ; Op (20H) ;        (* dst := reserve 4 ; keep a copy *)
+  EStr ("abc", FALSE) ;                    (* src string inline (call_rel) *)
+  ImmB (4) ; Op (30H) ;                    (* copy_block : dst, src, size *)
+  PrintStr ;                               (* write the copied "abc" *)
+  Nl ;
+
+  Op (50H) ;                             (* end_program *)
+
+  p1 := pcimg ;
+
+  (* ================= proc1 : print_num *)
+
+  OpB (0D4H, 250) ;          (* enter : 5 local slots *)
+
+  ImmB (16) ; Op (0D2H) ; Sg (1) ;       (* GP[1] := output buffer *)
+  Op (90H) ; Op (90H) ; Sg (2) ; Sg (3) ;  (* GP[2] count := 0, GP[3] index := 0 *)
+
+  Op (03H) ;                             (* load_param 1 : the value *)
+
+  Mark (lp) ;
+  Cg (2) ; Op (0ACH) ; Sg (2) ;          (* count := count + 1 *)
+  Op (20H) ; ImmB (10) ; Op (0AAH) ;     (* dup ; 10 ; umod  -> remainder *)
+  Op (21H) ; ImmB (10) ; Op (0A9H) ;     (* swap ; 10 ; udiv  -> quotient *)
+  Op (20H) ; Op (0ABH) ;                 (* dup ; eq0 (quotient = 0) *)
+  JBack (0E5H, lp) ;                     (* jpfalse_back while quotient # 0 *)
+
+  Op (40H) ; Op (00H) ;                  (* drop the trailing quotient 0 *)
+
+  Mark (lp) ;
+  ImmB (48) ; Op (0A6H) ; Sg (4) ;   (* GP[4] := char (digit + ORD('0')) *)
+  Cg (1) ; Cg (3) ; Op (0A6H) ;      (* addr := buf + index *)
+  Op (90H) ; Cg (4) ; Op (1DH) ;     (* buf [index] := char *)
+  Cg (3) ; Op (0ACH) ; Sg (3) ;      (* index := index + 1 *)
+  Cg (2) ; Op (0ADH) ; Sg (2) ;      (* count := count - 1 *)
+  Cg (2) ; Op (0ABH) ;               (* (count = 0)? *)
+  JBack (0E5H, lp) ;                 (* jpfalse_back while count # 0 *)
+
+  Cg (1) ; Cg (3) ; Op (0A6H) ;      (* addr := buf + index *)
+  Op (90H) ; Op (90H) ; Op (1DH) ;   (* buf [index] := 0 (NUL) *)
+
+  Cg (1) ; PrintStr ;                    (* write the number *)
+  Nl ;                                   (* CRLF *)
+
+  OpB (85H, 0) ;                         (* fct_leave 0 *)
+
+  (* procedure table, placed after the code so it never overlaps it *)
+  pt := pcimg ;
+  Put64 (HeaderSize + DescProcs, VAL (LONGCARD, pt)) ;
+  Put64 (HeaderSize + pt, VAL (LONGCARD, 312) - VAL (LONGCARD, pt)) ;
+  Put64 (HeaderSize + pt + 8,
+         VAL (LONGCARD, p1) - VAL (LONGCARD, pt + 8)) ;
+  INC (pcimg, 16) ;
+
+  (* checksum over the image, excluding the checksum field *)
+  sum := 0 ;
+  FOR i := HeaderSize TO HeaderSize + pcimg - 1 DO
+    IF NOT ((i >= 352) AND (i <= 355)) THEN
+      sum := sum + ORD (buf [i]) ;
+    END ;
+  END ;
+  Put32 (HeaderSize + DescChecksum, sum) ;
+
+  IF NOT WriteFile ("example.MCD", buf, HeaderSize + pcimg) THEN
+    Fatal ("mkdtest: cannot write example.MCD") ;
+  END ;
+END mkdtest.

mkread.mod

@@ -0,0 +1,145 @@
+MODULE mkread ;
+
+(* Generates readtest.MCD, a single-module MC64 image that reads two lines
+   from the host standard input via SYSTEM service 2 and echoes both back:
+
+     reserve 128 bytes  ; store_global 1        ; input buffer
+     load_global 1 ; id 2 ; system              ; read line 1 (pushes count)
+     drop                                        ; ignore the count here
+     "you said: " ; write string ; echo buffer ; CRLF
+     load_global 1 ; id 2 ; system              ; read line 2
+     drop
+     "again: " ; write string ; echo buffer ; CRLF
+     end_program                                ; service 0x50 *)
+
+FROM FileIO IMPORT WriteFile ;
+FROM Console IMPORT Fatal ;
+
+CONST
+  HeaderSize = 64 ;
+  DescName = 264 ;
+  DescChecksum = 288 ;
+  DescFlags = 292 ;
+  DescDepCount = 294 ;
+  DescProcs = 296 ;
+  BufSize = 512 ;
+
+VAR
+  buf : ARRAY [0 .. BufSize - 1] OF CHAR ;
+  i, sum : CARDINAL ;
+  pc, ilen : CARDINAL ;
+
+PROCEDURE Put32 (off, v : CARDINAL) ;
+BEGIN
+  buf [off] := CHR (v MOD 256) ;
+  buf [off + 1] := CHR ((v DIV 256) MOD 256) ;
+  buf [off + 2] := CHR ((v DIV 65536) MOD 256) ;
+  buf [off + 3] := CHR (v DIV 16777216) ;
+END Put32 ;
+
+PROCEDURE Put64 (off : CARDINAL ; v : LONGCARD) ;
+VAR j : CARDINAL ;
+BEGIN
+  FOR j := 0 TO 7 DO
+    buf [off + j] := CHR (VAL (CARDINAL, v MOD 256)) ;
+    v := v DIV 256 ;
+  END ;
+END Put64 ;
+
+PROCEDURE Op (o : CARDINAL) ;
+BEGIN
+  buf [HeaderSize + pc] := CHR (o MOD 256) ;
+  INC (pc) ;
+END Op ;
+
+PROCEDURE OpB (o, b : CARDINAL) ;
+BEGIN
+  Op (o) ;
+  buf [HeaderSize + pc] := CHR (b MOD 256) ;
+  INC (pc) ;
+END OpB ;
+
+PROCEDURE EStr (s : ARRAY OF CHAR ; nl : BOOLEAN) ;
+VAR len, i2 : CARDINAL ;
+BEGIN
+  Op (8CH) ;
+  IF nl THEN
+    len := LENGTH (s) + 3 ;
+  ELSE
+    len := LENGTH (s) + 1 ;
+  END ;
+  buf [HeaderSize + pc] := CHR (len) ;
+  INC (pc) ;
+  IF LENGTH (s) > 0 THEN
+    FOR i2 := 0 TO LENGTH (s) - 1 DO
+      buf [HeaderSize + pc + i2] := s [i2] ;
+    END ;
+  END ;
+  INC (pc, LENGTH (s)) ;
+  IF nl THEN
+    buf [HeaderSize + pc] := CHR (13) ;
+    buf [HeaderSize + pc + 1] := CHR (10) ;
+    INC (pc, 2) ;
+  END ;
+  buf [HeaderSize + pc] := 0C ;
+  INC (pc) ;
+END EStr ;
+
+PROCEDURE PrintStr ;
+BEGIN
+  OpB (8DH, 1) ;           (* id = write string *)
+  Op (0C3H) ;              (* system *)
+END PrintStr ;
+
+PROCEDURE ReadEcho (s : ARRAY OF CHAR) ;
+BEGIN
+  OpB (2DH, 1) ; OpB (8DH, 2) ; Op (0C3H) ;  (* read line into GP[1] *)
+  Op (40H) ; Op (00H) ;                       (* drop the byte count *)
+  EStr (s, FALSE) ; PrintStr ;
+  OpB (2DH, 1) ; PrintStr ;                   (* echo the line *)
+  EStr ("", TRUE) ; PrintStr ;                (* CRLF *)
+END ReadEcho ;
+
+BEGIN
+  FOR i := 0 TO BufSize - 1 DO
+    buf [i] := 0C ;
+  END ;
+
+  buf [0] := 'M' ;
+  buf [1] := 'C' ;
+  buf [2] := '6' ;
+  buf [3] := '4' ;
+
+  buf [HeaderSize + DescName] := 'r' ;
+  buf [HeaderSize + DescName + 1] := 'e' ;
+  buf [HeaderSize + DescName + 2] := 'a' ;
+  buf [HeaderSize + DescName + 3] := 'd' ;
+  buf [HeaderSize + DescFlags] := CHR (4) ;
+  buf [HeaderSize + DescDepCount] := CHR (0) ;
+  Put64 (HeaderSize + DescProcs, 304) ;
+
+  pc := 312 ;
+
+  OpB (0D4H, 255) ;          (* enter : no locals *)
+  OpB (8DH, 128) ; Op (0D2H) ; OpB (3DH, 1) ;   (* GP[1] := reserve 128 *)
+
+  ReadEcho ("you said: ") ;
+  ReadEcho ("again: ") ;
+
+  Op (50H) ;                                  (* end_program *)
+
+  ilen := pc ;
+  Put64 (HeaderSize + 304, 8) ;               (* proc0 at image 312 *)
+
+  sum := 0 ;
+  FOR i := HeaderSize TO HeaderSize + ilen - 1 DO
+    IF NOT ((i >= 352) AND (i <= 355)) THEN
+      sum := sum + ORD (buf [i]) ;
+    END ;
+  END ;
+  Put32 (HeaderSize + DescChecksum, sum) ;
+
+  IF NOT WriteFile ("readtest.MCD", buf, HeaderSize + ilen) THEN
+    Fatal ("mkread: cannot write readtest.MCD") ;
+  END ;
+END mkread.

trans8to64.mod

@@ -0,0 +1,487 @@
+MODULE trans8to64 ;
+
+(* trans8to64 : translate a classic 16-bit Turbo Modula-2 .MCD binary
+   into a 64-bit MC64 .MCD image that mcint can boot.
+
+   16-bit file layout (little-endian) ::
+      header   : 16 bytes
+         fileSize       u16  (byte count not counting header)
+         moduleStart    u16  (blob offset of the module descriptor)
+         codeSize       u16  (size of the blob that follows the header)
+         nbDependencies u16
+         reserved       [8] bytes
+      blob     : codeSize bytes
+         + moduleStart       descriptor:
+            +66..73  name[8]        +74,75 loadAddr
+            +76,77   checksum       +78,79 procsAddr
+            +80      flags (bit2=TOINIT)
+            +81      varCount       +82 proc count k0   +83 depCount
+            +84      var sizes : varCount*u16 BYTES
+         proc table : cell i (i16) at procsAddr-2*i, descending;
+            proc_i = (procsAddr-2*i) + 1 + cell
+            scan i while cell<0 ; codeEnd = procsAddr-2*k0
+      dependencies : nbDeps * 12 bytes (dropped by mc64)
+
+   64-bit output : 64-byte "MC64" header + descriptor + translated code +
+   rebuilt proc table (cells relative to cell start).
+
+   Operand translation (locked against mc64/Interpreter.mod) ::
+      8E word imm  2B -> 8B  zero-extended (CARDINAL/word semantics)
+      8F dword imm 4B -> 8B  via 8E, sign-extended (LONGINT constant)
+      CD switch    u16 low/high(range size)/ret ; cells = high+1
+                   64-bit: low u64, highw=low+high u64, t u64, cells i64
+                   cells relative to cell-start+8 ; call-switch return
+                   pushed as eot+t (mc64 CD honours t)
+      CF push_code 2B -> 8B, target preserved
+      E0/E1 jp     2B -> 8B, target preserved
+      DC limit_check : 16-bit pops its limit (no operand) ; the 64-bit form
+      reads a u8 immediate.  Reference modules only contain DC in dead code
+      (right after a leave), so we emit `DC 00` (never executed).
+   All other opcodes have identical operand widths and pass through.
+
+   Limitations :
+      - global slots / module-table address tricks (e.g. 0xFFF7/0xFFFF) do
+        not map onto the mc64 data window => globals misbehave at run time.
+      - extern references 0xEF/0xF0 point at dependencies; mc64 sets dcnt=0,
+        so such calls crash if executed.
+      - 8F used for REAL constants decodes as a LONGINT.
+      - runnable only for dependency-free modules; TOINIT (flags bit2) is
+        preserved, so a module with a real proc0 init runs under mcint.
+*)
+
+FROM FileIO IMPORT ReadFile, WriteFile ;
+FROM Console IMPORT WriteString, WriteLn, WriteLongCard, Fatal ;
+FROM ProgramArgs IMPORT ArgChan, NextArg ;
+FROM TextIO IMPORT ReadString ;
+
+CONST
+  MaxBuf = 65535 ;
+  HeaderSize = 64 ;
+  DescName = 264 ;
+  DescLoadAddr = 280 ;
+  DescChecksum = 288 ;
+  DescFlags = 292 ;
+  DescVarCount = 293 ;
+  DescDepCount = 294 ;
+  DescPad = 295 ;
+  DescProcs = 296 ;
+  DescVarSizes = 304 ;
+
+VAR
+  inName, outName : ARRAY [0 .. 200] OF CHAR ;
+  src : ARRAY [0 .. MaxBuf] OF CHAR ;
+  dst : ARRAY [0 .. MaxBuf] OF CHAR ;
+  map : ARRAY [0 .. MaxBuf] OF LONGCARD ;
+  got : CARDINAL ;
+  ms, cs : CARDINAL ;
+  desc, procs16 : CARDINAL ;
+  k0 : CARDINAL ;
+  codeEnd : CARDINAL ;
+  flags8, vcnt : CARDINAL ;
+  varSizes : ARRAY [0 .. 31] OF CARDINAL ;
+  procAddrs : ARRAY [0 .. 255] OF CARDINAL ;
+  ents : ARRAY [0 .. 256] OF CARDINAL ;
+  nEnt : CARDINAL ;
+  codeOff, procTabImg, imgLen : CARDINAL ;
+  i, j, sum : CARDINAL ;
+
+PROCEDURE H16 (off : CARDINAL) : CARDINAL ;
+BEGIN
+  RETURN ORD (src [off]) + 256 * ORD (src [off + 1]) ;
+END H16 ;
+
+PROCEDURE B (p : CARDINAL) : CARDINAL ;
+BEGIN
+  RETURN ORD (src [16 + p]) ;
+END B ;
+
+PROCEDURE Get16 (p : CARDINAL) : CARDINAL ;
+BEGIN
+  IF (p > MaxBuf) OR (p + 1 > MaxBuf) THEN
+    Fatal ("trans8to64: Get16 out of range") ;
+  END ;
+  RETURN ORD (src [16 + p]) + 256 * ORD (src [16 + p + 1]) ;
+END Get16 ;
+
+PROCEDURE Sig16 (p : CARDINAL) : LONGINT ;
+VAR v : CARDINAL ;
+BEGIN
+  v := Get16 (p) ;
+  IF v >= 32768 THEN
+    RETURN VAL (LONGINT, v) - 65536 ;
+  ELSE
+    RETURN VAL (LONGINT, v) ;
+  END ;
+END Sig16 ;
+
+PROCEDURE Align8 (c : CARDINAL) : CARDINAL ;
+BEGIN
+  IF (c MOD 8) # 0 THEN
+    RETURN c + 8 - (c MOD 8) ;
+  ELSE
+    RETURN c ;
+  END ;
+END Align8 ;
+
+PROCEDURE WB (off : CARDINAL; v : CARDINAL) ;
+BEGIN
+  dst [HeaderSize + off] := CHR (v MOD 256) ;
+END WB ;
+
+PROCEDURE Put64 (off : CARDINAL; v : LONGCARD) ;
+VAR j : CARDINAL ;
+BEGIN
+  FOR j := 0 TO 7 DO
+    dst [HeaderSize + off + j] := CHR (VAL (CARDINAL, v MOD 256)) ;
+    v := v DIV 256 ;
+  END ;
+END Put64 ;
+
+PROCEDURE Put32 (off, v : CARDINAL) ;
+BEGIN
+  dst [HeaderSize + off] := CHR (v MOD 256) ;
+  dst [HeaderSize + off + 1] := CHR ((v DIV 256) MOD 256) ;
+  dst [HeaderSize + off + 2] := CHR ((v DIV 65536) MOD 256) ;
+  dst [HeaderSize + off + 3] := CHR (v DIV 16777216) ;
+END Put32 ;
+
+(* number of sub-opcode operand bytes consumed by 0x12 quad ops *)
+PROCEDURE QuadLen (sub : CARDINAL) : CARDINAL ;
+BEGIN
+  CASE sub OF
+  | 0H, 1H, 2H, 4H, 5H, 6H : RETURN 1 ;
+  | 3H, 7H : RETURN 2 ;
+  | 0AH : RETURN 1 ;
+  ELSE RETURN 0 ;
+  END ;
+END QuadLen ;
+
+PROCEDURE InstrLen16 (p : CARDINAL) : CARDINAL ;
+VAR op, sub, v : CARDINAL ;
+BEGIN
+  op := B (p) ;
+  CASE op OF
+  | 02H : RETURN 2 ;
+  | 08H, 09H, 0AH, 0CH,
+    11H, 18H, 19H, 1AH, 1CH,
+    2CH, 2DH, 2EH,
+    3CH, 3DH, 3EH,
+    40H,
+    80H, 81H, 82H, 84H, 85H, 86H, 87H, 8DH,
+    0AEH, 0AFH, 0B0H, 0B1H,
+    0D4H, 0DEH, 0DFH,
+    0ECH, 0EDH, 0EEH, 0F0H : RETURN 2 ;
+  | 0BH, 1BH, 2FH, 3FH, 83H, 0EFH : RETURN 3 ;
+  | 12H : sub := B (p + 1) ; RETURN 2 + QuadLen (sub) ;
+  | 8CH : RETURN 2 + B (p + 1) ;
+  | 8EH, 0CFH, 0E0H, 0E1H : RETURN 3 ;
+  | 8FH : RETURN 5 ;
+  | 0CDH : v := Get16 (p + 3) ;
+           IF v >= 30000 THEN
+             v := 30000 ;
+           END ;
+           RETURN 7 + 2 * (v + 1) ;  ELSE RETURN 1 ;
+  END ;
+END InstrLen16 ;
+
+PROCEDURE InstrInfo (p : CARDINAL; VAR sz16, out, op : CARDINAL) ;
+BEGIN
+  op := B (p) ;
+  sz16 := InstrLen16 (p) ;
+  out := sz16 ;
+  CASE op OF
+  | 8EH, 8FH, 0CFH, 0E0H, 0E1H : out := 9 ;
+  | 0CDH : out := 25 + 8 * (Get16 (p + 3) + 1) ;
+  | 0DCH : out := 2 ;
+  ELSE out := sz16 ;
+  END ;
+END InstrInfo ;
+
+(* pass 1 : assign image offsets to every instruction in [start, stop) *)
+PROCEDURE Laying (start, stop : CARDINAL; VAR startImg : CARDINAL) ;
+VAR p, op, sz16, out, cur : CARDINAL ;
+BEGIN
+  p := start ;
+  cur := startImg ;
+  WHILE p < stop DO
+    InstrInfo (p, sz16, out, op) ;
+    IF p + sz16 > stop THEN
+      sz16 := stop - p ;
+      out := sz16 ;
+    END ;
+    map [p] := VAL (LONGCARD, cur) ;
+    IF cur + out > MaxBuf THEN
+      Fatal ("trans8to64: output too large") ;
+    END ;
+    cur := cur + out ;
+    p := p + sz16 ;
+  END ;
+  map [stop] := VAL (LONGCARD, cur) ;
+  startImg := cur ;
+END Laying ;
+
+(* pass 2 : emit [start, stop) at curImg (must follow pass 1 exactly) *)
+PROCEDURE Emitting (start, stop : CARDINAL; VAR curImg : CARDINAL) ;
+VAR p, op, sz16, out, cur, j, N, low, high, ret, tgt16, lsw, msw : CARDINAL ;
+    first, eot, t, off64, rel64, cellImg, idx : LONGCARD ;
+BEGIN
+  p := start ;
+  cur := curImg ;
+  WHILE p < stop DO
+    InstrInfo (p, sz16, out, op) ;
+    IF p + sz16 > stop THEN
+      sz16 := stop - p ;
+      out := sz16 ;
+      op := 0H ;
+    END ;
+    IF op = 8EH THEN
+      WB (cur, 8EH) ;
+      Put64 (cur + 1, VAL (LONGCARD, Get16 (p + 1))) ;
+    ELSIF op = 8FH THEN
+      lsw := Get16 (p + 1) ;
+      msw := Get16 (p + 3) ;
+      IF B (p + 4) >= 128 THEN
+        off64 := VAL (LONGCARD,
+                 (VAL (LONGINT, msw) - 65536) * 65536 +
+                  VAL (LONGINT, lsw)) ;
+      ELSE
+        off64 := VAL (LONGCARD,
+                 VAL (LONGINT, msw) * 65536 + VAL (LONGINT, lsw)) ;
+      END ;
+      WB (cur, 8EH) ;
+      Put64 (cur + 1, off64) ;
+    ELSIF op = 0CFH THEN
+      tgt16 := VAL (CARDINAL,
+               VAL (LONGINT, p) + 2 + Sig16 (p + 1)) ;
+      off64 := map [tgt16] - (VAL (LONGCARD, cur) + 8) ;
+      WB (cur, 0CFH) ;
+      Put64 (cur + 1, off64) ;
+    ELSIF (op = 0E0H) OR (op = 0E1H) THEN
+      tgt16 := VAL (CARDINAL,
+               VAL (LONGINT, p) + 2 + Sig16 (p + 1)) ;
+      off64 := map [tgt16] - (VAL (LONGCARD, cur) + 9) ;
+      WB (cur, op) ;
+      Put64 (cur + 1, off64) ;
+    ELSIF op = 0DCH THEN
+      WB (cur, 0DCH) ;
+      WB (cur + 1, 0) ;
+    ELSIF op = 0CDH THEN
+      low := Get16 (p + 1) ;
+      high := Get16 (p + 3) ;
+      ret := Get16 (p + 5) ;
+      N := high + 1 ;
+      WB (cur, 0CDH) ;
+      Put64 (cur + 1, VAL (LONGCARD, low)) ;
+      Put64 (cur + 9, VAL (LONGCARD, low + high)) ;
+      first := VAL (LONGCARD, cur) + 25 ;
+      eot := first + VAL (LONGCARD, N) * 8 ;
+      idx := VAL (LONGCARD, p) + 6 + VAL (LONGCARD, ret) ;
+      IF idx > VAL (LONGCARD, MaxBuf) THEN
+        idx := VAL (LONGCARD, codeEnd) ;
+      END ;
+      t := map [VAL (CARDINAL, idx)] - eot ;
+      Put64 (cur + 17, t) ;
+      FOR j := 0 TO N - 1 DO
+        cellImg := VAL (LONGCARD, cur) + 25 + VAL (LONGCARD, j) * 8 ;
+        tgt16 := VAL (CARDINAL,
+                 VAL (LONGINT, p) + 7 + VAL (LONGINT, j) * 2 +
+                 1 + Sig16 (p + 7 + 2 * j)) ;
+        rel64 := map [tgt16] - (cellImg + 8) ;
+        Put64 (VAL (CARDINAL, cellImg), rel64) ;
+      END ;
+    ELSE
+      FOR j := 0 TO sz16 - 1 DO
+        WB (cur + j, B (p + j)) ;
+      END ;
+    END ;
+    cur := cur + out ;
+    p := p + sz16 ;
+  END ;
+  curImg := cur ;
+END Emitting ;
+
+(* insert an entry, keeping ents[] sorted and unique *)
+PROCEDURE AddEnt (e : CARDINAL) ;
+VAR i, j : CARDINAL ;
+BEGIN
+  i := 0 ;
+  WHILE (i < nEnt) AND (ents [i] < e) DO
+    INC (i) ;
+  END ;
+  IF (i < nEnt) AND (ents [i] = e) THEN
+    RETURN ;
+  END ;
+  j := nEnt ;
+  WHILE j > i DO
+    ents [j] := ents [j - 1] ;
+    DEC (j) ;
+  END ;
+  ents [i] := e ;
+  INC (nEnt) ;
+END AddEnt ;
+
+PROCEDURE Usage ;
+BEGIN
+  WriteString ("usage: trans8to64 in.MCD out.MCD") ;
+  WriteLn ;
+END Usage ;
+
+BEGIN
+  NextArg ;
+  ReadString (ArgChan (), inName) ;
+  NextArg ;
+  ReadString (ArgChan (), outName) ;
+  IF (inName [0] = 0C) OR (outName [0] = 0C) THEN
+    Usage ;
+    HALT (1) ;
+  END ;
+
+  IF NOT ReadFile (inName, src, got) THEN
+    Fatal ("trans8to64: cannot read input") ;
+  END ;
+  IF got <= 16 THEN
+    Fatal ("trans8to64: input too short") ;
+  END ;
+
+  FOR i := 0 TO MaxBuf DO
+    dst [i] := 0C ;
+  END ;
+
+  ms := H16 (2) ;
+  cs := H16 (4) ;
+  IF 16 + cs > got THEN
+    Fatal ("trans8to64: header/blob size mismatch") ;
+  END ;
+  IF ms + 84 > cs THEN
+    Fatal ("trans8to64: descriptor out of range") ;
+  END ;
+
+  desc := ms ;
+  procs16 := Get16 (desc + 78) ;
+  flags8 := B (desc + 80) ;
+  vcnt := B (desc + 81) ;
+  IF vcnt > 32 THEN
+    Fatal ("trans8to64: too many var sizes") ;
+  END ;
+  IF desc + 84 + 2 * vcnt > cs THEN
+    Fatal ("trans8to64: var sizes out of range") ;
+  END ;
+  IF procs16 + 2 > cs THEN
+    Fatal ("trans8to64: procs table out of range") ;
+  END ;
+
+  (* count proc-table cells (negative, descending) *)
+  k0 := 0 ;
+  WHILE (procs16 >= 2 * k0) AND (Sig16 (procs16 - 2 * k0) < 0) DO
+    INC (k0) ;
+  END ;
+  IF k0 > 255 THEN
+    Fatal ("trans8to64: too many procedures") ;
+  END ;
+  codeEnd := procs16 - 2 * k0 ;
+
+  IF k0 > 0 THEN
+    FOR j := 0 TO k0 - 1 DO
+      procAddrs [j] := VAL (CARDINAL,
+                       VAL (LONGINT, procs16 - 2 * j) + 1 +
+                       Sig16 (procs16 - 2 * j)) ;
+    END ;
+  END ;
+
+  (* sorted unique proc entries + final code end *)
+  nEnt := 0 ;
+  IF k0 > 0 THEN
+    FOR j := 0 TO k0 - 1 DO
+      IF procAddrs [j] <= codeEnd THEN
+        AddEnt (procAddrs [j]) ;
+      END ;
+    END ;
+  END ;
+  AddEnt (codeEnd) ;
+
+  (* 16-bit var sizes *)
+  IF vcnt > 0 THEN
+    FOR j := 0 TO vcnt - 1 DO
+      varSizes [j] := Get16 (desc + 84 + 2 * j) ;
+    END ;
+  END ;
+
+  codeOff := Align8 (304 + vcnt * 8) ;
+  IF codeOff < 312 THEN
+    codeOff := 312 ;
+  END ;
+
+  (* pass 1 : assign positions ; intervals start at each proc entry *)
+  procTabImg := codeOff ;
+  IF nEnt >= 2 THEN
+    FOR j := 0 TO nEnt - 2 DO
+      Laying (ents [j], ents [j + 1], procTabImg) ;
+    END ;
+  END ;
+
+  (* descriptor *)
+  FOR j := 0 TO 7 DO
+    WB (DescName + j, B (desc + 66 + j)) ;
+  END ;
+  Put64 (DescLoadAddr, VAL (LONGCARD, Get16 (desc + 74))) ;
+  WB (DescFlags, flags8) ;
+  WB (DescVarCount, vcnt) ;
+  WB (DescDepCount, 0) ;
+  WB (DescPad, 0) ;
+  IF vcnt > 0 THEN
+    FOR j := 0 TO vcnt - 1 DO
+      Put64 (DescVarSizes + j * 8, VAL (LONGCARD, Align8 (varSizes [j]))) ;
+    END ;
+  END ;
+
+  (* pad the code region to 8 before the proc table *)
+  procTabImg := Align8 (procTabImg) ;
+
+  (* pass 2 : emit *)
+  imgLen := codeOff ;
+  FOR j := 0 TO nEnt - 2 DO
+    Emitting (ents [j], ents [j + 1], imgLen) ;
+  END ;
+  imgLen := Align8 (imgLen) ;
+  IF imgLen > procTabImg THEN
+    procTabImg := imgLen ;
+  END ;
+  Put64 (DescProcs, VAL (LONGCARD, procTabImg)) ;
+
+  (* rebuild the proc table : cell = target - cellAddr *)
+  FOR j := 0 TO k0 - 1 DO
+    Put64 (procTabImg + j * 8,
+           map [procAddrs [j]] - VAL (LONGCARD, procTabImg + j * 8)) ;
+  END ;
+  imgLen := procTabImg + k0 * 8 ;
+
+  (* file header : magic *)
+  dst [0] := 'M' ;
+  dst [1] := 'C' ;
+  dst [2] := '6' ;
+  dst [3] := '4' ;
+
+  (* checksum over the image bytes, excluding the checksum field itself *)
+  sum := 0 ;
+  FOR i := HeaderSize TO HeaderSize + imgLen - 1 DO
+    IF NOT ((i >= 352) AND (i <= 355)) THEN
+      sum := sum + ORD (dst [i]) ;
+    END ;
+  END ;
+  Put32 (DescChecksum, sum) ;
+
+  IF HeaderSize + imgLen > MaxBuf + 1 THEN
+    Fatal ("trans8to64: output too large") ;
+  END ;
+  IF NOT WriteFile (outName, dst, HeaderSize + imgLen) THEN
+    Fatal ("trans8to64: cannot write output") ;
+  END ;
+  WriteString ("trans8to64: ") ;
+  WriteString (inName) ;
+  WriteString (" -> ") ;
+  WriteString (outName) ;
+  WriteString (" : ok (") ;
+  WriteLongCard (VAL (LONGCARD, HeaderSize + imgLen)) ;
+  WriteString (" bytes)") ;
+  WriteLn ;
+END trans8to64.