[Openmcl-cvs-notifications] r14742 - /trunk/source/lib/foreign-types.lisp

[gb at clozure.com]

Author: gb
Date: Wed Apr 27 18:19:01 2011
New Revision: 14742

Log:
Register the foreign type ordinal of :ARRAY foreign types.

Modified:
    trunk/source/lib/foreign-types.lisp

Modified: trunk/source/lib/foreign-types.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/foreign-types.lisp (original)
+++ trunk/source/lib/foreign-types.lisp Wed Apr 27 18:19:01 2011
@@ -1845,18 +1845,21 @@
              (pair (cons type dims)))
         (declare (dynamic-extent pair))
         (ensure-foreign-type-bits type)
-        (or (gethash pair (ftd-array-types *target-ftd*))
-            (setf (gethash (cons type dims) (ftd-array-types *target-ftd*))
-                  =

-                  (make-foreign-array-type
-                   :element-type type
-                   :dimensions dims
-                   :alignment (foreign-type-alignment type)
-                   :bits (if (and (ensure-foreign-type-bits type)
-                                  (every #'integerp dims))
-                           (* (align-offset (foreign-type-bits type)
-                                            (foreign-type-alignment type))
-                              (reduce #'* dims))))))))
+        (let* ((atype =

+                (or (gethash pair (ftd-array-types *target-ftd*))
+                    (setf (gethash (cons type dims) (ftd-array-types *targ=
et-ftd*))
+                          =

+                          (make-foreign-array-type
+                           :element-type type
+                           :dimensions dims
+                           :alignment (foreign-type-alignment type)
+                           :bits (if (and (ensure-foreign-type-bits type)
+                                          (every #'integerp dims))
+                                   (* (align-offset (foreign-type-bits typ=
e)
+                                                    (foreign-type-alignmen=
t type))
+                                      (reduce #'* dims))))))))
+          (note-foreign-type-ordinal atype *target-ftd*)
+          atype)))
 =

     (def-foreign-type-translator * (to)
       (let* ((ftd *target-ftd*)