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

Integrate OFront fix for unsigned DIV in heap.

Browse source
This commit is contained in:
David Brown 2016-12-28 12:33:34 +00:00
parent d292b4b2c9
commit 173c83f217
1 changed files with 25 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

36
src/runtime/Heap.Mod
View file

@ -7,9 +7,10 @@ MODULE Heap;
ModNameLen = 20; ModNameLen = 20;
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 freelist entries excluding sentinel *) nofLists = 9; (* Number of freelist entries excluding sentinel *)
heapSize0 = 8000*Unit; (* startup heap size *) heapSize0 = 8000*Unit; (* Startup heap size *)
heapMinExpand = 10000*Unit; (* minimum heap expansion size *)
(* all blocks look the same: (* all blocks look the same:
free blocks describe themselves: size = Unit free blocks describe themselves: size = Unit
@ -78,6 +79,8 @@ MODULE Heap;
bigBlocks: S.ADDRESS; bigBlocks: S.ADDRESS;
allocated*: S.ADDRESS; allocated*: S.ADDRESS;
firstTry: BOOLEAN; firstTry: BOOLEAN;
ldUnit: INTEGER; (* Unit = 2^ldUnit, for unsigned division expressed as logical shift right *)
(* extensible heap *) (* extensible heap *)
heap-: S.ADDRESS; (* the sorted list of heap chunks *) heap-: S.ADDRESS; (* the sorted list of heap chunks *)
@ -210,8 +213,8 @@ 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 uLT(10000*Unit, blksz) THEN size := blksz IF uLT(heapMinExpand, blksz) THEN size := blksz
ELSE size := 10000*Unit (* additional heuristics *) ELSE size := heapMinExpand (* additional heuristics for avoiding many small heap expansions *)
END; END;
chnk := NewChunk(size); chnk := NewChunk(size);
IF chnk # 0 THEN IF chnk # 0 THEN
@ -239,15 +242,15 @@ MODULE Heap;
Lock(); Lock();
S.GET(tag, blksz); S.GET(tag, blksz);
ASSERT((Unit = 16) OR (Unit = 32));
ASSERT(SIZE(S.PTR) = SIZE(S.ADDRESS)); ASSERT(SIZE(S.PTR) = SIZE(S.ADDRESS));
ASSERT(blksz MOD Unit = 0); ASSERT(blksz MOD Unit = 0);
i0 := blksz DIV Unit; i := i0; i0 := S.LSH(blksz, -ldUnit); (*uDIV Unit*)
IF uLT(i, nofLists) THEN adr := freeList[i]; i := i0;
IF 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 uLT(i, nofLists) THEN (* Unlink from freelist[i] *) IF 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 *)
@ -266,11 +269,11 @@ MODULE Heap;
IF adr = 0 THEN (* Nothing free *) IF adr = 0 THEN (* Nothing free *)
IF firstTry THEN IF firstTry THEN
GC(TRUE); INC(blksz, Unit); GC(TRUE); INC(blksz, Unit);
(* Anti-thrashing heuristics: ensure 1/4 of the heap will not be allocated. *) (* Anti-thrashing heuristics: ensure 1/5 of the heap will not be allocated. *)
t := (allocated + blksz) DIV (3*Unit) * (4*Unit); (* Minimum required new heapsize *) t := S.LSH(allocated + blksz, -2) (*uDIV 4*) * 5 ; (* Minimum preferred heapsize *)
IF uLT(heapsize, t) THEN ExtendHeap(t - heapsize) END; IF uLT(heapsize, t) THEN ExtendHeap(t - heapsize) END;
firstTry := FALSE; new := NEWREC(tag); firstTry := FALSE; new := NEWREC(tag);
IF new = NIL THEN (* Fragmentation prevented allocation, heap is 1/4 free *) IF new = NIL THEN (* Heap is 1/5 free but fragmentation prevented allocation *)
ExtendHeap(blksz); ExtendHeap(blksz);
new := NEWREC(tag) (* Will find a free block if heap has been expanded successfully *) new := NEWREC(tag) (* Will find a free block if heap has been expanded successfully *)
END; END;
@ -395,7 +398,8 @@ MODULE Heap;
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 := S.LSH(freesize, -ldUnit) (*uDIV Unit*);
freesize := 0;
IF uLT(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
@ -416,7 +420,8 @@ MODULE Heap;
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 := S.LSH(freesize, -ldUnit) (*uDIV Unit*);
freesize := 0;
IF uLT(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
@ -595,6 +600,9 @@ MODULE Heap;
heapMax := 0; heapMax := 0;
bigBlocks := 0; bigBlocks := 0;
ASSERT((Unit = 16) OR (Unit = 32));
IF Unit = 16 THEN ldUnit := 4 ELSE ldUnit := 5 END;
heap := NewChunk(heapSize0); heap := NewChunk(heapSize0);
S.PUT(heap + nextChnkOff, AddressZero); S.PUT(heap + nextChnkOff, AddressZero);