Changeset 868


Ignore:
Timestamp:
Aug 30, 2004, 9:59:22 PM (16 years ago)
Author:
gb
Message:

Assert that SELF is an instance in instance method (should also assert
that :ID-typed parameters are instances/classes.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/examples/objc-runtime.lisp

    r852 r868  
    12391239(defun %objc-instance-class-index (p)
    12401240  #+apple-objc
    1241   (if (or (pointer-in-cfstring-section-p p)
    1242           (with-macptrs ((zone (#_malloc_zone_from_ptr p)))
    1243             (not (%null-ptr-p zone))))
     1241  (if (or (with-macptrs ((zone (#_malloc_zone_from_ptr p)))
     1242            (not (%null-ptr-p zone)))
     1243          (pointer-in-cfstring-section-p p))
    12441244    (with-macptrs ((parent (pref p :objc_object.isa)))
    12451245      (objc-class-id parent)))
    12461246  #+gnu-objc
    1247   (with-macptrs ((parent (pref p objc_object.class_pointer)))
     1247  (with-macptrs ((parent (pref p :objc_object.class_pointer)))
    12481248    (objc-class-id-parent))
    12491249  )
     
    15021502                        struct-return)
    15031503      (parse-objc-method selector-arg class-arg body)
     1504    (let* ((self (intern "SELF")))
    15041505      (multiple-value-bind (body decls) (parse-body body env)
     1506        (unless class-p
     1507          (push `(%set-objc-instance-type ,self) body))
    15051508        (setq body (coerce-foreign-boolean-args argspecs body))
    15061509        (if (eq resulttype :<BOOL>)
     
    15101513                                        class-name
    15111514                                        selector-name)))
    1512                (self (intern "SELF"))
    15131515               (_cmd (intern "_CMD"))
    15141516               (super (gensym "SUPER"))
     
    15201522          `(progn
    15211523            (defcallback ,impname
    1522                     (:without-interrupts nil
    1523                                         #+(and openmcl-native-threads apple-objc) :error-return
    1524                                         #+(and openmcl-native-threads apple-objc)  (condition objc-callback-error-return) ,@params ,resulttype)
    1525                   (declare (ignorable ,_cmd))
    1526                   ,@decls
    1527                   (rlet ((,super :objc_super
    1528                            #+apple-objc :receiver #+gnu-objc :self ,self
    1529                            :class
    1530                            ,@(if class-p
    1531                                 `((pref
    1532                                     (pref (@class ,class-name)
    1533                                      #+apple-objc :objc_class.isa
    1534                                      #+gnu-objc :objc_class.super_class )
    1535                                     :objc_class.super_class))
    1536                                 `((pref (@class ,class-name) :objc_class.super_class)))))
    1537                     (macrolet ((send-super (msg &rest args &environment env)
    1538                                 (make-optimized-send nil msg args env nil ',super ,class-name))
    1539                                (send-super/stret (s msg &rest args &environment env)
    1540                                 (make-optimized-send nil msg args env s ',super ,class-name)))
    1541                       (flet ((%send-super (msg &rest args)
    1542                                (make-general-send nil msg args nil ,super ,class-name))
    1543                              (%send-super/stret (s msg &rest args)
    1544                                (make-general-send nil msg args s ,super ,class-name))
    1545                              (super () ,super))
    1546                         ,@body))))
     1524                (:without-interrupts nil
     1525                #+(and openmcl-native-threads apple-objc) :error-return
     1526                #+(and openmcl-native-threads apple-objc)  (condition objc-callback-error-return) ,@params ,resulttype)
     1527              (declare (ignorable ,_cmd))
     1528              ,@decls
     1529              (rlet ((,super :objc_super
     1530                       #+apple-objc :receiver #+gnu-objc :self ,self
     1531                       :class
     1532                       ,@(if class-p
     1533                            `((pref
     1534                                (pref (@class ,class-name)
     1535                                 #+apple-objc :objc_class.isa
     1536                                 #+gnu-objc :objc_class.super_class )
     1537                                :objc_class.super_class))
     1538                            `((pref (@class ,class-name) :objc_class.super_class)))))
     1539                (macrolet ((send-super (msg &rest args &environment env)
     1540                            (make-optimized-send nil msg args env nil ',super ,class-name))
     1541                           (send-super/stret (s msg &rest args &environment env)
     1542                            (make-optimized-send nil msg args env s ',super ,class-name)))
     1543                  (flet ((%send-super (msg &rest args)
     1544                           (make-general-send nil msg args nil ,super ,class-name))
     1545                         (%send-super/stret (s msg &rest args)
     1546                           (make-general-send nil msg args s ,super ,class-name))
     1547                         (super () ,super))
     1548                    ,@body))))
    15471549            (%define-lisp-objc-method
    15481550             ',impname
     
    15511553             ,typestring
    15521554             ,impname
    1553              ,class-p))))))
     1555             ,class-p)))))))
    15541556
    15551557(defmacro define-objc-method ((selector-arg class-arg)
Note: See TracChangeset for help on using the changeset viewer.