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

Modified Files: image.lisp Log Message: Added global-function + to constant-block.

Date: Fri Jul 9 09:12:10 2004 Author: ffjeld

Index: movitz/image.lisp diff -u movitz/image.lisp:1.43 movitz/image.lisp:1.44 --- movitz/image.lisp:1.43 Fri Jul 9 04:16:24 2004 +++ movitz/image.lisp Fri Jul 9 09:12:10 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.43 2004/07/09 11:16:24 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.44 2004/07/09 16:12:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -284,6 +284,12 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) + (+ + :initform 'muerte.cl:+ + :binary-type word + :binary-tag :global-function + :map-binary-write 'movitz-intern + :map-binary-read-delayed 'movitz-word) (complicated-class-of :binary-type word :binary-tag :global-function @@ -734,6 +740,13 @@ (check-type (cdr object) movitz-funobj) (+ (car object) (movitz-intern-code-vector (cdr object) type)))))

+(defun movitz-intern-global-function (object &optional (type 'word)) + (assert (eq type 'word)) + (check-type object symbol) + (let ((x (movitz-env-named-function object))) + (check-type x movitz-funobj) + (movitz-intern x 'word))) + (defun movitz-word-code-vector (word &optional (type 'code-vector-word)) (assert (eq type 'code-vector-word)) (movitz-word (- word +code-vector-word-offset+))) @@ -853,7 +866,7 @@ ;; pull in functions in constant-block (dolist (gcf-name (binary-record-slot-names 'movitz-constant-block :match-tags :global-function)) (let* ((gcf-movitz-name (movitz-read (intern (symbol-name gcf-name) - ':muerte))) + ':muerte))) (gcf-funobj (movitz-symbol-function-value gcf-movitz-name))) (setf (slot-value constant-block gcf-name) 0) (cond