Update of /project/cl-store/cvsroot/cl-store In directory common-lisp.net:/tmp/cvs-serv6337
Modified Files: ChangeLog circularities.lisp cl-store.asd fast-io.lisp package.lisp store.lisp tests.lisp Added Files: README Removed Files: fix-clisp.lisp Log Message: Changelog 2004-05-18
Date: Tue May 18 10:56:27 2004 Author: sross
Index: cl-store/ChangeLog diff -u cl-store/ChangeLog:1.1.1.1 cl-store/ChangeLog:1.2 --- cl-store/ChangeLog:1.1.1.1 Mon May 17 11:41:19 2004 +++ cl-store/ChangeLog Tue May 18 10:56:27 2004 @@ -1,3 +1,8 @@ +2004-05-18 Sean Ross sdr@jhb.ucs.co.za + * store.lisp, fix-clisp.lisp, sbcl/sockets.lisp: + Added fix for sbcl to use non-blocking IO when working with sockets. + Created directory structure and moved fix-clisp + 2004-05-17 Sean Ross sdr@jhb.ucs.co.za * store.lisp, fast-io.lisp, circularities.lisp, package.lisp, fix-clisp.lisp, utils.lisp, cl-store.asd, tests.lisp:
Index: cl-store/circularities.lisp diff -u cl-store/circularities.lisp:1.1.1.1 cl-store/circularities.lisp:1.2 --- cl-store/circularities.lisp:1.1.1.1 Mon May 17 11:41:26 2004 +++ cl-store/circularities.lisp Tue May 18 10:56:27 2004 @@ -116,13 +116,6 @@ ((arrayp sequence) (inner-array)))))
- - - - - - - ;; storing already seen objects
Index: cl-store/cl-store.asd diff -u cl-store/cl-store.asd:1.1.1.1 cl-store/cl-store.asd:1.2 --- cl-store/cl-store.asd:1.1.1.1 Mon May 17 11:41:19 2004 +++ cl-store/cl-store.asd Tue May 18 10:56:27 2004 @@ -7,20 +7,45 @@
(in-package :cl-store.system)
+(defclass non-required-file (cl-source-file) () + (:documentation + "File containing implementation dependent code which may or may not be there.")) + +(defun lisp-system-shortname () + #+lispworks :lispworks #+cmu :cmucl #+clisp :clisp #+sbcl :sbcl) + +(defmethod component-pathname ((component non-required-file)) + (let ((pathname (call-next-method)) + (name (string-downcase (lisp-system-shortname)))) + (merge-pathnames + (make-pathname :directory (list :relative name)) + pathname))) + +(defmethod perform ((op compile-op) (component non-required-file)) + (when (probe-file (component-pathname component)) + (call-next-method))) + +(defmethod perform ((op load-op) (component non-required-file)) + (when (probe-file (component-pathname component)) + (call-next-method))) + + (defsystem cl-store :name "Store" :author "Sean Ross sdr@jhb.ucs.co.za" :maintainer "Sean Ross sdr@jhb.ucs.co.za" - :version "0.1" + :version "0.1.1" :description "Serialization package" :long-description "Portable CL Package to serialize data types" :licence "MIT" :components ((:file "package") - #+clisp(:file "fix-clisp" :depends-on "package") + (:non-required-file "fix-clisp" :depends-on ("package")) (:file "fast-io" :depends-on ("package")) (:file "utils" :depends-on ("fast-io")) (:file "circularities" :depends-on ("utils")) - (:file "store" :depends-on ("circularities")))) + (:file "store" :depends-on ("circularities")) + (:non-required-file "sockets" :depends-on ("store"))) + :depends-on (#+sbcl :sb-bsd-sockets))
(defmethod perform :after ((o load-op) (c (eql (find-system :cl-store)))) @@ -32,14 +57,12 @@ (oos 'test-op :cl-store-tests))
(defsystem cl-store-tests - #+sbcl :depends-on #+sbcl (sb-rt) + :depends-on (rt) :components ((:file "tests")))
(defmethod perform ((op test-op) (sys (eql (find-system :cl-store-tests)))) (or (funcall (find-symbol "RUN-TESTS" "CL-STORE-TESTS")) (error "Test-op Failed."))) - -
;; EOF
Index: cl-store/fast-io.lisp diff -u cl-store/fast-io.lisp:1.1.1.1 cl-store/fast-io.lisp:1.2 --- cl-store/fast-io.lisp:1.1.1.1 Mon May 17 11:41:19 2004 +++ cl-store/fast-io.lisp Tue May 18 10:56:27 2004 @@ -1,3 +1,6 @@ +;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;; See the file LICENCE for licence information. + (in-package :cl-store) (declaim (optimize speed (safety 0) (space 0) (debug 0) (compilation-speed 0))) (eval-when (:compile-toplevel :load-toplevel :execute) @@ -8,11 +11,13 @@
(defvar *full-write* t "An evil, evil variable. Read sequence doesn't just block it also -waits until the buffer has been filled. This forces the full +waits until the buffer has been filled. This variable forces the full 4096 bytes stored in the buffer to be written. Set this to nil if you don't like file sizes being multiples of 4096 when writing to files. This should be removed, or at least -deprecated, when a better solution is found.") +deprecated, when a better solution is found. +If you are using SBCL do not worry about this. +Just store objects to and from sockets.")
;; A structure was chosen over a normal object @@ -36,10 +41,6 @@
;; reading -;; how should EOF be handled?? - - -;;(declaim (ftype (function (buffer) (unsigned-byte 8)) read-buf-byte)) (defgeneric read-buf-byte (buf))
(defmethod read-buf-byte ((buf buffer))
Index: cl-store/package.lisp diff -u cl-store/package.lisp:1.1.1.1 cl-store/package.lisp:1.2 --- cl-store/package.lisp:1.1.1.1 Mon May 17 11:41:20 2004 +++ cl-store/package.lisp Tue May 18 10:56:27 2004 @@ -23,68 +23,68 @@ :*nuke-existing-classes* :*store-class-superclasses*) #+sbcl (:import-from :sb-mop - slot-definition-name - slot-value-using-class - slot-boundp-using-class - slot-definition-allocation - compute-slots - slot-definition-initform - slot-definition-initargs - slot-definition-name - slot-definition-readers - slot-definition-type - slot-definition-writers - class-direct-default-initargs - class-direct-slots - class-direct-superclasses - class-slots - ensure-class) + :slot-definition-name + :slot-value-using-class + :slot-boundp-using-class + :slot-definition-allocation + :compute-slots + :slot-definition-initform + :slot-definition-initargs + :slot-definition-name + :slot-definition-readers + :slot-definition-type + :slot-definition-writers + :class-direct-default-initargs + :class-direct-slots + :class-direct-superclasses + :class-slots + :ensure-class)
#+cmu (:import-from :pcl - slot-definition-name - slot-value-using-class - slot-boundp-using-class - slot-definition-allocation - compute-slots - slot-definition-initform - slot-definition-initargs - slot-definition-name - slot-definition-readers - slot-definition-type - slot-definition-writers - class-direct-default-initargs - class-direct-slots - class-direct-superclasses - class-slots - ensure-class) + :slot-definition-name + :slot-value-using-class + :slot-boundp-using-class + :slot-definition-allocation + :compute-slots + :slot-definition-initform + :slot-definition-initargs + :slot-definition-name + :slot-definition-readers + :slot-definition-type + :slot-definition-writers + :class-direct-default-initargs + :class-direct-slots + :class-direct-superclasses + :class-slots + :ensure-class)
#+clisp (:import-from :clos - slot-value - std-compute-slots - slot-boundp - class-name - class-direct-default-initargs - class-direct-slots - class-slots - ensure-class) + :slot-value + :std-compute-slots + :slot-boundp + :class-name + :class-direct-default-initargs + :class-direct-slots + :class-slots + :ensure-class)
#+lispworks (:import-from :clos - slot-definition-name - slot-value-using-class - slot-boundp-using-class - slot-definition-allocation - compute-slots - slot-definition-initform - slot-definition-initargs - slot-definition-name - slot-definition-readers - slot-definition-type - slot-definition-writers - class-direct-default-initargs - class-direct-slots - class-slots - class-direct-superclasses - ensure-class)) + :slot-definition-name + :slot-value-using-class + :slot-boundp-using-class + :slot-definition-allocation + :compute-slots + :slot-definition-initform + :slot-definition-initargs + :slot-definition-name + :slot-definition-readers + :slot-definition-type + :slot-definition-writers + :class-direct-default-initargs + :class-direct-slots + :class-slots + :class-direct-superclasses + :ensure-class))
Index: cl-store/store.lisp diff -u cl-store/store.lisp:1.1.1.1 cl-store/store.lisp:1.2 --- cl-store/store.lisp:1.1.1.1 Mon May 17 11:41:23 2004 +++ cl-store/store.lisp Tue May 18 10:56:27 2004 @@ -12,6 +12,10 @@
- fix up circularity stuff so that eq floats are restored correctly.
+- add support for working directly with an implementations + sockets and maybe support for acl-compat. + Done for sbcl. + - hopefully find a better way to do circularity fixing
- structure storing for non python implementations @@ -88,13 +92,13 @@
(defgeneric restore (place) (:method ((place string)) - "Restore the object found in the String PLACE." + "Restore the object found in the String path designator PLACE." (restore-file place)) (:method ((place pathname)) "Restore the object found in Pathname PLACE." (restore-file place)) (:method ((place stream)) - "Restore the object found in STREAM STREAM" + "Restore the object found in the Stream STREAM" (restore (make-buffer :stream place))) (:method ((place buffer)) "Restore the object found in Stream PLACE." @@ -196,7 +200,8 @@ (defmacro defstore ((var type buffer &rest method-args) &body body) "Defines method store-object specialized on TYPE. BODY is executed with VAR and STREAM bound to the -value to be serialized and the output stream respectively." +value to be serialized and the output stream respectively. +When present METHOD-ARGS are used as qualifers to the generated method." (with-gensyms (code) `(let ((,code (register-code ',type))) (declare (ignorable ,code))
Index: cl-store/tests.lisp diff -u cl-store/tests.lisp:1.1.1.1 cl-store/tests.lisp:1.2 --- cl-store/tests.lisp:1.1.1.1 Mon May 17 11:41:24 2004 +++ cl-store/tests.lisp Tue May 18 10:56:27 2004 @@ -2,7 +2,7 @@ ;; See the file LICENCE for licence information.
(defpackage :cl-store-tests - (:use :cl #+sbcl :sb-rt #-sbcl :rt :cl-store)) + (:use :cl :rt :cl-store))
(in-package :cl-store-tests)
@@ -330,9 +330,27 @@ t)
+(defclass foobarbaz () ((x :accessor x :initarg :x))) + + +(defstore (obj foobarbaz buff) + (store-object (x obj) buff)) + +;(defstore (obj foobarbaz buff :before) +; (format t "Storing a foobarbaz object.")) + +(defrestore (foobarbaz buff) + (make-instance 'foobarbaz :x (restore-object buff))) + + +(deftest custom.1 + (progn (store (make-instance 'foobarbaz :x "foo") *test-file*) + (equal "foo" (x (restore *test-file*)))) + t) + + (defun run-tests () - #+sbcl(sb-rt:do-tests) - #-sbcl(rt:do-tests) + (rt:do-tests) (when (probe-file *test-file*) (delete-file *test-file*)))