[movitz-cvs] CVS update: movitz/special-operators.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv3749

Modified Files:
	special-operators.lisp 
Log Message:
Provide name for gensym of setf-expanders.

Date: Sun Feb  8 18:27:56 2004
Author: ffjeld

Index: movitz/special-operators.lisp
diff -u movitz/special-operators.lisp:1.6 movitz/special-operators.lisp:1.7
--- movitz/special-operators.lisp:1.6	Wed Feb  4 11:01:26 2004
+++ movitz/special-operators.lisp	Sun Feb  8 18:27:56 2004
@@ -8,7 +8,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Nov 24 16:22:59 2000
 ;;;;                
-;;;; $Id: special-operators.lisp,v 1.6 2004/02/04 16:01:26 ffjeld Exp $
+;;;; $Id: special-operators.lisp,v 1.7 2004/02/08 23:27:56 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -359,7 +359,7 @@
 				    (values-list
 				     (translate-program (multiple-value-list (block ,access-fn , at cl-body))
 							:cl :muerte.cl)))))))
-	      (movitz-macro-expander-make-function expander :type :setf)))))))
+	      (movitz-macro-expander-make-function expander :type :setf :name access-fn)))))))
   (compiler-values ()))
 
 (define-special-operator muerte::defmacro-compile-time (&form form)
@@ -977,12 +977,15 @@
 		   :form term-form)
 	       (assert term2-type)
 	       (let ((term2-type (type-specifier-primary term2-type)))
+;;;		 (warn "t2-type: ~S, t2-ret: ~S, rm: ~S"
+;;;		       term2-type term2-returns result-mode)
 		 (case term2-returns
 		   (:untagged-fixnum-eax
 		    (case result-mode
 		      (:untagged-fixnum-eax
 		       (compiler-values ()
 			 :returns :untagged-fixnum-eax
+			 :type 'integer
 			 :functional-p term2-functional-p
 			 :modifies term2-modifies
 			 :code (append term2-code
@@ -1009,20 +1012,23 @@
 			    :returns add-register
 			    :functional-p term2-functional-p
 			    :modifies term2-modifies
+			    :type 'integer
 			    :code (append
 				   new-load-term-code
-				   (unless nil #+ignore (subtypep (translate-program term2-type :muerte.cl :cl)
-								  `(integer ,+movitz-most-negative-fixnum+
-									    ,+movitz-most-positive-fixnum+))
+				   (unless nil
+				     #+ignore (subtypep (translate-program term2-type :muerte.cl :cl)
+							`(integer ,+movitz-most-negative-fixnum+
+								  ,+movitz-most-positive-fixnum+))
 				     `((:testb ,+movitz-fixnum-zmask+
 					       ,(register32-to-low8 add-register))
 				       (:jnz '(:sub-program (,label) (:int 107) (:jmp (:pc+ -4))))))
 				   `((:addl ,(* constant-term +movitz-fixnum-factor+) ,add-register))
-				   (unless nil #+ignore (subtypep (translate-program term2-type :muerte.cl :cl)
-								  `(integer ,(+ +movitz-most-negative-fixnum+
-										constant-term)
-									    ,(+ +movitz-most-positive-fixnum+
-										constant-term)))
+				   (unless nil
+				     #+ignore (subtypep (translate-program term2-type :muerte.cl :cl)
+							`(integer ,(+ +movitz-most-negative-fixnum+
+								      constant-term)
+								  ,(+ +movitz-most-positive-fixnum+
+								      constant-term)))
 				     '((:into)))))))))))))
       (cond
        ((and (movitz-constantp term1 env)