Cache the immediate traps. There's no need to have more than one copy
authorChris Hanson <org/chris-hanson/cph>
Sat, 14 Aug 2004 05:51:46 +0000 (05:51 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 14 Aug 2004 05:51:46 +0000 (05:51 +0000)
of each.

v7/src/runtime/urtrap.scm

index b1e1a0486b6c9f4443aa2a632fbbd05aa03e3074..790fcc5ab19569faafd6eda6c5ac0572f132559f 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: urtrap.scm,v 14.15 2003/02/14 18:28:34 cph Exp $
+$Id: urtrap.scm,v 14.16 2004/08/14 05:51:46 cph Exp $
 
-Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1988,1993,2001,2002,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -30,8 +30,7 @@ USA.
 \f
 (define-structure (reference-trap
                   (type vector)
-                  (named ((ucode-primitive string->symbol)
-                          "#[(runtime reference-trap)reference-trap]"))
+                  (named '|#[(runtime reference-trap)reference-trap]|)
                   (print-procedure
                    (standard-unparser-method 'REFERENCE-TRAP
                      (lambda (trap port)
@@ -52,7 +51,7 @@ USA.
   (if (primitive-object-type? (ucode-type reference-trap) (getter))
       (let ((index (object-datum (getter))))
        (if (<= index trap-max-immediate)
-           (make-reference-trap index #f)
+           (make-immediate-reference-trap index)
            (make-reference-trap (primitive-object-ref (getter) 0)
                                 (primitive-object-ref (getter) 1))))
       (getter)))
@@ -78,9 +77,18 @@ USA.
     ((14) 'COMPILER-CACHED)
     ((15) 'MACRO)
     (else #f)))
+
+(define (make-immediate-reference-trap kind)
+  (or (vector-ref cached-traps kind)
+      (let ((trap (make-reference-trap kind #f)))
+       (vector-set! cached-traps kind trap)
+       trap)))
+
+(define cached-traps
+  (make-vector trap-max-immediate #f))
 \f
 (define (make-unassigned-reference-trap)
-  (make-reference-trap 0 #f))
+  (make-immediate-reference-trap 0))
 
 (define (unassigned-reference-trap? object)
   (and (reference-trap? object)
@@ -94,7 +102,7 @@ USA.
        (fix:= 0 (object-datum (getter)))))
 
 (define (make-unbound-reference-trap)
-  (make-reference-trap 2 #f))
+  (make-immediate-reference-trap 2))
 
 (define (unbound-reference-trap? object)
   (and (reference-trap? object)