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

Merge heap fix for negative addresses from OFront. Fix ulmSets CharSet size.

Browse source
This commit is contained in:
David Brown 2016-11-28 14:56:10 +00:00
parent c630f86399
commit b9339c9516
2 changed files with 96 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

96
src/library/ulm/ulmSets.Mod
View file

@ -40,14 +40,14 @@ MODULE ulmSets;
setsize* = MAX(SET) + 1; setsize* = MAX(SET) + 1;
TYPE TYPE
CharSet* = ARRAY ORD(MAX(CHAR)) + 1 DIV setsize OF SET; CharSet* = ARRAY (ORD(MAX(CHAR)) + 1) DIV setsize OF SET;
PROCEDURE InitSet*(VAR set: ARRAY OF SET); PROCEDURE InitSet*(VAR set: ARRAY OF SET);
VAR i: LONGINT; VAR i: LONGINT;
BEGIN BEGIN
i := 0; i := 0;
WHILE i < LEN(set) DO WHILE i < LEN(set) DO
set[i] := {}; INC(i); set[i] := {}; INC(i);
END; END;
END InitSet; END InitSet;
@ -56,7 +56,7 @@ MODULE ulmSets;
BEGIN BEGIN
i := 0; i := 0;
WHILE i < LEN(set) DO WHILE i < LEN(set) DO
set[i] := - set[i]; INC(i); set[i] := - set[i]; INC(i);
END; END;
END Complement; END Complement;
@ -92,115 +92,115 @@ MODULE ulmSets;
PROCEDURE Intersection*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET); PROCEDURE Intersection*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET);
VAR VAR
index: INTEGER; index: INTEGER;
BEGIN BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2))); ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0; index := 0;
WHILE index < LEN(result) DO WHILE index < LEN(result) DO
result[index] := set1[index] * set2[index]; result[index] := set1[index] * set2[index];
INC(index); INC(index);
END; END;
END Intersection; END Intersection;
PROCEDURE SymDifference*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET); PROCEDURE SymDifference*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET);
VAR VAR
index: INTEGER; index: INTEGER;
BEGIN BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2))); ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0; index := 0;
WHILE index < LEN(result) DO WHILE index < LEN(result) DO
result[index] := set1[index] / set2[index]; result[index] := set1[index] / set2[index];
INC(index); INC(index);
END; END;
END SymDifference; END SymDifference;
PROCEDURE Union*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET); PROCEDURE Union*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET);
VAR VAR
index: INTEGER; index: INTEGER;
BEGIN BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2))); ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0; index := 0;
WHILE index < LEN(result) DO WHILE index < LEN(result) DO
result[index] := set1[index] + set2[index]; result[index] := set1[index] + set2[index];
INC(index); INC(index);
END; END;
END Union; END Union;
PROCEDURE Difference*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET); PROCEDURE Difference*(set1, set2: ARRAY OF SET; VAR result: ARRAY OF SET);
VAR VAR
index: INTEGER; index: INTEGER;
BEGIN BEGIN
ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2))); ASSERT((LEN(result) = LEN(set1)) & (LEN(result) = LEN(set2)));
index := 0; index := 0;
WHILE index < LEN(result) DO WHILE index < LEN(result) DO
result[index] := set1[index] - set2[index]; result[index] := set1[index] - set2[index];
INC(index); INC(index);
END; END;
END Difference; END Difference;
PROCEDURE Equal*(set1, set2: ARRAY OF SET) : BOOLEAN; PROCEDURE Equal*(set1, set2: ARRAY OF SET) : BOOLEAN;
VAR VAR
index: INTEGER; index: INTEGER;
BEGIN BEGIN
index := 0; index := 0;
WHILE (index < LEN(set1)) & (index < LEN(set2)) DO WHILE (index < LEN(set1)) & (index < LEN(set2)) DO
IF set1[index] # set2[index] THEN IF set1[index] # set2[index] THEN
RETURN FALSE RETURN FALSE
END; END;
INC(index); INC(index);
END; END;
WHILE index < LEN(set1) DO WHILE index < LEN(set1) DO
IF set1[index] # {} THEN IF set1[index] # {} THEN
RETURN FALSE RETURN FALSE
END; END;
INC(index); INC(index);
END; END;
WHILE index < LEN(set2) DO WHILE index < LEN(set2) DO
IF set2[index] # {} THEN IF set2[index] # {} THEN
RETURN FALSE RETURN FALSE
END; END;
INC(index); INC(index);
END; END;
RETURN TRUE RETURN TRUE
END Equal; END Equal;
PROCEDURE Subset*(set1, set2: ARRAY OF SET) : BOOLEAN; PROCEDURE Subset*(set1, set2: ARRAY OF SET) : BOOLEAN;
VAR VAR
index: INTEGER; index: INTEGER;
BEGIN BEGIN
index := 0; index := 0;
WHILE (index < LEN(set1)) & (index < LEN(set2)) DO WHILE (index < LEN(set1)) & (index < LEN(set2)) DO
IF set1[index] - set2[index] # {} THEN IF set1[index] - set2[index] # {} THEN
RETURN FALSE RETURN FALSE
END; END;
INC(index); INC(index);
END; END;
WHILE index < LEN(set1) DO WHILE index < LEN(set1) DO
IF set1[index] # {} THEN IF set1[index] # {} THEN
RETURN FALSE RETURN FALSE
END; END;
INC(index); INC(index);
END; END;
RETURN TRUE RETURN TRUE
END Subset; END Subset;
PROCEDURE Card*(set: ARRAY OF SET) : INTEGER; PROCEDURE Card*(set: ARRAY OF SET) : INTEGER;
VAR VAR
index: INTEGER; index: INTEGER;
i: INTEGER; i: INTEGER;
card: INTEGER; card: INTEGER;
BEGIN BEGIN
card := 0; card := 0;
index := 0; index := 0;
WHILE index < LEN(set) DO WHILE index < LEN(set) DO
i := 0; i := 0;
WHILE i <= MAX(SET) DO WHILE i <= MAX(SET) DO
IF i IN set[index] THEN IF i IN set[index] THEN
INC(card); INC(card);
END; END;
INC(i); INC(i);
END; END;
INC(index); INC(index);
END; END;
RETURN card RETURN card
END Card; END Card;

69
src/runtime/Heap.Mod
View file

@ -22,7 +22,7 @@ MODULE Heap;
(* heap chunks *) (* heap chunks *)
nextChnkOff = S.VAL(S.ADDRESS, 0); (* next heap chunk, sorted ascendingly! *) nextChnkOff = S.VAL(S.ADDRESS, 0); (* next heap chunk, sorted ascendingly! *)
endOff = S.VAL(S.ADDRESS, SZA); (* end of heap chunk *) endOff = S.VAL(S.ADDRESS, SZA); (* end of heap chunk *)
blkOff = S.VAL(S.ADDRESS, 3*SZA); (* first block in a chunk *) blkOff = S.VAL(S.ADDRESS, 3*SZA); (* first block in a chunk, starts with tag *)
(* heap blocks *) (* heap blocks *)
tagOff = S.VAL(S.ADDRESS, 0); (* block starts with tag *) tagOff = S.VAL(S.ADDRESS, 0); (* block starts with tag *)
@ -79,9 +79,12 @@ MODULE Heap;
firstTry: BOOLEAN; firstTry: BOOLEAN;
(* extensible heap *) (* extensible heap *)
heap: S.ADDRESS; (* the sorted list of heap chunks *) heap: S.ADDRESS; (* the sorted list of heap chunks *)
heapend: S.ADDRESS; (* max possible pointer value (used for stack collection) *) heapNegMin: S.ADDRESS; (* Range of pointer values, used for stack collection *)
heapsize*: S.ADDRESS; (* the sum of all heap chunk sizes *) heapNegMax: S.ADDRESS;
heapPosMin: S.ADDRESS;
heapPosMax: S.ADDRESS;
heapsize*: S.ADDRESS; (* the sum of all heap chunk sizes *)
(* finalization candidates *) (* finalization candidates *)
fin: FinNode; fin: FinNode;
@ -166,18 +169,28 @@ MODULE Heap;
PROCEDURE -OSAllocate(size: S.ADDRESS): S.ADDRESS "Platform_OSAllocate(size)"; PROCEDURE -OSAllocate(size: S.ADDRESS): S.ADDRESS "Platform_OSAllocate(size)";
PROCEDURE NewChunk(blksz: S.ADDRESS): S.ADDRESS; PROCEDURE NewChunk(blksz: S.ADDRESS): S.ADDRESS;
VAR chnk: S.ADDRESS; VAR chnk, blk, end: S.ADDRESS;
BEGIN BEGIN
chnk := OSAllocate(blksz + blkOff); chnk := OSAllocate(blksz + blkOff);
IF chnk # 0 THEN IF chnk # 0 THEN
S.PUT(chnk + endOff, chnk + (blkOff + blksz)); blk := chnk + blkOff; (* Heap chunk consists of a single block *)
S.PUT(chnk + blkOff, chnk + (blkOff + sizeOff)); end := blk + blksz;
S.PUT(chnk + (blkOff + sizeOff), blksz); S.PUT(chnk + endOff, end);
S.PUT(chnk + (blkOff + sntlOff), NoPtrSntl); S.PUT(blk + tagOff, blk + sizeOff);
S.PUT(chnk + (blkOff + nextOff), bigBlocks); S.PUT(blk + sizeOff, blksz);
bigBlocks := chnk + blkOff; S.PUT(blk + sntlOff, NoPtrSntl);
INC(heapsize, blksz) S.PUT(blk + nextOff, bigBlocks);
END ; bigBlocks := blk; (* Prepend block to list of big blocks *)
INC(heapsize, blksz);
(* Maintain heap range limits *)
IF chnk > 0 THEN
IF chnk < heapPosMin THEN heapPosMin := blk + SZA 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 RETURN chnk
END NewChunk; END NewChunk;
@ -199,8 +212,7 @@ MODULE Heap;
S.GET(j, next) S.GET(j, next)
END; END;
S.PUT(chnk, next); S.PUT(j, chnk) S.PUT(chnk, next); S.PUT(j, chnk)
END ; END
IF next = 0 THEN S.GET(chnk+endOff, heapend) END
END END
END ExtendHeap; END ExtendHeap;
@ -504,7 +516,8 @@ MODULE Heap;
IF sp > stack0 THEN inc := -inc END ; IF sp > stack0 THEN inc := -inc END ;
WHILE sp # stack0 DO WHILE sp # stack0 DO
S.GET(sp, p); S.GET(sp, p);
IF (p > heap) & (p < heapend) THEN IF (p > 0) & (p >= heapPosMin) & (p < heapPosMax)
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 ;
@ -565,11 +578,25 @@ PROCEDURE -HeapModuleInit 'Heap__init()';
(* InitHeap is called by Platform.init before any module bodies have been (* InitHeap is called by Platform.init before any module bodies have been
initialised, to enable NEW, S.NEW *) initialised, to enable NEW, S.NEW *)
BEGIN BEGIN
heap := NewChunk(heapSize0); heap := 0;
S.GET(heap + endOff, heapend); heapsize := 0;
S.PUT(heap, AddressZero); allocated := 0;
allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; lockdepth := 0; lockdepth := 0;
FileCount := 0; modules := NIL; heapsize := 0; bigBlocks := 0; fin := NIL; heapPosMin := MAX(S.ADDRESS);
heapPosMax := 0;
heapNegMin := 0;
heapNegMax := MIN(S.ADDRESS);
heap := NewChunk(heapSize0);
S.PUT(heap + nextChnkOff, AddressZero);
firstTry := TRUE;
freeList[nofLists] := 1;
FileCount := 0;
modules := NIL;
bigBlocks := 0;
fin := NIL;
interrupted := FALSE; interrupted := FALSE;
HeapModuleInit; HeapModuleInit;