From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 22 Jun 2007 02:27:48 +0000 (+0000)
Subject: Don't use ASSQ with all interrupts off -- it can generate an unbounded
X-Git-Tag: 20090517-FFI~512
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=54b6a0a9ab47678e45ea1c01bebd066836cc74af;p=mit-scheme.git

Don't use ASSQ with all interrupts off -- it can generate an unbounded
amount of garbage and overflow the heap.
---

diff --git a/v7/src/compiler/base/crsend.scm b/v7/src/compiler/base/crsend.scm
index bd8604582..a38a6b74e 100644
--- a/v7/src/compiler/base/crsend.scm
+++ b/v7/src/compiler/base/crsend.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: crsend.scm,v 1.18 2007/06/14 17:39:26 cph Exp $
+$Id: crsend.scm,v 1.19 2007/06/22 02:27:48 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -109,14 +109,16 @@ USA.
 	   (map (lambda (label)
 		  (cons
 		   label
-		   (with-absolutely-no-interrupts
-		     (lambda ()
-		       ((ucode-primitive primitive-object-set-type)
-			(ucode-type compiled-entry)
-			(make-non-pointer-object
-			 (+ (cdr (or (assq label label-bindings)
-				     (error "Missing entry point" label)))
-			    (object-datum code-vector))))))))
+		   (let ((offset
+			  (cdr (or (assq label label-bindings)
+				   (error "Missing entry point" label)))))
+		     (with-absolutely-no-interrupts
+		       (lambda ()
+			 ((ucode-primitive primitive-object-set-type)
+			  (ucode-type compiled-entry)
+			  (make-non-pointer-object
+			   (+ offset
+			      (object-datum code-vector)))))))))
 		(cc-vector/entry-points cc-vector)))))
     (let ((label->expression
 	   (lambda (label)