From 395ca7feea248695ed30dd7a977331c5fb708dc4 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 14 May 2022 10:26:46 -0500 Subject: [PATCH 01/89] Fix meson.build for older versions of meson. --- meson.build | 7 +++++-- src/conf/janetconf.h | 6 +++--- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/meson.build b/meson.build index b28f33ca..2857b444 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.22.0') + version : '1.22.1') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') @@ -265,4 +265,7 @@ patched_janet = custom_target('patched-janeth', command : [janet_nativeclient, '@INPUT@', '@OUTPUT@']) # Create a version of the janet.h header that matches what jpm often expects -install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir')) +if meson.version().version_compare('>=0.61') + install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir')) +endif + diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index 6a651ae3..3bd49527 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -5,9 +5,9 @@ #define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MINOR 22 -#define JANET_VERSION_PATCH 0 -#define JANET_VERSION_EXTRA "" -#define JANET_VERSION "1.22.0" +#define JANET_VERSION_PATCH 1 +#define JANET_VERSION_EXTRA "-dev" +#define JANET_VERSION "1.22.1-dev" /* #define JANET_BUILD "local" */ From 431451bac2e208e9594c843d83a701cafe97fc57 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 25 May 2022 22:35:20 -0500 Subject: [PATCH 02/89] Make install work ok if meson is old. --- meson.build | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/meson.build b/meson.build index 2857b444..1397a742 100644 --- a/meson.build +++ b/meson.build @@ -267,5 +267,13 @@ patched_janet = custom_target('patched-janeth', # Create a version of the janet.h header that matches what jpm often expects if meson.version().version_compare('>=0.61') install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir')) +else + patched_janet2 = custom_target('patched-janeth2', + input : ['tools/patch-header.janet', 'src/include/janet.h', jconf], + install : true, + install_dir : get_option('includedir'), + build_by_default : true, + output : ['janet.h'], + command : [janet_nativeclient, '@INPUT@', '@OUTPUT@']) endif From 9cda44f443e3734c4941f4e44a262d0dcbacda69 Mon Sep 17 00:00:00 2001 From: naveen <172697+naveensrinivasan@users.noreply.github.com> Date: Fri, 27 May 2022 00:32:28 +0000 Subject: [PATCH 03/89] chore: Set permissions for GitHub actions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Restrict the GitHub token permissions only to the required ones; this way, even if the attackers will succeed in compromising your workflow, they won’t be able to do much. - Included permissions for the action. https://github.com/ossf/scorecard/blob/main/docs/checks.md#token-permissions https://docs.github.com/en/actions/using-workflows/workflow-syntax-for-github-actions#permissions https://docs.github.com/en/actions/using-jobs/assigning-permissions-to-jobs [Keeping your GitHub Actions and workflows secure Part 1: Preventing pwn requests](https://securitylab.github.com/research/github-actions-preventing-pwn-requests/) Signed-off-by: naveen <172697+naveensrinivasan@users.noreply.github.com> --- .github/workflows/release.yml | 7 +++++++ .github/workflows/test.yml | 3 +++ 2 files changed, 10 insertions(+) diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index 0f9991c0..e5c557dc 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -5,9 +5,14 @@ on: tags: - "v*.*.*" +permissions: + contents: read + jobs: release: + permissions: + contents: write # for softprops/action-gh-release to create GitHub release name: Build release binaries runs-on: ${{ matrix.os }} strategy: @@ -35,6 +40,8 @@ jobs: build/c/shell.c release-windows: + permissions: + contents: write # for softprops/action-gh-release to create GitHub release name: Build release binaries for windows runs-on: windows-latest steps: diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 71819468..63c90f7c 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -2,6 +2,9 @@ name: Test on: [push, pull_request] +permissions: + contents: read + jobs: test-posix: From e5a989c6f9cf921076c7140be84eaf1a7a455b40 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 27 May 2022 21:14:47 -0500 Subject: [PATCH 04/89] Remove multiple outputs with same name for old meson versions. --- meson.build | 8 -------- 1 file changed, 8 deletions(-) diff --git a/meson.build b/meson.build index 1397a742..2857b444 100644 --- a/meson.build +++ b/meson.build @@ -267,13 +267,5 @@ patched_janet = custom_target('patched-janeth', # Create a version of the janet.h header that matches what jpm often expects if meson.version().version_compare('>=0.61') install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir')) -else - patched_janet2 = custom_target('patched-janeth2', - input : ['tools/patch-header.janet', 'src/include/janet.h', jconf], - install : true, - install_dir : get_option('includedir'), - build_by_default : true, - output : ['janet.h'], - command : [janet_nativeclient, '@INPUT@', '@OUTPUT@']) endif From 48289acee6e25213b96c211e5e719245fe0fc99d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 28 May 2022 12:01:23 -0500 Subject: [PATCH 05/89] Add os/cpu-count functionality. --- README.md | 4 ++-- src/core/os.c | 42 ++++++++++++++++++++++++++++++++++++++++++ tools/format.sh | 0 3 files changed, 44 insertions(+), 2 deletions(-) mode change 100644 => 100755 tools/format.sh diff --git a/README.md b/README.md index 9c8d5f8d..6d4e71f5 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ [![Join the chat](https://badges.gitter.im/janet-language/community.svg)](https://gitter.im/janet-language/community)   -[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?) -[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?) +[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?) +[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?) [![Actions Status](https://github.com/janet-lang/janet/actions/workflows/test.yml/badge.svg)](https://github.com/janet-lang/janet/actions/workflows/test.yml) Janet logo diff --git a/src/core/os.c b/src/core/os.c index f443e14b..54497fcc 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -39,6 +39,10 @@ #include #include +#ifdef JANET_BSD +#include +#endif + #ifdef JANET_WINDOWS #include #include @@ -201,6 +205,43 @@ JANET_CORE_FN(os_exit, return janet_wrap_nil(); } +JANET_CORE_FN(os_cpu_count, + "(os/cpu-count &opt dflt)", + "Get an approximate number of CPUs available on for this process to use. If " + "unable to get an approximation, will return a default value dflt.") { + janet_arity(argc, 0, 1); + Janet dflt = argc > 0 ? argv[0] : janet_wrap_nil(); +#ifdef JANET_WINDOWS + (void) dflt; + SYSTEM_INFO info; + GetSystemInfo(&info); + return janet_wrap_integer(info.dwNumberOfProcessors); +#elif defined(JANET_LINUX) + (void) dflt; + return janet_wrap_integer(sysconf(_SC_NPROCESSORS_ONLN)); +#elif defined(JANET_BSD) && defined(HW_NCPUONLINE) + (void) dflt; + const int name[2] = {CTL_HW, HW_NCPUONLINE}; + int result = 0; + size_t len = sizeof(int); + if (-1 == sysctl(name, 2, &result, &len, sizeof(result), NULL, 0)) { + return dflt; + } + return janet_wrap_integer(result); +#elif defined(JANET_BSD) && defined(HW_NCPU) + (void) dflt; + const int name[2] = {CTL_HW, HW_NCPU}; + int result = 0; + size_t len = sizeof(int); + if (-1 == sysctl(name, 2, &result, &len, sizeof(result), NULL, 0)) { + return dflt; + } + return janet_wrap_integer(result); +#else + return dflt; +#endif +} + #ifndef JANET_REDUCED_OS #ifndef JANET_NO_PROCESSES @@ -2195,6 +2236,7 @@ void janet_lib_os(JanetTable *env) { JANET_CORE_REG("os/chmod", os_chmod), JANET_CORE_REG("os/touch", os_touch), JANET_CORE_REG("os/cd", os_cd), + JANET_CORE_REG("os/cpu-count", os_cpu_count), #ifndef JANET_NO_UMASK JANET_CORE_REG("os/umask", os_umask), #endif diff --git a/tools/format.sh b/tools/format.sh old mode 100644 new mode 100755 From 8145f3b68d73155184e1f02b5b64bac9fa84e31f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 28 May 2022 12:19:25 -0500 Subject: [PATCH 06/89] On linux, available CPUs is more useful information. --- CHANGELOG.md | 3 +++ src/core/features.h | 5 +++++ src/core/os.c | 10 +++++++++- 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e50db78d..0e91fe39 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,9 @@ # Changelog All notable changes to this project will be documented in this file. +## Unreleased - ??? +- Added `os/cpu-count` to get the number of available processors on a machine + ## 1.22.0 - 2022-05-09 - Prohibit negative size argument to `table/new`. - Add `module/value`. diff --git a/src/core/features.h b/src/core/features.h index 6f37f34c..40067414 100644 --- a/src/core/features.h +++ b/src/core/features.h @@ -36,6 +36,11 @@ # endif #endif +/* Needed for sched.h for cpu count */ +#ifdef __linux__ +#define _GNU_SOURCE +#endif + #if defined(WIN32) || defined(_WIN32) #define WIN32_LEAN_AND_MEAN #endif diff --git a/src/core/os.c b/src/core/os.c index 54497fcc..db747525 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -43,6 +43,10 @@ #include #endif +#ifdef JANET_LINUX +#include +#endif + #ifdef JANET_WINDOWS #include #include @@ -218,7 +222,11 @@ JANET_CORE_FN(os_cpu_count, return janet_wrap_integer(info.dwNumberOfProcessors); #elif defined(JANET_LINUX) (void) dflt; - return janet_wrap_integer(sysconf(_SC_NPROCESSORS_ONLN)); + cpu_set_t cs; + CPU_ZERO(&cs); + sched_getaffinity(0, sizeof(cs), &cs); + int count = CPU_COUNT(&cs); + return janet_wrap_integer(count); #elif defined(JANET_BSD) && defined(HW_NCPUONLINE) (void) dflt; const int name[2] = {CTL_HW, HW_NCPUONLINE}; From 6ada2a458f14fcb749de535b5eb8b10862af33a7 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 28 May 2022 12:21:44 -0500 Subject: [PATCH 07/89] Fixes on bsd for os/cpu-count. --- src/core/os.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/os.c b/src/core/os.c index db747525..a443826c 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -232,7 +232,7 @@ JANET_CORE_FN(os_cpu_count, const int name[2] = {CTL_HW, HW_NCPUONLINE}; int result = 0; size_t len = sizeof(int); - if (-1 == sysctl(name, 2, &result, &len, sizeof(result), NULL, 0)) { + if (-1 == sysctl(name, 2, &result, &len, ,NULL, 0)) { return dflt; } return janet_wrap_integer(result); @@ -241,7 +241,7 @@ JANET_CORE_FN(os_cpu_count, const int name[2] = {CTL_HW, HW_NCPU}; int result = 0; size_t len = sizeof(int); - if (-1 == sysctl(name, 2, &result, &len, sizeof(result), NULL, 0)) { + if (-1 == sysctl(name, 2, &result, &len, NULL, 0)) { return dflt; } return janet_wrap_integer(result); From 677ae46f0c90836ad0911c74a0f692b86e006b74 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 28 May 2022 12:22:28 -0500 Subject: [PATCH 08/89] Fix README links for sourcehut. --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 6d4e71f5..c6b00461 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ [![Join the chat](https://badges.gitter.im/janet-language/community.svg)](https://gitter.im/janet-language/community)   -[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?) -[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?) +[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?) +[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?) [![Actions Status](https://github.com/janet-lang/janet/actions/workflows/test.yml/badge.svg)](https://github.com/janet-lang/janet/actions/workflows/test.yml) Janet logo From dfa78ad3c671da87fbd2a42159e82bcc498142a1 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 28 May 2022 12:23:28 -0500 Subject: [PATCH 09/89] typo --- src/core/os.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/os.c b/src/core/os.c index a443826c..6d35e3ac 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -232,7 +232,7 @@ JANET_CORE_FN(os_cpu_count, const int name[2] = {CTL_HW, HW_NCPUONLINE}; int result = 0; size_t len = sizeof(int); - if (-1 == sysctl(name, 2, &result, &len, ,NULL, 0)) { + if (-1 == sysctl(name, 2, &result, &len, NULL, 0)) { return dflt; } return janet_wrap_integer(result); From 2f64a6b0cbdba47494b3f8dd2b4f0eb5fe5af95c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 28 May 2022 18:43:11 -0500 Subject: [PATCH 10/89] Add `parse-all` function as a natural extension to the `parse` function. --- CHANGELOG.md | 3 ++- src/boot/boot.janet | 14 ++++++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0e91fe39..5710b712 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,8 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? -- Added `os/cpu-count` to get the number of available processors on a machine +- Add `parse-all` as a generalization of the `parse` function. +- Add `os/cpu-count` to get the number of available processors on a machine ## 1.22.0 - 2022-05-09 - Prohibit negative size argument to `table/new`. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index d7113da5..8d78fd12 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2575,6 +2575,20 @@ (error (parser/error p)) (error "no value"))))) +(defn parse-all + `Parse a string and return all parsed values. For complex parsing, such as for a repl with error handling, + use the parser api.` + [str] + (let [p (parser/new) + ret @[]] + (parser/consume p str) + (parser/eof p) + (while (parser/has-more p) + (array/push ret (parser/produce p))) + (if (= :error (parser/status p)) + (error (parser/error p)) + ret))) + (def load-image-dict ``A table used in combination with `unmarshal` to unmarshal byte sequences created by `make-image`, such that `(load-image bytes)` is the same as `(unmarshal bytes load-image-dict)`.`` From 9c9f9d4fa670273006b4a2102fe50af6edb9782b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Jun 2022 15:24:34 -0500 Subject: [PATCH 11/89] Add some thread coordination primitives. Due to the nature of event loops, it is a bit difficult to integrate lock and other primitives such that they don't block fibers on the same thread. --- src/core/abstract.c | 9 ++++++-- src/core/ev.c | 52 +++++++++++++++++++++++++++++++++++++++++++++ src/include/janet.h | 21 ------------------ 3 files changed, 59 insertions(+), 23 deletions(-) diff --git a/src/core/abstract.c b/src/core/abstract.c index b568fb20..da48ca1d 100644 --- a/src/core/abstract.c +++ b/src/core/abstract.c @@ -106,6 +106,7 @@ void janet_os_mutex_lock(JanetOSMutex *mutex) { } void janet_os_mutex_unlock(JanetOSMutex *mutex) { + /* error handling? May want to keep counter */ LeaveCriticalSection((CRITICAL_SECTION *) mutex); } @@ -120,7 +121,10 @@ static int32_t janet_decref(JanetAbstractHead *ab) { } void janet_os_mutex_init(JanetOSMutex *mutex) { - pthread_mutex_init(mutex, NULL); + pthread_mutexattr_t attr; + pthread_mutexattr_init(&attr); + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + pthread_mutex_init(mutex, &attr); } void janet_os_mutex_deinit(JanetOSMutex *mutex) { @@ -132,7 +136,8 @@ void janet_os_mutex_lock(JanetOSMutex *mutex) { } void janet_os_mutex_unlock(JanetOSMutex *mutex) { - pthread_mutex_unlock(mutex); + int ret = pthread_mutex_unlock(mutex); + if (ret) janet_panic("cannot release lock"); } #endif diff --git a/src/core/ev.c b/src/core/ev.c index 70860826..665e651f 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -3013,6 +3013,54 @@ JANET_CORE_FN(janet_cfun_stream_write, janet_await(); } +typedef struct { + JanetOSMutex mutex; + int destroyed; +} JanetAbstractMutex; + +static int mutexgc(void *p, size_t size) { + JanetAbstractMutex *mutex = (JanetAbstractMutex *) p; + (void) size; + janet_os_mutex_deinit(&mutex->mutex); + return 0; +} + +const JanetAbstractType janet_mutex_type = { + "core/lock", + mutexgc, + JANET_ATEND_GC +}; + +JANET_CORE_FN(janet_cfun_mutex, + "(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)); + janet_os_mutex_init(&mutex->mutex); + return janet_wrap_abstract(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.") { + janet_fixarity(argc, 1); + JanetAbstractMutex *mutex = janet_getabstract(argv, 0, &janet_mutex_type); + janet_os_mutex_lock(&mutex->mutex); + return argv[0]; +} + +JANET_CORE_FN(janet_cfun_mutex_release, + "(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); + return argv[0]; +} + void janet_lib_ev(JanetTable *env) { JanetRegExt ev_cfuns_ext[] = { JANET_CORE_REG("ev/give", cfun_channel_push), @@ -3035,12 +3083,16 @@ void janet_lib_ev(JanetTable *env) { JANET_CORE_REG("ev/read", janet_cfun_stream_read), JANET_CORE_REG("ev/chunk", janet_cfun_stream_chunk), JANET_CORE_REG("ev/write", janet_cfun_stream_write), + JANET_CORE_REG("ev/lock", janet_cfun_mutex), + JANET_CORE_REG("ev/acquire-lock", janet_cfun_mutex_acquire), + JANET_CORE_REG("ev/release-lock", janet_cfun_mutex_release), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, ev_cfuns_ext); janet_register_abstract_type(&janet_stream_type); janet_register_abstract_type(&janet_channel_type); + janet_register_abstract_type(&janet_mutex_type); } #endif diff --git a/src/include/janet.h b/src/include/janet.h index 5952ed1b..9b90a506 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1180,17 +1180,6 @@ typedef struct { Janet payload; } JanetTryState; -/* Thread types */ -#ifdef JANET_THREADS -typedef struct JanetThread JanetThread; -typedef struct JanetMailbox JanetMailbox; -struct JanetThread { - JanetMailbox *mailbox; - JanetTable *encode; -}; -#endif - - /***** END SECTION TYPES *****/ /***** START SECTION OPCODES *****/ @@ -2078,16 +2067,6 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out); #endif -#ifdef JANET_THREADS - -extern JANET_API const JanetAbstractType janet_thread_type; - -JANET_API int janet_thread_receive(Janet *msg_out, double timeout); -JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout); -JANET_API JanetThread *janet_thread_current(void); - -#endif - /* Custom allocator support */ JANET_API void *(janet_malloc)(size_t); JANET_API void *(janet_realloc)(void *, size_t); From c9f33bbde03b804e8a62d0d90e4f56307347124f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Jun 2022 16:42:18 -0500 Subject: [PATCH 12/89] Add rwlocks. --- examples/evlocks.janet | 45 +++++++++++++++++++++++++++ src/core/abstract.c | 49 +++++++++++++++++++++++++++++ src/core/ev.c | 70 +++++++++++++++++++++++++++++++++++++++++- src/core/features.h | 10 ++++-- src/include/janet.h | 24 ++++++++++++++- 5 files changed, 193 insertions(+), 5 deletions(-) create mode 100644 examples/evlocks.janet diff --git a/examples/evlocks.janet b/examples/evlocks.janet new file mode 100644 index 00000000..08b497f7 --- /dev/null +++ b/examples/evlocks.janet @@ -0,0 +1,45 @@ +(defn sleep + "Sleep the entire thread, not just a single fiber." + [n] + (os/sleep (* 0.1 n))) + +(defn work [lock n] + (ev/acquire-lock lock) + (print "working " n "...") + (sleep n) + (print "done working...") + (ev/release-lock lock)) + +(defn reader + [rwlock n] + (ev/acquire-rlock rwlock) + (print "reading " n "...") + (sleep n) + (print "done reading " n "...") + (ev/release-rlock rwlock)) + +(defn writer + [rwlock n] + (ev/acquire-wlock rwlock) + (print "writing " n "...") + (sleep n) + (print "done writing...") + (ev/release-wlock rwlock)) + +(defn test-lock + [] + (def lock (ev/lock)) + (for i 3 7 + (ev/spawn-thread + (work lock i)))) + +(defn test-rwlock + [] + (def rwlock (ev/rwlock)) + (for i 0 20 + (if (> 0.1 (math/random)) + (ev/spawn-thread (writer rwlock i)) + (ev/spawn-thread (reader rwlock i))))) + +(test-rwlock) +(test-lock) diff --git a/src/core/abstract.c b/src/core/abstract.c index da48ca1d..ba2e0cf5 100644 --- a/src/core/abstract.c +++ b/src/core/abstract.c @@ -110,6 +110,31 @@ void janet_os_mutex_unlock(JanetOSMutex *mutex) { LeaveCriticalSection((CRITICAL_SECTION *) mutex); } +void janet_os_rwlock_init(JanetOSRWLock *rwlock) { + InitializeSRWLock((PSRWLOCK) rwlock); +} + +void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) { + /* no op? */ + (void) rwlock; +} + +void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) { + AcquireSRWLockShared((PSRWLOCK) rwlock); +} + +void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) { + AcquireSRWLockExclusive((PSRWLOCK) rwlock); +} + +void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) { + ReleaseSRWLockShared((PSRWLOCK) rwlock); +} + +void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) { + ReleaseSRWLockExclusive((PSRWLOCK) rwlock); +} + #else static int32_t janet_incref(JanetAbstractHead *ab) { @@ -140,6 +165,30 @@ void janet_os_mutex_unlock(JanetOSMutex *mutex) { if (ret) janet_panic("cannot release lock"); } +void janet_os_rwlock_init(JanetOSRWLock *rwlock) { + pthread_rwlock_init(rwlock, NULL); +} + +void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) { + pthread_rwlock_destroy(rwlock); +} + +void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) { + pthread_rwlock_rdlock(rwlock); +} + +void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) { + pthread_rwlock_wrlock(rwlock); +} + +void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) { + pthread_rwlock_unlock(rwlock); +} + +void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) { + pthread_rwlock_unlock(rwlock); +} + #endif int32_t janet_abstract_incref(void *abst) { diff --git a/src/core/ev.c b/src/core/ev.c index 665e651f..41931138 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -3015,7 +3015,6 @@ JANET_CORE_FN(janet_cfun_stream_write, typedef struct { JanetOSMutex mutex; - int destroyed; } JanetAbstractMutex; static int mutexgc(void *p, size_t size) { @@ -3061,6 +3060,69 @@ JANET_CORE_FN(janet_cfun_mutex_release, return argv[0]; } +typedef struct { + JanetOSRWLock rwlock; +} JanetAbstractRWLock; + +static int rwlockgc(void *p, size_t size) { + JanetAbstractRWLock *rwlock = (JanetAbstractRWLock *) p; + (void) size; + janet_os_rwlock_deinit(&rwlock->rwlock); + return 0; +} + +const JanetAbstractType janet_rwlock_type = { + "core/rwlock", + rwlockgc, + JANET_ATEND_GC +}; + +JANET_CORE_FN(janet_cfun_rwlock, + "(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)); + janet_os_rwlock_init(&rwlock->rwlock); + return janet_wrap_abstract(rwlock); +} + +JANET_CORE_FN(janet_cfun_rwlock_read_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); + return argv[0]; +} + +JANET_CORE_FN(janet_cfun_rwlock_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); + return argv[0]; +} + +JANET_CORE_FN(janet_cfun_rwlock_read_release, + "(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); + return argv[0]; +} + +JANET_CORE_FN(janet_cfun_rwlock_write_release, + "(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); + return argv[0]; +} + void janet_lib_ev(JanetTable *env) { JanetRegExt ev_cfuns_ext[] = { JANET_CORE_REG("ev/give", cfun_channel_push), @@ -3086,6 +3148,11 @@ void janet_lib_ev(JanetTable *env) { JANET_CORE_REG("ev/lock", janet_cfun_mutex), JANET_CORE_REG("ev/acquire-lock", janet_cfun_mutex_acquire), JANET_CORE_REG("ev/release-lock", janet_cfun_mutex_release), + JANET_CORE_REG("ev/rwlock", janet_cfun_rwlock), + JANET_CORE_REG("ev/acquire-rlock", janet_cfun_rwlock_read_lock), + JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock), + JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release), + JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release), JANET_REG_END }; @@ -3093,6 +3160,7 @@ void janet_lib_ev(JanetTable *env) { janet_register_abstract_type(&janet_stream_type); janet_register_abstract_type(&janet_channel_type); janet_register_abstract_type(&janet_mutex_type); + janet_register_abstract_type(&janet_rwlock_type); } #endif diff --git a/src/core/features.h b/src/core/features.h index 40067414..ce5e3bf1 100644 --- a/src/core/features.h +++ b/src/core/features.h @@ -45,9 +45,13 @@ #define WIN32_LEAN_AND_MEAN #endif -/* Needed for realpath on linux */ -#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__)) -#define _XOPEN_SOURCE 500 +/* Needed for realpath on linux, as well as pthread rwlocks. */ +#ifndef _XOPEN_SOURCE +#define _XOPEN_SOURCE 600 +#endif +#if _XOPEN_SOURCE < 600 +#undef _XOPEN_SOURCE +#define _XOPEN_SOURCE 600 #endif /* Needed for timegm and other extensions when building with -std=c99. diff --git a/src/include/janet.h b/src/include/janet.h index 9b90a506..3a11a6f5 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -299,6 +299,18 @@ typedef struct { JANET_CURRENT_CONFIG_BITS }) #endif +/* Feature include for pthreads. Most feature detection code should go in + * features.h instead. */ +#ifndef JANET_WINDOWS +#ifndef _XOPEN_SOURCE +#define _XOPEN_SOURCE 600 +#endif +#if _XOPEN_SOURCE < 600 +#undef _XOPEN_SOURCE +#define _XOPEN_SOURCE 600 +#endif +#endif + /* What to do when out of memory */ #ifndef JANET_OUT_OF_MEMORY #include @@ -335,9 +347,13 @@ typedef struct JanetDudCriticalSection { void *lock_semaphore; unsigned long spin_count; } JanetOSMutex; +typedef struct JanetDudRWLock { + void *ptr; +} JanetOSRWLock; #else #include typedef pthread_mutex_t JanetOSMutex; +typedef pthread_rwlock_t JanetOSRWLock; #endif #endif @@ -1368,11 +1384,17 @@ JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t s JANET_API int32_t janet_abstract_incref(void *abst); JANET_API int32_t janet_abstract_decref(void *abst); -/* Expose some OS sync primitives to make portable abstract types easier to implement */ +/* Expose some OS sync primitives */ JANET_API void janet_os_mutex_init(JanetOSMutex *mutex); JANET_API void janet_os_mutex_deinit(JanetOSMutex *mutex); JANET_API void janet_os_mutex_lock(JanetOSMutex *mutex); JANET_API void janet_os_mutex_unlock(JanetOSMutex *mutex); +JANET_API void janet_os_rwlock_init(JanetOSRWLock *rwlock); +JANET_API void janet_os_rwlock_deinit(JanetOSRWLock *rwlock); +JANET_API void janet_os_rwlock_rlock(JanetOSRWLock *rwlock); +JANET_API void janet_os_rwlock_wlock(JanetOSRWLock *rwlock); +JANET_API void janet_os_rwlock_runlock(JanetOSRWLock *rwlock); +JANET_API void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock); /* Get last error from an IO operation */ JANET_API Janet janet_ev_lasterr(void); From e69bbff195c673a5747dcab1a36a4649d65e0c53 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 5 Jun 2022 17:40:50 -0500 Subject: [PATCH 13/89] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5710b712..27700b70 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add mutexes (locks) and reader-writer locks to ev module for thread coordination. - Add `parse-all` as a generalization of the `parse` function. - Add `os/cpu-count` to get the number of available processors on a machine From 8d1ad99f4249acec1c5fa71c72a9b960edb8cb8c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Jun 2022 10:49:30 -0500 Subject: [PATCH 14/89] 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. --- src/core/corelib.c | 53 ++++++++++++++++++++++++++++++++++++++++++++++ src/core/ev.c | 36 +++++++++++++++---------------- 2 files changed, 71 insertions(+), 18 deletions(-) diff --git a/src/core/corelib.c b/src/core/corelib.c index f250a6d1..5893d640 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -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 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 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), diff --git a/src/core/ev.c b/src/core/ev.c index 41931138..00a1eb29 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -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); From 74348ab6c2fd970a9dcbd9ac0abae093f0039456 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Jun 2022 10:53:00 -0500 Subject: [PATCH 15/89] Fix symbol lookup when symbol isn't found. --- src/core/corelib.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/corelib.c b/src/core/corelib.c index 5893d640..66331f5d 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -374,6 +374,7 @@ JANET_CORE_FN(janet_core_native_lookup, JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type); const char *sym = janet_getcstring(argv, 1); void *value = symbol_clib(anative->clib, sym); + if (NULL == value) return janet_wrap_nil(); return janet_wrap_pointer(value); } From 986e36720ebc6247fb6b8817614dbc7c72b979c1 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Jun 2022 13:08:12 -0500 Subject: [PATCH 16/89] Update windows builds for raw-natives. --- CHANGELOG.md | 1 + src/core/corelib.c | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 27700b70..ef5f9242 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `raw-native`, `native-lookup`, and `native-close` for interfacing with dynamic libraries. - Add mutexes (locks) and reader-writer locks to ev module for thread coordination. - Add `parse-all` as a generalization of the `parse` function. - Add `os/cpu-count` to get the number of available processors on a machine diff --git a/src/core/corelib.c b/src/core/corelib.c index 66331f5d..b9661c51 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -55,7 +55,6 @@ typedef int Clib; 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) { From e3e485285b40531972b2db228aa3e5f87fd16953 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Jun 2022 13:36:03 -0500 Subject: [PATCH 17/89] Prevent double usage of native objects after closing. --- src/core/corelib.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/core/corelib.c b/src/core/corelib.c index b9661c51..2983cedc 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -92,6 +92,7 @@ static char *get_processed_name(const char *name) { typedef struct { Clib clib; + int closed; } JanetAbstractNative; static const JanetAbstractType janet_native_type = { @@ -362,6 +363,7 @@ JANET_CORE_FN(janet_core_raw_native, if (!lib) janet_panic(error_clib()); JanetAbstractNative *anative = janet_abstract(&janet_native_type, sizeof(JanetAbstractNative)); anative->clib = lib; + anative->closed = 0; return janet_wrap_abstract(anative); } @@ -372,6 +374,7 @@ JANET_CORE_FN(janet_core_native_lookup, janet_fixarity(argc, 2); JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type); const char *sym = janet_getcstring(argv, 1); + if (anative->closed) janet_panic("native object already closed"); void *value = symbol_clib(anative->clib, sym); if (NULL == value) return janet_wrap_nil(); return janet_wrap_pointer(value); @@ -383,7 +386,10 @@ JANET_CORE_FN(janet_core_native_close, "behavior after freeing.") { janet_fixarity(argc, 1); JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type); + if (anative->closed) janet_panic("native object already closed"); + anative->closed = 1; free_clib(anative->clib); + anative->clib = NULL; return janet_wrap_nil(); } From 94c19575b161a2ba4698446bdfd93af672c87871 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Jun 2022 13:37:07 -0500 Subject: [PATCH 18/89] Fix when clib is not pointer type. --- src/core/corelib.c | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/corelib.c b/src/core/corelib.c index 2983cedc..a74eaf6a 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -389,7 +389,6 @@ JANET_CORE_FN(janet_core_native_close, if (anative->closed) janet_panic("native object already closed"); anative->closed = 1; free_clib(anative->clib); - anative->clib = NULL; return janet_wrap_nil(); } From 282d1ba22f8fafbb3bbb23e6f3356e7a0b80817d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 6 Jun 2022 18:54:17 -0500 Subject: [PATCH 19/89] Implement sys v abi on x64 partially. --- Makefile | 1 + meson.build | 2 + meson_options.txt | 1 + src/boot/boot.janet | 1 + src/core/capi.c | 16 +++ src/core/corelib.c | 3 + src/core/ffi.c | 312 ++++++++++++++++++++++++++++++++++++++++++++ src/core/util.c | 7 + src/core/util.h | 3 + src/include/janet.h | 7 + 10 files changed, 353 insertions(+) create mode 100644 src/core/ffi.c diff --git a/Makefile b/Makefile index f8c4cfbb..dd8e0f25 100644 --- a/Makefile +++ b/Makefile @@ -108,6 +108,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \ src/core/debug.c \ src/core/emit.c \ src/core/ev.c \ + src/core/ffi.c \ src/core/fiber.c \ src/core/gc.c \ src/core/inttypes.c \ diff --git a/meson.build b/meson.build index 2857b444..3e67aaeb 100644 --- a/meson.build +++ b/meson.build @@ -76,6 +76,7 @@ conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline')) conf.set('JANET_EV_NO_EPOLL', not get_option('epoll')) conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue')) conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt')) +conf.set('JANET_NO_FFI', not get_option('ffi')) if get_option('os_name') != '' conf.set('JANET_OS_NAME', get_option('os_name')) endif @@ -116,6 +117,7 @@ core_src = [ 'src/core/debug.c', 'src/core/emit.c', 'src/core/ev.c', + 'src/core/ffi.c', 'src/core/fiber.c', 'src/core/gc.c', 'src/core/inttypes.c', diff --git a/meson_options.txt b/meson_options.txt index afc8f353..315bf365 100644 --- a/meson_options.txt +++ b/meson_options.txt @@ -19,6 +19,7 @@ option('simple_getline', type : 'boolean', value : false) option('epoll', type : 'boolean', value : false) option('kqueue', type : 'boolean', value : false) option('interpreter_interrupt', type : 'boolean', value : false) +option('ffi', type : 'boolean', value : true) option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024) option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 8d78fd12..fc34f4b6 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3938,6 +3938,7 @@ "src/core/debug.c" "src/core/emit.c" "src/core/ev.c" + "src/core/ffi.c" "src/core/fiber.c" "src/core/gc.c" "src/core/inttypes.c" diff --git a/src/core/capi.c b/src/core/capi.c index c7964f5a..c80c7304 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -260,11 +260,27 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) { } int64_t janet_getinteger64(const Janet *argv, int32_t n) { +#ifdef JANET_INTTYPES + return janet_unwrap_s64(argv[n]); +#else Janet x = argv[n]; if (!janet_checkint64(x)) { janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x); } return (int64_t) janet_unwrap_number(x); +#endif +} + +uint64_t janet_getuinteger64(const Janet *argv, int32_t n) { +#ifdef JANET_INTTYPES + return janet_unwrap_u64(argv[n]); +#else + Janet x = argv[n]; + if (!janet_checkint64(x)) { + janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x); + } + return (uint64_t) janet_unwrap_number(x); +#endif } size_t janet_getsize(const Janet *argv, int32_t n) { diff --git a/src/core/corelib.c b/src/core/corelib.c index a74eaf6a..322b1411 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -1074,6 +1074,9 @@ static void janet_load_libs(JanetTable *env) { #ifdef JANET_NET janet_lib_net(env); #endif +#ifdef JANET_FFI + janet_lib_ffi(env); +#endif } #ifdef JANET_BOOTSTRAP diff --git a/src/core/ffi.c b/src/core/ffi.c new file mode 100644 index 00000000..e0dfd13f --- /dev/null +++ b/src/core/ffi.c @@ -0,0 +1,312 @@ +/* +* Copyright (c) 2022 Calvin Rose +* +* Permission is hereby granted, free of charge, to any person obtaining a copy +* of this software and associated documentation files (the "Software"), to +* deal in the Software without restriction, including without limitation the +* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +* sell copies of the Software, and to permit persons to whom the Software is +* furnished to do so, subject to the following conditions: +* +* The above copyright notice and this permission notice shall be included in +* all copies or substantial portions of the Software. +* +* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +* IN THE SOFTWARE. +*/ + +#ifndef JANET_AMALG +#include "features.h" +#include +#include "util.h" +#endif + +#ifdef JANET_FFI + +static uint64_t test_function(int32_t a, int32_t b, const char *s) { + printf("a = %d\n", a); + printf("b = %d\n", b); + uint64_t ret = a + b; + printf("string: %s\n", s); + printf("hello from test function. Returning %lu.\n", ret); + return ret; +} + +JANET_CORE_FN(cfun_ffi_get_test_pointer, + "(ffi/get-test-pointer)", + "Get a test pointer to call using ffi.") { + janet_fixarity(argc, 0); + (void) argv; + return janet_wrap_pointer(test_function); +} + +typedef enum { + JANET_FFI_TYPE_VOID, + JANET_FFI_TYPE_SHORT, + JANET_FFI_TYPE_INT, + JANET_FFI_TYPE_LONG, + JANET_FFI_TYPE_USHORT, + JANET_FFI_TYPE_UINT, + JANET_FFI_TYPE_ULONG, + JANET_FFI_TYPE_BOOL, + JANET_FFI_TYPE_PTR, + JANET_FFI_TYPE_FLOAT, + JANET_FFI_TYPE_DOUBLE, + JANET_FFI_TYPE_INT8, + JANET_FFI_TYPE_UINT8, + JANET_FFI_TYPE_INT16, + JANET_FFI_TYPE_UINT16, + JANET_FFI_TYPE_INT32, + JANET_FFI_TYPE_UINT32, + JANET_FFI_TYPE_INT64, + JANET_FFI_TYPE_UINT64, +} JanetFFIPrimType; + +static const size_t janet_ffi_type_sizes[] = { + 0, /* JANET_FFI_TYPE_VOID */ + sizeof(short), /* JANET_FFI_TYPE_SHORT */ + sizeof(int), /* JANET_FFI_TYPE_INT */ + sizeof(long), /* JANET_FFI_TYPE_LONG */ + sizeof(unsigned short), /* JANET_FFI_TYPE_USHORT */ + sizeof(unsigned), /* JANET_FFI_TYPE_UINT */ + sizeof(unsigned long), /* JANET_FFI_TYPE_ULONG */ + sizeof(char), /* JANET_FFI_TYPE_BOOL */ + sizeof(void *), /* JANET_FFI_TYPE_PTR */ + sizeof(float), /* JANET_FFI_TYPE_FLOAT */ + sizeof(double), /* JANET_FFI_TYPE_DOUBLE */ + sizeof(int8_t), /* JANET_FFI_TYPE_INT8 */ + sizeof(uint8_t), /* JANET_FFI_TYPE_UINT8 */ + sizeof(int16_t), /* JANET_FFI_TYPE_INT16 */ + sizeof(uint16_t), /* JANET_FFI_TYPE_UINT16 */ + sizeof(int32_t), /* JANET_FFI_TYPE_INT32 */ + sizeof(uint32_t), /* JANET_FFI_TYPE_UINT32 */ + sizeof(int64_t), /* JANET_FFI_TYPE_INT64 */ + sizeof(uint64_t) /* JANET_FFI_TYPE_UINT64 */ +}; + +typedef enum { + JANET_FFI_CC_SYSV_64 +} JanetFFICallingConvention; + +#define JANET_FFI_MAX_REGS 16 +#define JANET_FFI_MAX_STACK 32 + +typedef struct { + uint32_t frame_size; + uint32_t reg_count; + uint32_t stack_count; + uint32_t arg_count; + JanetFFICallingConvention cc; + JanetFFIPrimType ret_type; + JanetFFIPrimType regs[JANET_FFI_MAX_REGS]; + JanetFFIPrimType stack[JANET_FFI_MAX_STACK]; +} JanetFFISignature; + +static const JanetAbstractType janet_signature_type = { + "core/ffi-signature", + JANET_ATEND_NAME +}; + +static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) { + /* TODO */ + (void) name; + return JANET_FFI_CC_SYSV_64; +} + +static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { + if (!janet_cstrcmp(name, "void")) return JANET_FFI_TYPE_VOID; + if (!janet_cstrcmp(name, "short")) return JANET_FFI_TYPE_SHORT; + if (!janet_cstrcmp(name, "int")) return JANET_FFI_TYPE_INT; + if (!janet_cstrcmp(name, "long")) return JANET_FFI_TYPE_LONG; + if (!janet_cstrcmp(name, "ushort")) return JANET_FFI_TYPE_USHORT; + if (!janet_cstrcmp(name, "uint")) return JANET_FFI_TYPE_UINT; + if (!janet_cstrcmp(name, "ulong")) return JANET_FFI_TYPE_ULONG; + if (!janet_cstrcmp(name, "bool")) return JANET_FFI_TYPE_BOOL; + if (!janet_cstrcmp(name, "ptr")) return JANET_FFI_TYPE_PTR; + if (!janet_cstrcmp(name, "float")) return JANET_FFI_TYPE_FLOAT; + if (!janet_cstrcmp(name, "double")) return JANET_FFI_TYPE_DOUBLE; + if (!janet_cstrcmp(name, "int8")) return JANET_FFI_TYPE_INT8; + if (!janet_cstrcmp(name, "uint8")) return JANET_FFI_TYPE_UINT8; + if (!janet_cstrcmp(name, "int16")) return JANET_FFI_TYPE_INT16; + if (!janet_cstrcmp(name, "uint16")) return JANET_FFI_TYPE_UINT16; + if (!janet_cstrcmp(name, "int32")) return JANET_FFI_TYPE_INT32; + if (!janet_cstrcmp(name, "uint32")) return JANET_FFI_TYPE_UINT32; + if (!janet_cstrcmp(name, "int64")) return JANET_FFI_TYPE_INT64; + if (!janet_cstrcmp(name, "uint64")) return JANET_FFI_TYPE_UINT64; + janet_panicf("unknown machine type %s", name); +} + +JANET_CORE_FN(cfun_ffi_signature, + "(ffi/signature calling-convention ret-type & arg-types)", + "Create a function signature object that can be used to make calls " + "with raw function pointers.") { + janet_arity(argc, 2, -1); + uint32_t frame_size = 0; + uint32_t reg_count = 0; + uint32_t stack_count = 0; + JanetFFICallingConvention cc = decode_ffi_cc(janet_getkeyword(argv, 0)); + JanetFFIPrimType ret_type = decode_ffi_prim(janet_getkeyword(argv, 1)); + uint32_t max_regs = JANET_FFI_MAX_REGS; + JanetFFIPrimType regs[JANET_FFI_MAX_REGS]; + JanetFFIPrimType stack[JANET_FFI_MAX_STACK]; + for (int i = 0; i < JANET_FFI_MAX_REGS; i++) regs[i] = JANET_FFI_TYPE_VOID; + for (int i = 0; i < JANET_FFI_MAX_STACK; i++) stack[i] = JANET_FFI_TYPE_VOID; + switch (cc) { + default: + break; + case JANET_FFI_CC_SYSV_64: + max_regs = 6; + break; + } + for (int32_t i = 2; i < argc; i++) { + JanetFFIPrimType ptype = decode_ffi_prim(janet_getkeyword(argv, i)); + if (reg_count < max_regs) { + regs[reg_count++] = ptype; + } else { + stack[stack_count++] = ptype; + frame_size += janet_ffi_type_sizes[ptype]; + } + } + JanetFFISignature *abst = janet_abstract(&janet_signature_type, sizeof(JanetFFISignature)); + abst->frame_size = frame_size; + abst->reg_count = reg_count; + abst->stack_count = stack_count; + abst->cc = cc; + abst->ret_type = ret_type; + abst->arg_count = stack_count + reg_count; + memcpy(abst->regs, regs, sizeof(JanetFFIPrimType) * JANET_FFI_MAX_REGS); + memcpy(abst->stack, stack, sizeof(JanetFFIPrimType) * JANET_FFI_MAX_STACK); + return janet_wrap_abstract(abst); +} + +static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { + switch(janet_type(argv[n])) { + default: + janet_panicf("bad slot #%d, expected pointer convertable type, got %v", argv[n]); + case JANET_POINTER: + case JANET_STRING: + case JANET_KEYWORD: + case JANET_SYMBOL: + return janet_unwrap_pointer(argv[n]); + case JANET_BUFFER: + return janet_unwrap_buffer(argv[n])->data; + } +} + +JANET_CORE_FN(cfun_ffi_call, + "(ffi/call pointer signature & args)", + "Call a raw pointer as a function pointer. The function signature specifies " + "how Janet values in `args` are converted to native machine types.") { + janet_arity(argc, 2, -1); + void *function_pointer = janet_getpointer(argv, 0); + JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type); + janet_fixarity(argc - 2, signature->arg_count); + + uint64_t regs[6]; + for (uint32_t i = 0; i < signature->reg_count; i++) { + switch (signature->regs[i]) { + case JANET_FFI_TYPE_FLOAT: + case JANET_FFI_TYPE_DOUBLE: + janet_panic("nyi"); + break; + case JANET_FFI_TYPE_VOID: + regs[i] = 0; + continue; + case JANET_FFI_TYPE_PTR: + regs[i] = (uint64_t) janet_ffi_getpointer(argv, i + 2); + break; + case JANET_FFI_TYPE_BOOL: + regs[i] = (uint64_t) janet_getboolean(argv, i + 2); + break; + case JANET_FFI_TYPE_SHORT: + case JANET_FFI_TYPE_INT: + case JANET_FFI_TYPE_INT8: + case JANET_FFI_TYPE_INT16: + case JANET_FFI_TYPE_INT32: + case JANET_FFI_TYPE_INT64: + case JANET_FFI_TYPE_LONG: + regs[i] = (uint64_t) janet_getinteger64(argv, i + 2); + break; + case JANET_FFI_TYPE_USHORT: + case JANET_FFI_TYPE_UINT: + case JANET_FFI_TYPE_UINT8: + case JANET_FFI_TYPE_UINT16: + case JANET_FFI_TYPE_UINT32: + case JANET_FFI_TYPE_UINT64: + case JANET_FFI_TYPE_ULONG: + regs[i] = janet_getuinteger64(argv, i + 2); + break; + } + } + + /* Danger zone */ + uint64_t ret, rethi; + __asm__("mov %3, %%rdi\n\t" + "mov %4, %%rsi\n\t" + "mov %5, %%rdx\n\t" + "mov %6, %%rcx\n\t" + "mov %7, %%r8\n\t" + "mov %8, %%r9\n\t" + "call *%2\n\t" + "mov %%rax, %0\n\t" + "mov %%rdx, %1" + : "=g" (ret), "=g" (rethi) + : "g"(function_pointer), + "g"(regs[0]), + "g"(regs[1]), + "g"(regs[2]), + "g"(regs[3]), + "g"(regs[4]), + "g"(regs[5]) + : "rax", "rdi", "rsi", "rdx", "rcx", "r8", "r9", "r10", "r11"); + + (void) rethi; /* at some point we will support more complex return types */ + switch (signature->ret_type) { + case JANET_FFI_TYPE_FLOAT: + case JANET_FFI_TYPE_DOUBLE: + janet_panic("nyi"); + break; + case JANET_FFI_TYPE_VOID: + break; + case JANET_FFI_TYPE_PTR: + return janet_wrap_pointer((void *) ret); + case JANET_FFI_TYPE_BOOL: + return janet_wrap_boolean(ret); + case JANET_FFI_TYPE_SHORT: + case JANET_FFI_TYPE_INT: + case JANET_FFI_TYPE_INT8: + case JANET_FFI_TYPE_INT16: + case JANET_FFI_TYPE_INT32: + return janet_wrap_integer((int32_t) ret); + case JANET_FFI_TYPE_INT64: + case JANET_FFI_TYPE_LONG: + return janet_wrap_integer((int64_t) ret); + case JANET_FFI_TYPE_USHORT: + case JANET_FFI_TYPE_UINT: + case JANET_FFI_TYPE_UINT8: + case JANET_FFI_TYPE_UINT16: + case JANET_FFI_TYPE_UINT32: + case JANET_FFI_TYPE_UINT64: + case JANET_FFI_TYPE_ULONG: + return janet_wrap_number(ret); + } + + return janet_wrap_nil(); +} + +void janet_lib_ffi(JanetTable *env) { + JanetRegExt ffi_cfuns[] = { + JANET_CORE_REG("ffi/get-test-pointer", cfun_ffi_get_test_pointer), + JANET_CORE_REG("ffi/signature", cfun_ffi_signature), + JANET_CORE_REG("ffi/call", cfun_ffi_call), + JANET_REG_END + }; + janet_core_cfuns_ext(env, NULL, ffi_cfuns); +} + +#endif diff --git a/src/core/util.c b/src/core/util.c index e5126a6f..c4cea1dd 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -739,6 +739,13 @@ int janet_checkint64(Janet x) { return janet_checkint64range(dval); } +int janet_checkuint64(Janet x) { + if (!janet_checktype(x, JANET_NUMBER)) + return 0; + double dval = janet_unwrap_number(x); + return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval; +} + int janet_checksize(Janet x) { if (!janet_checktype(x, JANET_NUMBER)) return 0; diff --git a/src/core/util.h b/src/core/util.h index 9ff51f1a..92feaa2c 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -159,5 +159,8 @@ void janet_lib_ev(JanetTable *env); void janet_ev_mark(void); int janet_make_pipe(JanetHandle handles[2], int mode); #endif +#ifdef JANET_FFI +void janet_lib_ffi(JanetTable *env); +#endif #endif diff --git a/src/include/janet.h b/src/include/janet.h index 3a11a6f5..b24493b6 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -163,6 +163,11 @@ extern "C" { #define JANET_DYNAMIC_MODULES #endif +/* Enable or disable the FFI library. */ +#ifndef JANET_NO_FFI +#define JANET_FFI +#endif + /* Enable or disable the assembler. Enabled by default. */ #ifndef JANET_NO_ASSEMBLER #define JANET_ASSEMBLER @@ -865,6 +870,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer); JANET_API int janet_checkint(Janet x); JANET_API int janet_checkint64(Janet x); +JANET_API int janet_checkuint64(Janet x); JANET_API int janet_checksize(Janet x); JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at); #define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x)) @@ -1936,6 +1942,7 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n); JANET_API int32_t janet_getnat(const Janet *argv, int32_t n); JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n); JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n); +JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n); JANET_API size_t janet_getsize(const Janet *argv, int32_t n); JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n); JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n); From 3f27d78ab5c59a5dfbfa456eee2fa02a69563725 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 8 Jun 2022 09:41:09 -0500 Subject: [PATCH 20/89] Add some FFI testing and more improvements to sysv abi. Add support for integer return and floating point return variants, as well as arguments on the stack. Start flushing out struct arguments. Still needed: - structs (packed and unpacked) - complex numbers - long doubles - MASM alternative for windows (you can technically use sysv abi on windows) - more calling conventions. --- Makefile | 5 +- ffitest/so.c | 37 +++++ ffitest/test.janet | 49 ++++++ src/core/ffi.c | 387 ++++++++++++++++++++++++++++++--------------- src/core/util.h | 2 + 5 files changed, 349 insertions(+), 131 deletions(-) create mode 100644 ffitest/so.c create mode 100644 ffitest/test.janet diff --git a/Makefile b/Makefile index dd8e0f25..ad562ee7 100644 --- a/Makefile +++ b/Makefile @@ -227,6 +227,9 @@ valtest: $(JANET_TARGET) $(TEST_PROGRAMS) callgrind: $(JANET_TARGET) for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done +ffitest: $(JANET_TARGET) + $(JANET_TARGET) ffitest/test.janet + ######################## ##### Distribution ##### ######################## @@ -367,5 +370,5 @@ help: @echo ' make grammar Generate a TextMate language grammar' @echo -.PHONY: clean install repl debug valgrind test \ +.PHONY: clean install repl debug valgrind test ffitest \ valtest dist uninstall docs grammar format help compile-commands diff --git a/ffitest/so.c b/ffitest/so.c new file mode 100644 index 00000000..a38c03d1 --- /dev/null +++ b/ffitest/so.c @@ -0,0 +1,37 @@ +#include +#include +#include + +int int_fn(int a, int b) { + return (a << 2) + b; +} + +double my_fn(int64_t a, int64_t b, const char *x) { + return (double)(a + b) + 0.5 + strlen(x); +} + +double double_fn(double x, double y, double z) { + return (x + y) * z * 3; +} + +double double_many(double x, double y, double z, double w, double a, double b) { + return x + y + z + w + a + b; +} + +double double_lots( + double a, + double b, + double c, + double d, + double e, + double f, + double g, + double h, + double i, + double j) { + return i + j; +} + +double float_fn(float x, float y, float z) { + return (x + y) * z; +} diff --git a/ffitest/test.janet b/ffitest/test.janet new file mode 100644 index 00000000..427a9b71 --- /dev/null +++ b/ffitest/test.janet @@ -0,0 +1,49 @@ +(def native-loc "ffitest/so.so") +(def native-source-loc "ffitest/so.c") + +(os/execute ["cc" native-source-loc "-shared" "-o" native-loc] :px) +(def module (raw-native native-loc)) + +(def int-fn-sig (native-signature :default :int :int :int)) +(def int-fn-pointer (native-lookup module "int_fn")) +(defn int-fn + [x y] + (native-call int-fn-pointer int-fn-sig x y)) + +(def double-fn-sig (native-signature :default :double :double :double :double)) +(def double-fn-pointer (native-lookup module "double_fn")) +(defn double-fn + [x y z] + (native-call double-fn-pointer double-fn-sig x y z)) + +(def double-many-sig (native-signature :default :double :double :double :double :double :double :double)) +(def double-many-pointer (native-lookup module "double_many")) +(defn double-many + [x y z w a b] + (native-call double-many-pointer double-many-sig x y z w a b)) + +(def double-lots-sig (native-signature :default :double + :double :double :double :double :double + :double :double :double :double :double)) +(def double-lots-pointer (native-lookup module "double_lots")) +(defn double-lots + [a b c d e f g h i j] + (native-call double-lots-pointer double-lots-sig a b c d e f g h i j)) + +(def float-fn-sig (native-signature :default :double :float :float :float)) +(def float-fn-pointer (native-lookup module "float_fn")) +(defn float-fn + [x y z] + (native-call float-fn-pointer float-fn-sig x y z)) + +# +# Call functions +# + +(assert (= 60 (int-fn 10 20))) +(assert (= 42 (double-fn 1.5 2.5 3.5))) +(assert (= 21 (double-many 1 2 3 4 5 6))) +(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10))) +(assert (= 204 (float-fn 8 4 17))) + +(print "Done.") diff --git a/src/core/ffi.c b/src/core/ffi.c index e0dfd13f..37a8c789 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -28,23 +28,6 @@ #ifdef JANET_FFI -static uint64_t test_function(int32_t a, int32_t b, const char *s) { - printf("a = %d\n", a); - printf("b = %d\n", b); - uint64_t ret = a + b; - printf("string: %s\n", s); - printf("hello from test function. Returning %lu.\n", ret); - return ret; -} - -JANET_CORE_FN(cfun_ffi_get_test_pointer, - "(ffi/get-test-pointer)", - "Get a test pointer to call using ffi.") { - janet_fixarity(argc, 0); - (void) argv; - return janet_wrap_pointer(test_function); -} - typedef enum { JANET_FFI_TYPE_VOID, JANET_FFI_TYPE_SHORT, @@ -67,44 +50,68 @@ typedef enum { JANET_FFI_TYPE_UINT64, } JanetFFIPrimType; -static const size_t janet_ffi_type_sizes[] = { - 0, /* JANET_FFI_TYPE_VOID */ - sizeof(short), /* JANET_FFI_TYPE_SHORT */ - sizeof(int), /* JANET_FFI_TYPE_INT */ - sizeof(long), /* JANET_FFI_TYPE_LONG */ - sizeof(unsigned short), /* JANET_FFI_TYPE_USHORT */ - sizeof(unsigned), /* JANET_FFI_TYPE_UINT */ - sizeof(unsigned long), /* JANET_FFI_TYPE_ULONG */ - sizeof(char), /* JANET_FFI_TYPE_BOOL */ - sizeof(void *), /* JANET_FFI_TYPE_PTR */ - sizeof(float), /* JANET_FFI_TYPE_FLOAT */ - sizeof(double), /* JANET_FFI_TYPE_DOUBLE */ - sizeof(int8_t), /* JANET_FFI_TYPE_INT8 */ - sizeof(uint8_t), /* JANET_FFI_TYPE_UINT8 */ - sizeof(int16_t), /* JANET_FFI_TYPE_INT16 */ - sizeof(uint16_t), /* JANET_FFI_TYPE_UINT16 */ - sizeof(int32_t), /* JANET_FFI_TYPE_INT32 */ - sizeof(uint32_t), /* JANET_FFI_TYPE_UINT32 */ - sizeof(int64_t), /* JANET_FFI_TYPE_INT64 */ - sizeof(uint64_t) /* JANET_FFI_TYPE_UINT64 */ +/* Custom alignof since alignof not in c99 standard */ +#define ALIGNOF(type) offsetof(struct { char c; type member; }, member) + +typedef struct { + size_t size; + size_t align; +} JanetFFIPrimInfo; + +static const JanetFFIPrimInfo janet_ffi_type_info[] = { + {0, 0}, /* JANET_FFI_TYPE_VOID */ + {sizeof(short), ALIGNOF(short)},/* JANET_FFI_TYPE_SHORT */ + {sizeof(int), ALIGNOF(int)}, /* JANET_FFI_TYPE_INT */ + {sizeof(long), ALIGNOF(long)}, /* JANET_FFI_TYPE_LONG */ + {sizeof(unsigned short), ALIGNOF(unsigned short)}, /* JANET_FFI_TYPE_USHORT */ + {sizeof(unsigned), ALIGNOF(unsigned)}, /* JANET_FFI_TYPE_UINT */ + {sizeof(unsigned long), ALIGNOF(unsigned long)}, /* JANET_FFI_TYPE_ULONG */ + {sizeof(char), ALIGNOF(char)}, /* JANET_FFI_TYPE_BOOL */ + {sizeof(void *), ALIGNOF(void *)}, /* JANET_FFI_TYPE_PTR */ + {sizeof(float), ALIGNOF(float)}, /* JANET_FFI_TYPE_FLOAT */ + {sizeof(double), ALIGNOF(double)}, /* JANET_FFI_TYPE_DOUBLE */ + {sizeof(int8_t), ALIGNOF(int8_t)}, /* JANET_FFI_TYPE_INT8 */ + {sizeof(uint8_t), ALIGNOF(uint8_t)}, /* JANET_FFI_TYPE_UINT8 */ + {sizeof(int16_t), ALIGNOF(int16_t)}, /* JANET_FFI_TYPE_INT16 */ + {sizeof(uint16_t), ALIGNOF(uint16_t)}, /* JANET_FFI_TYPE_UINT16 */ + {sizeof(int32_t), ALIGNOF(int32_t)}, /* JANET_FFI_TYPE_INT32 */ + {sizeof(uint32_t), ALIGNOF(uint32_t)}, /* JANET_FFI_TYPE_UINT32 */ + {sizeof(int64_t), ALIGNOF(int64_t)}, /* JANET_FFI_TYPE_INT64 */ + {sizeof(uint64_t), ALIGNOF(uint64_t)}, /* JANET_FFI_TYPE_UINT64 */ }; +typedef struct { + uint32_t size; + uint32_t align; + uint32_t field_count; + JanetFFIPrimType fields[]; +} JanetFFIStruct; + +typedef struct { + JanetFFIPrimType prim; + int32_t argn; +} JanetFFIMapping; + typedef enum { JANET_FFI_CC_SYSV_64 } JanetFFICallingConvention; #define JANET_FFI_MAX_REGS 16 +#define JANET_FFI_MAX_FP_REGS 8 #define JANET_FFI_MAX_STACK 32 typedef struct { uint32_t frame_size; uint32_t reg_count; + uint32_t fp_reg_count; uint32_t stack_count; uint32_t arg_count; + uint32_t variant; JanetFFICallingConvention cc; JanetFFIPrimType ret_type; - JanetFFIPrimType regs[JANET_FFI_MAX_REGS]; - JanetFFIPrimType stack[JANET_FFI_MAX_STACK]; + JanetFFIMapping regs[JANET_FFI_MAX_REGS]; + JanetFFIMapping fp_regs[JANET_FFI_MAX_FP_REGS]; + JanetFFIMapping stack[JANET_FFI_MAX_STACK]; } JanetFFISignature; static const JanetAbstractType janet_signature_type = { @@ -113,9 +120,11 @@ static const JanetAbstractType janet_signature_type = { }; static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) { - /* TODO */ - (void) name; - return JANET_FFI_CC_SYSV_64; + if (!janet_cstrcmp(name, "sysv64")) return JANET_FFI_CC_SYSV_64; + if (!janet_cstrcmp(name, "default")) { + return JANET_FFI_CC_SYSV_64; + } + janet_panicf("unknown calling convention %s", name); } static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { @@ -138,49 +147,87 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { if (!janet_cstrcmp(name, "uint32")) return JANET_FFI_TYPE_UINT32; if (!janet_cstrcmp(name, "int64")) return JANET_FFI_TYPE_INT64; if (!janet_cstrcmp(name, "uint64")) return JANET_FFI_TYPE_UINT64; +#ifdef JANET_64 + if (!janet_cstrcmp(name, "size")) return JANET_FFI_TYPE_UINT64; + if (!janet_cstrcmp(name, "ssize")) return JANET_FFI_TYPE_INT64; +#else + if (!janet_cstrcmp(name, "size")) return JANET_FFI_TYPE_UINT32; + if (!janet_cstrcmp(name, "ssize")) return JANET_FFI_TYPE_INT32; +#endif janet_panicf("unknown machine type %s", name); } +static int is_fp_type(JanetFFIPrimType prim) { + return prim == JANET_FFI_TYPE_DOUBLE || prim == JANET_FFI_TYPE_FLOAT; +} + JANET_CORE_FN(cfun_ffi_signature, - "(ffi/signature calling-convention ret-type & arg-types)", + "(native-signature calling-convention ret-type & arg-types)", "Create a function signature object that can be used to make calls " "with raw function pointers.") { janet_arity(argc, 2, -1); uint32_t frame_size = 0; uint32_t reg_count = 0; + uint32_t fp_reg_count = 0; uint32_t stack_count = 0; + uint32_t variant = 0; JanetFFICallingConvention cc = decode_ffi_cc(janet_getkeyword(argv, 0)); JanetFFIPrimType ret_type = decode_ffi_prim(janet_getkeyword(argv, 1)); uint32_t max_regs = JANET_FFI_MAX_REGS; - JanetFFIPrimType regs[JANET_FFI_MAX_REGS]; - JanetFFIPrimType stack[JANET_FFI_MAX_STACK]; - for (int i = 0; i < JANET_FFI_MAX_REGS; i++) regs[i] = JANET_FFI_TYPE_VOID; - for (int i = 0; i < JANET_FFI_MAX_STACK; i++) stack[i] = JANET_FFI_TYPE_VOID; + uint32_t max_fp_regs = JANET_FFI_MAX_FP_REGS; + JanetFFIMapping regs[JANET_FFI_MAX_REGS]; + JanetFFIMapping stack[JANET_FFI_MAX_STACK]; + JanetFFIMapping fp_regs[JANET_FFI_MAX_FP_REGS]; + for (int i = 0; i < JANET_FFI_MAX_REGS; i++) { + regs[i].prim = JANET_FFI_TYPE_VOID; + regs[i].argn = 0; + } + for (int i = 0; i < JANET_FFI_MAX_FP_REGS; i++) { + fp_regs[i].prim = JANET_FFI_TYPE_VOID; + fp_regs[i].argn = 0; + } + for (int i = 0; i < JANET_FFI_MAX_STACK; i++) { + stack[i].prim = JANET_FFI_TYPE_VOID; + stack[i].argn = 0; + } switch (cc) { default: break; case JANET_FFI_CC_SYSV_64: max_regs = 6; + max_fp_regs = 8; + if (is_fp_type(ret_type)) variant = 1; break; } for (int32_t i = 2; i < argc; i++) { JanetFFIPrimType ptype = decode_ffi_prim(janet_getkeyword(argv, i)); - if (reg_count < max_regs) { - regs[reg_count++] = ptype; + int is_fp = is_fp_type(ptype); + if (is_fp && fp_reg_count < max_fp_regs) { + fp_regs[fp_reg_count].argn = i; + fp_regs[fp_reg_count++].prim = ptype; + } else if (!is_fp && reg_count < max_regs) { + regs[reg_count].argn = i; + regs[reg_count++].prim = ptype; } else { - stack[stack_count++] = ptype; - frame_size += janet_ffi_type_sizes[ptype]; + stack[stack_count].argn = i; + stack[stack_count++].prim = ptype; + frame_size += janet_ffi_type_info[ptype].size; } } + + /* Create signature abstract value */ JanetFFISignature *abst = janet_abstract(&janet_signature_type, sizeof(JanetFFISignature)); abst->frame_size = frame_size; abst->reg_count = reg_count; + abst->fp_reg_count = fp_reg_count; abst->stack_count = stack_count; abst->cc = cc; abst->ret_type = ret_type; - abst->arg_count = stack_count + reg_count; - memcpy(abst->regs, regs, sizeof(JanetFFIPrimType) * JANET_FFI_MAX_REGS); - memcpy(abst->stack, stack, sizeof(JanetFFIPrimType) * JANET_FFI_MAX_STACK); + abst->arg_count = stack_count + reg_count + fp_reg_count; + abst->variant = variant; + memcpy(abst->regs, regs, sizeof(JanetFFIMapping) * JANET_FFI_MAX_REGS); + memcpy(abst->fp_regs, fp_regs, sizeof(JanetFFIMapping) * JANET_FFI_MAX_FP_REGS); + memcpy(abst->stack, stack, sizeof(JanetFFIMapping) * JANET_FFI_MAX_STACK); return janet_wrap_abstract(abst); } @@ -198,81 +245,67 @@ static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { } } -JANET_CORE_FN(cfun_ffi_call, - "(ffi/call pointer signature & args)", - "Call a raw pointer as a function pointer. The function signature specifies " - "how Janet values in `args` are converted to native machine types.") { - janet_arity(argc, 2, -1); - void *function_pointer = janet_getpointer(argv, 0); - JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type); - janet_fixarity(argc - 2, signature->arg_count); - - uint64_t regs[6]; - for (uint32_t i = 0; i < signature->reg_count; i++) { - switch (signature->regs[i]) { - case JANET_FFI_TYPE_FLOAT: - case JANET_FFI_TYPE_DOUBLE: - janet_panic("nyi"); - break; - case JANET_FFI_TYPE_VOID: - regs[i] = 0; - continue; - case JANET_FFI_TYPE_PTR: - regs[i] = (uint64_t) janet_ffi_getpointer(argv, i + 2); - break; - case JANET_FFI_TYPE_BOOL: - regs[i] = (uint64_t) janet_getboolean(argv, i + 2); - break; - case JANET_FFI_TYPE_SHORT: - case JANET_FFI_TYPE_INT: - case JANET_FFI_TYPE_INT8: - case JANET_FFI_TYPE_INT16: - case JANET_FFI_TYPE_INT32: - case JANET_FFI_TYPE_INT64: - case JANET_FFI_TYPE_LONG: - regs[i] = (uint64_t) janet_getinteger64(argv, i + 2); - break; - case JANET_FFI_TYPE_USHORT: - case JANET_FFI_TYPE_UINT: - case JANET_FFI_TYPE_UINT8: - case JANET_FFI_TYPE_UINT16: - case JANET_FFI_TYPE_UINT32: - case JANET_FFI_TYPE_UINT64: - case JANET_FFI_TYPE_ULONG: - regs[i] = janet_getuinteger64(argv, i + 2); - break; - } - } - - /* Danger zone */ - uint64_t ret, rethi; - __asm__("mov %3, %%rdi\n\t" - "mov %4, %%rsi\n\t" - "mov %5, %%rdx\n\t" - "mov %6, %%rcx\n\t" - "mov %7, %%r8\n\t" - "mov %8, %%r9\n\t" - "call *%2\n\t" - "mov %%rax, %0\n\t" - "mov %%rdx, %1" - : "=g" (ret), "=g" (rethi) - : "g"(function_pointer), - "g"(regs[0]), - "g"(regs[1]), - "g"(regs[2]), - "g"(regs[3]), - "g"(regs[4]), - "g"(regs[5]) - : "rax", "rdi", "rsi", "rdx", "rcx", "r8", "r9", "r10", "r11"); - - (void) rethi; /* at some point we will support more complex return types */ - switch (signature->ret_type) { - case JANET_FFI_TYPE_FLOAT: - case JANET_FFI_TYPE_DOUBLE: +static uint64_t janet_ffi_reg64(const Janet *argv, JanetFFIMapping mapping) { + JanetFFIPrimType ptype = mapping.prim; + int32_t n = mapping.argn; + union { + float f; + double d; + uint64_t reg; + } u; + switch (ptype) { + default: janet_panic("nyi"); - break; + return 0; + case JANET_FFI_TYPE_DOUBLE: + u.d = janet_getnumber(argv, n); + return u.reg; + case JANET_FFI_TYPE_FLOAT: + u.f = janet_getnumber(argv, n); + return u.reg; case JANET_FFI_TYPE_VOID: - break; + return 0; + case JANET_FFI_TYPE_PTR: + return (uint64_t) janet_ffi_getpointer(argv, n); + case JANET_FFI_TYPE_BOOL: + return (uint64_t) janet_getboolean(argv, n); + case JANET_FFI_TYPE_SHORT: + case JANET_FFI_TYPE_INT: + case JANET_FFI_TYPE_INT8: + case JANET_FFI_TYPE_INT16: + case JANET_FFI_TYPE_INT32: + case JANET_FFI_TYPE_INT64: + case JANET_FFI_TYPE_LONG: + return (uint64_t) janet_getinteger64(argv, n); + case JANET_FFI_TYPE_USHORT: + case JANET_FFI_TYPE_UINT: + case JANET_FFI_TYPE_UINT8: + case JANET_FFI_TYPE_UINT16: + case JANET_FFI_TYPE_UINT32: + case JANET_FFI_TYPE_UINT64: + case JANET_FFI_TYPE_ULONG: + return janet_getuinteger64(argv, n); + } +} + +static Janet janet_ffi_from64(uint64_t ret, JanetFFIPrimType ret_type) { + union { + float f; + double d; + uint64_t reg; + } u; + switch (ret_type) { + default: + janet_panic("nyi"); + return janet_wrap_nil(); + case JANET_FFI_TYPE_FLOAT: + u.reg = ret; + return janet_wrap_number(u.f); + case JANET_FFI_TYPE_DOUBLE: + u.reg = ret; + return janet_wrap_number(u.d); + case JANET_FFI_TYPE_VOID: + return janet_wrap_nil(); case JANET_FFI_TYPE_PTR: return janet_wrap_pointer((void *) ret); case JANET_FFI_TYPE_BOOL: @@ -295,15 +328,109 @@ JANET_CORE_FN(cfun_ffi_call, case JANET_FFI_TYPE_ULONG: return janet_wrap_number(ret); } +} + +static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) { + uint64_t ret, rethi; + (void) rethi; /* at some point we will support more complex return types */ + uint64_t regs[6]; + uint64_t fp_regs[8]; + for (uint32_t i = 0; i < signature->reg_count; i++) { + regs[i] = janet_ffi_reg64(argv, signature->regs[i]); + } + for (uint32_t i = 0; i < signature->fp_reg_count; i++) { + fp_regs[i] = janet_ffi_reg64(argv, signature->fp_regs[i]); + } + uint64_t *stack = alloca(sizeof(uint64_t) * signature->stack_count); + for (uint32_t i = 0; i < signature->stack_count; i++) { + stack[signature->stack_count - 1 - i] = janet_ffi_reg64(argv, signature->stack[i]); + } + + /* !!ACHTUNG!! */ + +#define FFI_ASM_PRELUDE \ + "mov %3, %%rdi\n\t" \ + "mov %4, %%rsi\n\t" \ + "mov %5, %%rdx\n\t" \ + "mov %6, %%rcx\n\t" \ + "mov %7, %%r8\n\t" \ + "mov %8, %%r9\n\t" \ + "movq %9, %%xmm0\n\t" \ + "movq %10, %%xmm1\n\t" \ + "movq %11, %%xmm2\n\t" \ + "movq %12, %%xmm3\n\t" \ + "movq %13, %%xmm4\n\t" \ + "movq %14, %%xmm5\n\t" \ + "movq %15, %%xmm6\n\t" \ + "movq %16, %%xmm7\n\t" +#define FFI_ASM_OUTPUTS "=g" (ret), "=g" (rethi) +#define FFI_ASM_INPUTS \ + "g"(function_pointer), \ + "g"(regs[0]), \ + "g"(regs[1]), \ + "g"(regs[2]), \ + "g"(regs[3]), \ + "g"(regs[4]), \ + "g"(regs[5]), \ + "g"(fp_regs[0]), \ + "g"(fp_regs[1]), \ + "g"(fp_regs[2]), \ + "g"(fp_regs[3]), \ + "g"(fp_regs[4]), \ + "g"(fp_regs[5]), \ + "g"(fp_regs[6]), \ + "g"(fp_regs[7]) + + switch (signature->variant) { + default: + /* fallthrough */ + case 0: + __asm__( FFI_ASM_PRELUDE + "call *%2\n\t" + "mov %%rax, %0\n\t" + "mov %%rdx, %1" + : FFI_ASM_OUTPUTS + : FFI_ASM_INPUTS + : "rax", "rdi", "rsi", "rdx", "rcx", "r8", "r9", "r10", "r11"); + return janet_ffi_from64(ret, signature->ret_type); + case 1: + __asm__( FFI_ASM_PRELUDE + "call *%2\n\t" + "movq %%xmm0, %0\n\t" + "movq %%xmm1, %1" + : FFI_ASM_OUTPUTS + : FFI_ASM_INPUTS + : "rax", "rdi", "rsi", "rdx", "rcx", "r8", "r9", "r10", "r11"); + return janet_ffi_from64(ret, signature->ret_type); + } + +#undef FFI_ASM_PRELUDE +#undef FFI_ASM_OUTPUTS +#undef FFI_ASM_INPUTS return janet_wrap_nil(); } +JANET_CORE_FN(cfun_ffi_call, + "(native-call pointer signature & args)", + "Call a raw pointer as a function pointer. The function signature specifies " + "how Janet values in `args` are converted to native machine types.") { + janet_arity(argc, 2, -1); + void *function_pointer = janet_getpointer(argv, 0); + JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type); + janet_fixarity(argc - 2, signature->arg_count); + switch (signature->cc) { + default: + janet_panic("unsupported calling convention"); + case JANET_FFI_CC_SYSV_64: + return janet_ffi_sysv64(signature, function_pointer, argv); + } +} + void janet_lib_ffi(JanetTable *env) { JanetRegExt ffi_cfuns[] = { - JANET_CORE_REG("ffi/get-test-pointer", cfun_ffi_get_test_pointer), - JANET_CORE_REG("ffi/signature", cfun_ffi_signature), - JANET_CORE_REG("ffi/call", cfun_ffi_call), + JANET_CORE_REG("native-signature", cfun_ffi_signature), + JANET_CORE_REG("native-call", cfun_ffi_call), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, ffi_cfuns); diff --git a/src/core/util.h b/src/core/util.h index 92feaa2c..69d9f358 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -31,6 +31,8 @@ #include #include +#include +#include /* for ffi */ #if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED) #include From f92aac14aa711d0635c66b3bf40edd99a1ecdc6a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 8 Jun 2022 09:50:31 -0500 Subject: [PATCH 21/89] Only enable FFI on x86-64, non-windows OSes. --- ffitest/so.c | 22 +++++++++++----------- src/core/ffi.c | 24 ++++++++++++------------ src/include/janet.h | 5 ++++- 3 files changed, 27 insertions(+), 24 deletions(-) diff --git a/ffitest/so.c b/ffitest/so.c index a38c03d1..9c18b50a 100644 --- a/ffitest/so.c +++ b/ffitest/so.c @@ -19,17 +19,17 @@ double double_many(double x, double y, double z, double w, double a, double b) { } double double_lots( - double a, - double b, - double c, - double d, - double e, - double f, - double g, - double h, - double i, - double j) { - return i + j; + double a, + double b, + double c, + double d, + double e, + double f, + double g, + double h, + double i, + double j) { + return i + j; } double float_fn(float x, float y, float z) { diff --git a/src/core/ffi.c b/src/core/ffi.c index 37a8c789..89230ab9 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -162,9 +162,9 @@ static int is_fp_type(JanetFFIPrimType prim) { } JANET_CORE_FN(cfun_ffi_signature, - "(native-signature calling-convention ret-type & arg-types)", - "Create a function signature object that can be used to make calls " - "with raw function pointers.") { + "(native-signature calling-convention ret-type & arg-types)", + "Create a function signature object that can be used to make calls " + "with raw function pointers.") { janet_arity(argc, 2, -1); uint32_t frame_size = 0; uint32_t reg_count = 0; @@ -214,7 +214,7 @@ JANET_CORE_FN(cfun_ffi_signature, frame_size += janet_ffi_type_info[ptype].size; } } - + /* Create signature abstract value */ JanetFFISignature *abst = janet_abstract(&janet_signature_type, sizeof(JanetFFISignature)); abst->frame_size = frame_size; @@ -232,7 +232,7 @@ JANET_CORE_FN(cfun_ffi_signature, } static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { - switch(janet_type(argv[n])) { + switch (janet_type(argv[n])) { default: janet_panicf("bad slot #%d, expected pointer convertable type, got %v", argv[n]); case JANET_POINTER: @@ -343,7 +343,7 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point } uint64_t *stack = alloca(sizeof(uint64_t) * signature->stack_count); for (uint32_t i = 0; i < signature->stack_count; i++) { - stack[signature->stack_count - 1 - i] = janet_ffi_reg64(argv, signature->stack[i]); + stack[signature->stack_count - 1 - i] = janet_ffi_reg64(argv, signature->stack[i]); } /* !!ACHTUNG!! */ @@ -383,9 +383,9 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point switch (signature->variant) { default: - /* fallthrough */ + /* fallthrough */ case 0: - __asm__( FFI_ASM_PRELUDE + __asm__(FFI_ASM_PRELUDE "call *%2\n\t" "mov %%rax, %0\n\t" "mov %%rdx, %1" @@ -394,7 +394,7 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point : "rax", "rdi", "rsi", "rdx", "rcx", "r8", "r9", "r10", "r11"); return janet_ffi_from64(ret, signature->ret_type); case 1: - __asm__( FFI_ASM_PRELUDE + __asm__(FFI_ASM_PRELUDE "call *%2\n\t" "movq %%xmm0, %0\n\t" "movq %%xmm1, %1" @@ -412,9 +412,9 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point } JANET_CORE_FN(cfun_ffi_call, - "(native-call pointer signature & args)", - "Call a raw pointer as a function pointer. The function signature specifies " - "how Janet values in `args` are converted to native machine types.") { + "(native-call pointer signature & args)", + "Call a raw pointer as a function pointer. The function signature specifies " + "how Janet values in `args` are converted to native machine types.") { janet_arity(argc, 2, -1); void *function_pointer = janet_getpointer(argv, 0); JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type); diff --git a/src/include/janet.h b/src/include/janet.h index b24493b6..9f93ddb5 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -163,10 +163,13 @@ extern "C" { #define JANET_DYNAMIC_MODULES #endif -/* Enable or disable the FFI library. */ +/* Enable or disable the FFI library. Currently, FFI only enabled on + * x86-64, non-windows operating systems. */ #ifndef JANET_NO_FFI +#if !defined(JANET_WINDOWS) && (defined(__x86_64__) || defined(_M_X64)) #define JANET_FFI #endif +#endif /* Enable or disable the assembler. Enabled by default. */ #ifndef JANET_NO_ASSEMBLER From 9d9cb378fffeb58ca4feb97bce6c43156620cbf9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 8 Jun 2022 09:59:13 -0500 Subject: [PATCH 22/89] Don't include alloca.h, not in MSVC. --- src/core/ffi.c | 4 ++++ src/core/util.h | 1 - 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 89230ab9..384e44bb 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -28,6 +28,10 @@ #ifdef JANET_FFI +#ifdef _MSC_VER +#define alloca _alloca +#endif + typedef enum { JANET_FFI_TYPE_VOID, JANET_FFI_TYPE_SHORT, diff --git a/src/core/util.h b/src/core/util.h index 69d9f358..2fb597e1 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -32,7 +32,6 @@ #include #include #include -#include /* for ffi */ #if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED) #include From 6f90df26a53b579d380ed1ea46d323db174f8b8b Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Wed, 8 Jun 2022 10:01:19 -0500 Subject: [PATCH 23/89] Alloca included by default on some OS, but not all. Do explcitly include alloca on non-msvc compilers. --- src/core/util.h | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/core/util.h b/src/core/util.h index 2fb597e1..204ea2c4 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -33,6 +33,10 @@ #include #include +#ifndef _MSC_VER +#include +#endif + #if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED) #include #define JANET_GETTIME From aca52d1e3655d7d433d67a802e40b0fe42916d7c Mon Sep 17 00:00:00 2001 From: masukomi Date: Wed, 8 Jun 2022 21:57:43 -0400 Subject: [PATCH 24/89] added make install & install-jpm-git to readme --- README.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/README.md b/README.md index c6b00461..30e8c009 100644 --- a/README.md +++ b/README.md @@ -89,6 +89,8 @@ cd somewhere/my/projects/janet make make test make repl +make install +make install-jpm-git ``` Find out more about the available make targets by running `make help`. @@ -103,6 +105,8 @@ cd somewhere/my/projects/janet make CC=gcc-x86 make test make repl +make install +make install-jpm-git ``` ### FreeBSD @@ -116,6 +120,8 @@ cd somewhere/my/projects/janet gmake gmake test gmake repl +gmake install +gmake install-jpm-git ``` ### NetBSD From f1ec8d1e11ea11e73fa2d002097448526d46a1a6 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 9 Jun 2022 20:27:56 -0500 Subject: [PATCH 25/89] Beginning of struct support. TODO: - struct return values - support for unions in signatures - more testing - complex types - packed structs - writing structs to buffers (useful and we have most of the machinery). --- ffitest/so.c | 21 ++ ffitest/test.janet | 22 ++ src/core/ffi.c | 543 +++++++++++++++++++++++++++++++-------------- src/core/util.h | 1 + 4 files changed, 421 insertions(+), 166 deletions(-) diff --git a/ffitest/so.c b/ffitest/so.c index 9c18b50a..22481932 100644 --- a/ffitest/so.c +++ b/ffitest/so.c @@ -35,3 +35,24 @@ double double_lots( double float_fn(float x, float y, float z) { return (x + y) * z; } + +typedef struct { + int a; + int b; +} intint; + +typedef struct { + int a; + int b; + int c; +} intintint; + +int intint_fn(double x, intint ii) { + printf("double: %g\n", x); + return ii.a + ii.b; +} + +int intintint_fn(double x, intintint iii) { + printf("double: %g\n", x); + return iii.a + iii.b + iii.c; +} diff --git a/ffitest/test.janet b/ffitest/test.janet index 427a9b71..0eb4a199 100644 --- a/ffitest/test.janet +++ b/ffitest/test.janet @@ -36,10 +36,32 @@ [x y z] (native-call float-fn-pointer float-fn-sig x y z)) +(def intint-fn-sig (native-signature :default :int :double [:int :int])) +(def intint-fn-pointer (native-lookup module "intint_fn")) +(defn intint-fn + [x ii] + (native-call intint-fn-pointer intint-fn-sig x ii)) + + +(def intintint (native-struct :int :int :int)) +(def intintint-fn-sig (native-signature :default :int :double intintint)) +(def intintint-fn-pointer (native-lookup module "intintint_fn")) +(defn intintint-fn + [x iii] + (native-call intintint-fn-pointer intintint-fn-sig x iii)) + # # Call functions # +(pp (int-fn 10 20)) +(pp (double-fn 1.5 2.5 3.5)) +(pp (double-many 1 2 3 4 5 6)) +(pp (double-lots 1 2 3 4 5 6 7 8 9 10)) +(pp (float-fn 8 4 17)) +(pp (intint-fn 123.456 [10 20])) +(pp (intintint-fn 123.456 [10 20 30])) + (assert (= 60 (int-fn 10 20))) (assert (= 42 (double-fn 1.5 2.5 3.5))) (assert (= 21 (double-many 1 2 3 4 5 6))) diff --git a/src/core/ffi.c b/src/core/ffi.c index 384e44bb..f6306b98 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -32,14 +32,11 @@ #define alloca _alloca #endif +typedef struct JanetFFIType JanetFFIType; +typedef struct JanetFFIStruct JanetFFIStruct; + typedef enum { JANET_FFI_TYPE_VOID, - JANET_FFI_TYPE_SHORT, - JANET_FFI_TYPE_INT, - JANET_FFI_TYPE_LONG, - JANET_FFI_TYPE_USHORT, - JANET_FFI_TYPE_UINT, - JANET_FFI_TYPE_ULONG, JANET_FFI_TYPE_BOOL, JANET_FFI_TYPE_PTR, JANET_FFI_TYPE_FLOAT, @@ -52,6 +49,7 @@ typedef enum { JANET_FFI_TYPE_UINT32, JANET_FFI_TYPE_INT64, JANET_FFI_TYPE_UINT64, + JANET_FFI_TYPE_STRUCT } JanetFFIPrimType; /* Custom alignof since alignof not in c99 standard */ @@ -64,12 +62,6 @@ typedef struct { static const JanetFFIPrimInfo janet_ffi_type_info[] = { {0, 0}, /* JANET_FFI_TYPE_VOID */ - {sizeof(short), ALIGNOF(short)},/* JANET_FFI_TYPE_SHORT */ - {sizeof(int), ALIGNOF(int)}, /* JANET_FFI_TYPE_INT */ - {sizeof(long), ALIGNOF(long)}, /* JANET_FFI_TYPE_LONG */ - {sizeof(unsigned short), ALIGNOF(unsigned short)}, /* JANET_FFI_TYPE_USHORT */ - {sizeof(unsigned), ALIGNOF(unsigned)}, /* JANET_FFI_TYPE_UINT */ - {sizeof(unsigned long), ALIGNOF(unsigned long)}, /* JANET_FFI_TYPE_ULONG */ {sizeof(char), ALIGNOF(char)}, /* JANET_FFI_TYPE_BOOL */ {sizeof(void *), ALIGNOF(void *)}, /* JANET_FFI_TYPE_PTR */ {sizeof(float), ALIGNOF(float)}, /* JANET_FFI_TYPE_FLOAT */ @@ -82,47 +74,121 @@ static const JanetFFIPrimInfo janet_ffi_type_info[] = { {sizeof(uint32_t), ALIGNOF(uint32_t)}, /* JANET_FFI_TYPE_UINT32 */ {sizeof(int64_t), ALIGNOF(int64_t)}, /* JANET_FFI_TYPE_INT64 */ {sizeof(uint64_t), ALIGNOF(uint64_t)}, /* JANET_FFI_TYPE_UINT64 */ + {0, ALIGNOF(uint64_t)} /* JANET_FFI_TYPE_STRUCT */ }; -typedef struct { +struct JanetFFIType { + JanetFFIStruct *st; + JanetFFIPrimType prim; +}; + +struct JanetFFIStruct { uint32_t size; uint32_t align; uint32_t field_count; - JanetFFIPrimType fields[]; -} JanetFFIStruct; + JanetFFIType fields[]; +}; +/* Specifies how the registers are classified. This is used + * to determine if a certain argument should be passed in a register, + * on the stack, special floating pointer register, etc. */ +typedef enum { + JANET_SYSV64_INTEGER, + JANET_SYSV64_SSE, + JANET_SYSV64_SSEUP, + JANET_SYSV64_X87, + JANET_SYSV64_X87UP, + JANET_SYSV64_COMPLEX_X87, + JANET_SYSV64_NO_CLASS, + JANET_SYSV64_MEMORY +} JanetFFIWordSpec; + +/* Describe how each Janet argument is interpreted in terms of machine words + * that will be mapped to registers/stack. */ typedef struct { - JanetFFIPrimType prim; - int32_t argn; + JanetFFIType type; + JanetFFIWordSpec spec; + uint32_t offset; /* point to the exact register / stack offset depending on spec. */ } JanetFFIMapping; typedef enum { JANET_FFI_CC_SYSV_64 } JanetFFICallingConvention; -#define JANET_FFI_MAX_REGS 16 -#define JANET_FFI_MAX_FP_REGS 8 -#define JANET_FFI_MAX_STACK 32 +#define JANET_FFI_MAX_ARGS 32 typedef struct { uint32_t frame_size; - uint32_t reg_count; - uint32_t fp_reg_count; - uint32_t stack_count; uint32_t arg_count; + uint32_t word_count; uint32_t variant; + uint32_t stack_count; JanetFFICallingConvention cc; - JanetFFIPrimType ret_type; - JanetFFIMapping regs[JANET_FFI_MAX_REGS]; - JanetFFIMapping fp_regs[JANET_FFI_MAX_FP_REGS]; - JanetFFIMapping stack[JANET_FFI_MAX_STACK]; + JanetFFIType ret_type; + JanetFFIMapping args[JANET_FFI_MAX_ARGS]; } JanetFFISignature; +int signature_mark(void *p, size_t s) { + (void) s; + JanetFFISignature *sig = p; + for (uint32_t i = 0; i < sig->arg_count; i++) { + JanetFFIType t = sig->args[i].type; + if (t.prim == JANET_FFI_TYPE_STRUCT) { + janet_mark(janet_wrap_abstract(t.st)); + } + } + return 0; +} + static const JanetAbstractType janet_signature_type = { "core/ffi-signature", - JANET_ATEND_NAME + NULL, + signature_mark, + JANET_ATEND_GCMARK }; +int struct_mark(void *p, size_t s) { + (void) s; + JanetFFIStruct *st = p; + for (uint32_t i = 0; i < st->field_count; i++) { + JanetFFIType t = st->fields[i]; + if (t.prim == JANET_FFI_TYPE_STRUCT) { + janet_mark(janet_wrap_abstract(t.st)); + } + } + return 0; +} + +static const JanetAbstractType janet_struct_type = { + "core/ffi-struct", + NULL, + struct_mark, + JANET_ATEND_GCMARK +}; + +static JanetFFIType prim_type(JanetFFIPrimType pt) { + JanetFFIType t; + t.prim = pt; + t.st = NULL; + return t; +} + +static size_t type_size(JanetFFIType t) { + if (t.prim == JANET_FFI_TYPE_STRUCT) { + return t.st->size; + } else { + return janet_ffi_type_info[t.prim].size; + } +} + +static size_t type_align(JanetFFIType t) { + if (t.prim == JANET_FFI_TYPE_STRUCT) { + return t.st->align; + } else { + return janet_ffi_type_info[t.prim].align; + } +} + static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) { if (!janet_cstrcmp(name, "sysv64")) return JANET_FFI_CC_SYSV_64; if (!janet_cstrcmp(name, "default")) { @@ -133,12 +199,6 @@ static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) { static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { if (!janet_cstrcmp(name, "void")) return JANET_FFI_TYPE_VOID; - if (!janet_cstrcmp(name, "short")) return JANET_FFI_TYPE_SHORT; - if (!janet_cstrcmp(name, "int")) return JANET_FFI_TYPE_INT; - if (!janet_cstrcmp(name, "long")) return JANET_FFI_TYPE_LONG; - if (!janet_cstrcmp(name, "ushort")) return JANET_FFI_TYPE_USHORT; - if (!janet_cstrcmp(name, "uint")) return JANET_FFI_TYPE_UINT; - if (!janet_cstrcmp(name, "ulong")) return JANET_FFI_TYPE_ULONG; if (!janet_cstrcmp(name, "bool")) return JANET_FFI_TYPE_BOOL; if (!janet_cstrcmp(name, "ptr")) return JANET_FFI_TYPE_PTR; if (!janet_cstrcmp(name, "float")) return JANET_FFI_TYPE_FLOAT; @@ -158,81 +218,61 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { if (!janet_cstrcmp(name, "size")) return JANET_FFI_TYPE_UINT32; if (!janet_cstrcmp(name, "ssize")) return JANET_FFI_TYPE_INT32; #endif + /* aliases */ + if (!janet_cstrcmp(name, "char")) return JANET_FFI_TYPE_INT8; + if (!janet_cstrcmp(name, "short")) return JANET_FFI_TYPE_INT16; + if (!janet_cstrcmp(name, "int")) return JANET_FFI_TYPE_INT32; + if (!janet_cstrcmp(name, "long")) return JANET_FFI_TYPE_INT64; + if (!janet_cstrcmp(name, "byte")) return JANET_FFI_TYPE_UINT8; + if (!janet_cstrcmp(name, "ushort")) return JANET_FFI_TYPE_UINT16; + if (!janet_cstrcmp(name, "uint")) return JANET_FFI_TYPE_UINT32; + if (!janet_cstrcmp(name, "ulong")) return JANET_FFI_TYPE_UINT64; janet_panicf("unknown machine type %s", name); } -static int is_fp_type(JanetFFIPrimType prim) { - return prim == JANET_FFI_TYPE_DOUBLE || prim == JANET_FFI_TYPE_FLOAT; +static JanetFFIType decode_ffi_type(Janet x); + +static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) { + JanetFFIStruct *st = janet_abstract(&janet_struct_type, + sizeof(JanetFFIStruct) + argc * sizeof(JanetFFIType)); + st->field_count = argc; + st->size = 0; + st->align = 1; + for (int32_t i = 0; i < argc; i++) { + st->fields[i] = decode_ffi_type(argv[i]); + size_t el_align = type_align(st->fields[i]); + size_t el_size = type_size(st->fields[i]); + if (el_align > st->align) st->align = el_align; + st->size = el_size + (((st->size + el_align - 1) / el_align) * el_align); + } + return st; } -JANET_CORE_FN(cfun_ffi_signature, - "(native-signature calling-convention ret-type & arg-types)", - "Create a function signature object that can be used to make calls " - "with raw function pointers.") { - janet_arity(argc, 2, -1); - uint32_t frame_size = 0; - uint32_t reg_count = 0; - uint32_t fp_reg_count = 0; - uint32_t stack_count = 0; - uint32_t variant = 0; - JanetFFICallingConvention cc = decode_ffi_cc(janet_getkeyword(argv, 0)); - JanetFFIPrimType ret_type = decode_ffi_prim(janet_getkeyword(argv, 1)); - uint32_t max_regs = JANET_FFI_MAX_REGS; - uint32_t max_fp_regs = JANET_FFI_MAX_FP_REGS; - JanetFFIMapping regs[JANET_FFI_MAX_REGS]; - JanetFFIMapping stack[JANET_FFI_MAX_STACK]; - JanetFFIMapping fp_regs[JANET_FFI_MAX_FP_REGS]; - for (int i = 0; i < JANET_FFI_MAX_REGS; i++) { - regs[i].prim = JANET_FFI_TYPE_VOID; - regs[i].argn = 0; +static JanetFFIType decode_ffi_type(Janet x) { + if (janet_checktype(x, JANET_KEYWORD)) { + return prim_type(decode_ffi_prim(janet_unwrap_keyword(x))); } - for (int i = 0; i < JANET_FFI_MAX_FP_REGS; i++) { - fp_regs[i].prim = JANET_FFI_TYPE_VOID; - fp_regs[i].argn = 0; + JanetFFIType ret; + ret.prim = JANET_FFI_TYPE_STRUCT; + if (janet_checkabstract(x, &janet_struct_type)) { + ret.st = janet_unwrap_abstract(x); + return ret; } - for (int i = 0; i < JANET_FFI_MAX_STACK; i++) { - stack[i].prim = JANET_FFI_TYPE_VOID; - stack[i].argn = 0; - } - switch (cc) { - default: - break; - case JANET_FFI_CC_SYSV_64: - max_regs = 6; - max_fp_regs = 8; - if (is_fp_type(ret_type)) variant = 1; - break; - } - for (int32_t i = 2; i < argc; i++) { - JanetFFIPrimType ptype = decode_ffi_prim(janet_getkeyword(argv, i)); - int is_fp = is_fp_type(ptype); - if (is_fp && fp_reg_count < max_fp_regs) { - fp_regs[fp_reg_count].argn = i; - fp_regs[fp_reg_count++].prim = ptype; - } else if (!is_fp && reg_count < max_regs) { - regs[reg_count].argn = i; - regs[reg_count++].prim = ptype; - } else { - stack[stack_count].argn = i; - stack[stack_count++].prim = ptype; - frame_size += janet_ffi_type_info[ptype].size; - } + int32_t len; + const Janet *els; + if (janet_indexed_view(x, &els, &len)) { + ret.st = build_struct_type(len, els); + return ret; + } else { + janet_panicf("bad native type %v", x); } +} - /* Create signature abstract value */ - JanetFFISignature *abst = janet_abstract(&janet_signature_type, sizeof(JanetFFISignature)); - abst->frame_size = frame_size; - abst->reg_count = reg_count; - abst->fp_reg_count = fp_reg_count; - abst->stack_count = stack_count; - abst->cc = cc; - abst->ret_type = ret_type; - abst->arg_count = stack_count + reg_count + fp_reg_count; - abst->variant = variant; - memcpy(abst->regs, regs, sizeof(JanetFFIMapping) * JANET_FFI_MAX_REGS); - memcpy(abst->fp_regs, fp_regs, sizeof(JanetFFIMapping) * JANET_FFI_MAX_FP_REGS); - memcpy(abst->stack, stack, sizeof(JanetFFIMapping) * JANET_FFI_MAX_STACK); - return janet_wrap_abstract(abst); +JANET_CORE_FN(cfun_ffi_struct, + "(native-struct & types)", + "Create a struct type descriptor that can be used to pass structs into native functions. ") { + janet_arity(argc, 1, -1); + return janet_wrap_abstract(build_struct_type(argc, argv)); } static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { @@ -249,105 +289,246 @@ static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { } } -static uint64_t janet_ffi_reg64(const Janet *argv, JanetFFIMapping mapping) { - JanetFFIPrimType ptype = mapping.prim; - int32_t n = mapping.argn; - union { - float f; - double d; - uint64_t reg; - } u; - switch (ptype) { +/* Write a value given by some Janet values and an FFI type as it would appear in memory. + * The alignment and space available is assumed to already be sufficient */ +static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFIType type) { + switch (type.prim) { + case JANET_FFI_TYPE_VOID: default: janet_panic("nyi"); - return 0; + break; + case JANET_FFI_TYPE_STRUCT: { + JanetView els = janet_getindexed(argv, n); + uint32_t cursor = 0; + JanetFFIStruct *st = type.st; + if ((uint32_t) els.len != st->field_count) { + janet_panicf("wrong number of fields in struct, expected %d, got %d", + (int32_t) st->field_count, els.len); + } + for (int32_t i = 0; i < els.len; i++) { + JanetFFIType tp = st->fields[i]; + size_t align = type_align(tp); + size_t size = type_size(tp); + cursor = ((cursor + align - 1) / align) * align; + janet_ffi_write_one(to + cursor, els.items, i, tp); + cursor += size; + } + } + break; case JANET_FFI_TYPE_DOUBLE: - u.d = janet_getnumber(argv, n); - return u.reg; + ((double *)(to))[0] = janet_getnumber(argv, n); + break; case JANET_FFI_TYPE_FLOAT: - u.f = janet_getnumber(argv, n); - return u.reg; - case JANET_FFI_TYPE_VOID: - return 0; + ((float *)(to))[0] = janet_getnumber(argv, n); + break; case JANET_FFI_TYPE_PTR: - return (uint64_t) janet_ffi_getpointer(argv, n); + ((void **)(to))[0] = janet_ffi_getpointer(argv, n); + break; case JANET_FFI_TYPE_BOOL: - return (uint64_t) janet_getboolean(argv, n); - case JANET_FFI_TYPE_SHORT: - case JANET_FFI_TYPE_INT: + ((bool *)(to))[0] = janet_getboolean(argv, n); + break; case JANET_FFI_TYPE_INT8: + ((int8_t *)(to))[0] = janet_getinteger(argv, n); + break; case JANET_FFI_TYPE_INT16: + ((int16_t *)(to))[0] = janet_getinteger(argv, n); + break; case JANET_FFI_TYPE_INT32: + ((int32_t *)(to))[0] = janet_getinteger(argv, n); + break; case JANET_FFI_TYPE_INT64: - case JANET_FFI_TYPE_LONG: - return (uint64_t) janet_getinteger64(argv, n); - case JANET_FFI_TYPE_USHORT: - case JANET_FFI_TYPE_UINT: + ((int64_t *)(to))[0] = janet_getinteger64(argv, n); + break; case JANET_FFI_TYPE_UINT8: + ((uint8_t *)(to))[0] = janet_getuinteger64(argv, n); + break; case JANET_FFI_TYPE_UINT16: + ((uint16_t *)(to))[0] = janet_getuinteger64(argv, n); + break; case JANET_FFI_TYPE_UINT32: + ((uint32_t *)(to))[0] = janet_getuinteger64(argv, n); + break; case JANET_FFI_TYPE_UINT64: - case JANET_FFI_TYPE_ULONG: - return janet_getuinteger64(argv, n); + ((uint64_t *)(to))[0] = janet_getuinteger64(argv, n); + break; } } -static Janet janet_ffi_from64(uint64_t ret, JanetFFIPrimType ret_type) { - union { - float f; - double d; - uint64_t reg; - } u; - switch (ret_type) { - default: - janet_panic("nyi"); - return janet_wrap_nil(); - case JANET_FFI_TYPE_FLOAT: - u.reg = ret; - return janet_wrap_number(u.f); - case JANET_FFI_TYPE_DOUBLE: - u.reg = ret; - return janet_wrap_number(u.d); - case JANET_FFI_TYPE_VOID: - return janet_wrap_nil(); +static int is_fp_type(JanetFFIType type) { + return type.prim == JANET_FFI_TYPE_DOUBLE || type.prim == JANET_FFI_TYPE_FLOAT; +} + +static JanetFFIMapping void_mapping(void) { + JanetFFIMapping m; + m.type = prim_type(JANET_FFI_TYPE_VOID); + m.spec = JANET_SYSV64_NO_CLASS; + m.offset = 0; + return m; +} + +/* AMD64 ABI Draft 0.99.7 – November 17, 2014 – 15:08 + * See section 3.2.3 Parameter Passing */ +static JanetFFIWordSpec sysv64_classify(JanetFFIType type) { + switch (type.prim) { case JANET_FFI_TYPE_PTR: - return janet_wrap_pointer((void *) ret); case JANET_FFI_TYPE_BOOL: - return janet_wrap_boolean(ret); - case JANET_FFI_TYPE_SHORT: - case JANET_FFI_TYPE_INT: case JANET_FFI_TYPE_INT8: case JANET_FFI_TYPE_INT16: case JANET_FFI_TYPE_INT32: - return janet_wrap_integer((int32_t) ret); case JANET_FFI_TYPE_INT64: - case JANET_FFI_TYPE_LONG: - return janet_wrap_integer((int64_t) ret); - case JANET_FFI_TYPE_USHORT: - case JANET_FFI_TYPE_UINT: case JANET_FFI_TYPE_UINT8: case JANET_FFI_TYPE_UINT16: case JANET_FFI_TYPE_UINT32: case JANET_FFI_TYPE_UINT64: - case JANET_FFI_TYPE_ULONG: - return janet_wrap_number(ret); + return JANET_SYSV64_INTEGER; + case JANET_FFI_TYPE_DOUBLE: + case JANET_FFI_TYPE_FLOAT: + return JANET_SYSV64_SSE; + case JANET_FFI_TYPE_STRUCT: { + JanetFFIStruct *st = type.st; + if (st->size > 16) return JANET_SYSV64_MEMORY; + JanetFFIWordSpec clazz = JANET_SYSV64_NO_CLASS; + for (uint32_t i = 0; i < st->field_count; i++) { + JanetFFIWordSpec next_class = sysv64_classify(st->fields[i]); + if (next_class != clazz) { + if (clazz == JANET_SYSV64_NO_CLASS) { + clazz = next_class; + } else if (clazz == JANET_SYSV64_MEMORY || next_class == JANET_SYSV64_MEMORY) { + clazz = JANET_SYSV64_MEMORY; + } else if (clazz == JANET_SYSV64_INTEGER || next_class == JANET_SYSV64_INTEGER) { + clazz = JANET_SYSV64_INTEGER; + } else if (next_class == JANET_SYSV64_X87 || next_class == JANET_SYSV64_X87UP + || next_class == JANET_SYSV64_COMPLEX_X87) { + clazz = JANET_SYSV64_MEMORY; + } else { + clazz = JANET_SYSV64_SSE; + } + } + } + return clazz; + } + case JANET_FFI_TYPE_VOID: + default: + janet_panic("nyi"); + return JANET_SYSV64_NO_CLASS; } } +JANET_CORE_FN(cfun_ffi_signature, + "(native-signature calling-convention ret-type & arg-types)", + "Create a function signature object that can be used to make calls " + "with raw function pointers.") { + janet_arity(argc, 2, -1); + uint32_t frame_size = 0; + uint32_t variant = 0; + uint32_t arg_count = argc - 2; + uint32_t stack_count = 0; + JanetFFICallingConvention cc = decode_ffi_cc(janet_getkeyword(argv, 0)); + JanetFFIType ret_type = decode_ffi_type(argv[1]); + JanetFFIMapping mappings[JANET_FFI_MAX_ARGS]; + for (int i = 0; i < JANET_FFI_MAX_ARGS; i++) mappings[i] = void_mapping(); + switch (cc) { + default: + janet_panicf("calling convention %v unsupported", argv[0]); + break; + case JANET_FFI_CC_SYSV_64: { + if (is_fp_type(ret_type)) variant = 1; + for (uint32_t i = 0; i < arg_count; i++) { + mappings[i].type = decode_ffi_type(argv[i + 2]); + mappings[i].offset = 0; + mappings[i].spec = sysv64_classify(mappings[i].type); + } + + /* Spill register overflow to memory */ + uint32_t next_register = 0; + uint32_t next_fp_register = 0; + const uint32_t max_regs = 6; + const uint32_t max_fp_regs = 8; + for (uint32_t i = 0; i < arg_count; i++) { + size_t el_size = (type_size(mappings[i].type) + 7) / 8; + switch (mappings[i].spec) { + default: + janet_panicf("nyi: %d", mappings[i].spec); + case JANET_SYSV64_INTEGER: { + if (next_register < max_regs) { + mappings[i].offset = next_register++; + } else { + mappings[i].spec = JANET_SYSV64_MEMORY; + mappings[i].offset = stack_count; + stack_count += el_size; + } + break; + } + case JANET_SYSV64_SSE: { + if (next_fp_register < max_fp_regs) { + mappings[i].offset = next_fp_register++; + } else { + mappings[i].spec = JANET_SYSV64_MEMORY; + mappings[i].offset = stack_count; + stack_count += el_size; + } + break; + } + case JANET_SYSV64_MEMORY: { + mappings[i].offset = stack_count; + stack_count += el_size; + } + } + + /* Invert stack */ + for (uint32_t i = 0; i < arg_count; i++) { + if (mappings[i].spec == JANET_SYSV64_MEMORY) { + uint32_t old_offset = mappings[i].offset; + size_t el_size = type_size(mappings[i].type); + mappings[i].offset = stack_count - ((el_size + 7) / 8) - old_offset; + } + } + } + } + break; + } + + /* Create signature abstract value */ + JanetFFISignature *abst = janet_abstract(&janet_signature_type, sizeof(JanetFFISignature)); + abst->frame_size = frame_size; + abst->cc = cc; + abst->ret_type = ret_type; + abst->arg_count = arg_count; + abst->variant = variant; + abst->stack_count = stack_count; + memcpy(abst->args, mappings, sizeof(JanetFFIMapping) * JANET_FFI_MAX_ARGS); + return janet_wrap_abstract(abst); +} + static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) { uint64_t ret, rethi; (void) rethi; /* at some point we will support more complex return types */ + union { + float f; + double d; + uint64_t reg; + } u; uint64_t regs[6]; uint64_t fp_regs[8]; - for (uint32_t i = 0; i < signature->reg_count; i++) { - regs[i] = janet_ffi_reg64(argv, signature->regs[i]); - } - for (uint32_t i = 0; i < signature->fp_reg_count; i++) { - fp_regs[i] = janet_ffi_reg64(argv, signature->fp_regs[i]); - } uint64_t *stack = alloca(sizeof(uint64_t) * signature->stack_count); - for (uint32_t i = 0; i < signature->stack_count; i++) { - stack[signature->stack_count - 1 - i] = janet_ffi_reg64(argv, signature->stack[i]); + for (uint32_t i = 0; i < signature->arg_count; i++) { + uint64_t *to; + int32_t n = i + 2; + JanetFFIMapping arg = signature->args[i]; + switch (arg.spec) { + default: + janet_panic("nyi"); + case JANET_SYSV64_INTEGER: + to = regs + arg.offset; + break; + case JANET_SYSV64_SSE: + to = fp_regs + arg.offset; + break; + case JANET_SYSV64_MEMORY: + to = stack + arg.offset; + break; + } + janet_ffi_write_one(to, argv, n, arg.type); } /* !!ACHTUNG!! */ @@ -396,7 +577,7 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point : FFI_ASM_OUTPUTS : FFI_ASM_INPUTS : "rax", "rdi", "rsi", "rdx", "rcx", "r8", "r9", "r10", "r11"); - return janet_ffi_from64(ret, signature->ret_type); + break; case 1: __asm__(FFI_ASM_PRELUDE "call *%2\n\t" @@ -405,14 +586,43 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point : FFI_ASM_OUTPUTS : FFI_ASM_INPUTS : "rax", "rdi", "rsi", "rdx", "rcx", "r8", "r9", "r10", "r11"); - return janet_ffi_from64(ret, signature->ret_type); + break; } #undef FFI_ASM_PRELUDE #undef FFI_ASM_OUTPUTS #undef FFI_ASM_INPUTS - return janet_wrap_nil(); + /* TODO - compound type returns */ + switch (signature->ret_type.prim) { + default: + janet_panic("nyi"); + return janet_wrap_nil(); + case JANET_FFI_TYPE_FLOAT: + u.reg = ret; + return janet_wrap_number(u.f); + case JANET_FFI_TYPE_DOUBLE: + u.reg = ret; + return janet_wrap_number(u.d); + case JANET_FFI_TYPE_VOID: + return janet_wrap_nil(); + case JANET_FFI_TYPE_PTR: + return janet_wrap_pointer((void *) ret); + case JANET_FFI_TYPE_BOOL: + return janet_wrap_boolean(ret); + case JANET_FFI_TYPE_INT8: + case JANET_FFI_TYPE_INT16: + case JANET_FFI_TYPE_INT32: + return janet_wrap_integer((int32_t) ret); + case JANET_FFI_TYPE_INT64: + return janet_wrap_integer((int64_t) ret); + case JANET_FFI_TYPE_UINT8: + case JANET_FFI_TYPE_UINT16: + case JANET_FFI_TYPE_UINT32: + case JANET_FFI_TYPE_UINT64: + /* TODO - fix 64 bit unsigned return */ + return janet_wrap_number(ret); + } } JANET_CORE_FN(cfun_ffi_call, @@ -435,6 +645,7 @@ void janet_lib_ffi(JanetTable *env) { JanetRegExt ffi_cfuns[] = { JANET_CORE_REG("native-signature", cfun_ffi_signature), JANET_CORE_REG("native-call", cfun_ffi_call), + JANET_CORE_REG("native-struct", cfun_ffi_struct), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, ffi_cfuns); diff --git a/src/core/util.h b/src/core/util.h index 204ea2c4..012a0677 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -32,6 +32,7 @@ #include #include #include +#include #ifndef _MSC_VER #include From 1cc48a370af3886c7a3eefb46d00b57a0d4c9161 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Jun 2022 08:46:20 -0500 Subject: [PATCH 26/89] Add native-write, which will write structs to buffers. Useful for testing as well as useful in its own right. Begs for an inverse, native-read which would convert byte data to native structs. --- src/core/ffi.c | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/src/core/ffi.c b/src/core/ffi.c index f6306b98..10c152bc 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -641,11 +641,28 @@ JANET_CORE_FN(cfun_ffi_call, } } +JANET_CORE_FN(cfun_ffi_buffer_write, + "(native-write ffi-type data &opt buffer)", + "Append a native tyep to a buffer such as it would appear in memory. This can be used " + "to pass pointers to structs in the ffi, or send C/C++/native structs over the network " + "or to files. Returns a modifed buffer or a new buffer if one is not supplied.") { + janet_arity(argc, 2, 3); + JanetFFIType type = decode_ffi_type(argv[0]); + size_t el_size = type_size(type); + JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, el_size); + janet_buffer_extra(buffer, el_size); + memset(buffer->data, 0, el_size); + janet_ffi_write_one(buffer->data, argv, 1, type); + buffer->count += el_size; + return janet_wrap_buffer(buffer); +} + void janet_lib_ffi(JanetTable *env) { JanetRegExt ffi_cfuns[] = { JANET_CORE_REG("native-signature", cfun_ffi_signature), JANET_CORE_REG("native-call", cfun_ffi_call), JANET_CORE_REG("native-struct", cfun_ffi_struct), + JANET_CORE_REG("native-write", cfun_ffi_buffer_write), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, ffi_cfuns); From 9ecb5b4791c3a19f2c3b28f949337903cacb122a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Jun 2022 09:38:52 -0500 Subject: [PATCH 27/89] Add native-read function as inverse to native-write. --- ffitest/test.janet | 36 ++++++++++++++++++ src/core/ffi.c | 95 +++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 125 insertions(+), 6 deletions(-) diff --git a/ffitest/test.janet b/ffitest/test.janet index 0eb4a199..e3d99d87 100644 --- a/ffitest/test.janet +++ b/ffitest/test.janet @@ -68,4 +68,40 @@ (assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10))) (assert (= 204 (float-fn 8 4 17))) +# +# Struct reading and writing +# + +(defn check-round-trip + [t value] + (def buf (native-write t value)) + (def same-value (native-read t buf)) + (assert (deep= value same-value) + (string/format "round trip %j (got %j)" value same-value))) + +(check-round-trip :bool true) +(check-round-trip :bool false) +(check-round-trip :void nil) +(check-round-trip :void nil) +(check-round-trip :s8 10) +(check-round-trip :s8 0) +(check-round-trip :s8 -10) +(check-round-trip :u8 10) +(check-round-trip :u8 0) +(check-round-trip :s16 10) +(check-round-trip :s16 0) +(check-round-trip :s16 -12312) +(check-round-trip :u16 10) +(check-round-trip :u16 0) +(check-round-trip :u32 0) +(check-round-trip :u32 10) +(check-round-trip :u32 0xFFFF7777) +(check-round-trip :s32 0x7FFF7777) +(check-round-trip :s32 0) +(check-round-trip :s32 -1234567) + +(def s (native-struct :s8 :s8 :s8 :float)) +(check-round-trip s [1 3 5 123.5]) +(check-round-trip s [-1 -3 -5 -123.5]) + (print "Done.") diff --git a/src/core/ffi.c b/src/core/ffi.c index 10c152bc..05aee7ec 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -219,6 +219,14 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { if (!janet_cstrcmp(name, "ssize")) return JANET_FFI_TYPE_INT32; #endif /* aliases */ + if (!janet_cstrcmp(name, "s8")) return JANET_FFI_TYPE_INT8; + if (!janet_cstrcmp(name, "u8")) return JANET_FFI_TYPE_UINT8; + if (!janet_cstrcmp(name, "s16")) return JANET_FFI_TYPE_INT16; + if (!janet_cstrcmp(name, "u16")) return JANET_FFI_TYPE_UINT16; + if (!janet_cstrcmp(name, "s32")) return JANET_FFI_TYPE_INT32; + if (!janet_cstrcmp(name, "u32")) return JANET_FFI_TYPE_UINT32; + if (!janet_cstrcmp(name, "s64")) return JANET_FFI_TYPE_INT64; + if (!janet_cstrcmp(name, "u64")) return JANET_FFI_TYPE_UINT64; if (!janet_cstrcmp(name, "char")) return JANET_FFI_TYPE_INT8; if (!janet_cstrcmp(name, "short")) return JANET_FFI_TYPE_INT16; if (!janet_cstrcmp(name, "int")) return JANET_FFI_TYPE_INT32; @@ -291,11 +299,13 @@ static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { /* Write a value given by some Janet values and an FFI type as it would appear in memory. * The alignment and space available is assumed to already be sufficient */ -static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFIType type) { +static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFIType type, int recur) { + if (recur == 0) janet_panic("recursion too deep"); switch (type.prim) { case JANET_FFI_TYPE_VOID: - default: - janet_panic("nyi"); + if (!janet_checktype(argv[n], JANET_NIL)) { + janet_panicf("expected nil, got %v", argv[n]); + } break; case JANET_FFI_TYPE_STRUCT: { JanetView els = janet_getindexed(argv, n); @@ -310,7 +320,7 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI size_t align = type_align(tp); size_t size = type_size(tp); cursor = ((cursor + align - 1) / align) * align; - janet_ffi_write_one(to + cursor, els.items, i, tp); + janet_ffi_write_one(to + cursor, els.items, i, tp, recur - 1); cursor += size; } } @@ -354,6 +364,64 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI } } +/* Read a value from memory and construct a Janet data structure that can be passed back into + * the interpreter. This should be the inverse to janet_ffi_write_one. It is assumed that the + * size of the data is correct. */ +static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recur) { + if (recur == 0) janet_panic("recursion too deep"); + switch (type.prim) { + default: + case JANET_FFI_TYPE_VOID: + return janet_wrap_nil(); + case JANET_FFI_TYPE_STRUCT: + { + JanetFFIStruct *st = type.st; + Janet *tup = janet_tuple_begin(st->field_count); + size_t cursor = 0; + for (uint32_t i = 0; i < st->field_count; i++) { + JanetFFIType tp = st->fields[i]; + size_t align = type_align(tp); + size_t size = type_size(tp); + cursor = ((cursor + align - 1) / align) * align; + tup[i] = janet_ffi_read_one(from + cursor, tp, recur - 1); + cursor += size; + } + return janet_wrap_tuple(janet_tuple_end(tup)); + } + case JANET_FFI_TYPE_DOUBLE: + return janet_wrap_number(((double *)(from))[0]); + case JANET_FFI_TYPE_FLOAT: + return janet_wrap_number(((float *)(from))[0]); + case JANET_FFI_TYPE_PTR: + return janet_wrap_pointer(((void **)(from))[0]); + case JANET_FFI_TYPE_BOOL: + return janet_wrap_boolean(((bool *)(from))[0]); + case JANET_FFI_TYPE_INT8: + return janet_wrap_number(((int8_t *)(from))[0]); + case JANET_FFI_TYPE_INT16: + return janet_wrap_number(((int16_t *)(from))[0]); + case JANET_FFI_TYPE_INT32: + return janet_wrap_number(((int32_t *)(from))[0]); + case JANET_FFI_TYPE_UINT8: + return janet_wrap_number(((uint8_t *)(from))[0]); + case JANET_FFI_TYPE_UINT16: + return janet_wrap_number(((uint16_t *)(from))[0]); + case JANET_FFI_TYPE_UINT32: + return janet_wrap_number(((uint32_t *)(from))[0]); +#ifdef JANET_INT_TYPES + case JANET_FFI_TYPE_INT64: + return janet_wrap_s64(((int64_t *)(from))[0]); + case JANET_FFI_TYPE_UINT64: + return janet_wrap_u64(((uint64_t *)(from))[0]); +#else + case JANET_FFI_TYPE_INT64: + return janet_wrap_number(((int64_t *)(from))[0]); + case JANET_FFI_TYPE_UINT64: + return janet_wrap_number(((uint64_t *)(from))[0]); +#endif + } +} + static int is_fp_type(JanetFFIType type) { return type.prim == JANET_FFI_TYPE_DOUBLE || type.prim == JANET_FFI_TYPE_FLOAT; } @@ -528,7 +596,7 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point to = stack + arg.offset; break; } - janet_ffi_write_one(to, argv, n, arg.type); + janet_ffi_write_one(to, argv, n, arg.type, 64); } /* !!ACHTUNG!! */ @@ -652,17 +720,32 @@ JANET_CORE_FN(cfun_ffi_buffer_write, JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, el_size); janet_buffer_extra(buffer, el_size); memset(buffer->data, 0, el_size); - janet_ffi_write_one(buffer->data, argv, 1, type); + janet_ffi_write_one(buffer->data, argv, 1, type, 64); buffer->count += el_size; return janet_wrap_buffer(buffer); } + +JANET_CORE_FN(cfun_ffi_buffer_read, + "(native-read ffi-type bytes &opt offset)", + "Parse a native struct out of a buffer and convert it to normal Janet data structures. " + "This function is the inverse of `native-write`.") { + janet_arity(argc, 2, 3); + JanetFFIType type = decode_ffi_type(argv[0]); + size_t el_size = type_size(type); + JanetByteView bytes = janet_getbytes(argv, 1); + size_t offset = (size_t) janet_optnat(argv, argc, 2, 0); + if ((size_t) bytes.len < offset + el_size) janet_panic("read out of range"); + return janet_ffi_read_one(bytes.bytes, type, 64); +} + void janet_lib_ffi(JanetTable *env) { JanetRegExt ffi_cfuns[] = { JANET_CORE_REG("native-signature", cfun_ffi_signature), JANET_CORE_REG("native-call", cfun_ffi_call), JANET_CORE_REG("native-struct", cfun_ffi_struct), JANET_CORE_REG("native-write", cfun_ffi_buffer_write), + JANET_CORE_REG("native-read", cfun_ffi_buffer_read), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, ffi_cfuns); From a5def77bfe01db4139548aa0ba96fb1e2f88da99 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Jun 2022 12:24:50 -0500 Subject: [PATCH 28/89] Add support for struct return values. --- ffitest/so.c | 21 +++++++++ ffitest/test.janet | 14 ++++++ src/core/ffi.c | 111 ++++++++++++++++++--------------------------- 3 files changed, 79 insertions(+), 67 deletions(-) diff --git a/ffitest/so.c b/ffitest/so.c index 22481932..c1ddda76 100644 --- a/ffitest/so.c +++ b/ffitest/so.c @@ -56,3 +56,24 @@ int intintint_fn(double x, intintint iii) { printf("double: %g\n", x); return iii.a + iii.b + iii.c; } + +intint return_struct(int i) { + intint ret; + ret.a = i; + ret.b = i * i; + return ret; +} + +typedef struct { + int64_t a; + int64_t b; + int64_t c; +} big; + +big struct_big(int i, double d) { + big ret; + ret.a = i; + ret.b = (int64_t) d; + ret.c = ret.a + ret.b + 1000; + return ret; +} diff --git a/ffitest/test.janet b/ffitest/test.janet index e3d99d87..e454fff7 100644 --- a/ffitest/test.janet +++ b/ffitest/test.janet @@ -42,6 +42,11 @@ [x ii] (native-call intint-fn-pointer intint-fn-sig x ii)) +(def return-struct-sig (native-signature :default [:int :int] :int)) +(def return-struct-pointer (native-lookup module "return_struct")) +(defn return-struct-fn + [i] + (native-call return-struct-pointer return-struct-sig i)) (def intintint (native-struct :int :int :int)) (def intintint-fn-sig (native-signature :default :int :double intintint)) @@ -50,6 +55,13 @@ [x iii] (native-call intintint-fn-pointer intintint-fn-sig x iii)) +(def big (native-struct :s64 :s64 :s64)) +(def struct-big-fn-sig (native-signature :default big :int :double)) +(def struct-big-fn-pointer (native-lookup module "struct_big")) +(defn struct-big-fn + [i d] + (native-call struct-big-fn-pointer struct-big-fn-sig i d)) + # # Call functions # @@ -61,6 +73,8 @@ (pp (float-fn 8 4 17)) (pp (intint-fn 123.456 [10 20])) (pp (intintint-fn 123.456 [10 20 30])) +(pp (return-struct-fn 42)) +(pp (struct-big-fn 11 99.5)) (assert (= 60 (int-fn 10 20))) (assert (= 42 (double-fn 1.5 2.5 3.5))) diff --git a/src/core/ffi.c b/src/core/ffi.c index 05aee7ec..36f03fa8 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -32,6 +32,8 @@ #define alloca _alloca #endif +#define JANET_FFI_MAX_RECUR 64 + typedef struct JanetFFIType JanetFFIType; typedef struct JanetFFIStruct JanetFFIStruct; @@ -124,7 +126,7 @@ typedef struct { uint32_t variant; uint32_t stack_count; JanetFFICallingConvention cc; - JanetFFIType ret_type; + JanetFFIMapping ret; JanetFFIMapping args[JANET_FFI_MAX_ARGS]; } JanetFFISignature; @@ -373,21 +375,20 @@ static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recu default: case JANET_FFI_TYPE_VOID: return janet_wrap_nil(); - case JANET_FFI_TYPE_STRUCT: - { - JanetFFIStruct *st = type.st; - Janet *tup = janet_tuple_begin(st->field_count); - size_t cursor = 0; - for (uint32_t i = 0; i < st->field_count; i++) { - JanetFFIType tp = st->fields[i]; - size_t align = type_align(tp); - size_t size = type_size(tp); - cursor = ((cursor + align - 1) / align) * align; - tup[i] = janet_ffi_read_one(from + cursor, tp, recur - 1); - cursor += size; - } - return janet_wrap_tuple(janet_tuple_end(tup)); + case JANET_FFI_TYPE_STRUCT: { + JanetFFIStruct *st = type.st; + Janet *tup = janet_tuple_begin(st->field_count); + size_t cursor = 0; + for (uint32_t i = 0; i < st->field_count; i++) { + JanetFFIType tp = st->fields[i]; + size_t align = type_align(tp); + size_t size = type_size(tp); + cursor = ((cursor + align - 1) / align) * align; + tup[i] = janet_ffi_read_one(from + cursor, tp, recur - 1); + cursor += size; } + return janet_wrap_tuple(janet_tuple_end(tup)); + } case JANET_FFI_TYPE_DOUBLE: return janet_wrap_number(((double *)(from))[0]); case JANET_FFI_TYPE_FLOAT: @@ -422,10 +423,6 @@ static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recu } } -static int is_fp_type(JanetFFIType type) { - return type.prim == JANET_FFI_TYPE_DOUBLE || type.prim == JANET_FFI_TYPE_FLOAT; -} - static JanetFFIMapping void_mapping(void) { JanetFFIMapping m; m.type = prim_type(JANET_FFI_TYPE_VOID); @@ -493,6 +490,11 @@ JANET_CORE_FN(cfun_ffi_signature, uint32_t stack_count = 0; JanetFFICallingConvention cc = decode_ffi_cc(janet_getkeyword(argv, 0)); JanetFFIType ret_type = decode_ffi_type(argv[1]); + JanetFFIMapping ret = { + ret_type, + JANET_SYSV64_NO_CLASS, + 0 + }; JanetFFIMapping mappings[JANET_FFI_MAX_ARGS]; for (int i = 0; i < JANET_FFI_MAX_ARGS; i++) mappings[i] = void_mapping(); switch (cc) { @@ -500,19 +502,23 @@ JANET_CORE_FN(cfun_ffi_signature, janet_panicf("calling convention %v unsupported", argv[0]); break; case JANET_FFI_CC_SYSV_64: { - if (is_fp_type(ret_type)) variant = 1; - for (uint32_t i = 0; i < arg_count; i++) { - mappings[i].type = decode_ffi_type(argv[i + 2]); - mappings[i].offset = 0; - mappings[i].spec = sysv64_classify(mappings[i].type); - } + JanetFFIWordSpec ret_spec = sysv64_classify(ret.type); + if (ret_spec == JANET_SYSV64_SSE) variant = 1; + ret.spec = ret_spec; /* Spill register overflow to memory */ uint32_t next_register = 0; uint32_t next_fp_register = 0; const uint32_t max_regs = 6; const uint32_t max_fp_regs = 8; + if (ret_spec == JANET_SYSV64_MEMORY) { + /* First integer reg is pointer. */ + next_register = 1; + } for (uint32_t i = 0; i < arg_count; i++) { + mappings[i].type = decode_ffi_type(argv[i + 2]); + mappings[i].offset = 0; + mappings[i].spec = sysv64_classify(mappings[i].type); size_t el_size = (type_size(mappings[i].type) + 7) / 8; switch (mappings[i].spec) { default: @@ -560,7 +566,7 @@ JANET_CORE_FN(cfun_ffi_signature, JanetFFISignature *abst = janet_abstract(&janet_signature_type, sizeof(JanetFFISignature)); abst->frame_size = frame_size; abst->cc = cc; - abst->ret_type = ret_type; + abst->ret = ret; abst->arg_count = arg_count; abst->variant = variant; abst->stack_count = stack_count; @@ -569,15 +575,15 @@ JANET_CORE_FN(cfun_ffi_signature, } static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) { - uint64_t ret, rethi; - (void) rethi; /* at some point we will support more complex return types */ - union { - float f; - double d; - uint64_t reg; - } u; + uint64_t ret[2]; uint64_t regs[6]; uint64_t fp_regs[8]; + JanetFFIWordSpec ret_spec = signature->ret.spec; + void *ret_mem = ret; + if (ret_spec == JANET_SYSV64_MEMORY) { + ret_mem = alloca(type_size(signature->ret.type)); + regs[0] = (uint64_t) ret_mem; + } uint64_t *stack = alloca(sizeof(uint64_t) * signature->stack_count); for (uint32_t i = 0; i < signature->arg_count; i++) { uint64_t *to; @@ -596,7 +602,7 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point to = stack + arg.offset; break; } - janet_ffi_write_one(to, argv, n, arg.type, 64); + janet_ffi_write_one(to, argv, n, arg.type, JANET_FFI_MAX_RECUR); } /* !!ACHTUNG!! */ @@ -616,7 +622,7 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point "movq %14, %%xmm5\n\t" \ "movq %15, %%xmm6\n\t" \ "movq %16, %%xmm7\n\t" -#define FFI_ASM_OUTPUTS "=g" (ret), "=g" (rethi) +#define FFI_ASM_OUTPUTS "=g" (ret[0]), "=g" (ret[1]) #define FFI_ASM_INPUTS \ "g"(function_pointer), \ "g"(regs[0]), \ @@ -661,36 +667,7 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point #undef FFI_ASM_OUTPUTS #undef FFI_ASM_INPUTS - /* TODO - compound type returns */ - switch (signature->ret_type.prim) { - default: - janet_panic("nyi"); - return janet_wrap_nil(); - case JANET_FFI_TYPE_FLOAT: - u.reg = ret; - return janet_wrap_number(u.f); - case JANET_FFI_TYPE_DOUBLE: - u.reg = ret; - return janet_wrap_number(u.d); - case JANET_FFI_TYPE_VOID: - return janet_wrap_nil(); - case JANET_FFI_TYPE_PTR: - return janet_wrap_pointer((void *) ret); - case JANET_FFI_TYPE_BOOL: - return janet_wrap_boolean(ret); - case JANET_FFI_TYPE_INT8: - case JANET_FFI_TYPE_INT16: - case JANET_FFI_TYPE_INT32: - return janet_wrap_integer((int32_t) ret); - case JANET_FFI_TYPE_INT64: - return janet_wrap_integer((int64_t) ret); - case JANET_FFI_TYPE_UINT8: - case JANET_FFI_TYPE_UINT16: - case JANET_FFI_TYPE_UINT32: - case JANET_FFI_TYPE_UINT64: - /* TODO - fix 64 bit unsigned return */ - return janet_wrap_number(ret); - } + return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR); } JANET_CORE_FN(cfun_ffi_call, @@ -720,7 +697,7 @@ JANET_CORE_FN(cfun_ffi_buffer_write, JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, el_size); janet_buffer_extra(buffer, el_size); memset(buffer->data, 0, el_size); - janet_ffi_write_one(buffer->data, argv, 1, type, 64); + janet_ffi_write_one(buffer->data, argv, 1, type, JANET_FFI_MAX_RECUR); buffer->count += el_size; return janet_wrap_buffer(buffer); } @@ -736,7 +713,7 @@ JANET_CORE_FN(cfun_ffi_buffer_read, JanetByteView bytes = janet_getbytes(argv, 1); size_t offset = (size_t) janet_optnat(argv, argc, 2, 0); if ((size_t) bytes.len < offset + el_size) janet_panic("read out of range"); - return janet_ffi_read_one(bytes.bytes, type, 64); + return janet_ffi_read_one(bytes.bytes, type, JANET_FFI_MAX_RECUR); } void janet_lib_ffi(JanetTable *env) { From 49bfe801910c59f47dc3cd45e3fbbb730dfa9563 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Jun 2022 12:33:01 -0500 Subject: [PATCH 29/89] Make sure void return types work as expected. --- ffitest/so.c | 8 ++++++++ ffitest/test.janet | 7 +++++++ src/core/ffi.c | 4 ++++ 3 files changed, 19 insertions(+) diff --git a/ffitest/so.c b/ffitest/so.c index c1ddda76..2d1cc818 100644 --- a/ffitest/so.c +++ b/ffitest/so.c @@ -77,3 +77,11 @@ big struct_big(int i, double d) { ret.c = ret.a + ret.b + 1000; return ret; } + +void void_fn(void) { + printf("void fn ran\n"); +} + +void void_ret_fn(int x) { + printf("void fn ran: %d\n", x); +} diff --git a/ffitest/test.janet b/ffitest/test.janet index e454fff7..bbfd6c09 100644 --- a/ffitest/test.janet +++ b/ffitest/test.janet @@ -62,10 +62,17 @@ [i d] (native-call struct-big-fn-pointer struct-big-fn-sig i d)) +(def void-fn-pointer (native-lookup module "void_fn")) +(def void-fn-sig (native-signature :default :void)) +(defn void-fn + [] + (native-call void-fn-pointer void-fn-sig)) + # # Call functions # +(pp (void-fn)) (pp (int-fn 10 20)) (pp (double-fn 1.5 2.5 3.5)) (pp (double-many 1 2 3 4 5 6)) diff --git a/src/core/ffi.c b/src/core/ffi.c index 36f03fa8..5a1b35cf 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -473,6 +473,7 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) { return clazz; } case JANET_FFI_TYPE_VOID: + return JANET_SYSV64_NO_CLASS; default: janet_panic("nyi"); return JANET_SYSV64_NO_CLASS; @@ -519,6 +520,9 @@ JANET_CORE_FN(cfun_ffi_signature, mappings[i].type = decode_ffi_type(argv[i + 2]); mappings[i].offset = 0; mappings[i].spec = sysv64_classify(mappings[i].type); + if (mappings[i].spec == JANET_SYSV64_NO_CLASS) { + janet_panic("unexpected void parameter"); + } size_t el_size = (type_size(mappings[i].type) + 7) / 8; switch (mappings[i].spec) { default: From a5b66029d38eb74e2cc65593eb068eeddf868448 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Jun 2022 15:23:15 -0500 Subject: [PATCH 30/89] Expose the built-in debugger in more places. --- CHANGELOG.md | 4 ++ src/boot/boot.janet | 105 +++++++++++++++++++++++++------------------- 2 files changed, 64 insertions(+), 45 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ef5f9242..bac809f8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set. +- Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on + abnormal fiber signals. +- Allow running scripts with the `-d` flag to use the built-in debugger on errors and breakpoints. - Add `raw-native`, `native-lookup`, and `native-close` for interfacing with dynamic libraries. - Add mutexes (locks) and reader-writer locks to ev module for thread coordination. - Add `parse-all` as a generalization of the `parse` function. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 8d78fd12..802e601b 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2746,6 +2746,49 @@ (get r 0) v)))) +(def debugger-env + "An environment that contains dot prefixed functions for debugging." + @{}) + +(defn debugger-on-status + "Create a function that can be passed to `run-context`'s `:on-status` + argument that will drop into a debugger on errors." + [env &opt level is-repl] + (default level 1) + (defn enter-debugger + [f x] + (def nextenv (make-env env)) + (put nextenv :fiber f) + (put nextenv :debug-level level) + (put nextenv :signal x) + (merge-into nextenv debugger-env) + (defn debugger-chunks [buf p] + (def status (:state p :delimiters)) + (def c ((:where p) 0)) + (def prpt (string "debug[" level "]:" c ":" status "> ")) + (getline prpt buf nextenv)) + (print "entering debug[" level "] - (quit) to exit") + (flush) + (run-context + {:chunks debugger-chunks + :on-status (debugger-on-status nextenv (+ 1 level) true) + :env nextenv}) + (print "exiting debug[" level "]") + (flush) + (nextenv :resume-value)) + (fn [f x] + (def fs (fiber/status f)) + (if (= :dead fs) + (when is-repl + (put env '_ @{:value x}) + (printf (get env :pretty-format "%q") x) + (flush)) + (do + (debug/stacktrace f x "") + (eflush) + (if (get env :debug) (enter-debugger f x)))))) + + (defn dofile ``Evaluate a file, file path, or stream and return the resulting environment. :env, :expander, :source, :evaluator, :read, and :parser are passed through to the underlying @@ -2802,9 +2845,12 @@ (debug/stacktrace f x "") (eflush) (os/exit 1)) - (put env :exit true) - (set exit-error x) - (set exit-fiber f))) + (if (get env :debug) + ((debugger-on-status env) f x) + (do + (put env :exit true) + (set exit-error x) + (set exit-fiber f))))) :evaluator evaluator :expander expander :read read @@ -3448,10 +3494,6 @@ (set res (debug/step (.fiber)))) res) -(def debugger-env - "An environment that contains dot prefixed functions for debugging." - @{}) - (def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env))) (each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil)) @@ -3479,43 +3521,9 @@ ":" (:state p :delimiters) "> ") buf env))) - (defn make-onsignal - [e level] - - (defn enter-debugger - [f x] - (def nextenv (make-env env)) - (put nextenv :fiber f) - (put nextenv :debug-level level) - (put nextenv :signal x) - (merge-into nextenv debugger-env) - (defn debugger-chunks [buf p] - (def status (:state p :delimiters)) - (def c ((:where p) 0)) - (def prpt (string "debug[" level "]:" c ":" status "> ")) - (getline prpt buf nextenv)) - (print "entering debug[" level "] - (quit) to exit") - (flush) - (repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv) - (print "exiting debug[" level "]") - (flush) - (nextenv :resume-value)) - - (fn [f x] - (def fs (fiber/status f)) - (if (= :dead fs) - (do - (put e '_ @{:value x}) - (printf (get e :pretty-format "%q") x) - (flush)) - (do - (debug/stacktrace f x "") - (eflush) - (if (e :debug) (enter-debugger f x)))))) - (run-context {:env env :chunks chunks - :on-status (or onsignal (make-onsignal env 1)) + :on-status (or onsignal (debugger-on-status env 1 true)) :parser parser :read read :source :repl})) @@ -3682,10 +3690,17 @@ (defn- run-main [env subargs arg] - (if-let [entry (in env 'main) + (when-let [entry (in env 'main) main (or (get entry :value) (in (get entry :ref) 0))] - (let [thunk (compile [main ;subargs] env arg)] - (if (function? thunk) (thunk) (error (thunk :error)))))) + (def guard (if (get env :debug) :ydt :y)) + (defn wrap-main [&] + (main ;subargs)) + (def f (fiber/new wrap-main guard)) + (fiber/setenv f env) + (while (fiber/can-resume? f) + (def res (resume f)) + (when (not= :dead (fiber/status f)) + ((debugger-on-status env) f res))))) (defdyn *args* "Dynamic bindings that will contain command line arguments at program start.") From c3648331f19cf843cacc076959e1cd812a36e672 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Jun 2022 15:38:30 -0500 Subject: [PATCH 31/89] Expose an easy to use `debugger` function. --- CHANGELOG.md | 1 + src/boot/boot.janet | 58 ++++++++++++++++++++++++++------------------- 2 files changed, 35 insertions(+), 24 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bac809f8..08dc6766 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `debugger` - an easy to use debugger function that just takes a fiber. - `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set. - Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on abnormal fiber signals. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 802e601b..512ded9f 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2750,32 +2750,40 @@ "An environment that contains dot prefixed functions for debugging." @{}) +(var- debugger-on-status-var nil) + +(defn debugger + "Run a repl-based debugger on a fiber. Optionally pass in a level + to differentiate nested debuggers." + [fiber &opt level] + (default level 1) + (def nextenv (make-env (fiber/getenv fiber))) + (put nextenv :fiber fiber) + (put nextenv :debug-level level) + (put nextenv :signal (fiber/last-value fiber)) + (merge-into nextenv debugger-env) + (defn debugger-chunks [buf p] + (def status (:state p :delimiters)) + (def c ((:where p) 0)) + (def prpt (string "debug[" level "]:" c ":" status "> ")) + (getline prpt buf nextenv)) + (print "entering debug[" level "] - (quit) to exit") + (flush) + (run-context + {:chunks debugger-chunks + :on-status (debugger-on-status-var nextenv (+ 1 level) true) + :env nextenv}) + (print "exiting debug[" level "]") + (flush) + (nextenv :resume-value)) + (defn debugger-on-status "Create a function that can be passed to `run-context`'s `:on-status` - argument that will drop into a debugger on errors." + argument that will drop into a debugger on errors. The debugger will + only start on abmnormal signals if the env table has the `:debug` dyn + set to a truthy value." [env &opt level is-repl] (default level 1) - (defn enter-debugger - [f x] - (def nextenv (make-env env)) - (put nextenv :fiber f) - (put nextenv :debug-level level) - (put nextenv :signal x) - (merge-into nextenv debugger-env) - (defn debugger-chunks [buf p] - (def status (:state p :delimiters)) - (def c ((:where p) 0)) - (def prpt (string "debug[" level "]:" c ":" status "> ")) - (getline prpt buf nextenv)) - (print "entering debug[" level "] - (quit) to exit") - (flush) - (run-context - {:chunks debugger-chunks - :on-status (debugger-on-status nextenv (+ 1 level) true) - :env nextenv}) - (print "exiting debug[" level "]") - (flush) - (nextenv :resume-value)) (fn [f x] (def fs (fiber/status f)) (if (= :dead fs) @@ -2786,8 +2794,9 @@ (do (debug/stacktrace f x "") (eflush) - (if (get env :debug) (enter-debugger f x)))))) + (if (get env :debug) (debugger f level)))))) +(set debugger-on-status-var debugger-on-status) (defn dofile ``Evaluate a file, file path, or stream and return the resulting environment. :env, :expander, @@ -3697,8 +3706,9 @@ (main ;subargs)) (def f (fiber/new wrap-main guard)) (fiber/setenv f env) + (var res nil) (while (fiber/can-resume? f) - (def res (resume f)) + (set res (resume f res)) (when (not= :dead (fiber/status f)) ((debugger-on-status env) f res))))) From 6d188f6e4466b767d9eb1292140056a14a659325 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Jun 2022 16:24:40 -0500 Subject: [PATCH 32/89] Improve .ppasm function. --- src/boot/boot.janet | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 512ded9f..5d42a00b 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3417,7 +3417,8 @@ (def pc (frame :pc)) (def sourcemap (in dasm :sourcemap)) (var last-loc [-2 -2]) - (print "\n signal: " (.signal)) + (print "\n signal: " (.signal)) + (print " status: " (fiber/status (.fiber))) (print " function: " (dasm :name) " [" (in dasm :source "") "]") (when-let [constants (dasm :constants)] (printf " constants: %.4q" constants)) From 181f0341f5a2429485810ba10775b96186815b4a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Jun 2022 18:53:22 -0500 Subject: [PATCH 33/89] Add :pack and :pack-all keywords to allow for struct packing. Syntax may need some work but covers both fully packed structs as well as packing of individual members. --- src/core/ffi.c | 79 ++++++++++++++++++++++++++++++++++---------------- 1 file changed, 54 insertions(+), 25 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 5a1b35cf..bdccbfc7 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -84,11 +84,17 @@ struct JanetFFIType { JanetFFIPrimType prim; }; +typedef struct { + JanetFFIType type; + size_t offset; +} JanetFFIStructMember; + struct JanetFFIStruct { uint32_t size; uint32_t align; uint32_t field_count; - JanetFFIType fields[]; + uint32_t is_aligned; + JanetFFIStructMember fields[]; }; /* Specifies how the registers are classified. This is used @@ -153,7 +159,7 @@ int struct_mark(void *p, size_t s) { (void) s; JanetFFIStruct *st = p; for (uint32_t i = 0; i < st->field_count; i++) { - JanetFFIType t = st->fields[i]; + JanetFFIType t = st->fields[i].type; if (t.prim == JANET_FFI_TYPE_STRUCT) { janet_mark(janet_wrap_abstract(t.st)); } @@ -243,18 +249,50 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { static JanetFFIType decode_ffi_type(Janet x); static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) { + /* Use :pack to indicate a single packed struct member and :pack-all + * to pack the remaining members */ + int32_t member_count = argc; + int all_packed = 0; + for (int32_t i = 0; i < argc; i++) { + if (janet_keyeq(argv[i], "pack")) { + member_count--; + } else if (janet_keyeq(argv[i], "pack-all")) { + member_count--; + all_packed = 1; + } + } + JanetFFIStruct *st = janet_abstract(&janet_struct_type, - sizeof(JanetFFIStruct) + argc * sizeof(JanetFFIType)); - st->field_count = argc; + sizeof(JanetFFIStruct) + argc * sizeof(JanetFFIStructMember)); + st->field_count = member_count; st->size = 0; st->align = 1; - for (int32_t i = 0; i < argc; i++) { - st->fields[i] = decode_ffi_type(argv[i]); - size_t el_align = type_align(st->fields[i]); - size_t el_size = type_size(st->fields[i]); - if (el_align > st->align) st->align = el_align; - st->size = el_size + (((st->size + el_align - 1) / el_align) * el_align); + if (argc == 0) { + janet_panic("invalid empty struct"); } + uint32_t is_aligned = 1; + int32_t i = 0; + for (int32_t j = 0; j < argc; j++) { + int pack_one = 0; + if (janet_keyeq(argv[j], "pack") || janet_keyeq(argv[j], "pack-all")) { + pack_one = 1; + j++; + } + st->fields[i].type = decode_ffi_type(argv[j]); + size_t el_size = type_size(st->fields[i].type); + size_t el_align = type_align(st->fields[i].type); + if (all_packed || pack_one) { + if (st->size % el_align != 0) is_aligned = 0; + st->fields[i].offset = st->size; + st->size += el_size; + } else { + if (el_align > st->align) st->align = el_align; + st->fields[i].offset = (((st->size + el_align - 1) / el_align) * el_align); + st->size = el_size + st->fields[i].offset; + } + i++; + } + st->is_aligned = is_aligned; return st; } @@ -311,19 +349,14 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI break; case JANET_FFI_TYPE_STRUCT: { JanetView els = janet_getindexed(argv, n); - uint32_t cursor = 0; JanetFFIStruct *st = type.st; if ((uint32_t) els.len != st->field_count) { janet_panicf("wrong number of fields in struct, expected %d, got %d", (int32_t) st->field_count, els.len); } for (int32_t i = 0; i < els.len; i++) { - JanetFFIType tp = st->fields[i]; - size_t align = type_align(tp); - size_t size = type_size(tp); - cursor = ((cursor + align - 1) / align) * align; - janet_ffi_write_one(to + cursor, els.items, i, tp, recur - 1); - cursor += size; + JanetFFIType tp = st->fields[i].type; + janet_ffi_write_one(to + st->fields[i].offset, els.items, i, tp, recur - 1); } } break; @@ -378,14 +411,9 @@ static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recu case JANET_FFI_TYPE_STRUCT: { JanetFFIStruct *st = type.st; Janet *tup = janet_tuple_begin(st->field_count); - size_t cursor = 0; for (uint32_t i = 0; i < st->field_count; i++) { - JanetFFIType tp = st->fields[i]; - size_t align = type_align(tp); - size_t size = type_size(tp); - cursor = ((cursor + align - 1) / align) * align; - tup[i] = janet_ffi_read_one(from + cursor, tp, recur - 1); - cursor += size; + JanetFFIType tp = st->fields[i].type; + tup[i] = janet_ffi_read_one(from + st->fields[i].offset, tp, recur - 1); } return janet_wrap_tuple(janet_tuple_end(tup)); } @@ -452,9 +480,10 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) { case JANET_FFI_TYPE_STRUCT: { JanetFFIStruct *st = type.st; if (st->size > 16) return JANET_SYSV64_MEMORY; + if (!st->is_aligned) return JANET_SYSV64_MEMORY; JanetFFIWordSpec clazz = JANET_SYSV64_NO_CLASS; for (uint32_t i = 0; i < st->field_count; i++) { - JanetFFIWordSpec next_class = sysv64_classify(st->fields[i]); + JanetFFIWordSpec next_class = sysv64_classify(st->fields[i].type); if (next_class != clazz) { if (clazz == JANET_SYSV64_NO_CLASS) { clazz = next_class; From c75b088ff858e0f56eddb21b4314444d97cff1bc Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 10 Jun 2022 19:13:23 -0500 Subject: [PATCH 34/89] Format boot.janet with janet-format. --- src/boot/boot.janet | 106 ++++++++++++++++++++++---------------------- 1 file changed, 54 insertions(+), 52 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 69ef4624..ad4d64b3 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -948,12 +948,12 @@ (def call-buffer @[]) (while true (forv i 0 ninds - (let [old-key (in iterkeys i) - ii (in inds i) - new-key (next ii old-key)] - (if (= nil new-key) - (do (set done true) (break)) - (do (set (iterkeys i) new-key) (array/push call-buffer (in ii new-key)))))) + (let [old-key (in iterkeys i) + ii (in inds i) + new-key (next ii old-key)] + (if (= nil new-key) + (do (set done true) (break)) + (do (set (iterkeys i) new-key) (array/push call-buffer (in ii new-key)))))) (if done (break)) (array/push res (f ;call-buffer)) (array/clear call-buffer)))) @@ -1591,8 +1591,8 @@ (each x ind (def y (f x)) (cond - is-new (do (set is-new false) (set category y) (set span @[x]) (array/push ret span)) - (= y category) (array/push span x) + is-new (do (set is-new false) (set category y) (set span @[x]) (array/push ret span)) + (= y category) (array/push span x) (do (set category y) (set span @[x]) (array/push ret span)))) ret) @@ -1842,7 +1842,7 @@ (when isarr (array/push anda (get-length-sym s)) (def pattern-len - (if-let [ rest-idx (find-index (fn [x] (= x '&)) pattern) ] + (if-let [rest-idx (find-index (fn [x] (= x '&)) pattern)] rest-idx (length pattern))) (array/push anda [<= pattern-len (get-length-sym s)])) @@ -2282,9 +2282,9 @@ (def source-code (file/read f :all)) (var index 0) (repeat (dec line) - (if-not index (break)) - (set index (string/find "\n" source-code index)) - (if index (++ index))) + (if-not index (break)) + (set index (string/find "\n" source-code index)) + (if index (++ index))) (when index (def line-end (string/find "\n" source-code index)) (eprint " " (string/slice source-code index line-end)) @@ -2586,8 +2586,8 @@ (while (parser/has-more p) (array/push ret (parser/produce p))) (if (= :error (parser/status p)) - (error (parser/error p)) - ret))) + (error (parser/error p)) + ret))) (def load-image-dict ``A table used in combination with `unmarshal` to unmarshal byte sequences created @@ -3027,7 +3027,7 @@ # Parse state (var cursor 0) # indexes into string for parsing - (var stack @[]) # return value for this block. + (var stack @[]) # return value for this block. # Traversal helpers (defn c [] (get str cursor)) @@ -3146,38 +3146,40 @@ (= b (chr "_")) (delim :underline) (= b (chr "`")) (delim :code) (= b (chr "*")) - (if (= (chr "*") (get line (+ i 1))) - (do (++ i) - (delim :bold)) - (delim :italics)) + (if (= (chr "*") (get line (+ i 1))) + (do (++ i) + (delim :bold)) + (delim :italics)) (do (++ token-length) (buffer/push token b)))) (endtoken) (tuple/slice tokens)) - (set parse-blocks (fn parse-blocks [indent] - (var new-indent indent) - (var p-start nil) - (var p-end nil) - (defn p-line [] - (unless p-start - (set p-start cursor)) - (skipline) - (set p-end cursor) - (set new-indent (skipwhite))) - (defn finish-p [] - (when (and p-start (> p-end p-start)) - (push (tokenize-line (getslice p-start p-end))) - (set p-start nil))) - (while (and (c) (>= new-indent indent)) - (cond - (nl?) (do (finish-p) (c++) (set new-indent (skipwhite))) - (ul?) (do (finish-p) (set new-indent (parse-list ul? :ul new-indent))) - (ol?) (do (finish-p) (set new-indent (parse-list ol? :ol new-indent))) - (fcb?) (do (finish-p) (set new-indent (parse-fcb new-indent))) - (>= new-indent (+ 4 indent)) (do (finish-p) (set new-indent (parse-icb new-indent))) - (p-line))) - (finish-p) - new-indent)) + (set + parse-blocks + (fn parse-blocks [indent] + (var new-indent indent) + (var p-start nil) + (var p-end nil) + (defn p-line [] + (unless p-start + (set p-start cursor)) + (skipline) + (set p-end cursor) + (set new-indent (skipwhite))) + (defn finish-p [] + (when (and p-start (> p-end p-start)) + (push (tokenize-line (getslice p-start p-end))) + (set p-start nil))) + (while (and (c) (>= new-indent indent)) + (cond + (nl?) (do (finish-p) (c++) (set new-indent (skipwhite))) + (ul?) (do (finish-p) (set new-indent (parse-list ul? :ul new-indent))) + (ol?) (do (finish-p) (set new-indent (parse-list ol? :ol new-indent))) + (fcb?) (do (finish-p) (set new-indent (parse-fcb new-indent))) + (>= new-indent (+ 4 indent)) (do (finish-p) (set new-indent (parse-icb new-indent))) + (p-line))) + (finish-p) + new-indent)) # Handle first line specially for defn, defmacro, etc. (when (= (chr "(") (in str 0)) @@ -3314,10 +3316,10 @@ (do (def [fullpath mod-kind] (module/find (string sym))) (if-let [mod-env (in module/cache fullpath)] - (print-module-entry {:module true - :kind mod-kind + (print-module-entry {:module true + :kind mod-kind :source-map [fullpath nil nil] - :doc (in mod-env :doc)}) + :doc (in mod-env :doc)}) (print "symbol " sym " not found.")))) (print-module-entry x))) @@ -3600,8 +3602,8 @@ (def ,chan (,ev/chan)) (def ,res @[]) (,wait-for-fibers ,chan - ,(seq [[i body] :pairs bodies] - ~(,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))) + ,(seq [[i body] :pairs bodies] + ~(,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))) ,res)))) (compwhen (dyn 'net/listen) @@ -3683,7 +3685,7 @@ (try (dofile path :evaluator flycheck-evaluator ;(kvs kwargs)) ([e f] - (debug/stacktrace f e ""))) + (debug/stacktrace f e ""))) (table/clear module/cache) (merge-into module/cache old-modcache) nil) @@ -3701,7 +3703,7 @@ (defn- run-main [env subargs arg] (when-let [entry (in env 'main) - main (or (get entry :value) (in (get entry :ref) 0))] + main (or (get entry :value) (in (get entry :ref) 0))] (def guard (if (get env :debug) :ydt :y)) (defn wrap-main [&] (main ;subargs)) @@ -3873,8 +3875,8 @@ (file/read stdin :line buf)) (def env (make-env)) (when-let [profile.janet (dyn *profilepath*)] - (def new-env (dofile profile.janet :exit true)) - (merge-module env new-env "" false)) + (def new-env (dofile profile.janet :exit true)) + (merge-module env new-env "" false)) (when debug-flag (put env *debug* true) (put env *redef* true)) From 0bc96304a9c104659d463cdc4e81940a7b7b0653 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 11 Jun 2022 09:40:37 -0500 Subject: [PATCH 35/89] Add r32 and r64 aliases for real numbers in ffi types. --- src/core/ffi.c | 2 ++ tools/tm_lang_gen.janet | 1 + 2 files changed, 3 insertions(+) diff --git a/src/core/ffi.c b/src/core/ffi.c index bdccbfc7..da3e7ffb 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -227,6 +227,8 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { if (!janet_cstrcmp(name, "ssize")) return JANET_FFI_TYPE_INT32; #endif /* aliases */ + if (!janet_cstrcmp(name, "r32")) return JANET_FFI_TYPE_FLOAT; + if (!janet_cstrcmp(name, "r64")) return JANET_FFI_TYPE_DOUBLE; if (!janet_cstrcmp(name, "s8")) return JANET_FFI_TYPE_INT8; if (!janet_cstrcmp(name, "u8")) return JANET_FFI_TYPE_UINT8; if (!janet_cstrcmp(name, "s16")) return JANET_FFI_TYPE_INT16; diff --git a/tools/tm_lang_gen.janet b/tools/tm_lang_gen.janet index 9c0f6161..29c6292d 100644 --- a/tools/tm_lang_gen.janet +++ b/tools/tm_lang_gen.janet @@ -17,6 +17,7 @@ "quote" "quasiquote" "unquote" + "upscope" "splice"] (all-bindings))) (def allsyms (dyn :allsyms)) From 0cc53a8964ca1e86d2073c67db850987b16d2280 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 11 Jun 2022 14:47:35 -0500 Subject: [PATCH 36/89] Get a GTK example working. Good proof of concept. --- ffitest/gtk.janet | 57 ++++++++++++++++++++++++++++++++++++++++++ src/core/ffi.c | 63 ++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 114 insertions(+), 6 deletions(-) create mode 100644 ffitest/gtk.janet diff --git a/ffitest/gtk.janet b/ffitest/gtk.janet new file mode 100644 index 00000000..e6de3672 --- /dev/null +++ b/ffitest/gtk.janet @@ -0,0 +1,57 @@ +# FFI is best used with a wrapper like the one below +# An even more sophisticated macro wrapper could add +# better doc strings, better parameter checking, etc. + +(defn defnative-context + "Load a dynamic library and set it as the context for following declarations" + [location] + (setdyn :raw-native (raw-native location))) + +(defmacro defnative + "Declare a native binding" + [name ret-type & body] + (def signature-args (last body)) + (def defn-args (seq [_ :in signature-args] (gensym))) + (def raw-symbol (string/replace-all "-" "_" name)) + (def $sig (symbol name "-signature-")) + (def $pointer (symbol name "-raw-pointer-")) + ~(upscope + (def ,$pointer :private (as-macro ,assert (,native-lookup (,dyn :raw-native) ,raw-symbol))) + (def ,$sig :private (,native-signature :default ,ret-type ,;signature-args)) + (defn ,name [,;defn-args] + (,native-call ,$pointer ,$sig ,;defn-args)))) + +(defnative-context "/usr/lib/libgtk-3.so") + +(defnative gtk-application-new :ptr [:ptr :uint]) +(defnative g-signal-connect-data :ulong [:ptr :ptr :ptr :ptr :ptr :int]) +(defnative g-application-run :int [:ptr :int :ptr]) +(defnative gtk-application-window-new :ptr [:ptr]) +(defnative gtk-button-new-with-label :ptr [:ptr]) +(defnative gtk-container-add :void [:ptr :ptr]) +(defnative gtk-widget-show-all :void [:ptr]) +(defnative gtk-button-set-label :void [:ptr :ptr]) + +# GTK follows a strict convention for callbacks. This lets us use +# a single "standard" callback whose behavior is specified by userdata. +# This lets use callbacks without code generation, so no issues with iOS, SELinux, etc. +# Limitation is that we cannot generate arbitrary closures to pass into apis. +# However, any stubs we need we would simply need to compile ourselves, so +# Janet includes a common stub out of the box. +(def cb (native-trampoline :default)) + +(defn on-active + [app] + (def window (gtk-application-window-new app)) + (def btn (gtk-button-new-with-label "Click Me!")) + (g-signal-connect-data btn "clicked" cb + (fn [btn] (gtk-button-set-label btn "Hello World")) + nil 1) + (gtk-container-add window btn) + (gtk-widget-show-all window)) + +(defn main + [&] + (def app (gtk-application-new "org.janet-lang.example.HelloApp" 0)) + (g-signal-connect-data app "activate" cb on-active nil 1) + (g-application-run app 0 nil)) diff --git a/src/core/ffi.c b/src/core/ffi.c index da3e7ffb..768df678 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -328,14 +328,22 @@ JANET_CORE_FN(cfun_ffi_struct, static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { switch (janet_type(argv[n])) { default: - janet_panicf("bad slot #%d, expected pointer convertable type, got %v", argv[n]); + janet_panicf("bad slot #%d, expected ffi pointer convertable type, got %v", argv[n]); case JANET_POINTER: case JANET_STRING: case JANET_KEYWORD: case JANET_SYMBOL: + case JANET_ABSTRACT: return janet_unwrap_pointer(argv[n]); case JANET_BUFFER: return janet_unwrap_buffer(argv[n])->data; + case JANET_FUNCTION: + /* Users may pass in a function. Any function passed is almost certainly + * being used as a callback, so we add it to the root set. */ + janet_gcroot(argv[n]); + return janet_unwrap_pointer(argv[n]); + case JANET_NIL: + return NULL; } } @@ -609,6 +617,25 @@ JANET_CORE_FN(cfun_ffi_signature, return janet_wrap_abstract(abst); } +/* A common callback function signature. To avoid runtime code generation, which is prohibited + * on many platforms, often buggy (see libffi), and generally complicated, instead provide + * a single (or small set of commonly used function signatures). All callbacks should + * eventually call this. */ +void janet_ffi_trampoline(void *ctx, void *userdata) { + if (NULL == userdata) { + /* Userdata not set. */ + janet_eprintf("no userdata found for janet callback"); + return; + } + Janet context = janet_wrap_pointer(ctx); + JanetFunction *fun = userdata; + janet_call(fun, 1, &context); +} + +static void janet_ffi_sysv64_standard_callback(void *ctx, void *userdata) { + janet_ffi_trampoline(ctx, userdata); +} + static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) { uint64_t ret[2]; uint64_t regs[6]; @@ -741,14 +768,37 @@ JANET_CORE_FN(cfun_ffi_buffer_write, JANET_CORE_FN(cfun_ffi_buffer_read, "(native-read ffi-type bytes &opt offset)", "Parse a native struct out of a buffer and convert it to normal Janet data structures. " - "This function is the inverse of `native-write`.") { + "This function is the inverse of `native-write`. `bytes` can also be a raw pointer, although " + "this is unsafe.") { janet_arity(argc, 2, 3); JanetFFIType type = decode_ffi_type(argv[0]); - size_t el_size = type_size(type); - JanetByteView bytes = janet_getbytes(argv, 1); size_t offset = (size_t) janet_optnat(argv, argc, 2, 0); - if ((size_t) bytes.len < offset + el_size) janet_panic("read out of range"); - return janet_ffi_read_one(bytes.bytes, type, JANET_FFI_MAX_RECUR); + if (janet_checktype(argv[1], JANET_POINTER)) { + uint8_t *ptr = janet_unwrap_pointer(argv[1]); + return janet_ffi_read_one(ptr + offset, type, JANET_FFI_MAX_RECUR); + } else { + size_t el_size = type_size(type); + JanetByteView bytes = janet_getbytes(argv, 1); + if ((size_t) bytes.len < offset + el_size) janet_panic("read out of range"); + return janet_ffi_read_one(bytes.bytes + offset, type, JANET_FFI_MAX_RECUR); + } +} + +JANET_CORE_FN(cfun_ffi_get_callback_trampoline, + "(native-trampoline cc)", + "Get a native function pointer that can be used as a callback and passed to C libraries. " + "This callback trampoline has the signature `void trampoline(void *ctx, void *userdata)` in " + "the given calling convention. This is the only function signature supported. " + "It is up to the programmer to ensure that the `userdata` argument contains a janet function " + "the will be called with one argument, `ctx` which is an opaque pointer. This pointer can " + "be further inspected with `native-read`.") { + janet_fixarity(argc, 1); + JanetFFICallingConvention cc = decode_ffi_cc(janet_getkeyword(argv, 0)); + switch (cc) { + default: + case JANET_FFI_CC_SYSV_64: + return janet_wrap_pointer(janet_ffi_sysv64_standard_callback); + } } void janet_lib_ffi(JanetTable *env) { @@ -758,6 +808,7 @@ void janet_lib_ffi(JanetTable *env) { JANET_CORE_REG("native-struct", cfun_ffi_struct), JANET_CORE_REG("native-write", cfun_ffi_buffer_write), JANET_CORE_REG("native-read", cfun_ffi_buffer_read), + JANET_CORE_REG("native-trampoline", cfun_ffi_get_callback_trampoline), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, ffi_cfuns); From 458c2c6d88b7c6c24f499cd56533f33440ce1dce Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 11 Jun 2022 15:47:51 -0500 Subject: [PATCH 37/89] Make calling convention optional for trampoline --- src/core/ffi.c | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 768df678..9ca420b2 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -197,11 +197,11 @@ static size_t type_align(JanetFFIType t) { } } +#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_SYSV_64 + static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) { if (!janet_cstrcmp(name, "sysv64")) return JANET_FFI_CC_SYSV_64; - if (!janet_cstrcmp(name, "default")) { - return JANET_FFI_CC_SYSV_64; - } + if (!janet_cstrcmp(name, "default")) return JANET_FFI_CC_DEFAULT; janet_panicf("unknown calling convention %s", name); } @@ -792,8 +792,9 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline, "It is up to the programmer to ensure that the `userdata` argument contains a janet function " "the will be called with one argument, `ctx` which is an opaque pointer. This pointer can " "be further inspected with `native-read`.") { - janet_fixarity(argc, 1); - JanetFFICallingConvention cc = decode_ffi_cc(janet_getkeyword(argv, 0)); + janet_arity(argc, 0, 1); + JanetFFICallingConvention cc = JANET_FFI_CC_DEFAULT; + if (argc >= 1) cc = decode_ffi_cc(janet_getkeyword(argv, 0)); switch (cc) { default: case JANET_FFI_CC_SYSV_64: From 6d970725e77079f3357d8fd0bc871e5f2f14686f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 11 Jun 2022 21:19:42 -0500 Subject: [PATCH 38/89] Update boot.janet for typos. --- src/boot/boot.janet | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index ad4d64b3..2ffd34a0 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2780,7 +2780,7 @@ (defn debugger-on-status "Create a function that can be passed to `run-context`'s `:on-status` argument that will drop into a debugger on errors. The debugger will - only start on abmnormal signals if the env table has the `:debug` dyn + only start on abnormal signals if the env table has the `:debug` dyn set to a truthy value." [env &opt level is-repl] (default level 1) @@ -3898,10 +3898,6 @@ (do - # Deprecate file/popen - (when-let [v (get root-env 'file/popen)] - (put v :deprecated true)) - # Modify root-env to remove private symbols and # flatten nested tables. (loop [[k v] :in (pairs root-env) From ea45d7ee477737a271d894bcf5f15c5f2389d1ff Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 11 Jun 2022 21:43:35 -0500 Subject: [PATCH 39/89] Convert to one big blob of assembly for sysv cc. Also begin working on win64 calling convention. --- src/core/ffi.c | 317 +++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 253 insertions(+), 64 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 9ca420b2..a144a751 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -34,6 +34,11 @@ #define JANET_FFI_MAX_RECUR 64 +/* Compiler, OS, and arch detection */ +#if defined(JANET_WINDOWS) && (defined(__x86_64__) || defined(_M_X64)) +#define JANET_FFI_WIN64_ENABLED +#endif + typedef struct JanetFFIType JanetFFIType; typedef struct JanetFFIStruct JanetFFIStruct; @@ -108,7 +113,9 @@ typedef enum { JANET_SYSV64_X87UP, JANET_SYSV64_COMPLEX_X87, JANET_SYSV64_NO_CLASS, - JANET_SYSV64_MEMORY + JANET_SYSV64_MEMORY, + JANET_WIN64_REGISTER, + JANET_WIN64_STACK } JanetFFIWordSpec; /* Describe how each Janet argument is interpreted in terms of machine words @@ -120,9 +127,16 @@ typedef struct { } JanetFFIMapping; typedef enum { - JANET_FFI_CC_SYSV_64 + JANET_FFI_CC_SYSV_64, + JANET_FFI_CC_WIN_64 } JanetFFICallingConvention; +#ifdef JANET_WINDOWS +#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_WIN_64 +#else +#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_SYSV_64 +#endif + #define JANET_FFI_MAX_ARGS 32 typedef struct { @@ -197,8 +211,6 @@ static size_t type_align(JanetFFIType t) { } } -#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_SYSV_64 - static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) { if (!janet_cstrcmp(name, "sysv64")) return JANET_FFI_CC_SYSV_64; if (!janet_cstrcmp(name, "default")) return JANET_FFI_CC_DEFAULT; @@ -541,9 +553,28 @@ JANET_CORE_FN(cfun_ffi_signature, default: janet_panicf("calling convention %v unsupported", argv[0]); break; + +#ifdef JANET_FFI_WIN64_ENABLED + case JANET_FFI_CC_WIN_64: { + size_t ret_size = type_size(ret.type); + ret.spec = JANET_WIN64_REGISTER; + uint32_t next_register = 0; + if (ret_size > 8) { + ret.spec = JANET_WIN64_STACK; + next_register++; + } + for (uint32_t i = 0; i < arg_count; i++) { + mappings[i].type = decode_ffi_type(argv[i + 2]); + mappings[i].offset = 0; + mappings[i].spec = JANET_WIN64_REGISTER; + } + + } + break; +#endif + case JANET_FFI_CC_SYSV_64: { JanetFFIWordSpec ret_spec = sysv64_classify(ret.type); - if (ret_spec == JANET_SYSV64_SSE) variant = 1; ret.spec = ret_spec; /* Spill register overflow to memory */ @@ -638,6 +669,7 @@ static void janet_ffi_sysv64_standard_callback(void *ctx, void *userdata) { static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) { uint64_t ret[2]; + uint64_t fp_ret[2]; uint64_t regs[6]; uint64_t fp_regs[8]; JanetFFIWordSpec ret_spec = signature->ret.spec; @@ -645,6 +677,8 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point if (ret_spec == JANET_SYSV64_MEMORY) { ret_mem = alloca(type_size(signature->ret.type)); regs[0] = (uint64_t) ret_mem; + } else if (ret_spec == JANET_SYSV64_SSE) { + ret_mem = fp_ret; } uint64_t *stack = alloca(sizeof(uint64_t) * signature->stack_count); for (uint32_t i = 0; i < signature->arg_count; i++) { @@ -669,69 +703,220 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point /* !!ACHTUNG!! */ -#define FFI_ASM_PRELUDE \ - "mov %3, %%rdi\n\t" \ - "mov %4, %%rsi\n\t" \ - "mov %5, %%rdx\n\t" \ - "mov %6, %%rcx\n\t" \ - "mov %7, %%r8\n\t" \ - "mov %8, %%r9\n\t" \ - "movq %9, %%xmm0\n\t" \ - "movq %10, %%xmm1\n\t" \ - "movq %11, %%xmm2\n\t" \ - "movq %12, %%xmm3\n\t" \ - "movq %13, %%xmm4\n\t" \ - "movq %14, %%xmm5\n\t" \ - "movq %15, %%xmm6\n\t" \ - "movq %16, %%xmm7\n\t" -#define FFI_ASM_OUTPUTS "=g" (ret[0]), "=g" (ret[1]) -#define FFI_ASM_INPUTS \ - "g"(function_pointer), \ - "g"(regs[0]), \ - "g"(regs[1]), \ - "g"(regs[2]), \ - "g"(regs[3]), \ - "g"(regs[4]), \ - "g"(regs[5]), \ - "g"(fp_regs[0]), \ - "g"(fp_regs[1]), \ - "g"(fp_regs[2]), \ - "g"(fp_regs[3]), \ - "g"(fp_regs[4]), \ - "g"(fp_regs[5]), \ - "g"(fp_regs[6]), \ - "g"(fp_regs[7]) - - switch (signature->variant) { - default: - /* fallthrough */ - case 0: - __asm__(FFI_ASM_PRELUDE - "call *%2\n\t" - "mov %%rax, %0\n\t" - "mov %%rdx, %1" - : FFI_ASM_OUTPUTS - : FFI_ASM_INPUTS - : "rax", "rdi", "rsi", "rdx", "rcx", "r8", "r9", "r10", "r11"); - break; - case 1: - __asm__(FFI_ASM_PRELUDE - "call *%2\n\t" - "movq %%xmm0, %0\n\t" - "movq %%xmm1, %1" - : FFI_ASM_OUTPUTS - : FFI_ASM_INPUTS - : "rax", "rdi", "rsi", "rdx", "rcx", "r8", "r9", "r10", "r11"); - break; - } - -#undef FFI_ASM_PRELUDE -#undef FFI_ASM_OUTPUTS -#undef FFI_ASM_INPUTS + __asm__("mov %5, %%rdi\n\t" + "mov %6, %%rsi\n\t" + "mov %7, %%rdx\n\t" + "mov %8, %%rcx\n\t" + "mov %9, %%r8\n\t" + "mov %10, %%r9\n\t" + "movq %11, %%xmm0\n\t" + "movq %12, %%xmm1\n\t" + "movq %13, %%xmm2\n\t" + "movq %14, %%xmm3\n\t" + "movq %15, %%xmm4\n\t" + "movq %16, %%xmm5\n\t" + "movq %17, %%xmm6\n\t" + "movq %18, %%xmm7\n\t" + "call *%4\n\t" + "mov %%rax, %0\n\t" + "mov %%rdx, %1\n\t" + "movq %%xmm0, %2\n\t" + "movq %%xmm1, %3" + : "=g"(ret[0]), "=g"(ret[1]), "=g"(fp_ret[0]), "=g"(fp_ret[1]) + : "g"(function_pointer), + "g"(regs[0]), + "g"(regs[1]), + "g"(regs[2]), + "g"(regs[3]), + "g"(regs[4]), + "g"(regs[5]), + "g"(fp_regs[0]), + "g"(fp_regs[1]), + "g"(fp_regs[2]), + "g"(fp_regs[3]), + "g"(fp_regs[4]), + "g"(fp_regs[5]), + "g"(fp_regs[6]), + "g"(fp_regs[7])); return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR); } +#if defined(JANET_WINDOWS) && (defined(__x86_64__) || defined(_M_X64)) + +/* Variants that allow setting all required registers for 64 bit windows calling convention. + * win64 calling convention has up to 4 arguments on registers, and one register for returns. + * Each register can either be an integer or floating point register, resulting in + * 2^5 = 32 variants. Unlike sysv, there are no function signatures that will fill + * all of the possible registers which is why we have so many variants. If you were using + * assembly, you could manually fill all of the registers and only have a single variant. + * And msvc does not support inline assembly on 64 bit targets, so yeah, we have this hackery. */ +typedef uint64_t (win64_variant_i_iiii)(uint64_t, uint64_t, uint64_t, uint64_t); +typedef uint64_t (win64_variant_i_iiif)(uint64_t, uint64_t, uint64_t, double); +typedef uint64_t (win64_variant_i_iifi)(uint64_t, uint64_t, double, uint64_t); +typedef uint64_t (win64_variant_i_iiff)(uint64_t, uint64_t, double, double); +typedef uint64_t (win64_variant_i_ifii)(uint64_t, double, uint64_t, uint64_t); +typedef uint64_t (win64_variant_i_ifif)(uint64_t, double, uint64_t, double); +typedef uint64_t (win64_variant_i_iffi)(uint64_t, double, double, uint64_t); +typedef uint64_t (win64_variant_i_ifff)(uint64_t, double, double, double); +typedef uint64_t (win64_variant_i_fiii)(double, uint64_t, uint64_t, uint64_t); +typedef uint64_t (win64_variant_i_fiif)(double, uint64_t, uint64_t, double); +typedef uint64_t (win64_variant_i_fifi)(double, uint64_t, double, uint64_t); +typedef uint64_t (win64_variant_i_fiff)(double, uint64_t, double, double); +typedef uint64_t (win64_variant_i_ffii)(double, double, uint64_t, uint64_t); +typedef uint64_t (win64_variant_i_ffif)(double, double, uint64_t, double); +typedef uint64_t (win64_variant_i_fffi)(double, double, double, uint64_t); +typedef uint64_t (win64_variant_i_ffff)(double, double, double, double); +typedef double (win64_variant_f_iiii)(uint64_t, uint64_t, uint64_t, uint64_t); +typedef double (win64_variant_f_iiif)(uint64_t, uint64_t, uint64_t, double); +typedef double (win64_variant_f_iifi)(uint64_t, uint64_t, double, uint64_t); +typedef double (win64_variant_f_iiff)(uint64_t, uint64_t, double, double); +typedef double (win64_variant_f_ifii)(uint64_t, double, uint64_t, uint64_t); +typedef double (win64_variant_f_ifif)(uint64_t, double, uint64_t, double); +typedef double (win64_variant_f_iffi)(uint64_t, double, double, uint64_t); +typedef double (win64_variant_f_ifff)(uint64_t, double, double, double); +typedef double (win64_variant_f_fiii)(double, uint64_t, uint64_t, uint64_t); +typedef double (win64_variant_f_fiif)(double, uint64_t, uint64_t, double); +typedef double (win64_variant_f_fifi)(double, uint64_t, double, uint64_t); +typedef double (win64_variant_f_fiff)(double, uint64_t, double, double); +typedef double (win64_variant_f_ffii)(double, double, uint64_t, uint64_t); +typedef double (win64_variant_f_ffif)(double, double, uint64_t, double); +typedef double (win64_variant_f_fffi)(double, double, double, uint64_t); +typedef double (win64_variant_f_ffff)(double, double, double, double); + +static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) { + union { + uint64_t integer; + double real; + } regs[4]; + union { + uint64_t integer; + double real; + } ret_reg; + JanetFFIWordSpec ret_spec = signature->ret.spec; + void *ret_mem = &ret_reg.integer; + if (ret_spec == JANET_WIN64_STACK) { + ret_mem = alloca(type_size(signature->ret.type)); + regs[0].integer = (uint64_t) ret_mem; + } + uint8_t *stack = alloca(signature->stack_count); + for (uint32_t i = 0; i < signature->arg_count; i++) { + int32_t n = i + 2; + JanetFFIMapping arg = signature->args[i]; + if (arg.spec == JANET_WIN64_STACK) { + janet_ffi_write_one(stack + arg.offset, argv, n, arg.type, JANET_FFI_MAX_RECUR); + } else { + janet_ffi_write_one((uint8_t *) ®s[arg.offset].integer, argv, n, arg.type, JANET_FFI_MAX_RECUR); + } + } + + /* the seasoned programmer who cut their teeth on assembly is probably queitly shaking their head by now... */ + switch (signature->variant) { + default: + janet_panic("unknown variant"); + case 0: + ret_reg.integer = ((win64_variant_i_iiii *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].integer, regs[3].integer); + break; + case 1: + ret_reg.integer = ((win64_variant_i_iiif *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].integer, regs[3].real); + break; + case 2: + ret_reg.integer = ((win64_variant_i_iifi *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].real, regs[3].integer); + break; + case 3: + ret_reg.integer = ((win64_variant_i_iiff *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].real, regs[3].real); + break; + case 4: + ret_reg.integer = ((win64_variant_i_ifii *) function_pointer)(regs[0].integer, regs[1].real, regs[2].integer, regs[3].integer); + break; + case 5: + ret_reg.integer = ((win64_variant_i_ifif *) function_pointer)(regs[0].integer, regs[1].real, regs[2].integer, regs[3].real); + break; + case 6: + ret_reg.integer = ((win64_variant_i_iffi *) function_pointer)(regs[0].integer, regs[1].real, regs[2].real, regs[3].integer); + break; + case 7: + ret_reg.integer = ((win64_variant_i_ifff *) function_pointer)(regs[0].integer, regs[1].real, regs[2].real, regs[3].real); + break; + case 8: + ret_reg.integer = ((win64_variant_i_fiii *) function_pointer)(regs[0].real, regs[1].integer, regs[2].integer, regs[3].integer); + break; + case 9: + ret_reg.integer = ((win64_variant_i_fiif *) function_pointer)(regs[0].real, regs[1].integer, regs[2].integer, regs[3].real); + break; + case 10: + ret_reg.integer = ((win64_variant_i_fifi *) function_pointer)(regs[0].real, regs[1].integer, regs[2].real, regs[3].integer); + break; + case 11: + ret_reg.integer = ((win64_variant_i_fiff *) function_pointer)(regs[0].real, regs[1].integer, regs[2].real, regs[3].real); + break; + case 12: + ret_reg.integer = ((win64_variant_i_ffii *) function_pointer)(regs[0].real, regs[1].real, regs[2].integer, regs[3].integer); + break; + case 13: + ret_reg.integer = ((win64_variant_i_ffif *) function_pointer)(regs[0].real, regs[1].real, regs[2].integer, regs[3].real); + break; + case 14: + ret_reg.integer = ((win64_variant_i_fffi *) function_pointer)(regs[0].real, regs[1].real, regs[2].real, regs[3].integer); + break; + case 15: + ret_reg.integer = ((win64_variant_i_ffff *) function_pointer)(regs[0].real, regs[1].real, regs[2].real, regs[3].real); + break; + case 16: + ret_reg.real = ((win64_variant_f_iiii *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].integer, regs[3].integer); + break; + case 17: + ret_reg.real = ((win64_variant_f_iiif *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].integer, regs[3].real); + break; + case 18: + ret_reg.real = ((win64_variant_f_iifi *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].real, regs[3].integer); + break; + case 19: + ret_reg.real = ((win64_variant_f_iiff *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].real, regs[3].real); + break; + case 20: + ret_reg.real = ((win64_variant_f_ifii *) function_pointer)(regs[0].integer, regs[1].real, regs[2].integer, regs[3].integer); + break; + case 21: + ret_reg.real = ((win64_variant_f_ifif *) function_pointer)(regs[0].integer, regs[1].real, regs[2].integer, regs[3].real); + break; + case 22: + ret_reg.real = ((win64_variant_f_iffi *) function_pointer)(regs[0].integer, regs[1].real, regs[2].real, regs[3].integer); + break; + case 23: + ret_reg.real = ((win64_variant_f_ifff *) function_pointer)(regs[0].integer, regs[1].real, regs[2].real, regs[3].real); + break; + case 24: + ret_reg.real = ((win64_variant_f_fiii *) function_pointer)(regs[0].real, regs[1].integer, regs[2].integer, regs[3].integer); + break; + case 25: + ret_reg.real = ((win64_variant_f_fiif *) function_pointer)(regs[0].real, regs[1].integer, regs[2].integer, regs[3].real); + break; + case 26: + ret_reg.real = ((win64_variant_f_fifi *) function_pointer)(regs[0].real, regs[1].integer, regs[2].real, regs[3].integer); + break; + case 27: + ret_reg.real = ((win64_variant_f_fiff *) function_pointer)(regs[0].real, regs[1].integer, regs[2].real, regs[3].real); + break; + case 28: + ret_reg.real = ((win64_variant_f_ffii *) function_pointer)(regs[0].real, regs[1].real, regs[2].integer, regs[3].integer); + break; + case 29: + ret_reg.real = ((win64_variant_f_ffif *) function_pointer)(regs[0].real, regs[1].real, regs[2].integer, regs[3].real); + break; + case 30: + ret_reg.real = ((win64_variant_f_fffi *) function_pointer)(regs[0].real, regs[1].real, regs[2].real, regs[3].integer); + break; + case 31: + ret_reg.real = ((win64_variant_f_ffff *) function_pointer)(regs[0].real, regs[1].real, regs[2].real, regs[3].real); + break; + } + + return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR); +} + +#endif + JANET_CORE_FN(cfun_ffi_call, "(native-call pointer signature & args)", "Call a raw pointer as a function pointer. The function signature specifies " @@ -743,6 +928,10 @@ JANET_CORE_FN(cfun_ffi_call, switch (signature->cc) { default: janet_panic("unsupported calling convention"); +#ifdef JANET_FFI_WIN64_ENABLED + case JANET_FFI_CC_WIN_64: + return janet_ffi_win64(signature, function_pointer, argv); +#endif case JANET_FFI_CC_SYSV_64: return janet_ffi_sysv64(signature, function_pointer, argv); } From 73c4289792f59b5ef129166df485c476db1ccf6c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 11 Jun 2022 21:50:34 -0500 Subject: [PATCH 40/89] Fix define check. --- src/core/ffi.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index a144a751..b94c67c1 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -742,7 +742,7 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR); } -#if defined(JANET_WINDOWS) && (defined(__x86_64__) || defined(_M_X64)) +#ifdef JANET_FFI_WIN64_ENABLED /* Variants that allow setting all required registers for 64 bit windows calling convention. * win64 calling convention has up to 4 arguments on registers, and one register for returns. From e318170fea351bc04ccddac2ca48cbf278432214 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Jun 2022 09:16:10 -0500 Subject: [PATCH 41/89] Begin working on windows calling convetion. Also remove inline assembly for making sysv64 calls. Instead, use crafted function signatures to set all needed registers. --- src/core/ffi.c | 221 +++++++++++++++++++++++++++++++++---------------- 1 file changed, 150 insertions(+), 71 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index b94c67c1..0e814733 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -38,6 +38,9 @@ #if defined(JANET_WINDOWS) && (defined(__x86_64__) || defined(_M_X64)) #define JANET_FFI_WIN64_ENABLED #endif +#if (defined(__x86_64__) || defined(_M_X64)) && !defined(JANET_WINDOWS) +#define JANET_FFI_SYSV64_ENABLED +#endif typedef struct JanetFFIType JanetFFIType; typedef struct JanetFFIStruct JanetFFIStruct; @@ -115,7 +118,9 @@ typedef enum { JANET_SYSV64_NO_CLASS, JANET_SYSV64_MEMORY, JANET_WIN64_REGISTER, - JANET_WIN64_STACK + JANET_WIN64_STACK, + JANET_WIN64_REGISTER_REF, + JANET_WIN64_STACK_REF } JanetFFIWordSpec; /* Describe how each Janet argument is interpreted in terms of machine words @@ -124,6 +129,7 @@ typedef struct { JanetFFIType type; JanetFFIWordSpec spec; uint32_t offset; /* point to the exact register / stack offset depending on spec. */ + uint32_t offset2; /* for reference passing apis (windows), use to allocate reference */ } JanetFFIMapping; typedef enum { @@ -260,6 +266,21 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { janet_panicf("unknown machine type %s", name); } +/* A common callback function signature. To avoid runtime code generation, which is prohibited + * on many platforms, often buggy (see libffi), and generally complicated, instead provide + * a single (or small set of commonly used function signatures). All callbacks should + * eventually call this. */ +void janet_ffi_trampoline(void *ctx, void *userdata) { + if (NULL == userdata) { + /* Userdata not set. */ + janet_eprintf("no userdata found for janet callback"); + return; + } + Janet context = janet_wrap_pointer(ctx); + JanetFunction *fun = userdata; + janet_call(fun, 1, &context); +} + static JanetFFIType decode_ffi_type(Janet x); static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) { @@ -481,6 +502,7 @@ static JanetFFIMapping void_mapping(void) { return m; } +#ifdef JANET_FFI_SYSV64_ENABLED /* AMD64 ABI Draft 0.99.7 – November 17, 2014 – 15:08 * See section 3.2.3 Parameter Passing */ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) { @@ -530,6 +552,7 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) { return JANET_SYSV64_NO_CLASS; } } +#endif JANET_CORE_FN(cfun_ffi_signature, "(native-signature calling-convention ret-type & arg-types)", @@ -545,6 +568,7 @@ JANET_CORE_FN(cfun_ffi_signature, JanetFFIMapping ret = { ret_type, JANET_SYSV64_NO_CLASS, + 0, 0 }; JanetFFIMapping mappings[JANET_FFI_MAX_ARGS]; @@ -557,26 +581,81 @@ JANET_CORE_FN(cfun_ffi_signature, #ifdef JANET_FFI_WIN64_ENABLED case JANET_FFI_CC_WIN_64: { size_t ret_size = type_size(ret.type); + size_t ref_stack_count = 0; ret.spec = JANET_WIN64_REGISTER; uint32_t next_register = 0; - if (ret_size > 8) { - ret.spec = JANET_WIN64_STACK; + if (ret_size != 1 && ret_size != 2 && ret_size != 4 && ret_size != 8) { + ret.spec = JANET_WIN64_REGISTER_REF; next_register++; + } else if (ret.type.prim == JANET_FFI_TYPE_FLOAT || + ret.type.prim == JANET_FFI_TYPE_DOUBLE) { + variant += 16; } for (uint32_t i = 0; i < arg_count; i++) { mappings[i].type = decode_ffi_type(argv[i + 2]); - mappings[i].offset = 0; - mappings[i].spec = JANET_WIN64_REGISTER; + size_t el_size = type_size(mappings[i].type); + int is_register_sized = (el_size == 1 || el_size == 2 || el_size == 4 || el_size == 8); + if (next_register < 4) { + mappings[i].offset = next_register++; + if (is_register_sized) { + mappings[i].spec = JANET_WIN64_REGISTER; + + /* Select variant based on position of floating point arguments */ + if (mappings[i].type.prim == JANET_FFI_TYPE_FLOAT || + mappings[i].type.prim == JANET_FFI_TYPE_DOUBLE) { + variant += 1 << next_register; + } + } else { + mappings[i].spec = JANET_WIN64_REGISTER_REF; + mappings[i].offset2 = ref_stack_count; + ref_stack_count += (el_size + 15) / 16; + } + } else { + if (is_register_sized) { + mappings[i].spec = JANET_WIN64_STACK; + mappings[i].offset = stack_count; + stack_count++; + } else { + mappings[i].spec = JANET_WIN64_STACK_REF; + mappings[i].offset = stack_count; + stack_count++; + mappings[i].offset2 = ref_stack_count; + ref_stack_count += (el_size + 15) / 16; + } + } + } + + /* Take into account reference arguments and align to 16 bytes just in case */ + stack_count += 2 * ref_stack_count; + if (stack_count & 1) { + stack_count++; + } + + /* Invert stack + * Offsets are in units of 8-bytes */ + for (uint32_t i = 0; i < arg_count; i++) { + uint32_t old_offset = mappings[i].offset; + if (mappings[i].spec == JANET_WIN64_STACK) { + mappings[i].offset = stack_count - 1 - old_offset; + } else if (mappings[i].spec == JANET_WIN64_STACK_REF) { + mappings[i].offset = stack_count - 1 - old_offset; + } + if (mappings[i].spec == JANET_WIN64_STACK_REF || mappings[i].spec == JANET_WIN64_REGISTER_REF) { + /* Align size to 16 bytes */ + size_t size = (type_size(mappings[i].type) + 15) & ~0xFUL; + mappings[i].offset2 = stack_count - mappings[i].offset2 - (size / 8); + } } } break; #endif +#ifdef JANET_FFI_SYSV64_ENABLED case JANET_FFI_CC_SYSV_64: { JanetFFIWordSpec ret_spec = sysv64_classify(ret.type); ret.spec = ret_spec; - + if (ret_spec == JANET_SYSV64_SSE) variant = 1; /* Spill register overflow to memory */ uint32_t next_register = 0; uint32_t next_fp_register = 0; @@ -622,18 +701,19 @@ JANET_CORE_FN(cfun_ffi_signature, stack_count += el_size; } } + } - /* Invert stack */ - for (uint32_t i = 0; i < arg_count; i++) { - if (mappings[i].spec == JANET_SYSV64_MEMORY) { - uint32_t old_offset = mappings[i].offset; - size_t el_size = type_size(mappings[i].type); - mappings[i].offset = stack_count - ((el_size + 7) / 8) - old_offset; - } + /* Invert stack */ + for (uint32_t i = 0; i < arg_count; i++) { + if (mappings[i].spec == JANET_SYSV64_MEMORY) { + uint32_t old_offset = mappings[i].offset; + size_t el_size = type_size(mappings[i].type); + mappings[i].offset = stack_count - ((el_size + 7) / 8) - old_offset; } } } break; +#endif } /* Create signature abstract value */ @@ -648,37 +728,39 @@ JANET_CORE_FN(cfun_ffi_signature, return janet_wrap_abstract(abst); } -/* A common callback function signature. To avoid runtime code generation, which is prohibited - * on many platforms, often buggy (see libffi), and generally complicated, instead provide - * a single (or small set of commonly used function signatures). All callbacks should - * eventually call this. */ -void janet_ffi_trampoline(void *ctx, void *userdata) { - if (NULL == userdata) { - /* Userdata not set. */ - janet_eprintf("no userdata found for janet callback"); - return; - } - Janet context = janet_wrap_pointer(ctx); - JanetFunction *fun = userdata; - janet_call(fun, 1, &context); -} +#ifdef JANET_FFI_SYSV64_ENABLED static void janet_ffi_sysv64_standard_callback(void *ctx, void *userdata) { janet_ffi_trampoline(ctx, userdata); } +/* Functions that set all argument registers. Two variants - one to read rax and rdx returns, another + * to read xmm0 and xmm1 returns. */ +typedef struct { + uint64_t x; + uint64_t y; +} sysv64_int_return; +typedef struct { + double x; + double y; +} sysv64_sse_return; +typedef sysv64_int_return janet_sysv64_variant_1(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f, + double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8); +typedef sysv64_sse_return janet_sysv64_variant_2(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f, + double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8); + static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) { - uint64_t ret[2]; - uint64_t fp_ret[2]; + sysv64_int_return int_return; + sysv64_sse_return sse_return; uint64_t regs[6]; - uint64_t fp_regs[8]; + double fp_regs[8]; JanetFFIWordSpec ret_spec = signature->ret.spec; - void *ret_mem = ret; + void *ret_mem = &int_return; if (ret_spec == JANET_SYSV64_MEMORY) { ret_mem = alloca(type_size(signature->ret.type)); regs[0] = (uint64_t) ret_mem; } else if (ret_spec == JANET_SYSV64_SSE) { - ret_mem = fp_ret; + ret_mem = &sse_return; } uint64_t *stack = alloca(sizeof(uint64_t) * signature->stack_count); for (uint32_t i = 0; i < signature->arg_count; i++) { @@ -692,7 +774,7 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point to = regs + arg.offset; break; case JANET_SYSV64_SSE: - to = fp_regs + arg.offset; + to = (uint64_t *)(fp_regs + arg.offset); break; case JANET_SYSV64_MEMORY: to = stack + arg.offset; @@ -701,49 +783,30 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point janet_ffi_write_one(to, argv, n, arg.type, JANET_FFI_MAX_RECUR); } - /* !!ACHTUNG!! */ + if (signature->variant) { + sse_return = ((janet_sysv64_variant_2 *)(function_pointer))( + regs[0], regs[1], regs[2], regs[3], regs[4], regs[5], + fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3], + fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]); + } else { + int_return = ((janet_sysv64_variant_1 *)(function_pointer))( + regs[0], regs[1], regs[2], regs[3], regs[4], regs[5], + fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3], + fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]); - __asm__("mov %5, %%rdi\n\t" - "mov %6, %%rsi\n\t" - "mov %7, %%rdx\n\t" - "mov %8, %%rcx\n\t" - "mov %9, %%r8\n\t" - "mov %10, %%r9\n\t" - "movq %11, %%xmm0\n\t" - "movq %12, %%xmm1\n\t" - "movq %13, %%xmm2\n\t" - "movq %14, %%xmm3\n\t" - "movq %15, %%xmm4\n\t" - "movq %16, %%xmm5\n\t" - "movq %17, %%xmm6\n\t" - "movq %18, %%xmm7\n\t" - "call *%4\n\t" - "mov %%rax, %0\n\t" - "mov %%rdx, %1\n\t" - "movq %%xmm0, %2\n\t" - "movq %%xmm1, %3" - : "=g"(ret[0]), "=g"(ret[1]), "=g"(fp_ret[0]), "=g"(fp_ret[1]) - : "g"(function_pointer), - "g"(regs[0]), - "g"(regs[1]), - "g"(regs[2]), - "g"(regs[3]), - "g"(regs[4]), - "g"(regs[5]), - "g"(fp_regs[0]), - "g"(fp_regs[1]), - "g"(fp_regs[2]), - "g"(fp_regs[3]), - "g"(fp_regs[4]), - "g"(fp_regs[5]), - "g"(fp_regs[6]), - "g"(fp_regs[7])); + } return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR); } +#endif + #ifdef JANET_FFI_WIN64_ENABLED +static void janet_ffi_win64_standard_callback(void *ctx, void *userdata) { + janet_ffi_trampoline(ctx, userdata); +} + /* Variants that allow setting all required registers for 64 bit windows calling convention. * win64 calling convention has up to 4 arguments on registers, and one register for returns. * Each register can either be an integer or floating point register, resulting in @@ -799,18 +862,26 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe ret_mem = alloca(type_size(signature->ret.type)); regs[0].integer = (uint64_t) ret_mem; } - uint8_t *stack = alloca(signature->stack_count); + uint64_t *stack = alloca(signature->stack_count * 8); for (uint32_t i = 0; i < signature->arg_count; i++) { int32_t n = i + 2; JanetFFIMapping arg = signature->args[i]; if (arg.spec == JANET_WIN64_STACK) { janet_ffi_write_one(stack + arg.offset, argv, n, arg.type, JANET_FFI_MAX_RECUR); + } else if (arg.spec == JANET_WIN64_STACK_REF) { + uint8_t *ptr = (uint8_t *)(stack + args.offset2); + janet_ffi_write_one(ptr, argv, n, arg.type, JANET_FFI_MAX_RECUR); + stack[args.offset] = (uint64_t) ptr; + } else if (arg.spec == JANET_WIN64_REGISTER_REF) { + uint8_t *ptr = (uint8_t *)(stack + args.offset2); + janet_ffi_write_one(ptr, argv, n, arg.type, JANET_FFI_MAX_RECUR); + regs[args.offset].integer = (uint64_t) ptr; } else { janet_ffi_write_one((uint8_t *) ®s[arg.offset].integer, argv, n, arg.type, JANET_FFI_MAX_RECUR); } } - /* the seasoned programmer who cut their teeth on assembly is probably queitly shaking their head by now... */ + /* the seasoned programmer who cut their teeth on assembly is probably quietly shaking their head by now... */ switch (signature->variant) { default: janet_panic("unknown variant"); @@ -932,8 +1003,10 @@ JANET_CORE_FN(cfun_ffi_call, case JANET_FFI_CC_WIN_64: return janet_ffi_win64(signature, function_pointer, argv); #endif +#ifdef JANET_FFI_SYSV64_ENABLED case JANET_FFI_CC_SYSV_64: return janet_ffi_sysv64(signature, function_pointer, argv); +#endif } } @@ -986,8 +1059,14 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline, if (argc >= 1) cc = decode_ffi_cc(janet_getkeyword(argv, 0)); switch (cc) { default: +#ifdef JANET_FFI_WIN64_ENABLED + case JANET_FFI_CC_WIN_64: + return janet_wrap_pointer(janet_ffi_win64_standard_callback); +#endif +#ifdef JANET_FFI_SYSV64_ENABLED case JANET_FFI_CC_SYSV_64: return janet_wrap_pointer(janet_ffi_sysv64_standard_callback); +#endif } } From 2e9f67f4e4faffc699032604f52125efc83645ff Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Jun 2022 10:02:02 -0500 Subject: [PATCH 42/89] Change all "native-*" to ffi/. Move new dll loading funcs. native-close, raw-native and native-lookup have become ffi/close, ffi/native, and ffi/lookup instead. The new ffi module will be useful for any architecture even if we don't support making calls to certain functions. We can simple add a do-nothing calling convetion that panics on call. ffi/read and ffi/write are useful in their own right. --- ffitest/gtk.janet | 14 +++--- ffitest/test.janet | 78 +++++++++++++++++----------------- src/core/corelib.c | 103 --------------------------------------------- src/core/ffi.c | 83 ++++++++++++++++++++++++++++++------ src/core/util.c | 29 +++++++++++++ src/core/util.h | 25 +++++++++++ 6 files changed, 169 insertions(+), 163 deletions(-) diff --git a/ffitest/gtk.janet b/ffitest/gtk.janet index e6de3672..529b7921 100644 --- a/ffitest/gtk.janet +++ b/ffitest/gtk.janet @@ -2,10 +2,10 @@ # An even more sophisticated macro wrapper could add # better doc strings, better parameter checking, etc. -(defn defnative-context +(defn ffi-context "Load a dynamic library and set it as the context for following declarations" [location] - (setdyn :raw-native (raw-native location))) + (setdyn :raw-native (ffi/native location))) (defmacro defnative "Declare a native binding" @@ -16,12 +16,12 @@ (def $sig (symbol name "-signature-")) (def $pointer (symbol name "-raw-pointer-")) ~(upscope - (def ,$pointer :private (as-macro ,assert (,native-lookup (,dyn :raw-native) ,raw-symbol))) - (def ,$sig :private (,native-signature :default ,ret-type ,;signature-args)) + (def ,$pointer :private (as-macro ,assert (,ffi/lookup (,dyn :raw-native) ,raw-symbol))) + (def ,$sig :private (,ffi/signature :default ,ret-type ,;signature-args)) (defn ,name [,;defn-args] - (,native-call ,$pointer ,$sig ,;defn-args)))) + (,ffi/call ,$pointer ,$sig ,;defn-args)))) -(defnative-context "/usr/lib/libgtk-3.so") +(ffi-context "/usr/lib/libgtk-3.so") (defnative gtk-application-new :ptr [:ptr :uint]) (defnative g-signal-connect-data :ulong [:ptr :ptr :ptr :ptr :ptr :int]) @@ -38,7 +38,7 @@ # Limitation is that we cannot generate arbitrary closures to pass into apis. # However, any stubs we need we would simply need to compile ourselves, so # Janet includes a common stub out of the box. -(def cb (native-trampoline :default)) +(def cb (ffi/trampoline :default)) (defn on-active [app] diff --git a/ffitest/test.janet b/ffitest/test.janet index bbfd6c09..0ec27735 100644 --- a/ffitest/test.janet +++ b/ffitest/test.janet @@ -1,72 +1,72 @@ -(def native-loc "ffitest/so.so") -(def native-source-loc "ffitest/so.c") +(def ffi/loc "ffitest/so.so") +(def ffi/source-loc "ffitest/so.c") -(os/execute ["cc" native-source-loc "-shared" "-o" native-loc] :px) -(def module (raw-native native-loc)) +(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px) +(def module (ffi/native ffi/loc)) -(def int-fn-sig (native-signature :default :int :int :int)) -(def int-fn-pointer (native-lookup module "int_fn")) +(def int-fn-sig (ffi/signature :default :int :int :int)) +(def int-fn-pointer (ffi/lookup module "int_fn")) (defn int-fn [x y] - (native-call int-fn-pointer int-fn-sig x y)) + (ffi/call int-fn-pointer int-fn-sig x y)) -(def double-fn-sig (native-signature :default :double :double :double :double)) -(def double-fn-pointer (native-lookup module "double_fn")) +(def double-fn-sig (ffi/signature :default :double :double :double :double)) +(def double-fn-pointer (ffi/lookup module "double_fn")) (defn double-fn [x y z] - (native-call double-fn-pointer double-fn-sig x y z)) + (ffi/call double-fn-pointer double-fn-sig x y z)) -(def double-many-sig (native-signature :default :double :double :double :double :double :double :double)) -(def double-many-pointer (native-lookup module "double_many")) +(def double-many-sig (ffi/signature :default :double :double :double :double :double :double :double)) +(def double-many-pointer (ffi/lookup module "double_many")) (defn double-many [x y z w a b] - (native-call double-many-pointer double-many-sig x y z w a b)) + (ffi/call double-many-pointer double-many-sig x y z w a b)) -(def double-lots-sig (native-signature :default :double +(def double-lots-sig (ffi/signature :default :double :double :double :double :double :double :double :double :double :double :double)) -(def double-lots-pointer (native-lookup module "double_lots")) +(def double-lots-pointer (ffi/lookup module "double_lots")) (defn double-lots [a b c d e f g h i j] - (native-call double-lots-pointer double-lots-sig a b c d e f g h i j)) + (ffi/call double-lots-pointer double-lots-sig a b c d e f g h i j)) -(def float-fn-sig (native-signature :default :double :float :float :float)) -(def float-fn-pointer (native-lookup module "float_fn")) +(def float-fn-sig (ffi/signature :default :double :float :float :float)) +(def float-fn-pointer (ffi/lookup module "float_fn")) (defn float-fn [x y z] - (native-call float-fn-pointer float-fn-sig x y z)) + (ffi/call float-fn-pointer float-fn-sig x y z)) -(def intint-fn-sig (native-signature :default :int :double [:int :int])) -(def intint-fn-pointer (native-lookup module "intint_fn")) +(def intint-fn-sig (ffi/signature :default :int :double [:int :int])) +(def intint-fn-pointer (ffi/lookup module "intint_fn")) (defn intint-fn [x ii] - (native-call intint-fn-pointer intint-fn-sig x ii)) + (ffi/call intint-fn-pointer intint-fn-sig x ii)) -(def return-struct-sig (native-signature :default [:int :int] :int)) -(def return-struct-pointer (native-lookup module "return_struct")) +(def return-struct-sig (ffi/signature :default [:int :int] :int)) +(def return-struct-pointer (ffi/lookup module "return_struct")) (defn return-struct-fn [i] - (native-call return-struct-pointer return-struct-sig i)) + (ffi/call return-struct-pointer return-struct-sig i)) -(def intintint (native-struct :int :int :int)) -(def intintint-fn-sig (native-signature :default :int :double intintint)) -(def intintint-fn-pointer (native-lookup module "intintint_fn")) +(def intintint (ffi/struct :int :int :int)) +(def intintint-fn-sig (ffi/signature :default :int :double intintint)) +(def intintint-fn-pointer (ffi/lookup module "intintint_fn")) (defn intintint-fn [x iii] - (native-call intintint-fn-pointer intintint-fn-sig x iii)) + (ffi/call intintint-fn-pointer intintint-fn-sig x iii)) -(def big (native-struct :s64 :s64 :s64)) -(def struct-big-fn-sig (native-signature :default big :int :double)) -(def struct-big-fn-pointer (native-lookup module "struct_big")) +(def big (ffi/struct :s64 :s64 :s64)) +(def struct-big-fn-sig (ffi/signature :default big :int :double)) +(def struct-big-fn-pointer (ffi/lookup module "struct_big")) (defn struct-big-fn [i d] - (native-call struct-big-fn-pointer struct-big-fn-sig i d)) + (ffi/call struct-big-fn-pointer struct-big-fn-sig i d)) -(def void-fn-pointer (native-lookup module "void_fn")) -(def void-fn-sig (native-signature :default :void)) +(def void-fn-pointer (ffi/lookup module "void_fn")) +(def void-fn-sig (ffi/signature :default :void)) (defn void-fn [] - (native-call void-fn-pointer void-fn-sig)) + (ffi/call void-fn-pointer void-fn-sig)) # # Call functions @@ -95,8 +95,8 @@ (defn check-round-trip [t value] - (def buf (native-write t value)) - (def same-value (native-read t buf)) + (def buf (ffi/write t value)) + (def same-value (ffi/read t buf)) (assert (deep= value same-value) (string/format "round trip %j (got %j)" value same-value))) @@ -121,7 +121,7 @@ (check-round-trip :s32 0) (check-round-trip :s32 -1234567) -(def s (native-struct :s8 :s8 :s8 :float)) +(def s (ffi/struct :s8 :s8 :s8 :float)) (check-round-trip s [1 3 5 123.5]) (check-round-trip s [-1 -3 -5 -123.5]) diff --git a/src/core/corelib.c b/src/core/corelib.c index 322b1411..dcde0c45 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -42,64 +42,6 @@ extern size_t janet_core_image_size; #define JDOC(x) NULL #endif -/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries - * with native code. */ -#if defined(JANET_NO_DYNAMIC_MODULES) -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 -typedef HINSTANCE Clib; -#define load_clib(name) LoadLibrary((name)) -#define free_clib(c) FreeLibrary((c)) -#define symbol_clib(lib, sym) GetProcAddress((lib), (sym)) -static char error_clib_buf[256]; -static char *error_clib(void) { - FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, - NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), - error_clib_buf, sizeof(error_clib_buf), NULL); - error_clib_buf[strlen(error_clib_buf) - 1] = '\0'; - return error_clib_buf; -} -#else -#include -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 - -static char *get_processed_name(const char *name) { - if (name[0] == '.') return (char *) name; - const char *c; - for (c = name; *c; c++) { - if (*c == '/') return (char *) name; - } - size_t l = (size_t)(c - name); - char *ret = janet_malloc(l + 3); - if (NULL == ret) { - JANET_OUT_OF_MEMORY; - } - ret[0] = '.'; - ret[1] = '/'; - memcpy(ret + 2, name, l + 1); - return ret; -} - -typedef struct { - Clib clib; - int closed; -} 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); @@ -350,48 +292,6 @@ 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; - anative->closed = 0; - 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); - if (anative->closed) janet_panic("native object already closed"); - void *value = symbol_clib(anative->clib, sym); - if (NULL == value) return janet_wrap_nil(); - 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); - if (anative->closed) janet_panic("native object already closed"); - anative->closed = 1; - 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`. " @@ -1011,9 +911,6 @@ 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), diff --git a/src/core/ffi.c b/src/core/ffi.c index 0e814733..76f0ab88 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -194,6 +194,16 @@ static const JanetAbstractType janet_struct_type = { JANET_ATEND_GCMARK }; +typedef struct { + Clib clib; + int closed; +} JanetAbstractNative; + +static const JanetAbstractType janet_native_type = { + "core/ffi-native", + JANET_ATEND_NAME +}; + static JanetFFIType prim_type(JanetFFIPrimType pt) { JanetFFIType t; t.prim = pt; @@ -352,7 +362,7 @@ static JanetFFIType decode_ffi_type(Janet x) { } JANET_CORE_FN(cfun_ffi_struct, - "(native-struct & types)", + "(ffi/struct & types)", "Create a struct type descriptor that can be used to pass structs into native functions. ") { janet_arity(argc, 1, -1); return janet_wrap_abstract(build_struct_type(argc, argv)); @@ -555,7 +565,7 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) { #endif JANET_CORE_FN(cfun_ffi_signature, - "(native-signature calling-convention ret-type & arg-types)", + "(ffi/signature calling-convention ret-type & arg-types)", "Create a function signature object that can be used to make calls " "with raw function pointers.") { janet_arity(argc, 2, -1); @@ -989,7 +999,7 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe #endif JANET_CORE_FN(cfun_ffi_call, - "(native-call pointer signature & args)", + "(ffi/call pointer signature & args)", "Call a raw pointer as a function pointer. The function signature specifies " "how Janet values in `args` are converted to native machine types.") { janet_arity(argc, 2, -1); @@ -1011,7 +1021,7 @@ JANET_CORE_FN(cfun_ffi_call, } JANET_CORE_FN(cfun_ffi_buffer_write, - "(native-write ffi-type data &opt buffer)", + "(ffi/write ffi-type data &opt buffer)", "Append a native tyep to a buffer such as it would appear in memory. This can be used " "to pass pointers to structs in the ffi, or send C/C++/native structs over the network " "or to files. Returns a modifed buffer or a new buffer if one is not supplied.") { @@ -1028,9 +1038,9 @@ JANET_CORE_FN(cfun_ffi_buffer_write, JANET_CORE_FN(cfun_ffi_buffer_read, - "(native-read ffi-type bytes &opt offset)", + "(ffi/read ffi-type bytes &opt offset)", "Parse a native struct out of a buffer and convert it to normal Janet data structures. " - "This function is the inverse of `native-write`. `bytes` can also be a raw pointer, although " + "This function is the inverse of `ffi/write`. `bytes` can also be a raw pointer, although " "this is unsafe.") { janet_arity(argc, 2, 3); JanetFFIType type = decode_ffi_type(argv[0]); @@ -1047,13 +1057,13 @@ JANET_CORE_FN(cfun_ffi_buffer_read, } JANET_CORE_FN(cfun_ffi_get_callback_trampoline, - "(native-trampoline cc)", + "(ffi/trampoline cc)", "Get a native function pointer that can be used as a callback and passed to C libraries. " "This callback trampoline has the signature `void trampoline(void *ctx, void *userdata)` in " "the given calling convention. This is the only function signature supported. " "It is up to the programmer to ensure that the `userdata` argument contains a janet function " "the will be called with one argument, `ctx` which is an opaque pointer. This pointer can " - "be further inspected with `native-read`.") { + "be further inspected with `ffi/read`.") { janet_arity(argc, 0, 1); JanetFFICallingConvention cc = JANET_FFI_CC_DEFAULT; if (argc >= 1) cc = decode_ffi_cc(janet_getkeyword(argv, 0)); @@ -1070,14 +1080,59 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline, } } +JANET_CORE_FN(janet_core_raw_native, + "(ffi/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; + anative->closed = 0; + return janet_wrap_abstract(anative); +} + +JANET_CORE_FN(janet_core_native_lookup, + "(ffi/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); + if (anative->closed) janet_panic("native object already closed"); + void *value = symbol_clib(anative->clib, sym); + if (NULL == value) return janet_wrap_nil(); + return janet_wrap_pointer(value); +} + +JANET_CORE_FN(janet_core_native_close, + "(ffi/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); + if (anative->closed) janet_panic("native object already closed"); + anative->closed = 1; + free_clib(anative->clib); + return janet_wrap_nil(); +} + void janet_lib_ffi(JanetTable *env) { JanetRegExt ffi_cfuns[] = { - JANET_CORE_REG("native-signature", cfun_ffi_signature), - JANET_CORE_REG("native-call", cfun_ffi_call), - JANET_CORE_REG("native-struct", cfun_ffi_struct), - JANET_CORE_REG("native-write", cfun_ffi_buffer_write), - JANET_CORE_REG("native-read", cfun_ffi_buffer_read), - JANET_CORE_REG("native-trampoline", cfun_ffi_get_callback_trampoline), + JANET_CORE_REG("ffi/native", janet_core_raw_native), + JANET_CORE_REG("ffi/lookup", janet_core_native_lookup), + JANET_CORE_REG("ffi/close", janet_core_native_close), + JANET_CORE_REG("ffi/signature", cfun_ffi_signature), + JANET_CORE_REG("ffi/call", cfun_ffi_call), + JANET_CORE_REG("ffi/struct", cfun_ffi_struct), + JANET_CORE_REG("ffi/write", cfun_ffi_buffer_write), + JANET_CORE_REG("ffi/read", cfun_ffi_buffer_read), + JANET_CORE_REG("ffi/trampoline", cfun_ffi_get_callback_trampoline), JANET_REG_END }; janet_core_cfuns_ext(env, NULL, ffi_cfuns); diff --git a/src/core/util.c b/src/core/util.c index c4cea1dd..7568299f 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -884,6 +884,35 @@ int janet_cryptorand(uint8_t *out, size_t n) { #endif } +/* Dynamic library loading */ + +char *get_processed_name(const char *name) { + if (name[0] == '.') return (char *) name; + const char *c; + for (c = name; *c; c++) { + if (*c == '/') return (char *) name; + } + size_t l = (size_t)(c - name); + char *ret = janet_malloc(l + 3); + if (NULL == ret) { + JANET_OUT_OF_MEMORY; + } + ret[0] = '.'; + ret[1] = '/'; + memcpy(ret + 2, name, l + 1); + return ret; +} + +#if defined(JANET_WINDOWS) +static char error_clib_buf[256]; +char *error_clib(void) { + FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + error_clib_buf, sizeof(error_clib_buf), NULL); + error_clib_buf[strlen(error_clib_buf) - 1] = '\0'; + return error_clib_buf; +} +#endif /* Alloc function macro fills */ void *(janet_malloc)(size_t size) { diff --git a/src/core/util.h b/src/core/util.h index 012a0677..3ac3e449 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -127,6 +127,31 @@ int janet_gettime(struct timespec *spec); #define strdup(x) _strdup(x) #endif +/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries + * with native code. */ +#if defined(JANET_NO_DYNAMIC_MODULES) +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 +typedef HINSTANCE Clib; +#define load_clib(name) LoadLibrary((name)) +#define free_clib(c) FreeLibrary((c)) +#define symbol_clib(lib, sym) GetProcAddress((lib), (sym)) +char *error_clib(void); +#else +#include +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 +char *get_processed_name(const char *name); + #define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR) /* Initialize builtin libraries */ From c9586d39ed5bd327af7192a2e08df519f9929f9a Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Jun 2022 10:12:45 -0500 Subject: [PATCH 43/89] Add a :none calling convention. The ffi module is useful even when true ffi calls are not yet implemented. This lets the ffi be enabled on any architecture, albeit with a degraded feature set where calling conventions are not implemented. --- src/core/ffi.c | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 76f0ab88..68f89e06 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -34,7 +34,9 @@ #define JANET_FFI_MAX_RECUR 64 -/* Compiler, OS, and arch detection */ +/* Compiler, OS, and arch detection. Used + * to enable a set of calling conventions. The + * :none calling convention is always enabled. */ #if defined(JANET_WINDOWS) && (defined(__x86_64__) || defined(_M_X64)) #define JANET_FFI_WIN64_ENABLED #endif @@ -133,14 +135,17 @@ typedef struct { } JanetFFIMapping; typedef enum { + JANET_FFI_CC_NONE, JANET_FFI_CC_SYSV_64, JANET_FFI_CC_WIN_64 } JanetFFICallingConvention; -#ifdef JANET_WINDOWS +#ifdef JANET_FFI_WIN64_ENABLED #define JANET_FFI_CC_DEFAULT JANET_FFI_CC_WIN_64 -#else +#elif defined(JANET_FFI_SYSV64_ENABLED) #define JANET_FFI_CC_DEFAULT JANET_FFI_CC_SYSV_64 +#else +#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_NONE #endif #define JANET_FFI_MAX_ARGS 32 @@ -228,7 +233,13 @@ static size_t type_align(JanetFFIType t) { } static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) { + if (!janet_cstrcmp(name, "none")) return JANET_FFI_CC_NONE; +#ifdef JANET_FFI_WIN64_ENABLED + if (!janet_cstrcmp(name, "win64")) return JANET_FFI_CC_WIN_64; +#endif +#ifdef JANET_FFI_SYSV64_ENABLED if (!janet_cstrcmp(name, "sysv64")) return JANET_FFI_CC_SYSV_64; +#endif if (!janet_cstrcmp(name, "default")) return JANET_FFI_CC_DEFAULT; janet_panicf("unknown calling convention %s", name); } @@ -585,8 +596,14 @@ JANET_CORE_FN(cfun_ffi_signature, for (int i = 0; i < JANET_FFI_MAX_ARGS; i++) mappings[i] = void_mapping(); switch (cc) { default: - janet_panicf("calling convention %v unsupported", argv[0]); - break; + case JANET_FFI_CC_NONE: { + /* Even if unsupported, we can check that the signature is valid + * and error at runtime */ + for (uint32_t i = 0; i < arg_count; i++) { + decode_ffi_type(argv[i + 2]); + } + } + break; #ifdef JANET_FFI_WIN64_ENABLED case JANET_FFI_CC_WIN_64: { @@ -1008,7 +1025,8 @@ JANET_CORE_FN(cfun_ffi_call, janet_fixarity(argc - 2, signature->arg_count); switch (signature->cc) { default: - janet_panic("unsupported calling convention"); + case JANET_FFI_CC_NONE: + janet_panic("calling convention not supported"); #ifdef JANET_FFI_WIN64_ENABLED case JANET_FFI_CC_WIN_64: return janet_ffi_win64(signature, function_pointer, argv); @@ -1069,6 +1087,8 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline, if (argc >= 1) cc = decode_ffi_cc(janet_getkeyword(argv, 0)); switch (cc) { default: + case JANET_FFI_CC_NONE: + janet_panic("calling convention not supported"); #ifdef JANET_FFI_WIN64_ENABLED case JANET_FFI_CC_WIN_64: return janet_wrap_pointer(janet_ffi_win64_standard_callback); From 299998055dbb99dcc1b3b598103f93ea885a9979 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Jun 2022 10:15:36 -0500 Subject: [PATCH 44/89] Update meson min build to turn off ffi. --- .builds/openbsd.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.builds/openbsd.yml b/.builds/openbsd.yml index c55cd119..a83bdea2 100644 --- a/.builds/openbsd.yml +++ b/.builds/openbsd.yml @@ -13,7 +13,7 @@ tasks: gmake test-install - meson_min: | cd janet - meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true + meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true -Dffi=false cd build_meson_min ninja - meson_prf: | From a45ef7a856b2b6265098dc617450bb21784b5512 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Jun 2022 10:17:25 -0500 Subject: [PATCH 45/89] Update CHANGELOG to reflect new function renames. --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 08dc6766..71f1eb89 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,12 +2,12 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Add `ffi/` module for interfacing with dynamic libraries and raw function pointers. - Add `debugger` - an easy to use debugger function that just takes a fiber. - `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set. - Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on abnormal fiber signals. - Allow running scripts with the `-d` flag to use the built-in debugger on errors and breakpoints. -- Add `raw-native`, `native-lookup`, and `native-close` for interfacing with dynamic libraries. - Add mutexes (locks) and reader-writer locks to ev module for thread coordination. - Add `parse-all` as a generalization of the `parse` function. - Add `os/cpu-count` to get the number of available processors on a machine From 3af7d61d3ebda03d8c2eedc0f9fe6af1c6edcf67 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Jun 2022 12:51:06 -0500 Subject: [PATCH 46/89] Update gtk example. --- ffitest/gtk.janet | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ffitest/gtk.janet b/ffitest/gtk.janet index 529b7921..a2e86d53 100644 --- a/ffitest/gtk.janet +++ b/ffitest/gtk.janet @@ -5,7 +5,7 @@ (defn ffi-context "Load a dynamic library and set it as the context for following declarations" [location] - (setdyn :raw-native (ffi/native location))) + (setdyn :ffi-context (ffi/native location))) (defmacro defnative "Declare a native binding" @@ -16,7 +16,7 @@ (def $sig (symbol name "-signature-")) (def $pointer (symbol name "-raw-pointer-")) ~(upscope - (def ,$pointer :private (as-macro ,assert (,ffi/lookup (,dyn :raw-native) ,raw-symbol))) + (def ,$pointer :private (as-macro ,assert (,ffi/lookup (,dyn :ffi-context) ,raw-symbol))) (def ,$sig :private (,ffi/signature :default ,ret-type ,;signature-args)) (defn ,name [,;defn-args] (,ffi/call ,$pointer ,$sig ,;defn-args)))) From 87fc339c456e072fd33136722e919312ce146bf0 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Jun 2022 13:50:17 -0500 Subject: [PATCH 47/89] Add named arguments with the &named symbol. Similar to &keys, but more ergonomic. --- CHANGELOG.md | 3 ++ src/core/asm.c | 10 ++++ src/core/specials.c | 109 +++++++++++++++++++++++++++++-------------- test/suite0011.janet | 7 +++ 4 files changed, 93 insertions(+), 36 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 08dc6766..26646975 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,9 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? +- Allow using `&named` in function prototypes for named arguments. This is a more ergonomic + variant of `&keys` that isn't as redundant, more self documenting, and allows extension to + things like default arguments. - Add `debugger` - an easy to use debugger function that just takes a fiber. - `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set. - Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on diff --git a/src/core/asm.c b/src/core/asm.c index b82389fd..95785e48 100644 --- a/src/core/asm.c +++ b/src/core/asm.c @@ -553,6 +553,10 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int x = janet_get1(s, janet_ckeywordv("vararg")); if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG; + /* Check structarg */ + x = janet_get1(s, janet_ckeywordv("structarg")); + if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG; + /* Check source */ x = janet_get1(s, janet_ckeywordv("source")); if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x); @@ -884,6 +888,10 @@ static Janet janet_disasm_vararg(JanetFuncDef *def) { return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG); } +static Janet janet_disasm_structarg(JanetFuncDef *def) { + return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG); +} + static Janet janet_disasm_constants(JanetFuncDef *def) { JanetArray *constants = janet_array(def->constants_length); for (int32_t i = 0; i < def->constants_length; i++) { @@ -933,6 +941,7 @@ Janet janet_disasm(JanetFuncDef *def) { janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def)); janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def)); janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def)); + janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def)); janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def)); janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def)); janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def)); @@ -986,6 +995,7 @@ JANET_CORE_FN(cfun_disasm, if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def); if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def); if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def); + if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def); if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def); if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def); if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def); diff --git a/src/core/specials.c b/src/core/specials.c index 6a56ff9d..1f91c3db 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -822,6 +822,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { int selfref = 0; int seenamp = 0; int seenopt = 0; + int namedargs = 0; /* Begin function */ c->scope->flags |= JANET_SCOPE_CLOSURE; @@ -846,6 +847,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { /* Keep track of destructured parameters */ JanetSlot *destructed_params = NULL; + JanetSlot *named_params = NULL; + JanetTable *named_table = NULL; + JanetSlot named_slot; /* Compile function parameters */ params = janet_unwrap_tuple(argv[parami]); @@ -853,49 +857,74 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { arity = paramcount; for (i = 0; i < paramcount; i++) { Janet param = params[i]; - if (janet_checktype(param, JANET_SYMBOL)) { + if (namedargs) { + if (!janet_checktype(param, JANET_SYMBOL)) { + errmsg = "only named arguments can follow &named"; + goto error; + } + Janet key = janet_wrap_keyword(janet_unwrap_symbol(param)); + janet_table_put(named_table, key, param); + janet_v_push(named_params, janetc_farslot(c)); + } else if (janet_checktype(param, JANET_SYMBOL)) { /* Check for varargs and unfixed arity */ - if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) { - if (seenamp) { - errmsg = "& in unexpected location"; - goto error; - } else if (i == paramcount - 1) { - allow_extra = 1; + const uint8_t *sym = janet_unwrap_symbol(param); + if (sym[0] == '&') { + if (!janet_cstrcmp(sym, "&")) { + if (seenamp) { + errmsg = "& in unexpected location"; + goto error; + } else if (i == paramcount - 1) { + allow_extra = 1; + arity--; + } else if (i == paramcount - 2) { + vararg = 1; + arity -= 2; + } else { + errmsg = "& in unexpected location"; + goto error; + } + seenamp = 1; + } else if (!janet_cstrcmp(sym, "&opt")) { + if (seenopt) { + errmsg = "only one &opt allowed"; + goto error; + } else if (i == paramcount - 1) { + errmsg = "&opt cannot be last item in parameter list"; + goto error; + } + min_arity = i; arity--; - } else if (i == paramcount - 2) { - vararg = 1; - arity -= 2; - } else { - errmsg = "& in unexpected location"; - goto error; - } - seenamp = 1; - } else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) { - if (seenopt) { - errmsg = "only one &opt allowed"; - goto error; - } else if (i == paramcount - 1) { - errmsg = "&opt cannot be last item in parameter list"; - goto error; - } - min_arity = i; - arity--; - seenopt = 1; - } else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) { - if (seenamp) { - errmsg = "&keys in unexpected location"; - goto error; - } else if (i == paramcount - 2) { + seenopt = 1; + } else if (!janet_cstrcmp(sym, "&keys")) { + if (seenamp) { + errmsg = "&keys in unexpected location"; + goto error; + } else if (i == paramcount - 2) { + vararg = 1; + structarg = 1; + arity -= 2; + } else { + errmsg = "&keys in unexpected location"; + goto error; + } + seenamp = 1; + } else if (!janet_cstrcmp(sym, "&named")) { + if (seenamp) { + errmsg = "&named in unexpected location"; + goto error; + } vararg = 1; structarg = 1; - arity -= 2; + arity = i; + seenamp = 1; + namedargs = 1; + named_table = janet_table(10); + named_slot = janetc_farslot(c); } else { - errmsg = "&keys in unexpected location"; - goto error; + janetc_nameslot(c, sym, janetc_farslot(c)); } - seenamp = 1; } else { - janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c)); + janetc_nameslot(c, sym, janetc_farslot(c)); } } else { janet_v_push(destructed_params, janetc_farslot(c)); @@ -914,6 +943,14 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { } janet_v_free(destructed_params); + /* Compile named arguments */ + if (namedargs) { + Janet param = janet_wrap_table(named_table); + destructure(c, param, named_slot, defleaf, NULL); + janetc_freeslot(c, named_slot); + janet_v_free(named_params); + } + max_arity = (vararg || allow_extra) ? INT32_MAX : arity; if (!seenopt) min_arity = arity; diff --git a/test/suite0011.janet b/test/suite0011.janet index 34dd6c34..e2a96fbf 100644 --- a/test/suite0011.janet +++ b/test/suite0011.janet @@ -80,5 +80,12 @@ "table rawget regression" (table/new -1)) +# Named arguments +(defn named-arguments + [&named bob sally joe] + (+ bob sally joe)) + +(assert (= 15 (named-arguments :bob 3 :sally 5 :joe 7)) "named arguments 1") + (end-suite) From ad1b50d1f53893c16a1a9fe93ff91c1ff596c25c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Jun 2022 18:03:23 -0500 Subject: [PATCH 48/89] Update dofile function signature. --- src/boot/boot.janet | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 2ffd34a0..0b28cc91 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -2803,14 +2803,7 @@ :source, :evaluator, :read, and :parser are passed through to the underlying `run-context` call. If `exit` is true, any top level errors will trigger a call to `(os/exit 1)` after printing the error.`` - [path &keys - {:exit exit - :env env - :source src - :expander expander - :evaluator evaluator - :read read - :parser parser}] + [path &named exit env source expander evaluator read parser] (def f (case (type path) :core/file path :core/stream path @@ -2818,7 +2811,7 @@ (def path-is-file (= f path)) (default env (make-env)) (def spath (string path)) - (put env :source (or src (if-not path-is-file spath path))) + (put env :source (or source (if-not path-is-file spath path))) (var exit-error nil) (var exit-fiber nil) (defn chunks [buf _] (:read f 4096 buf)) @@ -2864,7 +2857,7 @@ :expander expander :read read :parser parser - :source (or src (if path-is-file : spath))})) + :source (or source (if path-is-file : spath))})) (if-not path-is-file (:close f)) (when exit-error (if exit-fiber From 105ba5e12466b0864b8f8fc64fcf7f89f96a2383 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 12 Jun 2022 18:48:47 -0500 Subject: [PATCH 49/89] Add ffi/context and ffi/defbind helpers. Wrap the very bare-bones FFI library to be a bit more useful out of the box. --- ffitest/gtknew.janet | 52 ++++++++++++++++++++++++++++++++++++++++++++ src/boot/boot.janet | 40 ++++++++++++++++++++++++++++++++++ 2 files changed, 92 insertions(+) create mode 100644 ffitest/gtknew.janet diff --git a/ffitest/gtknew.janet b/ffitest/gtknew.janet new file mode 100644 index 00000000..358d4f35 --- /dev/null +++ b/ffitest/gtknew.janet @@ -0,0 +1,52 @@ +(ffi/context "/usr/lib/libgtk-3.so") + +(ffi/defbind + gtk-application-new :ptr + "Add docstrings as needed." + [a :ptr b :uint]) + +(ffi/defbind + g-signal-connect-data :ulong + [a :ptr b :ptr c :ptr d :ptr e :ptr f :int]) + +(ffi/defbind + g-application-run :int + [a :ptr b :int c :ptr]) + +(ffi/defbind + gtk-application-window-new :ptr + [a :ptr]) + +(ffi/defbind + gtk-button-new-with-label :ptr + [a :ptr]) + +(ffi/defbind + gtk-container-add :void + [a :ptr b :ptr]) + +(ffi/defbind + gtk-widget-show-all :void + [a :ptr]) + +(ffi/defbind + gtk-button-set-label :void + [a :ptr b :ptr]) + +(def cb (ffi/trampoline :default)) + +(defn on-active + [app] + (def window (gtk-application-window-new app)) + (def btn (gtk-button-new-with-label "Click Me!")) + (g-signal-connect-data btn "clicked" cb + (fn [btn] (gtk-button-set-label btn "Hello World")) + nil 1) + (gtk-container-add window btn) + (gtk-widget-show-all window)) + +(defn main + [&] + (def app (gtk-application-new "org.janet-lang.example.HelloApp" 0)) + (g-signal-connect-data app "activate" cb on-active nil 1) + (g-application-run app 0 nil)) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 0b28cc91..e886746b 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3608,6 +3608,46 @@ (ev/call (fn [] (net/accept-loop s handler)))) s)) +### +### +### FFI Extra +### +### + +(compwhen (dyn 'ffi/native) + + (defdyn *ffi-context*" Current native library for ffi/bind and other settings") + + (defn- default-mangle + [name &] + (string/replace-all "-" "_" name)) + + (defn ffi/context + "Set the path of the dynamic library to implictly bind, as well + as other global state for ease of creating native bindings." + [native-path &named map-symbols] + (def lib (ffi/native native-path)) + (default map-symbols default-mangle) + (setdyn *ffi-context* + {:native lib + :map-symbols map-symbols})) + + (defmacro ffi/defbind + "Generate bindings for native functions in a convenient manner." + [name ret-type & body] + (def meta (slice body 0 -2)) + (def arg-pairs (partition 2 (last body))) + (def formal-args (map 0 arg-pairs)) + (def type-args (map 1 arg-pairs)) + (def ctx (dyn *ffi-context*)) + (def raw-symbol ((get ctx :map-symbols default-mangle) name)) + (def ffi-mod (get ctx :native)) + (def ptr (assert (ffi/lookup ffi-mod raw-symbol) "failed to find symbol")) + (def computed-type-args (eval ~[,;type-args])) + (def sig (ffi/signature :default ret-type ;computed-type-args)) + ~(defn ,name ,;meta [,;formal-args] + (,ffi/call ,ptr ,sig ,;formal-args)))) + ### ### ### Flychecking From 80729353c8b0983e0d498ece1b4e9b804f1fc705 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 13 Jun 2022 21:26:03 -0500 Subject: [PATCH 50/89] Add :lazy option for ffi/context for jpm quickbin usage. --- ffitest/gtknew.janet | 12 ++++++--- src/boot/boot.janet | 59 +++++++++++++++++++++++++++++++++++--------- 2 files changed, 55 insertions(+), 16 deletions(-) diff --git a/ffitest/gtknew.janet b/ffitest/gtknew.janet index 358d4f35..57113ab9 100644 --- a/ffitest/gtknew.janet +++ b/ffitest/gtknew.janet @@ -1,4 +1,8 @@ -(ffi/context "/usr/lib/libgtk-3.so") +# :lazy true needed for jpm quickbin +# lazily loads library on first function use +# so the `main` function +# can be marshalled. +(ffi/context "/usr/lib/libgtk-3.so" :lazy true) (ffi/defbind gtk-application-new :ptr @@ -33,13 +37,13 @@ gtk-button-set-label :void [a :ptr b :ptr]) -(def cb (ffi/trampoline :default)) +(def cb (delay (ffi/trampoline :default))) (defn on-active [app] (def window (gtk-application-window-new app)) (def btn (gtk-button-new-with-label "Click Me!")) - (g-signal-connect-data btn "clicked" cb + (g-signal-connect-data btn "clicked" (cb) (fn [btn] (gtk-button-set-label btn "Hello World")) nil 1) (gtk-container-add window btn) @@ -48,5 +52,5 @@ (defn main [&] (def app (gtk-application-new "org.janet-lang.example.HelloApp" 0)) - (g-signal-connect-data app "activate" cb on-active nil 1) + (g-signal-connect-data app "activate" (cb) on-active nil 1) (g-application-run app 0 nil)) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index e886746b..e3a5d2b5 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3614,9 +3614,26 @@ ### ### +(defmacro delay + "Lazily evaluate a series of expressions. Returns a function that + returns the result of the last expression. Will only evaluate the + body once, and then memoizes the result." + [& forms] + (def state (gensym)) + (def loaded (gensym)) + ~((fn [] + (var ,state nil) + (var ,loaded nil) + (fn [] + (if ,loaded + ,state + (do + (set ,loaded true) + (set ,state (do ,;forms)))))))) + (compwhen (dyn 'ffi/native) - (defdyn *ffi-context*" Current native library for ffi/bind and other settings") + (defdyn *ffi-context* " Current native library for ffi/bind and other settings") (defn- default-mangle [name &] @@ -3625,12 +3642,16 @@ (defn ffi/context "Set the path of the dynamic library to implictly bind, as well as other global state for ease of creating native bindings." - [native-path &named map-symbols] - (def lib (ffi/native native-path)) + [native-path &named map-symbols lazy] (default map-symbols default-mangle) + (def lib (if lazy nil (ffi/native native-path))) + (def lazy-lib (if lazy (delay (ffi/native native-path)))) (setdyn *ffi-context* - {:native lib - :map-symbols map-symbols})) + @{:native-path native-path + :native lib + :native-lazy lazy-lib + :lazy lazy + :map-symbols map-symbols})) (defmacro ffi/defbind "Generate bindings for native functions in a convenient manner." @@ -3639,14 +3660,28 @@ (def arg-pairs (partition 2 (last body))) (def formal-args (map 0 arg-pairs)) (def type-args (map 1 arg-pairs)) - (def ctx (dyn *ffi-context*)) - (def raw-symbol ((get ctx :map-symbols default-mangle) name)) - (def ffi-mod (get ctx :native)) - (def ptr (assert (ffi/lookup ffi-mod raw-symbol) "failed to find symbol")) (def computed-type-args (eval ~[,;type-args])) - (def sig (ffi/signature :default ret-type ;computed-type-args)) - ~(defn ,name ,;meta [,;formal-args] - (,ffi/call ,ptr ,sig ,;formal-args)))) + (def {:native lib + :native-path np + :lazy lazy + :native-lazy llib + :map-symbols ms} (assert (dyn *ffi-context*) "no ffi context found")) + (def raw-symbol (ms name)) + (if lazy + (let [ptr + (delay + (assert (ffi/lookup (llib) raw-symbol) "failed to find symbol")) + sig + (delay + (ffi/signature :default ret-type ;computed-type-args))] + ~(defn ,name ,;meta [,;formal-args] + (,ffi/call (,ptr) (,sig) ,;formal-args))) + (let [ptr + (assert (ffi/lookup lib raw-symbol) "failed to find symbol") + sig + (ffi/signature :default ret-type ;computed-type-args)] + ~(defn ,name ,;meta [,;formal-args] + (,ffi/call ,ptr ,sig ,;formal-args)))))) ### ### From 62fc55fc7485783ee7af6f62567065f38af1972c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 17 Jun 2022 17:13:58 -0500 Subject: [PATCH 51/89] Remove pthread.h from janet.h Should make janet a bit easier to use. Also changes the header to not expose the size of native mutexes and rwlocks, except with janet_os_mutex_size and janet_os_rwlock_size. --- src/boot/boot.janet | 1 + src/core/abstract.c | 37 ++++++++++++++++++++-------- src/core/ev.c | 60 ++++++++++++++++++++------------------------- src/core/pp.c | 5 ++-- src/core/util.h | 4 +++ src/include/janet.h | 47 ++++++++--------------------------- 6 files changed, 72 insertions(+), 82 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index e3a5d2b5..cef6b613 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -45,6 +45,7 @@ (defn defmacro :macro "Define a macro." [name & more] + (setdyn name @{}) # override old macro definitions in the case of a recursive macro (apply defn name :macro more)) (defmacro as-macro diff --git a/src/core/abstract.c b/src/core/abstract.c index ba2e0cf5..1e218efb 100644 --- a/src/core/abstract.c +++ b/src/core/abstract.c @@ -23,6 +23,7 @@ #ifndef JANET_AMALG #include "features.h" #include +#include "util.h" #include "gc.h" #include "state.h" #ifdef JANET_EV @@ -85,6 +86,14 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) { #ifdef JANET_WINDOWS +void janet_os_mutex_size(void) { + return sizeof(CRITICAL_SECTION); +} + +void janet_os_rwlock_size(void) { + return sizeof(SRWLock); +} + static int32_t janet_incref(JanetAbstractHead *ab) { return InterlockedIncrement(&ab->gc.data.refcount); } @@ -137,6 +146,14 @@ void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) { #else +size_t janet_os_mutex_size(void) { + return sizeof(pthread_mutex_t); +} + +size_t janet_os_rwlock_size(void) { + return sizeof(pthread_rwlock_t); +} + static int32_t janet_incref(JanetAbstractHead *ab) { return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED); } @@ -149,44 +166,44 @@ void janet_os_mutex_init(JanetOSMutex *mutex) { pthread_mutexattr_t attr; pthread_mutexattr_init(&attr); pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); - pthread_mutex_init(mutex, &attr); + pthread_mutex_init((pthread_mutex_t *) mutex, &attr); } void janet_os_mutex_deinit(JanetOSMutex *mutex) { - pthread_mutex_destroy(mutex); + pthread_mutex_destroy((pthread_mutex_t *) mutex); } void janet_os_mutex_lock(JanetOSMutex *mutex) { - pthread_mutex_lock(mutex); + pthread_mutex_lock((pthread_mutex_t *) mutex); } void janet_os_mutex_unlock(JanetOSMutex *mutex) { - int ret = pthread_mutex_unlock(mutex); + int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex); if (ret) janet_panic("cannot release lock"); } void janet_os_rwlock_init(JanetOSRWLock *rwlock) { - pthread_rwlock_init(rwlock, NULL); + pthread_rwlock_init((pthread_rwlock_t *) rwlock, NULL); } void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) { - pthread_rwlock_destroy(rwlock); + pthread_rwlock_destroy((pthread_rwlock_t *) rwlock); } void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) { - pthread_rwlock_rdlock(rwlock); + pthread_rwlock_rdlock((pthread_rwlock_t *) rwlock); } void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) { - pthread_rwlock_wrlock(rwlock); + pthread_rwlock_wrlock((pthread_rwlock_t *) rwlock); } void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) { - pthread_rwlock_unlock(rwlock); + pthread_rwlock_unlock((pthread_rwlock_t *) rwlock); } void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) { - pthread_rwlock_unlock(rwlock); + pthread_rwlock_unlock((pthread_rwlock_t *) rwlock); } #endif diff --git a/src/core/ev.c b/src/core/ev.c index 00a1eb29..6e41131e 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -79,7 +79,11 @@ typedef struct { int32_t limit; int closed; int is_threaded; - JanetOSMutex lock; +#ifdef JANET_WINDOWS + CRITICAL_SECTION lock; +#else + pthread_mutex_t lock; +#endif } JanetChannel; typedef struct { @@ -643,7 +647,7 @@ static void janet_chan_init(JanetChannel *chan, int32_t limit, int threaded) { janet_q_init(&chan->items); janet_q_init(&chan->read_pending); janet_q_init(&chan->write_pending); - janet_os_mutex_init(&chan->lock); + janet_os_mutex_init((JanetOSMutex *) &chan->lock); } static void janet_chan_deinit(JanetChannel *chan) { @@ -656,17 +660,17 @@ static void janet_chan_deinit(JanetChannel *chan) { } } janet_q_deinit(&chan->items); - janet_os_mutex_deinit(&chan->lock); + janet_os_mutex_deinit((JanetOSMutex *) &chan->lock); } static void janet_chan_lock(JanetChannel *chan) { if (!janet_chan_is_threaded(chan)) return; - janet_os_mutex_lock(&chan->lock); + janet_os_mutex_lock((JanetOSMutex *) &chan->lock); } static void janet_chan_unlock(JanetChannel *chan) { if (!janet_chan_is_threaded(chan)) return; - janet_os_mutex_unlock(&chan->lock); + janet_os_mutex_unlock((JanetOSMutex *) &chan->lock); } /* @@ -3013,14 +3017,9 @@ JANET_CORE_FN(janet_cfun_stream_write, janet_await(); } -typedef struct { - JanetOSMutex mutex; -} JanetAbstractMutex; - static int mutexgc(void *p, size_t size) { - JanetAbstractMutex *mutex = (JanetAbstractMutex *) p; (void) size; - janet_os_mutex_deinit(&mutex->mutex); + janet_os_mutex_deinit(p); return 0; } @@ -3035,8 +3034,8 @@ JANET_CORE_FN(janet_cfun_mutex, "Create a new lock to coordinate threads.") { janet_fixarity(argc, 0); (void) argv; - JanetAbstractMutex *mutex = janet_abstract_threaded(&janet_mutex_type, sizeof(JanetAbstractMutex)); - janet_os_mutex_init(&mutex->mutex); + void *mutex = janet_abstract_threaded(&janet_mutex_type, janet_os_mutex_size()); + janet_os_mutex_init(mutex); return janet_wrap_abstract(mutex); } @@ -3046,8 +3045,8 @@ JANET_CORE_FN(janet_cfun_mutex_acquire, " 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); + void *mutex = janet_getabstract(argv, 0, &janet_mutex_type); + janet_os_mutex_lock(mutex); return argv[0]; } @@ -3055,19 +3054,14 @@ JANET_CORE_FN(janet_cfun_mutex_release, "(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); + void *mutex = janet_getabstract(argv, 0, &janet_mutex_type); + janet_os_mutex_unlock(mutex); return argv[0]; } -typedef struct { - JanetOSRWLock rwlock; -} JanetAbstractRWLock; - static int rwlockgc(void *p, size_t size) { - JanetAbstractRWLock *rwlock = (JanetAbstractRWLock *) p; (void) size; - janet_os_rwlock_deinit(&rwlock->rwlock); + janet_os_rwlock_deinit(p); return 0; } @@ -3082,8 +3076,8 @@ JANET_CORE_FN(janet_cfun_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)); - janet_os_rwlock_init(&rwlock->rwlock); + void *rwlock = janet_abstract_threaded(&janet_rwlock_type, janet_os_rwlock_size()); + janet_os_rwlock_init(rwlock); return janet_wrap_abstract(rwlock); } @@ -3091,8 +3085,8 @@ JANET_CORE_FN(janet_cfun_rwlock_read_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); + void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type); + janet_os_rwlock_rlock(rwlock); return argv[0]; } @@ -3100,8 +3094,8 @@ JANET_CORE_FN(janet_cfun_rwlock_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); + void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type); + janet_os_rwlock_wlock(rwlock); return argv[0]; } @@ -3109,8 +3103,8 @@ JANET_CORE_FN(janet_cfun_rwlock_read_release, "(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); + void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type); + janet_os_rwlock_runlock(rwlock); return argv[0]; } @@ -3118,8 +3112,8 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release, "(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); + void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type); + janet_os_rwlock_wunlock(rwlock); return argv[0]; } diff --git a/src/core/pp.c b/src/core/pp.c index ff3f0c85..1a7ad6a1 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -983,8 +983,9 @@ void janet_buffer_format( break; } case 's': { - const uint8_t *s = janet_getstring(argv, arg); - int32_t l = janet_string_length(s); + JanetByteView bytes = janet_getbytes(argv, arg); + const uint8_t *s = bytes.bytes; + int32_t l = bytes.len; if (form[2] == '\0') janet_buffer_push_bytes(b, s, l); else { diff --git a/src/core/util.h b/src/core/util.h index 3ac3e449..f42a3c84 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -34,6 +34,10 @@ #include #include +#ifdef JANET_EV +#include +#endif + #ifndef _MSC_VER #include #endif diff --git a/src/include/janet.h b/src/include/janet.h index 9f93ddb5..28d9c360 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -307,22 +307,10 @@ typedef struct { JANET_CURRENT_CONFIG_BITS }) #endif -/* Feature include for pthreads. Most feature detection code should go in - * features.h instead. */ -#ifndef JANET_WINDOWS -#ifndef _XOPEN_SOURCE -#define _XOPEN_SOURCE 600 -#endif -#if _XOPEN_SOURCE < 600 -#undef _XOPEN_SOURCE -#define _XOPEN_SOURCE 600 -#endif -#endif - -/* What to do when out of memory */ -#ifndef JANET_OUT_OF_MEMORY -#include -#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0) +/* Some extra includes if EV is enabled */ +#ifdef JANET_EV +typedef struct JanetOSMutex JanetOSMutex; +typedef struct JanetOSRWLock JanetOSRWLock; #endif /***** END SECTION CONFIG *****/ @@ -342,27 +330,10 @@ typedef struct { #include #include -/* Some extra includes if EV is enabled */ -#ifdef JANET_EV -#ifdef JANET_WINDOWS -typedef struct JanetDudCriticalSection { - /* Avoid including windows.h here - instead, create a structure of the same size */ - /* Needs to be same size as crtical section see WinNT.h for CRITCIAL_SECTION definition */ - void *debug_info; - long lock_count; - long recursion_count; - void *owning_thread; - void *lock_semaphore; - unsigned long spin_count; -} JanetOSMutex; -typedef struct JanetDudRWLock { - void *ptr; -} JanetOSRWLock; -#else -#include -typedef pthread_mutex_t JanetOSMutex; -typedef pthread_rwlock_t JanetOSRWLock; -#endif + +/* What to do when out of memory */ +#ifndef JANET_OUT_OF_MEMORY +#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0) #endif #ifdef JANET_BSD @@ -1394,6 +1365,8 @@ JANET_API int32_t janet_abstract_incref(void *abst); JANET_API int32_t janet_abstract_decref(void *abst); /* Expose some OS sync primitives */ +JANET_API size_t janet_os_mutex_size(void); +JANET_API size_t janet_os_rwlock_size(void); JANET_API void janet_os_mutex_init(JanetOSMutex *mutex); JANET_API void janet_os_mutex_deinit(JanetOSMutex *mutex); JANET_API void janet_os_mutex_lock(JanetOSMutex *mutex); From 40e943027866f4bc126d0a57a15014a50644f665 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 17 Jun 2022 17:24:52 -0500 Subject: [PATCH 52/89] Move examples to example directory. --- CHANGELOG.md | 4 +- Makefile | 5 +- .../gtknew.janet => examples/ffi/gtk.janet | 0 {ffitest => examples/ffi}/so.c | 0 {ffitest => examples/ffi}/test.janet | 0 ffitest/gtk.janet | 57 ------------------- 6 files changed, 4 insertions(+), 62 deletions(-) rename ffitest/gtknew.janet => examples/ffi/gtk.janet (100%) rename {ffitest => examples/ffi}/so.c (100%) rename {ffitest => examples/ffi}/test.janet (100%) delete mode 100644 ffitest/gtk.janet diff --git a/CHANGELOG.md b/CHANGELOG.md index 36476676..d7742bd1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,10 +2,12 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? -- Add `ffi/` module for interfacing with dynamic libraries and raw function pointers. +- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. - Allow using `&named` in function prototypes for named arguments. This is a more ergonomic variant of `&keys` that isn't as redundant, more self documenting, and allows extension to things like default arguments. +- Add `delay` macro for lazy evaluate-and-save thunks. +- Remove pthread.h from janet.h for easier includes. - Add `debugger` - an easy to use debugger function that just takes a fiber. - `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set. - Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on diff --git a/Makefile b/Makefile index ad562ee7..dd8e0f25 100644 --- a/Makefile +++ b/Makefile @@ -227,9 +227,6 @@ valtest: $(JANET_TARGET) $(TEST_PROGRAMS) callgrind: $(JANET_TARGET) for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done -ffitest: $(JANET_TARGET) - $(JANET_TARGET) ffitest/test.janet - ######################## ##### Distribution ##### ######################## @@ -370,5 +367,5 @@ help: @echo ' make grammar Generate a TextMate language grammar' @echo -.PHONY: clean install repl debug valgrind test ffitest \ +.PHONY: clean install repl debug valgrind test \ valtest dist uninstall docs grammar format help compile-commands diff --git a/ffitest/gtknew.janet b/examples/ffi/gtk.janet similarity index 100% rename from ffitest/gtknew.janet rename to examples/ffi/gtk.janet diff --git a/ffitest/so.c b/examples/ffi/so.c similarity index 100% rename from ffitest/so.c rename to examples/ffi/so.c diff --git a/ffitest/test.janet b/examples/ffi/test.janet similarity index 100% rename from ffitest/test.janet rename to examples/ffi/test.janet diff --git a/ffitest/gtk.janet b/ffitest/gtk.janet deleted file mode 100644 index a2e86d53..00000000 --- a/ffitest/gtk.janet +++ /dev/null @@ -1,57 +0,0 @@ -# FFI is best used with a wrapper like the one below -# An even more sophisticated macro wrapper could add -# better doc strings, better parameter checking, etc. - -(defn ffi-context - "Load a dynamic library and set it as the context for following declarations" - [location] - (setdyn :ffi-context (ffi/native location))) - -(defmacro defnative - "Declare a native binding" - [name ret-type & body] - (def signature-args (last body)) - (def defn-args (seq [_ :in signature-args] (gensym))) - (def raw-symbol (string/replace-all "-" "_" name)) - (def $sig (symbol name "-signature-")) - (def $pointer (symbol name "-raw-pointer-")) - ~(upscope - (def ,$pointer :private (as-macro ,assert (,ffi/lookup (,dyn :ffi-context) ,raw-symbol))) - (def ,$sig :private (,ffi/signature :default ,ret-type ,;signature-args)) - (defn ,name [,;defn-args] - (,ffi/call ,$pointer ,$sig ,;defn-args)))) - -(ffi-context "/usr/lib/libgtk-3.so") - -(defnative gtk-application-new :ptr [:ptr :uint]) -(defnative g-signal-connect-data :ulong [:ptr :ptr :ptr :ptr :ptr :int]) -(defnative g-application-run :int [:ptr :int :ptr]) -(defnative gtk-application-window-new :ptr [:ptr]) -(defnative gtk-button-new-with-label :ptr [:ptr]) -(defnative gtk-container-add :void [:ptr :ptr]) -(defnative gtk-widget-show-all :void [:ptr]) -(defnative gtk-button-set-label :void [:ptr :ptr]) - -# GTK follows a strict convention for callbacks. This lets us use -# a single "standard" callback whose behavior is specified by userdata. -# This lets use callbacks without code generation, so no issues with iOS, SELinux, etc. -# Limitation is that we cannot generate arbitrary closures to pass into apis. -# However, any stubs we need we would simply need to compile ourselves, so -# Janet includes a common stub out of the box. -(def cb (ffi/trampoline :default)) - -(defn on-active - [app] - (def window (gtk-application-window-new app)) - (def btn (gtk-button-new-with-label "Click Me!")) - (g-signal-connect-data btn "clicked" cb - (fn [btn] (gtk-button-set-label btn "Hello World")) - nil 1) - (gtk-container-add window btn) - (gtk-widget-show-all window)) - -(defn main - [&] - (def app (gtk-application-new "org.janet-lang.example.HelloApp" 0)) - (g-signal-connect-data app "activate" cb on-active nil 1) - (g-application-run app 0 nil)) From cff718f37dc97d34c6d724e1bc8d1409f946ad49 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 17 Jun 2022 17:27:42 -0500 Subject: [PATCH 53/89] Add suite0012 stub with delay test. --- test/suite0011.janet | 2 +- test/suite0012.janet | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 1 deletion(-) create mode 100644 test/suite0012.janet diff --git a/test/suite0011.janet b/test/suite0011.janet index e2a96fbf..f2806092 100644 --- a/test/suite0011.janet +++ b/test/suite0011.janet @@ -1,4 +1,4 @@ -# Copyright (c) 2021 Calvin Rose & contributors +# Copyright (c) 2022 Calvin Rose & contributors # # Permission is hereby granted, free of charge, to any person obtaining a copy # of this software and associated documentation files (the "Software"), to diff --git a/test/suite0012.janet b/test/suite0012.janet new file mode 100644 index 00000000..45727ade --- /dev/null +++ b/test/suite0012.janet @@ -0,0 +1,32 @@ +# Copyright (c) 2022 Calvin Rose & contributors +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +# IN THE SOFTWARE. + +(import ./helper :prefix "" :exit true) +(start-suite 12) + +(var counter 0) +(def thunk (delay (++ counter))) +(assert (= (thunk) 1) "delay 1") +(assert (= counter 1) "delay 2") +(assert (= (thunk) 1) "delay 3") +(assert (= counter 1) "delay 4") + +(end-suite) + From b1bdffbc34676f45a437178958fdf2dc99d1b987 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 17 Jun 2022 17:35:58 -0500 Subject: [PATCH 54/89] Don't inlcude pthread on windows. --- src/core/util.h | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/util.h b/src/core/util.h index f42a3c84..f591b0a2 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -35,8 +35,10 @@ #include #ifdef JANET_EV +#ifndef JANET_WINDOWS #include #endif +#endif #ifndef _MSC_VER #include From eed678a14b3eb2d4ff12392d14c47470685b97e6 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 17 Jun 2022 17:41:50 -0500 Subject: [PATCH 55/89] Include windows.h for windows builds --- src/core/abstract.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/core/abstract.c b/src/core/abstract.c index 1e218efb..31ddb50c 100644 --- a/src/core/abstract.c +++ b/src/core/abstract.c @@ -26,12 +26,13 @@ #include "util.h" #include "gc.h" #include "state.h" +#endif + #ifdef JANET_EV #ifdef JANET_WINDOWS #include #endif #endif -#endif /* Create new userdata */ void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) { @@ -86,11 +87,11 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) { #ifdef JANET_WINDOWS -void janet_os_mutex_size(void) { +size_t janet_os_mutex_size(void) { return sizeof(CRITICAL_SECTION); } -void janet_os_rwlock_size(void) { +size_t janet_os_rwlock_size(void) { return sizeof(SRWLock); } From 1d905bf07fabb9bc301c054824185415ac732348 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Fri, 17 Jun 2022 17:49:02 -0500 Subject: [PATCH 56/89] SRWLock is the size of a void pointer. --- src/core/abstract.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/abstract.c b/src/core/abstract.c index 31ddb50c..20d43f34 100644 --- a/src/core/abstract.c +++ b/src/core/abstract.c @@ -92,7 +92,7 @@ size_t janet_os_mutex_size(void) { } size_t janet_os_rwlock_size(void) { - return sizeof(SRWLock); + return sizeof(void *); } static int32_t janet_incref(JanetAbstractHead *ab) { From a1172529bf20757aaa103880b1d740e6393f1882 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 Jun 2022 09:46:28 -0500 Subject: [PATCH 57/89] Fix named arguments with optional args. --- src/boot/boot.janet | 21 +++++++-------------- src/core/ffi.c | 13 +++++++------ src/core/specials.c | 3 ++- test/suite0011.janet | 6 ++++++ 4 files changed, 22 insertions(+), 21 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index cef6b613..ef9edfd7 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3643,7 +3643,7 @@ (defn ffi/context "Set the path of the dynamic library to implictly bind, as well as other global state for ease of creating native bindings." - [native-path &named map-symbols lazy] + [&opt native-path &named map-symbols lazy] (default map-symbols default-mangle) (def lib (if lazy nil (ffi/native native-path))) (def lazy-lib (if lazy (delay (ffi/native native-path)))) @@ -3663,26 +3663,19 @@ (def type-args (map 1 arg-pairs)) (def computed-type-args (eval ~[,;type-args])) (def {:native lib - :native-path np :lazy lazy :native-lazy llib :map-symbols ms} (assert (dyn *ffi-context*) "no ffi context found")) (def raw-symbol (ms name)) + (defn make-sig [] + (ffi/signature :default ret-type ;computed-type-args)) + (defn make-ptr [] + (assert (ffi/lookup (llib) raw-symbol) "failed to find symbol")) (if lazy - (let [ptr - (delay - (assert (ffi/lookup (llib) raw-symbol) "failed to find symbol")) - sig - (delay - (ffi/signature :default ret-type ;computed-type-args))] ~(defn ,name ,;meta [,;formal-args] - (,ffi/call (,ptr) (,sig) ,;formal-args))) - (let [ptr - (assert (ffi/lookup lib raw-symbol) "failed to find symbol") - sig - (ffi/signature :default ret-type ;computed-type-args)] + (,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args)) ~(defn ,name ,;meta [,;formal-args] - (,ffi/call ,ptr ,sig ,;formal-args)))))) + (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))) ### ### diff --git a/src/core/ffi.c b/src/core/ffi.c index 68f89e06..04243267 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -1101,15 +1101,16 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline, } JANET_CORE_FN(janet_core_raw_native, - "(ffi/native path)", + "(ffi/native &opt 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); + "run initialization code to get a module table. If `path` is nil, opens the current running binary. " + "Returns a `core/native`.") { + janet_arity(argc, 0, 1); + const char *path = janet_optcstring(argv, argc, 0, NULL); + char *processed_name = (NULL == path) ? NULL : get_processed_name(path); Clib lib = load_clib(processed_name); - if (path != processed_name) janet_free(processed_name); + if (NULL != path && 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; diff --git a/src/core/specials.c b/src/core/specials.c index 1f91c3db..45627d7e 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -858,6 +858,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { for (i = 0; i < paramcount; i++) { Janet param = params[i]; if (namedargs) { + arity--; if (!janet_checktype(param, JANET_SYMBOL)) { errmsg = "only named arguments can follow &named"; goto error; @@ -915,7 +916,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) { } vararg = 1; structarg = 1; - arity = i; + arity--; seenamp = 1; namedargs = 1; named_table = janet_table(10); diff --git a/test/suite0011.janet b/test/suite0011.janet index f2806092..171e9a16 100644 --- a/test/suite0011.janet +++ b/test/suite0011.janet @@ -87,5 +87,11 @@ (assert (= 15 (named-arguments :bob 3 :sally 5 :joe 7)) "named arguments 1") +(defn named-opt-arguments + [&opt x &named a b c] + (+ x a b c)) + +(assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2") + (end-suite) From a1aab4008f86995fb76657e920bcb653d720dedd Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 Jun 2022 10:06:39 -0500 Subject: [PATCH 58/89] Update FFI example. --- examples/ffi/test.janet | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/ffi/test.janet b/examples/ffi/test.janet index 0ec27735..ccb4e0bb 100644 --- a/examples/ffi/test.janet +++ b/examples/ffi/test.janet @@ -1,5 +1,5 @@ -(def ffi/loc "ffitest/so.so") -(def ffi/source-loc "ffitest/so.c") +(def ffi/loc "examples/ffi/so.so") +(def ffi/source-loc "examples/ffi/so.c") (os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px) (def module (ffi/native ffi/loc)) From d8035615826e98ec215f525235de7b862c41f34f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 Jun 2022 10:14:42 -0500 Subject: [PATCH 59/89] Fix ffi/defbind for non-lazy bindings. Add testing to bind to symbols in current binary. --- src/boot/boot.janet | 2 +- test/suite0012.janet | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index ef9edfd7..51d34073 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -3670,7 +3670,7 @@ (defn make-sig [] (ffi/signature :default ret-type ;computed-type-args)) (defn make-ptr [] - (assert (ffi/lookup (llib) raw-symbol) "failed to find symbol")) + (assert (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find symbol")) (if lazy ~(defn ,name ,;meta [,;formal-args] (,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args)) diff --git a/test/suite0012.janet b/test/suite0012.janet index 45727ade..00afb19b 100644 --- a/test/suite0012.janet +++ b/test/suite0012.janet @@ -28,5 +28,16 @@ (assert (= (thunk) 1) "delay 3") (assert (= counter 1) "delay 4") +# FFI check +(compwhen (dyn 'ffi/native) + (ffi/context)) +(compwhen (dyn 'ffi/native) + (ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size])) +(compwhen (dyn 'ffi/native) + (def buffer1 @"aaaa") + (def buffer2 @"bbbb") + (memcpy buffer1 buffer2 4) + (assert (= (string buffer1) "bbbb") "ffi 1 - memcpy")) + (end-suite) From e37be627e070b7e13dcd9b66bbc3546144a72b88 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 Jun 2022 10:31:00 -0500 Subject: [PATCH 60/89] Allow loading current process on windows as well. --- src/core/ffi.c | 3 +++ src/core/util.c | 8 ++++++++ src/core/util.h | 2 +- 3 files changed, 12 insertions(+), 1 deletion(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 04243267..8b5481cb 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -202,6 +202,7 @@ static const JanetAbstractType janet_struct_type = { typedef struct { Clib clib; int closed; + int is_self; } JanetAbstractNative; static const JanetAbstractType janet_native_type = { @@ -1115,6 +1116,7 @@ JANET_CORE_FN(janet_core_raw_native, JanetAbstractNative *anative = janet_abstract(&janet_native_type, sizeof(JanetAbstractNative)); anative->clib = lib; anative->closed = 0; + anative->is_self = path == NULL; return janet_wrap_abstract(anative); } @@ -1138,6 +1140,7 @@ JANET_CORE_FN(janet_core_native_close, janet_fixarity(argc, 1); JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type); if (anative->closed) janet_panic("native object already closed"); + if (anative->is_self) janet_panic("cannot close self"); anative->closed = 1; free_clib(anative->clib); return janet_wrap_nil(); diff --git a/src/core/util.c b/src/core/util.c index 7568299f..8670797b 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -912,6 +912,14 @@ char *error_clib(void) { error_clib_buf[strlen(error_clib_buf) - 1] = '\0'; return error_clib_buf; } + +Clib load_clib(const char *name) { + if (name == NULL) { + return GetModuleHandle(NULL); + } else { + return LoadLibrary(name); + } +} #endif /* Alloc function macro fills */ diff --git a/src/core/util.h b/src/core/util.h index f591b0a2..3031cc2d 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -144,9 +144,9 @@ typedef int Clib; #elif defined(JANET_WINDOWS) #include typedef HINSTANCE Clib; -#define load_clib(name) LoadLibrary((name)) #define free_clib(c) FreeLibrary((c)) #define symbol_clib(lib, sym) GetProcAddress((lib), (sym)) +Clib load_clib(const char *name); char *error_clib(void); #else #include From f0d7b3cd122c1e2d456ea73634a058534f6063ba Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 Jun 2022 11:19:14 -0500 Subject: [PATCH 61/89] No alloca.h? --- src/core/util.h | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/core/util.h b/src/core/util.h index 3031cc2d..7c6b195e 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -40,10 +40,6 @@ #endif #endif -#ifndef _MSC_VER -#include -#endif - #if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED) #include #define JANET_GETTIME From 89546776b2ce1a0a9b6ab866936c645f7b84b1c9 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 Jun 2022 12:15:06 -0500 Subject: [PATCH 62/89] alloca --- src/core/ffi.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/ffi.c b/src/core/ffi.c index 8b5481cb..4949f9e6 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -30,6 +30,8 @@ #ifdef _MSC_VER #define alloca _alloca +#else +#include #endif #define JANET_FFI_MAX_RECUR 64 From 589981bdcb06c922a071c0bc092d2759d7fd6521 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 Jun 2022 12:18:06 -0500 Subject: [PATCH 63/89] BSD systems put alloca in the stdlib --- src/core/ffi.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 4949f9e6..49102b9d 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -30,7 +30,7 @@ #ifdef _MSC_VER #define alloca _alloca -#else +#elif defined(JANET_LINUX) #include #endif From 1a1dd39367b5e94828e5c871133c15e5002e3477 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 Jun 2022 13:54:47 -0500 Subject: [PATCH 64/89] Use __builtin_alloca if no other option. --- src/core/ffi.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/core/ffi.c b/src/core/ffi.c index 49102b9d..1b77ccea 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -32,6 +32,9 @@ #define alloca _alloca #elif defined(JANET_LINUX) #include +#elif !defined(alloca) +/* Last ditch effort to get alloca - works for gcc and clang */ +#define alloca __builtin_alloca #endif #define JANET_FFI_MAX_RECUR 64 From 20511cf608c686a3352af13c5bf840e38b950413 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 18 Jun 2022 16:53:01 -0500 Subject: [PATCH 65/89] Cast NULL pointer to nil in return in ffi. --- src/core/ffi.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 1b77ccea..0c47439c 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -491,8 +491,10 @@ static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recu return janet_wrap_number(((double *)(from))[0]); case JANET_FFI_TYPE_FLOAT: return janet_wrap_number(((float *)(from))[0]); - case JANET_FFI_TYPE_PTR: - return janet_wrap_pointer(((void **)(from))[0]); + case JANET_FFI_TYPE_PTR: { + void *ptr = ((void **)(from))[0]; + return (NULL == ptr) ? janet_wrap_nil() : janet_wrap_pointer(ptr); + } case JANET_FFI_TYPE_BOOL: return janet_wrap_boolean(((bool *)(from))[0]); case JANET_FFI_TYPE_INT8: From a6f93efd396f673762f0b912443f203bca16ffb1 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 08:03:07 -0500 Subject: [PATCH 66/89] Support for array types in ffi. --- examples/ffi/gtk.janet | 21 ++++++++++-- src/boot/boot.janet | 34 +++++++++--------- src/core/ffi.c | 78 +++++++++++++++++++++++++++++++++++++++--- 3 files changed, 109 insertions(+), 24 deletions(-) diff --git a/examples/ffi/gtk.janet b/examples/ffi/gtk.janet index 57113ab9..8657bace 100644 --- a/examples/ffi/gtk.janet +++ b/examples/ffi/gtk.janet @@ -7,7 +7,7 @@ (ffi/defbind gtk-application-new :ptr "Add docstrings as needed." - [a :ptr b :uint]) + [title :string flags :uint]) (ffi/defbind g-signal-connect-data :ulong @@ -15,7 +15,7 @@ (ffi/defbind g-application-run :int - [a :ptr b :int c :ptr]) + [app :ptr argc :int argv :ptr]) (ffi/defbind gtk-application-window-new :ptr @@ -39,6 +39,18 @@ (def cb (delay (ffi/trampoline :default))) +(defn ffi/array + ``Convert a janet array to a buffer that can be passed to FFI functions. + For example, to create an array of type `char *` (array of c strings), one + could use `(ffi/array ["hello" "world"] :ptr)`. One needs to be careful that + array elements are not garbage collected though - the GC can't follow references + inside an arbitrary byte buffer.`` + [arr ctype &opt buf] + (default buf @"") + (each el arr + (ffi/write ctype el buf)) + buf) + (defn on-active [app] (def window (gtk-application-window-new app)) @@ -53,4 +65,7 @@ [&] (def app (gtk-application-new "org.janet-lang.example.HelloApp" 0)) (g-signal-connect-data app "activate" (cb) on-active nil 1) - (g-application-run app 0 nil)) + # manually build an array with ffi/write + # - we are responsible for preventing gc when the arg array is used + (def argv (ffi/array (dyn *args*) :string)) + (g-application-run app (length (dyn *args*)) argv)) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 51d34073..1c42e6ea 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1,5 +1,5 @@ # The core janet library -# Copyright 2021 © Calvin Rose +# Copyright 2022 © Calvin Rose ### ### @@ -3413,26 +3413,26 @@ (def pc (frame :pc)) (def sourcemap (in dasm :sourcemap)) (var last-loc [-2 -2]) - (print "\n signal: " (.signal)) - (print " status: " (fiber/status (.fiber))) - (print " function: " (dasm :name) " [" (in dasm :source "") "]") + (eprint "\n signal: " (.signal)) + (eprint " status: " (fiber/status (.fiber))) + (eprint " function: " (get dasm :name "") " [" (in dasm :source "") "]") (when-let [constants (dasm :constants)] - (printf " constants: %.4q" constants)) - (printf " slots: %.4q\n" (frame :slots)) + (eprintf " constants: %.4q" constants)) + (eprintf " slots: %.4q\n" (frame :slots)) (def padding (string/repeat " " 20)) (loop [i :range [0 (length bytecode)] :let [instr (bytecode i)]] - (prin (if (= (tuple/type instr) :brackets) "*" " ")) - (prin (if (= i pc) "> " " ")) - (prinf "%.20s" (string (string/join (map string instr) " ") padding)) + (eprin (if (= (tuple/type instr) :brackets) "*" " ")) + (eprin (if (= i pc) "> " " ")) + (eprinf "%.20s" (string (string/join (map string instr) " ") padding)) (when sourcemap (let [[sl sc] (sourcemap i) loc [sl sc]] (when (not= loc last-loc) (set last-loc loc) - (prin " # line " sl ", column " sc)))) - (print)) - (print)) + (eprin " # line " sl ", column " sc)))) + (eprint)) + (eprint)) (defn .breakall "Set breakpoints on all instructions in the current function." @@ -3441,7 +3441,7 @@ (def bytecode (.bytecode n)) (forv i 0 (length bytecode) (debug/fbreak fun i)) - (print "Set " (length bytecode) " breakpoints in " fun)) + (eprint "set " (length bytecode) " breakpoints in " fun)) (defn .clearall "Clear all breakpoints on the current function." @@ -3450,7 +3450,7 @@ (def bytecode (.bytecode n)) (forv i 0 (length bytecode) (debug/unfbreak fun i)) - (print "Cleared " (length bytecode) " breakpoints in " fun))) + (eprint "cleared " (length bytecode) " breakpoints in " fun))) (defn .source "Show the source code for the function being debugged." @@ -3458,7 +3458,7 @@ (def frame (.frame n)) (def s (frame :source)) (def all-source (slurp s)) - (print "\n" all-source "\n")) + (eprint "\n" all-source "\n")) (defn .break "Set breakpoint at the current pc." @@ -3467,7 +3467,7 @@ (def fun (frame :function)) (def pc (frame :pc)) (debug/fbreak fun pc) - (print "Set breakpoint in " fun " at pc=" pc)) + (eprint "set breakpoint in " fun " at pc=" pc)) (defn .clear "Clear the current breakpoint." @@ -3476,7 +3476,7 @@ (def fun (frame :function)) (def pc (frame :pc)) (debug/unfbreak fun pc) - (print "Cleared breakpoint in " fun " at pc=" pc)) + (eprint "cleared breakpoint in " fun " at pc=" pc)) (defn .next "Go to the next breakpoint." diff --git a/src/core/ffi.c b/src/core/ffi.c index 0c47439c..9aaa6f19 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -56,6 +56,7 @@ typedef enum { JANET_FFI_TYPE_VOID, JANET_FFI_TYPE_BOOL, JANET_FFI_TYPE_PTR, + JANET_FFI_TYPE_STRING, JANET_FFI_TYPE_FLOAT, JANET_FFI_TYPE_DOUBLE, JANET_FFI_TYPE_INT8, @@ -81,6 +82,7 @@ static const JanetFFIPrimInfo janet_ffi_type_info[] = { {0, 0}, /* JANET_FFI_TYPE_VOID */ {sizeof(char), ALIGNOF(char)}, /* JANET_FFI_TYPE_BOOL */ {sizeof(void *), ALIGNOF(void *)}, /* JANET_FFI_TYPE_PTR */ + {sizeof(char *), ALIGNOF(char *)}, /* JANET_FFI_TYPE_STRING */ {sizeof(float), ALIGNOF(float)}, /* JANET_FFI_TYPE_FLOAT */ {sizeof(double), ALIGNOF(double)}, /* JANET_FFI_TYPE_DOUBLE */ {sizeof(int8_t), ALIGNOF(int8_t)}, /* JANET_FFI_TYPE_INT8 */ @@ -97,6 +99,7 @@ static const JanetFFIPrimInfo janet_ffi_type_info[] = { struct JanetFFIType { JanetFFIStruct *st; JanetFFIPrimType prim; + size_t array_count; }; typedef struct { @@ -104,6 +107,7 @@ typedef struct { size_t offset; } JanetFFIStructMember; +/* Also used to store array types */ struct JanetFFIStruct { uint32_t size; uint32_t align; @@ -219,14 +223,16 @@ static JanetFFIType prim_type(JanetFFIPrimType pt) { JanetFFIType t; t.prim = pt; t.st = NULL; + t.array_count = 0; return t; } static size_t type_size(JanetFFIType t) { + size_t count = t.array_count ? t.array_count : 1; if (t.prim == JANET_FFI_TYPE_STRUCT) { - return t.st->size; + return t.st->size * count; } else { - return janet_ffi_type_info[t.prim].size; + return janet_ffi_type_info[t.prim].size * count; } } @@ -254,6 +260,7 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { if (!janet_cstrcmp(name, "void")) return JANET_FFI_TYPE_VOID; if (!janet_cstrcmp(name, "bool")) return JANET_FFI_TYPE_BOOL; if (!janet_cstrcmp(name, "ptr")) return JANET_FFI_TYPE_PTR; + if (!janet_cstrcmp(name, "string")) return JANET_FFI_TYPE_STRING; if (!janet_cstrcmp(name, "float")) return JANET_FFI_TYPE_FLOAT; if (!janet_cstrcmp(name, "double")) return JANET_FFI_TYPE_DOUBLE; if (!janet_cstrcmp(name, "int8")) return JANET_FFI_TYPE_INT8; @@ -355,6 +362,11 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) { i++; } st->is_aligned = is_aligned; + if (is_aligned) { + st->size += st->align - 1; + st->size /= st->align; + st->size *= st->align; + } return st; } @@ -371,7 +383,15 @@ static JanetFFIType decode_ffi_type(Janet x) { int32_t len; const Janet *els; if (janet_indexed_view(x, &els, &len)) { - ret.st = build_struct_type(len, els); + if (janet_checktype(x, JANET_ARRAY)) { + if (len != 2) janet_panicf("array type must be of form @[type count], got %v", x); + int32_t array_count = janet_getnat(els, 1); + if (array_count == 0) janet_panic("vla not supported"); + ret = decode_ffi_type(els[0]); + ret.array_count = array_count; + } else { + ret.st = build_struct_type(len, els); + } return ret; } else { janet_panicf("bad native type %v", x); @@ -380,11 +400,27 @@ static JanetFFIType decode_ffi_type(Janet x) { JANET_CORE_FN(cfun_ffi_struct, "(ffi/struct & types)", - "Create a struct type descriptor that can be used to pass structs into native functions. ") { + "Create a struct type definition that can be used to pass structs into native functions. ") { janet_arity(argc, 1, -1); return janet_wrap_abstract(build_struct_type(argc, argv)); } +JANET_CORE_FN(cfun_ffi_size, + "(ffi/size type)", + "Get the size of an ffi type in bytes.") { + janet_fixarity(argc, 1); + size_t size = type_size(decode_ffi_type(argv[0])); + return janet_wrap_number((double) size); +} + +JANET_CORE_FN(cfun_ffi_align, + "(ffi/align type)", + "Get the align of an ffi type in bytes.") { + janet_fixarity(argc, 1); + size_t size = type_align(decode_ffi_type(argv[0])); + return janet_wrap_number((double) size); +} + static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { switch (janet_type(argv[n])) { default: @@ -411,6 +447,21 @@ static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { * The alignment and space available is assumed to already be sufficient */ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFIType type, int recur) { if (recur == 0) janet_panic("recursion too deep"); + if (type.array_count) { + JanetFFIType el_type = type; + el_type.array_count = 0; + size_t el_size = type_size(el_type); + JanetView els = janet_getindexed(argv, n); + if ((size_t) els.len != type.array_count) { + janet_panicf("bad array length, expected %d, got %d", type.array_count, els.len); + } + char *cursor = to; + for (int32_t i = 0; i < els.len; i++) { + janet_ffi_write_one(cursor, els.items, i, el_type, recur - 1); + cursor += el_size; + } + return; + } switch (type.prim) { case JANET_FFI_TYPE_VOID: if (!janet_checktype(argv[n], JANET_NIL)) { @@ -439,6 +490,9 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI case JANET_FFI_TYPE_PTR: ((void **)(to))[0] = janet_ffi_getpointer(argv, n); break; + case JANET_FFI_TYPE_STRING: + ((const char **)(to))[0] = janet_getcstring(argv, n); + break; case JANET_FFI_TYPE_BOOL: ((bool *)(to))[0] = janet_getboolean(argv, n); break; @@ -474,6 +528,17 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI * size of the data is correct. */ static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recur) { if (recur == 0) janet_panic("recursion too deep"); + if (type.array_count) { + JanetFFIType el_type = type; + el_type.array_count = 0; + size_t el_size = type_size(el_type); + JanetArray *array = janet_array(type.array_count); + for (size_t i = 0; i < type.array_count; i++) { + janet_array_push(array, janet_ffi_read_one(from, el_type, recur - 1)); + from += el_size; + } + return janet_wrap_array(array); + } switch (type.prim) { default: case JANET_FFI_TYPE_VOID: @@ -495,6 +560,8 @@ static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recu void *ptr = ((void **)(from))[0]; return (NULL == ptr) ? janet_wrap_nil() : janet_wrap_pointer(ptr); } + case JANET_FFI_TYPE_STRING: + return janet_cstringv(((char **)(from))[0]); case JANET_FFI_TYPE_BOOL: return janet_wrap_boolean(((bool *)(from))[0]); case JANET_FFI_TYPE_INT8: @@ -537,6 +604,7 @@ static JanetFFIMapping void_mapping(void) { static JanetFFIWordSpec sysv64_classify(JanetFFIType type) { switch (type.prim) { case JANET_FFI_TYPE_PTR: + case JANET_FFI_TYPE_STRING: case JANET_FFI_TYPE_BOOL: case JANET_FFI_TYPE_INT8: case JANET_FFI_TYPE_INT16: @@ -1163,6 +1231,8 @@ void janet_lib_ffi(JanetTable *env) { JANET_CORE_REG("ffi/struct", cfun_ffi_struct), JANET_CORE_REG("ffi/write", cfun_ffi_buffer_write), JANET_CORE_REG("ffi/read", cfun_ffi_buffer_read), + JANET_CORE_REG("ffi/size", cfun_ffi_size), + JANET_CORE_REG("ffi/align", cfun_ffi_align), JANET_CORE_REG("ffi/trampoline", cfun_ffi_get_callback_trampoline), JANET_REG_END }; From e316ccb1e03b468f036bfe9f9f24a23a69d5bc8d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 08:49:25 -0500 Subject: [PATCH 67/89] Use _tzset() on windows before localtime_s --- src/core/os.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/os.c b/src/core/os.c index 6d35e3ac..2660580d 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1345,6 +1345,7 @@ JANET_CORE_FN(os_date, if (argc >= 2 && janet_truthy(argv[1])) { /* local time */ #ifdef JANET_WINDOWS + _tzset(); localtime_s(&t_infos, &t); t_info = &t_infos; #else From 56b4e0b0ecd41f675864d32fe467e532c822793e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 09:18:59 -0500 Subject: [PATCH 68/89] Update CONTRIBUTING.md --- CONTRIBUTING.md | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index c65c99d5..23470084 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -43,7 +43,7 @@ For changes to the VM and Core code, you will probably need to know C. Janet is a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following omissions. -* No `restrict` +* No `restrict` * Certain functions in the standard library are not always available In practice, this means programming for both MSVC on one hand and everything else on the other. @@ -64,6 +64,23 @@ ensure a consistent code style for C. All janet code in the project should be formatted similar to the code in core.janet. The auto formatting from janet.vim will work well. +## Typo Fixing and One-Line changes + +Typo fixes are welcome, as are simple one line fixes. Do not open many separate pull requests for each +individual typo fix. This is incredibly annoying to deal with as someone needs to review each PR, run +CI, and merge. Instead, accumulate batches of typo fixes into a single PR. If there are objections to +specific changes, these can be addressed in the review process before the final merge, if the changes +are accepted. + +Similarly, low effort and bad faith changes are annoying to developers and such issues may be closed +immediately without response. + +## Contributions from Automated Tools + +People making changes found or generated by automated tools MUST note this when opening an issue +or creating a pull request. This can help give context to developers if the change/issue is +confusing or nonsensical. + ## Suggesting Changes To suggest changes, open an issue on GitHub. Check GitHub for other issues From b5720f6f105da93a7be6006800f80976195e9079 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 09:31:43 -0500 Subject: [PATCH 69/89] On suite0009 errors for localname/peername, add info Tag when the issue in the server or in the client. On windows, sometimes these seemed to get swapped for strange reason. --- test/suite0009.janet | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/test/suite0009.janet b/test/suite0009.janet index 8a1ecc0d..7da725cd 100644 --- a/test/suite0009.janet +++ b/test/suite0009.janet @@ -164,7 +164,7 @@ (:close s)) -(defn check-matching-names [stream] +(defn check-matching-names [stream tag] (def ln (net/localname stream)) (def pn (net/peername stream)) (def [my-ip my-port] ln) @@ -179,21 +179,20 @@ (= (string my-port) (get comparison 3)) (= remote-ip (get comparison 0)) (= (string remote-port) (get comparison 1))) - (string/format "localname should match peername: msg=%j, buf=%j" msg buf))) + (string/format "%s: localname should match peername: msg=%j, buf=%j" tag msg buf))) # Test on both server and client (defn names-handler [stream] (defer (:close stream) - (check-matching-names stream))) + (check-matching-names stream "server"))) # Test localname and peername -(repeat 20 +(repeat 10 (with [s (net/server "127.0.0.1" "8000" names-handler)] - (defn test-names [] + (repeat 10 (with [conn (net/connect "127.0.0.1" "8000")] - (check-matching-names conn))) - (repeat 20 (test-names))) + (check-matching-names conn "client")))) (gccollect)) # Create pipe From cbe833962b81c141ce4bf022b98d5b46337ab38e Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 10:01:10 -0500 Subject: [PATCH 70/89] Remove bad suite0009 test. Close #871 The issue is that there was no synchronization on writes. The stability of the test relied on the fact that the server would read in an entire message in one call to ev/read, which would _almost_ always happen since the messages are so small. --- src/core/net.c | 1 - test/suite0009.janet | 29 ++++++++++------------------- 2 files changed, 10 insertions(+), 20 deletions(-) diff --git a/src/core/net.c b/src/core/net.c index 52293427..5f719841 100644 --- a/src/core/net.c +++ b/src/core/net.c @@ -884,7 +884,6 @@ static JanetStream *make_stream(JSock handle, uint32_t flags) { return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods); } - void janet_lib_net(JanetTable *env) { JanetRegExt net_cfuns[] = { JANET_CORE_REG("net/address", cfun_net_sockaddr), diff --git a/test/suite0009.janet b/test/suite0009.janet index 7da725cd..018a7052 100644 --- a/test/suite0009.janet +++ b/test/suite0009.janet @@ -164,35 +164,26 @@ (:close s)) -(defn check-matching-names [stream tag] - (def ln (net/localname stream)) - (def pn (net/peername stream)) - (def [my-ip my-port] ln) - (def [remote-ip remote-port] pn) - (def msg (string my-ip " " my-port " " remote-ip " " remote-port)) - (def buf @"") - (ev/gather - (net/write stream msg) - (net/read stream 1024 buf)) - (def comparison (string/split " " buf)) - (assert (and (= my-ip (get comparison 2)) - (= (string my-port) (get comparison 3)) - (= remote-ip (get comparison 0)) - (= (string remote-port) (get comparison 1))) - (string/format "%s: localname should match peername: msg=%j, buf=%j" tag msg buf))) - # Test on both server and client (defn names-handler [stream] (defer (:close stream) - (check-matching-names stream "server"))) + # prevent immediate close + (ev/read stream 1) + (def [host port] (net/localname stream)) + (assert (= host "127.0.0.1") "localname host server") + (assert (= port 8000) "localname port server"))) # Test localname and peername (repeat 10 (with [s (net/server "127.0.0.1" "8000" names-handler)] (repeat 10 (with [conn (net/connect "127.0.0.1" "8000")] - (check-matching-names conn "client")))) + (def [host port] (net/peername conn)) + (assert (= host "127.0.0.1") "peername host client ") + (assert (= port 8000) "peername port client") + # let server close + (ev/write conn " ")))) (gccollect)) # Create pipe From 0dccc22b38dba1443d4f3356090764404c4c2fa6 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 10:28:18 -0500 Subject: [PATCH 71/89] Improve error messages when using bad metadata Print metadata value as well as binding name. --- src/core/specials.c | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/core/specials.c b/src/core/specials.c index 45627d7e..15bb3591 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -31,7 +31,7 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) { if (argn != 1) { - janetc_cerror(opts.compiler, "expected 1 argument"); + janetc_cerror(opts.compiler, "expected 1 argument to quote"); return janetc_cslot(janet_wrap_nil()); } return janetc_cslot(argv[0]); @@ -40,7 +40,7 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) { JanetSlot ret; if (argn != 1) { - janetc_cerror(opts.compiler, "expected 1 argument"); + janetc_cerror(opts.compiler, "expected 1 argument to splice"); return janetc_cslot(janet_wrap_nil()); } ret = janetc_value(opts, argv[0]); @@ -117,7 +117,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) { static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) { if (argn != 1) { - janetc_cerror(opts.compiler, "expected 1 argument"); + janetc_cerror(opts.compiler, "expected 1 argument to quasiquote"); return janetc_cslot(janet_wrap_nil()); } return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0); @@ -143,7 +143,7 @@ static int destructure(JanetCompiler *c, JanetTable *attr) { switch (janet_type(left)) { default: - janetc_cerror(c, "unexpected type in destructuring"); + janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left)); return 1; case JANET_SYMBOL: /* Leaf, assign right to left */ @@ -302,6 +302,9 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) { int32_t i; JanetTable *tab = janet_table(2); + const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL + ? ((const char *)janet_unwrap_symbol(argv[0])) + : ""; for (i = 1; i < argn - 1; i++) { Janet attr = argv[i]; switch (janet_type(attr)) { @@ -309,7 +312,7 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) janetc_cerror(c, "unexpected form - did you intend to use defn?"); break; default: - janetc_cerror(c, "could not add metadata to binding"); + janetc_error(c, janet_formatc("could not add metadata %v to binding %s", attr, binding_name)); break; case JANET_KEYWORD: janet_table_put(tab, attr, janet_wrap_true()); From 6ea27fe836506dcd10450486e6b11376d49df623 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 10:29:42 -0500 Subject: [PATCH 72/89] Error message sounded a bit unsure. --- src/core/specials.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/specials.c b/src/core/specials.c index 15bb3591..592fd1a1 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -312,7 +312,7 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) janetc_cerror(c, "unexpected form - did you intend to use defn?"); break; default: - janetc_error(c, janet_formatc("could not add metadata %v to binding %s", attr, binding_name)); + janetc_error(c, janet_formatc("cannot add metadata %v to binding %s", attr, binding_name)); break; case JANET_KEYWORD: janet_table_put(tab, attr, janet_wrap_true()); From 965f45aa3fd92a69f4a6827492aa463a31eee939 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 12:42:44 -0500 Subject: [PATCH 73/89] Update changelog to say FFI initially only available on non-windows platforms. --- CHANGELOG.md | 3 ++- src/include/janet.h | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d7742bd1..79decf92 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,8 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? -- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. +- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available + on 64 bit linux, mac, and bsd systems. - Allow using `&named` in function prototypes for named arguments. This is a more ergonomic variant of `&keys` that isn't as redundant, more self documenting, and allows extension to things like default arguments. diff --git a/src/include/janet.h b/src/include/janet.h index 28d9c360..08806300 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -166,7 +166,7 @@ extern "C" { /* Enable or disable the FFI library. Currently, FFI only enabled on * x86-64, non-windows operating systems. */ #ifndef JANET_NO_FFI -#if !defined(JANET_WINDOWS) && (defined(__x86_64__) || defined(_M_X64)) +#if !defined(JANET_WINDOWS) && !defined(__EMSCRIPTEN__) && (defined(__x86_64__) || defined(_M_X64)) #define JANET_FFI #endif #endif From c1a0352592f1eafc64ac98b2a9b4daadda90c2d4 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 12:58:45 -0500 Subject: [PATCH 74/89] Fix unset field in JanetFFIType. --- src/core/ffi.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 9aaa6f19..d6a7c879 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -362,11 +362,9 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) { i++; } st->is_aligned = is_aligned; - if (is_aligned) { - st->size += st->align - 1; - st->size /= st->align; - st->size *= st->align; - } + st->size += (st->align - 1); + st->size /= st->align; + st->size *= st->align; return st; } @@ -375,6 +373,7 @@ static JanetFFIType decode_ffi_type(Janet x) { return prim_type(decode_ffi_prim(janet_unwrap_keyword(x))); } JanetFFIType ret; + ret.array_count = 0; ret.prim = JANET_FFI_TYPE_STRUCT; if (janet_checkabstract(x, &janet_struct_type)) { ret.st = janet_unwrap_abstract(x); From cfaae47cea395279de9ce1d986ef3432533695b5 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 13:02:26 -0500 Subject: [PATCH 75/89] Fix trailing :pack-all or :pack in struct. --- src/core/ffi.c | 1 + src/core/specials.c | 4 ++-- test/suite0012.janet | 17 ++++++++++++++--- 3 files changed, 17 insertions(+), 5 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index d6a7c879..24de85cd 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -346,6 +346,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) { if (janet_keyeq(argv[j], "pack") || janet_keyeq(argv[j], "pack-all")) { pack_one = 1; j++; + if (j == argc) break; } st->fields[i].type = decode_ffi_type(argv[j]); size_t el_size = type_size(st->fields[i].type); diff --git a/src/core/specials.c b/src/core/specials.c index 592fd1a1..c608f8ab 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -303,8 +303,8 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) int32_t i; JanetTable *tab = janet_table(2); const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL - ? ((const char *)janet_unwrap_symbol(argv[0])) - : ""; + ? ((const char *)janet_unwrap_symbol(argv[0])) + : ""; for (i = 1; i < argn - 1; i++) { Janet attr = argv[i]; switch (janet_type(attr)) { diff --git a/test/suite0012.janet b/test/suite0012.janet index 00afb19b..86b43eec 100644 --- a/test/suite0012.janet +++ b/test/suite0012.janet @@ -28,16 +28,27 @@ (assert (= (thunk) 1) "delay 3") (assert (= counter 1) "delay 4") +(def has-ffi (dyn 'ffi/native)) + # FFI check -(compwhen (dyn 'ffi/native) +(compwhen has-ffi (ffi/context)) -(compwhen (dyn 'ffi/native) +(compwhen has-ffi (ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size])) -(compwhen (dyn 'ffi/native) +(compwhen has-ffi (def buffer1 @"aaaa") (def buffer2 @"bbbb") (memcpy buffer1 buffer2 4) (assert (= (string buffer1) "bbbb") "ffi 1 - memcpy")) +(compwhen has-ffi + (assert (= 8 (ffi/size [:int :char])) "size unpacked struct 1") + (assert (= 5 (ffi/size [:pack :int :char])) "size packed struct 1") + (assert (= 5 (ffi/size [:int :pack-all :char])) "size packed struct 2") + (assert (= 4 (ffi/align [:int :char])) "align 1") + (assert (= 1 (ffi/align [:pack :int :char])) "align 2") + (assert (= 1 (ffi/align [:int :char :pack-all])) "align 3") + (assert (= 26 (ffi/size [:char :pack :int @[:char 21]])) "array struct size")) + (end-suite) From 0a15a5ee564d3b283564d5e183a0b57abc40b579 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 15:07:35 -0500 Subject: [PATCH 76/89] Prepare for 1.23.0 release. --- CHANGELOG.md | 2 +- Makefile | 4 ++-- meson.build | 2 +- src/conf/janetconf.h | 6 +++--- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 79decf92..4aa66e61 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,7 @@ # Changelog All notable changes to this project will be documented in this file. -## Unreleased - ??? +## 1.23.0 - ??? - Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available on 64 bit linux, mac, and bsd systems. - Allow using `&named` in function prototypes for named arguments. This is a more ergonomic diff --git a/Makefile b/Makefile index dd8e0f25..0fdcb64d 100644 --- a/Makefile +++ b/Makefile @@ -168,9 +168,9 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet ######################## ifeq ($(UNAME), Darwin) -SONAME=libjanet.1.22.dylib +SONAME=libjanet.1.23.dylib else -SONAME=libjanet.so.1.22 +SONAME=libjanet.so.1.23 endif build/c/shell.c: src/mainclient/shell.c diff --git a/meson.build b/meson.build index 3e67aaeb..56adc975 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.22.1') + version : '1.23.0') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index 3bd49527..d711378d 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -4,10 +4,10 @@ #define JANETCONF_H #define JANET_VERSION_MAJOR 1 -#define JANET_VERSION_MINOR 22 -#define JANET_VERSION_PATCH 1 +#define JANET_VERSION_MINOR 23 +#define JANET_VERSION_PATCH 0 #define JANET_VERSION_EXTRA "-dev" -#define JANET_VERSION "1.22.1-dev" +#define JANET_VERSION "1.23.0-dev" /* #define JANET_BUILD "local" */ From eecc388ebd85818a5c10565b4fa20b72d7f5f3db Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 16:29:55 -0500 Subject: [PATCH 77/89] Add support for 0-element arrays in FFI. Allows for flexible array member construct mapping. --- src/core/ffi.c | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index 24de85cd..3b93b58d 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -99,7 +99,7 @@ static const JanetFFIPrimInfo janet_ffi_type_info[] = { struct JanetFFIType { JanetFFIStruct *st; JanetFFIPrimType prim; - size_t array_count; + ssize_t array_count; }; typedef struct { @@ -223,12 +223,12 @@ static JanetFFIType prim_type(JanetFFIPrimType pt) { JanetFFIType t; t.prim = pt; t.st = NULL; - t.array_count = 0; + t.array_count = -1; return t; } static size_t type_size(JanetFFIType t) { - size_t count = t.array_count ? t.array_count : 1; + size_t count = t.array_count < 0 ? 1 : (size_t) t.array_count; if (t.prim == JANET_FFI_TYPE_STRUCT) { return t.st->size * count; } else { @@ -294,6 +294,7 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) { if (!janet_cstrcmp(name, "int")) return JANET_FFI_TYPE_INT32; if (!janet_cstrcmp(name, "long")) return JANET_FFI_TYPE_INT64; if (!janet_cstrcmp(name, "byte")) return JANET_FFI_TYPE_UINT8; + if (!janet_cstrcmp(name, "uchar")) return JANET_FFI_TYPE_UINT8; if (!janet_cstrcmp(name, "ushort")) return JANET_FFI_TYPE_UINT16; if (!janet_cstrcmp(name, "uint")) return JANET_FFI_TYPE_UINT32; if (!janet_cstrcmp(name, "ulong")) return JANET_FFI_TYPE_UINT64; @@ -374,7 +375,7 @@ static JanetFFIType decode_ffi_type(Janet x) { return prim_type(decode_ffi_prim(janet_unwrap_keyword(x))); } JanetFFIType ret; - ret.array_count = 0; + ret.array_count = -1; ret.prim = JANET_FFI_TYPE_STRUCT; if (janet_checkabstract(x, &janet_struct_type)) { ret.st = janet_unwrap_abstract(x); @@ -384,10 +385,9 @@ static JanetFFIType decode_ffi_type(Janet x) { const Janet *els; if (janet_indexed_view(x, &els, &len)) { if (janet_checktype(x, JANET_ARRAY)) { - if (len != 2) janet_panicf("array type must be of form @[type count], got %v", x); - int32_t array_count = janet_getnat(els, 1); - if (array_count == 0) janet_panic("vla not supported"); + if (len != 2 && len != 1) janet_panicf("array type must be of form @[type count], got %v", x); ret = decode_ffi_type(els[0]); + int32_t array_count = len == 1 ? 0 : janet_getnat(els, 1); ret.array_count = array_count; } else { ret.st = build_struct_type(len, els); @@ -447,12 +447,12 @@ static void *janet_ffi_getpointer(const Janet *argv, int32_t n) { * The alignment and space available is assumed to already be sufficient */ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFIType type, int recur) { if (recur == 0) janet_panic("recursion too deep"); - if (type.array_count) { + if (type.array_count >= 0) { JanetFFIType el_type = type; - el_type.array_count = 0; + el_type.array_count = -1; size_t el_size = type_size(el_type); JanetView els = janet_getindexed(argv, n); - if ((size_t) els.len != type.array_count) { + if (els.len != type.array_count) { janet_panicf("bad array length, expected %d, got %d", type.array_count, els.len); } char *cursor = to; @@ -528,12 +528,12 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI * size of the data is correct. */ static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recur) { if (recur == 0) janet_panic("recursion too deep"); - if (type.array_count) { + if (type.array_count >= 0) { JanetFFIType el_type = type; - el_type.array_count = 0; + el_type.array_count = -1; size_t el_size = type_size(el_type); JanetArray *array = janet_array(type.array_count); - for (size_t i = 0; i < type.array_count; i++) { + for (ssize_t i = 0; i < type.array_count; i++) { janet_array_push(array, janet_ffi_read_one(from, el_type, recur - 1)); from += el_size; } From 47e91bfd8917e5f06aa54d940bdfe67df9c8b27c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 19 Jun 2022 18:52:37 -0500 Subject: [PATCH 78/89] Fix docstring. --- examples/ffi/test.janet | 4 ++++ src/core/ffi.c | 3 +-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/examples/ffi/test.janet b/examples/ffi/test.janet index ccb4e0bb..dccc4018 100644 --- a/examples/ffi/test.janet +++ b/examples/ffi/test.janet @@ -1,3 +1,7 @@ +# +# Simple FFI test script that tests against a simple shared object +# + (def ffi/loc "examples/ffi/so.so") (def ffi/source-loc "examples/ffi/so.c") diff --git a/src/core/ffi.c b/src/core/ffi.c index 3b93b58d..e7c0b024 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -1130,7 +1130,6 @@ JANET_CORE_FN(cfun_ffi_buffer_write, return janet_wrap_buffer(buffer); } - JANET_CORE_FN(cfun_ffi_buffer_read, "(ffi/read ffi-type bytes &opt offset)", "Parse a native struct out of a buffer and convert it to normal Janet data structures. " @@ -1153,7 +1152,7 @@ JANET_CORE_FN(cfun_ffi_buffer_read, JANET_CORE_FN(cfun_ffi_get_callback_trampoline, "(ffi/trampoline cc)", "Get a native function pointer that can be used as a callback and passed to C libraries. " - "This callback trampoline has the signature `void trampoline(void *ctx, void *userdata)` in " + "This callback trampoline has the signature `void trampoline(void \\*ctx, void \\*userdata)` in " "the given calling convention. This is the only function signature supported. " "It is up to the programmer to ensure that the `userdata` argument contains a janet function " "the will be called with one argument, `ctx` which is an opaque pointer. This pointer can " From cfa39ab3b05663b24946ad9b9da8d1797907329c Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 20 Jun 2022 10:49:25 -0500 Subject: [PATCH 79/89] Prepare for 1.23.0 release. --- CHANGELOG.md | 2 +- src/conf/janetconf.h | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4aa66e61..c5857690 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,7 @@ # Changelog All notable changes to this project will be documented in this file. -## 1.23.0 - ??? +## 1.23.0 - 2022-06-20 - Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available on 64 bit linux, mac, and bsd systems. - Allow using `&named` in function prototypes for named arguments. This is a more ergonomic diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index d711378d..dff90504 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -6,8 +6,8 @@ #define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MINOR 23 #define JANET_VERSION_PATCH 0 -#define JANET_VERSION_EXTRA "-dev" -#define JANET_VERSION "1.23.0-dev" +#define JANET_VERSION_EXTRA "" +#define JANET_VERSION "1.23.0" /* #define JANET_BUILD "local" */ From e4bafc621a5aea51a3264e67110dd887786bf189 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 20 Jun 2022 11:09:41 -0500 Subject: [PATCH 80/89] Remove ssize_t usage. --- src/core/ffi.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/ffi.c b/src/core/ffi.c index e7c0b024..60f7e9dc 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -99,7 +99,7 @@ static const JanetFFIPrimInfo janet_ffi_type_info[] = { struct JanetFFIType { JanetFFIStruct *st; JanetFFIPrimType prim; - ssize_t array_count; + int32_t array_count; }; typedef struct { @@ -533,7 +533,7 @@ static Janet janet_ffi_read_one(const uint8_t *from, JanetFFIType type, int recu el_type.array_count = -1; size_t el_size = type_size(el_type); JanetArray *array = janet_array(type.array_count); - for (ssize_t i = 0; i < type.array_count; i++) { + for (int32_t i = 0; i < type.array_count; i++) { janet_array_push(array, janet_ffi_read_one(from, el_type, recur - 1)); from += el_size; } From 8f0a1ffe5d03d4ea4eb54820171df26af682e025 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 20 Jun 2022 11:23:21 -0500 Subject: [PATCH 81/89] Github showing old git attributes. --- .gitattributes | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitattributes b/.gitattributes index 067fcc21..4ad85d26 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,3 +1,4 @@ +*.janet linguist-language=Janet *.janet text eol=lf *.c text eol=lf *.h text eol=lf From f456369941f912a053422c8da7b8d6a1fe31e0df Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 25 Jun 2022 18:15:58 -0500 Subject: [PATCH 82/89] Add support for a dyn :task-id Adds extra information to default information from supervisor channels. For threaded channels as supervisors, we don't get the source fiber so identifying the source of messages was not possible. This change allows better multithreading with supervisors. --- CHANGELOG.md | 4 ++++ meson.build | 2 +- src/conf/janetconf.h | 6 +++--- src/core/ev.c | 9 +++++++-- 4 files changed, 15 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c5857690..ea45911b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,10 @@ # Changelog All notable changes to this project will be documented in this file. +## 1.23.1 - ??? +- Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to + this change, supverisor messages over threaded channels would be from ambiguous threads/fibers. + ## 1.23.0 - 2022-06-20 - Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available on 64 bit linux, mac, and bsd systems. diff --git a/meson.build b/meson.build index 56adc975..49fc233a 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.23.0') + version : '1.23.1') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index dff90504..f6e56361 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -5,9 +5,9 @@ #define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MINOR 23 -#define JANET_VERSION_PATCH 0 -#define JANET_VERSION_EXTRA "" -#define JANET_VERSION "1.23.0" +#define JANET_VERSION_PATCH 1 +#define JANET_VERSION_EXTRA "-dev" +#define JANET_VERSION "1.23.1-dev" /* #define JANET_BUILD "local" */ diff --git a/src/core/ev.c b/src/core/ev.c index 6e41131e..bfdb1f1d 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -535,10 +535,15 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode); static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice); static Janet make_supervisor_event(const char *name, JanetFiber *fiber, int threaded) { - Janet tup[2]; + Janet tup[3]; tup[0] = janet_ckeywordv(name); tup[1] = threaded ? fiber->last_value : janet_wrap_fiber(fiber) ; - return janet_wrap_tuple(janet_tuple_n(tup, 2)); + if (fiber->env != NULL) { + tup[2] = janet_table_get(fiber->env, janet_ckeywordv("task-id")); + } else { + tup[2] = janet_wrap_nil(); + } + return janet_wrap_tuple(janet_tuple_n(tup, 3)); } /* Common init code */ From 9bde57854a056022d42c5d7cfceae47678895d82 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Tue, 28 Jun 2022 22:51:41 -0500 Subject: [PATCH 83/89] Add `tabseq` macro. --- CHANGELOG.md | 2 ++ src/boot/boot.janet | 17 ++++++++++++----- src/core/pp.c | 3 +-- src/core/string.c | 2 +- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ea45911b..f3e3caa8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. ## 1.23.1 - ??? +- Improve default error message from `assert`. +- Add the `tabseq` macro for simpler table comprehensions. - Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to this change, supverisor messages over threaded channels would be from ambiguous threads/fibers. diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 1c42e6ea..ae6415c5 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -158,7 +158,7 @@ (def ,v ,x) (if ,v ,v - (,error ,(if err err "assert failure"))))) + (,error ,(if err err (string/format "assert failure in %j" x)))))) (defn errorf "A combination of `error` and `string/format`. Equivalent to `(error (string/format fmt ;args))`." @@ -606,13 +606,20 @@ See `loop` for details.`` [head & body] (def $accum (gensym)) - ~(do (def ,$accum @[]) (loop ,head (array/push ,$accum (do ,;body))) ,$accum)) + ~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum)) + +(defmacro tabseq + ``Similar to `loop`, but accumulates key value pairs into a table. + See `loop` for details.`` + [head key-body & value-body] + (def $accum (gensym)) + ~(do (def ,$accum @{}) (loop ,head (,put ,$accum ,key-body (do ,;value-body))) ,$accum)) (defmacro generate ``Create a generator expression using the `loop` syntax. Returns a fiber that yields all values inside the loop in order. See `loop` for details.`` [head & body] - ~(fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi)) + ~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi)) (defmacro coro "A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`." @@ -2768,13 +2775,13 @@ (def c ((:where p) 0)) (def prpt (string "debug[" level "]:" c ":" status "> ")) (getline prpt buf nextenv)) - (print "entering debug[" level "] - (quit) to exit") + (eprint "entering debug[" level "] - (quit) to exit") (flush) (run-context {:chunks debugger-chunks :on-status (debugger-on-status-var nextenv (+ 1 level) true) :env nextenv}) - (print "exiting debug[" level "]") + (eprint "exiting debug[" level "]") (flush) (nextenv :resume-value)) diff --git a/src/core/pp.c b/src/core/pp.c index 1a7ad6a1..af28091e 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -762,8 +762,7 @@ static const char *scanformat( memset(precision, '\0', 3); while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL) p++; /* skip flags */ - if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char)) - janet_panic("invalid format (repeated flags)"); + if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS)) janet_panic("invalid format (repeated flags)"); if (isdigit((int)(*p))) width[0] = *p++; /* skip width */ if (isdigit((int)(*p))) diff --git a/src/core/string.c b/src/core/string.c index e283ead0..632f7a50 100644 --- a/src/core/string.c +++ b/src/core/string.c @@ -530,7 +530,7 @@ JANET_CORE_FN(cfun_string_join, JANET_CORE_FN(cfun_string_format, "(string/format format & values)", - "Similar to `snprintf`, but specialized for operating with Janet values. Returns " + "Similar to C's `snprintf`, but specialized for operating with Janet values. Returns " "a new string.") { janet_arity(argc, 1, -1); JanetBuffer *buffer = janet_buffer(0); From 94a506876fbd0f91ee07be5353518ae9a617135d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Josef=20Pospi=CC=81s=CC=8Cil?= Date: Fri, 1 Jul 2022 12:23:25 +0200 Subject: [PATCH 84/89] Trace function to the stderr --- src/core/vm.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/vm.c b/src/core/vm.c index ae5f8de0..966d4941 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -220,14 +220,14 @@ /* Trace a function call */ static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) { if (func->def->name) { - janet_printf("trace (%S", func->def->name); + janet_eprintf("trace (%S", func->def->name); } else { - janet_printf("trace (%p", janet_wrap_function(func)); + janet_eprintf("trace (%p", janet_wrap_function(func)); } for (int32_t i = 0; i < argc; i++) { - janet_printf(" %p", argv[i]); + janet_eprintf(" %p", argv[i]); } - janet_printf(")\n"); + janet_eprintf(")\n"); } /* Invoke a method once we have looked it up */ From 515891b03537f34d896dbe70ec9a20c04ab03ccb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Josef=20Pospi=CC=81s=CC=8Cil?= Date: Sat, 2 Jul 2022 07:42:52 +0200 Subject: [PATCH 85/89] Add basic test for tabseq --- test/suite0013.janet | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 test/suite0013.janet diff --git a/test/suite0013.janet b/test/suite0013.janet new file mode 100644 index 00000000..1fd0bbdb --- /dev/null +++ b/test/suite0013.janet @@ -0,0 +1,30 @@ +# Copyright (c) 2022 Calvin Rose & contributors +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +# IN THE SOFTWARE. + +(import ./helper :prefix "" :exit true) +(start-suite 13) + +(assert (deep= (tabseq [i :in (range 3)] i (* 3 i)) + @{0 0 1 3 2 6})) + +(assert (deep= (tabseq [i :in (range 3)] i) + @{})) + +(end-suite) From e422abc269e2ef377153066d44e198897b2550a7 Mon Sep 17 00:00:00 2001 From: Stephen Hassard Date: Sat, 2 Jul 2022 08:35:29 -0700 Subject: [PATCH 86/89] Use relative path for include/janet.h symlink When using make to build an rpm, the current symlink is created with an absolute path to the buildroot as causes the make install target to fail with: error: Symlink points to BuildRoot: /usr/include/janet.h -> /home/stephen/rpmbuild/BUILDROOT/janet-1.23.0-3.x86_64/usr/include/janet/janet.h We can create the link relatively which makes this more portable, where: ln -sf -t '/home/stephen/rpmbuild/BUILDROOT/janet-1.23.0-3.x86_64/usr/include' janet.h janet/janet.h Resulting in the following symlink: ls -la BUILDROOT/usr/include/janet.h lrwxrwxrwx. 1 stephen stephen 13 Jul 2 08:17 BUILDROOT/usr/include/janet.h -> janet/janet.h This symlink can then be properly packaged without path issues. Signed-off-by: Stephen Hassard --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 0fdcb64d..e49349ee 100644 --- a/Makefile +++ b/Makefile @@ -283,7 +283,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet' mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet' cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet' - ln -sf '$(DESTDIR)$(INCLUDEDIR)/janet/janet.h' '$(DESTDIR)$(INCLUDEDIR)/janet.h' + ln -sf -t '$(DESTDIR)$(INCLUDEDIR)' janet.h janet/janet.h mkdir -p '$(DESTDIR)$(JANET_PATH)' mkdir -p '$(DESTDIR)$(LIBDIR)' if test $(UNAME) = Darwin ; then \ From 8d0e6ed32f4869040ec22eaf7ed298104421dfb7 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 2 Jul 2022 21:11:05 -0500 Subject: [PATCH 87/89] Fix function handlers for :out and :err. They were not properly handled for formatting functions. --- src/core/io.c | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/core/io.c b/src/core/io.c index 13721e5f..e05e7c01 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -545,6 +545,16 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline, if (newline) janet_buffer_push_u8(buf, '\n'); return janet_wrap_nil(); } + case JANET_FUNCTION: { + /* Special case function */ + JanetFunction *fun = janet_unwrap_function(x); + JanetBuffer *buf = janet_buffer(0); + janet_buffer_format(buf, fmt, offset, argc, argv); + if (newline) janet_buffer_push_u8(buf, '\n'); + Janet args[1] = { janet_wrap_buffer(buf) }; + janet_call(fun, 1, args); + return janet_wrap_nil(); + } case JANET_NIL: f = dflt_file; if (f == NULL) janet_panic("cannot print to nil"); @@ -684,6 +694,16 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) janet_buffer_deinit(&buffer); break; } + case JANET_FUNCTION: { + JanetFunction *fun = janet_unwrap_function(x); + int32_t len = 0; + while (format[len]) len++; + JanetBuffer *buf = janet_buffer(len); + janet_formatbv(buf, format, args); + Janet args[1] = { janet_wrap_buffer(buf) }; + janet_call(fun, 1, args); + break; + } case JANET_BUFFER: janet_formatbv(janet_unwrap_buffer(x), format, args); break; From 435e64d4cfbf203a0c798a3a61d3f115f368a629 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 3 Jul 2022 12:08:21 -0500 Subject: [PATCH 88/89] Allow shorthand for setting task-id on new threads with flag. Avoids the need to wrap function bodies in closures in many cases. --- src/core/ev.c | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/src/core/ev.c b/src/core/ev.c index bfdb1f1d..84c631c4 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -2724,6 +2724,8 @@ JANET_CORE_FN(cfun_ev_go, return janet_wrap_fiber(fiber); } +#define JANET_THREAD_SUPERVISOR_FLAG 0x100 + /* For ev/thread - Run an interpreter in the new thread. */ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) { JanetBuffer *buffer = (JanetBuffer *) args.argp; @@ -2746,7 +2748,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) { } /* Get supervsior */ - if (flags & 0x8) { + if (flags & JANET_THREAD_SUPERVISOR_FLAG) { Janet sup = janet_unmarshal(nextbytes, endbytes - nextbytes, JANET_MARSHAL_UNSAFE, NULL, &nextbytes); @@ -2798,6 +2800,10 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) { } else { fiber = janet_unwrap_fiber(fiberv); } + if (flags & 0x8) { + if (NULL == fiber->env) fiber->env = janet_table(0); + janet_table_put(fiber->env, janet_ckeywordv("task-id"), value); + } fiber->supervisor_channel = janet_vm.user; janet_schedule(fiber, value); janet_loop(); @@ -2842,6 +2848,7 @@ JANET_CORE_FN(cfun_ev_thread, "If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. " "Otherwise, returns nil. Available flags:\n\n" "* `:n` - return immediately\n" + "* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n" "* `:a` - don't copy abstract registry to new thread (performance optimization)\n" "* `:c` - don't copy cfunction registry to new thread (performance optimization)") { janet_arity(argc, 1, 4); @@ -2849,10 +2856,10 @@ JANET_CORE_FN(cfun_ev_thread, if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0); uint64_t flags = 0; if (argc >= 3) { - flags = janet_getflags(argv, 2, "nac"); + flags = janet_getflags(argv, 2, "nact"); } void *supervisor = janet_optabstract(argv, argc, 3, &janet_channel_type, janet_vm.root_fiber->supervisor_channel); - if (NULL != supervisor) flags |= 0x8; + if (NULL != supervisor) flags |= JANET_THREAD_SUPERVISOR_FLAG; /* Marshal arguments for the new thread. */ JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer)); @@ -2863,7 +2870,7 @@ JANET_CORE_FN(cfun_ev_thread, if (!(flags & 0x2)) { janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE); } - if (flags & 0x8) { + if (flags & JANET_THREAD_SUPERVISOR_FLAG) { janet_marshal(buffer, janet_wrap_abstract(supervisor), NULL, JANET_MARSHAL_UNSAFE); } if (!(flags & 0x4)) { From e001efa9fdd6468e9589dfe1dcedb075dcf43048 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 4 Jul 2022 16:48:07 -0500 Subject: [PATCH 89/89] Fix #996 - linking command works on busybox. --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index e49349ee..fb3ecda1 100644 --- a/Makefile +++ b/Makefile @@ -283,7 +283,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet' mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet' cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet' - ln -sf -t '$(DESTDIR)$(INCLUDEDIR)' janet.h janet/janet.h + ln -sf -T ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' mkdir -p '$(DESTDIR)$(JANET_PATH)' mkdir -p '$(DESTDIR)$(LIBDIR)' if test $(UNAME) = Darwin ; then \