ghc/rts/ForeignCall.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * $Id: ForeignCall.c,v 1.10 1999/10/26 17:27:30 sewardj Exp $
   4  *
   5  * (c) The GHC Team 1994-1999.
   6  *
   7  * Implementation of foreign import and foreign export.
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11
  12 #ifdef INTERPRETER
  13
  14 #include "RtsUtils.h"    /* barf :-) */
  15 #include "Assembler.h"   /* for CFun stuff */
  16 #include "Evaluator.h"
  17 #include "ForeignCall.h"
  18
  19 /* Exports of this file:
  20       mkDescriptor
  21       ccall
  22       createAdjThunk
  23    Everything else is local, I think.
  24 */
  25
  26 /* ----------------------------------------------------------------------
  27  * Some misc-ery to begin with.
  28  * --------------------------------------------------------------------*/
  29
  30 CFunDescriptor* mkDescriptor( char* as, char* rs )
  31 {
  32     /* ToDo: don't use malloc */
  33     CFunDescriptor *d  = malloc(sizeof(CFunDescriptor));
  34     if (d == NULL) return d;
  35     d->arg_tys     = as;
  36     d->result_tys  = rs;
  37     d->num_args    = strlen(as);
  38     d->num_results = strlen(rs);
  39     return d;
  40 }
  41
  42
  43 /* ----------------------------------------------------------------------
  44  * Part the first: CALLING OUT -- foreign import
  45  * --------------------------------------------------------------------*/
  46
  47 /* SOME NOTES ABOUT PARAMETERISATION.
  48
  49    These pertain equally to foreign import and foreign export.
  50
  51    Implementations for calling in and out are very architecture
  52    dependent.  After some consideration, it appears that the two
  53    important factors are the instruction set, and the calling
  54    convention used.  Factors like the OS and compiler are not
  55    directly relevant.
  56
  57    So: routines which are architecture dependent are have
  58        _instructionsetname_callingconventionname attached to the
  59        the base name.  For example, code specific to the ccall
  60        convention on x86 would be suffixed _x86_ccall.
  61
  62    A third possible dimension of parameterisation relates to the
  63    split between callee and caller saves registers.  For example,
  64    x86_ccall code needs to assume a split, and different splits
  65    using ccall on x86 need different code.  However, that does not
  66    yet seem an issue, so it is ignored here.
  67 */
  68
  69
  70 /* ------------------------------------------------------------------
  71  * Calling out to C: a simple, universal calling API
  72  * ----------------------------------------------------------------*/
  73
  74 /* The universal call-C API supplies a single function:
  75
  76       void universal_call_c ( int   n_args,
  77                               void* args,
  78                               char* argstr,
  79                               void* fun )
  80
  81    PRECONDITIONS
  82
  83    args points to the start of a block of memory containing the
  84    arguments.  This block is an array of 8-byte entities,
  85    containing (n_args+1) slots.   The zeroth slot is where the
  86    return result goes. Slots [1 .. n_args] contain the arguments,
  87    presented left-to-right.
  88
  89    Arguments are stored in the host's byte ordering inside
  90    the slots.  Only 4 or 8 byte entities are allowed.
  91    4-byte entities are stored in the half-slot with lower
  92    addresses.
  93
  94    For example, a 32-bit value 0xAABBCCDD would be stored, on
  95    a little-endian, as
  96
  97       DD CC BB AA  0  0  0  0
  98
  99    whereas on a big-endian would expect
 100
 101       AA BB CC DD  0  0  0  0
 102
 103    Clients do not need to fill in the zero bytes; they are there
 104    only for illustration.
 105
 106    argstr is a simplified argument descriptor string.  argstr
 107    has one character for each (notional) argument slot of
 108    args.  That means the first byte of argstr describes the
 109    return type.  args should be allocated by the caller to hold
 110    as many slots as implied by argstr.
 111
 112    argstr always specifies a return type.  If the function to
 113    be called returns no result, you must specify a bogus
 114    return type in argstr[0]; a 32-bit int seems like a good bet.
 115
 116    Characters in argstr specify the result and argument types:
 117
 118       i    32-bit integral
 119       I    64-bit integral
 120       f    32-bit floating
 121       F    64-bit floating
 122
 123    Pointers should travel as integral entities.  At the moment
 124    there are no descriptors for entities smaller than 32 bits
 125    since AFAIK all calling conventions expand smaller entities
 126    to 32 bits anyway.  Users of this routine need to handle
 127    packing/unpacking of 16 and 8 bit quantities themselves.
 128
 129    If the preconditions are not met, behaviour of
 130    universal_call_c is entirely undefined.
 131
 132
 133    POSTCONDITION
 134
 135    The function specified by fun is called with arguments
 136    in args as specified by argstr.  The result of the call
 137    is placed in the first 8 bytes of args, again as specified
 138    by the first byte of argstr.  Calling and returning is to
 139    be done using the correct calling convention for the
 140    architecture.
 141
 142    It's clear that implementations of universal_call_c will
 143    have to be handwritten assembly.  The above design is intended
 144    to make that assembly as simple as possible, at the expense
 145    of a small amount of complication for the API's user.
 146
 147    These architecture-dependent assembly routines are in
 148    rts/universal_call_c.S.
 149 */
 150
 151
 152 /* ----------------------------------------------------------------*
 153  * External  refs for the assembly routines.
 154  * ----------------------------------------------------------------*/
 155
 156 #if i386_TARGET_ARCH
 157 extern void universal_call_c_x86_stdcall  ( int, void*, char*, void* );
 158 extern void universal_call_c_x86_ccall    ( int, void*, char*, void* );
 159 #else
 160 static void universal_call_c_generic      ( int, void*, char*, void* );
 161 #endif
 162
 163 /* ----------------------------------------------------------------*
 164  * This is a generic version of universal call that
 165  * only works for specific argument patterns.
 166  *
 167  * It allows ports to work on the Hugs Prelude immediately,
 168  * even if universal_call_c_arch_callingconvention is not available.
 169  * ----------------------------------------------------------------*/
 170
 171 static void universal_call_c_generic
 172 ( int   n_args,
 173   void* args,
 174   char* argstr,
 175   void* fun )
 176 {
 177   unsigned int *p = (unsigned int*) args;
 178
 179 #define ARG(n)  (p[n*2])
 180 #define CMP(str) ((n_args + 1 == strlen(str)) && \
 181                   (!strncmp(str,argstr,n_args + 1)))
 182
 183 #define CALL(retType,callTypes,callVals) \
 184         ((retType(*)callTypes)(fun))callVals
 185
 186   if (CMP("i")) {
 187     int res = CALL(int,(void),());
 188     ARG(0) = res;
 189   } else if (CMP("ii")) {
 190     int arg1 = (int) ARG(1);
 191     int res = CALL(int,(int),(arg1));
 192     ARG(0) = res;
 193   } else if (CMP("iii")) {
 194     int arg1 = (int) ARG(1);
 195     int arg2 = (int) ARG(2);
 196     int res = CALL(int,(int,int),(arg1,arg2));
 197     ARG(0) = res;
 198   } else {
 199     /* Do not have the generic call for this argument list. */
 200     int i;
 201     printf("Can not call external function at address %d\n",(int)fun);
 202     printf("Argument string = '");
 203     for(i=0;i<n_args;i++) {
 204       printf("%c",(char)argstr[i]);
 205     }
 206     printf("' [%d arg(s)]\n",n_args);
 207     assert(0);
 208   }
 209 #undef CALL
 210 #undef CMP
 211 #undef ARG
 212 }
 213
 214
 215 /* ----------------------------------------------------------------*
 216  * Move args/results between STG stack and the above API's arg block
 217  * Returns 0 on success
 218  *         1 if too many args/results or non-handled type
 219  *         2 if config error on this platform
 220  * Tries to automatically handle 32-vs-64 bit differences.
 221  * Assumes an LP64 programming model for 64 bit:
 222  *    sizeof(long)==sizeof(void*)==64  on a 64 bit platform
 223  *    sizeof(int)==32                  on a 64 bit platform
 224  * This code attempts to be architecture neutral (viz, generic).
 225  * ----------------------------------------------------------------*/
 226
 227 int ccall ( CFunDescriptor*  d,
 228             void             (*fun)(void),
 229             StgBCO**         bco,
 230             char             cc
 231           )
 232 {
 233    double         arg_vec [31];
 234    char           argd_vec[31];
 235    unsigned int*  p;
 236    int            i;
 237    unsigned long  ul;
 238
 239    if (sizeof(int) != 4 || sizeof(double) != 8 || sizeof(float) != 4
 240        || (sizeof(void*) != 4 && sizeof(void*) != 8)
 241        || (sizeof(unsigned long) != sizeof(void*)))
 242       return 2;
 243
 244    if (d->num_args > 30 || d->num_results > 1)
 245       return 1; /* unlikely, but ... */
 246
 247    p = (unsigned int*) &arg_vec[1];
 248    for (i = 0; i < d->num_args; i++) {
 249       switch (d->arg_tys[i]) {
 250
 251          case INT_REP:
 252             ul = (unsigned long)PopTaggedInt();
 253             goto common_int32_or_64;
 254          case WORD_REP:
 255             ul = (unsigned long)PopTaggedWord();
 256             goto common_int32_or_64;
 257          case ADDR_REP:
 258             ul = (unsigned long)(PopTaggedAddr());
 259             goto common_int32_or_64;
 260          case STABLE_REP:
 261             ul = (unsigned long)PopTaggedStablePtr();
 262             common_int32_or_64:
 263             if (sizeof(void*) == 4) {
 264                *(unsigned long *)p = ul; p++; *p++ = 0;
 265                argd_vec[i+1] = 'i';
 266             } else {
 267                *(unsigned long *)p = ul;
 268                p += 2;
 269                argd_vec[i+1] = 'I';
 270             }
 271             break;
 272
 273          case CHAR_REP: {
 274             int j = (int)PopTaggedChar();
 275             *p++ = j; *p++ = 0;
 276             argd_vec[i+1] = 'i';
 277             break;
 278          }
 279          case FLOAT_REP: {
 280             float f = PopTaggedFloat();
 281             *(float*)p = f; p++; *p++ = 0;
 282             argd_vec[i+1] = 'f';
 283             break;
 284          }
 285          case DOUBLE_REP: {
 286             double d = PopTaggedDouble();
 287             *(double*)p = d; p+=2;
 288             argd_vec[i+1] = 'F';
 289             break;
 290          }
 291          default:
 292             return 1;
 293       }
 294    }
 295
 296    if (d->num_results == 0) {
 297       argd_vec[0] = 'i';
 298    } else {
 299       switch (d->result_tys[0]) {
 300          case INT_REP: case WORD_REP: case ADDR_REP: case STABLE_REP:
 301             argd_vec[0] = (sizeof(void*)==4) ? 'i' : 'I'; break;
 302          case CHAR_REP:
 303             argd_vec[0] = 'i'; break;
 304          case FLOAT_REP:
 305             argd_vec[0] = 'f'; break;
 306          case DOUBLE_REP:
 307             argd_vec[0] = 'F'; break;
 308          default:
 309             return 1;
 310       }
 311    }
 312
 313    PushPtr((StgPtr)(*bco));
 314    SaveThreadState();
 315
 316 #if i386_TARGET_ARCH
 317    if (cc == 'c')
 318       universal_call_c_x86_ccall (
 319          d->num_args, (void*)arg_vec, argd_vec, fun );
 320    else if (cc == 's')
 321       universal_call_c_x86_stdcall (
 322          d->num_args, (void*)arg_vec, argd_vec, fun );
 323    else barf ( "ccall(i386): unknown calling convention" );
 324 #else
 325    universal_call_c_generic (
 326       d->num_args, (void*)arg_vec, argd_vec, fun );
 327 #endif
 328    LoadThreadState();
 329    *bco=(StgBCO*)PopPtr();
 330
 331    /* INT, WORD, ADDR, STABLE don't need to do a word-size check
 332       since the result is in the bytes starting at p regardless. */
 333
 334    if (d->num_results > 0) {
 335       p = (unsigned int*) &arg_vec[0];
 336       switch (d->result_tys[0]) {
 337
 338          case INT_REP:
 339             PushTaggedInt ( ((StgInt*)p) [0] );
 340             break;
 341          case WORD_REP:
 342             PushTaggedWord ( ((StgWord*)p) [0] );
 343             break;
 344          case ADDR_REP:
 345             PushTaggedAddr ( ((StgAddr*)p) [0] );
 346             break;
 347          case STABLE_REP:
 348             PushTaggedStablePtr ( ((StgStablePtr*)p) [0] );
 349             break;
 350
 351          case CHAR_REP:
 352             PushTaggedChar ( (StgChar) p[0]);
 353             break;
 354          case FLOAT_REP:
 355             PushTaggedFloat ( ((StgFloat*)p) [0] );
 356             break;
 357          case DOUBLE_REP:
 358             PushTaggedDouble ( ((StgDouble*)p) [0] );
 359             break;
 360
 361          default:
 362             return 1;
 363       }
 364    }
 365
 366    return 0;
 367 }
 368
 369
 370
 371 /* ----------------------------------------------------------------------
 372  * Part the second: CALLING IN -- foreign export {dynamic}
 373  * --------------------------------------------------------------------*/
 374
 375 /* Make it possible for the evaluator to get hold of bytecode
 376    for a given function by name.  Useful but a hack.  Sigh.
 377  */
 378 extern void* getHugs_AsmObject_for ( char* s );
 379
 380
 381 /* ----------------------------------------------------------------*
 382  * The implementation for x86_ccall and x86_stdcall.
 383  * ----------------------------------------------------------------*/
 384
 385 static
 386 HaskellObj
 387 unpackArgsAndCallHaskell_x86_nocallconv_wrk ( StgStablePtr stableptr,
 388                                               char* tydesc, char* args)
 389 {
 390    /* Copy args out of the C stack frame in an architecture
 391       dependent fashion, under the direction of the type description
 392       string tydesc.  Dereference the stable pointer, giving the
 393       Haskell function to call.  Build an application of this to
 394       the arguments, and finally wrap primRunST round the whole
 395       thing, since we know it returns an IO type.  Then evaluate
 396       the whole, which leaves nodeOut as the evaluated 'a', where
 397       the type of the function called is .... -> IO a.
 398
 399       We can't immediately unpack the results and return, since
 400       int results need to return in a different register (%eax and
 401       possibly %edx) from float things (%st(0)).  So return nodeOut
 402       to the relevant wrapper function, which knows enough about
 403       the return type to do the Right Thing.
 404
 405       There's no getting round it: this is most heinous hack.
 406    */
 407
 408    HaskellObj      node;
 409    HaskellObj      nodeOut;
 410    SchedulerStatus sstat;
 411
 412    char* resp = tydesc;
 413    char* argp = tydesc;
 414
 415    node = (HaskellObj)deRefStablePtr(stableptr);
 416
 417    if (*argp != ':') argp++;
 418    ASSERT( *argp == ':' );
 419    argp++;
 420    while (*argp) {
 421       switch (*argp) {
 422          case CHAR_REP:
 423             node = rts_apply ( node, rts_mkChar ( *(char*)args ) );
 424             args += 4;
 425             break;
 426          case INT_REP:
 427             node = rts_apply ( node, rts_mkInt ( *(int*)args ) );
 428             args += 4;
 429             break;
 430          case WORD_REP:
 431             node = rts_apply ( node, rts_mkWord ( *(unsigned int*)args ) );
 432             args += 4;
 433             break;
 434          case ADDR_REP:
 435             node = rts_apply ( node, rts_mkAddr ( *(void**)args ) );
 436             args += 4;
 437             break;
 438          case STABLE_REP:
 439             node = rts_apply ( node, rts_mkStablePtr ( *(int*)args ) );
 440             args += 4;
 441             break;
 442          case FLOAT_REP:
 443             node = rts_apply ( node, rts_mkFloat ( *(float*)args ) );
 444             args += 4;
 445             break;
 446          case DOUBLE_REP:
 447             node = rts_apply ( node, rts_mkDouble ( *(double*)args ) );
 448             args += 8;
 449             break;
 450          default:
 451             barf(
 452                "unpackArgsAndCallHaskell_x86_nocallconv: "
 453                "unexpected arg type rep");
 454       }
 455       argp++;
 456    }
 457
 458    node = rts_apply (
 459              asmClosureOfObject(getHugs_AsmObject_for("primRunST")),
 460              node );
 461
 462    sstat = rts_eval ( node, &nodeOut );
 463    if (sstat != Success)
 464       barf ("unpackArgsAndCallHaskell_x86_nocallconv: eval failed");
 465
 466    return nodeOut;
 467 }
 468
 469
 470 static
 471 double
 472 unpackArgsAndCallHaskell_x86_nocallconv_DOUBLE (
 473       StgStablePtr stableptr, char* tydesc, char* args
 474    )
 475 {
 476    HaskellObj nodeOut
 477       = unpackArgsAndCallHaskell_x86_nocallconv_wrk (
 478            stableptr, tydesc, args
 479         );
 480    /* Return a double.  This return will go into %st(0), which
 481       is unmodified by the adjustor thunk.
 482    */
 483    ASSERT(tydesc[0] == DOUBLE_REP);
 484    return rts_getDouble(nodeOut);
 485 }
 486
 487
 488 static
 489 float
 490 unpackArgsAndCallHaskell_x86_nocallconv_FLOAT (
 491       StgStablePtr stableptr, char* tydesc, char* args
 492    )
 493 {
 494    HaskellObj nodeOut
 495       = unpackArgsAndCallHaskell_x86_nocallconv_wrk (
 496            stableptr, tydesc, args
 497         );
 498    /* Probably could be merged with the double case, since %st(0) is
 499       still the return register.
 500    */
 501    ASSERT(tydesc[0] == FLOAT_REP);
 502    return rts_getFloat(nodeOut);
 503 }
 504
 505
 506 static
 507 unsigned long
 508 unpackArgsAndCallHaskell_x86_nocallconv_INTISH (
 509       StgStablePtr stableptr, char* tydesc, char* args
 510    )
 511 {
 512    HaskellObj nodeOut
 513       = unpackArgsAndCallHaskell_x86_nocallconv_wrk (
 514            stableptr, tydesc, args
 515         );
 516    /* A complete hack.  We know that all these returns will be
 517       put into %eax (and %edx, if it is a 64-bit return), and
 518       the adjustor thunk will then itself return to the original
 519       (C-world) caller without modifying %eax or %edx, so the
 520       original caller will be a Happy Bunny.
 521    */
 522    switch (*tydesc) {
 523       case ':':        return 0;
 524       case CHAR_REP:   return (unsigned long)rts_getChar(nodeOut);
 525       case INT_REP:    return (unsigned long)rts_getInt(nodeOut);
 526       case WORD_REP:   return (unsigned long)rts_getWord(nodeOut);
 527       case ADDR_REP:   return (unsigned long)rts_getAddr(nodeOut);
 528       case STABLE_REP: return (unsigned long)rts_getStablePtr(nodeOut);
 529       default:
 530          barf(
 531             "unpackArgsAndCallHaskell_x86_nocallconv: "
 532             "unexpected res type rep");
 533    }
 534 }
 535
 536
 537 /* This is a bit subtle, since it can deal with both stdcall
 538    and ccall.  There are two call transitions to consider:
 539
 540    1.  The call to "here".  If it's a ccall, we can return
 541        using 'ret 0' and let the caller remove the args.
 542        If stdcall, we have to return with 'ret N', where
 543        N is the size of the args passed.  N has to be
 544        determined by inspecting the type descriptor string
 545        typestr.
 546
 547    2.  The call to unpackArgsAndCallHaskell_x86_anycallconv_*.
 548        Whether these are done with stdcall or ccall depends on
 549        the conventions applied by the compiler that translated
 550        those procedures.  Fortunately, we can sidestep what it
 551        did by saving esp (in ebx), pushing the three args,
 552        calling unpack..., and restoring esp from ebx.  This
 553        trick assumes that ebx is a callee-saves register, so
 554        its value will be preserved across the unpack... call.
 555 */
 556 static
 557 StgAddr createAdjThunk_x86 ( StgStablePtr stableptr,
 558                              StgAddr      typestr,
 559                              char         callconv )
 560 {
 561    unsigned char* codeblock;
 562    unsigned char* cp;
 563    unsigned int   ch;
 564    unsigned int   nwords;
 565
 566    unsigned char* argp = (unsigned char*)typestr;
 567    unsigned int   ts   = (unsigned int)typestr;
 568    unsigned int   sp   = (unsigned int)stableptr;
 569
 570    if (((char*)typestr)[0] == DOUBLE_REP)
 571       ch = (unsigned int)
 572               &unpackArgsAndCallHaskell_x86_nocallconv_DOUBLE;
 573    else if (((char*)typestr)[0] == FLOAT_REP)
 574       ch = (unsigned int)
 575               &unpackArgsAndCallHaskell_x86_nocallconv_FLOAT;
 576    else
 577       ch = (unsigned int)
 578               &unpackArgsAndCallHaskell_x86_nocallconv_INTISH;
 579
 580    codeblock = malloc ( 0x26 );
 581    if (!codeblock)
 582       barf ( "createAdjThunk_x86: can't malloc memory\n");
 583
 584    if (callconv == 's') {
 585       nwords = 0;
 586       if (*argp != ':') argp++;
 587       ASSERT( *argp == ':' );
 588       argp++;
 589       while (*argp) {
 590          switch (*argp) {
 591             case CHAR_REP: case INT_REP: case WORD_REP:
 592             case ADDR_REP: case STABLE_REP: case FLOAT_REP:
 593                nwords += 4; break;
 594             case DOUBLE_REP:
 595                nwords += 8; break;
 596             default:
 597                barf("createAdjThunk_x86: unexpected type descriptor");
 598          }
 599          argp++;
 600       }
 601    } else
 602    if (callconv == 'c') {
 603       nwords = 0;
 604    } else {
 605       barf ( "createAdjThunk_x86: unknown calling convention\n");
 606    }
 607
 608    cp = codeblock;
 609    /*
 610       0000 53           pushl %ebx        # save caller's registers
 611       0001 51           pushl %ecx
 612       0002 56           pushl %esi
 613       0003 57           pushl %edi
 614       0004 55           pushl %ebp
 615       0005 89E0         movl %esp,%eax    # sp -> eax
 616       0007 83C018       addl $24,%eax     # move eax back over 5 saved regs + retaddr
 617       000a 89E3         movl %esp,%ebx    # remember sp before pushing args
 618       000c 50           pushl %eax        # push arg-block addr
 619       000d 6844332211   pushl $0x11223344 # push addr of type descr string
 620       0012 6877665544   pushl $0x44556677 # push stableptr to closure
 621       0017 E8BBAA9988   call 0x8899aabb   # SEE COMMENT BELOW
 622                                           # return value is in %eax, or %eax:%edx,
 623                                           # or %st(0), so don't trash these regs
 624                                           # between here and 'ret'
 625       001c 89DC         movl %ebx,%esp    # restore sp from remembered value
 626       001e 5D           popl %ebp         # restore caller's registers
 627       001f 5F           popl %edi
 628       0020 5E           popl %esi
 629       0021 59           popl %ecx
 630       0022 5B           popl %ebx
 631       0023 C27766       ret  $0x6677      # return, clearing args if stdcall
 632    */
 633    *cp++ = 0x53;
 634    *cp++ = 0x51;
 635    *cp++ = 0x56;
 636    *cp++ = 0x57;
 637    *cp++ = 0x55;
 638    *cp++ = 0x89; *cp++ = 0xE0;
 639    *cp++ = 0x83; *cp++ = 0xC0; *cp++ = 0x18;
 640    *cp++ = 0x89; *cp++ = 0xE3;
 641    *cp++ = 0x50;
 642    *cp++ = 0x68; *cp++=ts;ts>>=8; *cp++=ts;ts>>=8; *cp++=ts;ts>>=8; *cp++=ts;
 643    *cp++ = 0x68; *cp++=sp;sp>>=8; *cp++=sp;sp>>=8; *cp++=sp;sp>>=8; *cp++=sp;
 644
 645    /* call address needs to be: displacement relative to next insn */
 646    ch = ch - ( ((unsigned int)cp) + 5);
 647    *cp++ = 0xE8; *cp++=ch;ch>>=8; *cp++=ch;ch>>=8; *cp++=ch;ch>>=8; *cp++=ch;
 648
 649    *cp++ = 0x89; *cp++ = 0xDC;
 650    *cp++ = 0x5D;
 651    *cp++ = 0x5F;
 652    *cp++ = 0x5E;
 653    *cp++ = 0x59;
 654    *cp++ = 0x5B;
 655    *cp++ = 0xC2; *cp++=nwords;nwords>>=8; *cp++=nwords;
 656
 657    return codeblock;
 658 }
 659
 660
 661 /* ----------------------------------------------------------------*
 662  * The only function involved in foreign-export that needs to be
 663  * visible outside this file.
 664  * ----------------------------------------------------------------*/
 665
 666 StgAddr createAdjThunk ( StgStablePtr stableptr,
 667                          StgAddr      typestr,
 668                          StgChar      callconv )
 669 {
 670    return
 671 #if i386_TARGET_ARCH
 672       createAdjThunk_x86 ( stableptr, typestr, callconv );
 673 #else
 674       0;
 675       #warn foreign export not implemented on this architecture
 676 #endif
 677 }
 678
 679
 680 #endif /* INTERPRETER */
 681