Changeset 11346


Ignore:
Timestamp:
Nov 10, 2008, 10:09:39 PM (11 years ago)
Author:
rme
Message:

x86-darwin32::expand-ff-call: Try to deal with returning small
structures by value. See ticket:366.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/ffi-darwinx8632.lisp

    r10798 r11346  
    1414      (not (member nbits '(8 16 32 64))))))
    1515
    16 (defun x86-darwin32::struct-from-regbuf-values (r rtype regbuf)
    17   (ecase (ensure-foreign-type-bits rtype)
    18     (8 `(setf (%get-unsigned-byte ,r 0) (%get-unsigned-byte ,regbuf 0)))
    19     (16 `(setf (%get-unsigned-word ,r 0) (%get-unsigned-word ,regbuf 0)))
    20     (32 `(setf (%get-unsigned-long ,r 0) (%get-unsigned-long ,regbuf 0)))
    21     (64 `(setf (%%get-unsigned-longlong ,r 0)
    22                (%%get-unsigned-longlong ,regbuf 0)))))
    23 
    2416;;; All arguments are passed on the stack.
    2517;;;
     
    2820(defun x86-darwin32::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result))
    2921  (let* ((result-type-spec (or (car (last args)) :void))
    30          (regbuf nil)
     22         (result-in-registers-p nil)
    3123         (result-temp nil)
    32          (result-form nil)
    33          (struct-result-type nil))
     24         (result-form nil))
    3425    (multiple-value-bind (result-type error)
    3526        (ignore-errors (parse-foreign-type result-type-spec))
     
    3829        (setq args (butlast args)))
    3930      (collect ((argforms))
    40         (when (eq (car args) :monitor-exception-ports)
    41           (argforms (pop args)))
    4231        (when (typep result-type 'foreign-record-type)
    43           (setq result-form (pop args)
    44                 struct-result-type result-type
    45                 result-type *void-foreign-type*
    46                 result-type-spec :void)
    47           (if (x86-darwin32::record-type-returns-structure-as-first-arg result-type)
     32          (setq result-form (pop args))
     33          (if (x86-darwin32::record-type-returns-structure-as-first-arg
     34               result-type)
    4835            (progn
     36              (setq result-type *void-foreign-type*
     37                    result-type-spec :void)
    4938              (argforms :address)
    5039              (argforms result-form))
    5140            (progn
    52               (setq regbuf (gensym)
    53                     result-temp (gensym))
    54               (argforms :registers)
    55               (argforms regbuf))))
     41              ;; We're going to get either 32 bits in EAX, or
     42              ;; 64 bits in EDX:EAX.
     43              (setq result-type (parse-foreign-type :signed-doubleword)
     44                    result-type-spec :signed-doubleword)
     45              (setq result-temp (gensym))
     46              (setq result-in-registers-p t))))
    5647        (unless (evenp (length args))
    5748          (error "~s should be an even-length list of alternating foreign types and values" args))
     
    7566          (argforms (foreign-type-to-representation-type result-type))
    7667          (let* ((call (funcall result-coerce result-type-spec `(,@callform ,@(argforms)))))
    77             (if regbuf
     68            (if result-in-registers-p
    7869              `(let* ((,result-temp (%null-ptr)))
    7970                 (declare (dynamic-extent ,result-temp)
    8071                          (type macptr ,result-temp))
    8172                 (%setf-macptr ,result-temp ,result-form)
    82                  (%stack-block ((,regbuf 8))
    83                    ,call
    84                    ,(x86-darwin32::struct-from-regbuf-values result-temp struct-result-type regbuf)))
     73                 (setf (%%get-signed-longlong ,result-temp 0)
     74                       ,call))
    8575              call))))))
    8676
Note: See TracChangeset for help on using the changeset viewer.