d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

better error checking in Storage module

Browse source
This commit is contained in:
ceriel 1988-04-26 11:25:36 +00:00
parent 6c825b7892
commit 76a93fcbc3
1 changed files with 34 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
lang/m2/libm2/Storage.mod
View file

@ -21,6 +21,8 @@ IMPLEMENTATION MODULE Storage;
CONST CONST
NLISTS = 20; NLISTS = 20;
MAGICW = 0A5A5H;
MAGICC = 175C;
TYPE TYPE
ALIGNTYPE = ALIGNTYPE =
@ -35,8 +37,9 @@ IMPLEMENTATION MODULE Storage;
Bucket = Bucket =
RECORD RECORD
CASE : BOOLEAN OF CASE : BOOLEAN OF
FALSE: BSIZE: CARDINAL; (* size of user part in UNITs *) FALSE:
BNEXT: BucketPtr; | (* next free Bucket *) BNEXT: BucketPtr; (* next free Bucket *)
BSIZE: CARDINAL; | (* size of user part in UNITs *)
TRUE: BXX: ALIGNTYPE TRUE: BXX: ALIGNTYPE
END; END;
BSTORE: ALIGNTYPE; BSTORE: ALIGNTYPE;
@ -158,12 +161,21 @@ IMPLEMENTATION MODULE Storage;
END Allocate; END Allocate;
PROCEDURE ALLOCATE(VAR a: ADDRESS; size: CARDINAL); PROCEDURE ALLOCATE(VAR a: ADDRESS; size: CARDINAL);
VAR p: BucketPtr;
pc: POINTER TO CHAR;
BEGIN BEGIN
a := MyAllocate(size); a := MyAllocate(size);
IF a = NIL THEN IF a = NIL THEN
Message("out of core"); Message("out of core");
HALT; HALT;
END; END;
p := a - UNIT;
WITH p^ DO
IF BSIZE # ((size + (UNIT - 1)) DIV UNIT) THEN
pc := a + size;
pc^ := MAGICC;
END;
END;
END ALLOCATE; END ALLOCATE;
PROCEDURE Available(size: CARDINAL): BOOLEAN; PROCEDURE Available(size: CARDINAL): BOOLEAN;
@ -184,11 +196,27 @@ IMPLEMENTATION MODULE Storage;
PROCEDURE DEALLOCATE(VAR a: ADDRESS; size: CARDINAL); PROCEDURE DEALLOCATE(VAR a: ADDRESS; size: CARDINAL);
VAR p: BucketPtr; VAR p: BucketPtr;
pc: POINTER TO CHAR;
BEGIN BEGIN
IF (a = NIL) THEN RETURN; END; IF (a = NIL) THEN
Message("(Warning) NIL pointer deallocated");
RETURN;
END;
p := a - UNIT; p := a - UNIT;
IF (p^.BNEXT # BucketPtr(USED)) THEN RETURN; END; IF (p^.BNEXT # BucketPtr(USED)) THEN
Message("(Warning) area already deallocated or heap corrupted");
a := NIL;
RETURN;
END;
WITH p^ DO WITH p^ DO
IF BSIZE # ((size + (UNIT - 1)) DIV UNIT) THEN
Message("(Warning) wrong size in deallocate");
ELSIF (BSIZE*UNIT # size) THEN
pc := a + size;
IF pc^ # MAGICC THEN
Message("(Warning) area corrupted");
END;
END;
IF BSIZE <= NLISTS THEN IF BSIZE <= NLISTS THEN
BNEXT := FreeLists[BSIZE]; BNEXT := FreeLists[BSIZE];
FreeLists[BSIZE] := p; FreeLists[BSIZE] := p;
@ -197,6 +225,7 @@ IMPLEMENTATION MODULE Storage;
Llist := p; Llist := p;
END; END;
END; END;
a := NIL
END DEALLOCATE; END DEALLOCATE;
PROCEDURE ReOrganize(); PROCEDURE ReOrganize();
@ -291,7 +320,7 @@ IMPLEMENTATION MODULE Storage;
brk := sbrk(UNIT - brk MOD UNIT); brk := sbrk(UNIT - brk MOD UNIT);
FirstBlock := sbrk(0); FirstBlock := sbrk(0);
Compacted := FALSE; Compacted := FALSE;
USED := 1; USED := MAGICW;
END InitStorage; END InitStorage;
BEGIN BEGIN