1 /* -----------------------------------------------------------------------------
2 * Foreign export adjustor thunks
6 * ---------------------------------------------------------------------------*/
8 /* A little bit of background...
10 An adjustor thunk is a dynamically allocated code snippet that allows
11 Haskell closures to be viewed as C function pointers.
13 Stable pointers provide a way for the outside world to get access to,
14 and evaluate, Haskell heap objects, with the RTS providing a small
15 range of ops for doing so. So, assuming we've got a stable pointer in
16 our hand in C, we can jump into the Haskell world and evaluate a callback
17 procedure, say. This works OK in some cases where callbacks are used, but
18 does require the external code to know about stable pointers and how to deal
19 with them. We'd like to hide the Haskell-nature of a callback and have it
20 be invoked just like any other C function pointer.
22 Enter adjustor thunks. An adjustor thunk is a little piece of code
23 that's generated on-the-fly (one per Haskell closure being exported)
24 that, when entered using some 'universal' calling convention (e.g., the
25 C calling convention on platform X), pushes an implicit stable pointer
26 (to the Haskell callback) before calling another (static) C function stub
27 which takes care of entering the Haskell code via its stable pointer.
29 An adjustor thunk is allocated on the C heap, and is called from within
30 Haskell just before handing out the function pointer to the Haskell (IO)
31 action. User code should never have to invoke it explicitly.
33 An adjustor thunk differs from a C function pointer in one respect: when
34 the code is through with it, it has to be freed in order to release Haskell
35 and C resources. Failure to do so result in memory leaks on both the C and
43 /* Heavily arch-specific, I'm afraid.. */
44 #if defined(i386_TARGET_ARCH)
46 /* Now here's something obscure for you:
48 When generating an adjustor thunk that uses the C calling
49 convention, we have to make sure that the thunk kicks off
50 the process of jumping into Haskell with a tail jump. Why?
51 Because as a result of jumping in into Haskell we may end
52 up freeing the very adjustor thunk we came from using
53 freeHaskellFunctionPtr(). Hence, we better not return to
54 the adjustor code on our way out, since it could by then
57 The fix is readily at hand, just include the opcodes
58 for the C stack fixup code that we need to perform when
59 returning in some static piece of memory and arrange
60 to return to it before tail jumping from the adjustor thunk.
62 For this to work we make the assumption that bytes in .data
63 are considered executable.
65 static unsigned char __obscure_ccall_ret_code [] =
66 { 0x83, 0xc4, 0x04 /* addl $0x4, %esp */
71 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
74 unsigned char* adj_code;
75 size_t sizeof_adjustor;
77 if (cconv == 0) { /* the adjustor will be _stdcall'ed */
79 /* Magic constant computed by inspecting the code length of
80 the following assembly language snippet
81 (offset and machine code prefixed):
83 <0>: 58 popl %eax # temp. remove ret addr..
84 <1>: 68 fd fc fe fa pushl 0xfafefcfd # constant is large enough to
86 <6>: 50 pushl %eax # put back ret. addr
87 <7>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
88 <c>: ff e0 jmp %eax # and jump to it.
89 # the callee cleans up the stack
91 sizeof_adjustor = 14*sizeof(char);
93 if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
97 adj_code = (unsigned char*)adjustor;
98 adj_code[0x00] = (unsigned char)0x58; /* popl %eax */
100 adj_code[0x01] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
101 *((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
103 adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
105 adj_code[0x07] = (unsigned char)0xb8; /* movl $wptr, %eax */
106 *((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
108 adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
109 adj_code[0x0d] = (unsigned char)0xe0;
112 } else { /* the adjustor will be _ccall'ed */
114 /* Magic constant computed by inspecting the code length of
115 the following assembly language snippet
116 (offset and machine code prefixed):
118 <00>: 68 ef be ad de pushl $0xdeadbeef # constant is large enough to
119 # hold a StgStablePtr
120 <05>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
121 <0a>: 68 ef be ad de pushl $__obscure_ccall_ret_code # push the return address
122 <0f>: ff e0 jmp *%eax # jump to wptr
124 The ccall'ing version is a tad different, passing in the return
125 address of the caller to the auto-generated C stub (which enters
126 via the stable pointer.) (The auto-generated C stub is in on this
127 game, don't worry :-)
129 See the comment next to __obscure_ccall_ret_code why we need to
130 perform a tail jump instead of a call, followed by some C stack
133 Note: The adjustor makes the assumption that any return value
134 coming back from the C stub is not stored on the stack.
135 That's (thankfully) the case here with the restricted set of
136 return types that we support.
140 sizeof_adjustor = 17*sizeof(char);
142 if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
146 adj_code = (unsigned char*)adjustor;
148 adj_code[0x00] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
149 *((StgStablePtr*)(adj_code+0x01)) = (StgStablePtr)hptr;
151 adj_code[0x05] = (unsigned char)0xb8; /* movl $wptr, %eax */
152 *((StgFunPtr*)(adj_code + 0x06)) = (StgFunPtr)wptr;
154 adj_code[0x0a] = (unsigned char)0x68; /* pushl __obscure_ccall_ret_code */
155 *((StgFunPtr*)(adj_code + 0x0b)) = (StgFunPtr)__obscure_ccall_ret_code;
157 adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
158 adj_code[0x10] = (unsigned char)0xe0;
163 return ((void*)adjustor);
167 freeHaskellFunctionPtr(void* ptr)
169 if ( *(unsigned char*)ptr != 0x68 &&
170 *(unsigned char*)ptr != 0x58 ) {
171 fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
175 /* Free the stable pointer first..*/
176 if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
177 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
179 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
181 *((unsigned char*)ptr) = '\0';
186 #endif /* i386_TARGET_ARCH */