source: trunk/source/level-1/x86-callback-support.lisp @ 12763

Last change on this file since 12763 was 11590, checked in by rme, 11 years ago

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.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
Line 
1;;;
2;;;   Copyright (C) 2005-2006 Clozure Associates and contributors
3;;;   This file is part of OpenMCL. 
4;;;
5;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
6;;;   License , known as the LLGPL and distributed with OpenMCL as the
7;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
9;;;   conflict, the preamble takes precedence. 
10;;;
11;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
12;;;
13;;;   The LLGPL is also available online at
14;;;   http://opensource.franz.com/preamble.html
15
16
17(in-package "CCL")
18
19
20#+x8664-target 
21(defun make-callback-trampoline (index &optional info)
22  (declare (ignore info))
23  (let* ((p (%allocate-callback-pointer 16))
24         (addr #.(subprim-name->offset '.SPcallback)))
25    (setf (%get-unsigned-byte p 0) #x41 ; movl $n,%r11d
26          (%get-unsigned-byte p 1) #xc7
27          (%get-unsigned-byte p 2) #xc3
28          (%get-unsigned-byte p 3) (ldb (byte 8 0) index)
29          (%get-unsigned-byte p 4) (ldb (byte 8 8) index)
30          (%get-unsigned-byte p 5) (ldb (byte 8 16) index)
31          (%get-unsigned-byte p 6) (ldb (byte 8 24) index)
32          (%get-unsigned-byte p 7) #xff  ; jmp *
33          (%get-unsigned-byte p 8) #x24
34          (%get-unsigned-byte p 9) #x25
35          (%get-unsigned-byte p 10) (ldb (byte 8 0) addr)
36          (%get-unsigned-byte p 11) (ldb (byte 8 8) addr)
37          (%get-unsigned-byte p 12) (ldb (byte 8 16) addr)
38          (%get-unsigned-byte p 13) (ldb (byte 8 24) addr))
39    p))
40         
41#+x8632-target         
42(defun make-callback-trampoline (index &optional info)
43  (let* ((p (%allocate-callback-pointer 12))
44         (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))
63    (setf (%get-unsigned-byte p 0) #xb8 ; movl $n,%eax
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)
68          (%get-unsigned-byte p 5) #xff  ; jmp *
69          (%get-unsigned-byte p 6) #x24
70          (%get-unsigned-byte p 7) #x25
71          (%get-unsigned-byte p 8) (ldb (byte 8 0) addr)
72          (%get-unsigned-byte p 9) (ldb (byte 8 8) addr)
73          (%get-unsigned-byte p 10) (ldb (byte 8 16) addr)
74          (%get-unsigned-byte p 11) (ldb (byte 8 24) addr))
75    p))
76 
Note: See TracBrowser for help on using the repository browser.