fixed problems in Storage module: caused integer overflow and bad pointers

This commit is contained in:
ceriel 1988-04-11 10:34:31 +00:00
parent 48d2fa770e
commit d7030591f9

View file

@ -35,7 +35,7 @@ IMPLEMENTATION MODULE Storage;
Bucket = Bucket =
RECORD RECORD
CASE : BOOLEAN OF CASE : BOOLEAN OF
FALSE: BSIZE: INTEGER; (* size of user part in UNITs *) FALSE: BSIZE: CARDINAL; (* size of user part in UNITs *)
BNEXT: BucketPtr; | (* next free Bucket *) BNEXT: BucketPtr; | (* next free Bucket *)
TRUE: BXX: ALIGNTYPE TRUE: BXX: ALIGNTYPE
END; END;
@ -53,8 +53,8 @@ IMPLEMENTATION MODULE Storage;
USED: ADDRESS; USED: ADDRESS;
PROCEDURE MyAllocate(size: CARDINAL) : ADDRESS; PROCEDURE MyAllocate(size: CARDINAL) : ADDRESS;
VAR nu : INTEGER; VAR nu : CARDINAL;
b : INTEGER; b : CARDINAL;
p, q: BucketPtr; p, q: BucketPtr;
brk : ADDRESS; brk : ADDRESS;
BEGIN BEGIN
@ -79,7 +79,7 @@ IMPLEMENTATION MODULE Storage;
IF FreeLists[b] # NIL THEN IF FreeLists[b] # NIL THEN
q := FreeLists[b]; q := FreeLists[b];
FreeLists[b] := q^.BNEXT; FreeLists[b] := q^.BNEXT;
p := ADDRESS(q) + CARDINAL((nu+1)*UNIT); p := ADDRESS(q) + (nu+1)*UNIT;
(* p indicates the block that must be given (* p indicates the block that must be given
back back
*) *)
@ -113,7 +113,7 @@ IMPLEMENTATION MODULE Storage;
(* split block, (* split block,
tail goes to FreeLists area tail goes to FreeLists area
*) *)
q := ADDRESS(p) + CARDINAL((nu+1)*UNIT); q := ADDRESS(p) + (nu+1)*UNIT;
q^.BSIZE := p^.BSIZE -nu -1; q^.BSIZE := p^.BSIZE -nu -1;
q^.BNEXT := FreeLists[q^.BSIZE]; q^.BNEXT := FreeLists[q^.BSIZE];
FreeLists[q^.BSIZE] := q; FreeLists[q^.BSIZE] := q;
@ -124,7 +124,7 @@ IMPLEMENTATION MODULE Storage;
(* Give part of tail of original block. (* Give part of tail of original block.
Block stays in this list. Block stays in this list.
*) *)
q := ADDRESS(p) + CARDINAL((p^.BSIZE-nu)*UNIT); q := ADDRESS(p) + (p^.BSIZE-nu)*UNIT;
q^.BSIZE := nu; q^.BSIZE := nu;
p^.BSIZE := p^.BSIZE - nu - 1; p^.BSIZE := p^.BSIZE - nu - 1;
q^.BNEXT := USED; q^.BNEXT := USED;
@ -202,8 +202,9 @@ IMPLEMENTATION MODULE Storage;
PROCEDURE ReOrganize(); PROCEDURE ReOrganize();
VAR lastblock: BucketPtr; VAR lastblock: BucketPtr;
b, be: BucketPtr; b, be: BucketPtr;
i: INTEGER; i: CARDINAL;
BEGIN BEGIN
lastblock := NIL;
FOR i := 1 TO NLISTS DO FOR i := 1 TO NLISTS DO
b := FreeLists[i]; b := FreeLists[i];
WHILE b # NIL DO WHILE b # NIL DO
@ -231,7 +232,7 @@ IMPLEMENTATION MODULE Storage;
b := FirstBlock; b := FirstBlock;
WHILE ADDRESS(b) < ADDRESS(lastblock) DO WHILE ADDRESS(b) < ADDRESS(lastblock) DO
LOOP LOOP
be := ADDRESS(b)+CARDINAL((b^.BSIZE+1)*UNIT); be := ADDRESS(b)+(b^.BSIZE+1)*UNIT;
IF b^.BNEXT # NIL THEN IF b^.BNEXT # NIL THEN
(* this block is not free *) (* this block is not free *)
EXIT; EXIT;
@ -245,9 +246,13 @@ IMPLEMENTATION MODULE Storage;
EXIT; EXIT;
END; END;
(* this block and the next one are free, (* this block and the next one are free,
so merge them so merge them, but only if it is not too big
*) *)
IF MAX(CARDINAL) - b^.BSIZE > be^.BSIZE THEN
b^.BSIZE := b^.BSIZE + be^.BSIZE + 1; b^.BSIZE := b^.BSIZE + be^.BSIZE + 1;
ELSE
EXIT;
END;
END; END;
b := be; b := be;
END; END;
@ -270,12 +275,12 @@ IMPLEMENTATION MODULE Storage;
END; END;
END; END;
END; END;
b := ADDRESS(b) + CARDINAL((b^.BSIZE+1) * UNIT); b := ADDRESS(b) + (b^.BSIZE+1) * UNIT;
END; END;
END ReOrganize; END ReOrganize;
PROCEDURE InitStorage(); PROCEDURE InitStorage();
VAR i: INTEGER; VAR i: CARDINAL;
brk: ADDRESS; brk: ADDRESS;
BEGIN BEGIN
FOR i := 1 TO NLISTS DO FOR i := 1 TO NLISTS DO