Changeset 11196

Timestamp:

Oct 22, 2008, 5:18:20 AM (11 years ago)

Author:

gb

Message:

Support saving/loading "small" (16-bit) pointer-valued constants.
This is an incompatible change; it means that older versions of
the lisp looking for pointer-valued constants will get an obscure
error (=> unknown constant encoding) rather than a constant-not-found
error.

File:

• trunk/source/lib/db-io.lisp (modified) (5 diffs)

trunk/source/lib/db-io.lisp

@@ -577 +577 @@
     
 
-
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defconstant db-string-constant 0)
 (defconstant db-read-string-constant 1)
@@ -585 +585 @@
 (defconstant db-double-constant 5)
 (defconstant db-char-constant 6)
+(defconstant db-pointer-constant 7)
+)
 
 (defparameter *arg-spec-encoding*
@@ -693 +695 @@
                   (#.db-float-constant (pref dptr :dbm-constant.value.single-float))
                   (#.db-double-constant (pref dptr :dbm-constant.value.double-float))
-                  (#.db-char-constant (code-char (pref dptr :dbm-constant.value.u32)))))
+                  (#.db-char-constant (code-char (pref dptr :dbm-constant.value.u32)))
+                  (#.db-pointer-constant
+                   (let* ((val (pref dptr :dbm-constant.value.u32)))
+                     #+64-bit-target
+                     (if (logbitp 31 val)
+                       (setq val (logior val (ash #xffffffff 32))))
+                     (%int-to-ptr val )))))
           (cdb-free (pref datum :cdb-datum.data)))))
     val))
@@ -736 +744 @@
          short-float
          double-float
-         character)
+         character
+         macptr)
      (rletZ ((constant :dbm-constant)
              (content :cdb-datum)
@@ -755 +764 @@
          (character
           (setf (pref constant :dbm-constant.value.u32) (char-code val))
-          (setf (pref constant :dbm-constant.class) db-char-constant)))
+          (setf (pref constant :dbm-constant.class) db-char-constant))
+         (macptr
+          (setf (pref constant :dbm-constant.value.u32) (logand #xffffffff (%ptr-to-int val)))
+          (setf (pref constant :dbm-constant.class) db-pointer-constant))
+         )
        (setf (pref content :cdb-datum.data) constant
              (pref content :cdb-datum.size) (record-length :dbm-constant))