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 "PosixSource.h"
  40 #include "Rts.h"
  41 #include "RtsUtils.h"
  42 #include "RtsFlags.h"
  43
  44 /* Heavily arch-specific, I'm afraid.. */
  45 #if defined(i386_TARGET_ARCH) || defined(sparc_TARGET_ARCH) || defined(alpha_TARGET_ARCH)
  46
  47 #if defined(i386_TARGET_ARCH)
  48 /* Now here's something obscure for you:
  49
  50    When generating an adjustor thunk that uses the C calling
  51    convention, we have to make sure that the thunk kicks off
  52    the process of jumping into Haskell with a tail jump. Why?
  53    Because as a result of jumping in into Haskell we may end
  54    up freeing the very adjustor thunk we came from using
  55    freeHaskellFunctionPtr(). Hence, we better not return to
  56    the adjustor code on our way  out, since it could by then
  57    point to junk.
  58
  59    The fix is readily at hand, just include the opcodes
  60    for the C stack fixup code that we need to perform when
  61    returning in some static piece of memory and arrange
  62    to return to it before tail jumping from the adjustor thunk.
  63
  64    For this to work we make the assumption that bytes in .data
  65    are considered executable.
  66 */
  67 static unsigned char __obscure_ccall_ret_code [] =
  68   { 0x83, 0xc4, 0x04 /* addl $0x4, %esp */
  69   , 0xc3             /* ret */
  70   };
  71 #endif
  72
  73 void*
  74 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
  75 {
  76   void *adjustor = NULL;
  77
  78   switch (cconv)
  79   {
  80   case 0: /* _stdcall */
  81 #if defined(i386_TARGET_ARCH)
  82     /* Magic constant computed by inspecting the code length of
  83        the following assembly language snippet
  84        (offset and machine code prefixed):
  85
  86      <0>:       58                popl   %eax              # temp. remove ret addr..
  87      <1>:       68 fd fc fe fa    pushl  0xfafefcfd        # constant is large enough to
  88                                                            # hold a StgStablePtr
  89      <6>:       50                pushl  %eax              # put back ret. addr
  90      <7>:       b8 fa ef ff 00    movl   $0x00ffeffa, %eax # load up wptr
  91      <c>:       ff e0             jmp    %eax              # and jump to it.
  92                 # the callee cleans up the stack
  93     */
  94     if ((adjustor = stgMallocBytes(14, "createAdjustor")) != NULL) {
  95         unsigned char *const adj_code = (unsigned char *)adjustor;
  96         adj_code[0x00] = (unsigned char)0x58;  /* popl %eax  */
  97
  98         adj_code[0x01] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
  99         *((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
 100
 101         adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
 102
 103         adj_code[0x07] = (unsigned char)0xb8; /* movl  $wptr, %eax */
 104         *((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
 105
 106         adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
 107         adj_code[0x0d] = (unsigned char)0xe0;
 108     }
 109 #endif
 110     break;
 111
 112   case 1: /* _ccall */
 113 #if defined(i386_TARGET_ARCH)
 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     if ((adjustor = stgMallocBytes(17, "createAdjustor")) != NULL) {
 139         unsigned char *const adj_code = (unsigned char *)adjustor;
 140
 141         adj_code[0x00] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
 142         *((StgStablePtr*)(adj_code+0x01)) = (StgStablePtr)hptr;
 143
 144         adj_code[0x05] = (unsigned char)0xb8;  /* movl  $wptr, %eax */
 145         *((StgFunPtr*)(adj_code + 0x06)) = (StgFunPtr)wptr;
 146
 147         adj_code[0x0a] = (unsigned char)0x68;  /* pushl __obscure_ccall_ret_code */
 148         *((StgFunPtr*)(adj_code + 0x0b)) = (StgFunPtr)__obscure_ccall_ret_code;
 149
 150         adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
 151         adj_code[0x10] = (unsigned char)0xe0;
 152     }
 153 #elif defined(sparc_TARGET_ARCH)
 154   /* Magic constant computed by inspecting the code length of
 155      the following assembly language snippet
 156      (offset and machine code prefixed):
 157
 158   <00>: 13 00 3f fb     sethi  %hi(0x00ffeffa), %o1 # load up wptr (1 of 2)
 159   <04>: 11 37 ab 6f     sethi  %hi(0xdeadbeef), %o0 # load up hptr (1 of 2)
 160   <08>: 81 c2 63 fa     jmp    %o1+%lo(0x00ffeffa)  # jump to wptr (load 2 of 2)
 161   <0c>: 90 12 22 ef     or     %o0, %lo(0xdeadbeef), %o0 # load up hptr (2 of 2)
 162                                                          # [in delay slot]
 163   <10>: de ad be ef     # Place the value of the StgStablePtr somewhere readable
 164
 165     ccall'ing on a SPARC leaves little to be performed by the caller.
 166     The callee shifts the window on entry and restores it on exit.
 167     Input paramters and results are passed via registers. (%o0 in the
 168     code above contains the input paramter to wptr.) The return address
 169     is stored in %o7/%i7. Since we don't shift the window in this code,
 170     the return address is preserved and wptr will return to our caller.
 171   */
 172     if ((adjustor = stgMallocBytes(28, "createAdjustor")) != NULL) {
 173         unsigned char *const adj_code = (unsigned char *)adjustor;
 174
 175         /* sethi %hi(wptr), %o1 */
 176         *((unsigned long*)(adj_code+0x00)) = (unsigned long)0x13000000;
 177         *((unsigned long*)(adj_code+0x00)) |= ((unsigned long)wptr) >> 10;
 178
 179         /* sethi %hi(hptr), %o0 */
 180         *((unsigned long*)(adj_code+0x04)) = (unsigned long)0x11000000;
 181         *((unsigned long*)(adj_code+0x04)) |= ((unsigned long)hptr) >> 10;
 182
 183         /* jmp %o1+%lo(wptr) */
 184         *((unsigned long*)(adj_code+0x08)) = (unsigned long)0x81c26000;
 185         *((unsigned long*)(adj_code+0x08)) |= ((unsigned long)wptr) & 0x000003ff;
 186
 187         /* or %o0, %lo(hptr), %o0 */
 188         *((unsigned long*)(adj_code+0x0c)) = (unsigned long)0x90122000;
 189         *((unsigned long*)(adj_code+0x0c)) |= ((unsigned long)hptr) & 0x000003ff;
 190
 191         *((StgStablePtr*)(adj_code+0x10)) = (StgStablePtr)hptr;
 192     }
 193 #elif defined(alpha_TARGET_ARCH)
 194   /* Magic constant computed by inspecting the code length of
 195      the following assembly language snippet
 196      (offset and machine code prefixed; note that the machine code
 197      shown is longwords stored in little-endian order):
 198
 199   <00>: a61b0010        ldq a0, 0x10(pv)        # load up hptr
 200   <04>: a77b0018        ldq pv, 0x18(pv)        # load up wptr
 201   <08>: 6bfbabcd        jmp (pv), 0xabcd        # jump to wptr (with hint)
 202   <0c>: 47ff041f        nop                     # padding for alignment
 203   <10>: [8 bytes for hptr quadword]
 204   <18>: [8 bytes for wptr quadword]
 205
 206      The "computed" jump at <08> above is really a jump to a fixed
 207      location.  Accordingly, we place an always-correct hint in the
 208      jump instruction, namely the address offset from <0c> to wptr,
 209      divided by 4, taking the lowest 14 bits.
 210
 211 TODO: Depending on how much allocation overhead stgMallocBytes uses for
 212       header information (more precisely, if the overhead is no more than
 213       4 bytes), we should move the first three instructions above down by
 214       4 bytes (getting rid of the nop), hence saving memory. [ccshan]
 215   */
 216     ASSERT(((StgWord64)wptr & 3) == 0);
 217     if ((adjustor = stgMallocBytes(32, "createAdjustor")) != NULL) {
 218         StgWord64 *const code = (StgWord64 *)adjustor;
 219
 220         code[0] = 0xa77b0018a61b0010L;
 221         code[1] = 0x47ff041f6bfb0000L
 222                 | (((StgWord32*)(wptr) - (StgWord32*)(code) - 3) & 0x3fff);
 223
 224         code[2] = (StgWord64)hptr;
 225         code[3] = (StgWord64)wptr;
 226     }
 227 #else
 228 #error Adjustor creation is not supported on this platform.
 229 #endif
 230     break;
 231
 232   default:
 233     ASSERT(0);
 234     break;
 235   }
 236
 237   /* Have fun! */
 238   return adjustor;
 239 }
 240
 241 #endif
 242
 243 void
 244 freeHaskellFunctionPtr(void* ptr)
 245 {
 246 #if defined(i386_TARGET_ARCH)
 247  if ( *(unsigned char*)ptr != 0x68 &&
 248       *(unsigned char*)ptr != 0x58 ) {
 249    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
 250    return;
 251  }
 252
 253  /* Free the stable pointer first..*/
 254  if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
 255     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
 256  } else {
 257     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
 258  }
 259 #elif defined(sparc_TARGET_ARCH)
 260  if ( *(unsigned char*)ptr != 0x13 ) {
 261    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
 262    return;
 263  }
 264
 265  /* Free the stable pointer first..*/
 266  freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
 267 #elif defined(sparc_TARGET_ARCH)
 268  if ( *(StgWord64*)ptr != 0xa77b0018a61b0010L ) {
 269    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
 270    return;
 271  }
 272
 273  /* Free the stable pointer first..*/
 274  freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
 275 #else
 276  ASSERT(0);
 277 #endif
 278  *((unsigned char*)ptr) = '\0';
 279
 280  free(ptr);
 281 }
 282