vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 22:42:24 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
David Brown 2016-12-19 16:00:57 +00:00
parent 6f43c272c9
commit 43117e79f7
1 changed files with 87 additions and 95 deletions
Download patch file Download diff file Expand all files Collapse all files

118
src/runtime/Heap.Mod
View file

@ -8,7 +8,7 @@ MODULE Heap;
CmdNameLen = 24; CmdNameLen = 24;
SZA = SIZE(S.ADDRESS); (* Size of address *) SZA = SIZE(S.ADDRESS); (* Size of address *)
Unit = 4*SZA; (* smallest possible heap block *) 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 *) heapSize0 = 8000*Unit; (* startup heap size *)
(* all blocks look the same: (* all blocks look the same:
@ -81,10 +81,8 @@ MODULE Heap;
(* extensible heap *) (* extensible heap *)
heap-: S.ADDRESS; (* the sorted list of heap chunks *) 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 *) heapsize*: S.ADDRESS; (* the sum of all heap chunk sizes *)
(* finalization candidates *) (* finalization candidates *)
@ -114,6 +112,9 @@ MODULE Heap;
END Unlock; 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 *) PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *)
VAR oldflag : BOOLEAN; VAR oldflag : BOOLEAN;
@ -200,13 +201,8 @@ MODULE Heap;
bigBlocks := blk; (* Prepend block to list of big blocks *) bigBlocks := blk; (* Prepend block to list of big blocks *)
INC(heapsize, blksz); INC(heapsize, blksz);
(* Maintain heap range limits *) (* 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; END;
RETURN chnk RETURN chnk
END NewChunk; END NewChunk;
@ -214,17 +210,17 @@ MODULE Heap;
PROCEDURE ExtendHeap(blksz: S.ADDRESS); PROCEDURE ExtendHeap(blksz: S.ADDRESS);
VAR size, chnk, j, next: S.ADDRESS; VAR size, chnk, j, next: S.ADDRESS;
BEGIN BEGIN
IF blksz > 10000*Unit THEN size := blksz IF uLT(10000*Unit, blksz) THEN size := blksz
ELSE size := 10000*Unit (* additional heuristics *) ELSE size := 10000*Unit (* additional heuristics *)
END; END;
chnk := NewChunk(size); chnk := NewChunk(size);
IF chnk # 0 THEN IF chnk # 0 THEN
(*sorted insertion*) (*sorted insertion*)
IF chnk < heap THEN IF uLT(chnk, heap) THEN
S.PUT(chnk, heap); heap := chnk S.PUT(chnk, heap); heap := chnk
ELSE ELSE
j := heap; S.GET(j, next); j := heap; S.GET(j, next);
WHILE (next # 0) & (chnk - next > 0) DO WHILE (next # 0) & uLT(next, chnk) DO
j := next; j := next;
S.GET(j, next) S.GET(j, next)
END; END;
@ -248,13 +244,13 @@ MODULE Heap;
ASSERT(blksz MOD Unit = 0); ASSERT(blksz MOD Unit = 0);
i0 := blksz DIV Unit; i := i0; 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 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); S.GET(adr + nextOff, next);
freeList[i] := next; freeList[i] := next;
IF i # i0 THEN (* split *) IF i # i0 THEN (* Split *)
di := i - i0; restsize := di * Unit; end := adr + restsize; di := i - i0; restsize := di * Unit; end := adr + restsize;
S.PUT(end + sizeOff, blksz); S.PUT(end + sizeOff, blksz);
S.PUT(end + sntlOff, NoPtrSntl); S.PUT(end + sntlOff, NoPtrSntl);
@ -264,14 +260,15 @@ MODULE Heap;
freeList[di] := adr; freeList[di] := adr;
INC(adr, restsize) INC(adr, restsize)
END END
ELSE ELSE (* Search in bigBlocks *)
adr := bigBlocks; prev := 0; adr := bigBlocks; prev := 0;
LOOP LOOP
IF adr = 0 THEN IF adr = 0 THEN (* Nothing free *)
IF firstTry THEN IF firstTry THEN
GC(TRUE); INC(blksz, Unit); 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) ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize)
END; END;
firstTry := FALSE; new := NEWREC(tag); firstTry := TRUE; firstTry := FALSE; new := NEWREC(tag); firstTry := TRUE;
@ -287,21 +284,21 @@ MODULE Heap;
END END
END; END;
S.GET(adr+sizeOff, t); 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) prev := adr; S.GET(adr + nextOff, adr)
END; END;
restsize := t - blksz; end := adr + restsize; restsize := t - blksz; end := adr + restsize;
S.PUT(end + sizeOff, blksz); S.PUT(end + sizeOff, blksz);
S.PUT(end + sntlOff, NoPtrSntl); S.PUT(end + sntlOff, NoPtrSntl);
S.PUT(end, end + sizeOff); S.PUT(end, end + sizeOff);
IF restsize > nofLists * Unit THEN (*resize*) IF uLT(nofLists * Unit, restsize) THEN (* Resize *)
S.PUT(adr + sizeOff, restsize) S.PUT(adr + sizeOff, restsize)
ELSE (*unlink*) ELSE (* Unlink *)
S.GET(adr + nextOff, next); S.GET(adr + nextOff, next);
IF prev = 0 THEN bigBlocks := next IF prev = 0 THEN bigBlocks := next
ELSE S.PUT(prev + nextOff, next); ELSE S.PUT(prev + nextOff, next);
END; END;
IF restsize > 0 THEN (*move*) IF restsize # 0 THEN (* Move *)
di := restsize DIV Unit; di := restsize DIV Unit;
S.PUT(adr + sizeOff, restsize); S.PUT(adr + sizeOff, restsize);
S.PUT(adr + nextOff, freeList[di]); S.PUT(adr + nextOff, freeList[di]);
@ -311,7 +308,7 @@ MODULE Heap;
INC(adr, restsize) INC(adr, restsize)
END; END;
i := adr + 4*SZA; end := adr + blksz; 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, AddressZero);
S.PUT(i + SZA, AddressZero); S.PUT(i + SZA, AddressZero);
S.PUT(i + 2*SZA, AddressZero); S.PUT(i + 2*SZA, AddressZero);
@ -393,16 +390,16 @@ MODULE Heap;
WHILE chnk # 0 DO WHILE chnk # 0 DO
adr := chnk + blkOff; adr := chnk + blkOff;
S.GET(chnk + endOff, end); S.GET(chnk + endOff, end);
WHILE end - adr > 0 DO WHILE uLT(adr, end) DO
S.GET(adr, tag); 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; start := adr - freesize;
S.PUT(start, start+SZA); S.PUT(start, start+SZA);
S.PUT(start+sizeOff, freesize); S.PUT(start+sizeOff, freesize);
S.PUT(start+sntlOff, NoPtrSntl); S.PUT(start+sntlOff, NoPtrSntl);
i := freesize DIV Unit; freesize := 0; 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; END;
@ -417,13 +414,13 @@ MODULE Heap;
INC(adr, size) INC(adr, size)
END END
END; END;
IF freesize > 0 THEN (*collect last block*) IF freesize # 0 THEN (* Collect last block *)
start := adr - freesize; start := adr - freesize;
S.PUT(start, start+SZA); S.PUT(start, start+SZA);
S.PUT(start+sizeOff, freesize); S.PUT(start+sizeOff, freesize);
S.PUT(start+sntlOff, NoPtrSntl); S.PUT(start+sntlOff, NoPtrSntl);
i := freesize DIV Unit; freesize := 0; 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; END;
@ -435,8 +432,8 @@ MODULE Heap;
VAR i, j, x: S.ADDRESS; VAR i, j, x: S.ADDRESS;
BEGIN j := l; x := a[j]; BEGIN j := l; x := a[j];
LOOP i := j; j := 2*j + 1; 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] a[i] := a[j]
END; END;
a[i] := x 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 WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END
END HeapSort; 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 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; 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); S.GET(adr, tag);
IF ODD(tag) THEN (*already marked*) 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 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 ;
next := adr + size;
IF next - cand[i] > 0 THEN Mark(ptr) END ;
adr := next
END
END ; END ;
S.GET(chnk, chnk) IF uLE(end, cand[i]) THEN (*skip rest of this heap chunk*) adr := end END
END ;
S.GET(chnk + nextChnkOff, chnk)
END END
END MarkCandidates; END MarkCandidates;
@ -518,8 +513,8 @@ MODULE Heap;
PROCEDURE MarkStack(n: S.ADDRESS; VAR cand: ARRAY OF S.ADDRESS); PROCEDURE MarkStack(n: S.ADDRESS; VAR cand: ARRAY OF S.ADDRESS);
VAR VAR
frame: S.PTR; 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 BEGIN
IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *) IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *)
@ -530,11 +525,10 @@ MODULE Heap;
stack0 := ModulesMainStackFrame(); stack0 := ModulesMainStackFrame();
(* check for minimum alignment of pointers *) (* check for minimum alignment of pointers *)
inc := S.ADR(align.p) - S.ADR(align); 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 WHILE sp # stack0 DO
S.GET(sp, p); 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) cand[nofcand] := p; INC(nofcand)
END; END;
@ -600,20 +594,18 @@ MODULE Heap;
heapsize := 0; heapsize := 0;
allocated := 0; allocated := 0;
lockdepth := 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); heap := NewChunk(heapSize0);
S.PUT(heap + nextChnkOff, AddressZero); S.PUT(heap + nextChnkOff, AddressZero);
firstTry := TRUE; firstTry := TRUE;
freeList[nofLists] := 1; freeList[nofLists] := 1; (* Sentinel, # 0 *)
FileCount := 0; FileCount := 0;
modules := NIL; modules := NIL;
bigBlocks := 0;
fin := NIL; fin := NIL;
interrupted := FALSE; interrupted := FALSE;