+#include "Stable.h"
+
+#if defined(USE_LIBFFI_FOR_ADJUSTORS)
+#include "ffi.h"
+#include <string.h>
+#endif
+
+#if defined(i386_HOST_ARCH) && defined(darwin_HOST_OS)
+extern void adjustorCode(void);
+#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
+// from AdjustorAsm.s
+// not declared as a function so that AIX-style
+// fundescs can never get in the way.
+extern void *adjustorCode;
+#endif
+
+#if defined(USE_LIBFFI_FOR_ADJUSTORS)
+void
+freeHaskellFunctionPtr(void* ptr)
+{
+ ffi_closure *cl;
+
+ cl = (ffi_closure*)ptr;
+ freeStablePtr(cl->user_data);
+ stgFree(cl->cif->arg_types);
+ stgFree(cl->cif);
+ freeExec(cl);
+}
+
+static ffi_type * char_to_ffi_type(char c)
+{
+ switch (c) {
+ case 'v': return &ffi_type_void;
+ case 'f': return &ffi_type_float;
+ case 'd': return &ffi_type_double;
+ case 'L': return &ffi_type_sint64;
+ case 'l': return &ffi_type_uint64;
+ case 'W': return &ffi_type_sint32;
+ case 'w': return &ffi_type_uint32;
+ case 'S': return &ffi_type_sint16;
+ case 's': return &ffi_type_uint16;
+ case 'B': return &ffi_type_sint8;
+ case 'b': return &ffi_type_uint8;
+ case 'p': return &ffi_type_pointer;
+ default: barf("char_to_ffi_type: unknown type '%c'", c);
+ }
+}
+
+void*
+createAdjustor (int cconv,
+ StgStablePtr hptr,
+ StgFunPtr wptr,
+ char *typeString)
+{
+ ffi_cif *cif;
+ ffi_type **arg_types;
+ nat n_args, i;
+ ffi_type *result_type;
+ ffi_closure *cl;
+ int r, abi;
+ void *code;
+
+ n_args = strlen(typeString) - 1;
+ cif = stgMallocBytes(sizeof(ffi_cif), "createAdjustor");
+ arg_types = stgMallocBytes(n_args * sizeof(ffi_type*), "createAdjustor");
+
+ result_type = char_to_ffi_type(typeString[0]);
+ for (i=0; i < n_args; i++) {
+ arg_types[i] = char_to_ffi_type(typeString[i+1]);
+ }
+ switch (cconv) {
+#ifdef mingw32_TARGET_OS
+ case 0: /* stdcall */
+ abi = FFI_STDCALL;
+ break;
+#endif
+ case 1: /* ccall */
+ abi = FFI_DEFAULT_ABI;
+ break;
+ default:
+ barf("createAdjustor: convention %d not supported on this platform", cconv);
+ }
+
+ r = ffi_prep_cif(cif, abi, n_args, result_type, arg_types);
+ if (r != FFI_OK) barf("ffi_prep_cif failed: %d", r);
+
+ cl = allocateExec(sizeof(ffi_closure), &code);
+ if (cl == NULL) {
+ barf("createAdjustor: failed to allocate memory");
+ }
+
+ r = ffi_prep_closure(cl, cif, (void*)wptr, hptr/*userdata*/);
+ if (r != FFI_OK) barf("ffi_prep_closure failed: %d", r);
+
+ return (void*)code;
+}
+
+#else // To end of file...