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

Modified Files: image.lisp Log Message: Change the name "constant-block" to "run-time-context" so as to be consistent. "Run-time-context" is the name that's I've been using in newer documentation and code.

Date: Wed Jul 28 03:00:33 2004 Author: ffjeld

Index: movitz/image.lisp diff -u movitz/image.lisp:1.52 movitz/image.lisp:1.53 --- movitz/image.lisp:1.52 Tue Jul 27 02:11:44 2004 +++ movitz/image.lisp Wed Jul 28 03:00:33 2004 @@ -9,14 +9,14 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.52 2004/07/27 09:11:44 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.53 2004/07/28 10:00:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

(in-package movitz)

-(define-binary-class movitz-constant-block (movitz-heap-object) - ((constant-block-start :binary-type :label) ; keep this at the top. +(define-binary-class movitz-run-time-context (movitz-heap-object) + ((run-time-context-start :binary-type :label) ; keep this at the top. (type :binary-type other-type-byte :initform :run-time-context) @@ -168,7 +168,7 @@ :initarg :null-cons) (null-sym :binary-type movitz-nil-symbol - :reader movitz-constant-block-null-symbol + :reader movitz-run-time-context-null-symbol :initarg :null-sym) ;; primitive functions global constants (dynamic-find-binding @@ -346,28 +346,28 @@ :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word :initarg :interrupt-handlers - :accessor movitz-constant-block-interrupt-handlers) + :accessor movitz-run-time-context-interrupt-handlers) (interrupt-descriptor-table :binary-type word - :accessor movitz-constant-block-interrupt-descriptor-table + :accessor movitz-run-time-context-interrupt-descriptor-table :initarg :interrupt-descriptor-table :map-binary-read-delayed 'movitz-word :map-binary-write 'map-idt-to-array) (toplevel-funobj :binary-type word :initform nil - :accessor movitz-constant-block-toplevel-funobj + :accessor movitz-run-time-context-toplevel-funobj :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word) (global-properties :binary-type word :initform nil - :accessor movitz-constant-block-global-properties + :accessor movitz-run-time-context-global-properties :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word) (copy-funobj :binary-type word - ;; :accessor movitz-constant-block-copy-funobj + ;; :accessor movitz-run-time-context-copy-funobj :initform 'muerte::copy-funobj :map-binary-write (lambda (name type) (declare (ignore type)) @@ -406,8 +406,8 @@ :initform nil :map-binary-write (lambda (x type) (declare (ignore x type)) - (- (bt:slot-offset 'movitz-constant-block 'non-pointers-end) - (bt:slot-offset 'movitz-constant-block 'non-pointers-start)))) + (- (bt:slot-offset 'movitz-run-time-context 'non-pointers-end) + (bt:slot-offset 'movitz-run-time-context 'non-pointers-start)))) (bochs-flags :binary-type lu32 :initform 0) @@ -491,7 +491,7 @@ (if (not pf-name) 0 (truncate (+ (tag :null) - (bt:slot-offset 'movitz-constant-block + (bt:slot-offset 'movitz-run-time-context (intern (symbol-name pf-name) :movitz))) 4))) @@ -507,16 +507,16 @@ (cons :data (truncate jumper 4)) registers))))

-(defmethod movitz-object-offset ((obj movitz-constant-block)) 0) +(defmethod movitz-object-offset ((obj movitz-run-time-context)) 0)

(defun global-constant-offset (slot-name) (check-type slot-name symbol)

- (slot-offset 'movitz-constant-block + (slot-offset 'movitz-run-time-context (intern (symbol-name slot-name) :movitz)))

-(defun make-movitz-constant-block () - (make-instance 'movitz-constant-block +(defun make-movitz-run-time-context () + (make-instance 'movitz-run-time-context :t-symbol (movitz-read 't) :null-cons *movitz-nil* :null-sym (movitz-nil-sym *movitz-nil*))) @@ -577,8 +577,8 @@ :accessor image-called-functions) (toplevel-funobj :accessor image-toplevel-funobj) - (constant-block - :accessor image-constant-block) + (run-time-context + :accessor image-run-time-context) (load-time-funobjs :initform () :accessor image-load-time-funobjs) @@ -622,7 +622,7 @@

(defun unbound-value () (declare (special *image*)) - (slot-value (image-constant-block *image*) + (slot-value (image-run-time-context *image*) 'unbound-value))

(defun edi-offset () @@ -707,10 +707,10 @@ (eq :u8 (movitz-vector-element-type code-vector))) (error "Not a code-vector at #x~8,'0X: ~S" address code-vector)) (format t "~&;; Code vector: #x~X" (movitz-intern code-vector)) - (loop for pf-name in (binary-record-slot-names 'movitz-constant-block + (loop for pf-name in (binary-record-slot-names 'movitz-run-time-context :match-tags :primitive-function) when (= (movitz-intern-code-vector code-vector) - (binary-slot-value (image-constant-block *image*) pf-name)) + (binary-slot-value (image-run-time-context *image*) pf-name)) do (format t "~&;; #x~X matches global primitive-function ~W with offset ~D." address pf-name (- address (movitz-intern-code-vector code-vector))) @@ -785,20 +785,20 @@ (copy-hash-table (function-code-sizes *image*)) (make-hash-table :test #'equal))))) (setf (image-nil-word *image*) - (1+ (- (slot-offset 'movitz-constant-block 'null-cons) - (slot-offset 'movitz-constant-block 'constant-block-start)))) + (1+ (- (slot-offset 'movitz-run-time-context 'null-cons) + (slot-offset 'movitz-run-time-context 'run-time-context-start)))) (format t "~&;; NIL value: #x~X.~%" (image-nil-word *image*)) (assert (eq :null (extract-tag (image-nil-word *image*))) () "NIL value #x~X has tag ~D, but it must be ~D." (image-nil-word *image*) (ldb (byte 3 0) (image-nil-word *image*)) (tag :null)) - (setf (image-constant-block *image*) (make-movitz-constant-block)) - (unless (= 0 (mod (+ (image-nil-word *image*) (slot-offset 'movitz-constant-block + (setf (image-run-time-context *image*) (make-movitz-run-time-context)) + (unless (= 0 (mod (+ (image-nil-word *image*) (slot-offset 'movitz-run-time-context 'segment-descriptor-table)) 16)) (warn "Segment descriptor table is not aligned on a 16-byte boundary.")) - (setf (movitz-constant-block-interrupt-descriptor-table (image-constant-block *image*)) + (setf (movitz-run-time-context-interrupt-descriptor-table (image-run-time-context *image*)) (movitz-read (make-initial-interrupt-descriptors))) (setf (image-t-symbol *image*) (movitz-read t)) ;; (warn "NIL value: #x~X" (image-nil-word *image*)) @@ -840,7 +840,7 @@ (setf (movitz-symbol-value (movitz-read 'muerte:*build-number*)) (1+ *bootblock-build*)) (let ((handler (movitz-env-symbol-function 'muerte::interrupt-default-handler))) - (setf (movitz-constant-block-interrupt-handlers (image-constant-block *image*)) + (setf (movitz-run-time-context-interrupt-handlers (image-run-time-context *image*)) (movitz-read (make-array 256 :initial-element handler)))) (let ((load-address (image-start-address *image*))) (setf (image-cons-pointer *image*) (- load-address @@ -852,7 +852,7 @@ :load-address 0 :load-end-address 0 :entry-address 0)) - (assert (= load-address (+ (image-intern-object *image* (image-constant-block *image*)) + (assert (= load-address (+ (image-intern-object *image* (image-run-time-context *image*)) (image-ds-segment-base *image*)))) (when multiboot-p (assert (< (+ (image-intern-object *image* (image-multiboot-header *image*)) @@ -866,7 +866,7 @@ (stable-sort (copy-list (image-load-time-funobjs *image*)) #'> :key #'third)) (let* ((toplevel-funobj (make-toplevel-funobj *image*))) (setf (image-toplevel-funobj *image*) toplevel-funobj - (movitz-constant-block-toplevel-funobj (image-constant-block *image*)) toplevel-funobj) + (movitz-run-time-context-toplevel-funobj (image-run-time-context *image*)) toplevel-funobj) (format t "~&;; load-sequence:~%~<~A~>~%" (mapcar #'second (image-load-time-funobjs *image*))) (movitz-intern toplevel-funobj) (let ((init-code-address (+ (movitz-intern-code-vector (movitz-funobj-code-vector toplevel-funobj)) @@ -884,24 +884,24 @@ function-value) #+ignore (warn "fv: ~W" (movitz-macro-expander-function function-value))))) (movitz-environment-function-cells (image-global-environment *image*))) - (let ((constant-block (image-constant-block *image*))) - ;; pull in functions in constant-block - (dolist (gcf-name (binary-record-slot-names 'movitz-constant-block :match-tags :global-function)) + (let ((run-time-context (image-run-time-context *image*))) + ;; pull in functions in run-time-context + (dolist (gcf-name (binary-record-slot-names 'movitz-run-time-context :match-tags :global-function)) (let* ((gcf-movitz-name (movitz-read (intern (symbol-name gcf-name) ':muerte))) (gcf-funobj (movitz-symbol-function-value gcf-movitz-name))) - (setf (slot-value constant-block gcf-name) 0) + (setf (slot-value run-time-context gcf-name) 0) (cond ((or (not gcf-funobj) (eq 'muerte::unbound gcf-funobj)) (warn "Global constant function ~S is not defined!" gcf-name)) (t (check-type gcf-funobj movitz-funobj) - (setf (slot-value constant-block gcf-name) + (setf (slot-value run-time-context gcf-name) gcf-funobj))))) - ;; pull in primitive functions in constant-block - (dolist (pf-name (binary-record-slot-names 'movitz-constant-block + ;; pull in primitive functions in run-time-context + (dolist (pf-name (binary-record-slot-names 'movitz-run-time-context :match-tags :primitive-function)) - (setf (slot-value constant-block pf-name) + (setf (slot-value run-time-context pf-name) (find-primitive-function (intern (symbol-name pf-name) :muerte)))) #+ignore (loop for k being the hash-keys of (movitz-environment-setf-function-names *movitz-global-environment*) @@ -924,7 +924,7 @@ do (let ((mname (movitz-read var)) (mvalue (movitz-read (symbol-value var)))) (setf (movitz-symbol-value mname) mvalue))) - (setf (movitz-constant-block-global-properties constant-block) + (setf (movitz-run-time-context-global-properties run-time-context) (movitz-read (list :packages (make-packages-hash) :setf-namespace (movitz-environment-setf-function-names *movitz-global-environment*) @@ -1188,7 +1188,7 @@ (setf (gethash lisp-package (image-read-map-hash *image*)) (movitz-read movitz-package))) lisp-to-movitz-package) - (setf (slot-value (movitz-constant-block-null-symbol (image-constant-block *image*)) + (setf (slot-value (movitz-run-time-context-null-symbol (image-run-time-context *image*)) 'package) (movitz-read (ensure-package (string :common-lisp) :muerte.common-lisp))) (loop for symbol being the hash-key of (image-oblist *image*) @@ -1204,10 +1204,10 @@ movitz-packages))))

-(defun constant-block-find-slot (offset) - "Return the name of the constant-block slot located at offset." - (dolist (slot-name (bt:binary-record-slot-names 'movitz-constant-block)) - (when (= offset (bt:slot-offset 'movitz-constant-block slot-name)) +(defun run-time-context-find-slot (offset) + "Return the name of the run-time-context slot located at offset." + (dolist (slot-name (bt:binary-record-slot-names 'movitz-run-time-context)) + (when (= offset (bt:slot-offset 'movitz-run-time-context slot-name)) (return slot-name))))

(defun comment-instruction (instruction funobj pc) @@ -1217,10 +1217,10 @@ (eq 'ia-x86::edi (ia-x86::operand-register operand)) (not (ia-x86::operand-register2 operand)) (= 1 (ia-x86::operand-scale operand)) - (constant-block-find-slot (ia-x86::operand-offset operand)) + (run-time-context-find-slot (ia-x86::operand-offset operand)) (not (typep instruction 'ia-x86-instr::lea))) collect (format nil "<Global slot ~A>" - (constant-block-find-slot (ia-x86::operand-offset operand))) + (run-time-context-find-slot (ia-x86::operand-offset operand))) when (and (typep operand 'ia-x86::operand-indirect-register) (eq 'ia-x86::edi (ia-x86::operand-register operand)) (typep instruction 'ia-x86-instr::lea) @@ -1360,8 +1360,8 @@

(defun movitz-disassemble-primitive (name &optional (*image* *image*)) (let* ((code-vector (cond - ((slot-exists-p (image-constant-block *image*) name) - (slot-value (image-constant-block *image*) name)) + ((slot-exists-p (image-run-time-context *image*) name) + (slot-value (image-run-time-context *image*) name)) (t (movitz-symbol-value (movitz-read name))))) (code (map 'vector #'identity (movitz-vector-symbolic-data code-vector))) @@ -1547,7 +1547,7 @@ (symbol expr) (array expr) (cons (mapcar #'movitz-print expr)) - ((or movitz-nil movitz-constant-block) nil) + ((or movitz-nil movitz-run-time-context) nil) (movitz-fixnum (movitz-fixnum-value expr)) (movitz-std-instance expr)