ghc/rts/ForeignCall.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * $Id: ForeignCall.c,v 1.7 1999/10/19 23:52:02 andy 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  * This is a generic version of universal call that
 117  * only works for specific argument patterns.
 118  *
 119  * It allows ports to work on the Hugs Prelude immeduately,
 120  * even if univeral_call_c_<os/specific> is not ported.
 121  * ------------------------------------------------------------------------*/
 122
 123 void universal_call_c_x86_generic
 124 ( int   n_args,
 125   void* args,
 126   char* argstr,
 127   void* fun )
 128 {
 129    unsigned int *p = (unsigned int*) args;
 130
 131 #define ARG(n)  (p[n*2])
 132 #define CMP(str) ((n_args + 1 == strlen(str)) && \
 133                   (!strncmp(str,argstr,n_args + 1)))
 134
 135 #define CALL(retType,callTypes,callVals) \
 136         ((retType(*)callTypes)(fun))callVals
 137
 138   if (CMP("i")) {
 139     int res = CALL(int,(void),());
 140     ARG(0) = res;
 141   } else if (CMP("ii")) {
 142     int arg1 = (int) ARG(1);
 143     int res = CALL(int,(int),(arg1));
 144     ARG(0) = res;
 145   } else if (CMP("iii")) {
 146     int arg1 = (int) ARG(1);
 147     int arg2 = (int) ARG(2);
 148     int res = CALL(int,(int,int),(arg1,arg2));
 149     ARG(0) = res;
 150   } else {
 151     /* Do not have the generic call for this argument list. */
 152     int i;
 153     printf("Can not call external function at address %d\n",(int)fun);
 154     printf("Argument string = '");
 155     for(i=0;i<n_args;i++) {
 156       printf("%c",(char)argstr[i]);
 157     }
 158     printf("' [%d arg(s)]\n",n_args);
 159     assert(0);
 160   }
 161 #undef CMP
 162 }
 163
 164 /* --------------------------------------------------------------------------
 165  * Move args/results between STG stack and the above API's arg block
 166  * Returns 0 on success
 167  *         1 if too many args/results or non-handled type
 168  *         2 if config error on this platform
 169  * Tries to automatically handle 32-vs-64 bit differences.
 170  * ------------------------------------------------------------------------*/
 171
 172 int ccall ( CFunDescriptor* d, void (*fun)(void), StgBCO** bco )
 173 {
 174    double         arg_vec [31];
 175    char           argd_vec[31];
 176    unsigned int*  p;
 177    int            i;
 178
 179    if (sizeof(int) != 4 || sizeof(double) != 8 || sizeof(float) != 4
 180        || (sizeof(void*) != 4 && sizeof(void*) != 8))
 181       return 2;
 182
 183    if (d->num_args > 30 || d->num_results > 1)
 184       return 1; /* unlikely, but ... */
 185
 186    //fprintf ( stderr, "ccall: `%s' %d -> `%s' %d\n",
 187    //         d-> arg_tys, d->num_args, d->result_tys, d->num_results );
 188
 189    p = (unsigned int*) &arg_vec[1];
 190    for (i = 0; i < d->num_args; i++) {
 191       switch (d->arg_tys[i]) {
 192          case CHAR_REP: {
 193             int j = (int)PopTaggedChar();
 194             *p++ = j; *p++ = 0;
 195             argd_vec[i+1] = 'i';
 196             break;
 197          }
 198          case INT_REP: {
 199             int j = PopTaggedInt();
 200             *p++ = j; *p++ = 0;
 201             argd_vec[i+1] = 'i';
 202             break;
 203          }
 204          case ADDR_REP: {
 205             void* a = PopTaggedAddr();
 206             if (sizeof(void*) == 4) {
 207                *(void**)p = a; p++; *p++ = 0;
 208                argd_vec[i+1] = 'i';
 209             } else {
 210                *(void**)p = a;
 211                p += 2;
 212                argd_vec[i+1] = 'I';
 213             }
 214             break;
 215          }
 216          case FLOAT_REP: {
 217             float f = PopTaggedFloat();
 218             *(float*)p = f; p++; *p++ = 0;
 219             argd_vec[i+1] = 'f';
 220             break;
 221          }
 222          case DOUBLE_REP: {
 223             double d = PopTaggedDouble();
 224             *(double*)p = d; p+=2;
 225             argd_vec[i+1] = 'F';
 226             break;
 227          }
 228          default:
 229             return 1;
 230       }
 231    }
 232
 233    if (d->num_results == 0) {
 234       argd_vec[0] = 'i';
 235    } else {
 236       switch (d->result_tys[0]) {
 237          case CHAR_REP: case INT_REP:
 238             argd_vec[0] = 'i'; break;
 239          case ADDR_REP:
 240             argd_vec[0] = (sizeof(void*)==4) ? 'i' : 'I'; break;
 241          case FLOAT_REP:
 242             argd_vec[0] = 'f'; break;
 243          case DOUBLE_REP:
 244             argd_vec[0] = 'F'; break;
 245          default:
 246             return 1;
 247       }
 248    }
 249
 250    PushPtr((StgPtr)(*bco));
 251    SaveThreadState();
 252
 253    //fprintf(stderr, " argc=%d  arg_vec=%p  argd_vec=%p `%s' fun=%p\n",
 254    //          d->num_args, arg_vec, argd_vec, argd_vec, fun );
 255
 256 #if 1
 257    universal_call_c_x86_linux (
 258       d->num_args, (void*)arg_vec, argd_vec, fun );
 259 #else
 260    universal_call_c_x86_generic (
 261       d->num_args, (void*)arg_vec, argd_vec, fun );
 262 #endif
 263    LoadThreadState();
 264    *bco=(StgBCO*)PopPtr();
 265
 266    if (d->num_results > 0) {
 267       p = (unsigned int*) &arg_vec[0];
 268       switch (d->result_tys[0]) {
 269          case CHAR_REP:
 270             PushTaggedChar ( (StgChar) p[0]);
 271             break;
 272          case INT_REP:
 273             PushTaggedInt ( ((StgInt*)p) [0] );
 274             break;
 275          case ADDR_REP:
 276             if (sizeof(void*) == 4)
 277                PushTaggedAddr ( ((StgAddr*)p) [0] );
 278             else
 279                PushTaggedAddr ( ((StgAddr*)p) [0] );
 280             break;
 281          case FLOAT_REP:
 282             PushTaggedFloat ( ((StgFloat*)p) [0] );
 283             break;
 284          case DOUBLE_REP:
 285             PushTaggedDouble ( ((StgDouble*)p) [0] );
 286             break;
 287          default:
 288             return 1;
 289       }
 290    }
 291
 292    return 0;
 293 }
 294
 295
 296
 297 CFunDescriptor* mkDescriptor( char* as, char* rs )
 298 {
 299     /* ToDo: don't use malloc */
 300     CFunDescriptor *d  = malloc(sizeof(CFunDescriptor));
 301     if (d == NULL) return d;
 302     d->arg_tys     = as;
 303     d->result_tys  = rs;
 304     d->num_args    = strlen(as);
 305     d->num_results = strlen(rs);
 306     return d;
 307 }
 308
 309
 310 #endif /* INTERPRETER */