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) || defined(sparc_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
  71 void*
  72 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
  73 {
  74   void *adjustor;
  75   unsigned char* adj_code;
  76   size_t sizeof_adjustor;
  77
  78   if (cconv == 0) { /* the adjustor will be _stdcall'ed */
  79
  80 #if defined(sparc_TARGET_ARCH)
  81     /* SPARC doesn't have a calling convention other than _ccall */
  82     if (cconv == 0) {
  83         return NULL;
  84     }
  85 #endif
  86
  87     /* Magic constant computed by inspecting the code length of
  88        the following assembly language snippet
  89        (offset and machine code prefixed):
  90
  91      <0>:       58                popl   %eax              # temp. remove ret addr..
  92      <1>:       68 fd fc fe fa    pushl  0xfafefcfd        # constant is large enough to
  93                                                            # hold a StgStablePtr
  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
  98     */
  99     sizeof_adjustor = 14*sizeof(char);
 100
 101     if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
 102         return NULL;
 103     }
 104
 105     adj_code       = (unsigned char*)adjustor;
 106     adj_code[0x00] = (unsigned char)0x58;  /* popl %eax  */
 107
 108     adj_code[0x01] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
 109     *((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
 110
 111     adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
 112
 113     adj_code[0x07] = (unsigned char)0xb8; /* movl  $wptr, %eax */
 114     *((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
 115
 116     adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
 117     adj_code[0x0d] = (unsigned char)0xe0;
 118
 119
 120   } else { /* the adjustor will be _ccall'ed */
 121
 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):
 126
 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
 132
 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 :-)
 137
 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
 140     fixup.
 141
 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.
 146
 147
 148   */
 149     sizeof_adjustor = 17*sizeof(char);
 150
 151     if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
 152         return NULL;
 153     }
 154
 155     adj_code       = (unsigned char*)adjustor;
 156
 157     adj_code[0x00] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
 158     *((StgStablePtr*)(adj_code+0x01)) = (StgStablePtr)hptr;
 159
 160     adj_code[0x05] = (unsigned char)0xb8;  /* movl  $wptr, %eax */
 161     *((StgFunPtr*)(adj_code + 0x06)) = (StgFunPtr)wptr;
 162
 163     adj_code[0x0a] = (unsigned char)0x68;  /* pushl __obscure_ccall_ret_code */
 164     *((StgFunPtr*)(adj_code + 0x0b)) = (StgFunPtr)__obscure_ccall_ret_code;
 165
 166     adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
 167     adj_code[0x10] = (unsigned char)0xe0;
 168
 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):
 173
 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)
 178                                                          # [in delay slot]
 179   <10>: de ad be ef     # Place the value of the StgStablePtr somewhere readable
 180
 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.
 187
 188   */
 189     sizeof_adjustor = 28*sizeof(char);
 190
 191     if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
 192         return NULL;
 193     }
 194
 195     adj_code       = (unsigned char*)adjustor;
 196
 197     /* sethi %hi(wptr), %o1 */
 198     *((unsigned long*)(adj_code+0x00)) = (unsigned long)0x13000000;
 199     *((unsigned long*)(adj_code+0x00)) |= ((unsigned long)wptr) >> 10;
 200
 201     /* sethi %hi(hptr), %o0 */
 202     *((unsigned long*)(adj_code+0x04)) = (unsigned long)0x11000000;
 203     *((unsigned long*)(adj_code+0x04)) |= ((unsigned long)hptr) >> 10;
 204
 205     /* jmp %o1+%lo(wptr) */
 206     *((unsigned long*)(adj_code+0x08)) = (unsigned long)0x81c26000;
 207     *((unsigned long*)(adj_code+0x08)) |= ((unsigned long)wptr) & 0x000003ff;
 208
 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;
 212
 213     *((StgStablePtr*)(adj_code+0x10)) = (StgStablePtr)hptr;
 214 #endif
 215
 216   }
 217
 218   /* Have fun! */
 219   return ((void*)adjustor);
 220 }
 221
 222 void
 223 freeHaskellFunctionPtr(void* ptr)
 224 {
 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);
 229    return;
 230  }
 231
 232  /* Free the stable pointer first..*/
 233  if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
 234     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
 235  } else {
 236     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
 237  }
 238 #elif defined(sparc_TARGET_ARCH)
 239  if ( *(unsigned char*)ptr != 0x13 ) {
 240    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
 241    return;
 242  }
 243
 244  /* Free the stable pointer first..*/
 245  freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
 246 #endif
 247  *((unsigned char*)ptr) = '\0';
 248
 249  free(ptr);
 250 }
 251
 252 #else /* Provide dummy */
 253 void
 254 freeHaskellFunctionPtr(void* ptr)
 255 {
 256 }
 257
 258 #endif /* i386_TARGET_ARCH || sparc_TARGET_ARCH */
 259