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

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
*** empty log message ***
Date: Mon Dec 13 12:21:49 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.119 movitz/compiler.lisp:1.120
--- movitz/compiler.lisp:1.119	Fri Dec 10 13:46:30 2004
+++ movitz/compiler.lisp	Mon Dec 13 12:21:48 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.119 2004/12/10 12:46:30 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.120 2004/12/13 11:21:48 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -86,7 +86,7 @@
 
 (defvar *compiler-trust-user-type-declarations-p* t)
 
-(defvar *compiling-function-name*)
+(defvar *compiling-function-name* nil)
 (defvar muerte.cl:*compile-file-pathname* nil)
 
 (defvar *extended-code-expanders*
@@ -933,8 +933,7 @@
       (let ((ia-x86:*instruction-compute-extra-prefix-map*
 	     '((:call . compute-call-extra-prefix))))
 	(ia-x86:proglist-encode :octet-vector :32-bit #x00000000
-				(ia-x86:read-proglist (append combined-code
-							      #+ignore `((% bytes 8 0 0 0))))
+				(ia-x86:read-proglist combined-code)
 				:symtab-lookup
 				(lambda (label)
 				  (case label
@@ -951,8 +950,6 @@
 					     (* 4 pos)))))))))
     (setf (movitz-funobj-symtab funobj) code-symtab)
     (let ((code-length (- (length code-vector) 3 -3)))
-;;;      (assert (not (mismatch #(0 0 0) code-vector :start2 code-length)) ()
-;;;	"No space in code-vector was allocated for entry-points.")
       (setf (fill-pointer code-vector) code-length)
       ;; debug info
       (setf (ldb (byte 1 5) (slot-value funobj 'debug-info))
@@ -991,11 +988,15 @@
 		     (mapcar #'car rest))
 	       (vector-push 0 code-vector))))
       (setf (movitz-funobj-code-vector funobj)
-	(make-movitz-vector (length code-vector)
-			    :fill-pointer code-length
-			    :element-type 'code
-			    :initial-contents code-vector
-			    ))))
+	    (make-movitz-vector (length code-vector)
+				:fill-pointer code-length
+				:element-type 'code
+				:initial-contents code-vector)
+	    #+ignore
+	    (make-movitz-code-vector code-vector
+				     (car (slot-value funobj 'code-vector%1op))
+				     (car (slot-value funobj 'code-vector%2op))
+				     (car (slot-value funobj 'code-vector%3op))))))
   funobj)
 
 #+ignore
@@ -2809,8 +2810,7 @@
 			   (and (not (instruction-is i :init-lexvar))
 				(member binding (find-read-bindings i)
 					:test #'binding-eql)))
-			 (cdr init-pc)
-			 #-sbcl :end #-sbcl 15))
+			 (cdr init-pc)))
 	       (binding-destination (third load-instruction))
 	       (distance (position load-instruction (cdr init-pc))))
 	  (multiple-value-bind (free-registers more-later-p)
@@ -3020,8 +3020,7 @@
 					   (truncate
 					    (or (position-if (lambda (i)
 							       (member b (find-read-bindings i)))
-							     (cdr init-pc)
-							     #-sbcl :end #-sbcl 10)
+							     (cdr init-pc))
 						15)
 					    count)))))))))
 		 ;; First, make several passes while trying to locate bindings