Changeset 11590


Ignore:
Timestamp:
Jan 6, 2009, 6:00:06 PM (11 years ago)
Author:
rme
Message:

Additional x8632 FFI details involving structure return and callbacks.

DEFINE-CALLBACK: add hair to recognize when a hidden first argument
will need to be discarded on return. Try to deal with interactions
with the win32 _stdcall case, too. Pass info argument to
DEFINE-CALLBACK-FUNCTION that encodes the arg discard information.

DEFINE-CALLBACK-FUNCTION: pass said info argument to
MAKE-CALLBACK-TRAMPOLINE.

MAKE-CALLBACK-TRAMPOLINE: pack arg discarding information and the
callback index into the value that gets passed to .SPcallback via
the %eax register.

.SPcallback: decode this information, and handle discarding the
appropriate number of args on return.

Location:
trunk/source
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/X8632/x8632-backend.lisp

    r11552 r11590  
    285285(pushnew *x8632-backend* *known-backends* :key #'backend-name)
    286286
    287 ;;; FFI stuff.  Most operating systems use the same vanilla i386 ABI.
    288 ;;; Darwin uses a variant that returns small (<= 64 bit) structures in
    289 ;;; registers.  (There are some other Darwin exceptions too, but they
    290 ;;; don't concern us here).
     287;;; FFI stuff.  The vanilla i386 ABI always returns structures as a
     288;;; hidden first argument.  Some systems (Darwin, FreeBSD) use a
     289;;; variant that returns small (<= 64 bit) structures in registers.
    291290
    292291;;; A returned structure is passed as a hidden first argument.
     
    320319              (argforms result-form))
    321320            (progn
    322               ;; for Darwin
    323321              (ecase (foreign-type-bits result-type)
    324322                (8 (setq result-type-spec :unsigned-byte
     
    443441  (unless (eq return-type *void-foreign-type*)
    444442    (if (typep return-type 'foreign-record-type)
    445       ;; On non-Darwin systems, the result type would have been mapped
    446       ;; to :VOID.  On Darwin, small (<= 64 bits) structs are returned
    447       ;; by value.
     443      ;; If the struct result is returned via a hidden argument, the
     444      ;; return type would have been mapped to :VOID.  On some
     445      ;; systems, small (<= 64 bits) structs are returned by value,
     446      ;; which we arrange to retrieve here.
    448447      (ecase (ensure-foreign-type-bits return-type)
    449448        (8 `(setf (%get-unsigned-byte ,stack-ptr -8)
  • trunk/source/level-1/l1-callbacks.lisp

    r11186 r11590  
    2323
    2424;;; (defcallback ...) expands into a call to this function.
    25 (defun define-callback-function (lisp-function  &optional doc-string (without-interrupts t) (info 0) &aux name trampoline)
     25(defun define-callback-function (lisp-function  &optional doc-string (without-interrupts t) info &aux name trampoline)
    2626  (unless (functionp lisp-function)
    2727    (setq lisp-function (require-type lisp-function 'function)))
     
    5858                       (unless (%svref %pascal-functions% i)
    5959                         (return i)))))
    60           (setq trampoline (make-callback-trampoline index (or info 0)))
     60          (setq trampoline (make-callback-trampoline index info))
    6161          (setf (%svref %pascal-functions% index)
    6262                (%cons-pfe trampoline info lisp-function name without-interrupts)))))
  • trunk/source/level-1/x86-callback-support.lisp

    r11228 r11590  
    1919
    2020#+x8664-target 
    21 (defun make-callback-trampoline (index &optional discard-stack-bytes)
    22   (declare (ignore discard-stack-bytes))
     21(defun make-callback-trampoline (index &optional info)
     22  (declare (ignore info))
    2323  (let* ((p (%allocate-callback-pointer 16))
    2424         (addr #.(subprim-name->offset '.SPcallback)))
     
    4040         
    4141#+x8632-target         
    42 (defun make-callback-trampoline (index &optional (discard-stack-bytes 0))
     42(defun make-callback-trampoline (index &optional info)
    4343  (let* ((p (%allocate-callback-pointer 12))
    4444         (addr #.(subprim-name->offset '.SPcallback)))
     45    ;; If the optional info parameter is supplied, it will contain
     46    ;; some stuff in bits 23 through 31.
     47    ;;
     48    ;; If bit 23 is set, that indicates that the caller will pass a
     49    ;; "hidden" argument which is a pointer to appropriate storage for
     50    ;; holding a returned structure.  .SPcallback will have to discard
     51    ;; this extra argument upon return.
     52    ;;
     53    ;; The high 8 bits denote the number of words that .SPcallback
     54    ;; will have to discard upon return (used for _stdcall on
     55    ;; Windows).  Bit 23 won't be set in this case: we will have
     56    ;; already added in the extra word to discard if that's necessary.
     57    ;;
     58    ;; These bits are be packed into the value that .SPcallback
     59    ;; receives in %eax.  Bits 0 through 22 are the callback index.
     60    (if info
     61      (setf (ldb (byte 23 0) info) index)
     62      (setq info index))
    4563    (setf (%get-unsigned-byte p 0) #xb8 ; movl $n,%eax
    46           (%get-unsigned-byte p 1) (ldb (byte 8 0) index)
    47           (%get-unsigned-byte p 2) (ldb (byte 8 8) index)
    48           (%get-unsigned-byte p 3) (ldb (byte 8 16) index)
    49           (%get-unsigned-byte p 4) (ldb (byte 8 0) (ash (or discard-stack-bytes 0) (- x8632::word-shift)))
     64          (%get-unsigned-byte p 1) (ldb (byte 8 0) info)
     65          (%get-unsigned-byte p 2) (ldb (byte 8 8) info)
     66          (%get-unsigned-byte p 3) (ldb (byte 8 16) info)
     67          (%get-unsigned-byte p 4) (ldb (byte 8 24) info)
    5068          (%get-unsigned-byte p 5) #xff  ; jmp *
    5169          (%get-unsigned-byte p 6) #x24
  • trunk/source/lib/macros.lisp

    r11373 r11590  
    25412541         (result-type-spec :void)
    25422542         (args args)
    2543          (discard-stack-args nil)
     2543         (discard-stack-args nil)       ;only meaningful on win32
     2544         (discard-hidden-arg nil)       ;only meaningful on x8632
     2545         (info nil)
    25442546         (woi nil)
    25452547         (need-struct-arg)
     
    25512553             (rtype (ignore-errors (parse-foreign-type spec))))
    25522554        (setq need-struct-arg (typep rtype 'foreign-record-type))
     2555        (when need-struct-arg
     2556          (setq discard-hidden-arg
     2557                (funcall (ftd-ff-call-struct-return-by-implicit-arg-function
     2558                          *target-ftd*) rtype)))
    25532559        (if rtype
    25542560          (setq result-type-spec spec args (butlast args))))
     
    25712577          (funcall (ftd-callback-bindings-function *target-ftd*)
    25722578                   stack-ptr fp-args-ptr (arg-names) (arg-specs) result-type-spec struct-return-arg-name)
    2573         (unless num-arg-bytes (setq num-arg-bytes 0))
     2579        ;; x8632 hair
     2580        (when discard-hidden-arg
     2581          (if discard-stack-args
     2582            ;; We already have to discard some number of args, so just
     2583            ;; discard the extra hidden arg while we're at it.
     2584            (incf num-arg-bytes 4)
     2585            ;; Otherwise, indicate that we'll need to discard the
     2586            ;; hidden arg.
     2587            (setq info (ash 1 23))))
     2588        (when discard-stack-args
     2589          (setq info 0)
     2590          ;; put number of words to discard in high-order byte
     2591          (setf (ldb (byte 8 24) info)
     2592                (ash num-arg-bytes (- target::word-shift))))
    25742593        (multiple-value-bind (body decls doc) (parse-body body env t)
    25752594          `(progn
     
    25992618                ,doc
    26002619              ,woi
    2601               ,(if discard-stack-args num-arg-bytes 0))))))))
     2620              ,info)))))))
    26022621
    26032622
  • trunk/source/lisp-kernel/x86-spentry32.s

    r11449 r11590  
    42524252        /* arg word 0 at 8(%ebp), word 1 at 12(%ebp), etc. */
    42534253
     4254        /* %eax is passed to us via the callback trampoline.
     4255           bits 0-22: callback index
     4256           bit 23: flag, set if we need to discard hidden arg on return
     4257                   (ignored when upper 8 bits are non-zero)
     4258           bits 24-31: arg words to discard on return (_stdcall for win32) */
     4259       
    42544260        /* Reserve some space for results, relative to the
    42554261           current %ebp.  We may need quite a bit of it. */
    4256         __(subl $24,%esp)
     4262        __(subl $20,%esp)
    42574263        __(movl $0,-16(%ebp)) /* No FP result */
     4264        __(btl $23,%eax)      /* set CF if we need to discard hidden arg */
     4265        __(pushfl)            /* and save for later */
    42584266        __(movl %eax,%ecx)    /* extract args-discard count */
    42594267        __(shrl $24,%ecx)
    4260         __(andl $0x00ffffff,%eax)
     4268        __(andl $0x007fffff,%eax) /* callback index */
    42614269        __(movl %ecx,-12(%ebp))
    42624270        /* If the C stack is 16-byte aligned by convention,
     
    43284336        __(movl -8(%ebp),%eax)
    43294337        __(movl -4(%ebp),%edx)
    4330         __(leave)
    43314338        __ifdef([WIN_32])
    43324339         __(testl %ecx,%ecx)
    43334340         __(jne local_label(winapi_return))
    4334          __(repret)
    4335         __else
    4336          __(ret)
    4337         __endif
     4341        __endif
     4342        __(popfl)       /* flags from bt way back when */
     4343        __(jc local_label(discard_first_arg))
     4344        __(leave)
     4345        __(ret)
    433843461:      __(jne 2f)
    43394347        /* single float return in x87 */
    43404348        __(flds -8(%ebp))
    4341         __(leave)
    43424349        __ifdef([WIN_32])
    43434350         __(testl %ecx,%ecx)
    43444351         __(jne local_label(winapi_return))
    4345          __(repret)
    4346         __else
    4347          __(ret)
    43484352        __endif
     4353        __(leave)
     4354        __(ret)
    434943552:      /* double-float return in x87 */
    43504356        __(fldl -8(%ebp))
    4351         __(leave)
    43524357        __ifdef([WIN_32])
    43534358         __(testl %ecx,%ecx)
    43544359         __(jne local_label(winapi_return))
    4355          __(repret)
    4356         __else
    4357          __(ret)
    43584360        __endif
     4361        __(leave)
     4362        __(ret)
    43594363        __ifdef([WIN_32])
    4360 local_label(winapi_return):             
     4364local_label(winapi_return):
     4365          __(leave)
    43614366         /* %ecx is non-zero and contains count of arg words to pop */
    43624367          __(popl -4(%esp,%ecx,4))
     
    43644369          __(ret)
    43654370        __endif
     4371local_label(discard_first_arg):
     4372        __(leave)
     4373        __(ret $4)
    43664374_endsubp(callback)
    43674375
Note: See TracChangeset for help on using the changeset viewer.