Back to index

plt-scheme  4.2.1
ffi.c
Go to the documentation of this file.
00001 /* -----------------------------------------------------------------------
00002    ffi.c - Copyright (c) 1998, 2001, 2007 Red Hat, Inc.
00003    
00004    Alpha Foreign Function Interface 
00005 
00006    Permission is hereby granted, free of charge, to any person obtaining
00007    a copy of this software and associated documentation files (the
00008    ``Software''), to deal in the Software without restriction, including
00009    without limitation the rights to use, copy, modify, merge, publish,
00010    distribute, sublicense, and/or sell copies of the Software, and to
00011    permit persons to whom the Software is furnished to do so, subject to
00012    the following conditions:
00013 
00014    The above copyright notice and this permission notice shall be included
00015    in all copies or substantial portions of the Software.
00016 
00017    THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS
00018    OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
00019    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
00020    IN NO EVENT SHALL CYGNUS SOLUTIONS BE LIABLE FOR ANY CLAIM, DAMAGES OR
00021    OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
00022    ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
00023    OTHER DEALINGS IN THE SOFTWARE.
00024    ----------------------------------------------------------------------- */
00025 
00026 #include <ffi.h>
00027 #include <ffi_common.h>
00028 #include <stdlib.h>
00029 
00030 /* Force FFI_TYPE_LONGDOUBLE to be different than FFI_TYPE_DOUBLE;
00031    all further uses in this file will refer to the 128-bit type.  */
00032 #if defined(__LONG_DOUBLE_128__)
00033 # if FFI_TYPE_LONGDOUBLE != 4
00034 #  error FFI_TYPE_LONGDOUBLE out of date
00035 # endif
00036 #else
00037 # undef FFI_TYPE_LONGDOUBLE
00038 # define FFI_TYPE_LONGDOUBLE 4
00039 #endif
00040 
00041 extern void ffi_call_osf(void *, unsigned long, unsigned, void *, void (*)())
00042   FFI_HIDDEN;
00043 extern void ffi_closure_osf(void) FFI_HIDDEN;
00044 
00045 
00046 ffi_status
00047 ffi_prep_cif_machdep(ffi_cif *cif)
00048 {
00049   /* Adjust cif->bytes to represent a minimum 6 words for the temporary
00050      register argument loading area.  */
00051   if (cif->bytes < 6*FFI_SIZEOF_ARG)
00052     cif->bytes = 6*FFI_SIZEOF_ARG;
00053 
00054   /* Set the return type flag */
00055   switch (cif->rtype->type)
00056     {
00057     case FFI_TYPE_STRUCT:
00058     case FFI_TYPE_FLOAT:
00059     case FFI_TYPE_DOUBLE:
00060       cif->flags = cif->rtype->type;
00061       break;
00062 
00063     case FFI_TYPE_LONGDOUBLE:
00064       /* 128-bit long double is returned in memory, like a struct.  */
00065       cif->flags = FFI_TYPE_STRUCT;
00066       break;
00067 
00068     default:
00069       cif->flags = FFI_TYPE_INT;
00070       break;
00071     }
00072   
00073   return FFI_OK;
00074 }
00075 
00076 
00077 void
00078 ffi_call(ffi_cif *cif, void (*fn)(), void *rvalue, void **avalue)
00079 {
00080   unsigned long *stack, *argp;
00081   long i, avn;
00082   ffi_type **arg_types;
00083   
00084   /* If the return value is a struct and we don't have a return
00085      value address then we need to make one.  */
00086   if (rvalue == NULL && cif->flags == FFI_TYPE_STRUCT)
00087     rvalue = alloca(cif->rtype->size);
00088 
00089   /* Allocate the space for the arguments, plus 4 words of temp
00090      space for ffi_call_osf.  */
00091   argp = stack = alloca(cif->bytes + 4*FFI_SIZEOF_ARG);
00092 
00093   if (cif->flags == FFI_TYPE_STRUCT)
00094     *(void **) argp++ = rvalue;
00095 
00096   i = 0;
00097   avn = cif->nargs;
00098   arg_types = cif->arg_types;
00099 
00100   while (i < avn)
00101     {
00102       size_t size = (*arg_types)->size;
00103 
00104       switch ((*arg_types)->type)
00105        {
00106        case FFI_TYPE_SINT8:
00107          *(SINT64 *) argp = *(SINT8 *)(* avalue);
00108          break;
00109                 
00110        case FFI_TYPE_UINT8:
00111          *(SINT64 *) argp = *(UINT8 *)(* avalue);
00112          break;
00113                 
00114        case FFI_TYPE_SINT16:
00115          *(SINT64 *) argp = *(SINT16 *)(* avalue);
00116          break;
00117                 
00118        case FFI_TYPE_UINT16:
00119          *(SINT64 *) argp = *(UINT16 *)(* avalue);
00120          break;
00121                 
00122        case FFI_TYPE_SINT32:
00123        case FFI_TYPE_UINT32:
00124          /* Note that unsigned 32-bit quantities are sign extended.  */
00125          *(SINT64 *) argp = *(SINT32 *)(* avalue);
00126          break;
00127                 
00128        case FFI_TYPE_SINT64:
00129        case FFI_TYPE_UINT64:
00130        case FFI_TYPE_POINTER:
00131          *(UINT64 *) argp = *(UINT64 *)(* avalue);
00132          break;
00133 
00134        case FFI_TYPE_FLOAT:
00135          if (argp - stack < 6)
00136            {
00137              /* Note the conversion -- all the fp regs are loaded as
00138                doubles.  The in-register format is the same.  */
00139              *(double *) argp = *(float *)(* avalue);
00140            }
00141          else
00142            *(float *) argp = *(float *)(* avalue);
00143          break;
00144 
00145        case FFI_TYPE_DOUBLE:
00146          *(double *) argp = *(double *)(* avalue);
00147          break;
00148 
00149        case FFI_TYPE_LONGDOUBLE:
00150          /* 128-bit long double is passed by reference.  */
00151          *(long double **) argp = (long double *)(* avalue);
00152          size = sizeof (long double *);
00153          break;
00154 
00155        case FFI_TYPE_STRUCT:
00156          memcpy(argp, *avalue, (*arg_types)->size);
00157          break;
00158 
00159        default:
00160          FFI_ASSERT(0);
00161        }
00162 
00163       argp += ALIGN(size, FFI_SIZEOF_ARG) / FFI_SIZEOF_ARG;
00164       i++, arg_types++, avalue++;
00165     }
00166 
00167   ffi_call_osf(stack, cif->bytes, cif->flags, rvalue, fn);
00168 }
00169 
00170 
00171 ffi_status
00172 ffi_prep_closure_loc (ffi_closure* closure,
00173                     ffi_cif* cif,
00174                     void (*fun)(ffi_cif*, void*, void**, void*),
00175                     void *user_data,
00176                     void *codeloc)
00177 {
00178   unsigned int *tramp;
00179 
00180   tramp = (unsigned int *) &closure->tramp[0];
00181   tramp[0] = 0x47fb0401;    /* mov $27,$1        */
00182   tramp[1] = 0xa77b0010;    /* ldq $27,16($27)   */
00183   tramp[2] = 0x6bfb0000;    /* jmp $31,($27),0   */
00184   tramp[3] = 0x47ff041f;    /* nop               */
00185   *(void **) &tramp[4] = ffi_closure_osf;
00186 
00187   closure->cif = cif;
00188   closure->fun = fun;
00189   closure->user_data = user_data;
00190 
00191   /* Flush the Icache.
00192 
00193      Tru64 UNIX as doesn't understand the imb mnemonic, so use call_pal
00194      instead, since both Compaq as and gas can handle it.
00195 
00196      0x86 is PAL_imb in Tru64 UNIX <alpha/pal.h>.  */
00197   asm volatile ("call_pal 0x86" : : : "memory");
00198 
00199   return FFI_OK;
00200 }
00201 
00202 
00203 long FFI_HIDDEN
00204 ffi_closure_osf_inner(ffi_closure *closure, void *rvalue, unsigned long *argp)
00205 {
00206   ffi_cif *cif;
00207   void **avalue;
00208   ffi_type **arg_types;
00209   long i, avn, argn;
00210 
00211   cif = closure->cif;
00212   avalue = alloca(cif->nargs * sizeof(void *));
00213 
00214   argn = 0;
00215 
00216   /* Copy the caller's structure return address to that the closure
00217      returns the data directly to the caller.  */
00218   if (cif->flags == FFI_TYPE_STRUCT)
00219     {
00220       rvalue = (void *) argp[0];
00221       argn = 1;
00222     }
00223 
00224   i = 0;
00225   avn = cif->nargs;
00226   arg_types = cif->arg_types;
00227   
00228   /* Grab the addresses of the arguments from the stack frame.  */
00229   while (i < avn)
00230     {
00231       size_t size = arg_types[i]->size;
00232 
00233       switch (arg_types[i]->type)
00234        {
00235        case FFI_TYPE_SINT8:
00236        case FFI_TYPE_UINT8:
00237        case FFI_TYPE_SINT16:
00238        case FFI_TYPE_UINT16:
00239        case FFI_TYPE_SINT32:
00240        case FFI_TYPE_UINT32:
00241        case FFI_TYPE_SINT64:
00242        case FFI_TYPE_UINT64:
00243        case FFI_TYPE_POINTER:
00244        case FFI_TYPE_STRUCT:
00245          avalue[i] = &argp[argn];
00246          break;
00247 
00248        case FFI_TYPE_FLOAT:
00249          if (argn < 6)
00250            {
00251              /* Floats coming from registers need conversion from double
00252                 back to float format.  */
00253              *(float *)&argp[argn - 6] = *(double *)&argp[argn - 6];
00254              avalue[i] = &argp[argn - 6];
00255            }
00256          else
00257            avalue[i] = &argp[argn];
00258          break;
00259 
00260        case FFI_TYPE_DOUBLE:
00261          avalue[i] = &argp[argn - (argn < 6 ? 6 : 0)];
00262          break;
00263 
00264        case FFI_TYPE_LONGDOUBLE:
00265          /* 128-bit long double is passed by reference.  */
00266          avalue[i] = (long double *) argp[argn];
00267          size = sizeof (long double *);
00268          break;
00269 
00270        default:
00271          abort ();
00272        }
00273 
00274       argn += ALIGN(size, FFI_SIZEOF_ARG) / FFI_SIZEOF_ARG;
00275       i++;
00276     }
00277 
00278   /* Invoke the closure.  */
00279   closure->fun (cif, rvalue, avalue, closure->user_data);
00280 
00281   /* Tell ffi_closure_osf how to perform return type promotions.  */
00282   return cif->rtype->type;
00283 }