Changeset 12455


Ignore:
Timestamp:
Jul 26, 2009, 9:49:18 AM (10 years ago)
Author:
gb
Message:

In (SETF CLASS-DIRECT-SLOTS) :BEFORE method on OBJC:OBJC-CLASS:
check that #_class_addIvar succeeds to avoid obscure errors that
occur if it doesn't (it's not yet implemented in Cocotron.)

File:
1 edited

Legend:

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

    r12438 r12455  
    423423        (with-cstrs ((name string)
    424424                     (encoding encoding))
    425           (#_class_addIvar class name size align encoding)
     425          (when (eql #$NO (#_class_addIvar class name size align encoding))
     426            (error "class_addIvar failed"))
    426427          (with-macptrs ((ivar (#_class_getInstanceVariable class name)))
    427               (unless (%null-ptr-p ivar)
    428                 (let* ((offset (#_ivar_getOffset ivar)))
    429                   (setf (foreign-direct-slot-definition-bit-offset dslotd)
    430                         (ash offset 3))))))))))
     428            (unless (%null-ptr-p ivar)
     429              (let* ((offset (#_ivar_getOffset ivar)))
     430                (setf (foreign-direct-slot-definition-bit-offset dslotd)
     431                      (ash offset 3))))))))))
    431432
    432433
     
    458459;;; each foreign direct slotd's offset field should already have been
    459460;;; set to the slot's bit offset.
    460 #-apple-objc-2.0
     461#-(or apple-objc-2.0 cocotron-objc)
    461462(defun %make-objc-ivars (class)
    462463  (let* ((start-offset (superclass-instance-size class))
     
    544545              (signed (foreign-integer-type-signed ftype)))
    545546         (if (= bits align)
    546            (ecase bits
     547           (case bits
    547548             (1 (values #'%get-bit #'%set-bit))
    548549             (8 (values (if signed #'%get-signed-byte #'%get-unsigned-byte)
     
    554555             (64 (if signed
    555556                   (values #'%%get-signed-longlong #'%%set-signed-longlong)
    556                    (values #'%%get-unsigned-longlong #'%%set-unsigned-longlong))))
     557                   (values #'%%get-unsigned-longlong #'%%set-unsigned-longlong)))
     558             (t (values #'(lambda (ptr offset)
     559                       (%get-bitfield ptr offset bits))
     560                   #'(lambda (ptr offset new)
     561                       (setf (%get-bitfield ptr offset bits) new)))))
    557562           (values #'(lambda (ptr offset)
    558563                       (%get-bitfield ptr offset bits))
Note: See TracChangeset for help on using the changeset viewer.