mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-16 05:34:48 +00:00
Code Issues 1 Releases Wiki Activity

Merge branch 'master' into compile-opt

Browse Source
This commit is contained in:
Calvin Rose 2024-09-08 12:28:51 -05:00
commit 3618b72f4d
56 changed files with 2158 additions and 225 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
.github/workflows/test.yml vendored
View File

@ -89,3 +89,14 @@ jobs:
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
- name: Test the project
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1
test-s390x-linux:
name: Build and test s390x in qemu
runs-on: ubuntu-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Do Qemu build and test
run: |
docker run --rm --privileged multiarch/qemu-user-static --reset -p yes
docker run --rm -v .:/janet s390x/ubuntu bash -c "apt-get -y update && apt-get -y install git build-essential && cd /janet && make -j3 && make test"

31
CHANGELOG.md
View File

@ -1,6 +1,27 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.36.0 - 2024-09-07
- Improve error messages in `bundle/add*` functions.
- Add CI testing and verify tests pass on the s390x architecture.
- Save `:source-form` in environment entries when `*debug*` is set.
- Add experimental `filewatch/` module for listening to file system changes on Linux and Windows.
- Add `bundle/who-is` to query which bundle a file on disk was installed by.
- Add `geomean` function
- Add `:R` and `:W` flags to `os/pipe` to create blocking pipes on Posix and Windows systems.
These streams cannot be directly read to and written from, but can be passed to subprocesses.
- Add `array/join`
- Add `tuple/join`
- Add `bundle/add-bin` to make installing scripts easier. This also establishes a packaging convention for it.
- Fix marshalling weak tables and weak arrays.
- Fix bug in `ev/` module that could accidentally close sockets on accident.
- Expose C functions for constructing weak tables in janet.h
- Let range take non-integer values.
## 1.35.2 - 2024-06-16
- Fix some documentation typos.
- Allow using `:only` in import without quoting.
## 1.35.0 - 2024-06-15
- Add `:only` argument to `import` to allow for easier control over imported bindings.
- Add extra optional `env` argument to `eval` and `eval-string`.
@ -114,7 +135,7 @@ All notable changes to this project will be documented in this file.
See http://no-color.org/
- Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`.
Instead, raise a compiler error.
- Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await`
- Change the names of `:user8` and `:user9` signals to `:interrupt` and `:await`
- Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`.
- Add `ev/all-tasks` to see all currently suspended fibers.
- Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier.
@ -285,7 +306,7 @@ All notable changes to this project will be documented in this file.
- Add the ability to close channels with `ev/chan-close` (or `:close`).
- Add threaded channels with `ev/thread-chan`.
- Add `JANET_FN` and `JANET_REG` macros to more easily define C functions that export their source mapping information.
- Add `janet_interpreter_interupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
- Add `janet_interpreter_interrupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
- Add `table/clear`
- Add build option to disable the threading library without disabling all threads.
- Remove JPM from the main Janet distribution. Instead, JPM must be installed
@ -339,7 +360,7 @@ saving and restoring the entire VM state.
- Sort keys in pretty printing output.
## 1.15.3 - 2021-02-28
- Fix a fiber bug that occured in deeply nested fibers
- Fix a fiber bug that occurred in deeply nested fibers
- Add `unref` combinator to pegs.
- Small docstring changes.
@ -489,13 +510,13 @@ saving and restoring the entire VM state.
- Add `symbol/slice`
- Add `keyword/slice`
- Allow cross compilation with Makefile.
- Change `compare-primitve` to `cmp` and make it more efficient.
- Change `compare-primitive` to `cmp` and make it more efficient.
- Add `reverse!` for reversing an array or buffer in place.
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
- Add `repeat` macro for iterating something n times.
- Add `eachy` (each yield) macro for iterating a fiber.
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexadecimal digits.
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
## 1.10.1 - 2020-06-18

5
Makefile
View File

@ -140,6 +140,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
src/core/ev.c \
src/core/ffi.c \
src/core/fiber.c \
src/core/filewatch.c \
src/core/gc.c \
src/core/inttypes.c \
src/core/io.c \
@ -207,9 +208,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.35.dylib
SONAME=libjanet.1.36.dylib
else
SONAME=libjanet.so.1.35
SONAME=libjanet.so.1.36
endif
build/c/shell.c: src/mainclient/shell.c

3
build_win.bat
View File

@ -50,6 +50,7 @@ for %%f in (src\boot\*.c) do (
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
@if not errorlevel 0 goto :BUILDFAIL
build\janet_boot . > build\c\janet.c
@if not errorlevel 0 goto :BUILDFAIL
@rem Build the sources
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
@ -59,6 +60,7 @@ build\janet_boot . > build\c\janet.c
@rem Build the resources
rc /nologo /fobuild\janet_win.res janet_win.rc
@if not errorlevel 0 goto :BUILDFAIL
@rem Link everything to main client
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
@ -119,7 +121,6 @@ copy README.md dist\README.md
copy janet.lib dist\janet.lib
copy janet.exp dist\janet.exp
copy janet.def dist\janet.def
janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h
copy build\janet.h dist\janet.h

35
examples/chatserver.janet Normal file
View File

@ -0,0 +1,35 @@
(def conmap @{})
(defn broadcast [em msg]
(eachk par conmap
(if (not= par em)
(if-let [tar (get conmap par)]
(net/write tar (string/format "[%s]:%s" em msg))))))
(defn handler
[connection]
(print "connection: " connection)
(net/write connection "Whats your name?\n")
(def name (string/trim (string (ev/read connection 100))))
(print name " connected")
(if (get conmap name)
(do
(net/write connection "Name already taken!")
(:close connection))
(do
(put conmap name connection)
(net/write connection (string/format "Welcome %s\n" name))
(defer (do
(put conmap name nil)
(:close connection))
(while (def msg (ev/read connection 100))
(broadcast name (string msg)))
(print name " disconnected")))))
(defn main [& args]
(printf "STARTING SERVER...")
(flush)
(def my-server (net/listen "127.0.0.1" "8000"))
(forever
(def connection (net/accept my-server))
(ev/call handler connection)))

22
examples/ffi/so.c
View File

@ -35,6 +35,11 @@ typedef struct {
int c;
} intintint;
typedef struct {
uint64_t a;
uint64_t b;
} uint64pair;
typedef struct {
int64_t a;
int64_t b;
@ -203,3 +208,20 @@ EXPORTER
int sixints_fn_3(SixInts s, int x) {
return x + s.u + s.v + s.w + s.x + s.y + s.z;
}
EXPORTER
intint stack_spill_fn(uint8_t a, uint8_t b, uint8_t c, uint8_t d,
uint8_t e, uint8_t f, uint8_t g, uint8_t h,
float i, float j, float k, float l,
float m, float n, float o, float p,
float s1, int8_t s2, uint8_t s3, double s4, uint8_t s5, intint s6) {
return (intint) {
(a | b | c | d | e | f | g | h) + (i + j + k + l + m + n + o + p),
s1 *s6.a + s2 *s6.b + s3 *s4 *s5
};
}
EXPORTER
double stack_spill_fn_2(uint64pair a, uint64pair b, uint64pair c, int8_t d, uint64pair e, int8_t f) {
return (double)(a.a * c.a + a.b * c.b + b.a * e.a) * f - (double)(b.b * e.b) + d;
}

16
examples/ffi/test.janet
View File

@ -8,11 +8,13 @@
(if is-windows
(os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px))
(os/execute ["cc" ffi/source-loc "-g" "-shared" "-o" ffi/loc] :px))
(ffi/context ffi/loc)
(def intint (ffi/struct :int :int))
(def intintint (ffi/struct :int :int :int))
(def uint64pair (ffi/struct :u64 :u64))
(def big (ffi/struct :s64 :s64 :s64))
(def split (ffi/struct :int :int :float :float))
(def split-flip (ffi/struct :float :float :int :int))
@ -55,6 +57,13 @@
(ffi/defbind sixints-fn six-ints [])
(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
(ffi/defbind stack-spill-fn intint
[a :u8 b :u8 c :u8 d :u8
e :u8 f :u8 g :u8 h :u8
i :float j :float k :float l :float
m :float n :float o :float p :float
s1 :float s2 :s8 s3 :u8 s4 :double s5 :u8 s6 intint])
(ffi/defbind stack-spill-fn-2 :double [a uint64pair b uint64pair c uint64pair d :s8 e uint64pair f :s8])
(ffi/defbind-alias int-fn int-fn-aliased :int [a :int b :int])
#
@ -132,5 +141,10 @@
(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
(assert (= 204 (float-fn 8 4 17)))
(assert (= [0 38534415] (stack-spill-fn
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
1.5 -32 196 65536.5 3 [-15 32])))
(assert (= -2806 (stack-spill-fn-2 [2 3] [5 7] [9 11] -19 [13 17] -23)))
(print "Done.")

1
examples/sample-bundle-aliases/aliases-mod.janet Normal file
View File

@ -0,0 +1 @@
(defn fun [x] (range x))

3
examples/sample-bundle-aliases/bundle.janet Normal file
View File

@ -0,0 +1,3 @@
(defn install
[manifest &]
(bundle/add-file manifest "aliases-mod.janet"))

4
examples/sample-bundle-aliases/info.jdn Normal file
View File

@ -0,0 +1,4 @@
@{
:name "sample-bundle-aliases"
:dependencies ["sample-dep1" "sample-dep2"]
}

8
meson.build
View File

@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose and contributors
# Copyright (c) 2024 Calvin Rose and contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.35.0')
version : '1.36.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@ -79,6 +79,7 @@ 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'))
conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit'))
conf.set('JANET_NO_FILEWATCH', not get_option('filewatch'))
conf.set('JANET_NO_CRYPTORAND', not get_option('cryptorand'))
if get_option('os_name') != ''
conf.set('JANET_OS_NAME', get_option('os_name'))
@ -123,6 +124,7 @@ core_src = [
'src/core/ev.c',
'src/core/ffi.c',
'src/core/fiber.c',
'src/core/filewatch.c',
'src/core/gc.c',
'src/core/inttypes.c',
'src/core/io.c',
@ -260,6 +262,7 @@ test_files = [
'test/suite-debug.janet',
'test/suite-ev.janet',
'test/suite-ffi.janet',
'test/suite-filewatch.janet',
'test/suite-inttypes.janet',
'test/suite-io.janet',
'test/suite-marsh.janet',
@ -274,6 +277,7 @@ test_files = [
'test/suite-struct.janet',
'test/suite-symcache.janet',
'test/suite-table.janet',
'test/suite-tuple.janet',
'test/suite-unknown.janet',
'test/suite-value.janet',
'test/suite-vm.janet'

1
meson_options.txt
View File

@ -22,6 +22,7 @@ option('kqueue', type : 'boolean', value : true)
option('interpreter_interrupt', type : 'boolean', value : true)
option('ffi', type : 'boolean', value : true)
option('ffi_jit', type : 'boolean', value : true)
option('filewatch', 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)

198
src/boot/boot.janet
View File

@ -39,6 +39,7 @@
(buffer/format buf "%j" (in args index))
(set index (+ index 1)))
(array/push modifiers (string buf ")\n\n" docstr))
(if (dyn :debug) (array/push modifiers {:source-form (dyn :macro-form)}))
# Build return value
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
@ -116,7 +117,7 @@
(defn nil? "Check if x is nil." [x] (= x nil))
(defn empty? "Check if xs is empty." [xs] (= nil (next xs nil)))
# For macros, we define an imcomplete odd? function that will be overriden.
# For macros, we define an incomplete odd? function that will be overridden.
(defn odd? [x] (= 1 (mod x 2)))
(def- non-atomic-types
@ -153,6 +154,51 @@
,v
(,error ,(if err err (string/format "assert failure in %j" x))))))
(defmacro defdyn
``Define an alias for a keyword that is used as a dynamic binding. The
alias is a normal, lexically scoped binding that can be used instead of
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
called "earmuffs".``
[alias & more]
(assert (symbol? alias) "alias must be a symbol")
(assert (> (length alias) 2) "name must have leading and trailing '*' characters")
(assert (= 42 (get alias 0) (get alias (- (length alias) 1))) "name must have leading and trailing '*' characters")
(def prefix (dyn :defdyn-prefix))
(def kw (keyword prefix (slice alias 1 -2)))
~(def ,alias :dyn ,;more ,kw))
(defdyn *macro-form*
"Inside a macro, is bound to the source form that invoked the macro")
(defdyn *lint-error*
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
(defdyn *lint-warn*
"The current lint warning level. The warning level is the lint level at which and error will be printed but compilation will continue as normal.")
(defdyn *lint-levels*
"A table of keyword alias to numbers denoting a lint level. Can be used to provided custom aliases for numeric lint levels.")
(defdyn *macro-lints*
``Bound to an array of lint messages that will be reported by the compiler inside a macro.
To indicate an error or warning, a macro author should use `maclintf`.``)
(defn maclintf
``When inside a macro, call this function to add a linter warning. Takes
a `fmt` argument like `string/format`, which is used to format the message.``
[level fmt & args]
(def lints (dyn *macro-lints*))
(if lints
(do
(def form (dyn *macro-form*))
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
(def l (if (not= -1 l) l))
(def c (if (not= -1 c) c))
(def msg (string/format fmt ;args))
(array/push lints [level l c msg])))
nil)
(defn errorf
"A combination of `error` and `string/format`. Equivalent to `(error (string/format fmt ;args))`."
[fmt & args]
@ -541,6 +587,11 @@
[x ds & body]
(each-template x ds :each body))
(defn- check-empty-body
[body]
(if (= (length body) 0)
(maclintf :normal "empty loop body")))
(defmacro loop
```
A general purpose loop macro. This macro is similar to the Common Lisp loop
@ -619,6 +670,7 @@
See `loop` for details.``
[head & body]
(def $accum (gensym))
(check-empty-body body)
~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
(defmacro catseq
@ -626,6 +678,7 @@
See `loop` for details.``
[head & body]
(def $accum (gensym))
(check-empty-body body)
~(do (def ,$accum @[]) (loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
(defmacro tabseq
@ -639,6 +692,7 @@
``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]
(check-empty-body body)
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
(defmacro coro
@ -668,6 +722,19 @@
(each x xs (+= accum x) (++ total))
(/ accum total))))
(defn geomean
"Returns the geometric mean of xs. If empty, returns NaN."
[xs]
(if (lengthable? xs)
(do
(var accum 0)
(each x xs (+= accum (math/log x)))
(math/exp (/ accum (length xs))))
(do
(var [accum total] [0 0])
(each x xs (+= accum (math/log x)) (++ total))
(math/exp (/ accum total)))))
(defn product
"Returns the product of xs. If xs is empty, returns 1."
[xs]
@ -776,11 +843,21 @@
(defmacro- do-compare
[x y]
~(if (def f (get ,x :compare))
(f ,x ,y)
(if (def f (get ,y :compare))
(- (f ,y ,x))
(cmp ,x ,y))))
(def f (gensym))
(def f-res (gensym))
(def g (gensym))
(def g-res (gensym))
~(do
(def ,f (,get ,x :compare))
(def ,f-res (if ,f (,f ,x ,y)))
(if ,f-res
,f-res
(do
(def ,g (,get ,y :compare))
(def ,g-res (if ,g (,- (,g ,y ,x))))
(if ,g-res
,g-res
(,cmp ,x ,y))))))
(defn compare
``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
@ -1217,19 +1294,6 @@
(array/push parts (tuple apply f $args)))
(tuple 'fn :juxt (tuple '& $args) (tuple/slice parts 0)))
(defmacro defdyn
``Define an alias for a keyword that is used as a dynamic binding. The
alias is a normal, lexically scoped binding that can be used instead of
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
called "earmuffs".``
[alias & more]
(assert (symbol? alias) "alias must be a symbol")
(assert (and (> (length alias) 2) (= 42 (first alias) (last alias))) "name must have leading and trailing '*' characters")
(def prefix (dyn :defdyn-prefix))
(def kw (keyword prefix (slice alias 1 -2)))
~(def ,alias :dyn ,;more ,kw))
(defn has-key?
"Check if a data structure `ds` contains the key `key`."
[ds key]
@ -1250,18 +1314,6 @@
(defdyn *exit-value* "Set the return value from `run-context` upon an exit. By default, `run-context` will return nil.")
(defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrency control.")
(defdyn *macro-form*
"Inside a macro, is bound to the source form that invoked the macro")
(defdyn *lint-error*
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
(defdyn *lint-warn*
"The current lint warning level. The warning level is the lint level at which and error will be printed but compilation will continue as normal.")
(defdyn *lint-levels*
"A table of keyword alias to numbers denoting a lint level. Can be used to provided custom aliases for numeric lint levels.")
(defdyn *current-file*
"Bound to the name of the currently compiling file.")
@ -2045,24 +2097,6 @@
###
###
(defdyn *macro-lints*
``Bound to an array of lint messages that will be reported by the compiler inside a macro.
To indicate an error or warning, a macro author should use `maclintf`.``)
(defn maclintf
``When inside a macro, call this function to add a linter warning. Takes
a `fmt` argument like `string/format`, which is used to format the message.``
[level fmt & args]
(def lints (dyn *macro-lints*))
(when lints
(def form (dyn *macro-form*))
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
(def l (if-not (= -1 l) l))
(def c (if-not (= -1 c) c))
(def msg (string/format fmt ;args))
(array/push lints [level l c msg]))
nil)
(defn macex1
``Expand macros in a form, but do not recursively expand macros.
See `macex` docs for info on `on-binding`.``
@ -3857,7 +3891,7 @@
(string/replace-all "-" "_" name))
(defn ffi/context
"Set the path of the dynamic library to implictly bind, as well
"Set the path of the dynamic library to implicitly 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)
@ -4032,15 +4066,18 @@
(defn- copyfile
[from to]
(def mode (os/stat from :permissions))
(if-with [ffrom (file/open from :rb)]
(if-with [fto (file/open to :wb)]
(do
(def perm (os/stat from :permissions))
(def b (buffer/new 0x10000))
(with [ffrom (file/open from :rb)]
(with [fto (file/open to :wb)]
(forever
(file/read ffrom 0x10000 b)
(when (empty? b) (buffer/trim b) (os/chmod to mode) (break))
(when (empty? b) (buffer/trim b) (os/chmod to perm) (break))
(file/write fto b)
(buffer/clear b)))))
(buffer/clear b)))
(errorf "destination file %s cannot be opened for writing" to))
(errorf "source file %s cannot be opened for reading" from)))
(defn- copyrf
[from to]
@ -4189,14 +4226,15 @@
(not (not (os/stat (bundle-dir bundle-name) :mode))))
(defn bundle/install
"Install a bundle from the local filesystem. The name of the bundle will be infered from the bundle, or passed as a parameter :name in `config`."
"Install a bundle from the local filesystem. The name of the bundle will be inferred from the bundle, or passed as a parameter :name in `config`."
[path &keys config]
(def path (bundle-rpath path))
(def clean (get config :clean))
(def check (get config :check))
(def s (sep))
# Check meta file for dependencies and default name
(def infofile-pre (string path s "bundle" s "info.jdn"))
(def infofile-pre-1 (string path s "bundle" s "info.jdn"))
(def infofile-pre (if (fexists infofile-pre-1) infofile-pre-1 (string path s "info.jdn"))) # allow for alias
(var default-bundle-name nil)
(when (os/stat infofile-pre :mode)
(def info (-> infofile-pre slurp parse))
@ -4216,6 +4254,10 @@
# Setup installed paths
(prime-bundle-paths)
(os/mkdir (bundle-dir bundle-name))
# Aliases for common bundle/ files
(def bundle.janet (string path s "bundle.janet"))
(when (fexists bundle.janet) (copyfile bundle.janet (bundle-file bundle-name "init.janet")))
(when (fexists infofile-pre) (copyfile infofile-pre (bundle-file bundle-name "info.jdn")))
# Copy some files into the new location unconditionally
(def implicit-sources (string path s "bundle"))
(when (= :directory (os/stat implicit-sources :mode))
@ -4316,6 +4358,19 @@
(print "add " absdest)
absdest)
(defn bundle/whois
"Given a file path, figure out which bundle installed it."
[path]
(var ret nil)
(def rpath (bundle-rpath path))
(each bundle-name (bundle/list)
(def files (get (bundle/manifest bundle-name) :files []))
(def has-file (index-of rpath files))
(when has-file
(set ret bundle-name)
(break)))
ret)
(defn bundle/add-file
"Add files during an install relative to `(dyn *syspath*)`"
[manifest src &opt dest chmod-mode]
@ -4340,12 +4395,24 @@
[manifest src &opt dest chmod-mode]
(default dest src)
(def s (sep))
(case (os/stat src :mode)
(def mode (os/stat src :mode))
(if-not mode (errorf "file %s does not exist" src))
(case mode
:directory
(let [absdest (bundle/add-directory manifest dest chmod-mode)]
(each d (os/dir src) (bundle/add manifest (string src s d) (string dest s d) chmod-mode))
absdest)
:file (bundle/add-file manifest src dest chmod-mode)))
:file (bundle/add-file manifest src dest chmod-mode)
(errorf "bad path %s - file is a %s" src mode)))
(defn bundle/add-bin
`Shorthand for adding scripts during an install. Scripts will be installed to
(string (dyn *syspath*) "/bin") by default and will be set to be executable.`
[manifest src &opt dest chmod-mode]
(default dest (last (string/split "/" src)))
(default chmod-mode 8r755)
(os/mkdir (string (dyn *syspath*) (sep) "bin"))
(bundle/add-file manifest src (string "bin" (sep) dest) chmod-mode))
(defn bundle/update-all
"Reinstall all bundles"
@ -4485,7 +4552,13 @@
"c" (fn c-switch [i &]
(def path (in args (+ i 1)))
(def e (dofile path))
(spit (in args (+ i 2)) (make-image e))
(def output-path
(if (< (+ i 2) (length args))
(in args (+ i 2))
(string
(if (string/has-suffix? ".janet" path) (string/slice path 0 -7) path)
".jimage")))
(spit output-path (make-image e))
(set no-file false)
3)
"-" (fn [&] (set handleopts false) 1)
@ -4598,6 +4671,10 @@
(put flat :doc nil))
(when (boot/config :no-sourcemaps)
(put flat :source-map nil))
(unless (boot/config :no-docstrings)
(unless (v :private)
(unless (v :doc)
(errorf "no docs: %v %p" k v)))) # make sure we have docs
# Fix directory separators on windows to make image identical between windows and non-windows
(when-let [sm (get flat :source-map)]
(put flat :source-map [(string/replace-all "\\" "/" (sm 0)) (sm 1) (sm 2)]))
@ -4656,6 +4733,7 @@
"src/core/ev.c"
"src/core/ffi.c"
"src/core/fiber.c"
"src/core/filewatch.c"
"src/core/gc.c"
"src/core/inttypes.c"
"src/core/io.c"

7
src/boot/system_test.c
View File

@ -22,7 +22,7 @@
#include <janet.h>
#include <assert.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include "tests.h"
@ -35,6 +35,11 @@ int system_test() {
assert(sizeof(void *) == 8);
#endif
/* Check the version defines are self consistent */
char version_combined[256];
sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
assert(!strcmp(JANET_VERSION, version_combined));
/* Reflexive testing and nanbox testing */
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));

5
src/conf/janetconf.h
View File

@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 35
#define JANET_VERSION_MINOR 36
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.35.0"
#define JANET_VERSION "1.36.0"
/* #define JANET_BUILD "local" */
@ -29,6 +29,7 @@
/* #define JANET_NO_NET */
/* #define JANET_NO_INT_TYPES */
/* #define JANET_NO_EV */
/* #define JANET_NO_FILEWATCH */
/* #define JANET_NO_REALPATH */
/* #define JANET_NO_SYMLINKS */
/* #define JANET_NO_UMASK */

26
src/core/array.c
View File

@ -275,6 +275,31 @@ JANET_CORE_FN(cfun_array_concat,
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_join,
"(array/join arr & parts)",
"Join a variable number of arrays and tuples into the first argument, "
"which must be an array. "
"Return the modified array `arr`.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetArray *array = janet_getarray(argv, 0);
for (i = 1; i < argc; i++) {
int32_t j, len = 0;
const Janet *vals = NULL;
if (!janet_indexed_view(argv[i], &vals, &len)) {
janet_panicf("expected indexed type for argument %d, got %v", i, argv[i]);
}
if (array->data == vals) {
int32_t newcount = array->count + len;
janet_array_ensure(array, newcount, 2);
janet_indexed_view(argv[i], &vals, &len);
}
for (j = 0; j < len; j++)
janet_array_push(array, vals[j]);
}
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_insert,
"(array/insert arr at & xs)",
"Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
@ -385,6 +410,7 @@ void janet_lib_array(JanetTable *env) {
JANET_CORE_REG("array/remove", cfun_array_remove),
JANET_CORE_REG("array/trim", cfun_array_trim),
JANET_CORE_REG("array/clear", cfun_array_clear),
JANET_CORE_REG("array/join", cfun_array_join),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, array_cfuns);

64
src/core/buffer.c
View File

@ -371,17 +371,15 @@ JANET_CORE_FN(cfun_buffer_push_uint16,
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
uint16_t data;
uint8_t bytes[2];
} u;
u.data = janet_getuinteger16(argv, 2);
uint16_t data = janet_getuinteger16(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse) {
uint8_t temp = u.bytes[1];
u.bytes[1] = u.bytes[0];
u.bytes[0] = temp;
uint8_t temp = bytes[1];
bytes[1] = bytes[0];
bytes[0] = temp;
}
janet_buffer_push_u16(buffer, *(uint16_t *) u.bytes);
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}
@ -392,14 +390,12 @@ JANET_CORE_FN(cfun_buffer_push_uint32,
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
uint32_t data;
uint8_t bytes[4];
} u;
u.data = janet_getuinteger(argv, 2);
uint32_t data = janet_getuinteger(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse)
reverse_u32(u.bytes);
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
reverse_u32(bytes);
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}
@ -410,14 +406,12 @@ JANET_CORE_FN(cfun_buffer_push_uint64,
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
uint64_t data;
uint8_t bytes[8];
} u;
u.data = janet_getuinteger64(argv, 2);
uint64_t data = janet_getuinteger64(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse)
reverse_u64(u.bytes);
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
reverse_u64(bytes);
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}
@ -428,14 +422,12 @@ JANET_CORE_FN(cfun_buffer_push_float32,
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
float data;
uint8_t bytes[4];
} u;
u.data = (float) janet_getnumber(argv, 2);
float data = (float) janet_getnumber(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse)
reverse_u32(u.bytes);
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
reverse_u32(bytes);
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}
@ -446,14 +438,12 @@ JANET_CORE_FN(cfun_buffer_push_float64,
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
double data;
uint8_t bytes[8];
} u;
u.data = janet_getnumber(argv, 2);
double data = janet_getnumber(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse)
reverse_u64(u.bytes);
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
reverse_u64(bytes);
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}

4
src/core/bytecode.c
View File

@ -140,7 +140,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
/* relative pc is in DS field of instruction */
old_jump_target = i + (((int32_t)instr) >> 8);
new_jump_target = pc_map[old_jump_target];
instr += (new_jump_target - old_jump_target + (i - j)) << 8;
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 8;
break;
case JOP_JUMP_IF:
case JOP_JUMP_IF_NIL:
@ -149,7 +149,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
/* relative pc is in ES field of instruction */
old_jump_target = i + (((int32_t)instr) >> 16);
new_jump_target = pc_map[old_jump_target];
instr += (new_jump_target - old_jump_target + (i - j)) << 16;
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 16;
break;
default:
break;

28
src/core/capi.c
View File

@ -25,6 +25,7 @@
#include <janet.h>
#include "state.h"
#include "fiber.h"
#include "util.h"
#endif
#ifndef JANET_SINGLE_THREADED
@ -463,6 +464,33 @@ void janet_setdyn(const char *name, Janet value) {
}
}
/* Create a function that when called, returns X. Trivial in Janet, a pain in C. */
JanetFunction *janet_thunk_delay(Janet x) {
static const uint32_t bytecode[] = {
JOP_LOAD_CONSTANT,
JOP_RETURN
};
JanetFuncDef *def = janet_funcdef_alloc();
def->arity = 0;
def->min_arity = 0;
def->max_arity = INT32_MAX;
def->flags = JANET_FUNCDEF_FLAG_VARARG;
def->slotcount = 1;
def->bytecode = janet_malloc(sizeof(bytecode));
def->bytecode_length = (int32_t)(sizeof(bytecode) / sizeof(uint32_t));
def->constants = janet_malloc(sizeof(Janet));
def->constants_length = 1;
def->name = NULL;
if (!def->bytecode || !def->constants) {
JANET_OUT_OF_MEMORY;
}
def->constants[0] = x;
memcpy(def->bytecode, bytecode, sizeof(bytecode));
janet_def_addflags(def);
/* janet_verify(def); */
return janet_thunk(def);
}
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
uint64_t ret = 0;
const uint8_t *keyw = janet_getkeyword(argv, n);

2
src/core/compile.h
View File

@ -262,7 +262,7 @@ void janetc_popscope(JanetCompiler *c);
void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot);
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
/* Create a destory slots */
/* Create a destroy slot */
JanetSlot janetc_cslot(Janet x);
/* Search for a symbol */

42
src/core/corelib.c
View File

@ -432,27 +432,38 @@ JANET_CORE_FN(janet_core_range,
"With one argument, returns a range [0, end). With two arguments, returns "
"a range [start, end). With three, returns a range with optional step size.") {
janet_arity(argc, 1, 3);
int32_t start = 0, stop = 0, step = 1, count = 0;
double start = 0, stop = 0, step = 1, count = 0;
if (argc == 3) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
step = janet_getinteger(argv, 2);
count = (step > 0) ? (stop - start - 1) / step + 1 :
((step < 0) ? (stop - start + 1) / step + 1 : 0);
start = janet_getnumber(argv, 0);
stop = janet_getnumber(argv, 1);
step = janet_getnumber(argv, 2);
count = (step > 0) ? (stop - start) / step :
((step < 0) ? (stop - start) / step : 0);
} else if (argc == 2) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
start = janet_getnumber(argv, 0);
stop = janet_getnumber(argv, 1);
count = stop - start;
} else {
stop = janet_getinteger(argv, 0);
stop = janet_getnumber(argv, 0);
count = stop;
}
count = (count > 0) ? count : 0;
JanetArray *array = janet_array(count);
for (int32_t i = 0; i < count; i++) {
array->data[i] = janet_wrap_number(start + i * step);
int32_t int_count;
if (count > (double) INT32_MAX) {
int_count = INT32_MAX;
} else {
int_count = (int32_t) ceil(count);
}
array->count = count;
if (step > 0.0) {
janet_assert(start + int_count * step >= stop, "bad range code");
} else {
janet_assert(start + int_count * step <= stop, "bad range code");
}
JanetArray *array = janet_array(int_count);
for (int32_t i = 0; i < int_count; i++) {
array->data[i] = janet_wrap_number((double) start + (double) i * step);
}
array->count = int_count;
return janet_wrap_array(array);
}
@ -976,7 +987,7 @@ static void make_apply(JanetTable *env) {
/* Push the array */
S(JOP_PUSH_ARRAY, 5),
/* Call the funciton */
/* Call the function */
S(JOP_TAILCALL, 0)
};
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
@ -1121,6 +1132,9 @@ static void janet_load_libs(JanetTable *env) {
#endif
#ifdef JANET_EV
janet_lib_ev(env);
#ifdef JANET_FILEWATCH
janet_lib_filewatch(env);
#endif
#endif
#ifdef JANET_NET
janet_lib_net(env);

2
src/core/debug.c
View File

@ -102,7 +102,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
}
/* Error reporting. This can be emulated from within Janet, but for
* consitency with the top level code it is defined once. */
* consistency with the top level code it is defined once. */
void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
int32_t fi;

81
src/core/ev.c
View File

@ -74,7 +74,7 @@ typedef struct {
} mode;
} JanetChannelPending;
typedef struct {
struct JanetChannel {
JanetQueue items;
JanetQueue read_pending;
JanetQueue write_pending;
@ -86,7 +86,7 @@ typedef struct {
#else
pthread_mutex_t lock;
#endif
} JanetChannel;
};
typedef struct {
JanetFiber *fiber;
@ -255,6 +255,12 @@ static void add_timeout(JanetTimeout to) {
void janet_async_end(JanetFiber *fiber) {
if (fiber->ev_callback) {
if (fiber->ev_stream->read_fiber == fiber) {
fiber->ev_stream->read_fiber = NULL;
}
if (fiber->ev_stream->write_fiber == fiber) {
fiber->ev_stream->write_fiber = NULL;
}
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_DEINIT);
janet_gcunroot(janet_wrap_abstract(fiber->ev_stream));
fiber->ev_callback = NULL;
@ -276,8 +282,7 @@ void janet_async_in_flight(JanetFiber *fiber) {
#endif
}
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
JanetFiber *fiber = janet_vm.root_fiber;
void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
janet_assert(!fiber->ev_callback, "double async on fiber");
if (mode & JANET_ASYNC_LISTEN_READ) {
stream->read_fiber = fiber;
@ -291,6 +296,10 @@ void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback
janet_gcroot(janet_wrap_abstract(stream));
fiber->ev_state = state;
callback(fiber, JANET_ASYNC_EVENT_INIT);
}
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
janet_async_start_fiber(janet_vm.root_fiber, stream, mode, callback, state);
janet_await();
}
@ -316,8 +325,9 @@ static const JanetMethod ev_default_stream_methods[] = {
};
/* Create a stream*/
JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods) {
JanetStream *stream = janet_abstract(&janet_stream_type, sizeof(JanetStream));
JanetStream *janet_stream_ext(JanetHandle handle, uint32_t flags, const JanetMethod *methods, size_t size) {
janet_assert(size >= sizeof(JanetStream), "bad size");
JanetStream *stream = janet_abstract(&janet_stream_type, size);
stream->handle = handle;
stream->flags = flags;
stream->read_fiber = NULL;
@ -329,6 +339,10 @@ JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod
return stream;
}
JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods) {
return janet_stream_ext(handle, flags, methods, sizeof(JanetStream));
}
static void janet_stream_close_impl(JanetStream *stream) {
stream->flags |= JANET_STREAM_CLOSED;
#ifdef JANET_WINDOWS
@ -433,7 +447,7 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
}
janet_marshal_int64(ctx, (int64_t)(duph));
#else
/* Marshal after dup becuse it is easier than maintaining our own ref counting. */
/* Marshal after dup because it is easier than maintaining our own ref counting. */
int duph = dup(s->handle);
if (duph < 0) janet_panicf("failed to duplicate stream handle: %V", janet_ev_lasterr());
janet_marshal_int(ctx, (int32_t)(duph));
@ -469,7 +483,7 @@ static Janet janet_stream_next(void *p, Janet key) {
static void janet_stream_tostring(void *p, JanetBuffer *buffer) {
JanetStream *stream = p;
/* Let user print the file descriptor for debugging */
janet_formatb(buffer, "<core/stream handle=%d>", stream->handle);
janet_formatb(buffer, "[fd=%d]", stream->handle);
}
const JanetAbstractType janet_stream_type = {
@ -595,7 +609,7 @@ void janet_ev_deinit_common(void) {
/* Shorthand to yield to event loop */
void janet_await(void) {
/* Store the fiber in a gobal table */
/* Store the fiber in a global table */
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
}
@ -866,7 +880,7 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
/* No root fiber, we are in completion on a root fiber. Don't block. */
if (mode == 2) {
janet_chan_unlock(channel);
return 0;
return 1;
}
/* Pushed successfully, but should block. */
JanetChannelPending pending;
@ -922,6 +936,7 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i
int is_threaded = janet_chan_is_threaded(channel);
if (janet_q_pop(&channel->items, item, sizeof(Janet))) {
/* Queue empty */
if (is_choice == 2) return 0; // Skip pending read
JanetChannelPending pending;
pending.thread = &janet_vm;
pending.fiber = janet_vm.root_fiber,
@ -979,6 +994,28 @@ JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, Janet
}
}
int janet_channel_give(JanetChannel *channel, Janet x) {
return janet_channel_push(channel, x, 2);
}
int janet_channel_take(JanetChannel *channel, Janet *out) {
return janet_channel_pop(channel, out, 2);
}
JanetChannel *janet_channel_make(uint32_t limit) {
janet_assert(limit <= INT32_MAX, "bad limit");
JanetChannel *channel = janet_abstract(&janet_channel_type, sizeof(JanetChannel));
janet_chan_init(channel, (int32_t) limit, 0);
return channel;
}
JanetChannel *janet_channel_make_threaded(uint32_t limit) {
janet_assert(limit <= INT32_MAX, "bad limit");
JanetChannel *channel = janet_abstract_threaded(&janet_channel_type, sizeof(JanetChannel));
janet_chan_init(channel, (int32_t) limit, 0);
return channel;
}
/* Channel Methods */
JANET_CORE_FN(cfun_channel_push,
@ -1471,13 +1508,16 @@ void janet_ev_deinit(void) {
static void janet_register_stream(JanetStream *stream) {
if (NULL == CreateIoCompletionPort(stream->handle, janet_vm.iocp, (ULONG_PTR) stream, 0)) {
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | JANET_STREAM_ACCEPTABLE)) {
janet_panicf("failed to listen for events: %V", janet_ev_lasterr());
}
stream->flags |= JANET_STREAM_UNREGISTERED;
}
}
void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
ULONG_PTR completionKey = 0;
DWORD num_bytes_transfered = 0;
DWORD num_bytes_transferred = 0;
LPOVERLAPPED overlapped = NULL;
/* Calculate how long to wait before timeout */
@ -1492,7 +1532,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
} else {
waittime = INFINITE;
}
BOOL result = GetQueuedCompletionStatus(janet_vm.iocp, &num_bytes_transfered, &completionKey, &overlapped, (DWORD) waittime);
BOOL result = GetQueuedCompletionStatus(janet_vm.iocp, &num_bytes_transferred, &completionKey, &overlapped, (DWORD) waittime);
if (result || overlapped) {
if (0 == completionKey) {
@ -1515,7 +1555,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
if (fiber != NULL) {
fiber->flags &= ~JANET_FIBER_EV_FLAG_IN_FLIGHT;
/* System is done with this, we can reused this data */
overlapped->InternalHigh = (ULONG_PTR) num_bytes_transfered;
overlapped->InternalHigh = (ULONG_PTR) num_bytes_transferred;
fiber->ev_callback(fiber, result ? JANET_ASYNC_EVENT_COMPLETE : JANET_ASYNC_EVENT_FAILED);
} else {
janet_free((void *) overlapped);
@ -2327,6 +2367,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
} else {
janet_schedule(fiber, janet_wrap_nil());
}
stream->read_fiber = NULL;
janet_async_end(fiber);
break;
}
@ -2699,6 +2740,7 @@ static volatile long PipeSerialNumber;
* mode = 0: both sides non-blocking.
* mode = 1: only read side non-blocking: write side sent to subprocess
* mode = 2: only write side non-blocking: read side sent to subprocess
* mode = 3: both sides blocking - for use in two subprocesses (making pipeline from external processes)
*/
int janet_make_pipe(JanetHandle handles[2], int mode) {
#ifdef JANET_WINDOWS
@ -2712,6 +2754,11 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
memset(&saAttr, 0, sizeof(saAttr));
saAttr.nLength = sizeof(saAttr);
saAttr.bInheritHandle = TRUE;
if (mode == 3) {
/* No overlapped IO involved, just call CreatePipe */
if (!CreatePipe(handles, handles + 1, &saAttr, 0)) return -1;
return 0;
}
sprintf(PipeNameBuffer,
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
(unsigned int) GetCurrentProcessId(),
@ -2757,8 +2804,8 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
if (pipe(handles)) return -1;
if (mode != 2 && fcntl(handles[0], F_SETFD, FD_CLOEXEC)) goto error;
if (mode != 1 && fcntl(handles[1], F_SETFD, FD_CLOEXEC)) goto error;
if (mode != 2 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
if (mode != 1 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
if (mode != 2 && mode != 3 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
if (mode != 1 && mode != 3 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
return 0;
error:
close(handles[0]);
@ -2832,7 +2879,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
}
/* Get supervsior */
/* Get supervisor */
if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
Janet sup =
janet_unmarshal(nextbytes, endbytes - nextbytes,
@ -3269,6 +3316,8 @@ void janet_lib_ev(JanetTable *env) {
janet_register_abstract_type(&janet_channel_type);
janet_register_abstract_type(&janet_mutex_type);
janet_register_abstract_type(&janet_rwlock_type);
janet_lib_filewatch(env);
}
#endif

310
src/core/ffi.c
View File

@ -56,6 +56,9 @@
#if (defined(__x86_64__) || defined(_M_X64)) && !defined(JANET_WINDOWS)
#define JANET_FFI_SYSV64_ENABLED
#endif
#if (defined(__aarch64__) || defined(_M_ARM64)) && !defined(JANET_WINDOWS)
#define JANET_FFI_AAPCS64_ENABLED
#endif
typedef struct JanetFFIType JanetFFIType;
typedef struct JanetFFIStruct JanetFFIStruct;
@ -140,7 +143,13 @@ typedef enum {
JANET_WIN64_REGISTER,
JANET_WIN64_STACK,
JANET_WIN64_REGISTER_REF,
JANET_WIN64_STACK_REF
JANET_WIN64_STACK_REF,
JANET_AAPCS64_GENERAL,
JANET_AAPCS64_SSE,
JANET_AAPCS64_GENERAL_REF,
JANET_AAPCS64_STACK,
JANET_AAPCS64_STACK_REF,
JANET_AAPCS64_NONE
} JanetFFIWordSpec;
/* Describe how each Janet argument is interpreted in terms of machine words
@ -155,13 +164,16 @@ typedef struct {
typedef enum {
JANET_FFI_CC_NONE,
JANET_FFI_CC_SYSV_64,
JANET_FFI_CC_WIN_64
JANET_FFI_CC_WIN_64,
JANET_FFI_CC_AAPCS64
} JanetFFICallingConvention;
#ifdef JANET_FFI_WIN64_ENABLED
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_WIN_64
#elif defined(JANET_FFI_SYSV64_ENABLED)
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_SYSV_64
#elif defined(JANET_FFI_AAPCS64_ENABLED)
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_AAPCS64
#else
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_NONE
#endif
@ -301,6 +313,9 @@ static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) {
#endif
#ifdef JANET_FFI_SYSV64_ENABLED
if (!janet_cstrcmp(name, "sysv64")) return JANET_FFI_CC_SYSV_64;
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
if (!janet_cstrcmp(name, "aapcs64")) return JANET_FFI_CC_AAPCS64;
#endif
if (!janet_cstrcmp(name, "default")) return JANET_FFI_CC_DEFAULT;
janet_panicf("unknown calling convention %s", name);
@ -475,7 +490,7 @@ JANET_CORE_FN(cfun_ffi_align,
static void *janet_ffi_getpointer(const Janet *argv, int32_t n) {
switch (janet_type(argv[n])) {
default:
janet_panicf("bad slot #%d, expected ffi pointer convertable type, got %v", n, argv[n]);
janet_panicf("bad slot #%d, expected ffi pointer convertible type, got %v", n, argv[n]);
case JANET_POINTER:
case JANET_STRING:
case JANET_KEYWORD:
@ -763,6 +778,101 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
}
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
/* Procedure Call Standard for the Arm® 64-bit Architecture (AArch64) 2023Q3 – October 6, 2023
* See section 6.8.2 Parameter passing rules.
* https://github.com/ARM-software/abi-aa/releases/download/2023Q3/aapcs64.pdf
*
* Additional documentation needed for Apple platforms.
* https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms */
#define JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, alignment) (ptr = ((ptr) + ((alignment) - 1)) & ~((alignment) - 1))
#if !defined(JANET_APPLE)
#define JANET_FFI_AAPCS64_STACK_ALIGN(ptr, alignment) ((void) alignment, JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, 8))
#else
#define JANET_FFI_AAPCS64_STACK_ALIGN(ptr, alignment) JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, alignment)
#endif
typedef struct {
uint64_t a;
uint64_t b;
} Aapcs64Variant1ReturnGeneral;
typedef struct {
double a;
double b;
double c;
double d;
} Aapcs64Variant2ReturnSse;
/* Workaround for passing a return value pointer through x8.
* Limits struct returns to 128 bytes. */
typedef struct {
uint64_t a;
uint64_t b;
uint64_t c;
uint64_t d;
uint64_t e;
uint64_t f;
uint64_t g;
uint64_t h;
uint64_t i;
uint64_t j;
uint64_t k;
uint64_t l;
uint64_t m;
uint64_t n;
uint64_t o;
uint64_t p;
} Aapcs64Variant3ReturnPointer;
static JanetFFIWordSpec aapcs64_classify(JanetFFIType type) {
switch (type.prim) {
case JANET_FFI_TYPE_PTR:
case JANET_FFI_TYPE_STRING:
case JANET_FFI_TYPE_BOOL:
case JANET_FFI_TYPE_INT8:
case JANET_FFI_TYPE_INT16:
case JANET_FFI_TYPE_INT32:
case JANET_FFI_TYPE_INT64:
case JANET_FFI_TYPE_UINT8:
case JANET_FFI_TYPE_UINT16:
case JANET_FFI_TYPE_UINT32:
case JANET_FFI_TYPE_UINT64:
return JANET_AAPCS64_GENERAL;
case JANET_FFI_TYPE_DOUBLE:
case JANET_FFI_TYPE_FLOAT:
return JANET_AAPCS64_SSE;
case JANET_FFI_TYPE_STRUCT: {
JanetFFIStruct *st = type.st;
if (st->field_count <= 4 && aapcs64_classify(st->fields[0].type) == JANET_AAPCS64_SSE) {
bool is_hfa = true;
for (uint32_t i = 1; i < st->field_count; i++) {
if (st->fields[0].type.prim != st->fields[i].type.prim) {
is_hfa = false;
break;
}
}
if (is_hfa) {
return JANET_AAPCS64_SSE;
}
}
if (type_size(type) > 16) {
return JANET_AAPCS64_GENERAL_REF;
}
return JANET_AAPCS64_GENERAL;
}
case JANET_FFI_TYPE_VOID:
return JANET_AAPCS64_NONE;
default:
janet_panic("nyi");
return JANET_AAPCS64_NONE;
}
}
#endif
JANET_CORE_FN(cfun_ffi_signature,
"(ffi/signature calling-convention ret-type & arg-types)",
"Create a function signature object that can be used to make calls "
@ -960,6 +1070,96 @@ JANET_CORE_FN(cfun_ffi_signature,
}
break;
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
case JANET_FFI_CC_AAPCS64: {
uint32_t next_general_reg = 0;
uint32_t next_fp_reg = 0;
uint32_t stack_offset = 0;
uint32_t ref_stack_offset = 0;
JanetFFIWordSpec ret_spec = aapcs64_classify(ret_type);
ret.spec = ret_spec;
if (ret_spec == JANET_AAPCS64_SSE) {
variant = 1;
} else if (ret_spec == JANET_AAPCS64_GENERAL_REF) {
if (type_size(ret_type) > sizeof(Aapcs64Variant3ReturnPointer)) {
janet_panic("return value bigger than supported");
}
variant = 2;
} else {
variant = 0;
}
for (uint32_t i = 0; i < arg_count; i++) {
mappings[i].type = decode_ffi_type(argv[i + 2]);
mappings[i].spec = aapcs64_classify(mappings[i].type);
size_t arg_size = type_size(mappings[i].type);
switch (mappings[i].spec) {
case JANET_AAPCS64_GENERAL: {
bool arg_is_struct = mappings[i].type.prim == JANET_FFI_TYPE_STRUCT;
uint32_t needed_registers = (arg_size + 7) / 8;
if (next_general_reg + needed_registers <= 8) {
mappings[i].offset = next_general_reg;
next_general_reg += needed_registers;
} else {
size_t arg_align = arg_is_struct ? 8 : type_align(mappings[i].type);
mappings[i].spec = JANET_AAPCS64_STACK;
mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, arg_align);
#if !defined(JANET_APPLE)
stack_offset += arg_size > 8 ? arg_size : 8;
#else
stack_offset += arg_size;
#endif
next_general_reg = 8;
}
break;
}
case JANET_AAPCS64_GENERAL_REF:
if (next_general_reg < 8) {
mappings[i].offset = next_general_reg++;
} else {
mappings[i].spec = JANET_AAPCS64_STACK_REF;
mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, 8);
stack_offset += 8;
}
mappings[i].offset2 = JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ref_stack_offset, 8);
ref_stack_offset += arg_size;
break;
case JANET_AAPCS64_SSE: {
uint32_t needed_registers = (arg_size + 7) / 8;
if (next_fp_reg + needed_registers <= 8) {
mappings[i].offset = next_fp_reg;
next_fp_reg += needed_registers;
} else {
mappings[i].spec = JANET_AAPCS64_STACK;
mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, 8);
#if !defined(JANET_APPLE)
stack_offset += 8;
#else
stack_offset += arg_size;
#endif
}
break;
}
default:
janet_panic("nyi");
}
}
stack_offset = (stack_offset + 15) & ~0xFUL;
ref_stack_offset = (ref_stack_offset + 15) & ~0xFUL;
stack_count = stack_offset + ref_stack_offset;
for (uint32_t i = 0; i < arg_count; i++) {
if (mappings[i].spec == JANET_AAPCS64_GENERAL_REF || mappings[i].spec == JANET_AAPCS64_STACK_REF) {
mappings[i].offset2 = stack_offset + mappings[i].offset2;
}
}
}
break;
#endif
}
/* Create signature abstract value */
@ -1294,6 +1494,99 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
static void janet_ffi_aapcs64_standard_callback(void *ctx, void *userdata) {
janet_ffi_trampoline(ctx, userdata);
}
typedef Aapcs64Variant1ReturnGeneral janet_aapcs64_variant_1(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7,
double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7);
typedef Aapcs64Variant2ReturnSse janet_aapcs64_variant_2(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7,
double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7);
typedef Aapcs64Variant3ReturnPointer janet_aapcs64_variant_3(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7,
double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7);
static Janet janet_ffi_aapcs64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) {
union {
Aapcs64Variant1ReturnGeneral general_return;
Aapcs64Variant2ReturnSse sse_return;
Aapcs64Variant3ReturnPointer pointer_return;
} retu;
uint64_t regs[8];
double fp_regs[8];
void *ret_mem = &retu.general_return;
/* Apple's stack values do not need to be 8-byte aligned,
* thus all stack offsets refer to actual byte positions. */
uint8_t *stack = alloca(signature->stack_count);
#if defined(JANET_APPLE)
/* Values must be zero-extended by the caller instead of the callee. */
memset(stack, 0, signature->stack_count);
#endif
for (uint32_t i = 0; i < signature->arg_count; i++) {
int32_t n = i + 2;
JanetFFIMapping arg = signature->args[i];
void *to = NULL;
switch (arg.spec) {
case JANET_AAPCS64_GENERAL:
to = regs + arg.offset;
break;
case JANET_AAPCS64_GENERAL_REF:
to = stack + arg.offset2;
regs[arg.offset] = (uint64_t) to;
break;
case JANET_AAPCS64_SSE:
to = fp_regs + arg.offset;
break;
case JANET_AAPCS64_STACK:
to = stack + arg.offset;
break;
case JANET_AAPCS64_STACK_REF:
to = stack + arg.offset2;
uint64_t *ptr = (uint64_t *) stack + arg.offset;
*ptr = (uint64_t) to;
break;
default:
janet_panic("nyi");
}
if (to) {
janet_ffi_write_one(to, argv, n, arg.type, JANET_FFI_MAX_RECUR);
}
}
switch (signature->variant) {
case 0:
retu.general_return = ((janet_aapcs64_variant_1 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3],
regs[4], regs[5], regs[6], regs[7],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
case 1:
retu.sse_return = ((janet_aapcs64_variant_2 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3],
regs[4], regs[5], regs[6], regs[7],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
case 2: {
retu.pointer_return = ((janet_aapcs64_variant_3 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3],
regs[4], regs[5], regs[6], regs[7],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
}
}
return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR);
}
#endif
/* Allocate executable memory chunks in sizes of a page. Ideally we would keep
* an allocator around so that multiple JIT allocations would point to the same
* region but it isn't really worth it. */
@ -1373,6 +1666,10 @@ JANET_CORE_FN(cfun_ffi_call,
#ifdef JANET_FFI_SYSV64_ENABLED
case JANET_FFI_CC_SYSV_64:
return janet_ffi_sysv64(signature, function_pointer, argv);
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
case JANET_FFI_CC_AAPCS64:
return janet_ffi_aapcs64(signature, function_pointer, argv);
#endif
}
}
@ -1442,6 +1739,10 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline,
#ifdef JANET_FFI_SYSV64_ENABLED
case JANET_FFI_CC_SYSV_64:
return janet_wrap_pointer(janet_ffi_sysv64_standard_callback);
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
case JANET_FFI_CC_AAPCS64:
return janet_wrap_pointer(janet_ffi_aapcs64_standard_callback);
#endif
}
}
@ -1561,6 +1862,9 @@ JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
#endif
#ifdef JANET_FFI_SYSV64_ENABLED
janet_array_push(array, janet_ckeywordv("sysv64"));
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
janet_array_push(array, janet_ckeywordv("aapcs64"));
#endif
janet_array_push(array, janet_ckeywordv("none"));
return janet_wrap_array(array);

688
src/core/filewatch.c Normal file
View File

@ -0,0 +1,688 @@
/*
* Copyright (c) 2024 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
#ifdef JANET_EV
#ifdef JANET_FILEWATCH
#ifdef JANET_LINUX
#include <sys/inotify.h>
#include <unistd.h>
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
#endif
typedef struct {
const char *name;
uint32_t flag;
} JanetWatchFlagName;
typedef struct {
#ifndef JANET_WINDOWS
JanetStream *stream;
#endif
JanetTable* watch_descriptors;
JanetChannel *channel;
uint32_t default_flags;
int is_watching;
} JanetWatcher;
#ifdef JANET_LINUX
#include <sys/inotify.h>
#include <unistd.h>
static const JanetWatchFlagName watcher_flags_linux[] = {
{"access", IN_ACCESS},
{"all", IN_ALL_EVENTS},
{"attrib", IN_ATTRIB},
{"close-nowrite", IN_CLOSE_NOWRITE},
{"close-write", IN_CLOSE_WRITE},
{"create", IN_CREATE},
{"delete", IN_DELETE},
{"delete-self", IN_DELETE_SELF},
{"ignored", IN_IGNORED},
{"modify", IN_MODIFY},
{"move-self", IN_MOVE_SELF},
{"moved-from", IN_MOVED_FROM},
{"moved-to", IN_MOVED_TO},
{"open", IN_OPEN},
{"q-overflow", IN_Q_OVERFLOW},
{"unmount", IN_UNMOUNT},
};
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
uint32_t flags = 0;
for (int32_t i = 0; i < n; i++) {
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
janet_panicf("expected keyword, got %v", options[i]);
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_linux,
sizeof(watcher_flags_linux) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown inotify flag %v", options[i]);
}
flags |= result->flag;
}
return flags;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
int fd;
do {
fd = inotify_init1(IN_NONBLOCK | IN_CLOEXEC);
} while (fd == -1 && errno == EINTR);
if (fd == -1) {
janet_panicv(janet_ev_lasterr());
}
watcher->watch_descriptors = janet_table(0);
watcher->channel = channel;
watcher->default_flags = default_flags;
watcher->is_watching = 0;
watcher->stream = janet_stream(fd, JANET_STREAM_READABLE, NULL);
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
if (watcher->stream == NULL) janet_panic("watcher closed");
int result;
do {
result = inotify_add_watch(watcher->stream->handle, path, flags);
} while (result == -1 && errno == EINTR);
if (result == -1) {
janet_panicv(janet_ev_lasterr());
}
Janet name = janet_cstringv(path);
Janet wd = janet_wrap_integer(result);
janet_table_put(watcher->watch_descriptors, name, wd);
janet_table_put(watcher->watch_descriptors, wd, name);
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
if (watcher->stream == NULL) janet_panic("watcher closed");
Janet check = janet_table_get(watcher->watch_descriptors, janet_cstringv(path));
janet_assert(janet_checktype(check, JANET_NUMBER), "bad watch descriptor");
int watch_handle = janet_unwrap_integer(check);
int result;
do {
result = inotify_rm_watch(watcher->stream->handle, watch_handle);
} while (result != -1 && errno == EINTR);
if (result == -1) {
janet_panicv(janet_ev_lasterr());
}
}
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
JanetWatcher *watcher = *((JanetWatcher **) fiber->ev_state);
char buf[1024];
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_MARK:
janet_mark(janet_wrap_abstract(watcher));
break;
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
case JANET_ASYNC_EVENT_ERR:
{
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
}
read_more:
case JANET_ASYNC_EVENT_HUP:
case JANET_ASYNC_EVENT_INIT:
case JANET_ASYNC_EVENT_READ:
{
Janet name = janet_wrap_nil();
/* Assumption - read will never return partial events *
* From documentation:
*
* The behavior when the buffer given to read(2) is too small to
* return information about the next event depends on the kernel
* version: before Linux 2.6.21, read(2) returns 0; since Linux
* 2.6.21, read(2) fails with the error EINVAL. Specifying a buffer
* of size
*
* sizeof(struct inotify_event) + NAME_MAX + 1
*
* will be sufficient to read at least one event. */
ssize_t nread;
do {
nread = read(stream->handle, buf, sizeof(buf));
} while (nread == -1 && errno == EINTR);
/* Check for errors - special case errors that can just be waited on to fix */
if (nread == -1) {
if (errno == EAGAIN || errno == EWOULDBLOCK) {
break;
}
janet_cancel(fiber, janet_ev_lasterr());
fiber->ev_state = NULL;
janet_async_end(fiber);
break;
}
if (nread < (ssize_t) sizeof(struct inotify_event)) break;
/* Iterate through all events read from the buffer */
char *cursor = buf;
while (cursor < buf + nread) {
struct inotify_event inevent;
memcpy(&inevent, cursor, sizeof(inevent));
cursor += sizeof(inevent);
/* Read path of inevent */
if (inevent.len) {
name = janet_cstringv(cursor);
cursor += inevent.len;
}
/* Got an event */
Janet path = janet_table_get(watcher->watch_descriptors, janet_wrap_integer(inevent.wd));
JanetKV *event = janet_struct_begin(6);
janet_struct_put(event, janet_ckeywordv("wd"), janet_wrap_integer(inevent.wd));
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
if (janet_checktype(name, JANET_NIL)) {
/* We were watching a file directly, so path is the full path. Split into dirname / basename */
JanetString spath = janet_unwrap_string(path);
const uint8_t *cursor = spath + janet_string_length(spath);
const uint8_t *cursor_end = cursor;
while (cursor > spath && cursor[0] != '/') {
cursor--;
}
if (cursor == spath) {
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
janet_struct_put(event, janet_ckeywordv("file-name"), name);
} else {
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath))));
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1))));
}
} else {
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
janet_struct_put(event, janet_ckeywordv("file-name"), name);
}
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_integer(inevent.cookie));
Janet etype = janet_ckeywordv("type");
const JanetWatchFlagName *wfn_end = watcher_flags_linux + sizeof(watcher_flags_linux) / sizeof(watcher_flags_linux[0]);
for (const JanetWatchFlagName *wfn = watcher_flags_linux; wfn < wfn_end; wfn++) {
if ((inevent.mask & wfn->flag) == wfn->flag) janet_struct_put(event, etype, janet_ckeywordv(wfn->name));
}
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
}
/* Read some more if possible */
goto read_more;
}
break;
}
}
static void janet_watcher_listen(JanetWatcher *watcher) {
if (watcher->is_watching) janet_panic("already watching");
watcher->is_watching = 1;
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
JanetWatcher **state = janet_malloc(sizeof(JanetWatcher *)); /* Gross */
*state = watcher;
janet_async_start_fiber(fiber, watcher->stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, state);
janet_gcroot(janet_wrap_abstract(watcher));
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
if (!watcher->is_watching) return;
watcher->is_watching = 0;
janet_stream_close(watcher->stream);
janet_gcunroot(janet_wrap_abstract(watcher));
}
#elif JANET_WINDOWS
#define WATCHFLAG_RECURSIVE 0x100000u
static const JanetWatchFlagName watcher_flags_windows[] = {
{"all",
FILE_NOTIFY_CHANGE_ATTRIBUTES |
FILE_NOTIFY_CHANGE_CREATION |
FILE_NOTIFY_CHANGE_DIR_NAME |
FILE_NOTIFY_CHANGE_FILE_NAME |
FILE_NOTIFY_CHANGE_LAST_ACCESS |
FILE_NOTIFY_CHANGE_LAST_WRITE |
FILE_NOTIFY_CHANGE_SECURITY |
FILE_NOTIFY_CHANGE_SIZE |
WATCHFLAG_RECURSIVE},
{"attributes", FILE_NOTIFY_CHANGE_ATTRIBUTES},
{"creation", FILE_NOTIFY_CHANGE_CREATION},
{"dir-name", FILE_NOTIFY_CHANGE_DIR_NAME},
{"file-name", FILE_NOTIFY_CHANGE_FILE_NAME},
{"last-access", FILE_NOTIFY_CHANGE_LAST_ACCESS},
{"last-write", FILE_NOTIFY_CHANGE_LAST_WRITE},
{"recursive", WATCHFLAG_RECURSIVE},
{"security", FILE_NOTIFY_CHANGE_SECURITY},
{"size", FILE_NOTIFY_CHANGE_SIZE},
};
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
uint32_t flags = 0;
for (int32_t i = 0; i < n; i++) {
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
janet_panicf("expected keyword, got %v", options[i]);
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_windows,
sizeof(watcher_flags_windows) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown windows filewatch flag %v", options[i]);
}
flags |= result->flag;
}
return flags;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
watcher->watch_descriptors = janet_table(0);
watcher->channel = channel;
watcher->default_flags = default_flags;
watcher->is_watching = 0;
}
/* Since the file info padding includes embedded file names, we want to include more space for data.
* We also need to handle manually calculating changes if path names are too long, but ideally just avoid
* that scenario as much as possible */
#define FILE_INFO_PADDING (4096 * 4)
typedef struct {
OVERLAPPED overlapped;
JanetStream *stream;
JanetWatcher *watcher;
JanetFiber *fiber;
JanetString dir_path;
uint32_t flags;
uint64_t buf[FILE_INFO_PADDING / sizeof(uint64_t)]; /* Ensure alignment */
} OverlappedWatch;
#define NotifyChange FILE_NOTIFY_INFORMATION
static void read_dir_changes(OverlappedWatch *ow) {
BOOL result = ReadDirectoryChangesW(ow->stream->handle,
(NotifyChange *) ow->buf,
FILE_INFO_PADDING,
(ow->flags & WATCHFLAG_RECURSIVE) ? TRUE : FALSE,
ow->flags & ~WATCHFLAG_RECURSIVE,
NULL,
(OVERLAPPED *) ow,
NULL);
if (!result) {
janet_panicv(janet_ev_lasterr());
}
}
static const char* watcher_actions_windows[] = {
"unknown",
"added",
"removed",
"modified",
"renamed-old",
"renamed-new",
};
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
OverlappedWatch *ow = (OverlappedWatch *) fiber->ev_state;
JanetWatcher *watcher = ow->watcher;
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_INIT:
janet_async_in_flight(fiber);
break;
case JANET_ASYNC_EVENT_MARK:
janet_mark(janet_wrap_abstract(ow->stream));
janet_mark(janet_wrap_fiber(ow->fiber));
janet_mark(janet_wrap_abstract(watcher));
janet_mark(janet_wrap_string(ow->dir_path));
break;
case JANET_ASYNC_EVENT_CLOSE:
janet_table_remove(ow->watcher->watch_descriptors, janet_wrap_string(ow->dir_path));
break;
case JANET_ASYNC_EVENT_ERR:
case JANET_ASYNC_EVENT_FAILED:
janet_stream_close(ow->stream);
break;
case JANET_ASYNC_EVENT_COMPLETE:
{
if (!watcher->is_watching) {
janet_stream_close(ow->stream);
break;
}
NotifyChange *fni = (NotifyChange *) ow->buf;
while (1) {
/* Got an event */
/* Extract name */
Janet filename;
if (fni->FileNameLength) {
int32_t nbytes = (int32_t) WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), NULL, 0, NULL, NULL);
janet_assert(nbytes, "bad utf8 path");
uint8_t *into = janet_string_begin(nbytes);
WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), (char *) into, nbytes, NULL, NULL);
filename = janet_wrap_string(janet_string_end(into));
} else {
filename = janet_cstringv("");
}
JanetKV *event = janet_struct_begin(3);
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_actions_windows[fni->Action]));
janet_struct_put(event, janet_ckeywordv("file-name"), filename);
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(ow->dir_path));
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
/* Next event */
if (!fni->NextEntryOffset) break;
fni = (NotifyChange *) ((char *)fni + fni->NextEntryOffset);
}
/* Make another call to read directory changes */
read_dir_changes(ow);
janet_async_in_flight(fiber);
}
break;
}
}
static void start_listening_ow(OverlappedWatch *ow) {
read_dir_changes(ow);
JanetStream *stream = ow->stream;
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
fiber->supervisor_channel = janet_root_fiber()->supervisor_channel;
ow->fiber = fiber;
janet_async_start_fiber(fiber, stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, ow);
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
HANDLE handle = CreateFileA(path,
FILE_LIST_DIRECTORY | GENERIC_READ,
FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
NULL,
OPEN_EXISTING,
FILE_FLAG_OVERLAPPED | FILE_FLAG_BACKUP_SEMANTICS,
NULL);
if (handle == INVALID_HANDLE_VALUE) {
janet_panicv(janet_ev_lasterr());
}
JanetStream *stream = janet_stream(handle, JANET_STREAM_READABLE, NULL);
OverlappedWatch *ow = janet_malloc(sizeof(OverlappedWatch));
memset(ow, 0, sizeof(OverlappedWatch));
ow->stream = stream;
ow->dir_path = janet_cstring(path);
ow->fiber = NULL;
Janet pathv = janet_wrap_string(ow->dir_path);
ow->flags = flags | watcher->default_flags;
ow->watcher = watcher;
ow->overlapped.hEvent = CreateEvent(NULL, FALSE, 0, NULL); /* Do we need this */
Janet streamv = janet_wrap_pointer(ow);
janet_table_put(watcher->watch_descriptors, pathv, streamv);
if (watcher->is_watching) {
start_listening_ow(ow);
}
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
Janet pathv = janet_cstringv(path);
Janet streamv = janet_table_get(watcher->watch_descriptors, pathv);
if (janet_checktype(streamv, JANET_NIL)) {
janet_panicf("path %v is not being watched", pathv);
}
janet_table_remove(watcher->watch_descriptors, pathv);
OverlappedWatch *ow = janet_unwrap_pointer(streamv);
janet_stream_close(ow->stream);
}
static void janet_watcher_listen(JanetWatcher *watcher) {
if (watcher->is_watching) janet_panic("already watching");
watcher->is_watching = 1;
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
const JanetKV *kv = watcher->watch_descriptors->data + i;
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
start_listening_ow(ow);
}
janet_gcroot(janet_wrap_abstract(watcher));
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
if (!watcher->is_watching) return;
watcher->is_watching = 0;
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
const JanetKV *kv = watcher->watch_descriptors->data + i;
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
janet_stream_close(ow->stream);
}
janet_table_clear(watcher->watch_descriptors);
janet_gcunroot(janet_wrap_abstract(watcher));
}
#else
/* Default implementation */
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
(void) options;
(void) n;
return 0;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
(void) watcher;
(void) channel;
(void) default_flags;
janet_panic("filewatch not supported on this platform");
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
(void) watcher;
(void) flags;
(void) path;
janet_panic("nyi");
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
(void) watcher;
(void) path;
janet_panic("nyi");
}
static void janet_watcher_listen(JanetWatcher *watcher) {
(void) watcher;
janet_panic("nyi");
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
(void) watcher;
janet_panic("nyi");
}
#endif
/* C Functions */
static int janet_filewatch_mark(void *p, size_t s) {
JanetWatcher *watcher = (JanetWatcher *) p;
(void) s;
if (watcher->channel == NULL) return 0; /* Incomplete initialization */
#ifdef JANET_WINDOWS
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
const JanetKV *kv = watcher->watch_descriptors->data + i;
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
janet_mark(janet_wrap_fiber(ow->fiber));
janet_mark(janet_wrap_abstract(ow->stream));
janet_mark(janet_wrap_string(ow->dir_path));
}
#else
janet_mark(janet_wrap_abstract(watcher->stream));
#endif
janet_mark(janet_wrap_abstract(watcher->channel));
janet_mark(janet_wrap_table(watcher->watch_descriptors));
return 0;
}
static const JanetAbstractType janet_filewatch_at = {
"filewatch/watcher",
NULL,
janet_filewatch_mark,
JANET_ATEND_GCMARK
};
JANET_CORE_FN(cfun_filewatch_make,
"(filewatch/new channel &opt default-flags)",
"Create a new filewatcher that will give events to a channel channel. See `filewatch/add` for available flags.\n\n"
"When an event is triggered by the filewatcher, a struct containing information will be given to channel as with `ev/give`. "
"The contents of the channel depend on the OS, but will contain some common keys:\n\n"
"* `:type` -- the type of the event that was raised.\n\n"
"* `:file-name` -- the base file name of the file that triggered the event.\n\n"
"* `:dir-name` -- the directory name of the file that triggered the event.\n\n"
"Events also will contain keys specific to the host OS.\n\n"
"Windows has no extra properties on events.\n\n"
"Linux has the following extra properties on events:\n\n"
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n"
"* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
"* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
"") {
janet_arity(argc, 1, -1);
JanetChannel *channel = janet_getchannel(argv, 0);
JanetWatcher *watcher = janet_abstract(&janet_filewatch_at, sizeof(JanetWatcher));
uint32_t default_flags = decode_watch_flags(argv + 1, argc - 1);
janet_watcher_init(watcher, channel, default_flags);
return janet_wrap_abstract(watcher);
}
JANET_CORE_FN(cfun_filewatch_add,
"(filewatch/add watcher path &opt flags)",
"Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
"Windows/MINGW (flags correspond to FILE_NOTIFY_CHANGE_* flags in win32 documentation):\n\n"
"* `:all` - trigger an event for all of the below triggers.\n\n"
"* `:attributes` - FILE_NOTIFY_CHANGE_ATTRIBUTES\n\n"
"* `:creation` - FILE_NOTIFY_CHANGE_CREATION\n\n"
"* `:dir-name` - FILE_NOTIFY_CHANGE_DIR_NAME\n\n"
"* `:last-access` - FILE_NOTIFY_CHANGE_LAST_ACCESS\n\n"
"* `:last-write` - FILE_NOTIFY_CHANGE_LAST_WRITE\n\n"
"* `:security` - FILE_NOTIFY_CHANGE_SECURITY\n\n"
"* `:size` - FILE_NOTIFY_CHANGE_SIZE\n\n"
"* `:recursive` - watch subdirectories recursively\n\n"
"Linux (flags correspond to IN_* flags from <sys/inotify.h>):\n\n"
"* `:access` - IN_ACCESS\n\n"
"* `:all` - IN_ALL_EVENTS\n\n"
"* `:attrib` - IN_ATTRIB\n\n"
"* `:close-nowrite` - IN_CLOSE_NOWRITE\n\n"
"* `:close-write` - IN_CLOSE_WRITE\n\n"
"* `:create` - IN_CREATE\n\n"
"* `:delete` - IN_DELETE\n\n"
"* `:delete-self` - IN_DELETE_SELF\n\n"
"* `:ignored` - IN_IGNORED\n\n"
"* `:modify` - IN_MODIFY\n\n"
"* `:move-self` - IN_MOVE_SELF\n\n"
"* `:moved-from` - IN_MOVED_FROM\n\n"
"* `:moved-to` - IN_MOVED_TO\n\n"
"* `:open` - IN_OPEN\n\n"
"* `:q-overflow` - IN_Q_OVERFLOW\n\n"
"* `:unmount` - IN_UNMOUNT\n\n\n"
"On Windows, events will have the following possible types:\n\n"
"* `:unknown`\n\n"
"* `:added`\n\n"
"* `:removed`\n\n"
"* `:modified`\n\n"
"* `:renamed-old`\n\n"
"* `:renamed-new`\n\n"
"On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n"
"") {
janet_arity(argc, 2, -1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
const char *path = janet_getcstring(argv, 1);
uint32_t flags = watcher->default_flags | decode_watch_flags(argv + 2, argc - 2);
janet_watcher_add(watcher, path, flags);
return argv[0];
}
JANET_CORE_FN(cfun_filewatch_remove,
"(filewatch/remove watcher path)",
"Remove a path from the watcher.") {
janet_fixarity(argc, 2);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
const char *path = janet_getcstring(argv, 1);
janet_watcher_remove(watcher, path);
return argv[0];
}
JANET_CORE_FN(cfun_filewatch_listen,
"(filewatch/listen watcher)",
"Listen for changes in the watcher.") {
janet_fixarity(argc, 1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
janet_watcher_listen(watcher);
return janet_wrap_nil();
}
JANET_CORE_FN(cfun_filewatch_unlisten,
"(filewatch/unlisten watcher)",
"Stop listening for changes on a given watcher.") {
janet_fixarity(argc, 1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
janet_watcher_unlisten(watcher);
return janet_wrap_nil();
}
/* Module entry point */
void janet_lib_filewatch(JanetTable *env) {
JanetRegExt cfuns[] = {
JANET_CORE_REG("filewatch/new", cfun_filewatch_make),
JANET_CORE_REG("filewatch/add", cfun_filewatch_add),
JANET_CORE_REG("filewatch/remove", cfun_filewatch_remove),
JANET_CORE_REG("filewatch/listen", cfun_filewatch_listen),
JANET_CORE_REG("filewatch/unlisten", cfun_filewatch_unlisten),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, cfuns);
}
#endif
#endif

4
src/core/gc.c
View File

@ -321,9 +321,13 @@ static void janet_deinit_block(JanetGCObject *mem) {
janet_symbol_deinit(((JanetStringHead *) mem)->data);
break;
case JANET_MEMORY_ARRAY:
case JANET_MEMORY_ARRAY_WEAK:
janet_free(((JanetArray *) mem)->data);
break;
case JANET_MEMORY_TABLE:
case JANET_MEMORY_TABLE_WEAKK:
case JANET_MEMORY_TABLE_WEAKV:
case JANET_MEMORY_TABLE_WEAKKV:
janet_free(((JanetTable *) mem)->data);
break;
case JANET_MEMORY_FIBER: {

2
src/core/gc.h
View File

@ -64,7 +64,7 @@ enum JanetMemoryType {
};
/* To allocate collectable memory, one must call janet_alloc, initialize the memory,
* and then call when janet_enablegc when it is initailize and reachable by the gc (on the JANET stack) */
* and then call when janet_enablegc when it is initialized and reachable by the gc (on the JANET stack) */
void *janet_gcalloc(enum JanetMemoryType type, size_t size);
#endif

2
src/core/io.c
View File

@ -294,7 +294,7 @@ int janet_file_close(JanetFile *file) {
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
ret = fclose(file->file);
file->flags |= JANET_FILE_CLOSED;
file->file = NULL; /* NULL derefence is easier to debug then other problems */
file->file = NULL; /* NULL dereference is easier to debug then other problems */
return ret;
}
return 0;

45
src/core/marsh.c
View File

@ -68,8 +68,15 @@ enum {
LB_STRUCT_PROTO, /* 223 */
#ifdef JANET_EV
LB_THREADED_ABSTRACT, /* 224 */
LB_POINTER_BUFFER, /* 224 */
LB_POINTER_BUFFER, /* 225 */
#endif
LB_TABLE_WEAKK, /* 226 */
LB_TABLE_WEAKV, /* 227 */
LB_TABLE_WEAKKV, /* 228 */
LB_TABLE_WEAKK_PROTO, /* 229 */
LB_TABLE_WEAKV_PROTO, /* 230 */
LB_TABLE_WEAKKV_PROTO, /* 231 */
LB_ARRAY_WEAK, /* 232 */
} LeadBytes;
/* Helper to look inside an entry in an environment */
@ -569,7 +576,8 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
int32_t i;
JanetArray *a = janet_unwrap_array(x);
MARK_SEEN();
pushbyte(st, LB_ARRAY);
enum JanetMemoryType memtype = janet_gc_type(a);
pushbyte(st, memtype == JANET_MEMORY_ARRAY_WEAK ? LB_ARRAY_WEAK : LB_ARRAY);
pushint(st, a->count);
for (i = 0; i < a->count; i++)
marshal_one(st, a->data[i], flags + 1);
@ -592,7 +600,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_TABLE: {
JanetTable *t = janet_unwrap_table(x);
MARK_SEEN();
enum JanetMemoryType memtype = janet_gc_type(t);
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
pushbyte(st, t->proto ? LB_TABLE_WEAKK_PROTO : LB_TABLE_WEAKK);
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
pushbyte(st, t->proto ? LB_TABLE_WEAKV_PROTO : LB_TABLE_WEAKV);
} else if (memtype == JANET_MEMORY_TABLE_WEAKKV) {
pushbyte(st, t->proto ? LB_TABLE_WEAKKV_PROTO : LB_TABLE_WEAKKV);
} else {
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
}
pushint(st, t->count);
if (t->proto)
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
@ -1417,11 +1434,18 @@ static const uint8_t *unmarshal_one(
}
case LB_REFERENCE:
case LB_ARRAY:
case LB_ARRAY_WEAK:
case LB_TUPLE:
case LB_STRUCT:
case LB_STRUCT_PROTO:
case LB_TABLE:
case LB_TABLE_PROTO:
case LB_TABLE_WEAKK:
case LB_TABLE_WEAKV:
case LB_TABLE_WEAKKV:
case LB_TABLE_WEAKK_PROTO:
case LB_TABLE_WEAKV_PROTO:
case LB_TABLE_WEAKKV_PROTO:
/* Things that open with integers */
{
data++;
@ -1430,9 +1454,9 @@ static const uint8_t *unmarshal_one(
if (lead != LB_REFERENCE) {
MARSH_EOS(st, data - 1 + len);
}
if (lead == LB_ARRAY) {
if (lead == LB_ARRAY || lead == LB_ARRAY_WEAK) {
/* Array */
JanetArray *array = janet_array(len);
JanetArray *array = (lead == LB_ARRAY_WEAK) ? janet_array_weak(len) : janet_array(len);
array->count = len;
*out = janet_wrap_array(array);
janet_v_push(st->lookup, *out);
@ -1472,10 +1496,19 @@ static const uint8_t *unmarshal_one(
*out = st->lookup[len];
} else {
/* Table */
JanetTable *t = janet_table(len);
JanetTable *t;
if (lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKK) {
t = janet_table_weakk(len);
} else if (lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKV) {
t = janet_table_weakv(len);
} else if (lead == LB_TABLE_WEAKKV_PROTO || lead == LB_TABLE_WEAKKV) {
t = janet_table_weakkv(len);
} else {
t = janet_table(len);
}
*out = janet_wrap_table(t);
janet_v_push(st->lookup, *out);
if (lead == LB_TABLE_PROTO) {
if (lead == LB_TABLE_PROTO || lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKKV_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_TABLE, st);

8
src/core/math.c
View File

@ -85,10 +85,10 @@ void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len) {
uint8_t state[16] = {0};
for (int32_t i = 0; i < len; i++)
state[i & 0xF] ^= bytes[i];
rng->a = state[0] + (state[1] << 8) + (state[2] << 16) + (state[3] << 24);
rng->b = state[4] + (state[5] << 8) + (state[6] << 16) + (state[7] << 24);
rng->c = state[8] + (state[9] << 8) + (state[10] << 16) + (state[11] << 24);
rng->d = state[12] + (state[13] << 8) + (state[14] << 16) + (state[15] << 24);
rng->a = state[0] + ((uint32_t) state[1] << 8) + ((uint32_t) state[2] << 16) + ((uint32_t) state[3] << 24);
rng->b = state[4] + ((uint32_t) state[5] << 8) + ((uint32_t) state[6] << 16) + ((uint32_t) state[7] << 24);
rng->c = state[8] + ((uint32_t) state[9] << 8) + ((uint32_t) state[10] << 16) + ((uint32_t) state[11] << 24);
rng->d = state[12] + ((uint32_t) state[13] << 8) + ((uint32_t) state[14] << 16) + ((uint32_t) state[15] << 24);
rng->counter = 0u;
/* a, b, c, d can't all be 0 */
if (rng->a == 0) rng->a = 1u;

2
src/core/net.c
View File

@ -325,7 +325,7 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio
#endif
/* Adress info */
/* Address info */
static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL);

38
src/core/os.c
View File

@ -174,6 +174,8 @@ JANET_CORE_FN(os_arch,
"* :riscv64\n\n"
"* :sparc\n\n"
"* :wasm\n\n"
"* :s390\n\n"
"* :s390x\n\n"
"* :unknown\n") {
janet_fixarity(argc, 0);
(void) argv;
@ -200,6 +202,10 @@ JANET_CORE_FN(os_arch,
return janet_ckeywordv("ppc");
#elif (defined(__ppc64__) || defined(_ARCH_PPC64) || defined(_M_PPC))
return janet_ckeywordv("ppc64");
#elif (defined(__s390x__))
return janet_ckeywordv("s390x");
#elif (defined(__s390__))
return janet_ckeywordv("s390");
#else
return janet_ckeywordv("unknown");
#endif
@ -1413,7 +1419,7 @@ JANET_CORE_FN(os_spawn,
JANET_CORE_FN(os_posix_exec,
"(os/posix-exec args &opt flags env)",
"Use the execvpe or execve system calls to replace the current process with an interface similar to os/execute. "
"Hoever, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and "
"However, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and "
"does not allow redirection of stdio.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC);
}
@ -1582,8 +1588,8 @@ JANET_CORE_FN(os_clock,
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
janet_arity(argc, 0, 2);
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime");
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, NULL);
if (sourcestr == NULL || janet_cstrcmp(sourcestr, "realtime") == 0) {
source = JANET_TIME_REALTIME;
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
source = JANET_TIME_MONOTONIC;
@ -1596,8 +1602,8 @@ JANET_CORE_FN(os_clock,
struct timespec tv;
if (janet_gettime(&tv, source)) janet_panic("could not get time");
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
if (janet_cstrcmp(formatstr, "double") == 0) {
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, NULL);
if (formatstr == NULL || janet_cstrcmp(formatstr, "double") == 0) {
double dtime = (double)(tv.tv_sec + (tv.tv_nsec / 1E9));
return janet_wrap_number(dtime);
} else if (janet_cstrcmp(formatstr, "int") == 0) {
@ -2668,7 +2674,7 @@ JANET_CORE_FN(os_open,
} else if (write_flag && !read_flag) {
open_flags |= O_WRONLY;
} else {
open_flags = O_RDWR;
open_flags |= O_RDWR;
}
do {
@ -2680,16 +2686,24 @@ JANET_CORE_FN(os_open,
}
JANET_CORE_FN(os_pipe,
"(os/pipe)",
"(os/pipe &opt flags)",
"Create a readable stream and a writable stream that are connected. Returns a two-element "
"tuple where the first element is a readable stream and the second element is the writable "
"stream.") {
"stream. `flags` is a keyword set of flags to disable non-blocking settings on the ends of the pipe. "
"This may be desired if passing the pipe to a subprocess with `os/spawn`.\n\n"
"* :W - sets the writable end of the pipe to a blocking stream.\n"
"* :R - sets the readable end of the pipe to a blocking stream.\n\n"
"By default, both ends of the pipe are non-blocking for use with the `ev` module.") {
(void) argv;
janet_fixarity(argc, 0);
janet_arity(argc, 0, 1);
JanetHandle fds[2];
if (janet_make_pipe(fds, 0)) janet_panicv(janet_ev_lasterr());
JanetStream *reader = janet_stream(fds[0], JANET_STREAM_READABLE, NULL);
JanetStream *writer = janet_stream(fds[1], JANET_STREAM_WRITABLE, NULL);
int flags = 0;
if (argc > 0 && !janet_checktype(argv[0], JANET_NIL)) {
flags = (int) janet_getflags(argv, 0, "WR");
}
if (janet_make_pipe(fds, flags)) janet_panicv(janet_ev_lasterr());
JanetStream *reader = janet_stream(fds[0], (flags & 2) ? 0 : JANET_STREAM_READABLE, NULL);
JanetStream *writer = janet_stream(fds[1], (flags & 1) ? 0 : JANET_STREAM_WRITABLE, NULL);
Janet tup[2] = {janet_wrap_abstract(reader), janet_wrap_abstract(writer)};
return janet_wrap_tuple(janet_tuple_n(tup, 2));
}

5
src/core/parse.c
View File

@ -467,8 +467,13 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
return 0;
}
ret = janet_keywordv(p->buf + 1, blen - 1);
#ifdef JANET_INT_TYPES
} else if (start_num && !janet_scan_numeric(p->buf, blen, &ret)) {
(void) numval;
#else
} else if (start_num && !janet_scan_number(p->buf, blen, &numval)) {
ret = janet_wrap_number(numval);
#endif
} else if (!check_str_const("nil", p->buf, blen)) {
ret = janet_wrap_nil();
} else if (!check_str_const("false", p->buf, blen)) {

10
src/core/peg.c
View File

@ -134,7 +134,7 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
* a newline character is consider to be on the same line as the character before
* (\n is line terminator, not line separator).
* - in the not-found case, we still want to find the greatest-indexed newline that
* is before position. we use that to calcuate the line and column.
* is before position. we use that to calculate the line and column.
* - in the case that lo = 0 and s->linemap[0] is still greater than position, we
* are on the first line and our column is position + 1. */
int32_t hi = s->linemaplen; /* hi is greater than the actual line */
@ -667,11 +667,11 @@ tail:
case RULE_READINT: {
uint32_t tag = rule[2];
uint32_t signedness = rule[1] & 0x10;
uint32_t endianess = rule[1] & 0x20;
uint32_t endianness = rule[1] & 0x20;
int width = (int)(rule[1] & 0xF);
if (text + width > s->text_end) return NULL;
uint64_t accum = 0;
if (endianess) {
if (endianness) {
/* BE */
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
} else {
@ -1628,7 +1628,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
i += 2;
break;
case RULE_READINT:
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
/* [ width | (endianness << 5) | (signedness << 6), tag ] */
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
i += 3;
break;
@ -1725,7 +1725,7 @@ static JanetPeg *compile_peg(Janet x) {
JANET_CORE_FN(cfun_peg_compile,
"(peg/compile peg)",
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment "
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement "
"the grammar of the peg for otherwise undefined peg keywords.") {
janet_fixarity(argc, 1);
JanetPeg *peg = compile_peg(argv[0]);

2
src/core/state.c
View File

@ -58,7 +58,7 @@ void janet_vm_load(JanetVM *from) {
}
/* Trigger suspension of the Janet vm by trying to
* exit the interpeter loop when convenient. You can optionally
* exit the interpreter loop when convenient. You can optionally
* use NULL to interrupt the current VM when convenient */
void janet_interpreter_interrupt(JanetVM *vm) {
vm = vm ? vm : &janet_vm;

38
src/core/strtod.c
View File

@ -34,9 +34,9 @@
* because E is a valid digit in bases 15 or greater. For bases greater than
* 10, the letters are used as digits. A through Z correspond to the digits 10
* through 35, and the lowercase letters have the same values. The radix number
* is always in base 10. For example, a hexidecimal number could be written
* is always in base 10. For example, a hexadecimal number could be written
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
* hexidecimal literals. The previous number could also be written
* hexadecimal literals. The previous number could also be written
* '0xdeadbeef'.
*/
@ -489,6 +489,40 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
return 0;
}
/* Similar to janet_scan_number but allows for
* more numeric types with a given suffix. */
int janet_scan_numeric(
const uint8_t *str,
int32_t len,
Janet *out) {
int result;
double num;
int64_t i64 = 0;
uint64_t u64 = 0;
if (len < 2 || str[len - 2] != ':') {
result = janet_scan_number_base(str, len, 0, &num);
*out = janet_wrap_number(num);
return result;
}
switch (str[len - 1]) {
default:
return 1;
case 'n':
result = janet_scan_number_base(str, len - 2, 0, &num);
*out = janet_wrap_number(num);
return result;
/* Condition is inverted janet_scan_int64 and janet_scan_uint64 */
case 's':
result = !janet_scan_int64(str, len - 2, &i64);
*out = janet_wrap_s64(i64);
return result;
case 'u':
result = !janet_scan_uint64(str, len - 2, &u64);
*out = janet_wrap_u64(u64);
return result;
}
}
#endif
void janet_buffer_dtostr(JanetBuffer *buffer, double x) {

2
src/core/table.c
View File

@ -67,7 +67,7 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in
return table;
}
/* Initialize a table (for use withs scratch memory) */
/* Initialize a table (for use with scratch memory) */
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
return janet_table_init_impl(table, capacity, 1);
}

29
src/core/tuple.c
View File

@ -116,6 +116,34 @@ JANET_CORE_FN(cfun_tuple_setmap,
return argv[0];
}
JANET_CORE_FN(cfun_tuple_join,
"(tuple/join & parts)",
"Create a tuple by joining together other tuples and arrays.") {
janet_arity(argc, 0, -1);
int32_t total_len = 0;
for (int32_t i = 0; i < argc; i++) {
int32_t len = 0;
const Janet *vals = NULL;
if (!janet_indexed_view(argv[i], &vals, &len)) {
janet_panicf("expected indexed type for argument %d, got %v", i, argv[i]);
}
if (INT32_MAX - total_len < len) {
janet_panic("tuple too large");
}
total_len += len;
}
Janet *tup = janet_tuple_begin(total_len);
Janet *tup_cursor = tup;
for (int32_t i = 0; i < argc; i++) {
int32_t len = 0;
const Janet *vals = NULL;
janet_indexed_view(argv[i], &vals, &len);
memcpy(tup_cursor, vals, len * sizeof(Janet));
tup_cursor += len;
}
return janet_wrap_tuple(janet_tuple_end(tup));
}
/* Load the tuple module */
void janet_lib_tuple(JanetTable *env) {
JanetRegExt tuple_cfuns[] = {
@ -124,6 +152,7 @@ void janet_lib_tuple(JanetTable *env) {
JANET_CORE_REG("tuple/type", cfun_tuple_type),
JANET_CORE_REG("tuple/sourcemap", cfun_tuple_sourcemap),
JANET_CORE_REG("tuple/setmap", cfun_tuple_setmap),
JANET_CORE_REG("tuple/join", cfun_tuple_join),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, tuple_cfuns);

10
src/core/util.h
View File

@ -33,6 +33,7 @@
#include <errno.h>
#include <stddef.h>
#include <stdbool.h>
#include <math.h>
#ifdef JANET_EV
#ifndef JANET_WINDOWS
@ -141,7 +142,7 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source);
#define strdup(x) _strdup(x)
#endif
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libraries
* with native code. */
#if defined(JANET_NO_DYNAMIC_MODULES)
typedef int Clib;
@ -189,9 +190,6 @@ void janet_lib_debug(JanetTable *env);
#ifdef JANET_PEG
void janet_lib_peg(JanetTable *env);
#endif
#ifdef JANET_TYPED_ARRAY
void janet_lib_typed_array(JanetTable *env);
#endif
#ifdef JANET_INT_TYPES
void janet_lib_inttypes(JanetTable *env);
#endif
@ -202,10 +200,14 @@ extern const JanetAbstractType janet_address_type;
#ifdef JANET_EV
void janet_lib_ev(JanetTable *env);
void janet_ev_mark(void);
void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
int janet_make_pipe(JanetHandle handles[2], int mode);
#ifdef JANET_FILEWATCH
void janet_lib_filewatch(JanetTable *env);
#endif
#ifdef JANET_FFI
void janet_lib_ffi(JanetTable *env);
#endif
#endif
#endif

4
src/core/vm.c
View File

@ -1268,7 +1268,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
/*
* Execute a single instruction in the fiber. Does this by inspecting
* the fiber, setting a breakpoint at the next instruction, executing, and
* reseting breakpoints to how they were prior. Yes, it's a bit hacky.
* resetting breakpoints to how they were prior. Yes, it's a bit hacky.
*/
JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
/* No finished or currently alive fibers. */
@ -1613,7 +1613,7 @@ int janet_init(void) {
janet_vm.registry_count = 0;
janet_vm.registry_dirty = 0;
/* Intialize abstract registry */
/* Initialize abstract registry */
janet_vm.abstract_registry = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));

34
src/include/janet.h
View File

@ -46,7 +46,7 @@ extern "C" {
#endif
/*
* Detect OS and endianess.
* Detect OS and endianness.
* From webkit source. There is likely some extreneous
* detection for unsupported platforms
*/
@ -210,6 +210,11 @@ extern "C" {
#define JANET_EV
#endif
/* Enable or disable the filewatch/ module */
#if !defined(JANET_NO_FILEWATCH)
#define JANET_FILEWATCH
#endif
/* Enable or disable networking */
#if defined(JANET_EV) && !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
#define JANET_NET
@ -262,7 +267,7 @@ extern "C" {
#endif
#endif
/* Tell complier some functions don't return */
/* Tell compiler some functions don't return */
#ifndef JANET_NO_RETURN
#ifdef JANET_WINDOWS
#define JANET_NO_RETURN __declspec(noreturn)
@ -272,7 +277,7 @@ extern "C" {
#endif
/* Prevent some recursive functions from recursing too deeply
* ands crashing (the parser). Instead, error out. */
* and crashing (the parser). Instead, error out. */
#define JANET_RECURSION_GUARD 1024
/* Maximum depth to follow table prototypes before giving up and returning nil. */
@ -354,6 +359,7 @@ typedef struct {
#ifdef JANET_EV
typedef struct JanetOSMutex JanetOSMutex;
typedef struct JanetOSRWLock JanetOSRWLock;
typedef struct JanetChannel JanetChannel;
#endif
/***** END SECTION CONFIG *****/
@ -628,7 +634,9 @@ typedef void (*JanetEVCallback)(JanetFiber *fiber, JanetAsyncEvent event);
* call when ever an event is sent from the event loop. state is an optional (can be NULL)
* pointer to data allocated with janet_malloc. This pointer will be passed to callback as
* fiber->ev_state. It will also be freed for you by the runtime when the event loop determines
* it can no longer be referenced. On windows, the contents of state MUST contained an OVERLAPPED struct. */
* it can no longer be referenced. On windows, the contents of state MUST contained an OVERLAPPED struct at the 0 offset. */
JANET_API void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
JANET_API JANET_NO_RETURN void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
/* Do not send any more events to the given callback. Call this after scheduling fiber to be resume
@ -1414,6 +1422,7 @@ JANET_API void janet_loop1_interrupt(JanetVM *vm);
/* Wrapper around streams */
JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods);
JANET_API JanetStream *janet_stream_ext(JanetHandle handle, uint32_t flags, const JanetMethod *methods, size_t size); /* Allow for type punning streams */
JANET_API void janet_stream_close(JanetStream *stream);
JANET_API Janet janet_cfun_stream_close(int32_t argc, Janet *argv);
JANET_API Janet janet_cfun_stream_read(int32_t argc, Janet *argv);
@ -1444,6 +1453,14 @@ 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 channel utilities */
JanetChannel *janet_channel_make(uint32_t limit);
JanetChannel *janet_channel_make_threaded(uint32_t limit);
JanetChannel *janet_getchannel(const Janet *argv, int32_t n);
JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt);
JANET_API int janet_channel_give(JanetChannel *channel, Janet x);
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
/* Expose some OS sync primitives */
JANET_API size_t janet_os_mutex_size(void);
JANET_API size_t janet_os_rwlock_size(void);
@ -1599,6 +1616,9 @@ JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
JANET_API int janet_scan_number_base(const uint8_t *str, int32_t len, int32_t base, double *out);
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
#ifdef JANET_INT_TYPES
JANET_API int janet_scan_numeric(const uint8_t *str, int32_t len, Janet *out);
#endif
/* Debugging */
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
@ -1723,6 +1743,9 @@ JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
JANET_API JanetTable *janet_table_clone(JanetTable *table);
JANET_API void janet_table_clear(JanetTable *table);
JANET_API JanetTable *janet_table_weakk(int32_t capacity);
JANET_API JanetTable *janet_table_weakv(int32_t capacity);
JANET_API JanetTable *janet_table_weakkv(int32_t capacity);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
@ -1786,6 +1809,7 @@ JANET_API void janet_gcpressure(size_t s);
/* Functions */
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
JANET_API JanetFunction *janet_thunk_delay(Janet x);
JANET_API int janet_verify(JanetFuncDef *def);
/* Pretty printing */
@ -2151,7 +2175,7 @@ typedef enum {
RULE_TO, /* [rule] */
RULE_THRU, /* [rule] */
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
RULE_READINT, /* [(signedness << 4) | (endianness << 5) | bytewidth, tag] */
RULE_LINE, /* [tag] */
RULE_COLUMN, /* [tag] */
RULE_UNREF, /* [rule, tag] */

17
src/mainclient/shell.c
View File

@ -867,7 +867,7 @@ static int line() {
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
for (;;) {
char c;
char seq[3];
char seq[5];
int rc;
do {
@ -991,6 +991,20 @@ static int line() {
default:
break;
}
} else if (seq[2] == ';') {
if (read_console(seq + 3, 2) == -1) break;
if (seq[3] == '5') {
switch (seq[4]) {
case 'C': /* ctrl-right */
krightw();
break;
case 'D': /* ctrl-left */
kleftw();
break;
default:
break;
}
}
}
} else if (seq[0] == 'O') {
if (read_console(seq + 1, 1) == -1) break;
@ -1163,6 +1177,7 @@ int main(int argc, char **argv) {
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
Janet mainargs[1] = { janet_wrap_array(args) };
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
janet_gcroot(janet_wrap_fiber(fiber));
fiber->env = env;
/* Run the fiber in an event loop */

52
test/helper.janet
View File

@ -4,24 +4,47 @@
(var num-tests-run 0)
(var suite-name 0)
(var start-time 0)
(var skip-count 0)
(var skip-n 0)
(def is-verbose (os/getenv "VERBOSE"))
(defn assert
(defn- assert-no-tail
"Override's the default assert with some nice error handling."
[x &opt e]
(default e "assert error")
(++ num-tests-run)
(when (pos? skip-n)
(-- skip-n)
(++ skip-count)
(break x))
(default e "assert error")
(when x (++ num-tests-passed))
(def str (string e))
(def frame (last (debug/stack (fiber/current))))
(def stack (debug/stack (fiber/current)))
(def frame (last stack))
(def line-info (string/format "%s:%d"
(frame :source) (frame :source-line)))
(if x
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
(do (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
(do
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
x)
(defn skip-asserts
"Skip some asserts"
[n]
(+= skip-n n)
nil)
(defmacro assert
[x &opt e]
(def xx (gensym))
(default e ~',x)
~(do
(def ,xx ,x)
(,assert-no-tail ,xx ,e)
,xx))
(defmacro assert-error
[msg & forms]
(def errsym (keyword (gensym)))
@ -52,5 +75,22 @@
(defn end-suite []
(def delta (- (os/clock) start-time))
(eprinf "Finished suite %s in %.3f seconds - " suite-name delta)
(eprint num-tests-passed " of " num-tests-run " tests passed.")
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
(eprint num-tests-passed " of " num-tests-run " tests passed (" skip-count " skipped).")
(if (not= (+ skip-count num-tests-passed) num-tests-run) (os/exit 1)))
(defn rmrf
"rm -rf in janet"
[x]
(case (os/lstat x :mode)
nil nil
:directory (do
(each y (os/dir x)
(rmrf (string x "/" y)))
(os/rmdir x))
(os/rm x))
nil)
(defn randdir
"Get a random directory name"
[]
(string "tmp_dir_" (slice (string (math/random) ".tmp") 2)))

11
test/suite-array.janet
View File

@ -46,7 +46,6 @@
(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
(assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4")
# array/peek
(assert (nil? (array/peek @[])) "array/peek empty")
@ -76,6 +75,16 @@
(array/trim a)
(array/ensure @[1 1] 6 2)
# array/join
(assert (deep= @[1 2 3] (array/join @[] [1] [2] [3])) "array/join 1")
(assert (deep= @[] (array/join @[])) "array/join 2")
(assert (deep= @[1 :a :b :c] (array/join @[1] @[:a :b] [] [:c])) "array/join 3")
(assert (deep= @[:x :y :z "abc123" "def456"] (array/join @[:x :y :z] ["abc123" "def456"])) "array/join 4")
(assert-error "array/join error 1" (array/join))
(assert-error "array/join error 2" (array/join []))
(assert-error "array/join error 3" (array/join [] "abc123"))
(assert-error "array/join error 4" (array/join @[] "abc123"))
(assert-error "array/join error 5" (array/join @[] "abc123"))
(end-suite)

9
test/suite-boot.janet
View File

@ -754,7 +754,7 @@
(default name (string "has-key? " (++ test-has-key-auto)))
(assert (= expected (has-key? col key)) name)
(if
# guarenteed by `has-key?` to never fail
# guaranteed by `has-key?` to never fail
expected (in col key)
# if `has-key?` is false, then `in` should fail (for indexed types)
#
@ -990,4 +990,11 @@
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
(setdyn *debug* true)
(def source '(defn a [x] (+ x x)))
(eval source)
(assert (= 20 (a 10)))
(assert (deep= (get (dyn 'a) :source-form) source))
(setdyn *debug* nil)
(end-suite)

23
test/suite-bundle.janet
View File

@ -23,30 +23,20 @@
(assert true) # smoke test
# Testing here is stateful since we are manipulating the filesystem.
# Copy since not exposed in boot.janet
(defn- bundle-rpath
[path]
(string/replace-all "\\" "/" (os/realpath path)))
(defn- rmrf
"rm -rf in janet"
[x]
(case (os/lstat x :mode)
nil nil
:directory (do
(each y (os/dir x)
(rmrf (string x "/" y)))
(os/rmdir x))
(os/rm x))
nil)
# Test mkdir -> rmdir
(assert (os/mkdir "tempdir123"))
(rmrf "tempdir123")
# Setup a temporary syspath for manipultation
(math/seedrandom (os/cryptorand 16))
(def syspath (string (math/random) "_jpm_tree.tmp"))
(def syspath (randdir))
(rmrf syspath)
(assert (os/mkdir syspath))
(put root-env *syspath* (bundle-rpath syspath))
@ -100,6 +90,13 @@
(assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]"
(bundle/uninstall "sample-dep1"))
# Check bundle file aliases
(assert-no-error "sample-bundle-aliases install" (bundle/install "./examples/sample-bundle-aliases"))
(assert (= 4 (length (bundle/list))) "bundles are listed correctly 5")
(assert-no-error "import aliases" (import aliases-mod))
(assert (deep= (range 12) (aliases-mod/fun 12)) "using sample-bundle-aliases")
(assert-no-error "aliases uninstall" (bundle/uninstall "sample-bundle-aliases"))
# Now re-install sample-bundle as auto-remove
(assert-no-error "sample-bundle install" (bundle/reinstall "sample-bundle" :auto-remove true))

7
test/suite-corelib.janet
View File

@ -69,6 +69,13 @@
(seq [n :range [0 10]] (% n 5 3))
[0 1 2 0 1 0 1 2 0 1]) "variadic mod")
# linspace range
(assert (deep= @[0 1 2 3] (range 4)) "range 1")
(assert (deep= @[0 1 2 3] (range 3.01)) "range 2")
(assert (deep= @[0 1 2 3] (range 3.999)) "range 3")
(assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 4")
(assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 5")
(assert (< 1.0 nil false true
(fiber/new (fn [] 1))
"hi"

90
test/suite-ev.janet
View File

@ -375,4 +375,94 @@
(ev/cancel f (gensym))
(ev/take superv)
# Chat server test
(def conmap @{})
(defn broadcast [em msg]
(eachk par conmap
(if (not= par em)
(if-let [tar (get conmap par)]
(net/write tar (string/format "[%s]:%s" em msg))))))
(defn handler
[connection]
(net/write connection "Whats your name?\n")
(def name (string/trim (string (ev/read connection 100))))
(if (get conmap name)
(do
(net/write connection "Name already taken!")
(:close connection))
(do
(put conmap name connection)
(net/write connection (string/format "Welcome %s\n" name))
(defer (do
(put conmap name nil)
(:close connection))
(while (def msg (ev/read connection 100))
(broadcast name (string msg)))))))
# Now launch the chat server
(def chat-server (net/listen test-host test-port))
(ev/spawn
(forever
(def [ok connection] (protect (net/accept chat-server)))
(if (and ok connection)
(ev/call handler connection)
(break))))
# Read from socket
(defn expect-read
[stream text]
(def result (string (net/read stream 100)))
(assert (= result text) (string/format "expected %v, got %v" text result)))
# Now do our telnet chat
(def bob (net/connect test-host test-port))
(expect-read bob "Whats your name?\n")
(net/write bob "bob")
(expect-read bob "Welcome bob\n")
(def alice (net/connect test-host test-port))
(expect-read alice "Whats your name?\n")
(net/write alice "alice")
(expect-read alice "Welcome alice\n")
# Bob says hello, alice gets the message
(net/write bob "hello\n")
(expect-read alice "[bob]:hello\n")
# Alice says hello, bob gets the message
(net/write alice "hi\n")
(expect-read bob "[alice]:hi\n")
# Ted joins the chat server
(def ted (net/connect test-host test-port))
(expect-read ted "Whats your name?\n")
(net/write ted "ted")
(expect-read ted "Welcome ted\n")
# Ted says hi, alice and bob get message
(net/write ted "hi\n")
(expect-read alice "[ted]:hi\n")
(expect-read bob "[ted]:hi\n")
# Bob leaves for work. Now it's just ted and alice
(:close bob)
# Alice messages ted, ted gets message
(net/write alice "wuzzup\n")
(expect-read ted "[alice]:wuzzup\n")
(net/write ted "not much\n")
(expect-read alice "[ted]:not much\n")
# Alice bounces
(:close alice)
# Ted can send messages, nobody gets them :(
(net/write ted "hello?\n")
(:close ted)
# Close chat server
(:close chat-server)
(end-suite)

1
test/suite-ffi.janet
View File

@ -21,7 +21,6 @@
(import ./helper :prefix "" :exit true)
(start-suite)
# We should get ARM support...
(def has-ffi (dyn 'ffi/native))
(def has-full-ffi
(and has-ffi

204
test/suite-filewatch.janet Normal file
View File

@ -0,0 +1,204 @@
# Copyright (c) 2024 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)
(assert true)
(def chan (ev/chan 1000))
(def is-win (or (= :mingw (os/which)) (= :windows (os/which))))
(def is-linux (= :linux (os/which)))
# If not supported, exit early
(def [supported msg] (protect (filewatch/new chan)))
(when (and (not supported) (string/find "filewatch not supported" msg))
(end-suite)
(quit))
# Test GC
(assert-no-error "filewatch/new" (filewatch/new chan))
(gccollect)
(defn- expect
[key value & more-kvs]
(ev/with-deadline
1
(def event (ev/take chan))
(when is-verbose (pp event))
(assert event "check event")
(assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value))
(when (next more-kvs)
(each [k v] (partition 2 more-kvs)
(assert (= v (get event k)) (string/format "got %p, expected %p" (get event k) v))))))
(defn- expect-empty
[]
(assert (zero? (ev/count chan)) "channel check empty")
(ev/sleep 0) # turn the event loop
(assert (zero? (ev/count chan)) "channel check empty")
# Drain if not empty, help with failures after this
(while (pos? (ev/count chan)) (printf "extra: %p" (ev/take chan))))
(defn- expect-maybe
"On wine + mingw, we get an extra event. This is a wine peculiarity."
[key value]
(ev/with-deadline
1
(ev/sleep 0)
(when (pos? (ev/count chan))
(def event (ev/take chan))
(when is-verbose (pp event))
(assert event "check event")
(assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value)))))
(defn spit-file
[dir name]
(def path (string dir "/" name))
(spit path "test text"))
# Different operating systems report events differently. While it would be nice to
# normalize this, each system has very large limitations in what can be reported when
# compared with other systems. As such, the maximum subset of common functionality here
# is quite small. Instead, test the capabilities of each system.
# Create a file watcher on two test directories
(def fw (filewatch/new chan))
(def td1 (randdir))
(def td2 (randdir))
(def td3 (randdir))
(rmrf td1)
(rmrf td2)
(os/mkdir td1)
(os/mkdir td2)
(os/mkdir td3)
(spit-file td3 "file3.txt")
(when is-win
(filewatch/add fw td1 :last-write :last-access :file-name :dir-name :size :attributes :recursive)
(filewatch/add fw td2 :last-write :last-access :file-name :dir-name :size :attributes))
(when is-linux
(filewatch/add fw (string td3 "/file3.txt") :close-write :create :delete)
(filewatch/add fw td1 :close-write :create :delete)
(filewatch/add fw td2 :close-write :create :delete :ignored))
(assert-no-error "filewatch/listen no error" (filewatch/listen fw))
#
# Windows file writing
#
(when is-win
(spit-file td1 "file1.txt")
(expect :type :added :file-name "file1.txt" :dir-name td1)
(expect :type :modified)
(expect-maybe :type :modified) # for mingw + wine
(gccollect)
(spit-file td1 "file1.txt")
(expect :type :modified)
(expect :type :modified)
(expect-empty)
(gccollect)
# Check td2
(spit-file td2 "file2.txt")
(expect :type :added)
(expect :type :modified)
(expect-maybe :type :modified)
# Remove a file, then wait for remove event
(rmrf (string td1 "/file1.txt"))
(expect :type :removed)
(expect-empty)
# Unlisten to some events
(filewatch/remove fw td2)
# Check that we don't get anymore events from test directory 2
(spit-file td2 "file2.txt")
(expect-empty)
# Repeat and things should still work with test directory 1
(spit-file td1 "file1.txt")
(expect :type :added)
(expect :type :modified)
(expect-maybe :type :modified)
(gccollect)
(spit-file td1 "file1.txt")
(expect :type :modified)
(expect :type :modified)
(expect-maybe :type :modified)
(gccollect))
#
# Linux file writing
#
(when is-linux
(spit-file td1 "file1.txt")
(expect :type :create :file-name "file1.txt" :dir-name td1)
(expect :type :close-write)
(expect-empty)
(gccollect)
(spit-file td1 "file1.txt")
(expect :type :close-write)
(expect-empty)
(gccollect)
# Check file3.txt
(spit-file td3 "file3.txt")
(expect :type :close-write :file-name "file3.txt" :dir-name td3)
(expect-empty)
# Check td2
(spit-file td2 "file2.txt")
(expect :type :create)
(expect :type :close-write)
(expect-empty)
# Remove a file, then wait for remove event
(rmrf (string td1 "/file1.txt"))
(expect :type :delete)
(expect-empty)
# Unlisten to some events
(filewatch/remove fw td2)
(expect :type :ignored)
(expect-empty)
# Check that we don't get anymore events from test directory 2
(spit-file td2 "file2.txt")
(expect-empty)
# Repeat and things should still work with test directory 1
(spit-file td1 "file1.txt")
(expect :type :create)
(expect :type :close-write)
(expect-empty)
(gccollect)
(spit-file td1 "file1.txt")
(expect :type :close-write)
(expect-empty)
(gccollect))
(assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw))
(assert-no-error "cleanup 1" (rmrf td1))
(assert-no-error "cleanup 2" (rmrf td2))
(assert-no-error "cleanup 3" (rmrf td3))
(end-suite)

8
test/suite-inttypes.janet
View File

@ -47,6 +47,14 @@
(assert (= (int/to-number (i64 9007199254740991)) 9007199254740991))
(assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991))
# New parser
(assert (= (u64 "123") 123:u) "u64 parsing")
(assert (= (u64 "0") 0:u) "u64 parsing")
(assert (= (u64 "0xFFFF_FFFF_FFFF_FFFF") 0xFFFF_FFFF_FFFF_FFFF:u) "u64 parsing")
(assert (= (i64 "123") 123:s) "s64 parsing")
(assert (= (i64 "-123") -123:s) "s64 parsing")
(assert (= (i64 "0") 0:s) "s64 parsing")
(assert-error
"u64 out of bounds for safe integer"
(int/to-number (u64 "9007199254740993"))

77
test/suite-marsh.janet
View File

@ -146,5 +146,80 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(def item (ev/take newchan))
(assert (= item newchan) "ev/chan marshalling"))
(end-suite)
# Issue #1488 - marshalling weak values
(testmarsh (array/weak 10) "marsh array/weak")
(testmarsh (table/weak-keys 10) "marsh table/weak-keys")
(testmarsh (table/weak-values 10) "marsh table/weak-values")
(testmarsh (table/weak 10) "marsh table/weak")
# Now check that gc works with weak containers after marshalling
# Turn off automatic GC for testing weak references
(gcsetinterval 0x7FFFFFFF)
# array
(def a (array/weak 1))
(array/push a @"")
(assert (= 1 (length a)) "array/weak marsh 1")
(def aclone (-> a marshal unmarshal))
(assert (= 1 (length aclone)) "array/weak marsh 2")
(gccollect)
(assert (= 1 (length aclone)) "array/weak marsh 3")
(assert (= 1 (length a)) "array/weak marsh 4")
(assert (= nil (get a 0)) "array/weak marsh 5")
(assert (= nil (get aclone 0)) "array/weak marsh 6")
(assert (deep= a aclone) "array/weak marsh 7")
# table weak keys and values
(def t (table/weak 1))
(def keep-key :key)
(def keep-value :value)
(put t :abc @"")
(put t :key :value)
(assert (= 2 (length t)) "table/weak marsh 1")
(def tclone (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak marsh 2")
(gccollect)
(assert (= 1 (length tclone)) "table/weak marsh 3")
(assert (= 1 (length t)) "table/weak marsh 4")
(assert (= keep-value (get t keep-key)) "table/weak marsh 5")
(assert (= keep-value (get tclone keep-key)) "table/weak marsh 6")
(assert (deep= t tclone) "table/weak marsh 7")
# table weak keys
(def t (table/weak-keys 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-keys marsh 1")
(def tclone (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak-keys marsh 2")
(gccollect)
(assert (= 1 (length tclone)) "table/weak-keys marsh 3")
(assert (= 1 (length t)) "table/weak-keys marsh 4")
(assert (deep= t tclone) "table/weak-keys marsh 5")
# table weak values
(def t (table/weak-values 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-values marsh 1")
(def tclone (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
(gccollect)
(assert (= 1 (length t)) "table/weak-value marsh 3")
(assert (deep= t tclone) "table/weak-values marsh 4")
# tables with prototypes
(def t (table/weak-values 1))
(table/setproto t @{:abc 123})
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "marsh weak tables with prototypes 1")
(def tclone (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
(gccollect)
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")
(assert (deep= t tclone) "marsh weak tables with prototypes 4")
(assert (deep= (getproto t) (getproto tclone)) "marsh weak tables with prototypes 5")
(end-suite)

6
test/suite-os.janet
View File

@ -131,6 +131,12 @@
(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
# Pipes
(assert-no-error (os/pipe))
(assert-no-error (os/pipe :RW))
(assert-no-error (os/pipe :R))
(assert-no-error (os/pipe :W))
# os/execute with environment variables
# issue #636 - 7e2c433ab
(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe

2
test/suite-peg.janet
View File

@ -492,7 +492,7 @@
# header, followed by body, and drop the :header-len capture
:packet (/ (* :packet-header :packet-body) ,|$1)
# any exact seqence of packets (no extra characters)
# any exact sequence of packets (no extra characters)
:main (* (any :packet) -1)}))
(assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc"))

30
test/suite-tuple.janet Normal file
View File

@ -0,0 +1,30 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
(assert (= [1 2 3] (tuple/join [1] [2] [3])) "tuple/join 1")
(assert (= [] (tuple/join)) "tuple/join 2")
(assert (= [:a :b :c] (tuple/join @[:a :b] [] [:c])) "tuple/join 3")
(assert (= ["abc123" "def456"] (tuple/join ["abc123" "def456"])) "tuple/join 4")
(end-suite)