OM bugfixes: Kernel (fixed GC NewArr integer overflow), DevCPC486 (va…

…rious checks added)

Dev/Mod/CPC486.cp

@@ -7,6 +7,11 @@ MODULE DevCPC486;
 	copyright	= "System/Rsrc/About"
 	license	= "Docu/BB-License"
 	references	= "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
+	changes	= "
+	- 20070123, bh, ccall support for procedure variable calls
+	- 20070409, bh, OUT pointer initialization in empty procedures
+	- 20091228, bh, corrections for S.VAL(LONGINT, real) in Convert & ConvMove
+	"
 **)
 
 	IMPORT SYSTEM, DevCPM, DevCPT, DevCPE, DevCPL486;
@@ -873,6 +878,10 @@ MODULE DevCPC486;
 					IF y.mode = Reg THEN Free(y);
 						IF (m # Stk) & (m # Undef) & (m # Reg) & (f >= Int32) THEN
 							x.form := y.form; DevCPL486.GenFStore(x, TRUE); x.form := f
+						ELSIF y.form = Real64 THEN	(* S.VAL(LONGINT, real) *)
+							ASSERT((m = Undef) & (f = Int64));
+							DecStack(y.form); y.mode := Stk; DevCPL486.GenFStore(y, TRUE); y.form := Int64;
+							Pop(y, y.form, hint, stop)
 						ELSE
 							ASSERT(y.form # Real64);
 							DecStack(y.form); y.mode := Stk; DevCPL486.GenFStore(y, TRUE); y.form := Int32;
@@ -1023,10 +1032,8 @@ MODULE DevCPC486;
 		ASSERT(x.mode # Con);
 		IF (size >= 0)
 			& ((size # x.typ.size) & ((size > 4) OR (x.typ.size > 4))
-				OR (f IN {Comp, Real64, Int64}) & (x.mode IN {Reg, Stk})) THEN DevCPM.err(220) END;
-(*
-		IF sysval & ((x.form = Real64) & ~(f IN {Comp, Int64}) OR (f = Real64) & ~(x.form  IN {Comp, Int64})) THEN DevCPM.err(220) END;
-*)
+				OR (f IN {Comp, Real64}) & (x.mode IN {Reg, Stk})
+				OR (f  = Int64) & (x.mode = Stk)) THEN DevCPM.err(220) END;
 		y.mode := Undef; y.form := f; ConvMove(y, x, size >= 0, hint, stop)
 	END Convert;
 
@@ -1521,7 +1528,10 @@ lx	:= LONG(SHORT(ly))	y b+	y w*	x w	*
 	PROCEDURE MulDim* (VAR y, z: DevCPL486.Item; VAR fact: INTEGER; dimtyp: DevCPT.Struct);	(* z := z * y *)
 		VAR c: DevCPL486.Item;
 	BEGIN
-		IF y.mode = Con THEN fact := fact * y.offset
+		IF y.mode = Con THEN
+			IF y.offset <= MAX(INTEGER) DIV fact THEN fact := fact * y.offset
+			ELSE fact := 1; DevCPM.err(214)
+			END
 		ELSE
 			IF ranchk OR inxchk THEN
 				DevCPL486.MakeConst(c, 0, Int32); DevCPL486.GenComp(c, y); DevCPL486.GenAssert(ccG, ranTrap)
@@ -2152,6 +2162,7 @@ lx	:= LONG(SHORT(ly))	y b+	y w*	x w	*
 				DevCPL486.GenPush(fp);
 				DevCPL486.GenMove(sp, fp);
 				adr := proc.conval.intval2; size := -adr;
+				IF size < 0 THEN DevCPM.err(214); size := 256 END;
 				IF isGuarded IN proc.conval.setval THEN
 					DevCPL486.MakeReg(r, BX, Pointer); DevCPL486.GenPush(r);
 					DevCPL486.MakeReg(r, DI, Pointer); DevCPL486.GenPush(r);

System/Mod/Kernel.cp

@@ -6,7 +6,17 @@ MODULE Kernel;
 	version	= "System/Rsrc/About"
 	copyright	= "System/Rsrc/About"
 	license	= "Docu/BB-License"
-	changes	= ""
+	changes	= "
+	- 20070123, bh, Beep using MessageBeep
+	- 20070125, bh, Support for procedure signatures added
+	- 20070130, bh, KERNEL32 & USER32 eliminated
+	- 20070220, bh, comSig eliminated
+	- 20070307, bh, improved Ctrl-Break handling
+	- 20070308, bh, check for unloaded module in ExecFinalizer
+	- 20080107, bh, full GC included in NewBlock
+	- 20080107, bh, pointer anchoring bug corrected in NewRec & NewArr
+	- 20120822, bh, mf, checks for integer overflow in NewArr and NewBlock
+	"
 	issues	= ""
 
 **)
@@ -741,6 +751,7 @@ MODULE Kernel;
 	PROCEDURE NewArr* (eltyp, nofelem, nofdim: INTEGER): INTEGER;	(* impl. of NEW(ptr, dim0, dim1, ...) *)
 		VAR b: Block; size, headSize: INTEGER; t: Type; fin: BOOLEAN; l: FList;
 	BEGIN
+		IF (nofdim < 0) OR (nofdim > (MAX(INTEGER) - 12) DIV 4) THEN RETURN 0 END;
 		headSize := 4 * nofdim + 12; fin := FALSE;
 		CASE eltyp OF
 		| -1: eltyp := S.ADR(IntPtrType); fin := TRUE
@@ -761,6 +772,8 @@ MODULE Kernel;
 			IF ODD(eltyp) THEN DEC(eltyp); fin := TRUE END
 		END;
 		t := S.VAL(Type, eltyp);
+		ASSERT(t.size > 0, 100);
+		IF (nofelem < 0) OR (nofelem > (MAX(INTEGER) - headSize) DIV t.size) THEN RETURN 0 END;
 		size := headSize + nofelem * t.size;
 		b := NewBlock(size);
 		IF b = NIL THEN RETURN 0 END;