[elephant-cvs] CVS elephant/src/elephant
ieslick
ieslick at common-lisp.net
Mon Feb 5 03:18:22 UTC 2007
Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv8038/src/elephant
Modified Files:
serializer1.lisp serializer2.lisp
Log Message:
Small fix and a renaming to avoid warnings in SBCL
--- /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/05 00:40:31 1.5
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/05 03:18:22 1.6
@@ -18,7 +18,10 @@
(defpackage :elephant-serializer1
(:use :cl :elephant :elephant-memutil)
- #+(or cmu sbcl)
+ #+cmu
+ (:import-from :bignum
+ %bignum-ref)
+ #+sbcl
(:import-from :sb-bignum
%bignum-ref)
(:import-from :elephant
--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 01:01:26 1.14
+++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 03:18:22 1.15
@@ -18,12 +18,14 @@
(defpackage :elephant-serializer2
(:use :cl :elephant :elephant-memutil :elephant-utils)
- #+(or cmu sbcl)
+ #+cmu
+ (:import-from :bignum
+ %bignum-ref)
+ #+sbcl
(:import-from :sb-bignum
%bignum-ref)
(:import-from :elephant
*circularity-initial-hash-size*
- #+(or cmu sbcl allegro)
get-cached-instance
controller-symbol-cache
controller-symbol-id-cache
@@ -37,11 +39,12 @@
(in-package :elephant-serializer2)
-(eval-when (compile)
+(eval-when (:compile-toplevel)
(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0))
(inline serialize deserialize
slots-and-values
- deserialize-bignum)))
+ deserialize-bignum
+ %bignum-ref)))
(uffi:def-type foreign-char :char)
@@ -156,11 +159,11 @@
"Serialize a lisp value into a buffer-stream."
(declare (type buffer-stream bs)
(ignorable sc))
- (let ((*lisp-obj-id* -1)
- (*circularity-hash* (get-circularity-hash)))
+ (let ((lisp-obj-id -1)
+ (circularity-hash (get-circularity-hash)))
(labels
((%next-object-id ()
- (incf *lisp-obj-id*))
+ (incf lisp-obj-id))
(%serialize (frob)
(etypecase frob
(fixnum
@@ -214,12 +217,12 @@
(buffer-write-double frob bs))
(standard-object
(buffer-write-byte +object+ bs)
- (let ((idp (gethash frob *circularity-hash*)))
+ (let ((idp (gethash frob circularity-hash)))
(if idp (buffer-write-int32 idp bs)
(progn
(let ((id (%next-object-id)))
(buffer-write-int32 id bs)
- (setf (gethash frob *circularity-hash*) id))
+ (setf (gethash frob circularity-hash) id))
(%serialize (type-of frob))
(let ((svs (slots-and-values frob)))
(declare (dynamic-extent svs))
@@ -238,12 +241,12 @@
(buffer-write-uint (char-code frob) bs))
(cons
(buffer-write-byte +cons+ bs)
- (let ((idp (gethash frob *circularity-hash*)))
+ (let ((idp (gethash frob circularity-hash)))
(if idp (buffer-write-int32 idp bs)
(progn
(let ((id (%next-object-id)))
(buffer-write-int32 id bs)
- (setf (gethash frob *circularity-hash*) id))
+ (setf (gethash frob circularity-hash) id))
(%serialize (car frob))
(%serialize (cdr frob))))))
(pathname
@@ -252,12 +255,12 @@
(serialize-string pstring bs)))
(hash-table
(buffer-write-byte +hash-table+ bs)
- (let ((idp (gethash frob *circularity-hash*)))
+ (let ((idp (gethash frob circularity-hash)))
(if idp (buffer-write-int32 idp bs)
(progn
(let ((id (%next-object-id)))
(buffer-write-int32 id bs)
- (setf (gethash frob *circularity-hash*) id))
+ (setf (gethash frob circularity-hash) id))
(%serialize (hash-table-test frob))
(%serialize (hash-table-rehash-size frob))
(%serialize (hash-table-rehash-threshold frob))
@@ -269,11 +272,11 @@
(%serialize value))))))
;; (structure-object
;; (buffer-write-byte +struct+ bs)
- ;; (let ((idp (gethash frob *circularity-hash*)))
+ ;; (let ((idp (gethash frob circularity-hash)))
;; (if idp (buffer-write-int32 idp bs)
;; (progn
- ;; (buffer-write-int32 (incf *lisp-obj-id*) bs)
- ;; (setf (gethash frbo *circularity-hash*) *lisp-obj-id*)
+ ;; (buffer-write-int32 (incf lisp-obj-id) bs)
+ ;; (setf (gethash frbo circularity-hash) lisp-obj-id)
;; (%serialize (type-of frob))
;; (let ((svs (slots-and-values frob)))
;; (declare (dynamic-extent svs))
@@ -282,12 +285,12 @@
;; do (%serialize item)))))))
(array
(buffer-write-byte +array+ bs)
- (let ((idp (gethash frob *circularity-hash*)))
+ (let ((idp (gethash frob circularity-hash)))
(if idp (buffer-write-int32 idp bs)
(progn
(let ((id (%next-object-id)))
(buffer-write-int32 id bs)
- (setf (gethash frob *circularity-hash*) id))
+ (setf (gethash frob circularity-hash) id))
(buffer-write-byte
(logior (byte-from-array-type (array-element-type frob))
(if (array-has-fill-pointer-p frob)
@@ -306,7 +309,7 @@
(%serialize (row-major-aref frob i)))))))
)))
(%serialize frob)
- (release-circularity-hash *circularity-hash*)
+ (release-circularity-hash circularity-hash)
bs)))
(defun serialize-bignum (frob bs)
@@ -330,9 +333,7 @@
;; and non-cons
do
#+(or cmu sbcl allegro)
- (progn (setf (cdr byte-spec) (* 32 i))
- (%bignum-ref num i) bs)
-;; (buffer-write-uint (ldb byte-spec num) bs))
+ (buffer-write-uint (%bignum-ref num i) bs)
#+(or lispworks openmcl)
(buffer-write-uint (ldb (byte 32 (* 32 i)) num) bs)
)))
@@ -344,14 +345,14 @@
(defun deserialize (buf-str sc)
"Deserialize a lisp value from a buffer-stream."
(declare (type (or null buffer-stream) buf-str))
- (let ((*circularity-vector* (get-circularity-vector)))
+ (let ((circularity-vector (get-circularity-vector)))
(labels
((lookup-id (id)
- (if (>= id (fill-pointer *circularity-vector*)) nil
- (aref *circularity-vector* id)))
+ (if (>= id (fill-pointer circularity-vector)) nil
+ (aref circularity-vector id)))
(add-object (object)
- (vector-push-extend object *circularity-vector* 50)
- (1- (fill-pointer *circularity-vector*)))
+ (vector-push-extend object circularity-vector 50)
+ (1- (fill-pointer circularity-vector)))
(%deserialize (bs)
(declare (type buffer-stream bs))
(let ((tag (buffer-read-byte bs)))
@@ -484,7 +485,7 @@
(null (return-from deserialize nil))
(buffer-stream
(let ((result (%deserialize buf-str)))
- (release-circularity-vector *circularity-vector*)
+ (release-circularity-vector circularity-vector)
result))))))
(defun deserialize-bignum (bs length positive)
More information about the Elephant-cvs
mailing list