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)