ghc/runtime/c-as-asm/Adjustor.lc

   1 %
   2 %
   3 %
   4 \section[adjustor]{Adjustor `thunks'}
   5
   6 An adjustor is a dynamically allocated code snippet that allows
   7 Haskell closures to be viewed as C function pointers.
   8
   9 Stable pointers provide a way for the outside world to get access to,
  10 and evaluate, Haskell heap objects (see @StablePtrOps.lc@ for the (small)
  11 set of operations supported). So, assuming we've got a stable pointer in
  12 our hand in C, we can jump into the Haskell world and evaluate a callback
  13 procedure, say. This works OK in some cases where callbacks are used, but
  14 does require the external code to know about stable pointers and how to deal
  15 with them. We'd like to hide the Haskell-nature of a callback and have it
  16 be invoked just like any other C function pointer.
  17
  18 An adjustor `thunk' takes care of this, generating a little bit of code
  19 on the fly that, when entered (from C), will rearrange the C stack, pushing
  20 an implicit stable pointer (to the Haskell callback) before calling a
  21 C function stub that enters the Haskell code.
  22
  23 An adjustor thunk is allocated on the C heap, and is called from within
  24 Haskell just before handing out the function pointer to the Haskell (IO)
  25 action. User code should never have to invoke it explicitly.
  26
  27 An adjustor thunk differs from a C function pointer in one respect, when
  28 the code is through with it, it has to be freed in order to release Haskell
  29 and C resources. Failure to do so result in memory leaks on both the C and
  30 Haskell side.
  31
  32 \begin{code}
  33 #if !defined(PAR)
  34
  35 #include "rtsdefs.h"
  36
  37 #if defined(i386_TARGET_ARCH)
  38 char*
  39 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
  40 {
  41   void *adjustor,*adj;
  42   unsigned char* adj_code;
  43   int i;
  44   size_t sizeof_adjustor;
  45
  46   if (cconv) { /* the adjustor will be _stdcall'ed */
  47
  48     /* Magic constant computed by inspecting the code length of
  49        the following assembly language snippet
  50        (offset and machine code prefixed):
  51
  52      <0>:       58                popl   %eax              # temp. remove ret addr..
  53      <1>:       68 63 fd fc fe fa pushl  0xfafefcfd        # constant is large enough to
  54                                                            # hold a StgStablePtr
  55      <6>:       50                pushl  %eax              # put back ret. addr
  56      <7>:       b8 fa ef ff 00    movl   $0x00ffeffa, %eax # load up wptr
  57      <c>:       ff e0             jmp    %eax              # and jump to it.
  58                 # the callee cleans up the it will then clean up the stack
  59     */
  60     sizeof_adjustor = 15*sizeof(char);
  61
  62     if ((adjustor = malloc(sizeof_adjustor)) == NULL) {
  63         return NULL;
  64     }
  65
  66     adj_code    = (unsigned char*)adjustor;
  67     adj_code[0] = (unsigned char)0x58;  /* popl %eax  */
  68     adj_code[1] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
  69
  70     adj = (StgStablePtr*)(adj_code+2);
  71     *((StgStablePtr*)adj) = (StgStablePtr)hptr;
  72
  73     i = 2 + sizeof(StgStablePtr);
  74     adj_code[i]   = (unsigned char)0x50; /* pushl %eax */
  75     adj_code[i+1] = (unsigned char)0xb8; /* movl  $wptr, %eax */
  76     adj = (char*)(adj_code+i+2);
  77     *((StgFunPtr*)adj) = (StgFunPtr)wptr;
  78
  79     i = i+2+sizeof(StgFunPtr);
  80     adj_code[i]   = (unsigned char)0xff;  /* jmp %eax */
  81     adj_code[i+1] = (unsigned char)0xe0;
  82
  83   } else { /* the adjustor will be _ccall'ed */
  84
  85   /* Magic constant computed by inspecting the code length of
  86      the following assembly language snippet
  87      (offset and machine code prefixed):
  88
  89    <0>: 58                popl   %eax              # temp. remove ret addr..
  90    <1>: 68 63 fd fc fe fa pushl  0xfafefcfd        # constant is large enough to
  91                                                    # hold a StgStablePtr
  92    <6>: 50                pushl  %eax              # put back ret. addr
  93    <7>: b8 fa ef ff 00    movl   $0x00ffeffa, %eax # load up wptr
  94    <c>: ff d0             call   %eax              # and call it.
  95    <e>: 58                popl   %eax              # store away return address.
  96    <f>: 83 c4 04          addl   $0x4,%esp         # remove stable pointer
  97   <12>: 50                pushl  %eax              # put back return address.
  98   <13>: c3                ret                      # return to where you came from.
  99
 100   */
 101     sizeof_adjustor = 20*sizeof(char);
 102
 103     if ((adjustor = malloc(sizeof_adjustor)) == NULL) {
 104         return NULL;
 105     }
 106
 107     adj_code    = (unsigned char*)adjustor;
 108     adj_code[0] = (unsigned char)0x58;  /* popl %eax  */
 109     adj_code[1] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
 110
 111     adj = (StgStablePtr*)(adj_code+2);
 112     *((StgStablePtr*)adj) = (StgStablePtr)hptr;
 113
 114     i = 2 + sizeof(StgStablePtr);
 115     adj_code[i]   = (unsigned char)0x50; /* pushl %eax */
 116     adj_code[i+1] = (unsigned char)0xb8; /* movl  $wptr, %eax */
 117     adj = (char*)(adj_code+i+2);
 118     *((StgFunPtr*)adj) = (StgFunPtr)wptr;
 119
 120     i = i+2+sizeof(StgFunPtr);
 121     adj_code[i]   = (unsigned char)0xff;  /* call %eax */
 122     adj_code[i+1] = (unsigned char)0xd0;
 123     adj_code[i+2] = (unsigned char)0x58;  /* popl %eax */
 124     adj_code[i+3] = (unsigned char)0x83;  /* addl $0x4, %esp */
 125     adj_code[i+4] = (unsigned char)0xc4;
 126     adj_code[i+5] = (unsigned char)0x04;
 127     adj_code[i+6] = (unsigned char)0x50; /* pushl %eax */
 128     adj_code[i+7] = (unsigned char)0xc3; /* ret */
 129   }
 130
 131   /* Have fun! */
 132   return (adjustor);
 133 }
 134
 135 void
 136 freeAdjustor(void* ptr)
 137 {
 138  char* tmp;
 139
 140  /* Free the stable pointer first..*/
 141  tmp=(char*)ptr+2;
 142  freeStablePointer(*((StgStablePtr*)tmp));
 143
 144  free(ptr);
 145 }
 146
 147 #endif /* i386_TARGET_ARCH */
 148
 149 #endif /* !PAR */
 150 \end{code}