Don't insert top-level bindings of procedures into code, assuming that

they are primitives.  Use explicit references to primitives.

diff --git a/v7/src/compiler/back/syerly.scm b/v7/src/compiler/back/syerly.scm
index ea10059aeb23ed2061e025ce3b550a4d3ed7e06e..f42e751cec275d5505a74a8dd83b4fdc863103f5 100644 (file)
--- a/v7/src/compiler/back/syerly.scm
+++ b/v7/src/compiler/back/syerly.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: syerly.scm,v 1.17 2008/01/30 20:01:42 cph Exp $
+$Id: syerly.scm,v 1.18 2008/02/14 02:12:52 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -53,7 +53,7 @@ USA.
                               ENTRY-POINT LABEL BLOCK-OFFSET))
                (if-expanded
                 (scode/make-combination
-                 (scode/make-variable  'DIRECTIVE->INSTRUCTION-SEQUENCE)
+                 (scode/make-variable 'DIRECTIVE->INSTRUCTION-SEQUENCE)
                  operands)))
               (else
                (let ((place (assq (car instruction) early-instructions)))
@@ -167,7 +167,9 @@ USA.
                     (if (not (null? (scode/constant-value (cadr operands))))
                         (error "CONS-SYNTAX-EXPANDER: bad tail"
                                (cadr operands)))
-                    (if-expanded (scode/make-combination cons operands)))))))
+                    (if-expanded
+                     (scode/make-combination (ucode-primitive cons)
+                                             operands)))))))
        (if (and (scode/constant? (car operands))
                (bit-string? (scode/constant-value (car operands)))
                (scode/combination? (cadr operands)))
@@ -181,7 +183,7 @@ USA.
                   (if-expanded
                    (scode/make-combination
                     (if (scode/constant? (cadr inner-operands))
-                        cons
+                        (ucode-primitive cons)
                         operator)
                     (cons (instruction-append
                            (scode/constant-value (car operands))
@@ -233,6 +235,6 @@ USA.
                     (list (car binding))
                     (list (cdr binding))
                     (scode/make-combination
-                     cons
+                     (ucode-primitive cons)
                      (list rest
                            (scode/make-variable (car binding))))))))))))))
\ No newline at end of file

diff --git a/v7/src/compiler/base/scode.scm b/v7/src/compiler/base/scode.scm
index 1353ea8a0a35ac3b9bd03ea618435399dc94604f..f6682449edc66b235cd32813e8ef9a7c29141b80 100644 (file)
--- a/v7/src/compiler/base/scode.scm
+++ b/v7/src/compiler/base/scode.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: scode.scm,v 4.19 2008/01/30 20:01:43 cph Exp $
+$Id: scode.scm,v 4.20 2008/02/14 02:12:27 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -123,5 +123,6 @@ USA.
   (scode/make-absolute-combination
    'ERROR-PROCEDURE
    (list message
-        (scode/make-combination cons (list operand '()))
+        (scode/make-combination (ucode-primitive cons)
+                                (list operand '()))
         (scode/make-the-environment))))
\ No newline at end of file

diff --git a/v7/src/compiler/fggen/fggen.scm b/v7/src/compiler/fggen/fggen.scm
index e4a992ecb2a9fd6ab38691444430eefc30485d84..0584b86cb3735a0f7b18ac3b09411940666e01d9 100644 (file)
--- a/v7/src/compiler/fggen/fggen.scm
+++ b/v7/src/compiler/fggen/fggen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fggen.scm,v 4.44 2008/01/30 20:01:44 cph Exp $
+$Id: fggen.scm,v 4.45 2008/02/14 02:12:14 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -589,7 +589,9 @@ USA.
                (if (= n 1)
                    expression
                    (loop (scode/make-combination
-                          (if (= (remainder n 2) 1) car cdr)
+                          (if (= (remainder n 2) 1)
+                              (ucode-primitive car)
+                              (ucode-primitive cdr))
                           (list expression))
                          (quotient n 2))))))
            (else

diff --git a/v7/src/edwin/xform.scm b/v7/src/edwin/xform.scm
index 86d0e9a9f58b0352bfff62c320ab04f442176aac..58dbbfcaffe25c622a97e0eecef420d547f2d538 100644 (file)
--- a/v7/src/edwin/xform.scm
+++ b/v7/src/edwin/xform.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xform.scm,v 1.18 2008/01/30 20:02:07 cph Exp $
+$Id: xform.scm,v 1.19 2008/02/14 02:11:51 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -64,7 +64,8 @@ USA.
   (let ((entry (assq (scode-variable-name variable) transforms)))
     (if (not entry)
        variable
-       (make-combination vector-ref (list name-of-self (cdr entry))))))
+       (make-combination (ucode-primitive vector-ref)
+                         (list name-of-self (cdr entry))))))
 
 (define (transform-assignment transforms assignment)
   (assignment-components assignment
@@ -73,7 +74,7 @@ USA.
            (value (transform-expression transforms value)))
        (if (not entry)
            (make-assignment name value)
-           (make-combination vector-set!
+           (make-combination (ucode-primitive vector-set!)
                              (list name-of-self
                                    (cdr entry)
                                    value)))))))

diff --git a/v7/src/runtime/lambda.scm b/v7/src/runtime/lambda.scm
index 4b7cb28be66b3093d8ae5d64071de541ec94924d..dedeb03425834f468394605eda080a58073a361f 100644 (file)
--- a/v7/src/runtime/lambda.scm
+++ b/v7/src/runtime/lambda.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lambda.scm,v 14.22 2008/01/30 20:02:32 cph Exp $
+$Id: lambda.scm,v 14.23 2008/02/14 02:11:34 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -250,11 +250,12 @@ USA.
                                       (make-unassigned auxiliary))))
                (list (let ((environment (make-the-environment)))
                        (make-combination
-                        system-subvector->list
+                        (ucode-primitive system-subvector-to-list)
                         (list environment
                               (+ (length required) 3)
-                              (make-combination system-vector-length
-                                                (list environment)))))))))
+                              (make-combination
+                               (ucode-primitive system-vector-size)
+                               (list environment)))))))))
 
 (define (clexpr-components clexpr receiver)
   (slexpr-components clexpr

diff --git a/v7/src/runtime/syntax-output.scm b/v7/src/runtime/syntax-output.scm
index db1a620ccad76073ca6b639d6727f385102565c6..b222afbbabaab58402a27c335f448c1814359eb9 100644 (file)
--- a/v7/src/runtime/syntax-output.scm
+++ b/v7/src/runtime/syntax-output.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: syntax-output.scm,v 14.15 2008/01/30 20:02:36 cph Exp $
+$Id: syntax-output.scm,v 14.16 2008/02/14 02:11:38 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -139,7 +139,8 @@ USA.
   (make-access environment name))
 
 (define (output/access-assignment name environment value)
-  (make-combination lexical-assignment (list environment name value)))
+  (make-combination (ucode-primitive lexical-assignment)
+                   (list environment name value)))
 
 (define (output/local-declare declarations body)
   (make-declaration declarations body))

diff --git a/v7/src/runtime/urtrap.scm b/v7/src/runtime/urtrap.scm
index 2e27aff02bdc7ea5f818f6e800792810fb4ad64b..5b6c5009f9640ad356dfa09dfa5af0b84f32bbbd 100644 (file)
--- a/v7/src/runtime/urtrap.scm
+++ b/v7/src/runtime/urtrap.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: urtrap.scm,v 14.21 2008/02/13 14:25:33 cph Exp $
+$Id: urtrap.scm,v 14.22 2008/02/14 02:11:39 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -160,7 +160,7 @@ USA.
              (fix:= 15 (primitive-object-ref (getter) 0))))))
 
 (define (make-macro-reference-trap-expression transformer)
-  (make-combination primitive-object-set-type
+  (make-combination (ucode-primitive primitive-object-set-type)
                    (list (ucode-type reference-trap)
                          (make-combination (ucode-primitive cons)
                                            (list 15 transformer)))))