[movitz-cvs] CVS update: movitz/storage-types.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Thu Jul 29 00:13:13 UTC 2004
Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv23584
Modified Files:
storage-types.lisp
Log Message:
Re-arranged many details about *movitz-nil*, movitz-null, and how it
relates to the cons and symbol binary-classes etc. This should now be
slightly less messy, and slightly more efficient.
Date: Wed Jul 28 17:13:13 2004
Author: ffjeld
Index: movitz/storage-types.lisp
diff -u movitz/storage-types.lisp:1.34 movitz/storage-types.lisp:1.35
--- movitz/storage-types.lisp:1.34 Wed Jul 28 03:00:50 2004
+++ movitz/storage-types.lisp Wed Jul 28 17:13:13 2004
@@ -9,14 +9,12 @@
;;;; Created at: Sun Oct 22 00:22:43 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: storage-types.lisp,v 1.34 2004/07/28 10:00:50 ffjeld Exp $
+;;;; $Id: storage-types.lisp,v 1.35 2004/07/29 00:13:13 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
(in-package movitz)
-(defvar *movitz-nil* nil)
-
;; (defconstant +tag-other+ 6)
(define-unsigned lu64 8 :little-endian)
@@ -276,14 +274,14 @@
(defun print-cons (ic stream)
(typecase (movitz-cdr ic)
- (movitz-nil (format stream "~A" (movitz-car ic)))
+ (movitz-null (format stream "~A" (movitz-car ic)))
(movitz-cons (format stream "~A " (movitz-car ic)))
(t (format stream "~A . ~A" (movitz-car ic) (movitz-cdr ic)))))
(defun movitz-list-length (x)
(etypecase x
(list (list-length x))
- (movitz-nil 0)
+ (movitz-null 0)
(movitz-cons
(flet ((movitz-endp (x) (eq x *movitz-nil*)))
(do ((n 0 (+ n 2)) ;Counter.
@@ -533,38 +531,38 @@
;;; Symbols
(define-binary-class movitz-symbol (movitz-heap-object)
- ((value
- :binary-type word
- :map-binary-write 'movitz-read-and-intern
- :map-binary-read-delayed 'movitz-word
- :initform 'muerte::unbound ;
- :accessor movitz-symbol-value
- :initarg value)
- (function-value
+ ((function-value
:binary-type word
:accessor movitz-symbol-function-value
:map-binary-write 'movitz-read-and-intern-function-value
:map-binary-read-delayed 'movitz-word
- :initarg function-value
- :initform 'muerte::unbound)
+ :initarg :function-value
+ :initform 'muerte::unbound-function)
+ (value
+ :binary-type word
+ :map-binary-write 'movitz-read-and-intern
+ :map-binary-read-delayed 'movitz-word
+ :initform 'muerte::unbound ;
+ :accessor movitz-symbol-value
+ :initarg :value)
(plist
:binary-type word
:accessor movitz-plist
- :map-binary-write 'movitz-intern
+ :map-binary-write 'movitz-read-and-intern
:map-binary-read-delayed 'movitz-word
- :initform *movitz-nil*
- :initarg plist)
+ :initform nil
+ :initarg :plist)
(name
:binary-type word
- :map-binary-write 'movitz-intern
+ :map-binary-write 'movitz-read-and-intern
:map-binary-read-delayed 'movitz-word
- :initarg name
+ :initarg :name
:accessor movitz-symbol-name)
(package
:binary-type word
- :map-binary-write 'movitz-intern
+ :map-binary-write 'movitz-read-and-intern
:map-binary-read-delayed 'movitz-word
- :initform *movitz-nil*
+ :initform nil
:accessor movitz-symbol-package)
(flags
:binary-type (define-bitfield movitz-symbol-flags (lu16)
@@ -573,6 +571,7 @@
:constant-variable 4
:setf-placeholder 5)))
:accessor movitz-symbol-flags
+ :initarg :flags
:initform nil)
(hash-key
:binary-lisp-type lu16
@@ -581,7 +580,7 @@
(lisp-symbol
:initform nil
:initarg :lisp-symbol))
- (:slot-align value -7))
+ (:slot-align function-value -7))
#+ignore
(defmethod write-binary-record :before ((obj movitz-symbol) stream)
@@ -604,7 +603,7 @@
(let ((name-string (image-read-intern-constant *image* (symbol-name name))))
(make-instance 'movitz-symbol
:hash-key (movitz-sxhash name-string)
- 'name name-string
+ :name name-string
:lisp-symbol name)))
(defmethod print-object ((object movitz-symbol) stream)
@@ -620,8 +619,6 @@
(defun movitz-read-and-intern-function-value (obj type)
(assert (eq type 'word))
(cond
- ((eq 'muerte::unbound obj)
- (binary-slot-value (image-run-time-context *image*) 'unbound-function))
((typep obj 'movitz-funobj)
(movitz-intern obj))
((symbolp obj)
@@ -632,90 +629,26 @@
;;; NIL
-(define-binary-class movitz-nil (movitz-heap-object)
- ((car :binary-type word
- :map-binary-read-delayed 'movitz-word
- :map-binary-write 'movitz-intern)
- (cdr :binary-type word
- :map-binary-read-delayed 'movitz-word
- :map-binary-write 'movitz-intern)
- (sym :reader movitz-nil-sym)))
-
-(defmethod movitz-object-offset ((obj movitz-nil)) (error "xxx"))
-(defmethod movitz-symbol-value ((obj movitz-nil)) obj)
-
-(defmethod update-movitz-object ((obj movitz-nil) lisp-obj)
- (declare (ignore lisp-obj))
- (values))
-
-(defmethod movitz-car ((x movitz-nil)) x)
-(defmethod movitz-cdr ((x movitz-nil)) x)
-
-(define-binary-class movitz-nil-symbol (movitz-symbol)
- ((value
- :binary-type word
- :initform nil
- :map-binary-write 'movitz-read-and-intern
- :map-binary-read-delayed 'movitz-word)
- (function-value
- :initarg function-value
- :initform 'muerte::unbound
- :binary-type word
- :map-binary-write 'movitz-read-and-intern-function-value
- :map-binary-read-delayed 'movitz-word)
- (plist
- :binary-type word
- :initform nil
- :map-binary-write 'movitz-intern
- :map-binary-read-delayed 'movitz-word)
- (name
- :binary-type word
- :map-binary-write 'movitz-intern
- :map-binary-read-delayed 'movitz-word)
- (package
- :binary-type word
- :initform *movitz-nil*
- :map-binary-write 'movitz-intern
- :map-binary-read-delayed 'movitz-word)
- (hash-key
- :binary-lisp-type lu16)
- (flags
- :binary-type movitz-symbol-flags
- :initform '(:constant-variable)))
- (:slot-align value 7))
-
-(defmethod movitz-intern ((object movitz-nil-symbol) &optional type)
- (declare (ignore type))
- (image-intern-object *image* object))
-;;;(defmethod movitz-intern ((obj movitz-nil))
-;;; (declare (special *image*))
-;;; (princ (image-nil-value *image*)))
+(define-binary-class movitz-null (movitz-symbol) ())
(defun make-movitz-nil ()
- (let ((new-nil (make-instance 'movitz-nil)))
- (setf (slot-value new-nil 'car) new-nil
- (slot-value new-nil 'cdr) new-nil)
- (let ((*movitz-nil* new-nil))
- (setf (slot-value new-nil 'sym)
- (make-instance 'movitz-nil-symbol
- 'name (make-movitz-string "NIL")
- 'value new-nil
- 'function-value 'muerte::unbound
- 'plist new-nil
- :hash-key (if (not (boundp '*image*)) 0
- (logand #xffff (incf (image-symbol-hash-key-counter *image*)))))))
- new-nil))
+ (make-instance 'movitz-null
+ :name (symbol-name nil)
+ :value nil
+ :plist nil
+ :hash-key 0
+ :flags '(:constant-variable)))
+
+(defmethod movitz-intern ((object movitz-null) &optional (type 'word))
+ (assert (eq 'word type))
+ (image-nil-word *image*))
(defun movitz-null (x)
- (eq x *movitz-nil*))
+ (typep x 'movitz-null))
(deftype movitz-list ()
- `(or movitz-cons (satisfies movitz-null)))
-
-(defmethod movitz-intern ((obj movitz-nil) &optional type)
- (declare (ignore type))
- (image-nil-word *image*))
+ `(or movitz-cons movitz-null))
;;; Compiled funobj
@@ -1046,7 +979,8 @@
(defun movitz-sxhash (object)
"Must match the SXHASH function in :cl/hash-tables."
(typecase object
- (movitz-nil 0)
+ (movitz-null
+ 0)
(movitz-symbol
(movitz-symbol-hash-key object))
(movitz-string
@@ -1134,9 +1068,9 @@
;;;
-(unless (typep *movitz-nil* 'movitz-nil)
- (warn "Creating new *MOVITZ-NIL* object!")
- (setf *movitz-nil* (make-movitz-nil)))
+;;;(unless (typep *movitz-nil* 'movitz-nil)
+;;; (warn "Creating new *MOVITZ-NIL* object!")
+;;; (setf *movitz-nil* (make-movitz-nil)))
(define-binary-class gate-descriptor ()
@@ -1218,8 +1152,8 @@
(pad :binary-lisp-type 3)
(dummy
:binary-type word
- :initform *movitz-nil*
- :map-binary-write 'movitz-intern
+ :initform nil
+ :map-binary-write 'movitz-read-and-intern
:map-binary-read-delayed 'movitz-word)
(class
:binary-type word
More information about the Movitz-cvs
mailing list