From 041b3966e26184308d3fc18f379af032adcc998c Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Thu, 8 Dec 1994 16:48:37 +0000 Subject: [PATCH] Placed limits on size of objects open-coded by STRING-ALLOCATE and FLOATING-VECTOR-CONS. --- v8/src/compiler/midend/earlyrew.scm | 30 +++++++++++++++-------------- v8/src/compiler/midend/fakeprim.scm | 7 ++++++- 2 files changed, 22 insertions(+), 15 deletions(-) diff --git a/v8/src/compiler/midend/earlyrew.scm b/v8/src/compiler/midend/earlyrew.scm index 6beeaf434..e59585dec 100644 --- 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 5beeec7e2..cd4d0ce69 100644 --- 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]")) +;; 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 ) ;; Note: -- 2.25.1