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

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Use copy-funobj-code-vector-slots to initialize stack-allocated funobjs.

Date: Mon Jan 10 09:18:49 2005
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.127 movitz/compiler.lisp:1.128
--- movitz/compiler.lisp:1.127	Tue Jan  4 21:21:11 2005
+++ movitz/compiler.lisp	Mon Jan 10 09:18:49 2005
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.127 2005/01/04 20:21:11 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.128 2005/01/10 08:18:49 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -84,6 +84,10 @@
 (defvar *compiler-produce-defensive-code* t
   "Try to make code be extra cautious.")
 
+(defvar *compiler-relink-recursive-funcall* t
+  "If true, also recursive function calls look up the function through the function name,
+which enables tracing of recursive functions.")
+
 (defvar *compiler-trust-user-type-declarations-p* t)
 
 (defvar *compiling-function-name* nil)
@@ -5409,8 +5413,9 @@
 	  :functional-p nil
 	  :modifies arguments-modifies
 	  :code (append arguments-code
-			(if (eq (movitz-read operator)
-				(movitz-read (movitz-funobj-name funobj))) ; recursive?
+			(if (and (not *compiler-relink-recursive-funcall*)
+				 (eq (movitz-read operator)
+				     (movitz-read (movitz-funobj-name funobj)))) ; recursive?
 			    (make-compiled-funcall-by-esi (length arg-forms))
 			  (make-compiled-funcall-by-symbol operator (length arg-forms) funobj))
 			stack-restore-code))))))
@@ -6908,22 +6913,21 @@
 				   collect `(:pushl (:eax ,(slot-offset 'movitz-funobj 'constant0)
 							  ,(* 4 i))))
 			       (loop repeat (movitz-funobj-num-jumpers object)
-				   do (error "Can't handle jumpers.")
 				   collect `(:pushl 0))
 			       `((:pushl (:eax ,(slot-offset 'movitz-funobj 'num-jumpers)))
 				 (:pushl (:eax ,(slot-offset 'movitz-funobj 'name)))
 				 (:pushl (:eax ,(slot-offset 'movitz-funobj 'lambda-list)))
 				 
-;;;				 (:pushl 0) ; %3op
-;;;				 (:pushl 0) ; %2op
-;;;				 (:pushl 0) ; %1op
-;;;				 (:pushl 0) ; (default)
-				 (:pushl (:eax ,(slot-offset 'movitz-funobj 'code-vector%3op)))
-				 (:pushl (:eax ,(slot-offset 'movitz-funobj 'code-vector%2op)))
-				 (:pushl (:eax ,(slot-offset 'movitz-funobj 'code-vector%1op)))
-				 (:pushl (:eax ,(slot-offset 'movitz-funobj 'code-vector)))
+				 (:pushl 0) ; %3op
+				 (:pushl 0) ; %2op
+				 (:pushl 0) ; %1op
+				 (:pushl 0) ; (default)
 				 
-				 (:pushl (:eax ,(slot-offset 'movitz-funobj 'type))))))))))))
+				 (:pushl (:eax ,(slot-offset 'movitz-funobj 'type)))
+				 (:leal (:esp ,(tag :other)) :ebx)
+				 (,*compiler-local-segment-prefix*
+				  :call (:edi ,(global-constant-offset 'copy-funobj-code-vector-slots)))
+				 )))))))))
 
 ;;;(define-extended-code-expander :exit-dynamic-scope (instruction funobj frame-map)
 ;;;  nil)