diff --git a/Makefile b/Makefile index 79ca2d024c..fa084ae0e5 100644 --- a/Makefile +++ b/Makefile @@ -22,7 +22,8 @@ OBJS = native/arithmetic.o native/array.o native/bignum.o \ native/unix/socket.o \ native/unix/signal.o \ native/unix/read.o \ - native/unix/write.o + native/unix/write.o \ + native/unix/ffi.o default: @echo "Run 'make' with one of the following parameters:" diff --git a/factor.vcproj b/factor.vcproj index b45205b0a8..0f86356cea 100644 --- a/factor.vcproj +++ b/factor.vcproj @@ -19,7 +19,7 @@ + + + + + + + + @@ -235,6 +250,23 @@ + + + + + + + + #endif -#ifdef FFI +#if defined(FFI) && !defined(WIN32) #include #endif /* FFI */ @@ -122,9 +122,9 @@ typedef unsigned char BYTE; #include "float.h" #include "complex.h" #include "arithmetic.h" +#include "string.h" #include "misc.h" #include "relocate.h" -#include "string.h" #include "sbuf.h" #include "port.h" #include "io.h" diff --git a/native/ffi.c b/native/ffi.c index 628faea611..aa97cdf0e6 100644 --- a/native/ffi.c +++ b/native/ffi.c @@ -9,86 +9,6 @@ DLL* untag_dll(CELL tagged) return (DLL*)UNTAG(tagged); } -void primitive_dlopen(void) -{ -#ifdef FFI - char* path; - void* dllptr; - DLL* dll; - - maybe_garbage_collection(); - - path = unbox_c_string(); - dllptr = dlopen(path,RTLD_LAZY); - - if(dllptr == NULL) - { - general_error(ERROR_FFI,tag_object( - from_c_string(dlerror()))); - } - - dll = allot_object(DLL_TYPE,sizeof(DLL)); - dll->dll = dllptr; - dpush(tag_object(dll)); -#else - general_error(ERROR_FFI_DISABLED,F); -#endif -} - -void primitive_dlsym(void) -{ -#ifdef FFI - DLL* dll = untag_dll(dpop()); - void* sym = dlsym(dll->dll,unbox_c_string()); - if(sym == NULL) - { - general_error(ERROR_FFI,tag_object( - from_c_string(dlerror()))); - } - dpush(tag_cell((CELL)sym)); -#else - general_error(ERROR_FFI_DISABLED,F); -#endif -} - -void primitive_dlsym_self(void) -{ -#if defined(FFI) - void* sym = dlsym(NULL,unbox_c_string()); - if(sym == NULL) - { - general_error(ERROR_FFI,tag_object( - from_c_string(dlerror()))); - } - dpush(tag_cell((CELL)sym)); -#elif defined(WIN32) - void *sym = GetProcAddress(GetModuleHandle(NULL), unbox_c_string()); - if(sym == NULL) - { - general_error(ERROR_FFI, tag_object( - from_c_string("bad symbol"))); - } - dpush(tag_cell((CELL)sym)); -#else - general_error(ERROR_FFI_DISABLED,F); -#endif -} - -void primitive_dlclose(void) -{ -#ifdef FFI - DLL* dll = untag_dll(dpop()); - if(dlclose(dll->dll) == -1) - { - general_error(ERROR_FFI,tag_object( - from_c_string(dlerror()))); - } - dll->dll = NULL; -#else - general_error(ERROR_FFI_DISABLED,F); -#endif -} - #ifdef FFI CELL unbox_alien(void) { diff --git a/native/misc.c b/native/misc.c index ed21986f06..cc64f52ba7 100644 --- a/native/misc.c +++ b/native/misc.c @@ -57,3 +57,26 @@ void primitive_random_int(void) maybe_garbage_collection(); dpush(tag_object(s48_long_to_bignum(rand()))); } + +#ifdef WIN32 +F_STRING *last_error() +{ + char *buffer; + F_STRING *error; + DWORD dw = GetLastError(); + + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | + FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + dw, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &buffer, + 0, NULL); + + error = from_c_string(buffer); + LocalFree(buffer); + + return error; +} +#endif diff --git a/native/misc.h b/native/misc.h index a0035d013d..af9ee2c461 100644 --- a/native/misc.h +++ b/native/misc.h @@ -5,3 +5,7 @@ int64_t current_millis(void); void primitive_millis(void); void primitive_init_random(void); void primitive_random_int(void); +#ifdef WIN32 +F_STRING *last_error(); +#endif + diff --git a/native/port.c b/native/port.c index 9297a67ace..0c8d4813e2 100644 --- a/native/port.c +++ b/native/port.c @@ -67,24 +67,9 @@ void collect_port(F_PORT* port) #ifdef WIN32 CELL make_io_error(const char* func) { - char *buffer; F_STRING *function = from_c_string(func); - F_STRING *error; - DWORD dw = GetLastError(); - - FormatMessage( - FORMAT_MESSAGE_ALLOCATE_BUFFER | - FORMAT_MESSAGE_FROM_SYSTEM, - NULL, - dw, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), - (LPTSTR) &buffer, - 0, NULL); - error = from_c_string(buffer); - LocalFree(buffer); - - return cons(tag_object(function),cons(tag_object(error),F)); + return cons(tag_object(function),cons(tag_object(last_error()),F)); } #else CELL make_io_error(const char* func) diff --git a/native/unix/ffi.c b/native/unix/ffi.c new file mode 100644 index 0000000000..9915b8e30b --- /dev/null +++ b/native/unix/ffi.c @@ -0,0 +1,73 @@ +#include "../factor.h" + +void primitive_dlopen(void) +{ +#ifdef FFI + char* path; + void* dllptr; + DLL* dll; + + maybe_garbage_collection(); + + path = unbox_c_string(); + dllptr = dlopen(path,RTLD_LAZY); + + if(dllptr == NULL) + { + general_error(ERROR_FFI,tag_object( + from_c_string(dlerror()))); + } + + dll = allot_object(DLL_TYPE,sizeof(DLL)); + dll->dll = dllptr; + dpush(tag_object(dll)); +#else + general_error(ERROR_FFI_DISABLED,F); +#endif +} + +void primitive_dlsym(void) +{ +#ifdef FFI + DLL* dll = untag_dll(dpop()); + void* sym = dlsym(dll->dll,unbox_c_string()); + if(sym == NULL) + { + general_error(ERROR_FFI,tag_object( + from_c_string(dlerror()))); + } + dpush(tag_cell((CELL)sym)); +#else + general_error(ERROR_FFI_DISABLED,F); +#endif +} + +void primitive_dlsym_self(void) +{ +#if defined(FFI) + void* sym = dlsym(NULL,unbox_c_string()); + if(sym == NULL) + { + general_error(ERROR_FFI,tag_object( + from_c_string(dlerror()))); + } + dpush(tag_cell((CELL)sym)); +#else + general_error(ERROR_FFI_DISABLED,F); +#endif +} + +void primitive_dlclose(void) +{ +#ifdef FFI + DLL* dll = untag_dll(dpop()); + if(dlclose(dll->dll) == -1) + { + general_error(ERROR_FFI,tag_object( + from_c_string(dlerror()))); + } + dll->dll = NULL; +#else + general_error(ERROR_FFI_DISABLED,F); +#endif +} diff --git a/native/win32/ffi.c b/native/win32/ffi.c new file mode 100644 index 0000000000..3adf154632 --- /dev/null +++ b/native/win32/ffi.c @@ -0,0 +1,66 @@ +#include "../factor.h" + +void primitive_dlopen (void) +{ +#ifdef FFI + char *path; + HMODULE module; + DLL *dll; + + maybe_garbage_collection(); + + path = unbox_c_string(); + module = LoadLibrary(path); + + if (!module) + general_error(ERROR_FFI, tag_object(last_error())); + + dll = allot_object(DLL_TYPE, sizeof(DLL)); + dll->dll = module; + dpush(tag_object(dll)); +#else + general_error(ERROR_FFI_DISABLED, F); +#endif +} + +void primitive_dlsym (void) +{ +#ifdef FFI + DLL *dll = untag_dll(dpop()); + void *sym = GetProcAddress((HMODULE)dll->dll, unbox_c_string()); + + + if (!sym) + general_error(ERROR_FFI, tag_object(last_error())); + + dpush(tag_cell((CELL)sym)); +#else + general_error(ERROR_FFI_DISABLED, F); +#endif +} + +void primitive_dlclose (void) +{ +#ifdef FFI + DLL *dll = untag_dll(dpop()); + FreeLibrary((HMODULE)dll->dll); + dll->dll = NULL; +#else + general_error(ERROR_FFI_DISABLED, F); +#endif +} + +void primitive_dlsym_self (void) +{ +#ifdef FFI + void *sym = GetProcAddress(GetModuleHandle(NULL), unbox_c_string()); + + if(sym == NULL) + { + general_error(ERROR_FFI, tag_object(last_error())); + } + dpush(tag_cell((CELL)sym)); +#else + general_error(ERROR_FFI_DISABLED, F); +#endif +} diff --git a/native/win32/io.c b/native/win32/io.c index 8ff58cb90d..53e034bdab 100644 --- a/native/win32/io.c +++ b/native/win32/io.c @@ -17,6 +17,7 @@ void primitive_add_copy_io_task (void) void primitive_close (void) { F_PORT *port = untag_port(dpop()); + CloseHandle((HANDLE)port->fd); port->closed = true; }