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

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Add a check for whether (middle-of) code-vectors can look like
code-vector headers.

Date: Tue Dec 21 15:23:50 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.122 movitz/compiler.lisp:1.123
--- movitz/compiler.lisp:1.122	Wed Dec 15 14:58:04 2004
+++ movitz/compiler.lisp	Tue Dec 21 15:23:49 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.122 2004/12/15 13:58:04 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.123 2004/12/21 14:23:49 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -987,6 +987,7 @@
 	      ((some (lambda (label) (assoc label code-symtab))
 		     (mapcar #'car rest))
 	       (vector-push 0 code-vector))))
+      (check-locate-concistency code-vector)
       (setf (movitz-funobj-code-vector funobj)
 	    (make-movitz-vector (length code-vector)
 				:fill-pointer code-length
@@ -998,6 +999,13 @@
 				     (slot-value funobj 'code-vector%2op)
 				     (slot-value funobj 'code-vector%3op)))))
   funobj)
+
+(defun check-locate-concistency (code-vector)
+  (loop for x from 0 below (length code-vector) by 8
+      do (when (and (= (tag :basic-vector) (aref code-vector x))
+		    (= (enum-value 'movitz-vector-element-type :code) (aref code-vector (1+ x))))
+	   (break "Code-vector can break %find-code-vector at offset ~D." x)))
+  (values))
 
 #+ignore
 (defun make-compiled-function-body-default (form funobj env top-level-p)