ghc/rts/Adjustor.c

   1 /* -----------------------------------------------------------------------------
   2  * Foreign export adjustor thunks
   3  *
   4  * Copyright (c) 1998.
   5  *
   6  * ---------------------------------------------------------------------------*/
   7
   8 /* A little bit of background...
   9
  10 An adjustor thunk is a dynamically allocated code snippet that allows
  11 Haskell closures to be viewed as C function pointers.
  12
  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.
  21
  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.
  28
  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.
  32
  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
  36 Haskell side.
  37
  38 */
  39 #include "Rts.h"
  40 #include "RtsUtils.h"
  41 #include "RtsFlags.h"
  42
  43 /* Heavily arch-specific, I'm afraid.. */
  44 #if defined(i386_TARGET_ARCH)
  45
  46 /* Now here's something obscure for you:
  47
  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
  55    point to junk.
  56
  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.
  61
  62    For this to work we make the assumption that bytes in .data
  63    are considered executable.
  64 */
  65 static unsigned char __obscure_ccall_ret_code [] =
  66   { 0x83, 0xc4, 0x04 /* addl $0x4, %esp */
  67   , 0xc3             /* ret */
  68   };
  69
  70 void*
  71 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
  72 {
  73   void *adjustor;
  74   unsigned char* adj_code;
  75   size_t sizeof_adjustor;
  76
  77   if (cconv == 0) { /* the adjustor will be _stdcall'ed */
  78
  79     /* Magic constant computed by inspecting the code length of
  80        the following assembly language snippet
  81        (offset and machine code prefixed):
  82
  83      <0>:       58                popl   %eax              # temp. remove ret addr..
  84      <1>:       68 fd fc fe fa    pushl  0xfafefcfd        # constant is large enough to
  85                                                            # hold a StgStablePtr
  86      <6>:       50                pushl  %eax              # put back ret. addr
  87      <7>:       b8 fa ef ff 00    movl   $0x00ffeffa, %eax # load up wptr
  88      <c>:       ff e0             jmp    %eax              # and jump to it.
  89                 # the callee cleans up the stack
  90     */
  91     sizeof_adjustor = 14*sizeof(char);
  92
  93     if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
  94         return NULL;
  95     }
  96
  97     adj_code       = (unsigned char*)adjustor;
  98     adj_code[0x00] = (unsigned char)0x58;  /* popl %eax  */
  99
 100     adj_code[0x01] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
 101     *((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
 102
 103     adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
 104
 105     adj_code[0x07] = (unsigned char)0xb8; /* movl  $wptr, %eax */
 106     *((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
 107
 108     adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
 109     adj_code[0x0d] = (unsigned char)0xe0;
 110
 111
 112   } else { /* the adjustor will be _ccall'ed */
 113
 114   /* Magic constant computed by inspecting the code length of
 115      the following assembly language snippet
 116      (offset and machine code prefixed):
 117
 118   <00>: 68 ef be ad de     pushl  $0xdeadbeef      # constant is large enough to
 119                                                    # hold a StgStablePtr
 120   <05>: b8 fa ef ff 00     movl   $0x00ffeffa, %eax # load up wptr
 121   <0a>: 68 ef be ad de     pushl  $__obscure_ccall_ret_code # push the return address
 122   <0f>: ff e0              jmp    *%eax            # jump to wptr
 123
 124     The ccall'ing version is a tad different, passing in the return
 125     address of the caller to the auto-generated C stub (which enters
 126     via the stable pointer.) (The auto-generated C stub is in on this
 127     game, don't worry :-)
 128
 129     See the comment next to __obscure_ccall_ret_code why we need to
 130     perform a tail jump instead of a call, followed by some C stack
 131     fixup.
 132
 133     Note: The adjustor makes the assumption that any return value
 134     coming back from the C stub is not stored on the stack.
 135     That's (thankfully) the case here with the restricted set of
 136     return types that we support.
 137
 138
 139   */
 140     sizeof_adjustor = 17*sizeof(char);
 141
 142     if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
 143         return NULL;
 144     }
 145
 146     adj_code       = (unsigned char*)adjustor;
 147
 148     adj_code[0x00] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
 149     *((StgStablePtr*)(adj_code+0x01)) = (StgStablePtr)hptr;
 150
 151     adj_code[0x05] = (unsigned char)0xb8;  /* movl  $wptr, %eax */
 152     *((StgFunPtr*)(adj_code + 0x06)) = (StgFunPtr)wptr;
 153
 154     adj_code[0x0a] = (unsigned char)0x68;  /* pushl __obscure_ccall_ret_code */
 155     *((StgFunPtr*)(adj_code + 0x0b)) = (StgFunPtr)__obscure_ccall_ret_code;
 156
 157     adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
 158     adj_code[0x10] = (unsigned char)0xe0;
 159
 160   }
 161
 162   /* Have fun! */
 163   return ((void*)adjustor);
 164 }
 165
 166 void
 167 freeHaskellFunctionPtr(void* ptr)
 168 {
 169  if ( *(unsigned char*)ptr != 0x68 &&
 170       *(unsigned char*)ptr != 0x58 ) {
 171    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
 172    return;
 173  }
 174
 175  /* Free the stable pointer first..*/
 176  if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
 177     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
 178  } else {
 179     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
 180  }
 181  *((unsigned char*)ptr) = '\0';
 182
 183  free(ptr);
 184 }
 185
 186 #endif /* i386_TARGET_ARCH */
 187