diff --git a/.gitattributes b/.gitattributes deleted file mode 100644 index e69de29b..00000000 diff --git a/CHANGELOG.md b/CHANGELOG.md index 17c5b188..870dfa10 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,35 @@ All notable changes to this project will be documented in this file. ## Unreleased - ??? -- Add JANET_GIT environment variable to jpm to use a specific git binary (useful mainly on windows). +- `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. +- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf). + +## 1.10.1 - 2020-06-18 +- Expose `janet_table_clear` in API. +- Respect `JANET_NO_PROCESSES` define when building +- Fix `jpm` rules having multiple copies of the same dependency. +- Fix `jpm` install in some cases. +- Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types + to their current length. + +## 1.10.0 - 2020-06-14 +- Hardcode default jpm paths on install so env variables are needed in fewer cases. +- Add `:no-compile` to `create-executable` option for jpm. +- Fix bug with the `trace` function. +- Add `:h`, `:a`, and `:c` flags to `thread/new` for creating new kinds of threads. + By default, threads will now consume much less memory per thread, but sending data between + threads may cost more. +- Fix flychecking when using the `use` macro. +- CTRL-C no longer exits the repl, and instead cancels the current form. +- Various small bug fixes +- New MSI installer instead of NSIS based installer. +- Make `os/realpath` work on windows. +- Add polymorphic `compare` functions for comparing numbers. +- Add `to` and `thru` peg combinators. +- Add `JANET_GIT` environment variable to jpm to use a specific git binary (useful mainly on windows). - `asm` and `disasm` functions now use keywords instead of macros for keys. Also some slight changes to the way constants are encoded (remove wrapping `quote` in some cases). - Expose current macro form inside macros as (dyn :macro-form) diff --git a/Makefile b/Makefile index 49548e65..97cc517c 100644 --- a/Makefile +++ b/Makefile @@ -150,7 +150,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet ##### Amalgamation ##### ######################## -SONAME=libjanet.so.1.9 +SONAME=libjanet.so.1.10 build/shell.c: src/mainclient/shell.c cp $< $@ @@ -234,6 +234,10 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet ##### Installation ##### ######################## +build/jpm: jpm $(JANET_TARGET) + $(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)" + chmod +x build/jpm + .INTERMEDIATE: build/janet.pc build/janet.pc: $(JANET_TARGET) echo 'prefix=$(PREFIX)' > $@ @@ -249,7 +253,7 @@ build/janet.pc: $(JANET_TARGET) echo 'Libs: -L$${libdir} -ljanet' >> $@ echo 'Libs.private: $(CLIBS)' >> $@ -install: $(JANET_TARGET) build/janet.pc +install: $(JANET_TARGET) build/janet.pc build/jpm mkdir -p '$(DESTDIR)$(BINDIR)' cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet' mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet' @@ -260,7 +264,7 @@ install: $(JANET_TARGET) build/janet.pc cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a' ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) - cp -rf jpm '$(DESTDIR)$(BINDIR)' + cp -rf build/jpm '$(DESTDIR)$(BINDIR)' mkdir -p '$(DESTDIR)$(MANPATH)' cp janet.1 '$(DESTDIR)$(MANPATH)' cp jpm.1 '$(DESTDIR)$(MANPATH)' diff --git a/README.md b/README.md index 3ffc0f1b..5be52330 100644 --- a/README.md +++ b/README.md @@ -146,6 +146,7 @@ cd janet meson setup build \ --buildtype release \ --optimization 2 \ + --libdir /usr/local/lib \ -Dgit_hash=$(git log --pretty=format:'%h' -n 1) ninja -C build diff --git a/jpm b/jpm index 6a677257..31ca46d2 100755 --- a/jpm +++ b/jpm @@ -19,6 +19,9 @@ # Defaults # +###START### + +# Overriden on some installs. (def- exe-dir "Directory containing jpm script" (do @@ -26,21 +29,28 @@ (def i (last (string/find-all sep exe))) (slice exe 0 i))) -(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath))) +(defn- install-paths [] + {:headerpath (os/realpath (string exe-dir "/../include/janet")) + :libpath (os/realpath (string exe-dir "/../lib")) + :binpath exe-dir}) + +###END### # Default based on janet binary location (def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH") - (string exe-dir "/../include/janet"))) + (get (install-paths) :headerpath))) (def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH") - (string exe-dir "/../lib"))) - + (get (install-paths) :libpath))) # We want setting JANET_PATH to contain installed binaries. However, it is convenient # to have globally installed binaries got to the same place as jpm itself, which is on # the $PATH. (def JANET_BINPATH (or (os/getenv "JANET_BINPATH") (if-let [mp (os/getenv "JANET_MODPATH")] (string mp "/bin")) (if-let [mp (os/getenv "JANET_PATH")] (string mp "/bin")) - exe-dir)) + (get (install-paths) :binpath))) + +# modpath should only be derived from the syspath being used or an environment variable. +(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath))) # # Utilities @@ -66,11 +76,13 @@ (defn rm "Remove a directory and all sub directories." [path] - (if (= (os/lstat path :mode) :directory) - (do + (case (os/lstat path :mode) + :directory (do (each subpath (os/dir path) (rm (string path sep subpath))) (os/rmdir path)) + nil nil # do nothing if file does not exist + # Default, try to remove (os/rm path))) (defn- rimraf @@ -78,7 +90,8 @@ [path] (if is-win # windows get rid of read-only files - (os/shell (string `rmdir /S /Q "` path `"`)) + (when (os/stat path :mode) + (os/shell (string `rmdir /S /Q "` path `"`))) (rm path))) (defn clear-cache @@ -175,9 +188,27 @@ (unless item (error (string "No rule for target " target))) item) +(defn add-dep + "Add a dependency to an existing rule. Useful for extending phony + rules or extending the dependency graph of existing rules." + [target dep] + (def [deps] (gettarget target)) + (unless (find |(= dep $) deps) + (array/push deps dep))) + +(defn- add-thunk + [target more &opt phony] + (def item (gettarget target)) + (def [_ thunks pthunks] item) + (array/push (if phony pthunks thunks) more) + item) + (defn- rule-impl [target deps thunk &opt phony] - (put (getrules) target @[(array/slice deps) @[thunk] phony])) + (def rules (getrules)) + (unless (rules target) (put rules target @[(array/slice deps) @[] @[]])) + (each d deps (add-dep target d)) + (add-thunk target thunk phony)) (defmacro rule "Add a rule to the rule graph." @@ -201,20 +232,6 @@ [target deps & body] ~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true)) -(defn add-dep - "Add a dependency to an existing rule. Useful for extending phony - rules or extending the dependency graph of existing rules." - [target dep] - (def [deps] (gettarget target)) - (array/push deps dep)) - -(defn- add-thunk - [target more] - (def item (gettarget target)) - (def [_ thunks] item) - (array/push thunks more) - item) - (defmacro add-body "Add recipe code to an existing rule. This makes existing rules do more but does not modify the dependency graph." @@ -244,9 +261,11 @@ (error (string "No rule for file " target " found.")))) (def [deps thunks phony] item) (def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x)) - (when (or phony (needs-build-some target realdeps)) - (each thunk thunks (thunk))) - (unless phony target)) + (each thunk phony (thunk)) + (unless (empty? thunks) + (when (needs-build-some target realdeps) + (each thunk thunks (thunk)) + target))) # # Importing a file @@ -310,26 +329,30 @@ # Detect threads (def env (fiber/getenv (fiber/current))) (def threads? (not (not (env 'thread/new)))) - -# Default libraries to link (def- thread-flags (if is-win [] (if threads? ["-lpthread"] []))) -# lflags needed for the janet binary. +# flags needed for the janet binary and compiling standalone +# executables. (def janet-lflags (case (os/which) :macos ["-ldl" "-lm" ;thread-flags] :windows [;thread-flags] :linux ["-lm" "-ldl" "-lrt" ;thread-flags] ["-lm" ;thread-flags])) +(def janet-ldflags []) +(def janet-cflags []) # Default flags for natives, but not required +# How can we better detect the need for -pthread? +# we probably want to better detect compiler (def default-lflags (if is-win ["/nologo"] [])) (def default-cflags (if is-win ["/nologo" "/MD"] ["-std=c99" "-Wall" "-Wextra"])) +(def default-ldflags []) # Required flags for dynamic libraries. These # are used no matter what for dynamic libraries. @@ -339,7 +362,7 @@ ["-fPIC"])) (def- dynamic-lflags (if is-win - ["/DLL" ;thread-flags] + ["/DLL"] (if is-mac ["-shared" "-undefined" "dynamic_lookup" ;thread-flags] ["-shared" ;thread-flags]))) @@ -385,8 +408,8 @@ "Generate strings for adding custom defines to the compiler." [define value] (if value - (string (if is-win "/D" "-D") define "=" value) - (string (if is-win "/D" "-D") define))) + (string "-D" define "=" value) + (string "-D" define))) (defn- make-defines "Generate many defines. Takes a dictionary of defines. If a value is @@ -398,8 +421,8 @@ "Generate the c flags from the input options." [opts] @[;(opt opts :cflags default-cflags) - (string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH)) - (string (if is-win "/O" "-O") (opt opts :optimize 2))]) + (string "-I" (dyn :headerpath JANET_HEADERPATH)) + (string "-O" (opt opts :optimize 2))]) (defn- entry-name "Name of symbol that enters static compilation of a module." @@ -585,7 +608,8 @@ int main(int argc, const char **argv) { # Create executable's janet image (def cimage_dest (string dest ".c")) - (rule dest [source] + (def no-compile (opts :no-compile)) + (rule (if no-compile cimage_dest dest) [source] (check-cc) (print "generating executable c source...") (create-dirs dest) @@ -641,11 +665,11 @@ int main(int argc, const char **argv) { # Append main function (spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab) # Compile and link final exectable - (do + (unless no-compile (def cc (opt opts :compiler default-compiler)) - (def ldflags [;dep-ldflags ;(opt opts :ldflags [])]) + (def ldflags [;dep-ldflags ;(opt opts :ldflags []) ;janet-ldflags]) (def lflags [;static-libs (libjanet) ;dep-lflags ;(opt opts :lflags default-lflags) ;janet-lflags]) - (def cflags (getcflags opts)) + (def cflags [;(getcflags opts) ;janet-cflags]) (def defines (make-defines (opt opts :defines {}))) (print "compiling and linking " dest "...") (if is-win @@ -728,7 +752,7 @@ int main(int argc, const char **argv) { :binpath (abspath (dyn :binpath JANET_BINPATH))] (os/cd module-dir) (unless fresh - (os/execute [(git-path) "pull" "origin" "master"] :p)) + (os/execute [(git-path) "pull" "origin" "master" "--ff-only"] :p)) (when tag (os/execute [(git-path) "reset" "--hard" tag] :p)) (unless (dyn :offline) @@ -747,9 +771,9 @@ int main(int argc, const char **argv) { (def name (last parts)) (def path (string destdir sep name)) (array/push (dyn :installed-files) path) - (add-body "install" - (mkdir destdir) - (copy src destdir))) + (phony "install" [] + (mkdir destdir) + (copy src destdir))) (defn- make-lockfile [&opt filename] @@ -884,17 +908,22 @@ int main(int argc, const char **argv) { is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n This executable can be installed as well to the --binpath given." [&keys {:install install :name name :entry entry :headers headers - :cflags cflags :lflags lflags :deps deps :ldflags ldflags}] + :cflags cflags :lflags lflags :deps deps :ldflags ldflags + :no-compile no-compile}] (def name (if is-win (string name ".exe") name)) (def dest (string "build" sep name)) - (create-executable @{:cflags cflags :lflags lflags :ldflags ldflags} entry dest) - (add-dep "build" dest) - (when headers - (each h headers (add-dep dest h))) - (when deps - (each d deps (add-dep dest d))) - (when install - (install-rule dest (dyn :binpath JANET_BINPATH)))) + (create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest) + (if no-compile + (let [cdest (string dest ".c")] + (add-dep "build" cdest)) + (do + (add-dep "build" dest) + (when headers + (each h headers (add-dep dest h))) + (when deps + (each d deps (add-dep dest d))) + (when install + (install-rule dest (dyn :binpath JANET_BINPATH)))))) (defn declare-binscript "Declare a janet file to be installed as an executable script. Creates @@ -908,7 +937,7 @@ int main(int argc, const char **argv) { (def name (last parts)) (def path (string binpath sep name)) (array/push (dyn :installed-files) path) - (add-body "install" + (phony "install" [] (def contents (with [f (file/open main)] (def first-line (:read f :line)) @@ -926,7 +955,7 @@ int main(int argc, const char **argv) { (def bat (string "@echo off\r\njanet \"" fullname "\" %*")) (def newname (string binpath sep name ".bat")) (array/push (dyn :installed-files) newname) - (add-body "install" + (phony "install" [] (spit newname bat)))) (defn- print-rule-tree @@ -973,7 +1002,8 @@ int main(int argc, const char **argv) { (phony "build" []) - (phony "manifest" [] + (phony "manifest" [manifest]) + (rule manifest [] (print "generating " manifest "...") (mkdir manifests) (def sha (pslurp (string "\"" (git-path) "\" rev-parse HEAD"))) @@ -985,7 +1015,7 @@ int main(int argc, const char **argv) { :paths installed-files}) (spit manifest (string/format "%j\n" man))) - (phony "install" ["uninstall" "build" "manifest"] + (phony "install" ["uninstall" "build" manifest] (when (dyn :test) (do-rule "test")) (print "Installed as '" (meta :name) "'.")) diff --git a/meson.build b/meson.build index 2324e440..92e96b8c 100644 --- a/meson.build +++ b/meson.build @@ -20,7 +20,7 @@ project('janet', 'c', default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'], - version : '1.10.0') + version : '1.10.2') # Global settings janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') @@ -247,7 +247,18 @@ pkg.generate(libjanet, # Installation install_man('janet.1') -install_man('jpm.1') install_headers(['src/include/janet.h', jconf], subdir: 'janet') -install_data(sources : ['jpm'], install_dir : get_option('bindir')) install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet')) +if get_option('peg') and not get_option('reduced_os') and get_option('processes') + install_man('jpm.1') + patched_jpm = custom_target('patched-jpm', + input : ['tools/patch-jpm.janet', 'jpm'], + install : true, + install_dir : get_option('bindir'), + build_by_default : true, + output : ['jpm'], + command : [janet_nativeclient, '@INPUT@', '@OUTPUT@', + '--binpath=' + join_paths(get_option('prefix'), get_option('bindir')), + '--libpath=' + join_paths(get_option('prefix'), get_option('libdir'), 'janet'), + '--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))]) +endif diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 12883523..6e660f32 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -433,6 +433,17 @@ (def ,binding ,i) ,body)))) +(defn- loop-fiber-template + [binding expr body] + (with-syms [f s] + (def ds (if (idempotent? binding) binding (gensym))) + ~(let [,f ,expr] + (while true + (def ,ds (,resume ,f)) + (if (= :dead (,fiber/status ,f)) (break)) + ,;(if (= ds binding) [] [~(def ,binding ,ds)]) + ,;body)))) + (defn- loop1 [body head i] @@ -470,12 +481,7 @@ :pairs (keys-template binding object true [rest]) :in (each-template binding object [rest]) :iterate (iterate-template binding object rest) - :generate (with-syms [f s] - ~(let [,f ,object] - (while true - (def ,binding (,resume ,f)) - (if (= :dead (,fiber/status ,f)) (break)) - ,rest))) + :generate (loop-fiber-template binding object [rest]) (error (string "unexpected loop verb " verb))))) (defmacro for @@ -493,6 +499,18 @@ [x ds & body] (keys-template x ds true body)) +(defmacro eachy + "Resume a fiber in a loop until it has errored or died. Evaluate the body + of the loop with binding set to the yielded value." + [x fiber & body] + (loop-fiber-template x fiber body)) + +(defmacro repeat + "Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil." + [n & body] + (with-syms [iter] + ~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter))))) + (defmacro each "Loop over each value in ds. Returns nil." [x ds & body] @@ -542,6 +560,7 @@ (put _env 'each-template nil) (put _env 'keys-template nil) (put _env 'range-template nil) +(put _env 'loop-fiber-template nil) (defmacro seq "Similar to loop, but accumulates the loop body into an array and returns that. diff --git a/src/conf/janetconf.h b/src/conf/janetconf.h index c99c7d39..89a2efb8 100644 --- a/src/conf/janetconf.h +++ b/src/conf/janetconf.h @@ -28,9 +28,9 @@ #define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MINOR 10 -#define JANET_VERSION_PATCH 0 +#define JANET_VERSION_PATCH 2 #define JANET_VERSION_EXTRA "-dev" -#define JANET_VERSION "1.10.0" +#define JANET_VERSION "1.10.2-dev" /* #define JANET_BUILD "local" */ diff --git a/src/core/array.c b/src/core/array.c index 46014d9c..a7f92155 100644 --- a/src/core/array.c +++ b/src/core/array.c @@ -270,6 +270,26 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) { return argv[0]; } +static Janet cfun_array_trim(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + JanetArray *array = janet_getarray(argv, 0); + if (array->count) { + if (array->count < array->capacity) { + Janet *newData = realloc(array->data, array->count * sizeof(Janet)); + if (NULL == newData) { + JANET_OUT_OF_MEMORY; + } + array->data = newData; + array->capacity = array->count; + } + } else { + array->capacity = 0; + free(array->data); + array->data = NULL; + } + return argv[0]; +} + static const JanetReg array_cfuns[] = { { "array/new", cfun_array_new, @@ -345,6 +365,11 @@ static const JanetReg array_cfuns[] = { "By default, n is 1. " "Returns the array.") }, + { + "array/trim", cfun_array_trim, + JDOC("(array/trim arr)\n\n" + "Set the backing capacity of an array to its current length. Returns the modified array.") + }, {NULL, NULL, NULL} }; diff --git a/src/core/buffer.c b/src/core/buffer.c index ee205600..6e040c00 100644 --- a/src/core/buffer.c +++ b/src/core/buffer.c @@ -197,6 +197,26 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) { return argv[0]; } +static Janet cfun_buffer_trim(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + JanetBuffer *buffer = janet_getbuffer(argv, 0); + if (buffer->count) { + if (buffer->count < buffer->capacity) { + uint8_t *newData = realloc(buffer->data, buffer->count); + if (NULL == newData) { + JANET_OUT_OF_MEMORY; + } + buffer->data = newData; + buffer->capacity = buffer->count; + } + } else { + buffer->capacity = 0; + free(buffer->data); + buffer->data = NULL; + } + return argv[0]; +} + static Janet cfun_buffer_u8(int32_t argc, Janet *argv) { int32_t i; janet_arity(argc, 1, -1); @@ -379,6 +399,12 @@ static const JanetReg buffer_cfuns[] = { "Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. " "Returns the modified buffer.") }, + { + "buffer/trim", cfun_buffer_trim, + JDOC("(buffer/trim buffer)\n\n" + "Set the backing capacity of the buffer to the current length of the buffer. Returns the " + "modified buffer.") + }, { "buffer/push-byte", cfun_buffer_u8, JDOC("(buffer/push-byte buffer x)\n\n" diff --git a/src/core/capi.c b/src/core/capi.c index 6a99b85f..ce681b49 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -325,7 +325,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) { } Janet janet_dyn(const char *name) { - if (!janet_vm_fiber) return janet_wrap_nil(); + if (!janet_vm_fiber) { + if (!janet_vm_top_dyns) return janet_wrap_nil(); + return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name)); + } if (janet_vm_fiber->env) { return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name)); } else { @@ -334,11 +337,15 @@ Janet janet_dyn(const char *name) { } void janet_setdyn(const char *name, Janet value) { - if (!janet_vm_fiber) return; - if (!janet_vm_fiber->env) { - janet_vm_fiber->env = janet_table(1); + if (!janet_vm_fiber) { + if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10); + janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value); + } else { + if (!janet_vm_fiber->env) { + janet_vm_fiber->env = janet_table(1); + } + janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value); } - janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value); } uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) { diff --git a/src/core/inttypes.c b/src/core/inttypes.c index 73e66118..e11bcdab 100644 --- a/src/core/inttypes.c +++ b/src/core/inttypes.c @@ -206,14 +206,14 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) { // In the following code explicit casts are sometimes used to help // make it clear when int/float conversions are happening. // -static int64_t compare_double_double(double x, double y) { +static int compare_double_double(double x, double y) { return (x < y) ? -1 : ((x > y) ? 1 : 0); } -static int64_t compare_int64_double(int64_t x, double y) { +static int compare_int64_double(int64_t x, double y) { if (isnan(y)) { return 0; // clojure and python do this - } else if ((y > ((double) - MAX_INT_IN_DBL)) && (y < ((double) MAX_INT_IN_DBL))) { + } else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) { double dx = (double) x; return compare_double_double(dx, y); } else if (y > ((double) INT64_MAX)) { @@ -226,7 +226,7 @@ static int64_t compare_int64_double(int64_t x, double y) { } } -static int64_t compare_uint64_double(uint64_t x, double y) { +static int compare_uint64_double(uint64_t x, double y) { if (isnan(y)) { return 0; // clojure and python do this } else if (y < 0) { diff --git a/src/core/os.c b/src/core/os.c index 5b060b4a..6f68fafe 100644 --- a/src/core/os.c +++ b/src/core/os.c @@ -1225,6 +1225,9 @@ static Janet os_rename(int32_t argc, Janet *argv) { static Janet os_realpath(int32_t argc, Janet *argv) { janet_fixarity(argc, 1); const char *src = janet_getcstring(argv, 0); +#ifdef JANET_NO_REALPATH + janet_panic("os/realpath not enabled for this platform"); +#else #ifdef JANET_WINDOWS char *dest = _fullpath(NULL, src, _MAX_PATH); #else @@ -1234,6 +1237,7 @@ static Janet os_realpath(int32_t argc, Janet *argv) { Janet ret = janet_cstringv(dest); free(dest); return ret; +#endif } static Janet os_permission_string(int32_t argc, Janet *argv) { diff --git a/src/core/pp.c b/src/core/pp.c index 6c030b3a..59acba1b 100644 --- a/src/core/pp.c +++ b/src/core/pp.c @@ -123,9 +123,6 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p #undef POINTSIZE } -#undef HEX -#undef BUFSIZE - static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) { janet_buffer_push_u8(buffer, '"'); for (int32_t i = 0; i < len; ++i) { @@ -354,12 +351,16 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) { if (depth == 0) return 1; switch (janet_type(x)) { case JANET_NIL: - case JANET_NUMBER: case JANET_BOOLEAN: case JANET_BUFFER: case JANET_STRING: janet_description_b(S->buffer, x); break; + case JANET_NUMBER: + janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2); + int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x)); + S->buffer->count += count; + break; case JANET_SYMBOL: case JANET_KEYWORD: if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1; @@ -994,3 +995,6 @@ void janet_buffer_format( } } } + +#undef HEX +#undef BUFSIZE diff --git a/src/core/run.c b/src/core/run.c index 039d1144..f675810a 100644 --- a/src/core/run.c +++ b/src/core/run.c @@ -23,7 +23,6 @@ #ifndef JANET_AMALG #include "features.h" #include -#include "state.h" #endif /* Run a string */ @@ -56,9 +55,10 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char done = 1; } } else { + ret = janet_wrap_string(cres.error); if (cres.macrofiber) { janet_eprintf("compile error in %s: ", sourcePath); - janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error)); + janet_stacktrace(cres.macrofiber, ret); } else { janet_eprintf("compile error in %s: %s\n", sourcePath, (const char *)cres.error); @@ -68,25 +68,23 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char } } + if (done) break; + /* Dispatch based on parse state */ switch (janet_parser_status(&parser)) { case JANET_PARSE_DEAD: done = 1; break; - case JANET_PARSE_ERROR: + case JANET_PARSE_ERROR: { + const char *e = janet_parser_error(&parser); errflags |= 0x04; - janet_eprintf("parse error in %s: %s\n", - sourcePath, janet_parser_error(&parser)); + ret = janet_cstringv(e); + janet_eprintf("parse error in %s: %s\n", sourcePath, e); done = 1; break; - case JANET_PARSE_PENDING: - if (index == len) { - janet_parser_eof(&parser); - } else { - janet_parser_consume(&parser, bytes[index++]); - } - break; + } case JANET_PARSE_ROOT: + case JANET_PARSE_PENDING: if (index >= len) { janet_parser_eof(&parser); } else { diff --git a/src/core/state.h b/src/core/state.h index 79bfbb7e..1fc40909 100644 --- a/src/core/state.h +++ b/src/core/state.h @@ -34,6 +34,9 @@ typedef struct JanetScratch JanetScratch; +/* Top level dynamic bindings */ +extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns; + /* Cache the core environment */ extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env; diff --git a/src/core/thread.c b/src/core/thread.c index a6c552bd..54905135 100644 --- a/src/core/thread.c +++ b/src/core/thread.c @@ -66,9 +66,15 @@ struct JanetMailbox { JanetBuffer messages[]; }; +#define JANET_THREAD_HEAVYWEIGHT 0x1 +#define JANET_THREAD_ABSTRACTS 0x2 +#define JANET_THREAD_CFUNCTIONS 0x4 +static const char janet_thread_flags[] = "hac"; + typedef struct { JanetMailbox *original; JanetMailbox *newbox; + uint64_t flags; } JanetMailboxPair; static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL; @@ -175,7 +181,7 @@ static int thread_mark(void *p, size_t size) { return 0; } -static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) { +static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) { JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair)); if (NULL == pair) { JANET_OUT_OF_MEMORY; @@ -183,6 +189,7 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) { pair->original = original; janet_mailbox_ref(original, 1); pair->newbox = janet_mailbox_create(1, 16); + pair->flags = flags; return pair; } @@ -442,16 +449,44 @@ static int thread_worker(JanetMailboxPair *pair) { janet_init(); /* Get dictionaries for default encode/decode */ - JanetTable *encode = janet_get_core_table("make-image-dict"); + JanetTable *encode; + if (pair->flags & JANET_THREAD_HEAVYWEIGHT) { + encode = janet_get_core_table("make-image-dict"); + } else { + encode = NULL; + janet_vm_thread_decode = janet_table(0); + janet_gcroot(janet_wrap_table(janet_vm_thread_decode)); + } /* Create parent thread */ JanetThread *parent = janet_make_thread(pair->original, encode); Janet parentv = janet_wrap_abstract(parent); + /* Unmarshal the abstract registry */ + if (pair->flags & JANET_THREAD_ABSTRACTS) { + Janet reg; + int status = janet_thread_receive(®, INFINITY); + if (status) goto error; + if (!janet_checktype(reg, JANET_TABLE)) goto error; + janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry)); + janet_vm_abstract_registry = janet_unwrap_table(reg); + janet_gcroot(janet_wrap_table(janet_vm_abstract_registry)); + } + + /* Unmarshal the normal registry */ + if (pair->flags & JANET_THREAD_CFUNCTIONS) { + Janet reg; + int status = janet_thread_receive(®, INFINITY); + if (status) goto error; + if (!janet_checktype(reg, JANET_TABLE)) goto error; + janet_gcunroot(janet_wrap_table(janet_vm_registry)); + janet_vm_registry = janet_unwrap_table(reg); + janet_gcroot(janet_wrap_table(janet_vm_registry)); + } + /* Unmarshal the function */ Janet funcv; int status = janet_thread_receive(&funcv, INFINITY); - if (status) goto error; if (!janet_checktype(funcv, JANET_FUNCTION)) goto error; JanetFunction *func = janet_unwrap_function(funcv); @@ -558,22 +593,40 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) { } static Janet cfun_thread_new(int32_t argc, Janet *argv) { - janet_arity(argc, 1, 2); + janet_arity(argc, 1, 3); /* Just type checking */ janet_getfunction(argv, 0); int32_t cap = janet_optinteger(argv, argc, 1, 10); if (cap < 1 || cap > UINT16_MAX) { janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap); } - JanetTable *encode = janet_get_core_table("make-image-dict"); + uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS; + JanetTable *encode; + if (flags & JANET_THREAD_HEAVYWEIGHT) { + encode = janet_get_core_table("make-image-dict"); + } else { + encode = NULL; + } - JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox); + JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags); JanetThread *thread = janet_make_thread(pair->newbox, encode); if (janet_thread_start_child(pair)) { destroy_mailbox_pair(pair); janet_panic("could not start thread"); } + if (flags & JANET_THREAD_ABSTRACTS) { + if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) { + janet_panic("could not send abstract registry to thread"); + } + } + + if (flags & JANET_THREAD_CFUNCTIONS) { + if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) { + janet_panic("could not send registry to thread"); + } + } + /* If thread started, send the worker function. */ if (janet_thread_send(thread, argv[0], INFINITY)) { janet_panicf("could not send worker function %v to thread", argv[0]); @@ -638,10 +691,14 @@ static const JanetReg threadlib_cfuns[] = { }, { "thread/new", cfun_thread_new, - JDOC("(thread/new func &opt capacity)\n\n" + JDOC("(thread/new func &opt capacity flags)\n\n" "Start a new thread that will start immediately. " "If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. " "The capacity must be between 1 and 65535 inclusive, and defaults to 10. " + "Can optionally provide flags to the new thread - supported flags are:\n" + "\t:h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n" + "\t:a - Allow sending over registered abstract types to the new thread\n" + "\t:c - Send over cfunction information to the new thread.\n" "Returns a handle to the new thread.") }, { diff --git a/src/core/vm.c b/src/core/vm.c index 0e5bf40b..40ddf9e4 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -33,6 +33,7 @@ #include /* VM state */ +JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns; JANET_THREAD_LOCAL JanetTable *janet_vm_core_env; JANET_THREAD_LOCAL JanetTable *janet_vm_registry; JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry; @@ -929,7 +930,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { if (janet_checktype(callee, JANET_FUNCTION)) { func = janet_unwrap_function(callee); if (func->gc.flags & JANET_FUNCFLAG_TRACE) { - vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack); + vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart); } janet_stack_frame(stack)->pc = pc; if (janet_fiber_funcframe(fiber, func)) { @@ -968,7 +969,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { if (janet_checktype(callee, JANET_FUNCTION)) { func = janet_unwrap_function(callee); if (func->gc.flags & JANET_FUNCFLAG_TRACE) { - vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack); + vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart); } if (janet_fiber_funcframe_tail(fiber, func)) { janet_stack_frame(fiber->data + fiber->frame)->pc = pc; @@ -1419,6 +1420,8 @@ int janet_init(void) { janet_vm_traversal_top = NULL; /* Core env */ janet_vm_core_env = NULL; + /* Dynamic bindings */ + janet_vm_top_dyns = NULL; /* Seed RNG */ janet_rng_seed(janet_default_rng(), 0); /* Fibers */ @@ -1449,6 +1452,7 @@ void janet_deinit(void) { janet_vm_registry = NULL; janet_vm_abstract_registry = NULL; janet_vm_core_env = NULL; + janet_vm_top_dyns = NULL; free(janet_vm_traversal_base); janet_vm_fiber = NULL; janet_vm_root_fiber = NULL; diff --git a/src/include/janet.h b/src/include/janet.h index a69cc6a3..f1afc711 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1373,6 +1373,7 @@ JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other); 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); /* Fiber */ JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv); diff --git a/test/suite8.janet b/test/suite8.janet index 71f1b0ff..78bc2ed0 100644 --- a/test/suite8.janet +++ b/test/suite8.janet @@ -307,4 +307,22 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 (assert (:match peg5 "abcabcabcac") "repeat alias 2") (assert (not (:match peg5 "abcabc")) "repeat alias 3") +(defn check-jdn [x] + (assert (deep= (parse (string/format "%j" x)) x) "round trip jdn")) + +(check-jdn 0) +(check-jdn nil) +(check-jdn []) +(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001]) +(check-jdn -0.123123123123) +(check-jdn 12837192371923) +(check-jdn "a string") +(check-jdn @"a buffer") + +# Issue 428 +(var result nil) +(defn f [] (yield {:a :ok})) +(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x))) +(assert (= result :ok) "issue 428 2") + (end-suite) diff --git a/tools/patch-jpm.janet b/tools/patch-jpm.janet new file mode 100644 index 00000000..b0f812f3 --- /dev/null +++ b/tools/patch-jpm.janet @@ -0,0 +1,33 @@ +# Patch jpm to have the correct paths for the current install. +# usage: janet patch-jpm.janet output --libdir=/usr/local/lib/x64-linux/ --binpath + +(def- argpeg + (peg/compile + '(* "--" '(to "=") "=" '(any 1)))) + +(def- args (tuple/slice (dyn :args) 3)) +(def- len (length args)) +(var i :private 0) + +(def install-paths @{}) + +# Get flags +(each a args + (if-let [m (peg/match argpeg a)] + (let [[key value] m] + (put install-paths (keyword key) value)))) + +(def- replace-peg + (peg/compile + ~(% (* '(to "###START###") + (constant ,(string/format "# Inserted by tools/patch-jpm.janet\n(defn- install-paths [] %j)" install-paths)) + (thru "###END###") + '(any 1))))) + +(def source (slurp ((dyn :args) 1))) +(def newsource (0 (peg/match replace-peg source))) + +(spit ((dyn :args) 2) newsource) + +(unless (= :windows (os/which)) + (os/shell (string `chmod +x "` ((dyn :args) 2) `"`)))