Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6844
Modified Files: storage-types.lisp Log Message: Changed the implementation of structs a bit: Keep the length encoded as a fixnum (in 16 bits), and name them by their class metaobject rather than the symbol name.
Date: Fri Jul 23 18:30:40 2004 Author: ffjeld
Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.31 movitz/storage-types.lisp:1.32 --- movitz/storage-types.lisp:1.31 Fri Jul 23 08:34:32 2004 +++ movitz/storage-types.lisp Fri Jul 23 18:30:40 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.31 2004/07/23 15:34:32 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.32 2004/07/24 01:30:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -975,15 +975,23 @@ :initform :defstruct) (pad :binary-lisp-type 1) (length - :binary-lisp-type lu16 + :binary-type lu16 :initarg :length - :accessor movitz-struct-length) - (name + :accessor movitz-bignum-length + :map-binary-write (lambda (x &optional type) + (declare (ignore type)) + (check-type x (unsigned-byte 14)) + (* x 4)) + :map-binary-read (lambda (x &optional type) + (declare (ignore type)) + (assert (zerop (mod x 4))) + (truncate x 4))) + (class :binary-type word :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word - :reader movitz-struct-name - :initarg :name) + :reader movitz-struct-class + :initarg :class) (slot0 :binary-lisp-type :label) ; the slot values follows here. (slot-values :initform '() @@ -1017,7 +1025,7 @@
(defmethod print-object ((object movitz-struct) stream) (print-unreadable-object (object stream :type t) - (format stream "~S" (slot-value object 'name)))) + (format stream "~S" (slot-value object 'class))))
;;;
@@ -1072,7 +1080,7 @@ (svref bucket-data (1+ pos)) movitz-value))) (let* ((bucket (make-movitz-vector hash-size :initial-contents bucket-data)) (lh (make-instance 'movitz-struct - :name (movitz-read 'muerte::hash-table) + :class (muerte::movitz-find-class 'muerte::hash-table) :length 3 :slot-values (list hash-test ; test-function bucket