Changeset 14736

Timestamp:

Apr 26, 2011, 10:32:02 PM (14 years ago)

Author:

Gary Byers

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:

• trunk/source/lib/foreign-types.lisp (modified) (2 diffs)

trunk/source/lib/foreign-types.lisp

@@ -411 +411 @@
 
 (defmethod make-load-form ((s foreign-type) &optional env)
+  (declare (ignore env))
   (if (eq s *void-foreign-type*)
     '*void-foreign-type*
-    (make-load-form-saving-slots s :environment env)))
+    `(parse-foreign-type ',(unparse-foreign-type s))))
 
 
@@ -1888 +1889 @@
       (make-foreign-boolean-type :bits bits :signed nil))
 
-    (def-foreign-type signed-char (signed 8))
-    (def-foreign-type signed-byte (signed 8))
-    (def-foreign-type short (signed 16))
-    (def-foreign-type signed-halfword short)
-    (def-foreign-type int (signed 32))
-    (def-foreign-type signed-fullword int)
-    (def-foreign-type signed-short (signed 16))
-    (def-foreign-type signed-int (signed 32))
-    (def-foreign-type signed-doubleword (signed 64))
-    (def-foreign-type char #-darwin-target (unsigned 8)
-                      #+darwin-target (signed 8))
-    (def-foreign-type unsigned-char (unsigned 8))
-    (def-foreign-type unsigned-byte (unsigned 8))
-    (def-foreign-type unsigned-short (unsigned 16))
-    (def-foreign-type unsigned-halfword unsigned-short)
-    (def-foreign-type unsigned-int (unsigned 32))
-    (def-foreign-type unsigned-fullword unsigned-int)
-    (def-foreign-type unsigned-doubleword (unsigned 64))
-    (def-foreign-type bit (bitfield 1))
-
-    (def-foreign-type float single-float)
-    (def-foreign-type double double-float)
+    (%def-foreign-type :signed-char (parse-foreign-type '(:signed 8) ftd))
+    (%def-foreign-type :signed-byte (parse-foreign-type '(:signed 8) ftd))
+    (%def-foreign-type :short (parse-foreign-type '(:signed 16) ftd))
+    (%def-foreign-type :signed-halfword (parse-foreign-type :short ftd))
+    (%def-foreign-type :int (parse-foreign-type '(:signed 32) ftd))
+    (%def-foreign-type :signed-fullword (parse-foreign-type :int ftd))
+    (%def-foreign-type :signed-short (parse-foreign-type '(:signed 16) ftd))
+    (%def-foreign-type :signed-int (parse-foreign-type '(:signed 32) ftd))
+    (%def-foreign-type :signed-doubleword (parse-foreign-type '(:signed 64) ftd))
+    (%def-foreign-type :char (parse-foreign-type #-darwin-target '(:unsigned 8)
+                      #+darwin-target '(:signed 8) ftd))
+    (%def-foreign-type :unsigned-char (parse-foreign-type '(:unsigned 8) ftd))
+    (%def-foreign-type :unsigned-byte (parse-foreign-type '(:unsigned 8) ftd))
+    (%def-foreign-type :unsigned-short (parse-foreign-type '(:unsigned 16) ftd))
+    (%def-foreign-type :unsigned-halfword (parse-foreign-type :unsigned-short ftd))
+    (%def-foreign-type :unsigned-int (parse-foreign-type '(:unsigned 32) ftd))
+    (%def-foreign-type :unsigned-fullword (parse-foreign-type :unsigned-int ftd))
+    (%def-foreign-type :unsigned-doubleword (parse-foreign-type '(:unsigned 64) ftd))
+    (%def-foreign-type :bit (parse-foreign-type '(:bitfield 1) ftd))
+
+    (%def-foreign-type :float (parse-foreign-type :single-float ftd))
+    (%def-foreign-type :double (parse-foreign-type :double-float ftd))
 
     (%def-foreign-type :void *void-foreign-type*)
-    (def-foreign-type address (* :void))
+    (%def-foreign-type :address (parse-foreign-type '(:* :void) ftd))
     (let* ((signed-long-type (parse-foreign-type
                               `(:signed ,long-word-size)))