Use SCODE/PRIMITIVE-PROCEDURE?, not PRIMITIVE-PROCEDURE?, before

calling PRIMITIVE-PROCEDURE-NAME or PRIMITIVE-PROCEDURE-ARITY in the
compiler.  The SCODE/ variant excludes the compiled error procedure
`primitive', which is actually a string employed as a token, not a
primitive proper.

diff --git a/v7/src/compiler/base/blocks.scm b/v7/src/compiler/base/blocks.scm
index ee45738b4751649ebadbb6e95c7af1ea863245ce..d78468edbe67aa31d2b8bc8bb7551bbb3260be88 100644 (file)
--- a/v7/src/compiler/base/blocks.scm
+++ b/v7/src/compiler/base/blocks.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: blocks.scm,v 4.21 2008/01/30 20:01:42 cph Exp $
+$Id: blocks.scm,v 4.22 2009/02/02 20:06:32 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -159,7 +159,7 @@ from the continuation, and then "glued" into place afterwards.
     (if (boolean? checks)
        checks
        (let ((primitive
-              (if (primitive-procedure? primitive)
+              (if (scode/primitive-procedure? primitive)
                   (primitive-procedure-name primitive)
                   primitive))
              (default (car checks))

diff --git a/v7/src/compiler/machines/C/stackify.scm b/v7/src/compiler/machines/C/stackify.scm
index 6461a611346f617ef39c6d12b210b75a914a665e..96e23dc0815dbaac9a71d3d94d620a747a8ffa79 100644 (file)
--- a/v7/src/compiler/machines/C/stackify.scm
+++ b/v7/src/compiler/machines/C/stackify.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: stackify.scm,v 1.4 2008/01/30 20:01:46 cph Exp $
+$Id: stackify.scm,v 1.5 2009/02/02 20:06:33 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -135,7 +135,7 @@ USA.
       (symbol? obj)
       (string? obj)
       (bit-string? obj)
-      (primitive-procedure? obj)
+      (scode/primitive-procedure? obj)
       ;; The runtime system needs the following
       (interpreter-return-address? obj)))
 
@@ -508,7 +508,7 @@ USA.
                         (bit-string->unsigned-integer obj)
                         16))
                       (build/push-nat (bit-string-length obj) prog)))
-       ((primitive-procedure? obj)
+       ((scode/primitive-procedure? obj)
         (let ((arity (primitive-procedure-arity obj))
               (name (symbol-name (primitive-procedure-name obj))))
           (cond ((fix:< arity 0)

diff --git a/v7/src/compiler/machines/C/traditional.scm b/v7/src/compiler/machines/C/traditional.scm
index ed8ea243b6c7840d18c77ee581599e673f2eed01..2b15f0080de7a347a6ddb0b6426a6a278a7be028 100644 (file)
--- a/v7/src/compiler/machines/C/traditional.scm
+++ b/v7/src/compiler/machines/C/traditional.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: traditional.scm,v 1.7 2008/01/30 20:01:46 cph Exp $
+$Id: traditional.scm,v 1.8 2009/02/02 20:06:33 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -225,7 +225,7 @@ USA.
        ((eq? #t object) "SHARP_T")
        ((null? object) "EMPTY_LIST")
        ((eq? object unspecific) "UNSPECIFIC")
-       ((primitive-procedure? object)
+       ((scode/primitive-procedure? object)
         (let ((arity (primitive-procedure-arity object)))
           (if (< arity -1)
               (error "->simple-C-object: Unknown arity primitive:" object))