Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv3712
Modified Files:
storage-types.lisp
Log Message:
The layout of heap objects has been changed such that the type-code is
now the "first" byte in the object.
Date: Fri May 21 05:39:30 2004
Author: ffjeld
Index: movitz/storage-types.lisp
diff -u movitz/storage-types.lisp:1.16 movitz/storage-types.lisp:1.17
--- movitz/storage-types.lisp:1.16 Wed Apr 21 12:22:56 2004
+++ movitz/storage-types.lisp Fri May 21 05:39:30 2004
@@ -9,7 +9,7 @@
;;;; Created at: Sun Oct 22 00:22:43 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: storage-types.lisp,v 1.16 2004/04/21 16:22:56 ffjeld Exp $
+;;;; $Id: storage-types.lisp,v 1.17 2004/05/21 09:39:30 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -84,7 +84,6 @@
(defconstant +fixnum-tags+ '(:even-fixnum :odd-fixnum))
(defparameter +scan-skip-word+ #x00000003)
-
(defun tag (type)
(bt:enum-value 'other-type-byte type))
@@ -165,12 +164,14 @@
;;; Fixnums
(eval-when (:compile-toplevel :execute :load-toplevel)
-(defconstant +movitz-fixnum-bits+ 30)
-(defconstant +movitz-fixnum-shift+ (- 32 +movitz-fixnum-bits+))
-(defconstant +movitz-fixnum-factor+ (expt 2 +movitz-fixnum-shift+))
-(defconstant +movitz-fixnum-zmask+ (1- +movitz-fixnum-factor+))
-(defconstant +movitz-most-positive-fixnum+ (1- (expt 2 (1- +movitz-fixnum-bits+))))
-(defconstant +movitz-most-negative-fixnum+ (- (expt 2 (1- +movitz-fixnum-bits+)))))
+ (defconstant +movitz-fixnum-bits+ 30)
+ (defconstant +movitz-fixnum-shift+ (- 32 +movitz-fixnum-bits+))
+ (defconstant +movitz-fixnum-factor+ (expt 2 +movitz-fixnum-shift+))
+ (defconstant +movitz-fixnum-zmask+ (1- +movitz-fixnum-factor+))
+ (defconstant +movitz-most-positive-fixnum+ (1- (expt 2 (1- +movitz-fixnum-bits+))))
+ (defconstant +movitz-most-negative-fixnum+ (- (expt 2 (1- +movitz-fixnum-bits+))))
+
+ (defparameter +other-type-offset+ -6))
(defun fixnum-integer (word)
"For a Movitz word, that must be a fixnum, return the corresponding
@@ -325,24 +326,7 @@
;;; movitz-vectors
(define-binary-class movitz-vector (movitz-heap-object-other)
- ((flags
- :accessor movitz-vector-flags
- :initarg :flags
- :initform nil
- :binary-type (define-bitfield movitz-vector-flags (u8)
- (((:bits) :fill-pointer-p 2
- :code-vector-p 3
- :std-instance-slots-p 4))))
- (alignment-power
- :binary-lisp-type u8 ; align to 2^(high-nibble+3) + low-nibble
- :initform 0
- :initarg :alignment-power
- :reader movitz-vector-alignment-power)
- (num-elements
- :binary-type lu16
- :initarg :num-elements
- :reader movitz-vector-num-elements)
- (type
+ ((type
:binary-type other-type-byte
:reader movitz-vector-type
:initform :vector)
@@ -360,43 +344,60 @@
:binary-type lu16
:initarg :fill-pointer
:accessor movitz-vector-fill-pointer)
+ (flags
+ :accessor movitz-vector-flags
+ :initarg :flags
+ :initform nil
+ :binary-type (define-bitfield movitz-vector-flags (u8)
+ (((:bits) :fill-pointer-p 2
+ :code-vector-p 3
+ :std-instance-slots-p 4))))
+ (alignment-power
+ :binary-lisp-type u8 ; align to 2^(high-nibble+3) + low-nibble
+ :initform 0
+ :initarg :alignment-power
+ :reader movitz-vector-alignment-power)
+ (num-elements
+ :binary-type lu16
+ :initarg :num-elements
+ :reader movitz-vector-num-elements)
(data
:binary-lisp-type :label) ; data follows physically here
(symbolic-data
:initarg :symbolic-data
:accessor movitz-vector-symbolic-data))
- (:slot-align type -2))
+ (:slot-align type #.+other-type-offset+))
(defun vector-type-tag (element-type)
(dpb (enum-value 'movitz-vector-element-type element-type)
(byte 8 8)
(enum-value 'other-type-byte :vector)))
-(define-binary-class movitz-new-vector (movitz-heap-object-other)
- ((length
- :binary-type u32
- :initarg :length
- :accessor movitz-simple-vector-length)
- (type
- :binary-type other-type-byte
- :reader movitz-vector-type)
- #+ignore
- (element-type
- :binary-type (define-enum movitz-vector-element-type (u8)
- :any-t 0
- :character 1
- :u8 2
- :u16 3
- :u32 4
- :bit 5)
- :initarg :element-type
- :reader movitz-vector-element-type)
- (data
- :binary-lisp-type :label)
- (symbolic-data
- :initarg :symbolic-data
- :accessor movitz-vector-symbolic-data))
- (:slot-align type -2))
+;;;(define-binary-class movitz-new-vector (movitz-heap-object-other)
+;;; ((length
+;;; :binary-type u32
+;;; :initarg :length
+;;; :accessor movitz-simple-vector-length)
+;;; (type
+;;; :binary-type other-type-byte
+;;; :reader movitz-vector-type)
+;;; #+ignore
+;;; (element-type
+;;; :binary-type (define-enum movitz-vector-element-type (u8)
+;;; :any-t 0
+;;; :character 1
+;;; :u8 2
+;;; :u16 3
+;;; :u32 4
+;;; :bit 5)
+;;; :initarg :element-type
+;;; :reader movitz-vector-element-type)
+;;; (data
+;;; :binary-lisp-type :label)
+;;; (symbolic-data
+;;; :initarg :symbolic-data
+;;; :accessor movitz-vector-symbolic-data))
+;;; (:slot-align type #.+other-type-offset+))
(defun movitz-type-word-size (type)
(truncate (sizeof (intern (symbol-name type) :movitz)) 4))
@@ -745,14 +746,7 @@
;;; Compiled funobj
(define-binary-class movitz-funobj (movitz-heap-object-other)
- ((code-vector
- :binary-type code-vector-word
- :initform 'muerte::no-code-vector
- :initarg :code-vector
- :map-binary-write 'movitz-intern-code-vector
- :map-binary-read-delayed 'movitz-word-code-vector
- :accessor movitz-funobj-code-vector)
- (type
+ ((type
:binary-type other-type-byte
:initform :funobj)
(funobj-type
@@ -767,6 +761,13 @@
;; Bit 5: The code-vector's uses-stack-frame-p.
:binary-type 'lu16
:initform 0)
+ (code-vector
+ :binary-type code-vector-word
+ :initform 'muerte::no-code-vector
+ :initarg :code-vector
+ :map-binary-write 'movitz-intern-code-vector
+ :map-binary-read-delayed 'movitz-word-code-vector
+ :accessor movitz-funobj-code-vector)
(code-vector%1op
:binary-type code-pointer
:initform 'muerte::trampoline-funcall%1op
@@ -858,7 +859,7 @@
:initform :default
:initarg :entry-protocol
:reader funobj-entry-protocol))
- (:slot-align type -2))
+ (:slot-align type #.+other-type-offset+))
(defmethod write-binary-record ((obj movitz-funobj) stream)
(declare (special *record-all-funobjs*))
@@ -908,12 +909,7 @@
(define-binary-class movitz-funobj-standard-gf (movitz-funobj)
;; This class is binary congruent with movitz-funobj.
- ((code-vector
- :binary-type code-vector-word
- :initform 'muerte::standard-gf-dispatcher
- :map-binary-write 'movitz-intern-code-vector
- :map-binary-read-delayed 'movitz-word-code-vector)
- (type
+ ((type
:binary-type other-type-byte)
(funobj-type
:binary-type movitz-funobj-type
@@ -922,6 +918,11 @@
;; Bits 0-4: The value of the start-stack-frame-setup label.
:binary-type 'lu16
:initform 0)
+ (code-vector
+ :binary-type code-vector-word
+ :initform 'muerte::standard-gf-dispatcher
+ :map-binary-write 'movitz-intern-code-vector
+ :map-binary-read-delayed 'movitz-word-code-vector)
(code-vector%1op
:initform 'muerte::standard-gf-dispatcher%1op
:binary-type code-pointer
@@ -993,18 +994,11 @@
:map-binary-read-delayed 'movitz-word)
(plist
:initform nil))
- (:slot-align type -2))
+ (:slot-align type #.+other-type-offset+))
(defmethod movitz-funobj-const-list ((funobj movitz-funobj-standard-gf))
nil)
-#+ignore
-(defun make-movitz-funobj (lambda-list &key (name ""))
- (check-type name (or symbol cons))
- (make-instance 'movitz-funobj
- :lambda-list lambda-list
- :name name))
-
(defun make-standard-gf (class slots &key lambda-list (name "unnamed")
(function 'muerte::unbound)
num-required-arguments
@@ -1020,51 +1014,27 @@
;;;
-#+ignore
-(define-binary-class movitz-bignum (movitz-heap-object-other)
- ((low32
- :binary-lisp-type u32
- :map-binary-write 'movitz-intern
- :map-binary-read-delayed 'movitz-word
- :initarg :name)
- (type
- :binary-lisp-type other-type-byte
- :initform :bignum)
+(define-binary-class movitz-struct (movitz-heap-object-other)
+ ((type
+ :binary-type other-type-byte
+ :initform :defstruct)
(pad :binary-lisp-type 1)
(length
:binary-lisp-type lu16
:initarg :length
- :accessor movitz-bignum-length)
- (slot0 :binary-lisp-type :label) ; the slot values follows here.
- (slot-values
- :initform '()
- :initarg :slot-values
- :accessor movitz-struct-slot-values))
- (:slot-align type -2))
-
-;;;
-
-(define-binary-class movitz-struct (movitz-heap-object-other)
- ((name
+ :accessor movitz-struct-length)
+ (name
:binary-type word
:map-binary-write 'movitz-intern
:map-binary-read-delayed 'movitz-word
:reader movitz-struct-name
:initarg :name)
- (type
- :binary-type other-type-byte
- :initform :defstruct)
- (pad :binary-lisp-type 1)
- (length
- :binary-lisp-type lu16
- :initarg :length
- :accessor movitz-struct-length)
(slot0 :binary-lisp-type :label) ; the slot values follows here.
(slot-values
:initform '()
:initarg :slot-values
:accessor movitz-struct-slot-values))
- (:slot-align type -2))
+ (:slot-align type #.+other-type-offset+))
(defmethod update-movitz-object ((movitz-struct movitz-struct) lisp-struct)
(declare (ignore lisp-struct))
@@ -1271,15 +1241,15 @@
;;; std-instance
(define-binary-class movitz-std-instance (movitz-heap-object-other)
- ((dummy
+ ((type
+ :binary-type other-type-byte
+ :initform :std-instance)
+ (pad :binary-lisp-type 3)
+ (dummy
:binary-type word
:initform *movitz-nil*
:map-binary-write 'movitz-intern
:map-binary-read-delayed 'movitz-word)
- (type
- :binary-type other-type-byte
- :initform :std-instance)
- (pad :binary-lisp-type 3)
(class
:binary-type word
:map-binary-write 'movitz-intern
@@ -1292,7 +1262,7 @@
:map-binary-read-delayed 'movitz-word
:initarg :slots
:accessor movitz-std-instance-slots))
- (:slot-align type -2))
+ (:slot-align type #.+other-type-offset+))
;; (defmethod movitz-object-offset ((obj movitz-std-instance)) (- #x1e))
