Changeset 6043


Ignore:
Timestamp:
Mar 15, 2007, 7:53:48 AM (13 years ago)
Author:
gb
Message:

Intern foreign-array-types, too.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/lib/foreign-types.lisp

    r6042 r6043  
    7171  (ordinal-lock (make-lock))
    7272  (ordinal-types (make-hash-table :test #'eq :weak :key))
    73   (pointer-types (make-hash-table :test #'equalp)))
     73  (pointer-types (make-hash-table :test #'equalp))
     74  (array-types (make-hash-table :test #'equalp)))
    7475
    7576
     
    17111712            (error "Dimension is not a non-negative fixnum: ~S" loser))))
    17121713       
    1713       (let ((type (parse-foreign-type ele-type)))
    1714         (make-foreign-array-type
    1715          :element-type type
    1716          :dimensions dims
    1717          :alignment (foreign-type-alignment type)
    1718          :bits (if (and (ensure-foreign-type-bits type)
    1719                         (every #'integerp dims))
    1720                  (* (align-offset (foreign-type-bits type)
    1721                                   (foreign-type-alignment type))
    1722                     (reduce #'* dims))))))
     1714      (let* ((type (parse-foreign-type ele-type))
     1715            (pair (cons type dims)))
     1716        (declare (dynamic-extent pair))
     1717        (or (gethash pair (ftd-array-types *target-ftd*))
     1718            (setf (gethash (cons type dims) (ftd-array-types *target-ftd*))
     1719                 
     1720                  (make-foreign-array-type
     1721                   :element-type type
     1722                   :dimensions dims
     1723                   :alignment (foreign-type-alignment type)
     1724                   :bits (if (and (ensure-foreign-type-bits type)
     1725                                  (every #'integerp dims))
     1726                           (* (align-offset (foreign-type-bits type)
     1727                                            (foreign-type-alignment type))
     1728                              (reduce #'* dims))))))))
    17231729    (def-foreign-type-translator * (to)
    17241730      (let* ((to (if (eq to t) *void-foreign-type* (parse-foreign-type to))))
Note: See TracChangeset for help on using the changeset viewer.