Changeset 11590 for trunk/source/level-1


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/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • 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
Note: See TracChangeset for help on using the changeset viewer.