Rewrite some more variable references as explicit primitive constants.

This includes one instance, in MAKE-MACRO-REFERENCE-TRAP-EXPRESSION,
that was causing a fatal error.

diff --git a/v7/src/runtime/advice.scm b/v7/src/runtime/advice.scm
index 11cc3b931814c797016a4a35aa3ea1a5e8fa204f..16c10c6b63c56b209068803d623c50ece6b7f035 100644 (file)
--- a/v7/src/runtime/advice.scm
+++ b/v7/src/runtime/advice.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: advice.scm,v 14.24 2008/01/30 20:02:28 cph Exp $
+$Id: advice.scm,v 14.25 2008/02/13 14:25:30 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -65,7 +65,8 @@ USA.
 (define (make-advice-hook)
   ;; This inserts the actual procedure in a constant list.
   (make-combination
-   (make-combination car (list (list hook/advised-procedure-wrapper)))
+   (make-combination (ucode-primitive car)
+                    (list (list hook/advised-procedure-wrapper)))
    (list (make-the-environment))))
 
 (define (hook/advised-procedure-wrapper environment)

diff --git a/v7/src/runtime/sdata.scm b/v7/src/runtime/sdata.scm
index 35a41df4c8fb6c81945e035c6eb5a7b016930cfe..9da30f33b4d4c21833b3c36ac17b3112dffe31a5 100644 (file)
--- a/v7/src/runtime/sdata.scm
+++ b/v7/src/runtime/sdata.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: sdata.scm,v 14.8 2008/01/30 20:02:35 cph Exp $
+$Id: sdata.scm,v 14.9 2008/02/13 14:25:31 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -31,57 +31,69 @@ USA.
 (declare (usual-integrations))
 \f
 (define (&typed-singleton-cons type element)
-  (system-pair-cons type (unmap-reference-trap element) '()))
+  ((ucode-primitive system-pair-cons) type (unmap-reference-trap element) '()))
 
 (define (&singleton-element singleton)
-  (map-reference-trap (lambda () (system-pair-car singleton))))
+  (map-reference-trap
+   (lambda ()
+     ((ucode-primitive system-pair-car) singleton))))
 
 (define (&singleton-set-element! singleton new-element)
-  (system-pair-set-car! singleton (unmap-reference-trap new-element)))
+  ((ucode-primitive system-pair-set-car!)
+   singleton
+   (unmap-reference-trap new-element)))
 
 (define (&typed-pair-cons type car cdr)
-  (system-pair-cons type
-                   (unmap-reference-trap car)
-                   (unmap-reference-trap cdr)))
+  ((ucode-primitive system-pair-cons)
+   type
+   (unmap-reference-trap car)
+   (unmap-reference-trap cdr)))
 
 (define (&pair-car pair)
-  (map-reference-trap (lambda () (system-pair-car pair))))
+  (map-reference-trap (lambda () ((ucode-primitive system-pair-car) pair))))
 
 (define (&pair-set-car! pair new-car)
-  (system-pair-set-car! pair (unmap-reference-trap new-car)))
+  ((ucode-primitive system-pair-set-car!) pair (unmap-reference-trap new-car)))
 
 (define (&pair-cdr pair)
-  (map-reference-trap (lambda () (system-pair-cdr pair))))
+  (map-reference-trap (lambda () ((ucode-primitive system-pair-cdr) pair))))
 
 (define (&pair-set-cdr! pair new-cdr)
-  (system-pair-set-cdr! pair (unmap-reference-trap new-cdr)))
+  ((ucode-primitive system-pair-set-cdr!) pair (unmap-reference-trap new-cdr)))
 \f
 (define (&typed-triple-cons type first second third)
   (object-new-type type
-                  (hunk3-cons (unmap-reference-trap first)
-                              (unmap-reference-trap second)
-                              (unmap-reference-trap third))))
+                  ((ucode-primitive hunk3-cons)
+                   (unmap-reference-trap first)
+                   (unmap-reference-trap second)
+                   (unmap-reference-trap third))))
 
 (define (&triple-first triple)
-  (map-reference-trap (lambda () (system-hunk3-cxr0 triple))))
+  (map-reference-trap (lambda () ((ucode-primitive system-hunk3-cxr0) triple))))
 
 (define (&triple-set-first! triple new-first)
-  (system-hunk3-set-cxr0! triple (unmap-reference-trap new-first)))
+  ((ucode-primitive system-hunk3-set-cxr0!)
+   triple
+   (unmap-reference-trap new-first)))
 
 (define (&triple-second triple)
-  (map-reference-trap (lambda () (system-hunk3-cxr1 triple))))
+  (map-reference-trap (lambda () ((ucode-primitive system-hunk3-cxr1) triple))))
 
 (define (&triple-set-second! triple new-second)
-  (system-hunk3-set-cxr1! triple (unmap-reference-trap new-second)))
+  ((ucode-primitive system-hunk3-set-cxr1!)
+   triple
+   (unmap-reference-trap new-second)))
 
 (define (&triple-third triple)
-  (map-reference-trap (lambda () (system-hunk3-cxr2 triple))))
+  (map-reference-trap (lambda () ((ucode-primitive system-hunk3-cxr2) triple))))
 
 (define (&triple-set-third! triple new-third)
-  (system-hunk3-set-cxr2! triple (unmap-reference-trap new-third)))
+  ((ucode-primitive system-hunk3-set-cxr2!)
+   triple
+   (unmap-reference-trap new-third)))
 
 (define (&typed-vector-cons type elements)
-  (system-list->vector
+  ((ucode-primitive system-list-to-vector)
    type
    (let loop ((elements elements))
      (if (null? elements)
@@ -90,13 +102,17 @@ USA.
               (loop (cdr elements)))))))
 
 (define (&vector-length vector)
-  (system-vector-length vector))
+  ((ucode-primitive system-vector-size) vector))
 
 (define (&vector-ref vector index)
-  (map-reference-trap (lambda () (system-vector-ref vector index))))
+  (map-reference-trap
+   (lambda ()
+     ((ucode-primitive system-vector-ref) vector index))))
 
 (define (&subvector->list vector start stop)
-  (let loop ((sublist (system-subvector->list vector start stop)))
+  (let loop
+      ((sublist
+       ((ucode-primitive system-subvector-to-list) vector start stop)))
     (if (null? sublist)
        '()
        (cons (map-reference-trap (lambda () (car sublist)))

diff --git a/v7/src/runtime/unsyn.scm b/v7/src/runtime/unsyn.scm
index 49c7ed20733847bf60f710bbec60656d94046884..a531d95c20a9973aaea4a9dba0a5df6da872a339 100644 (file)
--- a/v7/src/runtime/unsyn.scm
+++ b/v7/src/runtime/unsyn.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unsyn.scm,v 14.35 2008/01/30 20:02:36 cph Exp $
+$Id: unsyn.scm,v 14.36 2008/02/13 14:25:32 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -394,7 +394,7 @@ USA.
         (cond ((or (not (eq? #t unsyntaxer:macroize?))
                    (has-substitution? operator))
                (ordinary-combination))
-              ((and (or (eq? operator cons)
+              ((and (or (eq? operator (ucode-primitive cons))
                         (absolute-reference-to? operator 'CONS))
                     (= (length operands) 2)
                     (delay? (cadr operands))

diff --git a/v7/src/runtime/urtrap.scm b/v7/src/runtime/urtrap.scm
index d283568491e47982928e2d48368ed33473b06c46..2e27aff02bdc7ea5f818f6e800792810fb4ad64b 100644 (file)
--- a/v7/src/runtime/urtrap.scm
+++ b/v7/src/runtime/urtrap.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: urtrap.scm,v 14.20 2008/01/30 20:02:37 cph Exp $
+$Id: urtrap.scm,v 14.21 2008/02/13 14:25:33 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -162,7 +162,8 @@ USA.
 (define (make-macro-reference-trap-expression transformer)
   (make-combination primitive-object-set-type
                    (list (ucode-type reference-trap)
-                         (make-combination cons (list 15 transformer)))))
+                         (make-combination (ucode-primitive cons)
+                                           (list 15 transformer)))))
 
 (define (macro-reference-trap-expression? expression)
   (and (combination? expression)
@@ -173,7 +174,8 @@ USA.
              (pair? (cdr operands))
              (let ((expression (cadr operands)))
                (and (combination? expression)
-                    (eq? (combination-operator expression) cons)
+                    (eq? (combination-operator expression)
+                         (ucode-primitive cons))
                     (let ((operands (combination-operands expression)))
                       (and (pair? operands)
                            (eqv? (car operands) 15)