From: Taylor R. Campbell <net/mumble/campbell>
Date: Mon, 2 Feb 2009 16:02:17 +0000 (+0000)
Subject: Use the CONS primitive, not the value of the top-level variable named
X-Git-Tag: 20090517-FFI~82
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9127a3f27bad10d4eadb0219a7ec05b31b7c69ab;p=mit-scheme.git

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 c1644924f..8d600896b 100644
--- 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 26b5d30ad..7400b993b 100644
--- 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