Use the CONS primitive, not the value of the top-level variable named

CONS, to detect error combinations.  Use PRIMITIVE-ARITY-CORRECT?
during RTL generation to check primitive arities, so that error
combinations are handled correctly.

diff --git a/v7/src/compiler/fggen/fggen.scm b/v7/src/compiler/fggen/fggen.scm
index c1644924fe3994288a5cf3fc7d334136a4af3986..8d600896b14e4f585697bb335420137c49510212 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.46 2009/02/02 15:33:38 riastradh Exp $
+$Id: fggen.scm,v 4.47 2009/02/02 16:02:17 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -951,7 +951,7 @@ USA.
                                         'LIST))
                               (and (scode/combination? irritants)
                                    (eq? (scode/combination-operator irritants)
-                                        cons)))))
+                                        (ucode-primitive cons))))))
                    (generate/error-combination block continuation
                                                context expression))
                   (else

diff --git a/v7/src/compiler/rtlgen/rgcomb.scm b/v7/src/compiler/rtlgen/rgcomb.scm
index 26b5d30ad69cf76dd72ba32ec3e44183af3ea231..7400b993b83d5cc64d0df125969bacba746d3edf 100644 (file)
--- a/v7/src/compiler/rtlgen/rgcomb.scm
+++ b/v7/src/compiler/rtlgen/rgcomb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rgcomb.scm,v 4.26 2008/01/30 20:01:56 cph Exp $
+$Id: rgcomb.scm,v 4.27 2009/02/02 16:02:17 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -157,10 +157,8 @@ USA.
   model                                        ; ignored
   (scfg*scfg->scfg!
    (prefix frame-size 0)
-   (let* ((primitive (constant-value (rvalue-known-value operator)))
-         (arity (primitive-procedure-arity primitive)))
-     (if (not (or (= arity -1)
-                 (= arity frame-size)))
+   (let ((primitive (constant-value (rvalue-known-value operator))))
+     (if (not (primitive-arity-correct? primitive frame-size))
         (error "Primitive called with incorrect number of arguments."
                primitive
                arity