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) || defined(sparc_TARGET_ARCH) || defined(alpha_TARGET_ARCH)
46 #if defined(i386_TARGET_ARCH)
47 /* Now here's something obscure for you:
49 When generating an adjustor thunk that uses the C calling
50 convention, we have to make sure that the thunk kicks off
51 the process of jumping into Haskell with a tail jump. Why?
52 Because as a result of jumping in into Haskell we may end
53 up freeing the very adjustor thunk we came from using
54 freeHaskellFunctionPtr(). Hence, we better not return to
55 the adjustor code on our way out, since it could by then
58 The fix is readily at hand, just include the opcodes
59 for the C stack fixup code that we need to perform when
60 returning in some static piece of memory and arrange
61 to return to it before tail jumping from the adjustor thunk.
63 For this to work we make the assumption that bytes in .data
64 are considered executable.
66 static unsigned char __obscure_ccall_ret_code [] =
67 { 0x83, 0xc4, 0x04 /* addl $0x4, %esp */
73 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
75 void *adjustor = NULL;
79 case 0: /* _stdcall */
80 #if defined(i386_TARGET_ARCH)
81 /* Magic constant computed by inspecting the code length of
82 the following assembly language snippet
83 (offset and machine code prefixed):
85 <0>: 58 popl %eax # temp. remove ret addr..
86 <1>: 68 fd fc fe fa pushl 0xfafefcfd # constant is large enough to
88 <6>: 50 pushl %eax # put back ret. addr
89 <7>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
90 <c>: ff e0 jmp %eax # and jump to it.
91 # the callee cleans up the stack
93 if ((adjustor = stgMallocBytes(14, "createAdjustor")) != NULL) {
94 unsigned char *const adj_code = (unsigned char *)adjustor;
95 adj_code[0x00] = (unsigned char)0x58; /* popl %eax */
97 adj_code[0x01] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
98 *((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
100 adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
102 adj_code[0x07] = (unsigned char)0xb8; /* movl $wptr, %eax */
103 *((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
105 adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
106 adj_code[0x0d] = (unsigned char)0xe0;
112 #if defined(i386_TARGET_ARCH)
113 /* Magic constant computed by inspecting the code length of
114 the following assembly language snippet
115 (offset and machine code prefixed):
117 <00>: 68 ef be ad de pushl $0xdeadbeef # constant is large enough to
118 # hold a StgStablePtr
119 <05>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
120 <0a>: 68 ef be ad de pushl $__obscure_ccall_ret_code # push the return address
121 <0f>: ff e0 jmp *%eax # jump to wptr
123 The ccall'ing version is a tad different, passing in the return
124 address of the caller to the auto-generated C stub (which enters
125 via the stable pointer.) (The auto-generated C stub is in on this
126 game, don't worry :-)
128 See the comment next to __obscure_ccall_ret_code why we need to
129 perform a tail jump instead of a call, followed by some C stack
132 Note: The adjustor makes the assumption that any return value
133 coming back from the C stub is not stored on the stack.
134 That's (thankfully) the case here with the restricted set of
135 return types that we support.
137 if ((adjustor = stgMallocBytes(17, "createAdjustor")) != NULL) {
138 unsigned char *const adj_code = (unsigned char *)adjustor;
140 adj_code[0x00] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
141 *((StgStablePtr*)(adj_code+0x01)) = (StgStablePtr)hptr;
143 adj_code[0x05] = (unsigned char)0xb8; /* movl $wptr, %eax */
144 *((StgFunPtr*)(adj_code + 0x06)) = (StgFunPtr)wptr;
146 adj_code[0x0a] = (unsigned char)0x68; /* pushl __obscure_ccall_ret_code */
147 *((StgFunPtr*)(adj_code + 0x0b)) = (StgFunPtr)__obscure_ccall_ret_code;
149 adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
150 adj_code[0x10] = (unsigned char)0xe0;
152 #elif defined(sparc_TARGET_ARCH)
153 /* Magic constant computed by inspecting the code length of
154 the following assembly language snippet
155 (offset and machine code prefixed):
157 <00>: 13 00 3f fb sethi %hi(0x00ffeffa), %o1 # load up wptr (1 of 2)
158 <04>: 11 37 ab 6f sethi %hi(0xdeadbeef), %o0 # load up hptr (1 of 2)
159 <08>: 81 c2 63 fa jmp %o1+%lo(0x00ffeffa) # jump to wptr (load 2 of 2)
160 <0c>: 90 12 22 ef or %o0, %lo(0xdeadbeef), %o0 # load up hptr (2 of 2)
162 <10>: de ad be ef # Place the value of the StgStablePtr somewhere readable
164 ccall'ing on a SPARC leaves little to be performed by the caller.
165 The callee shifts the window on entry and restores it on exit.
166 Input paramters and results are passed via registers. (%o0 in the
167 code above contains the input paramter to wptr.) The return address
168 is stored in %o7/%i7. Since we don't shift the window in this code,
169 the return address is preserved and wptr will return to our caller.
171 if ((adjustor = stgMallocBytes(28, "createAdjustor")) != NULL) {
172 unsigned char *const adj_code = (unsigned char *)adjustor;
174 /* sethi %hi(wptr), %o1 */
175 *((unsigned long*)(adj_code+0x00)) = (unsigned long)0x13000000;
176 *((unsigned long*)(adj_code+0x00)) |= ((unsigned long)wptr) >> 10;
178 /* sethi %hi(hptr), %o0 */
179 *((unsigned long*)(adj_code+0x04)) = (unsigned long)0x11000000;
180 *((unsigned long*)(adj_code+0x04)) |= ((unsigned long)hptr) >> 10;
182 /* jmp %o1+%lo(wptr) */
183 *((unsigned long*)(adj_code+0x08)) = (unsigned long)0x81c26000;
184 *((unsigned long*)(adj_code+0x08)) |= ((unsigned long)wptr) & 0x000003ff;
186 /* or %o0, %lo(hptr), %o0 */
187 *((unsigned long*)(adj_code+0x0c)) = (unsigned long)0x90122000;
188 *((unsigned long*)(adj_code+0x0c)) |= ((unsigned long)hptr) & 0x000003ff;
190 *((StgStablePtr*)(adj_code+0x10)) = (StgStablePtr)hptr;
192 #elif defined(alpha_TARGET_ARCH)
193 /* Magic constant computed by inspecting the code length of
194 the following assembly language snippet
195 (offset and machine code prefixed; note that the machine code
196 shown is longwords stored in little-endian order):
198 <00>: a61b0010 ldq a0, 0x10(pv) # load up hptr
199 <04>: a77b0018 ldq pv, 0x18(pv) # load up wptr
200 <08>: 6bfbabcd jmp (pv), 0xabcd # jump to wptr (with hint)
201 <0c>: 47ff041f nop # padding for alignment
202 <10>: [8 bytes for hptr quadword]
203 <18>: [8 bytes for wptr quadword]
205 The "computed" jump at <08> above is really a jump to a fixed
206 location. Accordingly, we place an always-correct hint in the
207 jump instruction, namely the address offset from <0c> to wptr,
208 divided by 4, taking the lowest 14 bits.
210 TODO: Depending on how much allocation overhead stgMallocBytes uses for
211 header information (more precisely, if the overhead is no more than
212 4 bytes), we should move the first three instructions above down by
213 4 bytes (getting rid of the nop), hence saving memory. [ccshan]
215 ASSERT(((StgWord64)wptr & 3) == 0);
216 if ((adjustor = stgMallocBytes(32, "createAdjustor")) != NULL) {
217 StgWord64 *const code = (StgWord64 *)adjustor;
219 code[0] = 0xa77b0018a61b0010L;
220 code[1] = 0x47ff041f6bfb0000L
221 | (((StgWord32*)(wptr) - (StgWord32*)(code) - 3) & 0x3fff);
223 code[2] = (StgWord64)hptr;
224 code[3] = (StgWord64)wptr;
227 #error Adjustor creation is not supported on this platform.
243 freeHaskellFunctionPtr(void* ptr)
245 #if defined(i386_TARGET_ARCH)
246 if ( *(unsigned char*)ptr != 0x68 &&
247 *(unsigned char*)ptr != 0x58 ) {
248 fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
252 /* Free the stable pointer first..*/
253 if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
254 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
256 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
258 #elif defined(sparc_TARGET_ARCH)
259 if ( *(unsigned char*)ptr != 0x13 ) {
260 fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
264 /* Free the stable pointer first..*/
265 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
266 #elif defined(sparc_TARGET_ARCH)
267 if ( *(StgWord64*)ptr != 0xa77b0018a61b0010L ) {
268 fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
272 /* Free the stable pointer first..*/
273 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
277 *((unsigned char*)ptr) = '\0';