[movitz-cvs] CVS update: movitz/storage-types.lisp

[Frode Vatvedt Fjeld]

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