Changeset 337

Timestamp:

Jan 19, 2004, 4:37:57 PM (21 years ago)

Author:

Gary Byers

Message:

(Finally) try to handle odd poweropen struct alignment rules.

File:

• trunk/ccl/lib/foreign-types.lisp (modified) (4 diffs)

trunk/ccl/lib/foreign-types.lisp

@@ -985 +985 @@
         (overall-alignment 1)
         (parsed-fields nil)
+        #+poweropen-target
+        (first-field-p t)
         (alt-alignment (foreign-record-type-alt-align result)))
     (dolist (field fields)
@@ -994 +996 @@
                (alignment (if alt-alignment
                             (min natural-alignment alt-alignment)
+                            #+poweropen-target
+                            (if first-field-p
+                              (progn
+                                (setq first-field-p nil)
+                                natural-alignment)
+                              (min 32 natural-alignment))
+                            #-poweropen-target
                             natural-alignment))
                (parsed-field
@@ -1281 +1290 @@
                         (reduce #'* dims))))))))
 
+(defun %find-foreign-record (name)
+  (or (info-foreign-type-struct name)
+      (info-foreign-type-union name)
+      (load-record name)))
+
+
 (defun %foreign-type-or-record (type)
   (if (consp type)
     (parse-foreign-type type)
-    (or (info-foreign-type-struct type)
-        (info-foreign-type-union type)
-        (load-record type)
+    (or (%find-foreign-record type)
         (parse-foreign-type type))))
-
 
 (defun %foreign-type-or-record-size (type &optional (units :bits))
@@ -1594 +1606 @@
             (ceiling bits 32))))
        (error "can't determine representation keyword for ~s" f)))))
+
+(defun foreign-record-accessor-names (record-type &optional prefix)
+  (collect ((accessors))
+    (dolist (field (foreign-record-type-fields record-type) (accessors))
+      (let* ((field-name (append prefix (list (foreign-record-field-name field))))
+             (field-type (foreign-record-field-type field)))
+        (if (typep field-type 'foreign-record-type)
+          (dolist (s (foreign-record-accessor-names field-type field-name))
+            (accessors s))
+          (accessors field-name))))))