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

Modified Files: image.lisp Log Message: Re-arranged the run-time-context structure somewhat so as to keep non-pointer slots in one place, and mark the out as such.

Date: Mon Jul 12 19:24:36 2004 Author: ffjeld

Index: movitz/image.lisp diff -u movitz/image.lisp:1.44 movitz/image.lisp:1.45 --- movitz/image.lisp:1.44 Fri Jul 9 09:12:10 2004 +++ movitz/image.lisp Mon Jul 12 19:24:36 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.44 2004/07/09 16:12:10 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.45 2004/07/13 02:24:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -296,7 +296,7 @@ :map-binary-read-delayed 'movitz-word :map-binary-write 'movitz-intern) (num-values - :binary-type lu32 + :binary-type word ; Fixnum :initform 0) (values :binary-type #.(* 4 +movitz-multiple-values-limit+)) @@ -393,6 +393,14 @@ :initform nil :map-binary-write 'movitz-read-and-intern :map-binary-read-delayed 'movitz-word) + (protect-non-pointer-area + :binary-type lu32 + :initform 3) + (protect-non-pointer-count + :binary-type lu32 + :initform (* 4 (- (bt:slot-offset 'movitz-constant-block 'non-pointers-end) + (bt:slot-offset 'movitz-constant-block 'non-pointers-start)))) + (non-pointers-start :binary-type :label) ; ========= NON-POINTER-START ======= ;; (align-segment-descriptors :binary-type 4) (segment-descriptor-table :binary-type :label) (segment-descriptor-0 @@ -430,6 +438,15 @@ (segment-descriptor-7 :binary-type segment-descriptor :initform (make-segment-descriptor)) + (bochs-flags + :binary-type lu32 + :initform 0) + (scratch0 ; A non-GC-root scratch register + :binary-type lu32 + :initform 0) + + (non-pointers-end :binary-type :label) ; ========= NON-POINTER-END ======= + (atomically-status :binary-type (define-bitfield atomically-status (lu32) (((:enum :byte (3 2)) @@ -455,13 +472,7 @@ :initform nil :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) - (bochs-flags - :binary-type lu32 - :initform 0) - (scratch0 ; A non-GC-root scratch register - :binary-type lu32 - :initform 0)) + :binary-tag :primitive-function)) (:slot-align null-cons -1))

(defun atomically-status-simple-pf (pf-name reset-status-p &rest registers)