ghc/rts/ForeignCall.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * $Id: ForeignCall.c,v 1.6 1999/10/19 11:01:26 sewardj Exp $
   4  *
   5  * (c) The GHC Team 1994-1999.
   6  *
   7  * Foreign Function calls
   8  *
   9  * ---------------------------------------------------------------------------*/
  10
  11 #include "Rts.h"
  12
  13 #ifdef INTERPRETER
  14
  15 #include "Assembler.h" /* for CFun stuff */
  16 #include "Evaluator.h"
  17 #include "ForeignCall.h"
  18
  19
  20 /* --------------------------------------------------------------------------
  21  * Calling out to C: a simple, universal calling API
  22  * ------------------------------------------------------------------------*/
  23
  24 /* The universal call-C API supplies a single function:
  25
  26       void universal_call_c ( int   n_args,
  27                               void* args,
  28                               char* argstr,
  29                               void* fun )
  30
  31    PRECONDITIONS
  32
  33    args points to the start of a block of memory containing the
  34    arguments.  This block is an array of 8-byte entities,
  35    containing (n_args+1) slots.   The zeroth slot is where the
  36    return result goes. Slots [1 .. n_args] contain the arguments,
  37    presented left-to-right.
  38
  39    Arguments are stored in the host's byte ordering inside
  40    the slots.  Only 4 or 8 byte entities are allowed.
  41    4-byte entities are stored in the half-slot with lower
  42    addresses.
  43
  44    For example, a 32-bit value 0xAABBCCDD would be stored, on
  45    a little-endian, as
  46
  47       DD CC BB AA  0  0  0  0
  48
  49    whereas on a big-endian would expect
  50
  51       AA BB CC DD  0  0  0  0
  52
  53    Clients do not need to fill in the zero bytes; they are there
  54    only for illustration.
  55
  56    argstr is a simplified argument descriptor string.  argstr
  57    has one character for each (notional) argument slot of
  58    args.  That means the first byte of argstr describes the
  59    return type.  args should be allocated by the caller to hold
  60    as many slots as implied by argstr.
  61
  62    argstr always specifies a return type.  If the function to
  63    be called returns no result, you must specify a bogus
  64    return type in argstr[0]; a 32-bit int seems like a good bet.
  65
  66    Characters in argstr specify the result and argument types:
  67
  68       i    32-bit integral
  69       I    64-bit integral
  70       f    32-bit floating
  71       F    64-bit floating
  72
  73    Pointers should travel as integral entities.  At the moment
  74    there are no descriptors for entities smaller than 32 bits
  75    since AFAIK all calling conventions expand smaller entities
  76    to 32 bits anyway.  Users of this routine need to handle
  77    packing/unpacking of 16 and 8 bit quantities themselves.
  78
  79    If the preconditions are not met, behaviour of
  80    universal_call_c is entirely undefined.
  81
  82
  83    POSTCONDITION
  84
  85    The function specified by fun is called with arguments
  86    in args as specified by argstr.  The result of the call
  87    is placed in the first 8 bytes of args, again as specified
  88    by the first byte of argstr.  Calling and returning is to
  89    be done using the correct calling convention for the
  90    architecture.
  91
  92    It's clear that implementations of universal_call_c will
  93    have to be handwritten assembly.  The above design is intended
  94    to make that assembly as simple as possible, at the expense
  95    of a small amount of complication for the API's user.
  96 */
  97
  98 /* ToDo: move these to the Right Place */
  99 extern StgInt          PopTaggedInt       ( void ) ;
 100 extern StgDouble       PopTaggedDouble    ( void ) ;
 101 extern StgFloat        PopTaggedFloat     ( void ) ;
 102 extern StgChar         PopTaggedChar      ( void ) ;
 103 extern StgAddr         PopTaggedAddr      ( void ) ;
 104
 105 extern void   PushTaggedInt     ( StgInt    );
 106 extern void   PushTaggedDouble  ( StgDouble );
 107 extern void   PushTaggedFloat   ( StgFloat  );
 108 extern void   PushTaggedChar    ( StgChar   );
 109 extern void   PushTaggedAddr    ( StgAddr   );
 110
 111 extern void   PushPtr        ( StgPtr );
 112 extern StgPtr PopPtr         ( void );
 113
 114
 115 /* --------------------------------------------------------------------------
 116  * Move args/results between STG stack and the above API's arg block
 117  * Returns 0 on success
 118  *         1 if too many args/results or non-handled type
 119  *         2 if config error on this platform
 120  * Tries to automatically handle 32-vs-64 bit differences.
 121  * ------------------------------------------------------------------------*/
 122
 123 int ccall ( CFunDescriptor* d, void (*fun)(void), StgBCO** bco )
 124 {
 125    double         arg_vec [31];
 126    char           argd_vec[31];
 127    unsigned int*  p;
 128    int            i;
 129
 130    if (sizeof(int) != 4 || sizeof(double) != 8 || sizeof(float) != 4
 131        || (sizeof(void*) != 4 && sizeof(void*) != 8))
 132       return 2;
 133
 134    if (d->num_args > 30 || d->num_results > 1)
 135       return 1; /* unlikely, but ... */
 136
 137    //fprintf ( stderr, "ccall: `%s' %d -> `%s' %d\n",
 138    //         d-> arg_tys, d->num_args, d->result_tys, d->num_results );
 139
 140    p = (unsigned int*) &arg_vec[1];
 141    for (i = 0; i < d->num_args; i++) {
 142       switch (d->arg_tys[i]) {
 143          case CHAR_REP: {
 144             int j = (int)PopTaggedChar();
 145             *p++ = j; *p++ = 0;
 146             argd_vec[i+1] = 'i';
 147             break;
 148          }
 149          case INT_REP: {
 150             int j = PopTaggedInt();
 151             *p++ = j; *p++ = 0;
 152             argd_vec[i+1] = 'i';
 153             break;
 154          }
 155          case ADDR_REP: {
 156             void* a = PopTaggedAddr();
 157             if (sizeof(void*) == 4) {
 158                *(void**)p = a; p++; *p++ = 0;
 159                argd_vec[i+1] = 'i';
 160             } else {
 161                *(void**)p = a;
 162                p += 2;
 163                argd_vec[i+1] = 'I';
 164             }
 165             break;
 166          }
 167          case FLOAT_REP: {
 168             float f = PopTaggedFloat();
 169             *(float*)p = f; p++; *p++ = 0;
 170             argd_vec[i+1] = 'f';
 171             break;
 172          }
 173          case DOUBLE_REP: {
 174             double d = PopTaggedDouble();
 175             *(double*)p = d; p+=2;
 176             argd_vec[i+1] = 'F';
 177             break;
 178          }
 179          default:
 180             return 1;
 181       }
 182    }
 183
 184    if (d->num_results == 0) {
 185       argd_vec[0] = 'i';
 186    } else {
 187       switch (d->result_tys[0]) {
 188          case CHAR_REP: case INT_REP:
 189             argd_vec[0] = 'i'; break;
 190          case ADDR_REP:
 191             argd_vec[0] = (sizeof(void*)==4) ? 'i' : 'I'; break;
 192          case FLOAT_REP:
 193             argd_vec[0] = 'f'; break;
 194          case DOUBLE_REP:
 195             argd_vec[0] = 'F'; break;
 196          default:
 197             return 1;
 198       }
 199    }
 200
 201    PushPtr((StgPtr)(*bco));
 202    SaveThreadState();
 203
 204    //fprintf(stderr, " argc=%d  arg_vec=%p  argd_vec=%p `%s' fun=%p\n",
 205    //          d->num_args, arg_vec, argd_vec, argd_vec, fun );
 206
 207    universal_call_c_x86_linux (
 208       d->num_args, (void*)arg_vec, argd_vec, fun );
 209    LoadThreadState();
 210    *bco=(StgBCO*)PopPtr();
 211
 212    if (d->num_results > 0) {
 213       p = (unsigned int*) &arg_vec[0];
 214       switch (d->result_tys[0]) {
 215          case CHAR_REP:
 216             PushTaggedChar ( (StgChar) p[0]);
 217             break;
 218          case INT_REP:
 219             PushTaggedInt ( ((StgInt*)p) [0] );
 220             break;
 221          case ADDR_REP:
 222             if (sizeof(void*) == 4)
 223                PushTaggedAddr ( ((StgAddr*)p) [0] );
 224             else
 225                PushTaggedAddr ( ((StgAddr*)p) [0] );
 226             break;
 227          case FLOAT_REP:
 228             PushTaggedFloat ( ((StgFloat*)p) [0] );
 229             break;
 230          case DOUBLE_REP:
 231             PushTaggedDouble ( ((StgDouble*)p) [0] );
 232             break;
 233          default:
 234             return 1;
 235       }
 236    }
 237
 238    return 0;
 239 }
 240
 241
 242
 243 CFunDescriptor* mkDescriptor( char* as, char* rs )
 244 {
 245     /* ToDo: don't use malloc */
 246     CFunDescriptor *d  = malloc(sizeof(CFunDescriptor));
 247     if (d == NULL) return d;
 248     d->arg_tys     = as;
 249     d->result_tys  = rs;
 250     d->num_args    = strlen(as);
 251     d->num_results = strlen(rs);
 252     return d;
 253 }
 254
 255 #endif /* INTERPRETER */