Changeset 6221


Ignore:
Timestamp:
Apr 8, 2007, 4:57:47 AM (13 years ago)
Author:
gb
Message:

Slight changes (preserve typedef name) in function/objc method arglists.
UNESCAPE-FOREIGN-NAME: handle missing brackets.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/lib/db-io.lisp

    r5959 r6221  
    567567                          (setf (schar name k)
    568568                                (schar string (incf i))))
     569                        (setq name (escape-foreign-name name))
    569570                        (if (eql ch #\r)
    570                           `(:struct ,(escape-foreign-name name))
     571                          `(:struct ,name)
    571572                          (if (eql ch #\u)
    572                             `(:union ,(escape-foreign-name name))
     573                            `(:union ,name)
    573574                            name)))
    574575                      (cdr (assoc ch *arg-spec-encoding*)))))
     
    894895                 (arg-type ()))
    895896            (multiple-value-setq (class-name p) (%decode-name buf p t))
    896             (multiple-value-setq (result-type p) (%decode-type buf p ftd))
     897            (multiple-value-setq (result-type p) (%decode-type buf p ftd t))
    897898            (dotimes (i nargs)
    898               (multiple-value-setq (arg-type p) (%decode-type buf p ftd))
     899              (multiple-value-setq (arg-type p) (%decode-type buf p ftd t))
    899900              (push arg-type arg-types))
    900901            (unless (dolist (m (objc-message-info-methods info))
     
    12361237      (break "Type spec = ~s" spec))))
    12371238
    1238 (defun encode-ffi-arg-type (spec &optional return-value-p)
     1239(defun encode-ffi-arg-type (spec)
    12391240  (case (car spec)
    12401241    (:primitive
     
    12811282           ,@(encode-name (ffi-struct-reference (cadr spec)))))
    12821283    (:typedef
    1283      (let* ((typedef (cadr spec))
    1284             (type (ffi-typedef-type typedef)))
    1285        (if (or return-value-p
    1286                (not (member (car type) '(:struct :union)))
    1287                #+eabi-target t)
    1288          (encode-ffi-arg-type type)
    1289          `(#\t ,@(encode-name (ffi-typedef-name typedef))))))
     1284     `(#\t ,@(encode-name (ffi-typedef-name (cadr spec)))))
    12901285    (:pointer
    12911286      `(#\a))
     
    13091304    `(,min-args
    13101305      ,@(encode-name name t)            ; verbatim
    1311       ,@(encode-ffi-arg-type result t)
     1306      ,@(encode-ffi-arg-type result)
    13121307      ,@(encode-ffi-arg-list args))))
    13131308
     
    14401435                   (string-downcase key)
    14411436                   (string key)))
    1442          (nbrackets (count #\< string)))
    1443     (declare (fixnum nbrackets))
     1437         (nleftbrackets (count #\< string))
     1438         (nrightbrackets (count #\> string))
     1439         (nbrackets (+ nleftbrackets nrightbrackets)))
     1440    (declare (fixnum nleftbrackets nrightbrackets nbrackets))
    14441441    (if (zerop nbrackets)
    14451442      string
    1446       (let* ((len (length string))
    1447              (out (make-string (- len (* 2 nbrackets))))
    1448              (j 0)
    1449              (state :lower))
    1450         (dotimes (i len out)
    1451           (let* ((ch (schar string i)))
    1452             (if (or (and (eq ch #\<)
    1453                          (eq state :upper))
    1454                     (and (eq ch #\>)
    1455                          (eq state :lower)))
    1456               (error "Mismatched brackets in ~s." key))
    1457             (case ch
    1458               (#\< (setq state :upper))
    1459               (#\> (setq state :lower))
    1460               (t (setf (schar out j) (if (eq state :upper)
    1461                                        (char-upcase ch)
    1462                                        (char-downcase ch))
    1463                        j (1+ j))))))))))
     1443      (if (/= nleftbrackets nrightbrackets)
     1444        (error "Mismatched brackets in ~s." key)
     1445        (let* ((len (length string))
     1446               (out (make-string (- len nbrackets)))
     1447               (j 0)
     1448               (state :lower))
     1449          (dotimes (i len out)
     1450            (let* ((ch (schar string i)))
     1451              (if (or (and (eq ch #\<)
     1452                           (eq state :upper))
     1453                      (and (eq ch #\>)
     1454                           (eq state :lower)))
     1455                (error "Mismatched brackets in ~s." key))
     1456              (case ch
     1457                (#\< (setq state :upper))
     1458                (#\> (setq state :lower))
     1459                (t (setf (schar out j) (if (eq state :upper)
     1460                                         (char-upcase ch)
     1461                                         (char-downcase ch))
     1462                         j (1+ j)))))))))))
    14641463
    14651464       
     
    15001499 
    15011500;; Should return a FOREIGN-TYPE structure.
    1502 (defun %decode-type (buf p ftd)
     1501(defun %decode-type (buf p ftd &optional suppress-typedef-expansion)
    15031502  (declare (type macptr buf) (fixnum p))
    15041503  (let* ((q (1+ p)))
     
    15311530                                             encoded-type-void)
    15321531                                      (values nil (1+ q))
    1533                                       (%decode-type buf q ftd))
     1532                                      (%decode-type buf q ftd suppress-typedef-expansion))
    15341533                                (values (make-foreign-pointer-type
    15351534                                         :to target
     
    15511550                     qqq)))))
    15521551      (#.encoded-type-named-type-ref
    1553        (multiple-value-bind (name qq) (%decode-name buf q)
    1554          (values (%parse-foreign-type name) qq)))
     1552       (multiple-value-bind (name qq) (%decode-name buf q)         
     1553         (values (if suppress-typedef-expansion
     1554                   name
     1555                   (%parse-foreign-type name))
     1556                 qq)))
    15551557      (#.encoded-type-named-struct-ref
    15561558       (multiple-value-bind (name qq) (%decode-name buf q)
     
    17251727      (let* ((r (%load-foreign-record (db-records d) name ftd already)))
    17261728        (when r (return r))))))
     1729
     1730
Note: See TracChangeset for help on using the changeset viewer.