Ignore:
Timestamp:
Apr 27, 2011, 5:32:02 AM (9 years ago)
Author:
gb
Message:

Don't use MAKE-LOAD-FORM-SAVING-SLOTS in MAKE-LOAD-FORM for
foreign-types; among other things it saves the type's ordinal slot,
which is supposed to be per-session. Unparse and parse instead.

After bootstrapping,

(maphash #'(lambda (k v)
             (when (>= k (ccl::ftd-ordinal ccl::*target-ftd*))
               (format t "~&~s ~s" k v)))
         (ccl::ftd-ordinal-types ccl::*target-ftd*))

should return NIL without printing anything.

Avoid constructs that'd require the use of MAKE-LOAD-FORM in
INSTALL-FOREIGN-TYPES, since PARSE-FOREIGN-TYPE can't be called
until this function has run.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/foreign-types.lisp

    r14724 r14736  
    411411
    412412(defmethod make-load-form ((s foreign-type) &optional env)
     413  (declare (ignore env))
    413414  (if (eq s *void-foreign-type*)
    414415    '*void-foreign-type*
    415     (make-load-form-saving-slots s :environment env)))
     416    `(parse-foreign-type ',(unparse-foreign-type s))))
    416417
    417418
     
    18881889      (make-foreign-boolean-type :bits bits :signed nil))
    18891890
    1890     (def-foreign-type signed-char (signed 8))
    1891     (def-foreign-type signed-byte (signed 8))
    1892     (def-foreign-type short (signed 16))
    1893     (def-foreign-type signed-halfword short)
    1894     (def-foreign-type int (signed 32))
    1895     (def-foreign-type signed-fullword int)
    1896     (def-foreign-type signed-short (signed 16))
    1897     (def-foreign-type signed-int (signed 32))
    1898     (def-foreign-type signed-doubleword (signed 64))
    1899     (def-foreign-type char #-darwin-target (unsigned 8)
    1900                       #+darwin-target (signed 8))
    1901     (def-foreign-type unsigned-char (unsigned 8))
    1902     (def-foreign-type unsigned-byte (unsigned 8))
    1903     (def-foreign-type unsigned-short (unsigned 16))
    1904     (def-foreign-type unsigned-halfword unsigned-short)
    1905     (def-foreign-type unsigned-int (unsigned 32))
    1906     (def-foreign-type unsigned-fullword unsigned-int)
    1907     (def-foreign-type unsigned-doubleword (unsigned 64))
    1908     (def-foreign-type bit (bitfield 1))
    1909 
    1910     (def-foreign-type float single-float)
    1911     (def-foreign-type double double-float)
     1891    (%def-foreign-type :signed-char (parse-foreign-type '(:signed 8) ftd))
     1892    (%def-foreign-type :signed-byte (parse-foreign-type '(:signed 8) ftd))
     1893    (%def-foreign-type :short (parse-foreign-type '(:signed 16) ftd))
     1894    (%def-foreign-type :signed-halfword (parse-foreign-type :short ftd))
     1895    (%def-foreign-type :int (parse-foreign-type '(:signed 32) ftd))
     1896    (%def-foreign-type :signed-fullword (parse-foreign-type :int ftd))
     1897    (%def-foreign-type :signed-short (parse-foreign-type '(:signed 16) ftd))
     1898    (%def-foreign-type :signed-int (parse-foreign-type '(:signed 32) ftd))
     1899    (%def-foreign-type :signed-doubleword (parse-foreign-type '(:signed 64) ftd))
     1900    (%def-foreign-type :char (parse-foreign-type #-darwin-target '(:unsigned 8)
     1901                      #+darwin-target '(:signed 8) ftd))
     1902    (%def-foreign-type :unsigned-char (parse-foreign-type '(:unsigned 8) ftd))
     1903    (%def-foreign-type :unsigned-byte (parse-foreign-type '(:unsigned 8) ftd))
     1904    (%def-foreign-type :unsigned-short (parse-foreign-type '(:unsigned 16) ftd))
     1905    (%def-foreign-type :unsigned-halfword (parse-foreign-type :unsigned-short ftd))
     1906    (%def-foreign-type :unsigned-int (parse-foreign-type '(:unsigned 32) ftd))
     1907    (%def-foreign-type :unsigned-fullword (parse-foreign-type :unsigned-int ftd))
     1908    (%def-foreign-type :unsigned-doubleword (parse-foreign-type '(:unsigned 64) ftd))
     1909    (%def-foreign-type :bit (parse-foreign-type '(:bitfield 1) ftd))
     1910
     1911    (%def-foreign-type :float (parse-foreign-type :single-float ftd))
     1912    (%def-foreign-type :double (parse-foreign-type :double-float ftd))
    19121913
    19131914    (%def-foreign-type :void *void-foreign-type*)
    1914     (def-foreign-type address (* :void))
     1915    (%def-foreign-type :address (parse-foreign-type '(:* :void) ftd))
    19151916    (let* ((signed-long-type (parse-foreign-type
    19161917                              `(:signed ,long-word-size)))
Note: See TracChangeset for help on using the changeset viewer.