// This is the C function that will get control when any callback is made. The "data"
// argument is the index of the entry in the callback table..
static void callbackEntryPt(ffi_cif *cif, void *ret, void* args[], void *data)
{
uintptr_t cbIndex = (uintptr_t)data;
ASSERT(cbIndex >= 0 && cbIndex < callBackEntries);
// We should get the task data for the thread that is running this code.
// If this thread has been created by the foreign code we will have to
// create a new one here.
TaskData *taskData = processes->GetTaskDataForThread();
if (taskData == 0)
{
try {
taskData = processes->CreateNewTaskData(0, 0, 0, TAGGED(0));
}
catch (std::bad_alloc &) {
::Exit("Unable to create thread data - insufficient memory");
}
catch (MemoryException &) {
::Exit("Unable to create thread data - insufficient memory");
}
}
else processes->ThreadUseMLMemory(taskData);
// We may get multiple calls to call-backs and we mustn't risk
// overflowing the save-vec.
Handle mark = taskData->saveVec.mark();
// In the future we might want to call C functions without some of the
// overhead that comes with an RTS call which may allocate in ML
// memory. If we do that we also have to ensure that callbacks
// don't allocate, so this code would have to change.
Handle mlEntryHandle;
{
// Get the ML function. Lock to avoid another thread moving
// callbackTable under our feet.
PLocker pLocker(&callbackTableLock);
struct _cbStructEntry *cbEntry = &callbackTable[cbIndex];
mlEntryHandle = taskData->saveVec.push(cbEntry->mlFunction);
}
// Create a pair of the arg vector and the result pointer.
Handle argHandle = toSysWord(taskData, args);
Handle resHandle = toSysWord(taskData, ret); // Result must go in here.
Handle pairHandle = alloc_and_save(taskData, 2);
pairHandle->WordP()->Set(0, argHandle->Word());
pairHandle->WordP()->Set(1, resHandle->Word());
// TODO: This calls BuildCodeSegment to allocate small stub code.
// They could easily be cached in X86TaskData::SetCallbackFunction at least
// up to the next GC.
taskData->EnterCallbackFunction(mlEntryHandle, pairHandle);
taskData->saveVec.reset(mark);
// Release ML memory now we're going back to C.
processes->ThreadReleaseMLMemory(taskData);
}
Handle cmem_load_32(TaskData *taskData, Handle indexH, Handle offsetH, Handle baseH)
{
// Load 32-bit int - In 32-bit mode this needs to be boxed
uint8_t *baseAddr =
*((uint8_t**)baseH->Word().AsAddress()) +
getPolySigned(taskData, offsetH->Word());
POLYSIGNED index = getPolySigned(taskData, indexH->Word());
return toSysWord(taskData, ((uint32_t*)baseAddr)[index]);
}
Handle cmem_load_64(TaskData *taskData, Handle indexH, Handle offsetH, Handle baseH)
{
uint8_t *baseAddr =
*((uint8_t**)baseH->Word().AsAddress()) +
getPolySigned(taskData, offsetH->Word());
POLYSIGNED index = getPolySigned(taskData, indexH->Word());
// Box the result.
return toSysWord(taskData, ((uint64_t*)baseAddr)[index]);
}
Handle poly_ffi(TaskData *taskData, Handle args, Handle code)
{
unsigned c = get_C_unsigned(taskData, code->Word());
switch (c)
{
case 0: // malloc
{
POLYUNSIGNED size = getPolyUnsigned(taskData, args->Word());
return toSysWord(taskData, malloc(size));
}
case 1: // free
{
void *mem = *(void**)(args->WordP());
free(mem);
return taskData->saveVec.push(TAGGED(0));
}
case 2: // Load library
{
TempString libName(args->Word());
#if (defined(_WIN32) && ! defined(__CYGWIN__))
HINSTANCE lib = LoadLibrary(libName);
if (lib == NULL)
{
char buf[256];
#if (defined(UNICODE))
_snprintf(buf, sizeof(buf), "Loading <%S> failed. Error %lu", libName, GetLastError());
#else
_snprintf(buf, sizeof(buf), "Loading <%s> failed. Error %lu", libName, GetLastError());
#endif
buf[sizeof(buf)-1] = 0; // Terminate just in case
raise_exception_string(taskData, EXC_foreign, buf);
}
#else
void *lib = dlopen(libName, RTLD_LAZY);
if (lib == NULL)
{
char buf[256];
snprintf(buf, sizeof(buf), "Loading <%s> failed: %s", (const char *)libName, dlerror());
buf[sizeof(buf)-1] = 0; // Terminate just in case
raise_exception_string(taskData, EXC_foreign, buf);
}
#endif
return toSysWord(taskData, lib);
}
case 3: // Load address of executable.
{
#if (defined(_WIN32) && ! defined(__CYGWIN__))
HINSTANCE lib = hApplicationInstance;
#else
void *lib = dlopen(NULL, RTLD_LAZY);
if (lib == NULL)
{
char buf[256];
snprintf(buf, sizeof(buf), "Loading address of executable failed: %s", dlerror());
buf[sizeof(buf)-1] = 0; // Terminate just in case
raise_exception_string(taskData, EXC_foreign, buf);
}
#endif
return toSysWord(taskData, lib);
}
case 4: // Unload library - Is this actually going to be used?
{
#if (defined(_WIN32) && ! defined(__CYGWIN__))
HMODULE hMod = *(HMODULE*)(args->WordP());
if (! FreeLibrary(hMod))
raise_syscall(taskData, "FreeLibrary failed", -(int)GetLastError());
#else
void *lib = *(void**)(args->WordP());
if (dlclose(lib) != 0)
{
char buf[256];
snprintf(buf, sizeof(buf), "dlclose failed: %s", dlerror());
buf[sizeof(buf)-1] = 0; // Terminate just in case
raise_exception_string(taskData, EXC_foreign, buf);
}
#endif
return taskData->saveVec.push(TAGGED(0));
}
case 5: // Load the address of a symbol from a library.
{
TempCString symName(args->WordP()->Get(1));
#if (defined(_WIN32) && ! defined(__CYGWIN__))
HMODULE hMod = *(HMODULE*)(args->WordP()->Get(0).AsAddress());
void *sym = (void*)GetProcAddress(hMod, symName);
if (sym == NULL)
{
char buf[256];
_snprintf(buf, sizeof(buf), "Loading symbol <%s> failed. Error %lu", symName, GetLastError());
buf[sizeof(buf)-1] = 0; // Terminate just in case
raise_exception_string(taskData, EXC_foreign, buf);
}
#else
void *lib = *(void**)(args->WordP()->Get(0).AsAddress());
void *sym = dlsym(lib, symName);
if (sym == NULL)
{
char buf[256];
snprintf(buf, sizeof(buf), "load_sym <%s> : %s", (const char *)symName, dlerror());
buf[sizeof(buf)-1] = 0; // Terminate just in case
raise_exception_string(taskData, EXC_foreign, buf);
}
#endif
return toSysWord(taskData, sym);
}
// Libffi functions
case 50: // Return a list of available ABIs
return makeList(taskData, sizeof(abiTable)/sizeof(abiTable[0]),
(char*)abiTable, sizeof(abiTable[0]), 0, mkAbitab);
case 51: // A constant from the table
{
unsigned index = get_C_unsigned(taskData, args->Word());
if (index >= sizeof(constantTable) / sizeof(constantTable[0]))
raise_exception_string(taskData, EXC_foreign, "Index out of range");
return Make_arbitrary_precision(taskData, constantTable[index]);
}
case 52: // Return an FFI type
{
unsigned index = get_C_unsigned(taskData, args->Word());
if (index >= sizeof(ffiTypeTable) / sizeof(ffiTypeTable[0]))
raise_exception_string(taskData, EXC_foreign, "Index out of range");
return toSysWord(taskData, ffiTypeTable[index]);
}
case 53: // Extract fields from ffi type.
{
ffi_type *ffit = *(ffi_type**)(args->WordP());
Handle sizeHandle = Make_arbitrary_precision(taskData, ffit->size);
Handle alignHandle = Make_arbitrary_precision(taskData, ffit->alignment);
Handle typeHandle = Make_arbitrary_precision(taskData, ffit->type);
Handle elemHandle = toSysWord(taskData, ffit->elements);
Handle resHandle = alloc_and_save(taskData, 4);
resHandle->WordP()->Set(0, sizeHandle->Word());
resHandle->WordP()->Set(1, alignHandle->Word());
resHandle->WordP()->Set(2, typeHandle->Word());
resHandle->WordP()->Set(3, elemHandle->Word());
return resHandle;
}
case 54: // Construct an ffi type.
{
// This is probably only used to create structs.
size_t size = getPolyUnsigned(taskData, args->WordP()->Get(0));
unsigned short align = get_C_ushort(taskData, args->WordP()->Get(1));
unsigned short type = get_C_ushort(taskData, args->WordP()->Get(2));
unsigned nElems = 0;
for (PolyWord p = args->WordP()->Get(3); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t)
nElems++;
size_t space = sizeof(ffi_type);
// If we need the elements add space for the elements plus
// one extra for the zero terminator.
if (nElems != 0) space += (nElems+1) * sizeof(ffi_type *);
ffi_type *result = (ffi_type*)malloc(space);
// Raise an exception rather than returning zero.
if (result == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM);
ffi_type **elem = 0;
if (nElems != 0) elem = (ffi_type **)(result+1);
memset(result, 0, sizeof(ffi_type)); // Zero it in case they add fields
result->size = size;
result->alignment = align;
result->type = type;
result->elements = elem;
if (elem != 0)
{
for (PolyWord p = args->WordP()->Get(3); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t)
{
PolyWord e = ((ML_Cons_Cell*)p.AsObjPtr())->h;
*elem++ = *(ffi_type**)(e.AsAddress());
}
*elem = 0;
}
return toSysWord(taskData, result);
}
case 55: // Create a CIF. This contains all the types and some extra information.
// The result is in allocated memory followed immediately by the argument type vector.
{
ffi_abi abi = (ffi_abi)get_C_ushort(taskData, args->WordP()->Get(0));
ffi_type *rtype = *(ffi_type **)args->WordP()->Get(1).AsAddress();
unsigned nArgs = 0;
for (PolyWord p = args->WordP()->Get(2); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t)
nArgs++;
// Allocate space for the cif followed by the argument type vector
size_t space = sizeof(ffi_cif) + nArgs * sizeof(ffi_type*);
ffi_cif *cif = (ffi_cif *)malloc(space);
if (cif == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM);
ffi_type **atypes = (ffi_type **)(cif+1);
// Copy the arguments types.
ffi_type **at = atypes;
for (PolyWord p = args->WordP()->Get(2); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t)
{
PolyWord e = ((ML_Cons_Cell*)p.AsObjPtr())->h;
*at++ = *(ffi_type**)(e.AsAddress());
}
ffi_status status = ffi_prep_cif(cif, abi, nArgs, rtype, atypes);
if (status == FFI_BAD_TYPEDEF)
raise_exception_string(taskData, EXC_foreign, "Bad typedef in ffi_prep_cif");
else if (status == FFI_BAD_ABI)
raise_exception_string(taskData, EXC_foreign, "Bad ABI in ffi_prep_cif");
else if (status != FFI_OK)
raise_exception_string(taskData, EXC_foreign, "Error in ffi_prep_cif");
return toSysWord(taskData, cif);
}
case 56: // Call a function.
{
ffi_cif *cif = *(ffi_cif **)args->WordP()->Get(0).AsAddress();
void *f = *(void**)args->WordP()->Get(1).AsAddress();
void *res = *(void**)args->WordP()->Get(2).AsAddress();
void **arg = *(void***)args->WordP()->Get(3).AsAddress();
// We release the ML memory across the call so a GC can occur
// even if this thread is blocked in the C code.
processes->ThreadReleaseMLMemory(taskData);
ffi_call(cif, FFI_FN(f), res, arg);
processes->ThreadUseMLMemory(taskData);
return taskData->saveVec.push(TAGGED(0));
}
case 57: // Create a callback.
{
#ifdef INTERPRETED
raise_exception_string(taskData, EXC_foreign, "Callbacks are not implemented in the byte code interpreter");
#endif
Handle mlFunction = taskData->saveVec.push(args->WordP()->Get(0));
ffi_cif *cif = *(ffi_cif **)args->WordP()->Get(1).AsAddress();
void *resultFunction;
// Allocate the memory. resultFunction is set to the executable address in or related to
// the memory.
ffi_closure *closure = (ffi_closure *)ffi_closure_alloc(sizeof(ffi_closure), &resultFunction);
if (closure == 0)
raise_exception_string(taskData, EXC_foreign, "Callbacks not implemented or insufficient memory");
PLocker pLocker(&callbackTableLock);
// Find a free entry in the table if there is one.
unsigned entryNo = 0;
while (entryNo < callBackEntries && callbackTable[entryNo].closureSpace != 0) entryNo++;
if (entryNo == callBackEntries)
{
// Need to grow the table.
struct _cbStructEntry *newTable =
(struct _cbStructEntry*)realloc(callbackTable, (callBackEntries+1)*sizeof(struct _cbStructEntry));
if (newTable == 0)
raise_exception_string(taskData, EXC_foreign, "Unable to allocate memory for callback table");
callbackTable = newTable;
callBackEntries++;
}
callbackTable[entryNo].mlFunction = mlFunction->Word();
callbackTable[entryNo].closureSpace = closure;
callbackTable[entryNo].resultFunction = resultFunction;
if (ffi_prep_closure_loc(closure, cif, callbackEntryPt, (void*)((uintptr_t)entryNo), resultFunction) != FFI_OK)
raise_exception_string(taskData, EXC_foreign,"libffi error: ffi_prep_closure_loc failed");
return toSysWord(taskData, resultFunction);
}
case 58: // Free an existing callback.
{
// The address returned from call 57 above is the executable address that can
// be passed as a callback function. The writable memory address returned
// as the result of ffi_closure_alloc may or may not be the same. To be safe
// we need to search the table.
void *resFun = *(void**)args->Word().AsAddress();
PLocker pLocker(&callbackTableLock);
unsigned i = 0;
while (i < callBackEntries)
{
if (callbackTable[i].resultFunction == resFun)
{
ffi_closure_free(callbackTable[i].closureSpace);
callbackTable[i].closureSpace = 0;
callbackTable[i].resultFunction = 0;
callbackTable[i].mlFunction = TAGGED(0); // Release the ML function
return taskData->saveVec.push(TAGGED(0));
}
}
raise_exception_string(taskData, EXC_foreign, "Invalid callback entry");
}
default:
{
char msg[100];
sprintf(msg, "Unknown ffi function: %d", c);
raise_exception_string(taskData, EXC_foreign, msg);
return 0;
}
}
}
static Handle toSysWord(TaskData *taskData, void *p)
{
return toSysWord(taskData, (uintptr_t)p);
}