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
42 /* Heavily arch-specific, I'm afraid.. */
43 #if defined(i386_TARGET_ARCH)
45 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
48 unsigned char* adj_code;
50 size_t sizeof_adjustor;
52 if (cconv == 0) { /* the adjustor will be _stdcall'ed */
54 /* Magic constant computed by inspecting the code length of
55 the following assembly language snippet
56 (offset and machine code prefixed):
58 <0>: 58 popl %eax # temp. remove ret addr..
59 <1>: 68 63 fd fc fe fa pushl 0xfafefcfd # constant is large enough to
61 <6>: 50 pushl %eax # put back ret. addr
62 <7>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
63 <c>: ff e0 jmp %eax # and jump to it.
64 # the callee cleans up the it will then clean up the stack
66 sizeof_adjustor = 15*sizeof(char);
68 if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
72 adj_code = (unsigned char*)adjustor;
73 adj_code[0] = (unsigned char)0x58; /* popl %eax */
74 adj_code[1] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
76 adj = (StgStablePtr*)(adj_code+2);
77 *((StgStablePtr*)adj) = (StgStablePtr)hptr;
79 i = 2 + sizeof(StgStablePtr);
80 adj_code[i] = (unsigned char)0x50; /* pushl %eax */
81 adj_code[i+1] = (unsigned char)0xb8; /* movl $wptr, %eax */
82 adj = (char*)(adj_code+i+2);
83 *((StgFunPtr*)adj) = (StgFunPtr)wptr;
85 i = i+2+sizeof(StgFunPtr);
86 adj_code[i] = (unsigned char)0xff; /* jmp %eax */
87 adj_code[i+1] = (unsigned char)0xe0;
89 } else { /* the adjustor will be _ccall'ed */
91 /* Magic constant computed by inspecting the code length of
92 the following assembly language snippet
93 (offset and machine code prefixed):
95 <0>: 58 popl %eax # temp. remove ret addr..
96 <1>: 68 63 fd fc fe fa pushl 0xfafefcfd # constant is large enough to
98 <6>: 50 pushl %eax # put back ret. addr
99 <7>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr
100 <c>: ff d0 call %eax # and call it.
101 <e>: 58 popl %eax # store away return address.
102 <f>: 83 c4 04 addl $0x4,%esp # remove stable pointer
103 <12>: 50 pushl %eax # put back return address.
104 <13>: c3 ret # return to where you came from.
107 sizeof_adjustor = 20*sizeof(char);
109 if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
113 adj_code = (unsigned char*)adjustor;
114 adj_code[0] = (unsigned char)0x58; /* popl %eax */
115 adj_code[1] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */
117 adj = (StgStablePtr*)(adj_code+2);
118 *((StgStablePtr*)adj) = (StgStablePtr)hptr;
120 i = 2 + sizeof(StgStablePtr);
121 adj_code[i] = (unsigned char)0x50; /* pushl %eax */
122 adj_code[i+1] = (unsigned char)0xb8; /* movl $wptr, %eax */
123 adj = (char*)(adj_code+i+2);
124 *((StgFunPtr*)adj) = (StgFunPtr)wptr;
126 i = i+2+sizeof(StgFunPtr);
127 adj_code[i] = (unsigned char)0xff; /* call %eax */
128 adj_code[i+1] = (unsigned char)0xd0;
129 adj_code[i+2] = (unsigned char)0x58; /* popl %eax */
130 adj_code[i+3] = (unsigned char)0x83; /* addl $0x4, %esp */
131 adj_code[i+4] = (unsigned char)0xc4;
132 adj_code[i+5] = (unsigned char)0x04;
133 adj_code[i+6] = (unsigned char)0x50; /* pushl %eax */
134 adj_code[i+7] = (unsigned char)0xc3; /* ret */
142 freeHaskellFunctionPtr(void* ptr)
146 /* Free the stable pointer first..*/
148 freeStablePointer(*((StgStablePtr*)tmp));
153 #endif /* i386_TARGET_ARCH */