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
  42 /* Heavily arch-specific, I'm afraid.. */
  43 #if defined(i386_TARGET_ARCH)
  44 char*
  45 createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr)
  46 {
  47   void *adjustor,*adj;
  48   unsigned char* adj_code;
  49   int i;
  50   size_t sizeof_adjustor;
  51
  52   if (cconv == 0) { /* the adjustor will be _stdcall'ed */
  53
  54     /* Magic constant computed by inspecting the code length of
  55        the following assembly language snippet
  56        (offset and machine code prefixed):
  57
  58      <0>:       58                popl   %eax              # temp. remove ret addr..
  59      <1>:       68 63 fd fc fe fa pushl  0xfafefcfd        # constant is large enough to
  60                                                            # hold a StgStablePtr
  61      <6>:       50                pushl  %eax              # put back ret. addr
  62      <7>:       b8 fa ef ff 00    movl   $0x00ffeffa, %eax # load up wptr
  63      <c>:       ff e0             jmp    %eax              # and jump to it.
  64                 # the callee cleans up the it will then clean up the stack
  65     */
  66     sizeof_adjustor = 15*sizeof(char);
  67
  68     if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
  69         return NULL;
  70     }
  71
  72     adj_code    = (unsigned char*)adjustor;
  73     adj_code[0] = (unsigned char)0x58;  /* popl %eax  */
  74     adj_code[1] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
  75
  76     adj = (StgStablePtr*)(adj_code+2);
  77     *((StgStablePtr*)adj) = (StgStablePtr)hptr;
  78
  79     i = 2 + sizeof(StgStablePtr);
  80     adj_code[i]   = (unsigned char)0x50; /* pushl %eax */
  81     adj_code[i+1] = (unsigned char)0xb8; /* movl  $wptr, %eax */
  82     adj = (char*)(adj_code+i+2);
  83     *((StgFunPtr*)adj) = (StgFunPtr)wptr;
  84
  85     i = i+2+sizeof(StgFunPtr);
  86     adj_code[i]   = (unsigned char)0xff;  /* jmp %eax */
  87     adj_code[i+1] = (unsigned char)0xe0;
  88
  89   } else { /* the adjustor will be _ccall'ed */
  90
  91   /* Magic constant computed by inspecting the code length of
  92      the following assembly language snippet
  93      (offset and machine code prefixed):
  94
  95    <0>: 58                popl   %eax              # temp. remove ret addr..
  96    <1>: 68 63 fd fc fe fa pushl  0xfafefcfd        # constant is large enough to
  97                                                    # hold a StgStablePtr
  98    <6>: 50                pushl  %eax              # put back ret. addr
  99    <7>: b8 fa ef ff 00    movl   $0x00ffeffa, %eax # load up wptr
 100    <c>: ff d0             call   %eax              # and call it.
 101    <e>: 58                popl   %eax              # store away return address.
 102    <f>: 83 c4 04          addl   $0x4,%esp         # remove stable pointer
 103   <12>: 50                pushl  %eax              # put back return address.
 104   <13>: c3                ret                      # return to where you came from.
 105
 106   */
 107     sizeof_adjustor = 20*sizeof(char);
 108
 109     if ((adjustor = stgMallocBytes(sizeof_adjustor,"createAdjustor")) == NULL) {
 110         return NULL;
 111     }
 112
 113     adj_code    = (unsigned char*)adjustor;
 114     adj_code[0] = (unsigned char)0x58;  /* popl %eax  */
 115     adj_code[1] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
 116
 117     adj = (StgStablePtr*)(adj_code+2);
 118     *((StgStablePtr*)adj) = (StgStablePtr)hptr;
 119
 120     i = 2 + sizeof(StgStablePtr);
 121     adj_code[i]   = (unsigned char)0x50; /* pushl %eax */
 122     adj_code[i+1] = (unsigned char)0xb8; /* movl  $wptr, %eax */
 123     adj = (char*)(adj_code+i+2);
 124     *((StgFunPtr*)adj) = (StgFunPtr)wptr;
 125
 126     i = i+2+sizeof(StgFunPtr);
 127     adj_code[i]   = (unsigned char)0xff;  /* call %eax */
 128     adj_code[i+1] = (unsigned char)0xd0;
 129     adj_code[i+2] = (unsigned char)0x58;  /* popl %eax */
 130     adj_code[i+3] = (unsigned char)0x83;  /* addl $0x4, %esp */
 131     adj_code[i+4] = (unsigned char)0xc4;
 132     adj_code[i+5] = (unsigned char)0x04;
 133     adj_code[i+6] = (unsigned char)0x50; /* pushl %eax */
 134     adj_code[i+7] = (unsigned char)0xc3; /* ret */
 135   }
 136
 137   /* Have fun! */
 138   return (adjustor);
 139 }
 140
 141 void
 142 freeHaskellFunctionPtr(void* ptr)
 143 {
 144  char* tmp;
 145
 146  /* Free the stable pointer first..*/
 147  tmp=(char*)ptr+2;
 148  freeStablePointer(*((StgStablePtr*)tmp));
 149
 150  free(ptr);
 151 }
 152
 153 #endif /* i386_TARGET_ARCH */
 154