Test replacing CRITICAL_SECTION with SRWLOCK.

We use rw locks anyway, and it should be faster and smaller.

.builds/openbsd.yml

@@ -1,4 +1,4 @@
-image: openbsd/7.7
+image: openbsd/7.6
 sources:
 - https://git.sr.ht/~bakpakin/janet
 packages:
@@ -10,6 +10,7 @@ tasks:
     gmake
     gmake test
     doas gmake install
+    gmake test-install
     doas gmake uninstall
 - meson_min: |
     cd janet

CHANGELOG.md

@@ -1,11 +1,7 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
-## 1.40.0 - 2025-11-15
+## Unreleased - ???
-- Add `os/posix-chroot`
-- Fix `ev/deadline` with interrupt race condition bug on Windows.
-- Improve `flycheck` by allowing functions and macros to define their own flycheck behavior via the metadata `:flycheck`.
-- Add `*flychecking*` dynamic binding to check if inside flycheck evalutation
 - Add `gcperthread` callback for abstract types. This lets threaded abstracts have a finalizer that is called per thread, as well as a global finalizer.
 - Add `JANET_DO_ERROR_*` flags to describe the return value of `janet_dobytes` and `janet_dostring`.
 

CONTRIBUTING.md

@@ -61,7 +61,7 @@ ensure a consistent code style for C.
 
 ## Janet style
 
-All janet code in the project should be formatted similar to the code in src/boot/boot.janet.
+All janet code in the project should be formatted similar to the code in core.janet.
 The auto formatting from janet.vim will work well.
 
 ## Typo Fixing and One-Line changes

Makefile

@@ -261,7 +261,6 @@ $(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
 # Testing assumes HOSTCC=CC
 
 TEST_SCRIPTS=$(wildcard test/suite*.janet)
-EXAMPLE_SCRIPTS=$(wildcard examples/*.janet)
 
 repl: $(JANET_TARGET)
 	$(RUN) ./$(JANET_TARGET)
@@ -269,26 +268,21 @@ repl: $(JANET_TARGET)
 debug: $(JANET_TARGET)
 	$(DEBUGGER) ./$(JANET_TARGET)
 
-VALGRIND_COMMAND=$(RUN) valgrind --leak-check=full --quiet
+VALGRIND_COMMAND=valgrind --leak-check=full --quiet
-CALLGRIND_COMMAND=$(RUN) valgrind --tool=callgrind
 
 valgrind: $(JANET_TARGET)
 	$(VALGRIND_COMMAND) ./$(JANET_TARGET)
 
-test: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
+test: $(JANET_TARGET) $(TEST_PROGRAMS)
 	for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
 	for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
 
-valtest: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
+valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
 	for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
-	for f in examples/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) -k "$$f"; done
+	for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
 
 callgrind: $(JANET_TARGET)
-	$(CALLGRIND_COMMAND) ./$(JANET_TARGET)
+	for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
-
-calltest: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
-	for f in test/suite*.janet; do $(CALLGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
-	for f in examples/*.janet; do $(CALLGRIND_COMMAND) ./$(JANET_TARGET) -k "$$f"; done
 
 ########################
 ##### Distribution #####
@@ -419,6 +413,9 @@ clean:
 	-rm -rf build vgcore.* callgrind.*
 	-rm -rf test/install/build test/install/modpath
 
+test-install:
+	echo "JPM has been removed from default install."
+
 help:
 	@echo
 	@echo 'Janet: A Dynamic Language & Bytecode VM'
@@ -430,8 +427,7 @@ help:
 	@echo '   make test       Test a built Janet'
 	@echo '   make valgrind   Assess Janet with Valgrind'
 	@echo '   make callgrind  Assess Janet with Valgrind, using Callgrind'
-	@echo '   make valtest    Run the test suite and examples with Valgrind to check for memory leaks'
+	@echo '   make valtest    Run the test suite with Valgrind to check for memory leaks'
-	@echo '   make calltest   Run the test suite and examples with Callgrind'
 	@echo '   make dist       Create a distribution tarball'
 	@echo '   make docs       Generate documentation'
 	@echo '   make debug      Run janet with GDB or LLDB'
@@ -441,9 +437,6 @@ help:
 	@echo "   make format     Format Janet's own source files"
 	@echo '   make grammar    Generate a TextMate language grammar'
 	@echo
-	@echo '   make install-jpm-git   Install jpm into the current filesystem'
-	@echo '   make install-spork-git Install spork into the current filesystem'
-	@echo
 
-.PHONY: clean install install-jpm-git install-spork-git repl debug valgrind test \
+.PHONY: clean install repl debug valgrind test \
-	valtest callgrind callgrind-test dist uninstall docs grammar format help compile-commands
+	valtest dist uninstall docs grammar format help compile-commands

examples/sample-bad-bundle1/info.jdn

@@ -1,3 +0,0 @@
-@{
-  :name "sample-bad-bundle1"
-}

examples/sample-bad-bundle2/info.jdn

@@ -1,3 +0,0 @@
-@{
-  :name "sample-bad-bundle2"
-}

src/boot/boot.janet

@@ -7,7 +7,7 @@
 ###
 ###
 
-(def defn :macro :flycheck
+(def defn :macro
   ```
   (defn name & more)
 
@@ -43,7 +43,7 @@
     # Build return value
     ~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
 
-(defn defmacro :macro :flycheck
+(defn defmacro :macro
   "Define a macro."
   [name & more]
   (setdyn name @{}) # override old macro definitions in the case of a recursive macro
@@ -57,12 +57,12 @@
   [f & args]
   (f ;args))
 
-(defmacro defmacro- :flycheck
+(defmacro defmacro-
   "Define a private macro that will not be exported."
   [name & more]
   (apply defn name :macro :private more))
 
-(defmacro defn- :flycheck
+(defmacro defn-
   "Define a private function that will not be exported."
   [name & more]
   (apply defn name :private more))
@@ -144,7 +144,7 @@
 (defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
 (defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
 
-(defmacro assert :flycheck # should top level assert flycheck?
+(defmacro assert
   "Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
   [x &opt err]
   (def v (gensym))
@@ -154,7 +154,7 @@
        ,v
        (,error ,(if err err (string/format "assert failure in %j" x))))))
 
-(defmacro defdyn :flycheck
+(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
@@ -171,9 +171,6 @@
 (defdyn *macro-form*
   "Inside a macro, is bound to the source form that invoked the macro")
 
-(defdyn *flychecking*
-  "Check if the current form is being evaluated inside `flycheck`. Will be `true` while flychecking.")
-
 (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.")
 
@@ -348,15 +345,12 @@
   [body catch]
   (assert (and (not (empty? catch)) (indexed? (catch 0))) "the first element of `catch` must be a tuple or array")
   (let [[err fib] (catch 0)
-        r (gensym)
+        r (or err (gensym))
-        f (gensym)]
+        f (or fib (gensym))]
     ~(let [,f (,fiber/new (fn :try [] ,body) :ie)
            ,r (,resume ,f)]
        (if (,= (,fiber/status ,f) :error)
-         (do
+         (do ,;(tuple/slice catch 1))
-           ,(if err ~(def ,err ,r))
-           ,(if fib ~(def ,fib ,f))
-           ,;(tuple/slice catch 1))
          ,r))))
 
 (defmacro with-syms
@@ -1806,8 +1800,8 @@
   (flatten-into @[] xs))
 
 (defn kvs
-  ``Takes a table or struct and returns a new array of key value pairs
+  ``Takes a table or struct and returns and array of key value pairs
-  like `@[k v k v ...]`.``
+  like `@[k v k v ...]`. Returns a new array.``
   [dict]
   (def ret @[])
   (loop [k :keys dict] (array/push ret k (in dict k)))
@@ -2360,7 +2354,7 @@
 
 (set macexvar macex)
 
-(defmacro varfn :flycheck
+(defmacro varfn
   ``Create a function that can be rebound. `varfn` has the same signature
   as `defn`, but defines functions in the environment as vars. If a var `name`
   already exists in the environment, it is rebound to the new function. Returns
@@ -3951,7 +3945,7 @@
   [& forms]
   (def state (gensym))
   (def loaded (gensym))
-  ~((fn :delay []
+  ~((fn []
       (var ,state nil)
       (var ,loaded nil)
       (fn []
@@ -3983,7 +3977,7 @@
               :lazy lazy
               :map-symbols map-symbols}))
 
-  (defmacro ffi/defbind-alias :flycheck
+  (defmacro ffi/defbind-alias
     "Generate bindings for native functions in a convenient manner.
      Similar to defbind but allows for the janet function name to be
      different than the FFI function."
@@ -3994,8 +3988,6 @@
     (def formal-args (map 0 arg-pairs))
     (def type-args (map 1 arg-pairs))
     (def computed-type-args (eval ~[,;type-args]))
-    (if (dyn *flychecking*)
-      (break ~(defn ,alias ,;meta [,;formal-args] nil)))
     (def {:native lib
           :lazy lazy
           :native-lazy llib
@@ -4011,7 +4003,7 @@
       ~(defn ,alias ,;meta [,;formal-args]
          (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
 
-  (defmacro ffi/defbind :flycheck
+  (defmacro ffi/defbind
     "Generate bindings for native functions in a convenient manner."
     [name ret-type & body]
     ~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
@@ -4022,51 +4014,6 @@
 ###
 ###
 
-(def- flycheck-specials @{})
-
-(defn- flycheck-evaluator
-  ``
-  An evaluator function that is passed to `run-context` that lints
-  (flychecks) code for `flycheck`.  This means code will be parsed,
-  compiled, and have macros expanded, but the code will not be
-  evaluated.
-  ``
-  [thunk source env where]
-  (when (and (tuple? source) (= (tuple/type source) :parens))
-    (def head (source 0))
-    (def entry (get env head {}))
-    (def fc (get flycheck-specials head (get entry :flycheck)))
-    (cond
-      # Sometimes safe form
-      (function? fc)
-      (fc thunk source env where)
-      # Always safe form
-      fc
-      (thunk))))
-
-(defn flycheck
-  ```
-  Check a file for errors without running the file. Found errors
-  will be printed to stderr in the usual format. Top level functions
-  and macros that have the metadata `:flycheck` will also be evaluated
-  during flychecking. For full control, the `:flycheck` metadata can
-  also be a function that takes 4 arguments - `thunk`, `source`, `env`,
-  and `where`, the same as the `:evaluator` argument to `run-context`.
-  Other arguments to `flycheck` are the same as `dofile`. Returns nil.
-  ```
-  [path &keys kwargs]
-  (def mc @{})
-  (def new-env (make-env (get kwargs :env)))
-  (put new-env *flychecking* true)
-  (put new-env *module-cache* @{})
-  (put new-env *module-loading* @{})
-  (put new-env *module-make-env* (fn :make-flycheck-env [&] (make-env new-env)))
-  (try
-    (dofile path :evaluator flycheck-evaluator ;(kvs kwargs) :env new-env)
-    ([e f]
-      (debug/stacktrace f e "")))
-  nil)
-
 (defn- no-side-effects
   `Check if form may have side effects. If returns true, then the src
   must not have side effects, such as calling a C function.`
@@ -4082,29 +4029,59 @@
          (all no-side-effects (values src)))
     true))
 
-(defn- is-safe-def [thunk source env where]
+(defn- is-safe-def [x] (no-side-effects (last x)))
-  (if (no-side-effects (last source))
-    (thunk)))
 
-(defn- flycheck-importer
+(def- safe-forms {'defn true 'varfn true 'defn- true 'defmacro true 'defmacro- true
+                  'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
+                  'defglobal is-safe-def 'varglobal is-safe-def 'defdyn true})
+
+(def- importers {'import true 'import* true 'dofile true 'require true})
+(defn- use-2 [evaluator args]
+  (each a args (import* (string a) :prefix "" :evaluator evaluator)))
+
+(defn- flycheck-evaluator
+  ``An evaluator function that is passed to `run-context` that lints (flychecks) code.
+  This means code will parsed and compiled, macros executed, but the code will not be run.
+  Used by `flycheck`.``
   [thunk source env where]
-  (let [[l c] (tuple/sourcemap source)
+  (when (tuple? source)
-        newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)]
+    (def head (source 0))
-    ((compile newtup env where))))
+    (def safe-check
+      (or
+        (safe-forms head)
+        (if (symbol? head)
+          (if (string/has-prefix? "define-" head) is-safe-def))))
+    (cond
+      # Sometimes safe form
+      (function? safe-check)
+      (if (safe-check source) (thunk))
+      # Always safe form
+      safe-check
+      (thunk)
+      # Use
+      (= 'use head)
+      (use-2 flycheck-evaluator (tuple/slice source 1))
+      # Import-like form
+      (importers head)
+      (let [[l c] (tuple/sourcemap source)
+            newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)]
+        ((compile newtup env where))))))
 
-(defn- flycheck-use
+(defn flycheck
-  [thunk source env where]
+  ``Check a file for errors without running the file. Found errors will be printed to stderr
-  (each a (drop 1 source) (import* (string a) :prefix "" :evaluator flycheck-evaluator)))
+  in the usual format. Macros will still be executed, however, so
-
+  arbitrary execution is possible. Other arguments are the same as `dofile`. `path` can also be
-# Add metadata to defs and import macros for flychecking
+  a file value such as stdin. Returns nil.``
-(each sym ['def 'var]
+  [path &keys kwargs]
-  (put flycheck-specials sym is-safe-def))
+  (def old-modcache (table/clone module/cache))
-(each sym ['def- 'var- 'defglobal 'varglobal]
+  (table/clear module/cache)
-  (put (dyn sym) :flycheck is-safe-def))
+  (try
-(each sym ['import 'import* 'dofile 'require]
+    (dofile path :evaluator flycheck-evaluator ;(kvs kwargs))
-  (put (dyn sym) :flycheck flycheck-importer))
+    ([e f]
-(each sym ['use]
+      (debug/stacktrace f e "")))
-  (put (dyn sym) :flycheck flycheck-use))
+  (table/clear module/cache)
+  (merge-into module/cache old-modcache)
+  nil)
 
 ###
 ###
@@ -4197,7 +4174,7 @@
     (spit manifest-name b))
 
   (defn bundle/manifest
-    "Get the manifest for a given installed bundle."
+    "Get the manifest for a give installed bundle"
     [bundle-name]
     (def name (get-manifest-filename bundle-name))
     (assertf (fexists name) "no bundle %v found" bundle-name)
@@ -4222,9 +4199,7 @@
       (put new-env *syspath* fixed-syspath)
       (with-env new-env
         (put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right
-        (try
+        (require (string "@syspath/bundle/" bundle-name)))))
-          (require (string "@syspath/bundle/" bundle-name))
-          ([_] (error "bundle must contain bundle.janet or bundle/init.janet"))))))
 
   (defn- do-hook
     [module bundle-name hook & args]
@@ -4261,9 +4236,7 @@
     nil)
 
   (defn bundle/uninstall
-    ``Remove a bundle from the current syspath. There is 1 hook called during
+    "Remove a bundle from the current syspath"
-    uninstallation (uninstall). A user can register a hook by defining a
-    function with the same name in the bundle script.``
     [bundle-name]
     (def breakage @{})
     (each b (bundle/list)
@@ -4299,8 +4272,8 @@
     order)
 
   (defn bundle/prune
-    ``Remove all orphaned bundles from the current syspath. An orphaned bundle is a
+    "Remove all orphaned bundles from the syspath. An orphaned bundle is a bundle that is
-    bundle that is marked for :auto-remove and is not depended on by any other bundle.``
+     marked for :auto-remove and is not depended on by any other bundle."
     []
     (def topo (bundle/topolist))
     (def rtopo (reverse topo))
@@ -4329,44 +4302,33 @@
     (not (not (os/stat (bundle-dir bundle-name) :mode))))
 
   (defn bundle/install
-    ``Install a bundle from the local filesystem. The name of the bundle is
+    "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`."
-    the value mapped to :name in either `config` or the info file. There are
-    5 hooks called during installation (postdeps, clean, build, install and
-    check). A user can register a hook by defining a function with the same name
-    in the bundle script.``
     [path &keys config]
     (def path (bundle-rpath path))
     (def s (sep))
     # Detect bundle name
     (def infofile-src1 (string path s "bundle" s "info.jdn"))
     (def infofile-src2 (string path s "info.jdn"))
-    (def infofile-src (cond
+    (def infofile-src (cond (fexists infofile-src1) infofile-src1
-                        (fexists infofile-src1) infofile-src1
+                            (fexists infofile-src2) infofile-src2))
-                        (fexists infofile-src2) infofile-src2))
     (def info (-?> infofile-src slurp parse))
     (def bundle-name (get config :name (get info :name)))
-    (assertf bundle-name
+    (assertf bundle-name "unable to infer bundle name for %v, use :name argument" path)
-             "unable to infer bundle name for %v, use :name argument or add :name to info file" path)
     (assertf (not (string/check-set "\\/" bundle-name))
              "bundle name %v cannot contain path separators" bundle-name)
     (assert (next bundle-name) "cannot use empty bundle-name")
     (assertf (not (fexists (get-manifest-filename bundle-name)))
              "bundle %v is already installed" bundle-name)
-    # Check bscript
-    (def bscript-src1 (string path s "bundle" s "init.janet"))
-    (def bscript-src2 (string path s "bundle.janet"))
-    (def bscript-src (cond
-                        (fexists bscript-src1) bscript-src1
-                        (fexists bscript-src2) bscript-src2))
     # Setup installed paths
     (prime-bundle-paths)
     (os/mkdir (bundle-dir bundle-name))
-    # Copy aliased infofile
+    # Copy infofile
-    (when (fexists infofile-src2)
+    (def infofile-dest (bundle-file bundle-name "info.jdn"))
-      (copyfile infofile-src2 (bundle-file bundle-name "info.jdn")))
+    (when infofile-src (copyfile infofile-src infofile-dest))
-    # Copy aliased bscript
+    # Copy aliased initfile
-    (when (fexists bscript-src2)
+    (def initfile-alias (string path s "bundle.janet"))
-      (copyfile bscript-src2 (bundle-file bundle-name "init.janet")))
+    (def initfile-dest (bundle-file bundle-name "init.janet"))
+    (when (fexists initfile-alias) (copyfile initfile-alias initfile-dest))
     # Copy some files into the new location unconditionally
     (def implicit-sources (string path s "bundle"))
     (when (= :directory (os/stat implicit-sources :mode))
@@ -4375,21 +4337,21 @@
     (merge-into man config)
     (sync-manifest man)
     (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name))
-      (when info
+      (when (os/stat infofile-dest :mode)
+        (def info (-> infofile-dest slurp parse))
         (def deps (seq [d :in (get info :dependencies @[])]
-                    (string (if (dictionary? d) (get d :name) d))))
+                   (string (if (dictionary? d) (get d :name) d))))
         (def missing (filter (complement bundle/installed?) deps))
         (when (next missing)
           (error (string "missing dependencies " (string/join missing ", "))))
         (put man :dependencies deps)
         (put man :info info))
-      (def module (get-bundle-module bundle-name))
       (def clean (get config :clean))
       (def check (get config :check))
+      (def module (get-bundle-module bundle-name))
       (def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k)))
       (put man :hooks all-hooks)
-      (do-hook module bundle-name :dependencies man) # deprecated, use :postdeps
+      (do-hook module bundle-name :dependencies man)
-      (do-hook module bundle-name :postdeps man)
       (when clean
         (do-hook module bundle-name :clean man))
       (do-hook module bundle-name :build man)
@@ -4399,21 +4361,15 @@
       (when check
         (do-hook module bundle-name :check man)))
     (print "installed " bundle-name)
-    (when (or (get man :has-exe)
+    (when (get man :has-bin-script)
-              # remove eventually
-              (get man :has-bin-script))
       (def binpath (string (dyn *syspath*) s "bin"))
-      (eprintf "executable files have been installed to %s" binpath))
+      (eprintf "executable scripts have been installed to %s" binpath))
-    (when (get man :has-man)
-      (def manpath (string (dyn *syspath*) s "man"))
-      (eprintf "man pages have been installed to %s" manpath))
     bundle-name)
 
   (defn- bundle/pack
-    ``Take an installed bundle and create a bundle source directory that can be
+    "Take an installed bundle and create a bundle source directory that can be used to
-    used to reinstall the bundle on a compatible system. This is used to create
+     reinstall the bundle on a compatible system. This is used to create backups for installed
-    backups for installed bundles without rebuilding, or make a prebuilt bundle
+     bundles without rebuilding, or make a prebuilt bundle for other systems."
-    for other systems.``
     [bundle-name dest-dir &opt is-backup]
     (var i 0)
     (def man (bundle/manifest bundle-name))
@@ -4443,9 +4399,9 @@
     dest-dir)
 
   (defn bundle/replace
-    ``Reinstall an existing bundle from a new directory. Similar to
+    "Reinstall an existing bundle from a new directory. Similar to bundle/reinstall,
-    bundle/reinstall, but installs the replacement bundle from any directory.
+     but installs the replacement bundle from any directory. This is necesarry to replace a package without
-    This is necessary to replace a package without breaking any dependencies.``
+     breaking any dependencies."
     [bundle-name path &keys new-config]
     (def manifest (bundle/manifest bundle-name))
     (def config (get manifest :config @{}))
@@ -4472,7 +4428,7 @@
     bundle-name)
 
   (defn bundle/add-directory
-    "Add a directory during an install relative to `(dyn *syspath*)`."
+    "Add a directory during the install process relative to `(dyn *syspath*)`"
     [manifest dest &opt chmod-mode]
     (def files (get-files manifest))
     (def s (sep))
@@ -4500,7 +4456,7 @@
     ret)
 
   (defn bundle/add-file
-    "Add a file during an install relative to `(dyn *syspath*)`."
+    "Add files during an install relative to `(dyn *syspath*)`"
     [manifest src &opt dest chmod-mode]
     (default dest src)
     (def files (get-files manifest))
@@ -4517,9 +4473,9 @@
     absdest)
 
   (defn bundle/add
-    ``Add a file or directory during an install relative to `(dyn *syspath*)`.
+    "Add files and directories during a bundle install relative to `(dyn *syspath*)`.
-    Added files and directories will be recorded in the bundle manifest such
+     Added files and directories will be recorded in the bundle manifest such that they are properly tracked
-    that they are properly tracked and removed during an upgrade or uninstall.``
+     and removed during an upgrade or uninstall."
     [manifest src &opt dest chmod-mode]
     (default dest src)
     (def s (sep))
@@ -4534,31 +4490,20 @@
       (errorf "bad path %s - file is a %s" src mode)))
 
   (defn bundle/add-bin
-    ``Add a file to the "bin" subdirectory of the current syspath. By default,
+    ``
-    files will be set to be executable.``
+    Shorthand for adding scripts during an install. Scripts will be installed to
-    [manifest src &opt filename chmod-mode]
+    `(string (dyn *syspath*) "/bin")` by default and will be set to be executable.
+    ``
+    [manifest src &opt dest chmod-mode]
     (def s (sep))
-    (default filename (last (string/split s src)))
+    (default dest (last (string/split s src)))
     (default chmod-mode 8r755)
     (os/mkdir (string (dyn *syspath*) s "bin"))
-    (put manifest :has-exe true)
+    (put manifest :has-bin-script true)
-    (put manifest :has-bin-script true) # remove eventually
+    (bundle/add-file manifest src (string "bin" s dest) chmod-mode))
-    (bundle/add-file manifest src (string "bin" s filename) chmod-mode))
-
-  (defn bundle/add-manpage
-    ``Add a file to the man subdirectory of the current syspath. Files are
-    copied inside a directory `mansec`. By default, `mansec` is "man1".``
-    [manifest src &opt mansec]
-    (def s (sep))
-    (default mansec "man1")
-    (def filename (last (string/split s src)))
-    (os/mkdir (string (dyn *syspath*) s "man"))
-    (os/mkdir (string (dyn *syspath*) s "man" s mansec))
-    (put manifest :has-man true)
-    (bundle/add-file manifest src (string "man" s mansec s filename)))
 
   (defn bundle/update-all
-    "Reinstall all bundles."
+    "Reinstall all bundles"
     [&keys configs]
     (each bundle (bundle/topolist)
       (bundle/reinstall bundle ;(kvs configs)))))
@@ -4570,10 +4515,7 @@
 ###
 
 # conditional compilation for reduced os
-(def- getenv-raw (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
+(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
-(defn- getenv-alias [env-var &opt dflt]
-  (def x (getenv-raw env-var dflt))
-  (if (= x "") nil x)) # empty string is coerced to nil
 
 (defn- run-main
   [env subargs arg]
@@ -4948,15 +4890,14 @@
      "src/core/wrap.c"])
 
   # Print janet.c to stdout
-  (def image-only (has-value? boot/args "image-only"))
+  (print "/* Amalgamated build - DO NOT EDIT */")
-  (print "/* " (if image-only "Image-only" "Amalgamated") " build - DO NOT EDIT */")
   (print "/* Generated from janet version " janet/version "-" janet/build " */")
   (print "#define JANET_BUILD \"" janet/build "\"")
   (print ```#define JANET_AMALG```)
 
   (defn do-one-file
     [fname]
-    (unless image-only
+    (unless (has-value? boot/args "image-only")
       (print "\n/* " fname " */")
       (print "#line 0 \"" fname "\"\n")
       (def source (slurp fname))

src/core/abstract.c

@@ -88,7 +88,7 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
 #ifdef JANET_WINDOWS
 
 size_t janet_os_mutex_size(void) {
-    return sizeof(CRITICAL_SECTION);
+    return sizeof(SRWLOCK);
 }
 
 size_t janet_os_rwlock_size(void) {
@@ -96,20 +96,20 @@ size_t janet_os_rwlock_size(void) {
 }
 
 void janet_os_mutex_init(JanetOSMutex *mutex) {
-    InitializeCriticalSection((CRITICAL_SECTION *) mutex);
+    InitializeSRWLock((PSRWLOCK) mutex);
 }
 
 void janet_os_mutex_deinit(JanetOSMutex *mutex) {
-    DeleteCriticalSection((CRITICAL_SECTION *) mutex);
+    /* no op? */
+    (void) mutex;
 }
 
 void janet_os_mutex_lock(JanetOSMutex *mutex) {
-    EnterCriticalSection((CRITICAL_SECTION *) mutex);
+    AcquireSRWLockExclusive((PSRWLOCK) mutex);
 }
 
 void janet_os_mutex_unlock(JanetOSMutex *mutex) {
-    /* error handling? May want to keep counter */
+    ReleaseSRWLockExclusive((PSRWLOCK) mutex);
-    LeaveCriticalSection((CRITICAL_SECTION *) mutex);
 }
 
 void janet_os_rwlock_init(JanetOSRWLock *rwlock) {

src/core/corelib.c

@@ -746,7 +746,6 @@ typedef struct SandboxOption {
 
 static const SandboxOption sandbox_options[] = {
     {"all", JANET_SANDBOX_ALL},
-    {"chroot", JANET_SANDBOX_CHROOT},
     {"env", JANET_SANDBOX_ENV},
     {"ffi", JANET_SANDBOX_FFI},
     {"ffi-define", JANET_SANDBOX_FFI_DEFINE},
@@ -772,7 +771,6 @@ JANET_CORE_FN(janet_core_sandbox,
               "Disable feature sets to prevent the interpreter from using certain system resources. "
               "Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
               "* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
-              "* :chroot - disallow calling `os/posix-chroot`\n"
               "* :env - disallow reading and write env variables\n"
               "* :ffi - disallow FFI (recommended if disabling anything else)\n"
               "* :ffi-define - disallow loading new FFI modules and binding new functions\n"

src/core/ev.c

@@ -83,7 +83,7 @@ struct JanetChannel {
     int closed;
     int is_threaded;
 #ifdef JANET_WINDOWS
-    CRITICAL_SECTION lock;
+    SRWLOCK lock;
 #else
     pthread_mutex_t lock;
 #endif
@@ -117,9 +117,6 @@ typedef struct {
     double sec;
     JanetVM *vm;
     JanetFiber *fiber;
-#ifdef JANET_WINDOWS
-    HANDLE cancel_event;
-#endif
 } JanetThreadedTimeout;
 
 #define JANET_MAX_Q_CAPACITY 0x7FFFFFF
@@ -607,7 +604,12 @@ void janet_ev_init_common(void) {
 #endif
 }
 
-#if JANET_ANDROID
+#ifdef JANET_WINDOWS
+static VOID CALLBACK janet_timeout_stop(ULONG_PTR ptr) {
+    UNREFERENCED_PARAMETER(ptr);
+    ExitThread(0);
+}
+#elif JANET_ANDROID
 static void janet_timeout_stop(int sig_num) {
     if (sig_num == SIGUSR1) {
         pthread_exit(0);
@@ -618,14 +620,10 @@ static void janet_timeout_stop(int sig_num) {
 static void handle_timeout_worker(JanetTimeout to, int cancel) {
     if (!to.has_worker) return;
 #ifdef JANET_WINDOWS
-    if (cancel && to.worker_event) {
+    (void) cancel;
-        SetEvent(to.worker_event);
+    QueueUserAPC(janet_timeout_stop, to.worker, 0);
-    }
     WaitForSingleObject(to.worker, INFINITE);
     CloseHandle(to.worker);
-    if (to.worker_event) {
-        CloseHandle(to.worker_event);
-    }
 #else
 #ifdef JANET_ANDROID
     if (cancel) janet_assert(!pthread_kill(to.worker, SIGUSR1), "pthread_kill");
@@ -695,20 +693,10 @@ static void janet_timeout_cb(JanetEVGenericMessage msg) {
 static DWORD WINAPI janet_timeout_body(LPVOID ptr) {
     JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr;
     janet_free(ptr);
-    JanetTimestamp wait_begin = ts_now();
+    SleepEx((DWORD)(tto.sec * 1000), TRUE);
-    DWORD duration = (DWORD)round(tto.sec * 1000);
+    janet_interpreter_interrupt(tto.vm);
-    DWORD res = WAIT_TIMEOUT;
+    JanetEVGenericMessage msg = {0};
-    JanetTimestamp wait_end = ts_now();
+    janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
-    for (DWORD i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) {
-        res = WaitForSingleObject(tto.cancel_event, (duration + i));
-        wait_end = ts_now();
-    }
-    /* only send interrupt message if result is WAIT_TIMEOUT */
-    if (res == WAIT_TIMEOUT) {
-        janet_interpreter_interrupt(tto.vm);
-        JanetEVGenericMessage msg = {0};
-        janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
-    }
     return 0;
 }
 #else
@@ -3282,13 +3270,7 @@ JANET_CORE_FN(cfun_ev_deadline,
         tto->vm = &janet_vm;
         tto->fiber = tocheck;
 #ifdef JANET_WINDOWS
-        HANDLE cancel_event = CreateEvent(NULL, TRUE, FALSE, NULL);
+        HANDLE worker = CreateThread(NULL, 0, janet_timeout_body, tto, 0, NULL);
-        if (NULL == cancel_event) {
-            janet_free(tto);
-            janet_panic("failed to create cancel event");
-        }
-        tto->cancel_event = cancel_event;
-        HANDLE worker = CreateThread(NULL, 0, janet_timeout_body, tto, CREATE_SUSPENDED, NULL);
         if (NULL == worker) {
             janet_free(tto);
             janet_panic("failed to create thread");
@@ -3303,10 +3285,6 @@ JANET_CORE_FN(cfun_ev_deadline,
 #endif
         to.has_worker = 1;
         to.worker = worker;
-#ifdef JANET_WINDOWS
-        to.worker_event = cancel_event;
-        ResumeThread(worker);
-#endif
     } else {
         to.has_worker = 0;
     }

src/core/os.c

@@ -67,7 +67,6 @@
 #include <crt_externs.h>
 #define environ (*_NSGetEnviron())
 #include <AvailabilityMacros.h>
-int chroot(const char *dirname);
 #else
 extern char **environ;
 #endif
@@ -1542,28 +1541,6 @@ JANET_CORE_FN(os_posix_fork,
 #endif
 }
 
-JANET_CORE_FN(os_posix_chroot,
-              "(os/posix-chroot dirname)",
-              "Call `chroot` to change the root directory to `dirname`. "
-              "Not supported on all systems (POSIX only).") {
-    janet_sandbox_assert(JANET_SANDBOX_CHROOT);
-    janet_fixarity(argc, 1);
-#ifdef JANET_WINDOWS
-    (void) argv;
-    janet_panic("not supported on Windows");
-#else
-    const char *root = janet_getcstring(argv, 0);
-    int result;
-    do {
-        result = chroot(root);
-    } while (result == -1 && errno == EINTR);
-    if (result == -1) {
-        janet_panic(janet_strerror(errno));
-    }
-    return janet_wrap_nil();
-#endif
-}
-
 #ifdef JANET_EV
 /* Runs in a separate thread */
 static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
@@ -2872,7 +2849,6 @@ void janet_lib_os(JanetTable *env) {
         JANET_CORE_REG("os/touch", os_touch),
         JANET_CORE_REG("os/realpath", os_realpath),
         JANET_CORE_REG("os/cd", os_cd),
-        JANET_CORE_REG("os/posix-chroot", os_posix_chroot),
 #ifndef JANET_NO_UMASK
         JANET_CORE_REG("os/umask", os_umask),
 #endif

src/core/run.c

@@ -60,6 +60,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                     done = 1;
                 }
             } else {
+                ret = janet_wrap_string(cres.error);
                 int32_t line = (int32_t) parser->line;
                 int32_t col = (int32_t) parser->column;
                 if ((cres.error_mapping.line > 0) &&
@@ -67,17 +68,13 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                     line = cres.error_mapping.line;
                     col = cres.error_mapping.column;
                 }
-                JanetString ctx = janet_formatc("%s:%d:%d: compile error",
-                                                sourcePath, line, col);
-                JanetString errstr = janet_formatc("%s: %s",
-                                                   (const char *)ctx,
-                                                   (const char *)cres.error);
-                ret = janet_wrap_string(errstr);
                 if (cres.macrofiber) {
-                    janet_eprintf("%s", (const char *)ctx);
+                    janet_eprintf("%s:%d:%d: compile error", sourcePath,
+                                  line, col);
                     janet_stacktrace_ext(cres.macrofiber, ret, "");
                 } else {
-                    janet_eprintf("%s\n", (const char *)errstr);
+                    janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
+                                  line, col, (const char *)cres.error);
                 }
                 errflags |= JANET_DO_ERROR_COMPILE;
                 done = 1;
@@ -92,14 +89,12 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                 done = 1;
                 break;
             case JANET_PARSE_ERROR: {
+                const char *e = janet_parser_error(parser);
                 errflags |= JANET_DO_ERROR_PARSE;
+                ret = janet_cstringv(e);
                 int32_t line = (int32_t) parser->line;
                 int32_t col = (int32_t) parser->column;
-                JanetString errstr = janet_formatc("%s:%d:%d: parse error: %s",
+                janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
-                                                   sourcePath, line, col,
-                                                   janet_parser_error(parser));
-                ret = janet_wrap_string(errstr);
-                janet_eprintf("%s\n", (const char *)errstr);
                 done = 1;
                 break;
             }
@@ -127,8 +122,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
         janet_loop();
         if (fiber) {
             janet_gcunroot(janet_wrap_fiber(fiber));
-            if (!errflags)
+            ret = fiber->last_value;
-                ret = fiber->last_value;
         }
     }
 #endif

src/core/state.h

@@ -68,7 +68,6 @@ typedef struct {
     int has_worker;
 #ifdef JANET_WINDOWS
     HANDLE worker;
-    HANDLE worker_event;
 #else
     pthread_t worker;
 #endif

src/include/janet.h

@@ -147,7 +147,6 @@ extern "C" {
     || defined(__s390x__) /* S390 64-bit */ \
     || defined(__s390__)  /* S390 32-bit */ \
     || defined(__ARMEB__) /* ARM big endian */ \
-    || defined(__AARCH64EB__) /* ARM64 big endian */ \
     || ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \
         && defined(__BIG_ENDIAN))
 #define JANET_BIG_ENDIAN 1
@@ -1900,7 +1899,6 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
 #define JANET_SANDBOX_FFI_USE 2048
 #define JANET_SANDBOX_FFI_JIT 4096
 #define JANET_SANDBOX_SIGNAL 8192
-#define JANET_SANDBOX_CHROOT 16384
 #define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
 #define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
 #define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)

test/helper.janet

@@ -50,11 +50,6 @@
   (def errsym (keyword (gensym)))
   ~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
 
-(defmacro assert-error-value
-  [msg errval & forms]
-  (def e (gensym))
-  ~(assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
-
 (defn check-compile-error
   [form]
   (def result (compile form))

test/suite-boot.janet

@@ -1023,11 +1023,4 @@
 (assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"}
                    @{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys")
 
-# different try overloads
-(assert (= (try (error :error) ([] :caught)) :caught))
-(assert (= (try (error :error) ([e] e)) :error))
-(assert (= (try (error :error) ([e fib] [e (fiber? fib)])) [:error true]))
-# regression test for #1659
-(assert (= (try (error :error) ([_ _] :caught)) :caught))
-
 (end-suite)

test/suite-bundle.janet

@@ -117,17 +117,8 @@
 (assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
 (assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8")
 
-# Try installing a bundle that is missing bundle script
-(assert-error-value "bundle missing bundle script"
-                    "bundle must contain bundle.janet or bundle/init.janet"
-                    (bundle/install "./examples/sample-bad-bundle1"))
-(assert (= 0 (length (bundle/list))) "check failure 0")
-(assert (= 0 (length (bundle/topolist))) "check failure 1")
-
 # Try installing a bundle that fails check
-(assert-error-value "bundle check hook fails"
+(assert-error "bad test" (bundle/install "./examples/sample-bad-bundle" :check true))
-                    "Check failed!"
-                    (bundle/install "./examples/sample-bad-bundle2" :check true))
 (assert (= 0 (length (bundle/list))) "check failure 0")
 (assert (= 0 (length (bundle/topolist))) "check failure 1")