diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index e26ed7ed..68afc1ce 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -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" diff --git a/CHANGELOG.md b/CHANGELOG.md index 72addf6d..94901287 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/Makefile b/Makefile index 3b1f4a78..b6721aa2 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/build_win.bat b/build_win.bat index 8ee166f3..5e40d14b 100644 --- a/build_win.bat +++ b/build_win.bat @@ -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 diff --git a/examples/chatserver.janet b/examples/chatserver.janet new file mode 100644 index 00000000..534444f5 --- /dev/null +++ b/examples/chatserver.janet @@ -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))) diff --git a/examples/ffi/so.c b/examples/ffi/so.c index b2d097bf..1ce3120e 100644 --- a/examples/ffi/so.c +++ b/examples/ffi/so.c @@ -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; +} diff --git a/examples/ffi/test.janet b/examples/ffi/test.janet index 3d97596c..b63fb1c3 100644 --- a/examples/ffi/test.janet +++ b/examples/ffi/test.janet @@ -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.") diff --git a/examples/sample-bundle-aliases/aliases-mod.janet b/examples/sample-bundle-aliases/aliases-mod.janet new file mode 100644 index 00000000..a5f66831 --- /dev/null +++ b/examples/sample-bundle-aliases/aliases-mod.janet @@ -0,0 +1 @@ +(defn fun [x] (range x)) diff --git a/examples/sample-bundle-aliases/bundle.janet b/examples/sample-bundle-aliases/bundle.janet new file mode 100644 index 00000000..fc6eefac --- /dev/null +++ b/examples/sample-bundle-aliases/bundle.janet @@ -0,0 +1,3 @@ +(defn install + [manifest &] + (bundle/add-file manifest "aliases-mod.janet")) diff --git a/examples/sample-bundle-aliases/info.jdn b/examples/sample-bundle-aliases/info.jdn new file mode 100644 index 00000000..65bb8646 --- /dev/null +++ b/examples/sample-bundle-aliases/info.jdn @@ -0,0 +1,4 @@ +@{ + :name "sample-bundle-aliases" + :dependencies ["sample-dep1" "sample-dep2"] +} diff --git a/meson.build b/meson.build index c82459bc..0aa40303 100644 --- a/meson.build +++ b/meson.build @@ -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' diff --git a/meson_options.txt b/meson_options.txt index f6730593..7b9b33af 100644 --- a/meson_options.txt +++ b/meson_options.txt @@ -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) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index aeac1727..17aa50fa 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -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)) - (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)) - (file/write fto b) - (buffer/clear b))))) + (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)) + (forever + (file/read ffrom 0x10000 b) + (when (empty? b) (buffer/trim b) (os/chmod to perm) (break)) + (file/write fto 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" diff --git a/src/boot/system_test.c b/src/boot/system_test.c index 0edcc1e4..aed27b52 100644 --- a/src/boot/system_test.c +++ b/src/boot/system_test.c @@ -22,7 +22,7 @@ #include #include -#include +#include #include #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())); diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index 94270b6f..c7c48b1e 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -4,10 +4,10 @@ #define JANETCONF_H #define JANET_VERSION_MAJOR 1 -#define JANET_VERSION_MINOR 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 */ diff --git a/src/core/array.c b/src/core/array.c index 32ee5dfa..2eb52b6e 100644 --- a/src/core/array.c +++ b/src/core/array.c @@ -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); diff --git a/src/core/buffer.c b/src/core/buffer.c index 2983a0fc..085133ef 100644 --- a/src/core/buffer.c +++ b/src/core/buffer.c @@ -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]; } diff --git a/src/core/bytecode.c b/src/core/bytecode.c index ff431974..5ab3048c 100644 --- a/src/core/bytecode.c +++ b/src/core/bytecode.c @@ -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; diff --git a/src/core/capi.c b/src/core/capi.c index 9dd5d29d..959ea985 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -25,6 +25,7 @@ #include #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); diff --git a/src/core/compile.h b/src/core/compile.h index c9109ca0..40ba2136 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -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 */ diff --git a/src/core/corelib.c b/src/core/corelib.c index 5eb6a9ff..7ac7f564 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -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); diff --git a/src/core/debug.c b/src/core/debug.c index 12c6c2c4..fa24a378 100644 --- a/src/core/debug.c +++ b/src/core/debug.c @@ -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; diff --git a/src/core/ev.c b/src/core/ev.c index e277b6e8..0a46c886 100644 --- a/src/core/ev.c +++ b/src/core/ev.c @@ -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, "", 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)) { - janet_panicf("failed to listen for events: %V", janet_ev_lasterr()); + 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 diff --git a/src/core/ffi.c b/src/core/ffi.c index 03fccfd1..fb322c9d 100644 --- a/src/core/ffi.c +++ b/src/core/ffi.c @@ -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); diff --git a/src/core/filewatch.c b/src/core/filewatch.c new file mode 100644 index 00000000..4e8e85b7 --- /dev/null +++ b/src/core/filewatch.c @@ -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 +#include "util.h" +#endif + +#ifdef JANET_EV +#ifdef JANET_FILEWATCH + +#ifdef JANET_LINUX +#include +#include +#endif + +#ifdef JANET_WINDOWS +#include +#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 +#include + +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 ):\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 diff --git a/src/core/gc.c b/src/core/gc.c index 9350b319..3afcfe8a 100644 --- a/src/core/gc.c +++ b/src/core/gc.c @@ -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: { diff --git a/src/core/gc.h b/src/core/gc.h index e5f99884..b7385738 100644 --- a/src/core/gc.h +++ b/src/core/gc.h @@ -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 diff --git a/src/core/io.c b/src/core/io.c index 75e2ec5e..eb875019 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -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; diff --git a/src/core/marsh.c b/src/core/marsh.c index c82baf1a..088f14f9 100644 --- a/src/core/marsh.c +++ b/src/core/marsh.c @@ -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(); - pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE); + 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); diff --git a/src/core/math.c b/src/core/math.c index a95d3ab3..f3128de1 100644 --- a/src/core/math.c +++ b/src/core/math.c @@ -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; diff --git a/src/core/net.c b/src/core/net.c index acf0ae08..c3f8c87b 100644 --- a/src/core/net.c +++ b/src/core/net.c @@ -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); diff --git a/src/core/os.c b/src/core/os.c index 2cd079d8..d7ffe6da 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -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)); } diff --git a/src/core/parse.c b/src/core/parse.c index 40ccfbf2..0d667f2f 100644 --- a/src/core/parse.c +++ b/src/core/parse.c @@ -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)) { diff --git a/src/core/peg.c b/src/core/peg.c index 35a36166..48ba88d1 100644 --- a/src/core/peg.c +++ b/src/core/peg.c @@ -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 . 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]); diff --git a/src/core/state.c b/src/core/state.c index 8d5e2556..c3307869 100644 --- a/src/core/state.c +++ b/src/core/state.c @@ -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; diff --git a/src/core/strtod.c b/src/core/strtod.c index 258ba9d8..025dbb2a 100644 --- a/src/core/strtod.c +++ b/src/core/strtod.c @@ -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) { diff --git a/src/core/table.c b/src/core/table.c index 4ebcde5f..5f619eee 100644 --- a/src/core/table.c +++ b/src/core/table.c @@ -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); } diff --git a/src/core/tuple.c b/src/core/tuple.c index bf6d09e6..c67c94a0 100644 --- a/src/core/tuple.c +++ b/src/core/tuple.c @@ -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); diff --git a/src/core/util.h b/src/core/util.h index 86234986..7a0dbaff 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -33,6 +33,7 @@ #include #include #include +#include #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 diff --git a/src/core/vm.c b/src/core/vm.c index 91a86318..051d406f 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -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)); diff --git a/src/include/janet.h b/src/include/janet.h index 853eb364..4ddf8ee4 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -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] */ diff --git a/src/mainclient/shell.c b/src/mainclient/shell.c index 696fb352..8643df54 100644 --- a/src/mainclient/shell.c +++ b/src/mainclient/shell.c @@ -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 */ diff --git a/test/helper.janet b/test/helper.janet index 799f3993..288638a9 100644 --- a/test/helper.janet +++ b/test/helper.janet @@ -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))) diff --git a/test/suite-array.janet b/test/suite-array.janet index 0b02ab1e..f0fecbaa 100644 --- a/test/suite-array.janet +++ b/test/suite-array.janet @@ -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) diff --git a/test/suite-boot.janet b/test/suite-boot.janet index 24f2e7b9..c3c8b743 100644 --- a/test/suite-boot.janet +++ b/test/suite-boot.janet @@ -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) diff --git a/test/suite-bundle.janet b/test/suite-bundle.janet index f7452bd2..a0f4c031 100644 --- a/test/suite-bundle.janet +++ b/test/suite-bundle.janet @@ -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)) diff --git a/test/suite-corelib.janet b/test/suite-corelib.janet index e6fe0fea..3c209418 100644 --- a/test/suite-corelib.janet +++ b/test/suite-corelib.janet @@ -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" diff --git a/test/suite-ev.janet b/test/suite-ev.janet index 2fe7f2f5..f0e859bf 100644 --- a/test/suite-ev.janet +++ b/test/suite-ev.janet @@ -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) diff --git a/test/suite-ffi.janet b/test/suite-ffi.janet index 6ad4f70c..0a810198 100644 --- a/test/suite-ffi.janet +++ b/test/suite-ffi.janet @@ -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 diff --git a/test/suite-filewatch.janet b/test/suite-filewatch.janet new file mode 100644 index 00000000..90bb82b9 --- /dev/null +++ b/test/suite-filewatch.janet @@ -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) diff --git a/test/suite-inttypes.janet b/test/suite-inttypes.janet index 6f5c35eb..67272130 100644 --- a/test/suite-inttypes.janet +++ b/test/suite-inttypes.janet @@ -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")) diff --git a/test/suite-marsh.janet b/test/suite-marsh.janet index 6e840910..b9f4d277 100644 --- a/test/suite-marsh.janet +++ b/test/suite-marsh.janet @@ -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) diff --git a/test/suite-os.janet b/test/suite-os.janet index fdc623da..c4d2bda6 100644 --- a/test/suite-os.janet +++ b/test/suite-os.janet @@ -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 diff --git a/test/suite-peg.janet b/test/suite-peg.janet index e0c85e66..b4547db2 100644 --- a/test/suite-peg.janet +++ b/test/suite-peg.janet @@ -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")) diff --git a/test/suite-tuple.janet b/test/suite-tuple.janet new file mode 100644 index 00000000..6a74e9ec --- /dev/null +++ b/test/suite-tuple.janet @@ -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) + diff --git a/tools/afl/parser_testcases/simple.janet b/tools/afl/parser_testcases/simple.janet index d4a7e7e0..417cfbff 100644 --- a/tools/afl/parser_testcases/simple.janet +++ b/tools/afl/parser_testcases/simple.janet @@ -12,4 +12,4 @@ true @[1 "hello"] nil (foo 2 3) -([{} @{:k ([""])}]) \ No newline at end of file +([{} @{:k ([""])}])