[movitz-cvs] CVS movitz

[ffjeld]

Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv31859

Modified Files:
	compiler.lisp 
Log Message:
Minor cleanup of make-function-arguments-init.


--- /project/movitz/cvsroot/movitz/compiler.lisp	2007/02/16 20:17:23	1.173
+++ /project/movitz/cvsroot/movitz/compiler.lisp	2007/02/17 19:24:28	1.174
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.173 2007/02/16 20:17:23 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.174 2007/02/17 19:24:28 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -2850,22 +2850,24 @@
 		      unless (search set x)
 		      do (setf x (nconc x (copy-list set)))
 		      finally (return x)))
-	 (num-jumpers (length jumpers)))
+	 (num-jumpers (length jumpers))
+	 (stuff (append key-args-constants
+			(sort (loop for (constant count) on constants by #'cddr
+				  unless (or (eq constant *movitz-nil*)
+					     (eq constant (image-t-symbol *image*)))
+				  collect (cons constant count))
+			      #'< :key #'cdr))))
     (values (append jumpers
+		    (mapcar (lambda (x)
+			      (movitz-read (car x)))
+			    stuff)
 		    (make-list (length borrowing-bindings)
-			       :initial-element *movitz-nil*)
-		    (mapcar (lambda (x) (movitz-read (car x)))
-			    (append (sort (loop for (constant count) on constants by #'cddr
-					      unless (or (eq constant *movitz-nil*)
-							 (eq constant (image-t-symbol *image*)))
-					      collect (cons constant count))
-					  #'< :key #'cdr)
-				    key-args-constants)))
+			       :initial-element *movitz-nil*))
 	    num-jumpers
 	    (loop for (name set) on jumper-sets by #'cddr
 		collect (cons name set))
 	    (loop for borrowing-binding in borrowing-bindings
-		as pos upfrom num-jumpers
+		as pos upfrom (+ num-jumpers (length stuff))
 		collect (cons borrowing-binding pos)))))
 
 (defun movitz-funobj-intern-constant (funobj obj)
@@ -4783,8 +4785,7 @@
 	 (movitz-binding (decode-keyword-formal (first key-vars)) env))))
     (values
      (append
-      (loop ;;  with eax-optional-destructive-p = nil
-	  for optional in optional-vars
+      (loop for optional in optional-vars
 	  as optional-var = (decode-optional-formal optional)
 	  as binding = (movitz-binding optional-var env)
 	  as last-optional-p = (and (null key-vars)
@@ -4966,22 +4967,12 @@
 			    :result-mode :ebx)
 			  `((:jmp 'default-done)))))
 		,@(case position
-		    (0 `((:load-constant ,(movitz-read (keyword-function-argument-keyword-name binding)) :eax :op :cmpl))
-		       #+ignore `((:cmpl (:esi ,(movitz-funobj-intern-constant
-						 funobj
-						 (movitz-read (keyword-function-argument-keyword-name binding))))
-					 :eax)))
-		    (1 `((:load-constant ,(movitz-read (keyword-function-argument-keyword-name binding)) :ebx :op :cmpl))
-		       #+ignore `((:cmpl (:esi ,(movitz-funobj-intern-constant
-						 funobj
-						 (movitz-read (keyword-function-argument-keyword-name binding))))
-					 :ebx)))
-		    (t `((:load-constant ,(movitz-read (keyword-function-argument-keyword-name binding)) :eax :op :cmpl))
-		       #+ignore `((:movl (:ebp (:ecx 4) ,(* -4 (1- position))) :eax)
-				  (:cmpl (:esi ,(movitz-funobj-intern-constant
-						 funobj
-						 (movitz-read (keyword-function-argument-keyword-name binding))))
-					 :eax))))
+		    (0 `((:load-constant ,(movitz-read (keyword-function-argument-keyword-name binding))
+					 :eax :op :cmpl)))
+		    (1 `((:load-constant ,(movitz-read (keyword-function-argument-keyword-name binding))
+					 :ebx :op :cmpl)))
+		    (t `((:load-constant ,(movitz-read (keyword-function-argument-keyword-name binding))
+					 :eax :op :cmpl))))
 		,@(if allow-other-keys-p
 		      `((:jne 'default))
 		    `((:jne '(:sub-program (unknown-key) (:int 101)))))