step4: composites — arrays, records, sets, pointers, strings, WITH; 74/74 tests green

Extended.def

@@ -2,8 +2,10 @@ DEFINITION MODULE Extended ;
 
 (* 0x40 extended sub-opcode dispatch (§10.2 of the spec). *)
 
-EXPORT QUALIFIED Execute ;
+EXPORT QUALIFIED Execute, SetHeapBase ;
 
 PROCEDURE Execute ;
 
+PROCEDURE SetHeapBase (b: LONGCARD) ;
+
 END Extended.

Extended.mod

@@ -2,19 +2,20 @@ IMPLEMENTATION MODULE Extended ;
 
 FROM Instruction IMPORT Fetch ;
 FROM Stack IMPORT Pop, Push, PopReal, PushReal ;
-FROM Memory IMPORT CopyBytes, FillBytes, WriteSlot, ReadSlot,
-  TopOfMemory ;
+FROM Memory IMPORT CopyBytes, FillBytes, WriteSlot, ReadSlot ;
 FROM Local IMPORT GetSP, SetSP ;
 FROM Console IMPORT Fatal ;
 
 VAR
   hp : LONGCARD ;
 
+PROCEDURE SetHeapBase (b: LONGCARD) ;
+BEGIN
+  hp := b ;
+END SetHeapBase ;
+
 PROCEDURE HeapPtr () : LONGCARD ;
 BEGIN
-  IF hp = 0 THEN
-    hp := TopOfMemory () ;
-  END ;
   RETURN hp ;
 END HeapPtr ;
 
@@ -43,14 +44,18 @@ BEGIN
 END Mul64 ;
 
 PROCEDURE AllocateHeap (size: LONGCARD) : LONGCARD ;
-VAR sz: LONGCARD ;
+VAR sz, base: LONGCARD ;
 BEGIN
   sz := size ;
   IF (sz MOD 8) # 0 THEN
     sz := sz + 8 - (sz MOD 8) ;
   END ;
-  hp := HeapPtr () - sz ;
-  RETURN hp ;
+  base := hp ;
+  IF base + sz >= GetSP () THEN
+    Fatal ("extended: OutOfMemory (heap meets stack)") ;
+  END ;
+  hp := base + sz ;
+  RETURN base ;
 END AllocateHeap ;
 
 PROCEDURE Execute ;
@@ -87,7 +92,7 @@ BEGIN
       hp := mark ;
       WriteSlot (dst, 0) ;
   | 9 :  (* FREEMEM *)
-      Push (TopOfMemory () - HeapPtr ()) ;
+      Push (GetSP () - HeapPtr ()) ;
   | 0AH, 0BH, 0CH :  (* TRANSFER/IOTRANSFER/NEWPROCESS *)
       Fatal ("extended: processes unimplemented") ;
   | 0DH :  (* BIOS (no-op) *)

Loader2.mod

@@ -10,6 +10,7 @@ FROM Global IMPORT SetModuleBase, SetModuleProcs, SetModuleFlag,
 FROM Local IMPORT Init, SetGP, SetIP ;
 FROM Instruction IMPORT ProcedureAddress ;
 FROM Interpreter IMPORT Run ;
+FROM Extended IMPORT SetHeapBase ;
 FROM Console IMPORT Fatal ;
 
 CONST
@@ -160,6 +161,7 @@ BEGIN
   END ;
   LoadOne (dcnt, name, next, TRUE) ;
 
+  SetHeapBase (next) ;
   mainDataWin := GetModuleBase (dcnt) ;
   fl := GetModuleFlag (dcnt) ;
   SetCurrentModule (dcnt) ;