From sross at common-lisp.net  Mon Dec 11 21:44:03 2006
From: sross at common-lisp.net (sross)
Date: Mon, 11 Dec 2006 16:44:03 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store
Message-ID: <20061211214403.2111A2201B@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store
In directory clnet:/tmp/cvs-serv9039

Modified Files:
	.cvsignore ChangeLog cl-store.asd default-backend.lisp 
	tests.lisp utils.lisp 
Log Message:
Changelog 2006-12-11 and 2006-10-01



--- /project/cl-store/cvsroot/cl-store/.cvsignore	2004/12/02 10:31:54	1.3
+++ /project/cl-store/cvsroot/cl-store/.cvsignore	2006/12/11 21:44:02	1.4
@@ -6,3 +6,6 @@
 *.lib
 clean.sh
 wc.sh
+*.fsl
+*.ofasl
+*.ufasl
--- /project/cl-store/cvsroot/cl-store/ChangeLog	2006/08/03 19:42:09	1.41
+++ /project/cl-store/cvsroot/cl-store/ChangeLog	2006/12/11 21:44:02	1.42
@@ -1,5 +1,13 @@
+2006-12-11 Sean Ross <sross at common-lisp.net>
+	* lispworks/custom.lisp: Began work on new special float creation.
+	* .cvsignore : Update ignorable files
+
+2006-10-01 Sean Ross <sross at common-lisp.net>
+	* utils.lisp: Fix mkstr to upcase args.
+
 2006-08-03 Sean Ross <sross at common-lisp.net>
 	* lispworks/custom.lisp: Fix float handling for Lispworks 5.0 .
+	* utils.lisp: changed references to compute-slots to class-slots.
 	* package.lisp: Removed symbols from export list that are no 
 	longer used.
 
--- /project/cl-store/cvsroot/cl-store/cl-store.asd	2006/08/03 19:42:09	1.38
+++ /project/cl-store/cvsroot/cl-store/cl-store.asd	2006/12/11 21:44:02	1.39
@@ -45,8 +45,7 @@
   :name "CL-STORE"
   :author "Sean Ross <sross at common-lisp.net>"
   :maintainer "Sean Ross <sross at common-lisp.net>"
-  :version "0.6.10"
-  :compatible-with "0.6.2<=?<0.6.10"
+  :version "0.7.3"
   :description "Serialization package"
   :long-description "Portable CL Package to serialize data"
   :licence "MIT"
--- /project/cl-store/cvsroot/cl-store/default-backend.lisp	2006/08/03 19:42:09	1.35
+++ /project/cl-store/cvsroot/cl-store/default-backend.lisp	2006/12/11 21:44:02	1.36
@@ -200,6 +200,7 @@
         (store-object exponent stream)
         (store-object sign stream)))))
 
+
 (defrestore-cl-store (float stream)
   (float (* (the float (get-float-type (read-byte stream)))
             (* (the integer (restore-object stream))
@@ -503,6 +504,7 @@
     (simple-vector (store-simple-vector obj stream))
     (t (store-array obj stream))))
 
+
 (defun store-array (obj stream)
   (declare (optimize speed (safety 0) (debug 0))
            (type array obj))
@@ -543,7 +545,7 @@
               (setting (row-major-aref obj pos) (restore-object stream)))))))
 
 (defun store-simple-vector (obj stream)
-  (declare (optimize speed (safety 1) (debug 0))
+  (declare (optimize speed (safety 0) (debug 0))
            (type simple-vector obj))
   (output-type-code +simple-vector-code+ stream)
   (store-object (length obj) stream)
--- /project/cl-store/cvsroot/cl-store/tests.lisp	2006/08/03 19:42:09	1.27
+++ /project/cl-store/cvsroot/cl-store/tests.lisp	2006/12/11 21:44:02	1.28
@@ -45,6 +45,8 @@
 (deftestit complex.5 #C(-111 -1123))
 (deftestit complex.6 #C(-11.2 -34.5))
 
+;; short floats
+
 
 ;; single-float
 (deftestit single-float.1 3244.32)
@@ -61,6 +63,8 @@
 (deftestit double-float.5 most-positive-double-float)
 (deftestit double-float.6 most-negative-double-float)
 
+;; long floats
+
 ;; infinite floats
 #+(or sbcl cmu lispworks allegro)
 (progn 
@@ -184,7 +188,7 @@
 (deftestit cons.4  '(1 . 2))
 (deftestit cons.5  '(t . nil))
 (deftestit cons.6 '(1 2 3 . 5))
-(deftest cons.7 (let ((list (cons nil nil))) ;  '#1=(#1#)))
+(deftest cons.7 (let ((list (cons nil nil)))
                   (setf (car list) list)
                   (store list *test-file*)
                   (let ((ret (restore *test-file*)))
--- /project/cl-store/cvsroot/cl-store/utils.lisp	2006/08/03 19:42:09	1.22
+++ /project/cl-store/cvsroot/cl-store/utils.lisp	2006/12/11 21:44:02	1.23
@@ -139,7 +139,7 @@
 (defun mkstr (&rest args)
   (with-output-to-string (s)
     (dolist (x args)
-      (princ x s))))
+      (format s "~@:(~A~)" x))))
 
 (defun symbolicate (&rest syms)
   "Concatenate all symbol names into one big symbol"
@@ -150,7 +150,7 @@
 (defun safe-length (list)
   "Similar to `list-length', but avoid errors on improper lists.
 Return two values: the length of the list and the last cdr.
-Modified to work on circular lists."
+Modified to work on non proper lists."
   (do ((n 0 (+ n 2))                    ;Counter.
        (fast list (cddr fast))          ;Fast pointer: leaps by 2.
        (slow list (cdr slow)))          ;Slow pointer: leaps by 1.



From sross at common-lisp.net  Mon Dec 11 21:44:03 2006
From: sross at common-lisp.net (sross)
Date: Mon, 11 Dec 2006 16:44:03 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store/lispworks
Message-ID: <20061211214403.06AB825002@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store/lispworks
In directory clnet:/tmp/cvs-serv9039/lispworks

Modified Files:
	.cvsignore custom.lisp 
Log Message:
Changelog 2006-12-11 and 2006-10-01



--- /project/cl-store/cvsroot/cl-store/lispworks/.cvsignore	2004/10/06 14:41:40	1.1
+++ /project/cl-store/cvsroot/cl-store/lispworks/.cvsignore	2006/12/11 21:44:03	1.2
@@ -1 +1,11 @@
+*.fasl
+*.x86f
 *.ufsl
+filetest.cls
+*.fas
+*.lib
+clean.sh
+wc.sh
+*.fsl
+*.ofasl
+*.ufasl
--- /project/cl-store/cvsroot/cl-store/lispworks/custom.lisp	2006/08/03 19:42:09	1.7
+++ /project/cl-store/cvsroot/cl-store/lispworks/custom.lisp	2006/12/11 21:44:03	1.8
@@ -4,29 +4,19 @@
 (in-package :cl-store)
 
 ;; Setup special floats
-(defvar +single-positive-infinity+ most-positive-single-float)
-(defvar +single-negative-infinity+ most-negative-single-float)
-(defvar +single-nan+)
-
-(defvar +double-positive-infinity+ most-positive-double-float)
-(defvar +double-negative-infinity+ most-negative-double-float)
-(defvar +double-nan+)
-
-(setf +single-positive-infinity+ (expt +single-positive-infinity+ 2))
-(setf +single-negative-infinity+ (expt +single-negative-infinity+ 3))
-(setf +single-nan+ (/ +single-negative-infinity+ +single-negative-infinity+))
-(setf +double-positive-infinity+ (expt +double-positive-infinity+ 2))
-(setf +double-negative-infinity+ (expt +double-negative-infinity+ 3))
-(setf +double-nan+ (/ +double-negative-infinity+ +double-negative-infinity+))
-
-(setf *special-floats*
-      (list (cons +double-positive-infinity+ +positive-double-infinity-code+)
-            (cons +single-positive-infinity+ +positive-infinity-code+)
-            
-            (cons +single-negative-infinity+ +negative-infinity-code+)
-            (cons +double-negative-infinity+ +negative-double-infinity-code+)
-            (cons +single-nan+ +float-nan-code+)
-            (cons +double-nan+ +float-double-nan-code+)))
+(defun create-float-values (value &rest codes)
+  (let ((neg-inf (expt value 3)))
+    (mapcar 'cons
+            (list (expt (abs value) 2)
+                  neg-inf
+                  (/ neg-inf neg-inf))
+            codes)))
+
+(defparameter *special-floats*
+  (nconc (create-float-values most-negative-single-float +positive-infinity-code+
+                              +negative-infinity-code+ +float-nan-code+)
+         (create-float-values most-negative-double-float +positive-double-infinity-code+
+                              +negative-double-infinity-code+ +float-double-nan-code+)))
 
 ;; Custom structure storing from Alain Picard.
 (defstore-cl-store (obj structure-object stream)



From sross at common-lisp.net  Thu Dec 14 18:15:41 2006
From: sross at common-lisp.net (sross)
Date: Thu, 14 Dec 2006 13:15:41 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store
Message-ID: <20061214181541.9E13B48000@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store
In directory clnet:/tmp/cvs-serv7536

Modified Files:
	ChangeLog backends.lisp cl-store.asd default-backend.lisp 
	tests.lisp utils.lisp 
Log Message:
Changelog 2006-12-13




--- /project/cl-store/cvsroot/cl-store/ChangeLog	2006/12/11 21:44:02	1.42
+++ /project/cl-store/cvsroot/cl-store/ChangeLog	2006/12/14 18:15:41	1.43
@@ -1,3 +1,10 @@
+2006-12-13 Sean Ross <sross at common-lisp.net>
+	* utils.lisp, acl/custom.lisp, cmucl/custom.lisp, lispworks/custom.lisp
+	sbcl/custom/lisp, default-backend.lisp, cl-store.asd: 
+	Committed handling for serialization of float types short, single, double and
+	long and handling of positive infinity, negative infinity and NaN for all
+	float types (this is still only for sbcl, cmucl, acl, and lispworks).
+
 2006-12-11 Sean Ross <sross at common-lisp.net>
 	* lispworks/custom.lisp: Began work on new special float creation.
 	* .cvsignore : Update ignorable files
--- /project/cl-store/cvsroot/cl-store/backends.lisp	2005/11/30 09:49:56	1.13
+++ /project/cl-store/cvsroot/cl-store/backends.lisp	2006/12/14 18:15:41	1.14
@@ -111,7 +111,6 @@
         (push (cons name instance) *registered-backends*))
     instance))
 
-
 (defun get-class-form (name fields extends)
   `(defclass ,name ,extends
     ,fields
--- /project/cl-store/cvsroot/cl-store/cl-store.asd	2006/12/11 21:44:02	1.39
+++ /project/cl-store/cvsroot/cl-store/cl-store.asd	2006/12/14 18:15:41	1.40
@@ -45,7 +45,7 @@
   :name "CL-STORE"
   :author "Sean Ross <sross at common-lisp.net>"
   :maintainer "Sean Ross <sross at common-lisp.net>"
-  :version "0.7.3"
+  :version "0.7.5"
   :description "Serialization package"
   :long-description "Portable CL Package to serialize data"
   :licence "MIT"
@@ -61,6 +61,7 @@
                (:non-required-file "custom")))
 
 (defmethod perform :after ((o load-op) (c (eql (find-system :cl-store))))
+  (funcall (find-symbol "SETUP-SPECIAL-FLOATS" :cl-store))
   (provide 'cl-store))
 
 (defmethod perform ((op test-op) (sys (eql (find-system :cl-store))))
--- /project/cl-store/cvsroot/cl-store/default-backend.lisp	2006/12/11 21:44:02	1.36
+++ /project/cl-store/cvsroot/cl-store/default-backend.lisp	2006/12/14 18:15:41	1.37
@@ -4,17 +4,16 @@
 ;; The cl-store backend. 
 (in-package :cl-store)
 
-(defbackend cl-store :magic-number 1416850499
+(defbackend cl-store :magic-number 1395477571
             :stream-type '(unsigned-byte 8)
             :old-magic-numbers (1912923 1886611788 1347635532 1886611820 1414745155
-                                1349740876 1884506444 1347643724 1349732684 1953713219)
+                                1349740876 1884506444 1347643724 1349732684 1953713219
+                                1416850499)
             :extends (resolving-backend)
             :fields ((restorers :accessor restorers 
                                 :initform (make-hash-table :size 100))))
 
-
-
-(defun register-code (code name &optional (errorp t))
+(defun register-code (code name &optional (errorp nil))
   (aif (and (gethash code (restorers (find-backend 'cl-store))) errorp)
        (error "Code ~A is already defined for ~A." code name)
        (setf (gethash code (restorers (find-backend 'cl-store)))
@@ -23,35 +22,31 @@
 
 
 ;;  Type code constants
-(defvar +referrer-code+ (register-code 1 'referrer nil))
-(defvar +unicode-string-code+ (register-code 3 'unicode-string nil))
-(defvar +integer-code+ (register-code 4 'integer nil))
-(defvar +simple-string-code+ (register-code 5 'simple-string nil))
-(defvar +float-code+ (register-code 6 'float nil))
-(defvar +ratio-code+ (register-code 7 'ratio nil))
-(defvar +character-code+ (register-code 8 'character nil))
-(defvar +complex-code+ (register-code 9 'complex nil))
-(defvar +symbol-code+ (register-code 10 'symbol nil))
-(defvar +cons-code+ (register-code 11 'cons nil))
-(defvar +pathname-code+ (register-code 12 'pathname nil))
-(defvar +hash-table-code+ (register-code 13 'hash-table nil))
-(defvar +standard-object-code+ (register-code 14 'standard-object nil))
-(defvar +condition-code+ (register-code 15 'condition nil))
-(defvar +structure-object-code+ (register-code 16 'structure-object nil))
-(defvar +standard-class-code+ (register-code 17 'standard-class nil))
-(defvar +built-in-class-code+ (register-code 18 'built-in-class nil))
-(defvar +array-code+ (register-code 19 'array nil))
-(defvar +simple-vector-code+ (register-code 20 'simple-vector nil))
-(defvar +package-code+ (register-code 21 'package nil))
-
-(defvar +positive-infinity-code+ (register-code 22 'positive-infinity nil))
-(defvar +negative-infinity-code+ (register-code 23 'negative-infinity nil))
+(defvar +referrer-code+ (register-code 1 'referrer))
+(defvar +special-float-code+ (register-code 2 'special-float))
+(defvar +unicode-string-code+ (register-code 3 'unicode-string))
+(defvar +integer-code+ (register-code 4 'integer))
+(defvar +simple-string-code+ (register-code 5 'simple-string))
+(defvar +float-code+ (register-code 6 'float))
+(defvar +ratio-code+ (register-code 7 'ratio))
+(defvar +character-code+ (register-code 8 'character))
+(defvar +complex-code+ (register-code 9 'complex))
+(defvar +symbol-code+ (register-code 10 'symbol))
+(defvar +cons-code+ (register-code 11 'cons))
+(defvar +pathname-code+ (register-code 12 'pathname))
+(defvar +hash-table-code+ (register-code 13 'hash-table))
+(defvar +standard-object-code+ (register-code 14 'standard-object))
+(defvar +condition-code+ (register-code 15 'condition))
+(defvar +structure-object-code+ (register-code 16 'structure-object))
+(defvar +standard-class-code+ (register-code 17 'standard-class))
+(defvar +built-in-class-code+ (register-code 18 'built-in-class))
+(defvar +array-code+ (register-code 19 'array))
+(defvar +simple-vector-code+ (register-code 20 'simple-vector))
+(defvar +package-code+ (register-code 21 'package))
 
-;; new storing for 32 bit ints
+;; fast storing for 32 bit ints
 (defvar +32-bit-integer-code+ (register-code 24 '32-bit-integer nil))
 
-(defvar +float-nan-code+ (register-code 25 'nan-float nil))
-
 (defvar +function-code+ (register-code 26 'function nil))
 (defvar +gf-code+ (register-code 27 'generic-function nil))
 
@@ -61,13 +56,9 @@
 
 (defvar +gensym-code+ (register-code 30 'gensym nil))
 
-(defvar +positive-double-infinity-code+ (register-code 31 'positive-double-infinity nil))
-(defvar +negative-double-infinity-code+ (register-code 32 'negative-double-infinity nil))
-(defvar +float-double-nan-code+ (register-code 33 'float-double-nan nil))
 (defvar +unicode-base-string-code+ (register-code 34 'unicode-base-string nil))
 (defvar +simple-base-string-code+ (register-code 35 'simple-base-string nil))
 
-
 ;; setups for type code mapping
 (defun output-type-code (code stream)
   (declare (type ub32 code))
@@ -81,7 +72,7 @@
   (declare (optimize speed (safety 0) (space 0) (debug 0)))
   (eql reader 'referrer))
 
-(defvar *restorers* (restorers (find-backend 'cl-store)))
+(defparameter *restorers* (restorers (find-backend 'cl-store)))
 
 ;; get-next-reader needs to return a symbol which will be used by the
 ;; backend to lookup the function that was defined by
@@ -118,8 +109,6 @@
       (eql type 'integer)
       (eql type 'character)))
 
-;  (find type '(integer character 32-bit-integer)))
-
 (defstore-cl-store (obj integer stream)
   (declare (optimize speed (safety 1) (debug 0)))
   (if (typep obj 'sb32)
@@ -179,8 +168,42 @@
         result)))
 
 ;; Floats (*special-floats* are setup in the custom.lisp files)
+
+(defconstant +short-float-inf+ 0)
+(defconstant +short-float-neg-inf+ 1)
+(defconstant +short-float-nan+ 2)
+
+(defconstant +single-float-inf+ 3)
+(defconstant +single-float-neg-inf+ 4)
+(defconstant +single-float-nan+ 5)
+
+(defconstant +double-float-inf+ 6)
+(defconstant +double-float-neg-inf+ 7)
+(defconstant +double-float-nan+ 8)
+
+(defconstant +long-float-inf+ 9)
+(defconstant +long-float-neg-inf+ 10)
+(defconstant +long-float-nan+ 11)
+
 (defvar *special-floats* nil)
 
+;; Implementations are to provide an implementation for the create-float-value
+;; function
+(defun create-float-values (value &rest codes)
+  "Returns a alist of special float to float code mappings."
+  nil)
+
+(defun setup-special-floats ()
+  (setf *special-floats*
+        (nconc (create-float-values most-negative-short-float +short-float-inf+
+                                    +short-float-neg-inf+ +short-float-nan+)
+               (create-float-values most-negative-single-float +single-float-inf+
+                                    +single-float-neg-inf+ +single-float-nan+)
+               (create-float-values most-negative-double-float +double-float-inf+
+                                    +double-float-neg-inf+ +double-float-nan+)
+               (create-float-values most-negative-long-float +long-float-inf+
+                                    +long-float-neg-inf+ +long-float-nan+))))
+
 (defstore-cl-store (obj float stream)
   (declare (optimize speed))
   (block body
@@ -189,7 +212,8 @@
                       #'(lambda (err)
                           (declare (ignore err))
                           (when-let (type (cdr (assoc obj *special-floats*)))
-                            (output-type-code type stream)
+                            (output-type-code +special-float-code+ stream)
+                            (write-byte type stream)
                             (return-from body)))))
         (multiple-value-setq (significand exponent sign)
           (integer-decode-float obj))
@@ -200,7 +224,6 @@
         (store-object exponent stream)
         (store-object sign stream)))))
 
-
 (defrestore-cl-store (float stream)
   (float (* (the float (get-float-type (read-byte stream)))
             (* (the integer (restore-object stream))
@@ -208,33 +231,9 @@
                      (the integer (restore-object stream))))
             (the integer (restore-object stream)))))
 
-(defun handle-special-float (code name)
-  (aif (rassoc code *special-floats*)
-       (car it)
-       (store-error "~A Cannot be represented." name)))
-
-(defrestore-cl-store (negative-infinity stream)
-  (handle-special-float +negative-infinity-code+
-                        "Single Float Negative Infinity"))
-
-(defrestore-cl-store (positive-infinity stream)
-  (handle-special-float +positive-infinity-code+
-                        "Single Float Positive Infinity"))
-
-(defrestore-cl-store (nan-float stream)
-   (handle-special-float +float-nan-code+ "Single Float NaN"))
-
-(defrestore-cl-store (negative-double-infinity stream)
-  (handle-special-float +negative-double-infinity-code+
-                        "Double Float Negative Infinity"))
-
-(defrestore-cl-store (positive-double-infinity stream)
-  (handle-special-float +positive-double-infinity-code+
-                        "Double Float Positive Infinity"))
-
-(defrestore-cl-store (float-double-nan stream)
-  (handle-special-float +float-double-nan-code+
-                        "Double Float NaN"))
+(defrestore-cl-store (special-float stream)
+  (or (car (rassoc (read-byte stream) *special-floats*))
+      (restore-error "Float ~S is not a valid special float.")))
 
 
 ;; ratio
--- /project/cl-store/cvsroot/cl-store/tests.lisp	2006/12/11 21:44:02	1.28
+++ /project/cl-store/cvsroot/cl-store/tests.lisp	2006/12/14 18:15:41	1.29
@@ -1,6 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;; See the file LICENCE for licence information.
-
 (defpackage :cl-store-tests
   (:use :cl :regression-test :cl-store))
 
--- /project/cl-store/cvsroot/cl-store/utils.lisp	2006/12/11 21:44:02	1.23
+++ /project/cl-store/cvsroot/cl-store/utils.lisp	2006/12/14 18:15:41	1.24
@@ -81,15 +81,18 @@
 
 ;; because clisp doesn't have the class single-float or double-float.
 (defun float-type (float)
-  (typecase float
+  (etypecase float
     (single-float 0)
     (double-float 1)
-    (t 0)))
+    (short-float 2)
+    (long-float 3)))
 
 (defun get-float-type (num)
   (ecase num
     (0 1.0)
-    (1 1.0d0)))
+    (1 1.0d0)
+    (2 1.0s0)
+    (3 1.0l0)))
 
 (deftype ub32 ()
   `(unsigned-byte 32))



From sross at common-lisp.net  Thu Dec 14 18:15:42 2006
From: sross at common-lisp.net (sross)
Date: Thu, 14 Dec 2006 13:15:42 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store/acl
Message-ID: <20061214181542.0045E48144@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store/acl
In directory clnet:/tmp/cvs-serv7536/acl

Modified Files:
	custom.lisp 
Log Message:
Changelog 2006-12-13




--- /project/cl-store/cvsroot/cl-store/acl/custom.lisp	2005/02/11 12:00:35	1.3
+++ /project/cl-store/cvsroot/cl-store/acl/custom.lisp	2006/12/14 18:15:41	1.4
@@ -4,24 +4,12 @@
 (in-package :cl-store)
 
 
-;; setup special floats
-(defvar +single-positive-infinity+ (expt most-positive-single-float 2))
-(defvar +single-negative-infinity+ (expt most-negative-single-float 3))
-(defvar +single-nan+ (/ +single-negative-infinity+ +single-negative-infinity+))
-
-(defvar +double-positive-infinity+ (expt most-positive-double-float 2))
-(defvar +double-negative-infinity+ (expt most-negative-double-float 3))
-(defvar +double-nan+ (/ +double-negative-infinity+ +double-negative-infinity+))
-
-
-(setf *special-floats*
-  (list (cons +double-positive-infinity+ +positive-double-infinity-code+)
-        (cons +single-positive-infinity+ +positive-infinity-code+)
-        (cons +single-negative-infinity+ +negative-infinity-code+)
-        (cons +double-negative-infinity+ +negative-double-infinity-code+)
-        (cons +single-nan+ +float-nan-code+)
-        (cons +double-nan+ +float-double-nan-code+)))
-
-
+(defun create-float-values (value &rest codes)
+  (let ((neg-inf (expt value 3)))
+    (mapcar 'cons
+            (list (expt (abs value) 2)
+                  neg-inf
+                  (/ neg-inf neg-inf))
+            codes)))
 
 ;; EOF



From sross at common-lisp.net  Thu Dec 14 18:15:43 2006
From: sross at common-lisp.net (sross)
Date: Thu, 14 Dec 2006 13:15:43 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store/cmucl
Message-ID: <20061214181543.344D348144@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store/cmucl
In directory clnet:/tmp/cvs-serv7536/cmucl

Modified Files:
	custom.lisp 
Log Message:
Changelog 2006-12-13




--- /project/cl-store/cvsroot/cl-store/cmucl/custom.lisp	2005/02/11 12:00:39	1.6
+++ /project/cl-store/cvsroot/cl-store/cmucl/custom.lisp	2006/12/14 18:15:43	1.7
@@ -3,31 +3,16 @@
 
 (in-package :cl-store)
 
-(defvar +single-positive-infinity+ most-positive-single-float)
-(defvar +single-negative-infinity+ most-negative-single-float)
-(defvar +single-nan+)
-
-(defvar +double-positive-infinity+ most-positive-double-float)
-(defvar +double-negative-infinity+ most-negative-double-float)
-(defvar +double-nan+)
-
-(ext:with-float-traps-masked (:overflow :invalid)
-  (setf +single-positive-infinity+ (expt +single-positive-infinity+ 2))
-  (setf +single-negative-infinity+ (expt +single-negative-infinity+ 3))
-  (setf +single-nan+ (/ +single-negative-infinity+ +single-negative-infinity+))
-  (setf +double-positive-infinity+ (expt +double-positive-infinity+ 2))
-  (setf +double-negative-infinity+ (expt +double-negative-infinity+ 3))
-  (setf +double-nan+ (/ +double-negative-infinity+ +double-negative-infinity+)))
-
-(setf *special-floats*
-  (list (cons +double-positive-infinity+ +positive-double-infinity-code+)
-        (cons +single-positive-infinity+ +positive-infinity-code+)
-        (cons +single-negative-infinity+ +negative-infinity-code+)
-        (cons +double-negative-infinity+ +negative-double-infinity-code+)
-        (cons +single-nan+ +float-nan-code+)
-        (cons +double-nan+ +float-double-nan-code+)))
-
-
+; special floats
+(defun create-float-values (value &rest codes)
+  "Returns a alist of special float to float code mappings."
+  (ext:with-float-traps-masked (:overflow :invalid)
+    (let ((neg-inf (expt value 3)))
+      (mapcar 'cons
+              (list (expt (abs value) 2)
+                    neg-inf
+                    (/ neg-inf neg-inf))
+              codes))))
 
 ;; Custom Structures
 (defstore-cl-store (obj structure-object stream)



From sross at common-lisp.net  Thu Dec 14 18:15:43 2006
From: sross at common-lisp.net (sross)
Date: Thu, 14 Dec 2006 13:15:43 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store/lispworks
Message-ID: <20061214181543.76E5448144@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store/lispworks
In directory clnet:/tmp/cvs-serv7536/lispworks

Modified Files:
	custom.lisp 
Log Message:
Changelog 2006-12-13




--- /project/cl-store/cvsroot/cl-store/lispworks/custom.lisp	2006/12/11 21:44:03	1.8
+++ /project/cl-store/cvsroot/cl-store/lispworks/custom.lisp	2006/12/14 18:15:43	1.9
@@ -3,7 +3,7 @@
 
 (in-package :cl-store)
 
-;; Setup special floats
+;; Special float handling
 (defun create-float-values (value &rest codes)
   (let ((neg-inf (expt value 3)))
     (mapcar 'cons
@@ -12,12 +12,6 @@
                   (/ neg-inf neg-inf))
             codes)))
 
-(defparameter *special-floats*
-  (nconc (create-float-values most-negative-single-float +positive-infinity-code+
-                              +negative-infinity-code+ +float-nan-code+)
-         (create-float-values most-negative-double-float +positive-double-infinity-code+
-                              +negative-double-infinity-code+ +float-double-nan-code+)))
-
 ;; Custom structure storing from Alain Picard.
 (defstore-cl-store (obj structure-object stream)
   (output-type-code +structure-object-code+ stream)



From sross at common-lisp.net  Thu Dec 14 18:15:43 2006
From: sross at common-lisp.net (sross)
Date: Thu, 14 Dec 2006 13:15:43 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store/sbcl
Message-ID: <20061214181543.B040348145@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store/sbcl
In directory clnet:/tmp/cvs-serv7536/sbcl

Modified Files:
	custom.lisp 
Log Message:
Changelog 2006-12-13




--- /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp	2006/03/14 11:02:32	1.12
+++ /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp	2006/12/14 18:15:43	1.13
@@ -4,31 +4,15 @@
 (in-package :cl-store)
 
 ; special floats
-(defvar +single-positive-infinity+ most-positive-single-float)
-(defvar +single-negative-infinity+ most-negative-single-float)
-(defvar +single-nan+)
-
-(defvar +double-positive-infinity+ most-positive-double-float)
-(defvar +double-negative-infinity+ most-negative-double-float)
-(defvar +double-nan+)
-
-(sb-int:with-float-traps-masked (:overflow :invalid)
-  (setf +single-positive-infinity+ (expt +single-positive-infinity+ 2))
-  (setf +single-negative-infinity+ (expt +single-negative-infinity+ 3))
-  (setf +single-nan+ (/ +single-negative-infinity+ +single-negative-infinity+))
-  (setf +double-positive-infinity+ (expt +double-positive-infinity+ 2))
-  (setf +double-negative-infinity+ (expt +double-negative-infinity+ 3))
-  (setf +double-nan+ (/ +double-negative-infinity+ +double-negative-infinity+)))
-
-(setf *special-floats*
-  (list (cons +double-positive-infinity+ +positive-double-infinity-code+)
-        (cons +single-positive-infinity+ +positive-infinity-code+)
-        (cons +single-negative-infinity+ +negative-infinity-code+)
-        (cons +double-negative-infinity+ +negative-double-infinity-code+)
-        (cons +single-nan+ +float-nan-code+)
-        (cons +double-nan+ +float-double-nan-code+)))
-
-
+(defun create-float-values (value &rest codes)
+  "Returns a alist of special float to float code mappings."
+  (sb-int:with-float-traps-masked (:overflow :invalid)
+    (let ((neg-inf (expt value 3)))
+      (mapcar 'cons
+              (list (expt (abs value) 2)
+                    neg-inf
+                    (/ neg-inf neg-inf))
+              codes))))
 
 ;; Custom structure storing
 



From sross at common-lisp.net  Sat Dec 16 13:50:27 2006
From: sross at common-lisp.net (sross)
Date: Sat, 16 Dec 2006 08:50:27 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store
Message-ID: <20061216135027.B0A795301D@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store
In directory clnet:/tmp/cvs-serv3655

Modified Files:
	.cvsignore ChangeLog cl-store.asd utils.lisp 
Log Message:
Changelog 2006-12-16 : Preliminary Support for ABCL



--- /project/cl-store/cvsroot/cl-store/.cvsignore	2006/12/11 21:44:02	1.4
+++ /project/cl-store/cvsroot/cl-store/.cvsignore	2006/12/16 13:50:26	1.5
@@ -9,3 +9,4 @@
 *.fsl
 *.ofasl
 *.ufasl
+*.abcl
--- /project/cl-store/cvsroot/cl-store/ChangeLog	2006/12/14 18:15:41	1.43
+++ /project/cl-store/cvsroot/cl-store/ChangeLog	2006/12/16 13:50:26	1.44
@@ -1,3 +1,7 @@
+2006-12-16 Sean Ross <sross at common-lisp.net>
+	* cl-store.asd, utils.lisp : Added preliminary support for ABCL (tested on 
+	version 0.0.9).
+
 2006-12-13 Sean Ross <sross at common-lisp.net>
 	* utils.lisp, acl/custom.lisp, cmucl/custom.lisp, lispworks/custom.lisp
 	sbcl/custom/lisp, default-backend.lisp, cl-store.asd: 
--- /project/cl-store/cvsroot/cl-store/cl-store.asd	2006/12/14 18:15:41	1.40
+++ /project/cl-store/cvsroot/cl-store/cl-store.asd	2006/12/16 13:50:26	1.41
@@ -9,7 +9,7 @@
 
 (in-package #:cl-store.system)
 
-#-(or lispworks mcl cmu clisp sbcl allegro ecl openmcl)
+#-(or lispworks mcl cmu clisp sbcl allegro ecl openmcl abcl)
 (error "This is an unsupported lisp implementation.
 Currently only MCL, OpenMCL, Lispworks, CMUCL, SBCL,
 CLISP, ECL and AllegroCL are supported.")
@@ -20,7 +20,7 @@
 
 (defun lisp-system-shortname ()
   #+mcl :mcl #+lispworks :lispworks #+cmu :cmucl #+clisp :clisp #+sbcl :sbcl
-  #+allegro :acl #+ecl :ecl #+openmcl :openmcl)
+  #+allegro :acl #+ecl :ecl #+openmcl :openmcl #+abcl :abcl)
 
 (defmethod component-pathname ((component non-required-file))
   (let ((pathname (call-next-method))
--- /project/cl-store/cvsroot/cl-store/utils.lisp	2006/12/14 18:15:41	1.24
+++ /project/cl-store/cvsroot/cl-store/utils.lisp	2006/12/16 13:50:26	1.25
@@ -12,6 +12,7 @@
   `(let ,(mapcar #'(lambda (x) `(,x (gensym))) names)
     , at body))
 
+#-abcl
 (defgeneric serializable-slots (object)
   (declare (optimize speed))
   (:documentation 
@@ -28,6 +29,7 @@
 
 ; unfortunately the metaclass of conditions in sbcl and cmu 
 ; are not standard-class
+#-abcl
 (defgeneric serializable-slots-using-class (object class)
   (declare (optimize speed))
   (:documentation "Return a list of slot-definitions to serialize.
@@ -46,6 +48,7 @@
 
 
 ; Generify get-slot-details for customization (from Thomas Stenhaug)
+#-abcl
 (defgeneric get-slot-details (slot-definition)
   (declare (optimize speed))
   (:documentation 



From sross at common-lisp.net  Sat Dec 16 13:55:00 2006
From: sross at common-lisp.net (sross)
Date: Sat, 16 Dec 2006 08:55:00 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store
Message-ID: <20061216135500.ED14653014@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store
In directory clnet:/tmp/cvs-serv3961

Modified Files:
	cl-store.asd 
Log Message:
Bumped version to 0.7.6



--- /project/cl-store/cvsroot/cl-store/cl-store.asd	2006/12/16 13:50:26	1.41
+++ /project/cl-store/cvsroot/cl-store/cl-store.asd	2006/12/16 13:55:00	1.42
@@ -45,7 +45,7 @@
   :name "CL-STORE"
   :author "Sean Ross <sross at common-lisp.net>"
   :maintainer "Sean Ross <sross at common-lisp.net>"
-  :version "0.7.5"
+  :version "0.7.6"
   :description "Serialization package"
   :long-description "Portable CL Package to serialize data"
   :licence "MIT"



From sross at common-lisp.net  Sun Dec 17 00:11:09 2006
From: sross at common-lisp.net (sross)
Date: Sat, 16 Dec 2006 19:11:09 -0500 (EST)
Subject: [cl-store-cvs] CVS cl-store
Message-ID: <20061217001109.375C8111D6@common-lisp.net>

Update of /project/cl-store/cvsroot/cl-store
In directory clnet:/tmp/cvs-serv19024

Modified Files:
	circularities.lisp ChangeLog 
Log Message:
Bug fix from Alex Mizrahi. Change *restored-values* to use eql as the
hash test.



--- /project/cl-store/cvsroot/cl-store/circularities.lisp	2005/10/04 08:10:26	1.24
+++ /project/cl-store/cvsroot/cl-store/circularities.lisp	2006/12/17 00:11:09	1.25
@@ -167,7 +167,7 @@
   (let ((*restore-counter* 0)
         (*need-to-fix* nil)
         (*restored-values* (and *check-for-circs*
-                                (make-hash-table :test #'eq
+                                (make-hash-table :test #'eql
                                                  :size *restore-hash-size*))))
     (check-magic-number backend place)
     (prog1
@@ -225,9 +225,9 @@
   (declare (optimize speed (safety 1) (debug 0)))
   (if (referrer-p val)
       (multiple-value-bind (new-val win) (referred-value val *restored-values*)
-          (if (or new-val win)
-              new-val
-              val))
+        (if (or new-val win)
+            new-val
+            val))
       val))
 
 ;; EOF
--- /project/cl-store/cvsroot/cl-store/ChangeLog	2006/12/16 13:50:26	1.44
+++ /project/cl-store/cvsroot/cl-store/ChangeLog	2006/12/17 00:11:09	1.45
@@ -1,4 +1,8 @@
 2006-12-16 Sean Ross <sross at common-lisp.net>
+	* circularities.lisp: Bug fix from Alex Mizrahi. Change *restored-values*
+	to use eql as the hash test. 
+
+2006-12-16 Sean Ross <sross at common-lisp.net>
 	* cl-store.asd, utils.lisp : Added preliminary support for ABCL (tested on 
 	version 0.0.9).