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>: BA 10 00 1B     mov    %i3, %i5
 159   <04>: B8 10 00 1A     mov    %i2, %i4
 160   <08>: B6 10 00 19     mov    %i1, %i3
 161   <0c>: B4 10 00 18     mov    %i0, %i2
 162   <10>: 13 00 3f fb     sethi  %hi(0x00ffeffa), %o1 # load up wptr (1 of 2)
 163   <14>: 11 37 ab 6f     sethi  %hi(0xdeadbeef), %o0 # load up hptr (1 of 2)
 164   <18>: 81 c2 63 fa     jmp    %o1+%lo(0x00ffeffa)  # jump to wptr (load 2 of 2)
 165   <1c>: 90 12 22 ef     or     %o0, %lo(0xdeadbeef), %o0 # load up hptr (2 of 2)
 166                                                          # [in delay slot]
 167   <20>: de ad be ef     # Place the value of the StgStablePtr somewhere readable
 168
 169     ccall'ing on a SPARC leaves little to be performed by the caller.
 170     The callee shifts the window on entry and restores it on exit.
 171     Input paramters and results are passed via registers. (%o0 in the
 172     code above contains the input paramter to wptr.) The return address
 173     is stored in %o7/%i7. Since we don't shift the window in this code,
 174     the return address is preserved and wptr will return to our caller.
 175
 176     JRS, 21 Aug 01: the above para is a fiction.  The caller passes
 177     args in %i0 .. %i5 and then the rest at [%sp+92].  We want to
 178     tailjump to wptr, passing hptr as the new first arg, and a dummy
 179     second arg, which would be where the return address is on x86.
 180     That means we have to shuffle the original caller's args along by
 181     two.
 182
 183     We do a half-correct solution which works only if the original
 184     caller passed 4 or fewer arg words.  Move %i0 .. %i3 into %i3
 185     .. %i6, so we can park hptr in %i0 and a bogus arg in %i1.  The
 186     fully correct solution would be to subtract 8 from %sp and then
 187     place %i4 and %i5 at [%sp+92] and [%sp+96] respectively.  This
 188     machinery should then work in all cases.  (Or would it?  Perhaps
 189     it would trash parts of the caller's frame.  Dunno).
 190   */
 191     if ((adjustor = stgMallocBytes(4*(8+1), "createAdjustor")) != NULL) {
 192         unsigned long *const adj_code = (unsigned long *)adjustor;
 193
 194         /* mov  %o3, %o5 */
 195         adj_code[0] = (unsigned long)0x9A10000B;
 196         /* mov  %o2, %o4 */
 197         adj_code[1] = (unsigned long)0x9810000A;
 198         /* mov  %o1, %o3 */
 199         adj_code[2] = (unsigned long)0x96100009;
 200         /* mov  %o0, %o2 */
 201         adj_code[3] = (unsigned long)0x94100008;
 202
 203         /* sethi %hi(wptr), %o1 */
 204         adj_code[4] = (unsigned long)0x13000000;
 205         adj_code[4] |= ((unsigned long)wptr) >> 10;
 206
 207         /* sethi %hi(hptr), %o0 */
 208         adj_code[5] = (unsigned long)0x11000000;
 209         adj_code[5] |= ((unsigned long)hptr) >> 10;
 210
 211         /* jmp %o1+%lo(wptr) */
 212         adj_code[6] = (unsigned long)0x81c26000;
 213         adj_code[6] |= ((unsigned long)wptr) & 0x000003ff;
 214
 215         /* or %o0, %lo(hptr), %o0 */
 216         adj_code[7] = (unsigned long)0x90122000;
 217         adj_code[7] |= ((unsigned long)hptr) & 0x000003ff;
 218
 219         adj_code[8] = (StgStablePtr)hptr;
 220     }
 221 #elif defined(alpha_TARGET_ARCH)
 222   /* Magic constant computed by inspecting the code length of
 223      the following assembly language snippet
 224      (offset and machine code prefixed; note that the machine code
 225      shown is longwords stored in little-endian order):
 226
 227   <00>: a61b0010        ldq a0, 0x10(pv)        # load up hptr
 228   <04>: a77b0018        ldq pv, 0x18(pv)        # load up wptr
 229   <08>: 6bfbabcd        jmp (pv), 0xabcd        # jump to wptr (with hint)
 230   <0c>: 47ff041f        nop                     # padding for alignment
 231   <10>: [8 bytes for hptr quadword]
 232   <18>: [8 bytes for wptr quadword]
 233
 234      The "computed" jump at <08> above is really a jump to a fixed
 235      location.  Accordingly, we place an always-correct hint in the
 236      jump instruction, namely the address offset from <0c> to wptr,
 237      divided by 4, taking the lowest 14 bits.
 238
 239 TODO: Depending on how much allocation overhead stgMallocBytes uses for
 240       header information (more precisely, if the overhead is no more than
 241       4 bytes), we should move the first three instructions above down by
 242       4 bytes (getting rid of the nop), hence saving memory. [ccshan]
 243   */
 244     ASSERT(((StgWord64)wptr & 3) == 0);
 245     if ((adjustor = stgMallocBytes(32, "createAdjustor")) != NULL) {
 246         StgWord64 *const code = (StgWord64 *)adjustor;
 247
 248         code[0] = 0xa77b0018a61b0010L;
 249         code[1] = 0x47ff041f6bfb0000L
 250                 | (((StgWord32*)(wptr) - (StgWord32*)(code) - 3) & 0x3fff);
 251
 252         code[2] = (StgWord64)hptr;
 253         code[3] = (StgWord64)wptr;
 254     }
 255 #else
 256 #error Adjustor creation is not supported on this platform.
 257 #endif
 258     break;
 259
 260   default:
 261     ASSERT(0);
 262     break;
 263   }
 264
 265   /* Have fun! */
 266   return adjustor;
 267 }
 268
 269 #endif
 270
 271 void
 272 freeHaskellFunctionPtr(void* ptr)
 273 {
 274 #if defined(i386_TARGET_ARCH)
 275  if ( *(unsigned char*)ptr != 0x68 &&
 276       *(unsigned char*)ptr != 0x58 ) {
 277    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
 278    return;
 279  }
 280
 281  /* Free the stable pointer first..*/
 282  if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
 283     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
 284  } else {
 285     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
 286  }
 287 #elif defined(sparc_TARGET_ARCH)
 288  if ( *(unsigned char*)ptr != 0x13 ) {
 289    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
 290    return;
 291  }
 292
 293  /* Free the stable pointer first..*/
 294  freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
 295 #elif defined(sparc_TARGET_ARCH)
 296  if ( *(StgWord64*)ptr != 0xa77b0018a61b0010L ) {
 297    fprintf(stderr, "freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
 298    return;
 299  }
 300
 301  /* Free the stable pointer first..*/
 302  freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
 303 #else
 304  ASSERT(0);
 305 #endif
 306  *((unsigned char*)ptr) = '\0';
 307
 308  free(ptr);
 309 }
 310