Integrate JTempl's new OFront heap implementation using unsigned address arithmetic.

src/runtime/Heap.Mod

@@ -8,7 +8,7 @@ MODULE Heap;
     CmdNameLen = 24;
     SZA        = SIZE(S.ADDRESS);  (* Size of address *)
     Unit       = 4*SZA;            (* smallest possible heap block *)
-    nofLists   = 9;                (* number of free_lists *)
+    nofLists   = 9;                (* number of freelist entries excluding sentinel *)
     heapSize0  = 8000*Unit;        (* startup heap size *)
 
   (* all blocks look the same:
@@ -50,7 +50,7 @@ MODULE Heap;
       enumPtrs-: EnumProc;
       reserved1,
       reserved2: LONGINT
-    END ;
+    END;
 
     Command- = PROCEDURE;
 
@@ -58,7 +58,7 @@ MODULE Heap;
       next-: Cmd;
       name-: CmdName;
       cmd-:  Command
-    END ;
+    END;
 
     Finalizer = PROCEDURE(obj: S.PTR);
 
@@ -68,7 +68,7 @@ MODULE Heap;
       obj:      S.ADDRESS;  (* weak pointer *)
       marked:   BOOLEAN;
       finalize: Finalizer;
-    END ;
+    END;
 
   VAR
     (* the list of loaded (=initialization started) modules *)
@@ -81,10 +81,8 @@ MODULE Heap;
 
     (* extensible heap *)
     heap-:      S.ADDRESS;  (* the sorted list of heap chunks *)
-    heapNegMin: S.ADDRESS;  (* Range of pointer values, used for stack collection *)
+    heapMin:    S.ADDRESS;  (* Range of valid pointer values, used for stack collection *)
-    heapNegMax: S.ADDRESS;
+    heapMax:    S.ADDRESS;
-    heapPosMin: S.ADDRESS;
-    heapPosMax: S.ADDRESS;
     heapsize*:  S.ADDRESS;  (* the sum of all heap chunk sizes *)
 
     (* finalization candidates *)
@@ -114,6 +112,9 @@ MODULE Heap;
   END Unlock;
 
 
+  PROCEDURE -uLT(x, y: S.ADDRESS): BOOLEAN  "((size_t)x <  (size_t)y)";
+  PROCEDURE -uLE(x, y: S.ADDRESS): BOOLEAN  "((size_t)x <= (size_t)y)";
+
   (*
     PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
     VAR oldflag : BOOLEAN;
@@ -200,13 +201,8 @@ MODULE Heap;
       bigBlocks := blk;  (* Prepend block to list of big blocks *)
       INC(heapsize, blksz);
       (* Maintain heap range limits *)
-      IF chnk > 0 THEN
+      IF uLT(blk + SZA, heapMin) THEN heapMin := blk + SZA END;
-        IF chnk < heapPosMin THEN heapPosMin := blk + SZA END;
+      IF uLT(heapMax,   end)     THEN heapMax := end       END
-        IF end  > heapPosMax THEN heapPosMax := end       END
-      ELSE (* chnk < 0 *)
-        IF chnk < heapNegMin THEN heapNegMin := blk + SZA END;
-        IF end  > heapNegMax THEN heapNegMax := end       END
-      END
     END;
     RETURN chnk
   END NewChunk;
@@ -214,17 +210,17 @@ MODULE Heap;
   PROCEDURE ExtendHeap(blksz: S.ADDRESS);
     VAR size, chnk, j, next: S.ADDRESS;
   BEGIN
-    IF blksz > 10000*Unit THEN size := blksz
+    IF uLT(10000*Unit, blksz) THEN size := blksz
     ELSE size := 10000*Unit  (* additional heuristics *)
-    END ;
+    END;
     chnk := NewChunk(size);
     IF chnk # 0 THEN
       (*sorted insertion*)
-      IF chnk < heap THEN
+      IF uLT(chnk, heap) THEN
         S.PUT(chnk, heap); heap := chnk
       ELSE
         j := heap; S.GET(j, next);
-        WHILE (next # 0) & (chnk - next > 0) DO
+        WHILE (next # 0) & uLT(next, chnk) DO
           j := next;
           S.GET(j, next)
         END;
@@ -248,13 +244,13 @@ MODULE Heap;
     ASSERT(blksz MOD Unit = 0);
 
     i0 := blksz DIV Unit; i := i0;
-    IF i < nofLists THEN adr := freeList[i];
+    IF uLT(i, nofLists) THEN adr := freeList[i];
       WHILE adr = 0 DO INC(i); adr := freeList[i] END
-    END ;
+    END;
-    IF i < nofLists THEN (* unlink *)
+    IF uLT(i, nofLists) THEN (* Unlink from freelist[i] *)
       S.GET(adr + nextOff, next);
       freeList[i] := next;
-      IF i # i0 THEN (* split *)
+      IF i # i0 THEN (* Split *)
         di := i - i0; restsize := di * Unit; end := adr + restsize;
         S.PUT(end + sizeOff, blksz);
         S.PUT(end + sntlOff, NoPtrSntl);
@@ -264,60 +260,61 @@ MODULE Heap;
         freeList[di] := adr;
         INC(adr, restsize)
       END
-    ELSE
+    ELSE (* Search in bigBlocks *)
       adr := bigBlocks; prev := 0;
       LOOP
-        IF adr = 0 THEN
+        IF adr = 0 THEN (* Nothing free *)
           IF firstTry THEN
             GC(TRUE); INC(blksz, Unit);
-            IF (heapsize - allocated - blksz) * 4 < heapsize THEN
+            IF uLT(heapsize - allocated, blksz)
-              (* heap is still almost full; expand to avoid thrashing *)
+            OR uLT((heapsize - allocated - blksz) * 4, heapsize) THEN
+              (* heap would still be more than 3/4 full; expand to avoid thrashing *)
               ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize)
-            END ;
+            END;
             firstTry := FALSE; new := NEWREC(tag); firstTry := TRUE;
             IF new = NIL THEN
               (* depending on the fragmentation, the heap may not have been extended by
                 the anti-thrashing heuristics above *)
               ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize);
               new := NEWREC(tag);  (* will find a free block if heap has been expanded properly *)
-            END ;
+            END;
             Unlock(); RETURN new
           ELSE
             Unlock(); RETURN NIL
           END
-        END ;
+        END;
         S.GET(adr+sizeOff, t);
-        IF t >= blksz THEN EXIT END ;
+        IF uLE(blksz, t) THEN EXIT END;
         prev := adr; S.GET(adr + nextOff, adr)
-      END ;
+      END;
       restsize := t - blksz; end := adr + restsize;
       S.PUT(end + sizeOff, blksz);
       S.PUT(end + sntlOff, NoPtrSntl);
       S.PUT(end,           end + sizeOff);
-      IF restsize > nofLists * Unit THEN (*resize*)
+      IF uLT(nofLists * Unit, restsize) THEN (* Resize *)
         S.PUT(adr + sizeOff, restsize)
-      ELSE (*unlink*)
+      ELSE (* Unlink *)
         S.GET(adr + nextOff, next);
         IF prev = 0 THEN bigBlocks := next
         ELSE S.PUT(prev + nextOff, next);
-        END ;
+        END;
-        IF restsize > 0 THEN (*move*)
+        IF restsize # 0 THEN (* Move *)
           di := restsize DIV Unit;
           S.PUT(adr + sizeOff, restsize);
           S.PUT(adr + nextOff, freeList[di]);
           freeList[di] := adr
         END
-      END ;
+      END;
       INC(adr, restsize)
-    END ;
+    END;
     i := adr + 4*SZA; end := adr + blksz;
-    WHILE end - i > 0 DO  (*deliberately unrolled*)
+    WHILE uLT(i, end) DO  (* Deliberately unrolled *)
       S.PUT(i,         AddressZero);
       S.PUT(i + SZA,   AddressZero);
       S.PUT(i + 2*SZA, AddressZero);
       S.PUT(i + 3*SZA, AddressZero);
       INC(i, 4*SZA)
-    END ;
+    END;
     S.PUT(adr + nextOff, AddressZero);
     S.PUT(adr,           tag);
     S.PUT(adr + sizeOff, AddressZero);
@@ -355,7 +352,7 @@ MODULE Heap;
           S.GET(tag, offset);                  (* Get next ptr field offset *)
           IF offset < 0 THEN                   (* Sentinel reached: Value is -8*(#fields+1) *)
             S.PUT(q - SZA, tag + offset + 1);  (* Rotate base ptr into tag *)
-            IF p = 0 THEN EXIT END ;
+            IF p = 0 THEN EXIT END;
             n := q; q := p;
             S.GET(q - SZA, tag); DEC(tag, 1);
             S.GET(tag, offset); fld := q + offset;
@@ -373,7 +370,7 @@ MODULE Heap;
                 tag := tagbits
               END
             END
-          END ;
+          END;
           INC(tag, SZA)
         END
       END
@@ -388,24 +385,24 @@ MODULE Heap;
   PROCEDURE Scan;
     VAR chnk, adr, end, start, tag, i, size, freesize: S.ADDRESS;
   BEGIN bigBlocks := 0; i := 1;
-    WHILE i < nofLists DO freeList[i] := 0; INC(i) END ;
+    WHILE i < nofLists DO freeList[i] := 0; INC(i) END;
     freesize := 0; allocated := 0; chnk := heap;
     WHILE chnk # 0 DO
       adr := chnk + blkOff;
       S.GET(chnk + endOff, end);
-      WHILE end - adr > 0 DO
+      WHILE uLT(adr, end) DO
         S.GET(adr, tag);
-        IF ODD(tag) THEN  (*marked*)
+        IF ODD(tag) THEN  (* Marked *)
-          IF freesize > 0 THEN
+          IF freesize # 0 THEN
             start := adr - freesize;
             S.PUT(start,         start+SZA);
             S.PUT(start+sizeOff, freesize);
             S.PUT(start+sntlOff, NoPtrSntl);
             i := freesize DIV Unit; freesize := 0;
-            IF i < nofLists THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start
+            IF uLT(i, nofLists) THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start
-            ELSE                 S.PUT(start + nextOff, bigBlocks);   bigBlocks   := start
+            ELSE                     S.PUT(start + nextOff, bigBlocks);   bigBlocks   := start
             END
-          END ;
+          END;
           DEC(tag, 1);
           S.PUT(adr, tag);
           S.GET(tag, size);
@@ -416,17 +413,17 @@ MODULE Heap;
           INC(freesize, size);
           INC(adr, size)
         END
-      END ;
+      END;
-      IF freesize > 0 THEN (*collect last block*)
+      IF freesize # 0 THEN (* Collect last block *)
         start := adr - freesize;
         S.PUT(start,         start+SZA);
         S.PUT(start+sizeOff, freesize);
         S.PUT(start+sntlOff, NoPtrSntl);
         i := freesize DIV Unit; freesize := 0;
-        IF i < nofLists THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start
+        IF uLT(i, nofLists) THEN S.PUT(start + nextOff, freeList[i]); freeList[i] := start
-        ELSE                 S.PUT(start + nextOff, bigBlocks);   bigBlocks   := start
+        ELSE                     S.PUT(start + nextOff, bigBlocks);   bigBlocks   := start
         END
-      END ;
+      END;
       S.GET(chnk, chnk)
     END
   END Scan;
@@ -435,8 +432,8 @@ MODULE Heap;
     VAR i, j, x: S.ADDRESS;
   BEGIN j := l; x := a[j];
     LOOP i := j; j := 2*j + 1;
-      IF (j < r) & (a[j] < a[j+1]) THEN INC(j) END;
+      IF (j < r) &  uLT(a[j], a[j+1]) THEN INC(j) END;
-      IF (j > r) OR (a[j] <= x) THEN EXIT END;
+      IF (j > r) OR uLE(a[j], x) THEN EXIT END;
       a[i] := a[j]
     END;
     a[i] := x
@@ -449,29 +446,27 @@ MODULE Heap;
     WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END
   END HeapSort;
 
-  PROCEDURE MarkCandidates(n: S.ADDRESS; VAR cand: ARRAY OF S.ADDRESS);
+  PROCEDURE MarkCandidates(n: LONGINT; VAR cand: ARRAY OF S.ADDRESS);
-    VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: S.ADDRESS;
+    VAR chnk, end, adr, tag, next, i, ptr, size: S.ADDRESS;
   BEGIN
-    chnk := heap; i := 0; lim := cand[n-1];
+    ASSERT(n > 0);
-    WHILE (chnk # 0 ) & (lim - chnk > 0) DO
+    chnk := heap; i := 0;
+    WHILE chnk # 0 DO
+      S.GET(chnk + endOff, end);
       adr := chnk + blkOff;
-      S.GET(chnk + endOff, lim1);
+      WHILE uLT(adr, end) DO
-      IF lim1 - lim > 0 THEN lim1 := lim END ;
-      WHILE lim1 - adr > 0 DO
         S.GET(adr, tag);
         IF ODD(tag) THEN (*already marked*)
-          S.GET(tag-1, size); INC(adr, size)
+          S.GET(tag-1, size); INC(adr, size); ptr := adr + SZA;
+          WHILE uLT(cand[i], ptr) DO INC(i); IF i = n THEN RETURN END END ;
         ELSE
-          S.GET(tag, size);
+          S.GET(tag, size); ptr := adr + SZA; INC(adr, size);
-          ptr := adr + SZA;
+          WHILE uLT(cand[i], ptr) DO INC(i); IF i = n THEN RETURN END END ;
-          WHILE ptr - cand[i] > 0 DO INC(i) END ;
+          IF uLT(cand[i], adr) THEN Mark(ptr) END
-          IF i = n THEN RETURN END ;
+        END ;
-          next := adr + size;
+        IF uLE(end, cand[i]) THEN (*skip rest of this heap chunk*) adr := end END
-          IF next - cand[i] > 0 THEN Mark(ptr) END ;
-          adr := next
-        END
       END ;
-      S.GET(chnk, chnk)
+      S.GET(chnk + nextChnkOff, chnk)
     END
   END MarkCandidates;
 
@@ -483,7 +478,7 @@ MODULE Heap;
       S.GET(n.obj - SZA, tag);
       IF ~ODD(tag) THEN n.marked := FALSE; Mark(n.obj)
       ELSE n.marked := TRUE
-      END ;
+      END;
       n := n.next
     END
   END CheckFin;
@@ -493,7 +488,7 @@ MODULE Heap;
   BEGIN n := fin; prev := NIL;
     WHILE n # NIL DO
       IF ~n.marked THEN
-        IF n = fin THEN fin := fin.next ELSE prev.next := n.next END ;
+        IF n = fin THEN fin := fin.next ELSE prev.next := n.next END;
         n.finalize(S.VAL(S.PTR, n.obj));
         (* new nodes may have been pushed in n.finalize, therefore: *)
         IF prev = NIL THEN n := fin ELSE n := n.next END
@@ -518,28 +513,27 @@ MODULE Heap;
   PROCEDURE MarkStack(n: S.ADDRESS; VAR cand: ARRAY OF S.ADDRESS);
     VAR
       frame: S.PTR;
-      inc, nofcand: S.ADDRESS;
+      nofcand: LONGINT;
-      sp, p, stack0: S.ADDRESS;
+      inc, sp, p, stack0: S.ADDRESS;
-      align: RECORD ch: CHAR; p: S.PTR END ;
+      align: RECORD ch: CHAR; p: S.PTR END;
   BEGIN
     IF n > 0 THEN MarkStack(n-1, cand);  (* flush register windows by means of recursive calls *)
       IF n > 100 THEN RETURN END   (* prevent tail recursion optimization *)
-    END ;
+    END;
     IF n = 0 THEN
       nofcand := 0; sp := S.ADR(frame);
       stack0 := ModulesMainStackFrame();
       (* check for minimum alignment of pointers *)
       inc := S.ADR(align.p) - S.ADR(align);
-      IF sp - stack0 > 0 THEN inc := -inc END ;
+      IF uLT(stack0, sp) THEN inc := -inc END;
       WHILE sp # stack0 DO
         S.GET(sp, p);
-        IF (p > 0) & (p >= heapPosMin) & (p < heapPosMax)
+        IF uLE(heapMin, p) & uLT(p, heapMax) THEN
-        OR (p < 0) & (p >= heapNegMin) & (p < heapNegMax) THEN
+          IF nofcand = LEN(cand) THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand); nofcand := 0 END;
-          IF nofcand = LEN(cand) THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand); nofcand := 0 END ;
           cand[nofcand] := p; INC(nofcand)
-        END ;
+        END;
         INC(sp, inc)
-      END ;
+      END;
       IF nofcand > 0 THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand) END
     END
   END MarkStack;
@@ -555,9 +549,9 @@ MODULE Heap;
       Lock();
       m := S.VAL(Module, modules);
       WHILE m # NIL DO
-        IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END ;
+        IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END;
         m := m^.next
-      END ;
+      END;
       IF markStack THEN
         (* generate register pressure to force callee saved registers to memory;
           may be simplified by inlining OS calls or processor specific instructions
@@ -569,10 +563,10 @@ MODULE Heap;
           INC(i8, 9); INC(i9, 10); INC(i10, 11); INC(i11, 12); INC(i12, 13); INC(i13, 14); INC(i14, 15); INC(i15, 16);
           INC(i16, 17); INC(i17, 18); INC(i18, 19); INC(i19, 20); INC(i20, 21); INC(i21, 22); INC(i22, 23); INC(i23, 24);
           IF (i0 = -99) & (i15 = 24) THEN MarkStack(32, cand); EXIT END
-        END ;
+        END;
         IF i0 + i1 + i2 + i3 + i4 + i5 + i6 + i7 + i8 + i9 + i10 + i11 + i12 + i13 + i14 + i15
           + i16 + i17 + i18 + i19 + i20 + i21 + i22 + i23 > 10000 THEN RETURN    (* use all variables *)
-        END ;
+        END;
       END;
       CheckFin;
       Scan;
@@ -600,20 +594,18 @@ MODULE Heap;
     heapsize   := 0;
     allocated  := 0;
     lockdepth  := 0;
-    heapPosMin := MAX(S.ADDRESS);
+    heapMin    := -1;  (* all bits set *)
-    heapPosMax := 0;
+    heapMax    := 0;
-    heapNegMin := 0;
+    bigBlocks  := 0;
-    heapNegMax := MIN(S.ADDRESS);
 
     heap := NewChunk(heapSize0);
     S.PUT(heap + nextChnkOff, AddressZero);
 
     firstTry    := TRUE;
-    freeList[nofLists] := 1;
+    freeList[nofLists] := 1; (* Sentinel, # 0 *)
 
     FileCount   := 0;
     modules     := NIL;
-    bigBlocks   := 0;
     fin         := NIL;
     interrupted := FALSE;