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)
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 */
72 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
75 unsigned char* adj_code;
76 size_t sizeof_adjustor;
78 if (cconv == 0) { /* the adjustor will be _stdcall'ed */
80 #if defined(sparc_TARGET_ARCH)
81 /* SPARC doesn't have a calling convention other than _ccall */
87 /* Magic constant computed by inspecting the code length of
88 the following assembly language snippet
89 (offset and machine code prefixed):
91 <0>: 58 popl %eax # temp. remove ret addr..
92 <1>: 68 fd fc fe fa pushl 0xfafefcfd # constant is large enough to
94 <6>: 50 pushl %eax # put back ret. addr
95 <7>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
96 <c>: ff e0 jmp %eax # and jump to it.
97 # the callee cleans up the stack
99 sizeof_adjustor = 14*sizeof(char);
101 if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
105 adj_code = (unsigned char*)adjustor;
106 adj_code[0x00] = (unsigned char)0x58; /* popl %eax */
108 adj_code[0x01] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
109 *((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
111 adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
113 adj_code[0x07] = (unsigned char)0xb8; /* movl $wptr, %eax */
114 *((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
116 adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
117 adj_code[0x0d] = (unsigned char)0xe0;
120 } else { /* the adjustor will be _ccall'ed */
122 #if defined(i386_TARGET_ARCH)
123 /* Magic constant computed by inspecting the code length of
124 the following assembly language snippet
125 (offset and machine code prefixed):
127 <00>: 68 ef be ad de pushl $0xdeadbeef # constant is large enough to
128 # hold a StgStablePtr
129 <05>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
130 <0a>: 68 ef be ad de pushl $__obscure_ccall_ret_code # push the return address
131 <0f>: ff e0 jmp *%eax # jump to wptr
133 The ccall'ing version is a tad different, passing in the return
134 address of the caller to the auto-generated C stub (which enters
135 via the stable pointer.) (The auto-generated C stub is in on this
136 game, don't worry :-)
138 See the comment next to __obscure_ccall_ret_code why we need to
139 perform a tail jump instead of a call, followed by some C stack
142 Note: The adjustor makes the assumption that any return value
143 coming back from the C stub is not stored on the stack.
144 That's (thankfully) the case here with the restricted set of
145 return types that we support.
149 sizeof_adjustor = 17*sizeof(char);
151 if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
155 adj_code = (unsigned char*)adjustor;
157 adj_code[0x00] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
158 *((StgStablePtr*)(adj_code+0x01)) = (StgStablePtr)hptr;
160 adj_code[0x05] = (unsigned char)0xb8; /* movl $wptr, %eax */
161 *((StgFunPtr*)(adj_code + 0x06)) = (StgFunPtr)wptr;
163 adj_code[0x0a] = (unsigned char)0x68; /* pushl __obscure_ccall_ret_code */
164 *((StgFunPtr*)(adj_code + 0x0b)) = (StgFunPtr)__obscure_ccall_ret_code;
166 adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
167 adj_code[0x10] = (unsigned char)0xe0;
169 #elif defined(sparc_TARGET_ARCH)
170 /* Magic constant computed by inspecting the code length of
171 the following assembly language snippet
172 (offset and machine code prefixed):
174 <00>: 13 00 3f fb sethi %hi(0x00ffeffa), %o1 # load up wptr (1 of 2)
175 <04>: 11 37 ab 6f sethi %hi(0xdeadbeef), %o0 # load up hptr (1 of 2)
176 <08>: 81 c2 63 fa jmp %o1+%lo(0x00ffeffa) # jump to wptr (load 2 of 2)
177 <0c>: 90 12 22 ef or %o0, %lo(0xdeadbeef), %o0 # load up hptr (2 of 2)
179 <10>: de ad be ef # Place the value of the StgStablePtr somewhere readable
181 ccall'ing on a SPARC leaves little to be performed by the caller.
182 The callee shifts the window on entry and restores it on exit.
183 Input paramters and results are passed via registers. (%o0 in the
184 code above contains the input paramter to wptr.) The return address
185 is stored in %o7/%i7. Since we don't shift the window in this code,
186 the return address is preserved and wptr will return to our caller.
189 sizeof_adjustor = 28*sizeof(char);
191 if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
195 adj_code = (unsigned char*)adjustor;
197 /* sethi %hi(wptr), %o1 */
198 *((unsigned long*)(adj_code+0x00)) = (unsigned long)0x13000000;
199 *((unsigned long*)(adj_code+0x00)) |= ((unsigned long)wptr) >> 10;
201 /* sethi %hi(hptr), %o0 */
202 *((unsigned long*)(adj_code+0x04)) = (unsigned long)0x11000000;
203 *((unsigned long*)(adj_code+0x04)) |= ((unsigned long)hptr) >> 10;
205 /* jmp %o1+%lo(wptr) */
206 *((unsigned long*)(adj_code+0x08)) = (unsigned long)0x81c26000;
207 *((unsigned long*)(adj_code+0x08)) |= ((unsigned long)wptr) & 0x000003ff;
209 /* or %o0, %lo(hptr), %o0 */
210 *((unsigned long*)(adj_code+0x0c)) = (unsigned long)0x90122000;
211 *((unsigned long*)(adj_code+0x0c)) |= ((unsigned long)hptr) & 0x000003ff;
213 *((StgStablePtr*)(adj_code+0x10)) = (StgStablePtr)hptr;
219 return ((void*)adjustor);
223 freeHaskellFunctionPtr(void* ptr)
225 #if defined(i386_TARGET_ARCH)
226 if ( *(unsigned char*)ptr != 0x68 &&
227 *(unsigned char*)ptr != 0x58 ) {
228 fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
232 /* Free the stable pointer first..*/
233 if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
234 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
236 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
238 #elif defined(sparc_TARGET_ARCH)
239 if ( *(unsigned char*)ptr != 0x13 ) {
240 fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
244 /* Free the stable pointer first..*/
245 freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
247 *((unsigned char*)ptr) = '\0';
252 #endif /* i386_TARGET_ARCH || sparc_TARGET_ARCH */