Changeset 11196


Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/db-io.lisp

    r11183 r11196  
    577577   
    578578
    579 
     579(eval-when (:compile-toplevel :load-toplevel :execute)
    580580(defconstant db-string-constant 0)
    581581(defconstant db-read-string-constant 1)
     
    585585(defconstant db-double-constant 5)
    586586(defconstant db-char-constant 6)
     587(defconstant db-pointer-constant 7)
     588)
    587589
    588590(defparameter *arg-spec-encoding*
     
    693695                  (#.db-float-constant (pref dptr :dbm-constant.value.single-float))
    694696                  (#.db-double-constant (pref dptr :dbm-constant.value.double-float))
    695                   (#.db-char-constant (code-char (pref dptr :dbm-constant.value.u32)))))
     697                  (#.db-char-constant (code-char (pref dptr :dbm-constant.value.u32)))
     698                  (#.db-pointer-constant
     699                   (let* ((val (pref dptr :dbm-constant.value.u32)))
     700                     #+64-bit-target
     701                     (if (logbitp 31 val)
     702                       (setq val (logior val (ash #xffffffff 32))))
     703                     (%int-to-ptr val )))))
    696704          (cdb-free (pref datum :cdb-datum.data)))))
    697705    val))
     
    736744         short-float
    737745         double-float
    738          character)
     746         character
     747         macptr)
    739748     (rletZ ((constant :dbm-constant)
    740749             (content :cdb-datum)
     
    755764         (character
    756765          (setf (pref constant :dbm-constant.value.u32) (char-code val))
    757           (setf (pref constant :dbm-constant.class) db-char-constant)))
     766          (setf (pref constant :dbm-constant.class) db-char-constant))
     767         (macptr
     768          (setf (pref constant :dbm-constant.value.u32) (logand #xffffffff (%ptr-to-int val)))
     769          (setf (pref constant :dbm-constant.class) db-pointer-constant))
     770         )
    758771       (setf (pref content :cdb-datum.data) constant
    759772             (pref content :cdb-datum.size) (record-length :dbm-constant))
Note: See TracChangeset for help on using the changeset viewer.