From 76a93fcbc31afb730d3364ee1fd0eaf88da8e7e7 Mon Sep 17 00:00:00 2001
From: ceriel <none@none>
Date: Tue, 26 Apr 1988 11:25:36 +0000
Subject: [PATCH] better error checking in Storage module

---
 lang/m2/libm2/Storage.mod | 39 ++++++++++++++++++++++++++++++++++-----
 1 file changed, 34 insertions(+), 5 deletions(-)

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