Changeset 10457


Ignore:
Timestamp:
Aug 13, 2008, 4:42:20 AM (11 years ago)
Author:
gb
Message:

From rme: support class ordinals in ObjC foreign type system.

Location:
trunk/source/objc-bridge
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/objc-bridge/objc-clos.lisp

    r9592 r10457  
    166166          (#.objc-flag-class (id->objc-class-slots-vector index))
    167167          (#.objc-flag-metaclass (id->objc-metaclass-slots-vector index)))))
    168          
     168
     169(defun %objc-domain-class-ordinal (p)
     170  (let* ((type (%macptr-type p))
     171         (flags (ldb objc-type-flags type))
     172         (index (ldb objc-type-index type)))
     173    (declare (fixnum type flags index))
     174    (ecase flags
     175      (#.objc-flag-instance nil)
     176      (#.objc-flag-class (objc-class-id->ordinal index))
     177      (#.objc-flag-metaclass (objc-metaclass-id->ordinal index)))))
     178
     179(defun %set-objc-domain-class-ordinal (p new)
     180  (let* ((type (%macptr-type p))
     181         (flags (ldb objc-type-flags type))
     182         (index (ldb objc-type-index type)))
     183    (declare (fixnum type flags index))
     184    (ecase flags
     185      (#.objc-flag-instance nil)
     186      (#.objc-flag-class (setf (objc-class-id->ordinal index) new))
     187      (#.objc-flag-metaclass (setf (objc-metaclass-id->ordinal index) new)))))
     188
    169189(defloadvar *objc-object-domain*
    170190    (register-foreign-object-domain :objc
     
    176196                                :class-own-wrapper
    177197                                #'%objc-domain-class-own-wrapper
    178                                 :slots-vector #'%objc-domain-slots-vector))
     198                                :slots-vector #'%objc-domain-slots-vector
     199                                :class-ordinal #'%objc-domain-class-ordinal
     200                                :set-class-ordinal
     201                                #'%set-objc-domain-class-ordinal))
    179202
    180203;;; P is known to be a (possibly null!) instance of some ObjC class.
  • trunk/source/objc-bridge/objc-runtime.lisp

    r7471 r10457  
    173173       (class-foreign-names (make-array 1024))
    174174       (metaclass-foreign-names (make-array 1024))
     175       (class-id->ordinal (make-array 1024 :initial-element nil))
     176       (metaclass-id->ordinal (make-array 1024 :initial-element nil))
    175177       )
    176178
     
    192194                   (fill class-id->metaclass-id nil :start old-size :end new-size)
    193195                   (extend class-foreign-names)
    194                    (extend metaclass-foreign-names))
     196                   (extend metaclass-foreign-names)
     197                   (extend class-id->ordinal)
     198                   (extend metaclass-id->ordinal)
     199                   (fill class-id->ordinal nil :start old-size :end new-size)
     200                   (fill metaclass-id->ordinal nil
     201                         :start old-size :end new-size))
    195202             (setq class-table-size new-size))))
    196203    (flet ((assign-next-class-id ()
     
    251258                     (setf (svref m id) meta
    252259                           (svref msv id)
    253                            (make-objc-metaclass-slots-vector meta))
     260                           (make-objc-metaclass-slots-vector meta)
     261                           (svref metaclass-id->ordinal id)
     262                           (%next-class-ordinal))
    254263                     id))))
    255264        (defun register-objc-class (class)
     
    266275                        (make-objc-class-slots-vector class)
    267276                        (svref class-id->metaclass-id id)
    268                         (install-objc-metaclass meta))
     277                        (install-objc-metaclass meta)
     278                        (svref class-id->ordinal id) (%next-class-ordinal))
    269279                  id)))))
    270280      (defun objc-class-id (class)
     
    278288      (defun objc-class-id->objc-metaclass (class-id)
    279289        (svref m (svref class-id->metaclass-id class-id)))
     290      (defun objc-class-id->ordinal (i)
     291        (svref class-id->ordinal i))
     292      (defun (setf objc-class-id->ordinal) (new i)
     293        (setf (svref class-id->ordinal i) new))
     294      (defun objc-metaclass-id->ordinal (m)
     295        (svref metaclass-id->ordinal m))
     296      (defun (setf objc-metaclass-id->ordinal) (new m)
     297        (setf (svref class-id->ordinal m) new))
    280298      (defun objc-class-map () objc-class-map)
    281299      (defun %objc-class-count () next-objc-class-id)
Note: See TracChangeset for help on using the changeset viewer.