[movitz-cvs] CVS update: movitz/compiler.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Removed function make-compiled-function-body-pass1.

Date: Thu Feb  5 05:45:20 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.14 movitz/compiler.lisp:1.15
--- movitz/compiler.lisp:1.14	Wed Feb  4 11:14:42 2004
+++ movitz/compiler.lisp	Thu Feb  5 05:45:20 2004
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.14 2004/02/04 16:14:42 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.15 2004/02/05 10:45:20 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -168,13 +168,13 @@
     (multiple-value-bind (required-vars optional-vars rest-var key-vars)
 	(decode-normal-lambda-list lambda-list)
       ;; There are several main branches through the function
-      ;; compiler, and this is where we decide which to take.
+      ;; compiler, and this is where we decide which one to take.
       (funcall (cond
 		((let ((sub-form (cddr form)))
 		   (and (consp (car sub-form))
 			(eq 'muerte::numargs-case (caar sub-form))))
 		 'make-compiled-function-pass1-numarg-case)
-		((and (= 1 (length required-vars))
+		((and (= 1 (length required-vars)) ; (x &optional y)
 		      (= 1 (length optional-vars))
 		      (null key-vars)
 		      (not rest-var))
@@ -201,21 +201,29 @@
 	     (error "There are duplicates in lambda-list ~S." lambda-list))
 	   (multiple-value-bind (clause-body clause-declarations)
 	       (parse-declarations-and-body clause-body)
-	     (let ((function-env
-		    (add-bindings-from-lambda-list lambda-list
-						   (make-local-movitz-environment
-						    funobj-env funobj
-						    :type 'function-env
-						    :declaration-context :funobj
-						    :declarations 
-						    (append clause-declarations
-							    declarations)))))
-	       (make-compiled-function-body-pass1 funobj
-						  function-env
-						  (list* 'muerte.cl::block
-							 (compute-function-block-name name)
-							 clause-body)
-						  top-level-p)
+	     (let* ((function-env
+		     (add-bindings-from-lambda-list lambda-list
+						    (make-local-movitz-environment
+						     funobj-env funobj
+						     :type 'function-env
+						     :declaration-context :funobj
+						     :declarations 
+						     (append clause-declarations
+							     declarations))))
+		    (function-form (list* 'muerte.cl::block
+					  (compute-function-block-name name)
+					  clause-body)))
+	       (multiple-value-bind (arg-init-code need-normalized-ecx-p)
+		   (make-function-arguments-init funobj function-env)
+		 (setf (extended-code function-env)
+		   (append arg-init-code
+			   (compiler-call #'compile-form
+			     :form (make-special-funarg-shadowing function-env function-form)
+			     :funobj funobj
+			     :env function-env
+			     :top-level-p top-level-p
+			     :result-mode :function)))
+		 (setf (need-normalized-ecx-p function-env) need-normalized-ecx-p))
 	       (push (cons numargs function-env)
 		     (function-envs funobj)))))
     funobj))
@@ -236,22 +244,19 @@
 	  (movitz-funobj-lambda-list funobj) (movitz-read (lambda-list-simplify lambda-list))
 	  (funobj-env funobj) funobj-env
 	  (function-envs funobj) (list (cons 'muerte.cl::t function-env)))
-    (make-compiled-function-body-pass1 funobj function-env form top-level-p)))
-
-(defun make-compiled-function-body-pass1 (funobj function-env form top-level-p)
-  "Returns the funobj with its extended-code."
-  (compiler-values-bind (&code body-code)
-      (compiler-call #'compile-form
-	:form (make-special-funarg-shadowing function-env form)
-	:funobj funobj
-	:env function-env
-	:top-level-p top-level-p
-	:result-mode :function)
     (multiple-value-bind (arg-init-code need-normalized-ecx-p)
 	(make-function-arguments-init funobj function-env)
-      (setf (extended-code function-env) (append arg-init-code body-code)
-	    (need-normalized-ecx-p function-env) need-normalized-ecx-p)
-      funobj)))
+      (setf (need-normalized-ecx-p function-env) need-normalized-ecx-p)
+      (setf (extended-code function-env)
+	(append arg-init-code
+		(compiler-call #'compile-form
+		  :form (make-special-funarg-shadowing function-env form)
+		  :funobj funobj
+		  :env function-env
+		  :top-level-p top-level-p
+		  :result-mode :function))))
+    funobj))
+
 
 (defun make-compiled-funobj-pass2 (toplevel-funobj-pass1)
   "This is where second pass compilation for each top-level funobj begins."