1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-28 19:19:53 +00:00

Add stubs that are precursor to FFI.

FFI may be best implemented as an external library
(libffi has incompatible license to Janet) or as code
that takes void * and wraps then into Janet C functions
given a function signature. Either way, we need to some way
to load symbols from arbitrary dynamic libraries.
This commit is contained in:
Calvin Rose 2022-06-06 10:49:30 -05:00
parent e69bbff195
commit 8d1ad99f42
2 changed files with 71 additions and 18 deletions

View File

@ -49,10 +49,13 @@ typedef int Clib;
#define load_clib(name) ((void) name, 0)
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
#define error_clib() "dynamic libraries not supported"
#define free_clib(c) ((void) (c), 0)
#elif defined(JANET_WINDOWS)
#include <windows.h>
typedef HINSTANCE Clib;
#define load_clib(name) LoadLibrary((name))
#define free_clib(c) FreeLibrary((c))
#elif defined(JANET_WINDOWS)
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
static char error_clib_buf[256];
static char *error_clib(void) {
@ -66,6 +69,7 @@ static char *error_clib(void) {
#include <dlfcn.h>
typedef void *Clib;
#define load_clib(name) dlopen((name), RTLD_NOW)
#define free_clib(lib) dlclose((lib))
#define symbol_clib(lib, sym) dlsym((lib), (sym))
#define error_clib() dlerror()
#endif
@ -87,6 +91,15 @@ static char *get_processed_name(const char *name) {
return ret;
}
typedef struct {
Clib clib;
} JanetAbstractNative;
static const JanetAbstractType janet_native_type = {
"core/native",
JANET_ATEND_NAME
};
JanetModule janet_native(const char *name, const uint8_t **error) {
char *processed_name = get_processed_name(name);
Clib lib = load_clib(processed_name);
@ -337,6 +350,43 @@ JANET_CORE_FN(janet_core_native,
return janet_wrap_table(env);
}
JANET_CORE_FN(janet_core_raw_native,
"(raw-native path)",
"Load a shared object or dll from the given path, and do not extract"
" or run any code from it. This is different than `native`, which will "
"run initialization code to get a module table. Returns a `core/native`.") {
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
char *processed_name = get_processed_name(path);
Clib lib = load_clib(processed_name);
if (path != processed_name) janet_free(processed_name);
if (!lib) janet_panic(error_clib());
JanetAbstractNative *anative = janet_abstract(&janet_native_type, sizeof(JanetAbstractNative));
anative->clib = lib;
return janet_wrap_abstract(anative);
}
JANET_CORE_FN(janet_core_native_lookup,
"(native-lookup native symbol-name)",
"Lookup a symbol from a native object. All symbol lookups will return a raw pointer "
"if the symbol is found, else nil.") {
janet_fixarity(argc, 2);
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
const char *sym = janet_getcstring(argv, 1);
void *value = symbol_clib(anative->clib, sym);
return janet_wrap_pointer(value);
}
JANET_CORE_FN(janet_core_native_close,
"(native-close native)",
"Free a native object. Dereferencing pointers to symbols in the object will have undefined "
"behavior after freeing.") {
janet_fixarity(argc, 1);
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
free_clib(anative->clib);
return janet_wrap_nil();
}
JANET_CORE_FN(janet_core_describe,
"(describe x)",
"Returns a string that is a human-readable description of `x`. "
@ -956,6 +1006,9 @@ static const uint32_t cmp_asm[] = {
static void janet_load_libs(JanetTable *env) {
JanetRegExt corelib_cfuns[] = {
JANET_CORE_REG("native", janet_core_native),
JANET_CORE_REG("raw-native", janet_core_raw_native),
JANET_CORE_REG("native-lookup", janet_core_native_lookup),
JANET_CORE_REG("native-close", janet_core_native_close),
JANET_CORE_REG("describe", janet_core_describe),
JANET_CORE_REG("string", janet_core_string),
JANET_CORE_REG("symbol", janet_core_symbol),

View File

@ -3031,8 +3031,8 @@ const JanetAbstractType janet_mutex_type = {
};
JANET_CORE_FN(janet_cfun_mutex,
"(ev/lock)",
"Create a new lock to coordinate threads.") {
"(ev/lock)",
"Create a new lock to coordinate threads.") {
janet_fixarity(argc, 0);
(void) argv;
JanetAbstractMutex *mutex = janet_abstract_threaded(&janet_mutex_type, sizeof(JanetAbstractMutex));
@ -3041,10 +3041,10 @@ JANET_CORE_FN(janet_cfun_mutex,
}
JANET_CORE_FN(janet_cfun_mutex_acquire,
"(ev/acquire-lock lock)",
"Acquire a lock such that this operating system thread is the only thread with access to this resource."
" This will block this entire thread until the lock becomes available, and will not yield to other fibers "
"on this system thread.") {
"(ev/acquire-lock lock)",
"Acquire a lock such that this operating system thread is the only thread with access to this resource."
" This will block this entire thread until the lock becomes available, and will not yield to other fibers "
"on this system thread.") {
janet_fixarity(argc, 1);
JanetAbstractMutex *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
janet_os_mutex_lock(&mutex->mutex);
@ -3052,8 +3052,8 @@ JANET_CORE_FN(janet_cfun_mutex_acquire,
}
JANET_CORE_FN(janet_cfun_mutex_release,
"(ev/release-lock lock)",
"Release a lock such that other threads may acquire it.") {
"(ev/release-lock lock)",
"Release a lock such that other threads may acquire it.") {
janet_fixarity(argc, 1);
JanetAbstractMutex *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
janet_os_mutex_unlock(&mutex->mutex);
@ -3078,8 +3078,8 @@ const JanetAbstractType janet_rwlock_type = {
};
JANET_CORE_FN(janet_cfun_rwlock,
"(ev/rwlock)",
"Create a new read-write lock to coordinate threads.") {
"(ev/rwlock)",
"Create a new read-write lock to coordinate threads.") {
janet_fixarity(argc, 0);
(void) argv;
JanetAbstractRWLock *rwlock = janet_abstract_threaded(&janet_rwlock_type, sizeof(JanetAbstractRWLock));
@ -3088,8 +3088,8 @@ JANET_CORE_FN(janet_cfun_rwlock,
}
JANET_CORE_FN(janet_cfun_rwlock_read_lock,
"(ev/acquire-rlock rwlock)",
"Acquire a read lock an a read-write lock.") {
"(ev/acquire-rlock rwlock)",
"Acquire a read lock an a read-write lock.") {
janet_fixarity(argc, 1);
JanetAbstractRWLock *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
janet_os_rwlock_rlock(&rwlock->rwlock);
@ -3097,8 +3097,8 @@ JANET_CORE_FN(janet_cfun_rwlock_read_lock,
}
JANET_CORE_FN(janet_cfun_rwlock_write_lock,
"(ev/acquire-wlock rwlock)",
"Acquire a write lock on a read-write lock.") {
"(ev/acquire-wlock rwlock)",
"Acquire a write lock on a read-write lock.") {
janet_fixarity(argc, 1);
JanetAbstractRWLock *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
janet_os_rwlock_wlock(&rwlock->rwlock);
@ -3106,8 +3106,8 @@ JANET_CORE_FN(janet_cfun_rwlock_write_lock,
}
JANET_CORE_FN(janet_cfun_rwlock_read_release,
"(ev/release-rlock rwlock)",
"Release a read lock on a read-write lock") {
"(ev/release-rlock rwlock)",
"Release a read lock on a read-write lock") {
janet_fixarity(argc, 1);
JanetAbstractRWLock *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
janet_os_rwlock_runlock(&rwlock->rwlock);
@ -3115,8 +3115,8 @@ JANET_CORE_FN(janet_cfun_rwlock_read_release,
}
JANET_CORE_FN(janet_cfun_rwlock_write_release,
"(ev/release-wlock rwlock)",
"Release a write lock on a read-write lock") {
"(ev/release-wlock rwlock)",
"Release a write lock on a read-write lock") {
janet_fixarity(argc, 1);
JanetAbstractRWLock *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
janet_os_rwlock_wunlock(&rwlock->rwlock);