Changeset 7301


Ignore:
Timestamp:
Sep 26, 2007, 3:46:59 AM (12 years ago)
Author:
gb
Message:

Try to be more paranoid about null pointers (even if they have their
type asserted.)

ENCODE-OBJC-TYPE: try to get record field types right (being careful
about recursion); need to do this to help NSInvocation deal with
record types on some platforms that'll remain nameless.

Location:
trunk/ccl
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-1/l1-clos-boot.lisp

    r6935 r7301  
    19921992  (defun %ordinal-type-class-for-macptr (p)
    19931993    (with-lock-grabbed (ordinal-type-class-alist-lock)
    1994       (or (cdr (assoc (%macptr-type p) ordinal-type-class-alist :key #'foreign-type-ordinal))
     1994      (or (unless (%null-ptr-p p)
     1995            (cdr (assoc (%macptr-type p) ordinal-type-class-alist :key #'foreign-type-ordinal)))
    19951996          *macptr-class*)))
    19961997                 
  • trunk/ccl/objc-bridge/bridge.lisp

    r6856 r7301  
    209209(defmethod print-object ((a ns::aedesc) stream)
    210210  (print-unreadable-object (a stream :type t :identity (%gcable-ptr-p a))
    211     (format stream "~s ~s"
    212             (ns::aedesc-descriptor-type a)
    213             (ns::aedesc-data-handle a))
     211    (unless (%null-ptr-p a)
     212      (format stream "~s ~s"
     213              (ns::aedesc-descriptor-type a)
     214              (ns::aedesc-data-handle a)))
    214215    (describe-macptr-allocation-and-address a stream)))
    215216
     
    304305(defmethod print-object ((d ns::ns-decimal) stream)
    305306  (print-unreadable-object (d stream :type t :identity t)
    306     (format stream "exponent = ~d, length = ~s, is-negative = ~s, is-compact = ~s, mantissa = ~s" (ns::ns-decimal-exponent d) (ns::ns-decimal-length d) (ns::ns-decimal-is-negative d) (ns::ns-decimal-is-compact d) (ns::ns-decimal-mantissa d))
     307    (unless (%null-ptr-p d)
     308      (format stream "exponent = ~d, length = ~s, is-negative = ~s, is-compact = ~s, mantissa = ~s" (ns::ns-decimal-exponent d) (ns::ns-decimal-length d) (ns::ns-decimal-is-negative d) (ns::ns-decimal-is-compact d) (ns::ns-decimal-mantissa d)))
    307309    (describe-macptr-allocation-and-address d stream)))
    308310
     
    321323(defmethod print-object ((r ns::ns-rect) stream)
    322324  (print-unreadable-object (r stream :type t :identity t)
    323     (flet ((maybe-round (x)
    324              (multiple-value-bind (q r) (round x)
    325                (if (zerop r) q x))))
    326       (format stream "~s X ~s @ ~s,~s"
    327               (maybe-round (ns::ns-rect-width r))
    328               (maybe-round (ns::ns-rect-height r))
    329               (maybe-round (ns::ns-rect-x r))
    330               (maybe-round (ns::ns-rect-y r)))
    331       (describe-macptr-allocation-and-address r stream))))
     325    (unless (%null-ptr-p r)
     326      (flet ((maybe-round (x)
     327               (multiple-value-bind (q r) (round x)
     328                 (if (zerop r) q x))))
     329        (format stream "~s X ~s @ ~s,~s"
     330                (maybe-round (ns::ns-rect-width r))
     331                (maybe-round (ns::ns-rect-height r))
     332                (maybe-round (ns::ns-rect-x r))
     333                (maybe-round (ns::ns-rect-y r)))
     334        (describe-macptr-allocation-and-address r stream)))))
    332335
    333336
     
    343346           (multiple-value-bind (q r) (round x)
    344347             (if (zerop r) q x))))
    345     (print-unreadable-object (s stream :type t :identity t)
    346       (format stream "~s X ~s"
    347               (maybe-round (ns::ns-size-width s))
    348               (maybe-round (ns::ns-size-height s)))
    349       (describe-macptr-allocation-and-address s stream))))
     348    (unless (%null-ptr-p s)
     349      (print-unreadable-object (s stream :type t :identity t)
     350        (format stream "~s X ~s"
     351                (maybe-round (ns::ns-size-width s))
     352                (maybe-round (ns::ns-size-height s)))))
     353    (describe-macptr-allocation-and-address s stream)))
    350354
    351355
     
    360364             (if (zerop r) q x))))
    361365    (print-unreadable-object (p stream :type t :identity t)
    362       (format stream "~s,~s"
    363               (maybe-round (ns::ns-point-x p))
    364               (maybe-round (ns::ns-point-y p)))
     366      (unless (%null-ptr-p p)
     367        (format stream "~s,~s"
     368                (maybe-round (ns::ns-point-x p))
     369                (maybe-round (ns::ns-point-y p))))
    365370      (describe-macptr-allocation-and-address p stream))))
    366371
     
    373378(defmethod print-object ((r ns::ns-range) stream)
    374379  (print-unreadable-object (r stream :type t :identity t)
    375     (format stream "~s/~s"
    376             (ns::ns-range-location r)
    377             (ns::ns-range-length r))
     380    (unless (%null-ptr-p r)
     381      (format stream "~s/~s"
     382              (ns::ns-range-location r)
     383              (ns::ns-range-length r)))
    378384    (describe-macptr-allocation-and-address r stream)))
    379385
  • trunk/ccl/objc-bridge/objc-clos.lisp

    r6856 r7301  
    536536           (values #'(lambda (ptr offset)
    537537                       (let* ((p (%null-ptr)))
    538                          (%set-macptr-domain p 1)
    539                          (%set-macptr-type p to-ordinal)
    540                          (%setf-macptr p (%get-ptr ptr offset))))
     538                         (%setf-macptr p (%get-ptr ptr offset))
     539                         (unless (%null-ptr-p p)
     540                           (%set-macptr-domain p 1)
     541                           (%set-macptr-type p to-ordinal))
     542                         p))
    541543                   #'%set-ptr))))
    542544      (foreign-mem-block-type
  • trunk/ccl/objc-bridge/objc-runtime.lisp

    r6976 r7301  
    18781878(defvar *objc-char-type* (parse-foreign-type :char))
    18791879
    1880 (defun encode-objc-type (type &optional for-ivar)
     1880
     1881(defun encode-objc-type (type &optional for-ivar recursive)
    18811882  (if (or (eq type *objc-id-type*)
    18821883          (foreign-type-= type *objc-id-type*))
     
    18931894                     (foreign-type-= target *objc-char-type*))
    18941895               "*"
    1895                (format nil "^~a" (encode-objc-type target)))))
     1896               (format nil "^~a" (encode-objc-type target nil t)))))
    18961897          (foreign-double-float-type "d")
    18971898          (foreign-single-float-type "f")
     
    19221923                                        (format s "\"~a\""
    19231924                                                (unescape-foreign-name
    1924                                                  (or (foreign-record-field-name f) "")))
    1925                                         (format s "~a" (encode-objc-type
    1926                                                         (foreign-record-field-type f))))))))
    1927           (foreign-array-type
     1925                                                 (or (foreign-record-field-name f) ""))))
     1926                                      (unless recursive
     1927                                        (format s "~a" (encode-objc-type
     1928                                                        (foreign-record-field-type f) nil nil)))))))
     1929        (foreign-array-type
    19281930           (ensure-foreign-type-bits type)
    19291931           (let* ((dims (foreign-array-type-dimensions type))
     
    19311933             (if dims (format nil "[~d~a]"
    19321934                              (car dims)
    1933                               (encode-objc-type element-type))
     1935                              (encode-objc-type element-type nil t))
    19341936               (if (or (eq element-type *objc-char-type*)
    19351937                       (foreign-type-= element-type *objc-char-type*))
    19361938                 "*"
    1937                  (format nil "^~a" (encode-objc-type element-type))))))
     1939                 (format nil "^~a" (encode-objc-type element-type nil t))))))
    19381940          (t (break "type = ~s" type)))))))
    19391941
Note: See TracChangeset for help on using the changeset viewer.