Don't panic about excessively large allocations (ticket #343)

src/Lib/Common/ehandler.sch

@@ -570,6 +570,18 @@
        ((= code $ex.put-char)
         (not-a-port "put-char" arg1))
 
+       ;; Allocation
+
+       ;; The allocation size is given in words, and it may be negative
+       ;; due to overflow when adding a vector header and/or aligning.
+       ;; We report the unsigned value in bytes.
+
+       ((= code $ex.alloc)
+        (let ((uwords (if (< arg1 0)
+                        (+ arg1 (expt 2 30))
+                        arg1)))
+          (error #f (errmsg 'msg:alloctoobig) (list (* uwords 4)))))
+
        ;; Others
 
        ;; For assertions, the first argument is the expression that

src/Lib/Common/errmsg.sch

@@ -228,4 +228,6 @@
 
 (msg:keyboardinterrupt          "keyboard interrupt")
 
+(msg:alloctoobig                "requested allocation exceeds max object size")
+
 ))

src/Rts/IAssassin/millicode.c

@@ -105,6 +105,9 @@ void EXPORT mc_alloc( word *globals )
   assert2( is_fixnum(globals[G_RESULT]) && (int)globals[G_RESULT] >= 0 );
 
   nwords = roundup_walign( nwords );
+  if ( nwords*sizeof(word) > LARGEST_OBJECT )
+    signal_exception( globals, EX_ALLOC, 0, 0 );
+
   p = GC_malloc( nwords*sizeof(word) );
   assert (p != 0);
   globals[ G_RESULT ] = (word)p;
@@ -119,6 +122,9 @@ void EXPORT mc_alloc( word *globals )
   assert2(((word)elim & 7) == 0);
 
   nwords = roundup_walign( nwords );
+  if ( nwords*sizeof(word) > LARGEST_OBJECT )
+    signal_exception( globals, EX_ALLOC, 0, 0 );
+
   p = etop;
   etop += nwords;
   if (etop <= elim) {

src/Rts/Shared/i386-millicode.asm

@@ -213,13 +213,15 @@ EXTNAME(%1):
 	;; On entry, esp is off by 4
 PUBLIC i386_alloc_bv
 	MCg	mc_alloc_bv
+
 PUBLIC i386_alloc
 %ifdef OPTIMIZE_MILLICODE
 	mov	TEMP, [GLOBALS+G_ETOP]
 	add	RESULT, 7
 	and	RESULT, 0xfffffff8
-	add	TEMP, RESULT
 	add	TEMP, SCE_BUFFER
+	add	TEMP, RESULT		; Might wrap around on a large request
+	jc	L1
 	cmp	TEMP, CONT
 	ja	L1
 	mov	RESULT, [GLOBALS+G_ETOP]
@@ -242,8 +244,9 @@ PUBLIC i386_alloci
 	mov	ecx, RESULT		; Byte count for initialization
 	shr	ecx, 2			;   really want words
 	mov	TEMP, [GLOBALS+G_ETOP]
-	add	TEMP, RESULT
 	add	TEMP, SCE_BUFFER
+	add	TEMP, RESULT		; Might wrap around on a large request
+	jc	L2
 	cmp	TEMP, CONT
 	ja	L2
 	mov	RESULT, [GLOBALS+G_ETOP]

src/Rts/except.cfg

@@ -186,5 +186,6 @@
 (define-const breakpoint 202 "EX_BREAKPOINT" "EX_BREAKPOINT" "$ex.breakpoint")
 (define-const signal 203 "EX_SIGNAL" "EX_SIGNAL" "$ex.signal")
 (define-const timer 204 "EX_TIMER" "EX_TIMER" "$ex.timer")
+(define-const alloc 205 "EX_ALLOC" "EX_ALLOC" "$ex.alloc")
 
 ; eof