From: sof Date: Fri, 14 Aug 1998 10:57:32 +0000 (+0000) Subject: [project @ 1998-08-14 10:57:32 by sof] X-Git-Tag: Approx_2487_patches~439 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=db0176b2d4c8064eb416b5619686b97b246f64e7;p=ghc-hetmet.git [project @ 1998-08-14 10:57:32 by sof] On-the-fly generation of code chunks for 'foreign export dynamic' - x86 only at the moment --- diff --git a/ghc/runtime/c-as-asm/Adjustor.lc b/ghc/runtime/c-as-asm/Adjustor.lc new file mode 100644 index 0000000..b102854 --- /dev/null +++ b/ghc/runtime/c-as-asm/Adjustor.lc @@ -0,0 +1,150 @@ +% +% +% +\section[adjustor]{Adjustor `thunks'} + +An adjustor is a dynamically allocated code snippet that allows +Haskell closures to be viewed as C function pointers. + +Stable pointers provide a way for the outside world to get access to, +and evaluate, Haskell heap objects (see @StablePtrOps.lc@ for the (small) +set of operations supported). So, assuming we've got a stable pointer in +our hand in C, we can jump into the Haskell world and evaluate a callback +procedure, say. This works OK in some cases where callbacks are used, but +does require the external code to know about stable pointers and how to deal +with them. We'd like to hide the Haskell-nature of a callback and have it +be invoked just like any other C function pointer. + +An adjustor `thunk' takes care of this, generating a little bit of code +on the fly that, when entered (from C), will rearrange the C stack, pushing +an implicit stable pointer (to the Haskell callback) before calling a +C function stub that enters the Haskell code. + +An adjustor thunk is allocated on the C heap, and is called from within +Haskell just before handing out the function pointer to the Haskell (IO) +action. User code should never have to invoke it explicitly. + +An adjustor thunk differs from a C function pointer in one respect, when +the code is through with it, it has to be freed in order to release Haskell +and C resources. Failure to do so result in memory leaks on both the C and +Haskell side. + +\begin{code} +#if !defined(PAR) + +#include "rtsdefs.h" + +#if defined(i386_TARGET_ARCH) +char* +createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr) +{ + void *adjustor,*adj; + unsigned char* adj_code; + int i; + size_t sizeof_adjustor; + + if (cconv) { /* the adjustor will be _stdcall'ed */ + + /* Magic constant computed by inspecting the code length of + the following assembly language snippet + (offset and machine code prefixed): + + <0>: 58 popl %eax # temp. remove ret addr.. + <1>: 68 63 fd fc fe fa pushl 0xfafefcfd # constant is large enough to + # hold a StgStablePtr + <6>: 50 pushl %eax # put back ret. addr + <7>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr + : ff e0 jmp %eax # and jump to it. + # the callee cleans up the it will then clean up the stack + */ + sizeof_adjustor = 15*sizeof(char); + + if ((adjustor = malloc(sizeof_adjustor)) == NULL) { + return NULL; + } + + adj_code = (unsigned char*)adjustor; + adj_code[0] = (unsigned char)0x58; /* popl %eax */ + adj_code[1] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */ + + adj = (StgStablePtr*)(adj_code+2); + *((StgStablePtr*)adj) = (StgStablePtr)hptr; + + i = 2 + sizeof(StgStablePtr); + adj_code[i] = (unsigned char)0x50; /* pushl %eax */ + adj_code[i+1] = (unsigned char)0xb8; /* movl $wptr, %eax */ + adj = (char*)(adj_code+i+2); + *((StgFunPtr*)adj) = (StgFunPtr)wptr; + + i = i+2+sizeof(StgFunPtr); + adj_code[i] = (unsigned char)0xff; /* jmp %eax */ + adj_code[i+1] = (unsigned char)0xe0; + + } else { /* the adjustor will be _ccall'ed */ + + /* Magic constant computed by inspecting the code length of + the following assembly language snippet + (offset and machine code prefixed): + + <0>: 58 popl %eax # temp. remove ret addr.. + <1>: 68 63 fd fc fe fa pushl 0xfafefcfd # constant is large enough to + # hold a StgStablePtr + <6>: 50 pushl %eax # put back ret. addr + <7>: b8 fa ef ff 00 movl $0x00ffeffa, %eax # load up wptr + : ff d0 call %eax # and call it. + : 58 popl %eax # store away return address. + : 83 c4 04 addl $0x4,%esp # remove stable pointer + <12>: 50 pushl %eax # put back return address. + <13>: c3 ret # return to where you came from. + + */ + sizeof_adjustor = 20*sizeof(char); + + if ((adjustor = malloc(sizeof_adjustor)) == NULL) { + return NULL; + } + + adj_code = (unsigned char*)adjustor; + adj_code[0] = (unsigned char)0x58; /* popl %eax */ + adj_code[1] = (unsigned char)0x68; /* pushl hptr (which is a dword immediate ) */ + + adj = (StgStablePtr*)(adj_code+2); + *((StgStablePtr*)adj) = (StgStablePtr)hptr; + + i = 2 + sizeof(StgStablePtr); + adj_code[i] = (unsigned char)0x50; /* pushl %eax */ + adj_code[i+1] = (unsigned char)0xb8; /* movl $wptr, %eax */ + adj = (char*)(adj_code+i+2); + *((StgFunPtr*)adj) = (StgFunPtr)wptr; + + i = i+2+sizeof(StgFunPtr); + adj_code[i] = (unsigned char)0xff; /* call %eax */ + adj_code[i+1] = (unsigned char)0xd0; + adj_code[i+2] = (unsigned char)0x58; /* popl %eax */ + adj_code[i+3] = (unsigned char)0x83; /* addl $0x4, %esp */ + adj_code[i+4] = (unsigned char)0xc4; + adj_code[i+5] = (unsigned char)0x04; + adj_code[i+6] = (unsigned char)0x50; /* pushl %eax */ + adj_code[i+7] = (unsigned char)0xc3; /* ret */ + } + + /* Have fun! */ + return (adjustor); +} + +void +freeAdjustor(void* ptr) +{ + char* tmp; + + /* Free the stable pointer first..*/ + tmp=(char*)ptr+2; + freeStablePointer(*((StgStablePtr*)tmp)); + + free(ptr); +} + +#endif /* i386_TARGET_ARCH */ + +#endif /* !PAR */ +\end{code}