mirrors
/
janet
mirror of https://github.com/janet-lang/janet
1
0
Fork 0
Code Issues 1 Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
src/core/corelib.c
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),

36
src/core/ev.c
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);