mirror of
https://github.com/janet-lang/janet
synced 2024-11-18 06:34:48 +00:00
Merge branch 'master' of github.com:janet-lang/janet
This commit is contained in:
bakpakin
commit
69853c8e5c
@ -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: |
|
||||
|
||||
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -1,3 +1,4 @@
|
||||
*.janet linguist-language=Janet
|
||||
*.janet text eol=lf
|
||||
*.c text eol=lf
|
||||
*.h text eol=lf
|
||||
|
||||
7
.github/workflows/release.yml
vendored
7
.github/workflows/release.yml
vendored
@ -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:
|
||||
|
||||
3
.github/workflows/test.yml
vendored
3
.github/workflows/test.yml
vendored
@ -2,6 +2,9 @@ name: Test
|
||||
|
||||
on: [push, pull_request]
|
||||
|
||||
permissions:
|
||||
contents: read
|
||||
|
||||
jobs:
|
||||
|
||||
test-posix:
|
||||
|
||||
23
CHANGELOG.md
23
CHANGELOG.md
@ -1,6 +1,29 @@
|
||||
# Changelog
|
||||
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.
|
||||
|
||||
## 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
|
||||
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
|
||||
abnormal fiber signals.
|
||||
- Allow running scripts with the `-d` flag to use the built-in debugger on errors and breakpoints.
|
||||
- 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
|
||||
|
||||
## 1.22.0 - 2022-05-09
|
||||
- Prohibit negative size argument to `table/new`.
|
||||
- Add `module/value`.
|
||||
|
||||
@ -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
|
||||
|
||||
7
Makefile
7
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 \
|
||||
@ -167,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
|
||||
@ -282,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 ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||
if test $(UNAME) = Darwin ; then \
|
||||
|
||||
10
README.md
10
README.md
@ -1,7 +1,7 @@
|
||||
[](https://gitter.im/janet-language/community)
|
||||
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
|
||||
[](https://github.com/janet-lang/janet/actions/workflows/test.yml)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
@ -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
|
||||
|
||||
45
examples/evlocks.janet
Normal file
45
examples/evlocks.janet
Normal file
@ -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)
|
||||
71
examples/ffi/gtk.janet
Normal file
71
examples/ffi/gtk.janet
Normal file
@ -0,0 +1,71 @@
|
||||
# :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
|
||||
"Add docstrings as needed."
|
||||
[title :string flags :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
|
||||
[app :ptr argc :int argv :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 (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))
|
||||
(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)
|
||||
# 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))
|
||||
87
examples/ffi/so.c
Normal file
87
examples/ffi/so.c
Normal file
@ -0,0 +1,87 @@
|
||||
#include <stdio.h>
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
void void_fn(void) {
|
||||
printf("void fn ran\n");
|
||||
}
|
||||
|
||||
void void_ret_fn(int x) {
|
||||
printf("void fn ran: %d\n", x);
|
||||
}
|
||||
132
examples/ffi/test.janet
Normal file
132
examples/ffi/test.janet
Normal file
@ -0,0 +1,132 @@
|
||||
#
|
||||
# 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")
|
||||
|
||||
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px)
|
||||
(def module (ffi/native ffi/loc))
|
||||
|
||||
(def int-fn-sig (ffi/signature :default :int :int :int))
|
||||
(def int-fn-pointer (ffi/lookup module "int_fn"))
|
||||
(defn int-fn
|
||||
[x y]
|
||||
(ffi/call int-fn-pointer int-fn-sig x y))
|
||||
|
||||
(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]
|
||||
(ffi/call double-fn-pointer double-fn-sig x y z))
|
||||
|
||||
(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]
|
||||
(ffi/call double-many-pointer double-many-sig x y z w a b))
|
||||
|
||||
(def double-lots-sig (ffi/signature :default :double
|
||||
:double :double :double :double :double
|
||||
:double :double :double :double :double))
|
||||
(def double-lots-pointer (ffi/lookup module "double_lots"))
|
||||
(defn double-lots
|
||||
[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 (ffi/signature :default :double :float :float :float))
|
||||
(def float-fn-pointer (ffi/lookup module "float_fn"))
|
||||
(defn float-fn
|
||||
[x y z]
|
||||
(ffi/call float-fn-pointer float-fn-sig x y z))
|
||||
|
||||
(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]
|
||||
(ffi/call intint-fn-pointer intint-fn-sig x ii))
|
||||
|
||||
(def return-struct-sig (ffi/signature :default [:int :int] :int))
|
||||
(def return-struct-pointer (ffi/lookup module "return_struct"))
|
||||
(defn return-struct-fn
|
||||
[i]
|
||||
(ffi/call return-struct-pointer return-struct-sig i))
|
||||
|
||||
(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]
|
||||
(ffi/call intintint-fn-pointer intintint-fn-sig x iii))
|
||||
|
||||
(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]
|
||||
(ffi/call struct-big-fn-pointer struct-big-fn-sig i d))
|
||||
|
||||
(def void-fn-pointer (ffi/lookup module "void_fn"))
|
||||
(def void-fn-sig (ffi/signature :default :void))
|
||||
(defn void-fn
|
||||
[]
|
||||
(ffi/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))
|
||||
(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]))
|
||||
(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)))
|
||||
(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)))
|
||||
|
||||
#
|
||||
# Struct reading and writing
|
||||
#
|
||||
|
||||
(defn check-round-trip
|
||||
[t value]
|
||||
(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)))
|
||||
|
||||
(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 (ffi/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.")
|
||||
@ -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.23.1')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@ -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',
|
||||
@ -265,4 +267,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
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2021 © Calvin Rose
|
||||
# Copyright 2022 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@ -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
|
||||
@ -162,7 +163,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))`."
|
||||
@ -610,13 +611,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)`."
|
||||
@ -953,12 +961,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))))
|
||||
@ -1596,8 +1604,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)
|
||||
|
||||
@ -1847,7 +1855,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)]))
|
||||
@ -2287,9 +2295,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))
|
||||
@ -2580,6 +2588,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)`.``
|
||||
@ -2737,19 +2759,64 @@
|
||||
(get r 0)
|
||||
v))))
|
||||
|
||||
(def debugger-env
|
||||
"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))
|
||||
(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})
|
||||
(eprint "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. The debugger will
|
||||
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)
|
||||
(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) (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,
|
||||
: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
|
||||
@ -2757,7 +2824,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))
|
||||
@ -2793,14 +2860,17 @@
|
||||
(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
|
||||
:parser parser
|
||||
:source (or src (if path-is-file :<anonymous> spath))}))
|
||||
:source (or source (if path-is-file :<anonymous> spath))}))
|
||||
(if-not path-is-file (:close f))
|
||||
(when exit-error
|
||||
(if exit-fiber
|
||||
@ -2963,7 +3033,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))
|
||||
@ -3082,38 +3152,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))
|
||||
@ -3250,10 +3322,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)))
|
||||
|
||||
@ -3353,25 +3425,26 @@
|
||||
(def pc (frame :pc))
|
||||
(def sourcemap (in dasm :sourcemap))
|
||||
(var last-loc [-2 -2])
|
||||
(print "\n signal: " (.signal))
|
||||
(print " function: " (dasm :name) " [" (in dasm :source "") "]")
|
||||
(eprint "\n signal: " (.signal))
|
||||
(eprint " status: " (fiber/status (.fiber)))
|
||||
(eprint " function: " (get dasm :name "<anonymous>") " [" (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."
|
||||
@ -3380,7 +3453,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."
|
||||
@ -3389,7 +3462,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."
|
||||
@ -3397,7 +3470,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."
|
||||
@ -3406,7 +3479,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."
|
||||
@ -3415,7 +3488,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."
|
||||
@ -3439,10 +3512,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))
|
||||
|
||||
@ -3470,43 +3539,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}))
|
||||
@ -3573,8 +3608,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)
|
||||
@ -3586,6 +3621,74 @@
|
||||
(ev/call (fn [] (net/accept-loop s handler))))
|
||||
s))
|
||||
|
||||
###
|
||||
###
|
||||
### FFI Extra
|
||||
###
|
||||
###
|
||||
|
||||
(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")
|
||||
|
||||
(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."
|
||||
[&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))))
|
||||
(setdyn *ffi-context*
|
||||
@{: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."
|
||||
[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 computed-type-args (eval ~[,;type-args]))
|
||||
(def {:native lib
|
||||
: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 (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))
|
||||
~(defn ,name ,;meta [,;formal-args]
|
||||
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
|
||||
|
||||
###
|
||||
###
|
||||
### Flychecking
|
||||
@ -3656,7 +3759,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)
|
||||
@ -3673,10 +3776,18 @@
|
||||
|
||||
(defn- run-main
|
||||
[env subargs arg]
|
||||
(if-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))))))
|
||||
(when-let [entry (in env 'main)
|
||||
main (or (get entry :value) (in (get entry :ref) 0))]
|
||||
(def guard (if (get env :debug) :ydt :y))
|
||||
(defn wrap-main [&]
|
||||
(main ;subargs))
|
||||
(def f (fiber/new wrap-main guard))
|
||||
(fiber/setenv f env)
|
||||
(var res nil)
|
||||
(while (fiber/can-resume? f)
|
||||
(set res (resume f res))
|
||||
(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.")
|
||||
@ -3838,8 +3949,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))
|
||||
@ -3861,10 +3972,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)
|
||||
@ -3929,6 +4036,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"
|
||||
|
||||
@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#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_MINOR 23
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.23.1-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
||||
@ -23,14 +23,16 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "gc.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Create new userdata */
|
||||
void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
|
||||
@ -85,6 +87,14 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
size_t janet_os_mutex_size(void) {
|
||||
return sizeof(CRITICAL_SECTION);
|
||||
}
|
||||
|
||||
size_t janet_os_rwlock_size(void) {
|
||||
return sizeof(void *);
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return InterlockedIncrement(&ab->gc.data.refcount);
|
||||
}
|
||||
@ -106,11 +116,45 @@ 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);
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
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);
|
||||
}
|
||||
@ -120,19 +164,47 @@ 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((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) {
|
||||
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((pthread_rwlock_t *) rwlock, NULL);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_destroy((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_rdlock((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_wrlock((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
||||
pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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) {
|
||||
|
||||
@ -42,51 +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"
|
||||
#elif defined(JANET_WINDOWS)
|
||||
#include <windows.h>
|
||||
typedef HINSTANCE Clib;
|
||||
#define load_clib(name) LoadLibrary((name))
|
||||
#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 <dlfcn.h>
|
||||
typedef void *Clib;
|
||||
#define load_clib(name) dlopen((name), RTLD_NOW)
|
||||
#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;
|
||||
}
|
||||
|
||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
char *processed_name = get_processed_name(name);
|
||||
Clib lib = load_clib(processed_name);
|
||||
@ -1016,6 +971,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
|
||||
|
||||
148
src/core/ev.c
148
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 {
|
||||
@ -531,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 */
|
||||
@ -643,7 +652,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 +665,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);
|
||||
}
|
||||
|
||||
/*
|
||||
@ -2715,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;
|
||||
@ -2737,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);
|
||||
@ -2789,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();
|
||||
@ -2833,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);
|
||||
@ -2840,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));
|
||||
@ -2854,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)) {
|
||||
@ -3013,6 +3029,106 @@ JANET_CORE_FN(janet_cfun_stream_write,
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static int mutexgc(void *p, size_t size) {
|
||||
(void) size;
|
||||
janet_os_mutex_deinit(p);
|
||||
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;
|
||||
void *mutex = janet_abstract_threaded(&janet_mutex_type, janet_os_mutex_size());
|
||||
janet_os_mutex_init(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);
|
||||
void *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
|
||||
janet_os_mutex_lock(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);
|
||||
void *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
|
||||
janet_os_mutex_unlock(mutex);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int rwlockgc(void *p, size_t size) {
|
||||
(void) size;
|
||||
janet_os_rwlock_deinit(p);
|
||||
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;
|
||||
void *rwlock = janet_abstract_threaded(&janet_rwlock_type, janet_os_rwlock_size());
|
||||
janet_os_rwlock_init(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);
|
||||
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||
janet_os_rwlock_rlock(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);
|
||||
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||
janet_os_rwlock_wlock(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);
|
||||
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||
janet_os_rwlock_runlock(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);
|
||||
void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
|
||||
janet_os_rwlock_wunlock(rwlock);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
void janet_lib_ev(JanetTable *env) {
|
||||
JanetRegExt ev_cfuns_ext[] = {
|
||||
JANET_CORE_REG("ev/give", cfun_channel_push),
|
||||
@ -3035,12 +3151,22 @@ 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_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
|
||||
};
|
||||
|
||||
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);
|
||||
janet_register_abstract_type(&janet_rwlock_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@ -36,13 +36,22 @@
|
||||
# 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
|
||||
|
||||
/* 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.
|
||||
|
||||
1241
src/core/ffi.c
Normal file
1241
src/core/ffi.c
Normal file
File diff suppressed because it is too large
Load Diff
@ -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;
|
||||
|
||||
@ -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),
|
||||
|
||||
@ -39,6 +39,14 @@
|
||||
#include <sys/stat.h>
|
||||
#include <signal.h>
|
||||
|
||||
#ifdef JANET_BSD
|
||||
#include <sys/sysctl.h>
|
||||
#endif
|
||||
|
||||
#ifdef JANET_LINUX
|
||||
#include <sched.h>
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#include <direct.h>
|
||||
@ -201,6 +209,47 @@ 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;
|
||||
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};
|
||||
int result = 0;
|
||||
size_t len = sizeof(int);
|
||||
if (-1 == sysctl(name, 2, &result, &len, 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, NULL, 0)) {
|
||||
return dflt;
|
||||
}
|
||||
return janet_wrap_integer(result);
|
||||
#else
|
||||
return dflt;
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
@ -1296,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
|
||||
@ -2195,6 +2245,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
|
||||
|
||||
@ -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)))
|
||||
@ -983,8 +982,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 {
|
||||
|
||||
@ -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]))
|
||||
: "<multiple bindings>";
|
||||
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("cannot add metadata %v to binding %s", attr, binding_name));
|
||||
break;
|
||||
case JANET_KEYWORD:
|
||||
janet_table_put(tab, attr, janet_wrap_true());
|
||||
@ -822,6 +825,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 +850,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 +860,75 @@ 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) {
|
||||
arity--;
|
||||
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--;
|
||||
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 +947,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;
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
@ -877,6 +884,43 @@ 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;
|
||||
}
|
||||
|
||||
Clib load_clib(const char *name) {
|
||||
if (name == NULL) {
|
||||
return GetModuleHandle(NULL);
|
||||
} else {
|
||||
return LoadLibrary(name);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Alloc function macro fills */
|
||||
void *(janet_malloc)(size_t size) {
|
||||
|
||||
@ -31,6 +31,14 @@
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
#include <stddef.h>
|
||||
#include <stdbool.h>
|
||||
|
||||
#ifdef JANET_EV
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
|
||||
#include <time.h>
|
||||
@ -121,6 +129,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 <windows.h>
|
||||
typedef HINSTANCE Clib;
|
||||
#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 <dlfcn.h>
|
||||
typedef void *Clib;
|
||||
#define load_clib(name) dlopen((name), RTLD_NOW)
|
||||
#define free_clib(lib) dlclose((lib))
|
||||
#define symbol_clib(lib, sym) dlsym((lib), (sym))
|
||||
#define error_clib() dlerror()
|
||||
#endif
|
||||
char *get_processed_name(const char *name);
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
|
||||
/* Initialize builtin libraries */
|
||||
@ -159,5 +192,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
|
||||
|
||||
@ -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 */
|
||||
|
||||
@ -163,6 +163,14 @@ extern "C" {
|
||||
#define JANET_DYNAMIC_MODULES
|
||||
#endif
|
||||
|
||||
/* 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(__EMSCRIPTEN__) && (defined(__x86_64__) || defined(_M_X64))
|
||||
#define JANET_FFI
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Enable or disable the assembler. Enabled by default. */
|
||||
#ifndef JANET_NO_ASSEMBLER
|
||||
#define JANET_ASSEMBLER
|
||||
@ -299,10 +307,10 @@ typedef struct {
|
||||
JANET_CURRENT_CONFIG_BITS })
|
||||
#endif
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#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 *****/
|
||||
@ -322,23 +330,10 @@ typedef struct {
|
||||
#include <stddef.h>
|
||||
#include <stdio.h>
|
||||
|
||||
/* 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;
|
||||
#else
|
||||
#include <pthread.h>
|
||||
typedef pthread_mutex_t JanetOSMutex;
|
||||
#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
|
||||
@ -849,6 +844,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))
|
||||
@ -1180,17 +1176,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 *****/
|
||||
@ -1379,11 +1364,19 @@ 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 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);
|
||||
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);
|
||||
@ -1925,6 +1918,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);
|
||||
@ -2078,16 +2072,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);
|
||||
|
||||
@ -164,36 +164,26 @@
|
||||
|
||||
(:close s))
|
||||
|
||||
(defn check-matching-names [stream]
|
||||
(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 "localname should match peername: msg=%j, buf=%j" msg buf)))
|
||||
|
||||
# Test on both server and client
|
||||
(defn names-handler
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(check-matching-names stream)))
|
||||
# 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 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)))
|
||||
(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
|
||||
|
||||
@ -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
|
||||
@ -80,5 +80,18 @@
|
||||
"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")
|
||||
|
||||
(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)
|
||||
|
||||
|
||||
54
test/suite0012.janet
Normal file
54
test/suite0012.janet
Normal file
@ -0,0 +1,54 @@
|
||||
# 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")
|
||||
|
||||
(def has-ffi (dyn 'ffi/native))
|
||||
|
||||
# FFI check
|
||||
(compwhen has-ffi
|
||||
(ffi/context))
|
||||
(compwhen has-ffi
|
||||
(ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size]))
|
||||
(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)
|
||||
|
||||
30
test/suite0013.janet
Normal file
30
test/suite0013.janet
Normal file
@ -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)
|
||||
0
tools/format.sh
Normal file → Executable file
0
tools/format.sh
Normal file → Executable file
@ -17,6 +17,7 @@
|
||||
"quote"
|
||||
"quasiquote"
|
||||
"unquote"
|
||||
"upscope"
|
||||
"splice"]
|
||||
(all-bindings)))
|
||||
(def allsyms (dyn :allsyms))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user