Placed limits on size of objects open-coded by STRING-ALLOCATE and

FLOATING-VECTOR-CONS.

diff --git a/v8/src/compiler/midend/earlyrew.scm b/v8/src/compiler/midend/earlyrew.scm
index 6beeaf434ef71bfb5abaf4adb8ff9a6fd472c0ed..e59585dec03a3eff3717ee873ec7f8e50ef88613 100644 (file)
--- a/v8/src/compiler/midend/earlyrew.scm
+++ b/v8/src/compiler/midend/earlyrew.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: earlyrew.scm,v 1.1 1994/11/19 02:04:29 adams Exp $
+$Id: earlyrew.scm,v 1.2 1994/12/08 16:46:54 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -508,23 +508,25 @@ MIT in each case. |#
 ;; This is done this way because of current rtl generator 
 
 (let ((allocation-rewriter
-       (lambda (name out-of-line)
+       (lambda (name out-of-line limit)
         (let ((primitive (make-primitive-procedure name)))
           (lambda (size)
-            (let ((default
-                    (lambda ()
-                      `(CALL (QUOTE ,out-of-line) (QUOTE #F) ,size))))
-              (cond ((earlyrew/number? size)
-                     => (lambda (nbytes)
-                          (if (not (exact-nonnegative-integer? nbytes))
-                              (default)
-                              `(CALL (QUOTE ,primitive) (QUOTE #F) ,size))))
-                    (else
-                     (default)))))))))
+            (define (default)
+              `(CALL (QUOTE ,out-of-line) (QUOTE #F) ,size))
+            (cond ((earlyrew/number? size)
+                   => (lambda (nbytes)
+                        (if (not (and (exact-nonnegative-integer? nbytes)
+                                      (<= nbytes limit)))
+                            (default)
+                            `(CALL (QUOTE ,primitive) (QUOTE #F) ,size))))
+                  (else
+                   (default))))))))
   (define-rewrite/early 'STRING-ALLOCATE
-    (allocation-rewriter 'STRING-ALLOCATE %string-allocate))
+    (allocation-rewriter 'STRING-ALLOCATE %string-allocate
+                        *string-allocate-max-open-coded-length*))
   (define-rewrite/early 'FLOATING-VECTOR-CONS
-    (allocation-rewriter 'FLOATING-VECTOR-CONS %floating-vector-cons)))
+    (allocation-rewriter 'FLOATING-VECTOR-CONS %floating-vector-cons 
+                        *floating-vector-cons-max-open-coded-length*)))
 
 ;; *** This can be improved by using %vector-allocate,
 ;; and a non-marked header moved through the vector as it is filled. ***

diff --git a/v8/src/compiler/midend/fakeprim.scm b/v8/src/compiler/midend/fakeprim.scm
index 5beeec7e2f3db6d4d272b38b2a887ea61b523b2a..cd4d0ce694e8b5d499825db33a9cbd4c231ff37e 100644 (file)
--- a/v8/src/compiler/midend/fakeprim.scm
+++ b/v8/src/compiler/midend/fakeprim.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fakeprim.scm,v 1.3 1994/11/25 22:59:37 jmiller Exp $
+$Id: fakeprim.scm,v 1.4 1994/12/08 16:48:37 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -775,6 +775,11 @@ MIT in each case. |#
   ;;     continuation.
   (make-operator/out-of-line "#[vector-cons]"))
 \f
+;; These limit the size of an object the is open-coded by bumping free
+;; without a rigourous heap check.
+(define *string-allocate-max-open-coded-length* 4000)
+(define *floating-vector-cons-max-open-coded-length* 500)
+
 (define %string-allocate
   ;; (CALL ',%string-allocate <continuation or #F> <length>)
   ;; Note: