From 54b6a0a9ab47678e45ea1c01bebd066836cc74af Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 22 Jun 2007 02:27:48 +0000 Subject: [PATCH] Don't use ASSQ with all interrupts off -- it can generate an unbounded amount of garbage and overflow the heap. --- v7/src/compiler/base/crsend.scm | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) 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) -- 2.25.1