1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-22 02:04:49 +00:00

Compare commits

..

1 Commits

Author SHA1 Message Date
Calvin Rose
c5b3da1ffe Inter 2025-05-16 18:35:33 -05:00
36 changed files with 390 additions and 830 deletions

View File

@@ -1,4 +1,4 @@
image: openbsd/7.7 image: openbsd/7.4
sources: sources:
- https://git.sr.ht/~bakpakin/janet - https://git.sr.ht/~bakpakin/janet
packages: packages:
@@ -10,17 +10,13 @@ tasks:
gmake gmake
gmake test gmake test
doas gmake install doas gmake install
gmake test-install
doas gmake uninstall doas gmake uninstall
- meson_min: | - meson_min: |
cd janet cd janet
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
cd build_meson_min cd build_meson_min
ninja ninja
- meson_reduced: |
cd janet
meson setup build_meson_reduced --buildtype=release -Dreduced_os=true
cd build_meson_reduced
ninja
- meson_prf: | - meson_prf: |
cd janet cd janet
meson setup build_meson_prf --buildtype=release -Dprf=true meson setup build_meson_prf --buildtype=release -Dprf=true

View File

@@ -25,7 +25,7 @@ jobs:
name: Build and test on Windows name: Build and test on Windows
strategy: strategy:
matrix: matrix:
os: [ windows-latest, windows-2022 ] os: [ windows-latest, windows-2019 ]
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
steps: steps:
- name: Checkout the repository - name: Checkout the repository
@@ -46,7 +46,7 @@ jobs:
name: Build and test on Windows Minimal build name: Build and test on Windows Minimal build
strategy: strategy:
matrix: matrix:
os: [ windows-2022 ] os: [ windows-2019 ]
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
steps: steps:
- name: Checkout the repository - name: Checkout the repository

View File

@@ -1,27 +1,7 @@
# Changelog # Changelog
All notable changes to this project will be documented in this file. All notable changes to this project will be documented in this file.
## 1.40.1 - 2025-11-16 ## Unreleased - ???
- Fix `JANET_REDUCED_OS` build regression caused by `os/posix-chroot`.
- Code formatting
## 1.40.0 - 2025-11-15
- 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`.
## 1.39.1 - 2025-08-30
- Add support for chdir in os/spawn on older macOS versions
- Expose channels properly in C API
## 1.39.0 - 2025-08-24
- Various bug fixes
- Add `net/socket`
- Add support for illumos OS
- Raise helpful errors for incorrect arguments to `import`.
- Allow configuring `JANET_THREAD_LOCAL` during builds to allow multi-threading on unknown compilers. - Allow configuring `JANET_THREAD_LOCAL` during builds to allow multi-threading on unknown compilers.
- Make `ffi/write` append to a buffer instead of insert at 0 by default. - Make `ffi/write` append to a buffer instead of insert at 0 by default.
- Add `os/getpid` to get the current process id. - Add `os/getpid` to get the current process id.

View File

@@ -61,7 +61,7 @@ ensure a consistent code style for C.
## Janet style ## 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. The auto formatting from janet.vim will work well.
## Typo Fixing and One-Line changes ## Typo Fixing and One-Line changes

View File

@@ -47,7 +47,6 @@ SPORK_TAG?=master
HAS_SHARED?=1 HAS_SHARED?=1
DEBUGGER=gdb DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname, SONAME_SETTER=-Wl,-soname,
STRIPFLAGS=-x -S
# For cross compilation # For cross compilation
HOSTCC?=$(CC) HOSTCC?=$(CC)
@@ -55,7 +54,7 @@ HOSTAR?=$(AR)
# Symbols are (optionally) removed later, keep -g as default! # Symbols are (optionally) removed later, keep -g as default!
CFLAGS?=-O2 -g CFLAGS?=-O2 -g
LDFLAGS?=-rdynamic LDFLAGS?=-rdynamic
LIBJANET_LDFLAGS?=$(LDFLAGS) LIBJANET_LDFLAGS?=$(LD_FLAGS)
RUN:=$(RUN) RUN:=$(RUN)
@@ -81,12 +80,6 @@ ifeq ($(UNAME), Darwin)
LDCONFIG:=true LDCONFIG:=true
else ifeq ($(UNAME), Linux) else ifeq ($(UNAME), Linux)
CLIBS:=$(CLIBS) -lrt -ldl CLIBS:=$(CLIBS) -lrt -ldl
else ifeq ($(UNAME), SunOS)
BUILD_CFLAGS+=-D__EXTENSIONS__ -DJANET_NO_NANBOX
BOOT_CFLAGS+=-D__EXTENSIONS__ -DJANET_NO_NANBOX
CLIBS:=-lsocket -lm
STRIPFLAGS=-x
LDCONFIG:=false
endif endif
# For other unix likes, add flags here! # For other unix likes, add flags here!
@@ -220,9 +213,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
######################## ########################
ifeq ($(UNAME), Darwin) ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.40.dylib SONAME=libjanet.1.38.dylib
else else
SONAME=libjanet.so.1.40 SONAME=libjanet.so.1.38
endif endif
ifeq ($(MINGW_COMPILER), clang) ifeq ($(MINGW_COMPILER), clang)
@@ -261,7 +254,6 @@ $(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
# Testing assumes HOSTCC=CC # Testing assumes HOSTCC=CC
TEST_SCRIPTS=$(wildcard test/suite*.janet) TEST_SCRIPTS=$(wildcard test/suite*.janet)
EXAMPLE_SCRIPTS=$(wildcard examples/*.janet)
repl: $(JANET_TARGET) repl: $(JANET_TARGET)
$(RUN) ./$(JANET_TARGET) $(RUN) ./$(JANET_TARGET)
@@ -269,26 +261,21 @@ repl: $(JANET_TARGET)
debug: $(JANET_TARGET) debug: $(JANET_TARGET)
$(DEBUGGER) ./$(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: $(JANET_TARGET)
$(VALGRIND_COMMAND) ./$(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 test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; 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 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: $(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 ##### ##### Distribution #####
@@ -302,7 +289,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
README.md build/c/janet.c build/c/shell.c README.md build/c/janet.c build/c/shell.c
mkdir -p build/$(JANET_DIST_DIR)/bin mkdir -p build/$(JANET_DIST_DIR)/bin
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/ cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
strip $(STRIPFLAGS) 'build/$(JANET_DIST_DIR)/bin/janet' strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
mkdir -p build/$(JANET_DIST_DIR)/include mkdir -p build/$(JANET_DIST_DIR)/include
cp build/janet.h build/$(JANET_DIST_DIR)/include/ cp build/janet.h build/$(JANET_DIST_DIR)/include/
mkdir -p build/$(JANET_DIST_DIR)/lib/ mkdir -p build/$(JANET_DIST_DIR)/lib/
@@ -347,23 +334,22 @@ build/janet.pc: $(JANET_TARGET)
echo 'Libs.private: $(CLIBS)' >> $@ echo 'Libs.private: $(CLIBS)' >> $@
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
$(eval JANET_VERSION := $(shell $(JANET_TARGET) -e '(print janet/version)'))
mkdir -p '$(DESTDIR)$(BINDIR)' mkdir -p '$(DESTDIR)$(BINDIR)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet' cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
strip $(STRIPFLAGS) '$(DESTDIR)$(BINDIR)/janet' strip -x -S '$(DESTDIR)$(BINDIR)/janet'
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet' mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet' cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
mkdir -p '$(DESTDIR)$(JANET_PATH)' mkdir -p '$(DESTDIR)$(JANET_PATH)'
mkdir -p '$(DESTDIR)$(LIBDIR)' mkdir -p '$(DESTDIR)$(LIBDIR)'
if test $(UNAME) = Darwin ; then \ if test $(UNAME) = Darwin ; then \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(JANET_VERSION).dylib' ; \ cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib' ; \
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \ ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \
ln -sf libjanet.$(JANET_VERSION).dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \ ln -sf libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
else \ else \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(JANET_VERSION)' ; \ cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' ; \
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \ ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \
ln -sf libjanet.so.$(JANET_VERSION) $(DESTDIR)$(LIBDIR)/$(SONAME) ; \ ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
fi fi
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a' cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
mkdir -p '$(DESTDIR)$(JANET_MANPATH)' mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
@@ -420,6 +406,9 @@ clean:
-rm -rf build vgcore.* callgrind.* -rm -rf build vgcore.* callgrind.*
-rm -rf test/install/build test/install/modpath -rm -rf test/install/build test/install/modpath
test-install:
echo "JPM has been removed from default install."
help: help:
@echo @echo
@echo 'Janet: A Dynamic Language & Bytecode VM' @echo 'Janet: A Dynamic Language & Bytecode VM'
@@ -431,8 +420,7 @@ help:
@echo ' make test Test a built Janet' @echo ' make test Test a built Janet'
@echo ' make valgrind Assess Janet with Valgrind' @echo ' make valgrind Assess Janet with Valgrind'
@echo ' make callgrind Assess Janet with Valgrind, using Callgrind' @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 dist Create a distribution tarball'
@echo ' make docs Generate documentation' @echo ' make docs Generate documentation'
@echo ' make debug Run janet with GDB or LLDB' @echo ' make debug Run janet with GDB or LLDB'
@@ -442,9 +430,6 @@ help:
@echo " make format Format Janet's own source files" @echo " make format Format Janet's own source files"
@echo ' make grammar Generate a TextMate language grammar' @echo ' make grammar Generate a TextMate language grammar'
@echo @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

View File

@@ -213,10 +213,6 @@ gmake install-jpm-git
NetBSD build instructions are the same as the FreeBSD build instructions. NetBSD build instructions are the same as the FreeBSD build instructions.
Alternatively, install the package directly with `pkgin install janet`. Alternatively, install the package directly with `pkgin install janet`.
### illumos
Building on illumos is exactly the same as building on FreeBSD.
### Windows ### Windows
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#). 1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#).

View File

@@ -49,7 +49,6 @@ for %%f in (src\boot\*.c) do (
) )
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj %JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
@if errorlevel 1 goto :BUILDFAIL @if errorlevel 1 goto :BUILDFAIL
@rem note that there is no default syspath being baked in
build\janet_boot . > build\c\janet.c build\janet_boot . > build\c\janet.c
@if errorlevel 1 goto :BUILDFAIL @if errorlevel 1 goto :BUILDFAIL

View File

@@ -1,6 +0,0 @@
# Linux only - uses abstract unix domain sockets
(ev/spawn (net/server :unix "@abc123" (fn [conn] (print (:read conn 1024)) (:close conn))))
(ev/sleep 1)
(def s (net/connect :unix "@abc123" :stream))
(:write s "hello")
(:close s)

View File

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

View File

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

View File

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

View File

@@ -214,7 +214,7 @@ Don't execute a script, only compile it to check for errors. Useful for linting
.BR \-m\ syspath .BR \-m\ syspath
Set the dynamic binding :syspath to the string syspath so that Janet will load system modules Set the dynamic binding :syspath to the string syspath so that Janet will load system modules
from a directory different than the default. The default is set when Janet is built, and defaults to from a directory different than the default. The default is set when Janet is built, and defaults to
/usr/local/lib/janet on Linux/Posix. On Windows, there is no default value. This option supersedes JANET_PATH. /usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH.
.TP .TP
.BR \-c\ source\ output .BR \-c\ source\ output
@@ -255,7 +255,8 @@ and then arguments to the script.
.RS .RS
The location to look for Janet libraries. This is the only environment variable Janet needs to The location to look for Janet libraries. This is the only environment variable Janet needs to
find native and source code modules. If no JANET_PATH is set, Janet will look in find native and source code modules. If no JANET_PATH is set, Janet will look in
the default location set at compile time. This should be a colon-separated list of directory names on Linux/Posix, and a semicolon-separated list on Windows. Note that a typical setup (i.e. not NixOS / Guix) will only use a single directory. the default location set at compile time. This should be a list of as well as a colon
separate list of such directories.
.RE .RE
.B JANET_PROFILE .B JANET_PROFILE

View File

@@ -20,7 +20,7 @@
project('janet', 'c', project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'], default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.40.1') version : '1.38.0')
# Global settings # Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet') janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -281,7 +281,6 @@ test_files = [
'test/suite-corelib.janet', 'test/suite-corelib.janet',
'test/suite-debug.janet', 'test/suite-debug.janet',
'test/suite-ev.janet', 'test/suite-ev.janet',
'test/suite-ev2.janet',
'test/suite-ffi.janet', 'test/suite-ffi.janet',
'test/suite-filewatch.janet', 'test/suite-filewatch.janet',
'test/suite-inttypes.janet', 'test/suite-inttypes.janet',

View File

@@ -7,7 +7,7 @@
### ###
### ###
(def defn :macro :flycheck (def defn :macro
``` ```
(defn name & more) (defn name & more)
@@ -43,7 +43,7 @@
# Build return value # Build return value
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start))))) ~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
(defn defmacro :macro :flycheck (defn defmacro :macro
"Define a macro." "Define a macro."
[name & more] [name & more]
(setdyn name @{}) # override old macro definitions in the case of a recursive macro (setdyn name @{}) # override old macro definitions in the case of a recursive macro
@@ -57,12 +57,12 @@
[f & args] [f & args]
(f ;args)) (f ;args))
(defmacro defmacro- :flycheck (defmacro defmacro-
"Define a private macro that will not be exported." "Define a private macro that will not be exported."
[name & more] [name & more]
(apply defn name :macro :private more)) (apply defn name :macro :private more))
(defmacro defn- :flycheck (defmacro defn-
"Define a private function that will not be exported." "Define a private function that will not be exported."
[name & more] [name & more]
(apply defn name :private 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 %= "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." "Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
[x &opt err] [x &opt err]
(def v (gensym)) (def v (gensym))
@@ -154,11 +154,11 @@
,v ,v
(,error ,(if err err (string/format "assert failure in %j" x)))))) (,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 ``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 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 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 replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
called "earmuffs".`` called "earmuffs".``
[alias & more] [alias & more]
(assert (symbol? alias) "alias must be a symbol") (assert (symbol? alias) "alias must be a symbol")
@@ -171,9 +171,6 @@
(defdyn *macro-form* (defdyn *macro-form*
"Inside a macro, is bound to the source form that invoked the macro") "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* (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.") "The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
@@ -293,6 +290,22 @@
(array/concat accum body) (array/concat accum body)
(tuple/slice accum 0)) (tuple/slice accum 0))
(defmacro try
``Try something and catch errors. `body` is any expression,
and `catch` should be a form, the first element of which is a tuple. This tuple
should contain a binding for errors and an optional binding for
the fiber wrapping the body. Returns the result of `body` if no error,
or the result of `catch` if an error.``
[body catch]
(let [[[err fib]] catch
f (gensym)
r (gensym)]
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
,r (,resume ,f)]
(if (,= (,fiber/status ,f) :error)
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
,r))))
(defmacro protect (defmacro protect
`Evaluate expressions, while capturing any errors. Evaluates to a tuple `Evaluate expressions, while capturing any errors. Evaluates to a tuple
of two elements. The first element is true if successful, false if an of two elements. The first element is true if successful, false if an
@@ -339,26 +352,6 @@
(tuple 'if $fi $fi ret)))))) (tuple 'if $fi $fi ret))))))
ret) ret)
(defmacro try
``Try something and catch errors. `body` is any expression,
and `catch` should be a form, the first element of which is a tuple. This tuple
should contain a binding for errors and an optional binding for
the fiber wrapping the body. Returns the result of `body` if no error,
or the result of `catch` if an error.``
[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)
f (gensym)]
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
,r (,resume ,f)]
(if (,= (,fiber/status ,f) :error)
(do
,(if err ~(def ,err ,r))
,(if fib ~(def ,fib ,f))
,;(tuple/slice catch 1))
,r))))
(defmacro with-syms (defmacro with-syms
"Evaluates `body` with each symbol in `syms` bound to a generated, unique symbol." "Evaluates `body` with each symbol in `syms` bound to a generated, unique symbol."
[syms & body] [syms & body]
@@ -1806,8 +1799,8 @@
(flatten-into @[] xs)) (flatten-into @[] xs))
(defn kvs (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] [dict]
(def ret @[]) (def ret @[])
(loop [k :keys dict] (array/push ret k (in dict k))) (loop [k :keys dict] (array/push ret k (in dict k)))
@@ -2360,7 +2353,7 @@
(set macexvar macex) (set macexvar macex)
(defmacro varfn :flycheck (defmacro varfn
``Create a function that can be rebound. `varfn` has the same signature ``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` 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 already exists in the environment, it is rebound to the new function. Returns
@@ -3187,17 +3180,12 @@
use the name of the module as a prefix. One can also use "`:export true`" use the name of the module as a prefix. One can also use "`:export true`"
to re-export the imported symbols. If "`:exit true`" is given as an argument, to re-export the imported symbols. If "`:exit true`" is given as an argument,
any errors encountered at the top level in the module will cause `(os/exit 1)` any errors encountered at the top level in the module will cause `(os/exit 1)`
to be called. Dynamic bindings will NOT be imported. Use :fresh with a truthy to be called. Dynamic bindings will NOT be imported. Use :fresh to bypass the
value to bypass the module cache. Use `:only [foo bar baz]` to only import module cache. Use `:only [foo bar baz]` to only import select bindings into the
select bindings into the current environment.`` current environment.``
[path & args] [path & args]
(assertf (even? (length args)) "args should have even length: %n" args)
(def ps (partition 2 args)) (def ps (partition 2 args))
(def argm (def argm (mapcat (fn [[k v]] [k (case k :as (string v) :only ~(quote ,v) v)]) ps))
(mapcat (fn [[k v]]
(assertf (keyword? k) "expected keyword, got %s: %n" (type k) k)
[k (case k :as (string v) :only ~(quote ,v) v)])
ps))
(tuple import* (string path) ;argm)) (tuple import* (string path) ;argm))
(defmacro use (defmacro use
@@ -3260,10 +3248,12 @@
# Terminal codes for emission/tokenization # Terminal codes for emission/tokenization
(def delimiters (def delimiters
(if has-color (if has-color
{:code ["\e[97m" "\e[39m"] {:underline ["\e[4m" "\e[24m"]
:code ["\e[97m" "\e[39m"]
:italics ["\e[4m" "\e[24m"] :italics ["\e[4m" "\e[24m"]
:bold ["\e[1m" "\e[22m"]} :bold ["\e[1m" "\e[22m"]}
{:code ["`" "`"] {:underline ["_" "_"]
:code ["`" "`"]
:italics ["*" "*"] :italics ["*" "*"]
:bold ["**" "**"]})) :bold ["**" "**"]}))
(def modes @{}) (def modes @{})
@@ -3394,6 +3384,7 @@
(= b (chr `\`)) (do (= b (chr `\`)) (do
(++ token-length) (++ token-length)
(buffer/push token (get line (++ i)))) (buffer/push token (get line (++ i))))
(= b (chr "_")) (delim :underline)
(= b (chr "*")) (= b (chr "*"))
(if (= (chr "*") (get line (+ i 1))) (if (= (chr "*") (get line (+ i 1)))
(do (++ i) (do (++ i)
@@ -3925,14 +3916,8 @@
(compwhen (dyn 'net/listen) (compwhen (dyn 'net/listen)
(defn net/server (defn net/server
`` "Start a server asynchronously with `net/listen` and `net/accept-loop`. Returns the new server stream."
Starts a server with `net/listen`. Runs `net/accept-loop` asynchronously if
`handler` is set and `type` is `:stream` (the default). It is invalid to set
`handler` if `type` is `:datagram`. Returns the new server stream.
``
[host port &opt handler type no-reuse] [host port &opt handler type no-reuse]
(assert (not (and (= type :datagram) handler))
"handler not supported for :datagram servers")
(def s (net/listen host port type no-reuse)) (def s (net/listen host port type no-reuse))
(if handler (if handler
(ev/go (fn [] (net/accept-loop s handler)))) (ev/go (fn [] (net/accept-loop s handler))))
@@ -3951,7 +3936,7 @@
[& forms] [& forms]
(def state (gensym)) (def state (gensym))
(def loaded (gensym)) (def loaded (gensym))
~((fn :delay [] ~((fn []
(var ,state nil) (var ,state nil)
(var ,loaded nil) (var ,loaded nil)
(fn [] (fn []
@@ -3983,7 +3968,7 @@
:lazy lazy :lazy lazy
:map-symbols map-symbols})) :map-symbols map-symbols}))
(defmacro ffi/defbind-alias :flycheck (defmacro ffi/defbind-alias
"Generate bindings for native functions in a convenient manner. "Generate bindings for native functions in a convenient manner.
Similar to defbind but allows for the janet function name to be Similar to defbind but allows for the janet function name to be
different than the FFI function." different than the FFI function."
@@ -3994,8 +3979,6 @@
(def formal-args (map 0 arg-pairs)) (def formal-args (map 0 arg-pairs))
(def type-args (map 1 arg-pairs)) (def type-args (map 1 arg-pairs))
(def computed-type-args (eval ~[,;type-args])) (def computed-type-args (eval ~[,;type-args]))
(if (dyn *flychecking*)
(break ~(defn ,alias ,;meta [,;formal-args] nil)))
(def {:native lib (def {:native lib
:lazy lazy :lazy lazy
:native-lazy llib :native-lazy llib
@@ -4011,7 +3994,7 @@
~(defn ,alias ,;meta [,;formal-args] ~(defn ,alias ,;meta [,;formal-args]
(,ffi/call ,(make-ptr) ,(make-sig) ,;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." "Generate bindings for native functions in a convenient manner."
[name ret-type & body] [name ret-type & body]
~(ffi/defbind-alias ,name ,name ,ret-type ,;body))) ~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
@@ -4022,51 +4005,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 (defn- no-side-effects
`Check if form may have side effects. If returns true, then the src `Check if form may have side effects. If returns true, then the src
must not have side effects, such as calling a C function.` must not have side effects, such as calling a C function.`
@@ -4082,29 +4020,59 @@
(all no-side-effects (values src))) (all no-side-effects (values src)))
true)) 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] [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 +4165,7 @@
(spit manifest-name b)) (spit manifest-name b))
(defn bundle/manifest (defn bundle/manifest
"Get the manifest for a given installed bundle." "Get the manifest for a give installed bundle"
[bundle-name] [bundle-name]
(def name (get-manifest-filename bundle-name)) (def name (get-manifest-filename bundle-name))
(assertf (fexists name) "no bundle %v found" bundle-name) (assertf (fexists name) "no bundle %v found" bundle-name)
@@ -4222,9 +4190,7 @@
(put new-env *syspath* fixed-syspath) (put new-env *syspath* fixed-syspath)
(with-env new-env (with-env new-env
(put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right (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 (defn- do-hook
[module bundle-name hook & args] [module bundle-name hook & args]
@@ -4261,9 +4227,7 @@
nil) nil)
(defn bundle/uninstall (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] [bundle-name]
(def breakage @{}) (def breakage @{})
(each b (bundle/list) (each b (bundle/list)
@@ -4299,8 +4263,8 @@
order) order)
(defn bundle/prune (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 topo (bundle/topolist))
(def rtopo (reverse topo)) (def rtopo (reverse topo))
@@ -4329,67 +4293,58 @@
(not (not (os/stat (bundle-dir bundle-name) :mode)))) (not (not (os/stat (bundle-dir bundle-name) :mode))))
(defn bundle/install (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] [path &keys config]
(def path (bundle-rpath path)) (def path (bundle-rpath path))
(def clean (get config :clean))
(def check (get config :check))
(def s (sep)) (def s (sep))
# Detect bundle name # Check meta file for dependencies and default name
(def infofile-src1 (string path s "bundle" s "info.jdn")) (def infofile-pre-1 (string path s "bundle" s "info.jdn"))
(def infofile-src2 (string path s "info.jdn")) (def infofile-pre (if (fexists infofile-pre-1) infofile-pre-1 (string path s "info.jdn"))) # allow for alias
(def infofile-src (cond (var default-bundle-name nil)
(fexists infofile-src1) infofile-src1 (when (os/stat infofile-pre :mode)
(fexists infofile-src2) infofile-src2)) (def info (-> infofile-pre slurp parse))
(def info (-?> infofile-src slurp parse)) (def deps (get info :dependencies @[]))
(def bundle-name (get config :name (get info :name))) (set default-bundle-name (get info :name))
(assertf bundle-name (def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d)))
"unable to infer bundle name for %v, use :name argument or add :name to info file" path) (when (next missing) (errorf "missing dependencies %s" (string/join missing ", "))))
(def bundle-name (get config :name default-bundle-name))
(assertf bundle-name "unable to infer bundle name for %v, use :name argument" path)
(assertf (not (string/check-set "\\/" bundle-name)) (assertf (not (string/check-set "\\/" bundle-name))
"bundle name %v cannot contain path separators" bundle-name) "bundle name %v cannot contain path separators" bundle-name)
(assert (next bundle-name) "cannot use empty bundle-name") (assert (next bundle-name) "cannot use empty bundle-name")
(assertf (not (fexists (get-manifest-filename bundle-name))) (assertf (not (fexists (get-manifest-filename bundle-name)))
"bundle %v is already installed" 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 # Setup installed paths
(prime-bundle-paths) (prime-bundle-paths)
(os/mkdir (bundle-dir bundle-name)) (os/mkdir (bundle-dir bundle-name))
# Copy aliased infofile # Aliases for common bundle/ files
(when (fexists infofile-src2) (def bundle.janet (string path s "bundle.janet"))
(copyfile infofile-src2 (bundle-file bundle-name "info.jdn"))) (when (fexists bundle.janet) (copyfile bundle.janet (bundle-file bundle-name "init.janet")))
# Copy aliased bscript (when (fexists infofile-pre) (copyfile infofile-pre (bundle-file bundle-name "info.jdn")))
(when (fexists bscript-src2)
(copyfile bscript-src2 (bundle-file bundle-name "init.janet")))
# Copy some files into the new location unconditionally # Copy some files into the new location unconditionally
(def implicit-sources (string path s "bundle")) (def implicit-sources (string path s "bundle"))
(when (= :directory (os/stat implicit-sources :mode)) (when (= :directory (os/stat implicit-sources :mode))
(copyrf implicit-sources (bundle-dir bundle-name))) (copyrf implicit-sources (bundle-dir bundle-name)))
(def man @{:name bundle-name :local-source path :files @[]}) (def man @{:name bundle-name :local-source path :files @[]})
(merge-into man config) (merge-into man config)
(def infofile (bundle-file bundle-name "info.jdn"))
(put man :auto-remove (get config :auto-remove))
(sync-manifest man) (sync-manifest man)
(edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name)) (edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name))
(when info (when (os/stat infofile :mode)
(def deps (seq [d :in (get info :dependencies @[])] (def info (-> infofile slurp parse))
(string (if (dictionary? d) (get d :name) d)))) (def deps (get info :dependencies @[]))
(def missing (filter (complement bundle/installed?) deps)) (def missing (filter (complement bundle/installed?) deps))
(when (next missing) (when (next missing)
(error (string "missing dependencies " (string/join missing ", ")))) (error (string "missing dependencies " (string/join missing ", "))))
(put man :dependencies deps) (put man :dependencies deps)
(put man :info info)) (put man :info info))
(def module (get-bundle-module bundle-name)) (def module (get-bundle-module bundle-name))
(def clean (get config :clean))
(def check (get config :check))
(def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k))) (def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k)))
(put man :hooks all-hooks) (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 (when clean
(do-hook module bundle-name :clean man)) (do-hook module bundle-name :clean man))
(do-hook module bundle-name :build man) (do-hook module bundle-name :build man)
@@ -4399,21 +4354,15 @@
(when check (when check
(do-hook module bundle-name :check man))) (do-hook module bundle-name :check man)))
(print "installed " bundle-name) (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")) (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) bundle-name)
(defn- bundle/pack (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] [bundle-name dest-dir &opt is-backup]
(var i 0) (var i 0)
(def man (bundle/manifest bundle-name)) (def man (bundle/manifest bundle-name))
@@ -4443,9 +4392,9 @@
dest-dir) dest-dir)
(defn bundle/replace (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] [bundle-name path &keys new-config]
(def manifest (bundle/manifest bundle-name)) (def manifest (bundle/manifest bundle-name))
(def config (get manifest :config @{})) (def config (get manifest :config @{}))
@@ -4472,7 +4421,7 @@
bundle-name) bundle-name)
(defn bundle/add-directory (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] [manifest dest &opt chmod-mode]
(def files (get-files manifest)) (def files (get-files manifest))
(def s (sep)) (def s (sep))
@@ -4500,7 +4449,7 @@
ret) ret)
(defn bundle/add-file (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] [manifest src &opt dest chmod-mode]
(default dest src) (default dest src)
(def files (get-files manifest)) (def files (get-files manifest))
@@ -4517,9 +4466,9 @@
absdest) absdest)
(defn bundle/add (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] [manifest src &opt dest chmod-mode]
(default dest src) (default dest src)
(def s (sep)) (def s (sep))
@@ -4534,31 +4483,20 @@
(errorf "bad path %s - file is a %s" src mode))) (errorf "bad path %s - file is a %s" src mode)))
(defn bundle/add-bin (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)) (def s (sep))
(default filename (last (string/split s src))) (default dest (last (string/split s src)))
(default chmod-mode 8r755) (default chmod-mode 8r755)
(os/mkdir (string (dyn *syspath*) s "bin")) (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 (defn bundle/update-all
"Reinstall all bundles." "Reinstall all bundles"
[&keys configs] [&keys configs]
(each bundle (bundle/topolist) (each bundle (bundle/topolist)
(bundle/reinstall bundle ;(kvs configs))))) (bundle/reinstall bundle ;(kvs configs)))))
@@ -4570,10 +4508,7 @@
### ###
# conditional compilation for reduced os # 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 (defn- run-main
[env subargs arg] [env subargs arg]
@@ -4696,7 +4631,7 @@
--reinstall (-B) name : Reinstall a bundle by bundle name --reinstall (-B) name : Reinstall a bundle by bundle name
--uninstall (-u) name : Uninstall a bundle by bundle name --uninstall (-u) name : Uninstall a bundle by bundle name
--update-all (-U) : Reinstall all installed bundles --update-all (-U) : Reinstall all installed bundles
--prune (-P) : Uninstall all bundles that are orphaned --prune (-P) : Uninstalled all bundles that are orphaned
--list (-L) : List all installed bundles --list (-L) : List all installed bundles
-- : Stop handling options -- : Stop handling options
```) ```)
@@ -4948,15 +4883,14 @@
"src/core/wrap.c"]) "src/core/wrap.c"])
# Print janet.c to stdout # 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 "/* Generated from janet version " janet/version "-" janet/build " */")
(print "#define JANET_BUILD \"" janet/build "\"") (print "#define JANET_BUILD \"" janet/build "\"")
(print ```#define JANET_AMALG```) (print ```#define JANET_AMALG```)
(defn do-one-file (defn do-one-file
[fname] [fname]
(unless image-only (unless (has-value? boot/args "image-only")
(print "\n/* " fname " */") (print "\n/* " fname " */")
(print "#line 0 \"" fname "\"\n") (print "#line 0 \"" fname "\"\n")
(def source (slurp fname)) (def source (slurp fname))

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H #define JANETCONF_H
#define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 40 #define JANET_VERSION_MINOR 38
#define JANET_VERSION_PATCH 1 #define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA "" #define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.40.1" #define JANET_VERSION "1.38.0"
/* #define JANET_BUILD "local" */ /* #define JANET_BUILD "local" */

View File

@@ -66,7 +66,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
JanetBuildConfig modconf = getter(); JanetBuildConfig modconf = getter();
JanetBuildConfig host = janet_config_current(); JanetBuildConfig host = janet_config_current();
if (host.major != modconf.major || if (host.major != modconf.major ||
host.minor != modconf.minor || host.minor < modconf.minor ||
host.bits != modconf.bits) { host.bits != modconf.bits) {
char errbuf[128]; char errbuf[128];
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)", snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
@@ -653,15 +653,22 @@ JANET_CORE_FN(janet_core_check_int,
"(int? x)", "(int? x)",
"Check if x can be exactly represented as a 32 bit signed two's complement integer.") { "Check if x can be exactly represented as a 32 bit signed two's complement integer.") {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checkint(argv[0])); if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
double num = janet_unwrap_number(argv[0]);
return janet_wrap_boolean(num == (double)((int32_t)num));
ret_false:
return janet_wrap_false();
} }
JANET_CORE_FN(janet_core_check_nat, JANET_CORE_FN(janet_core_check_nat,
"(nat? x)", "(nat? x)",
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.") { "Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.") {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
if (!janet_checkint(argv[0])) return janet_wrap_false(); if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
return janet_wrap_boolean(janet_unwrap_integer(argv[0]) >= 0); double num = janet_unwrap_number(argv[0]);
return janet_wrap_boolean(num >= 0 && (num == (double)((int32_t)num)));
ret_false:
return janet_wrap_false();
} }
JANET_CORE_FN(janet_core_is_bytes, JANET_CORE_FN(janet_core_is_bytes,
@@ -746,7 +753,6 @@ typedef struct SandboxOption {
static const SandboxOption sandbox_options[] = { static const SandboxOption sandbox_options[] = {
{"all", JANET_SANDBOX_ALL}, {"all", JANET_SANDBOX_ALL},
{"chroot", JANET_SANDBOX_CHROOT},
{"env", JANET_SANDBOX_ENV}, {"env", JANET_SANDBOX_ENV},
{"ffi", JANET_SANDBOX_FFI}, {"ffi", JANET_SANDBOX_FFI},
{"ffi-define", JANET_SANDBOX_FFI_DEFINE}, {"ffi-define", JANET_SANDBOX_FFI_DEFINE},
@@ -772,7 +778,6 @@ JANET_CORE_FN(janet_core_sandbox,
"Disable feature sets to prevent the interpreter from using certain system resources. " "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" "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" "* :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" "* :env - disallow reading and write env variables\n"
"* :ffi - disallow FFI (recommended if disabling anything else)\n" "* :ffi - disallow FFI (recommended if disabling anything else)\n"
"* :ffi-define - disallow loading new FFI modules and binding new functions\n" "* :ffi-define - disallow loading new FFI modules and binding new functions\n"
@@ -997,11 +1002,11 @@ static void make_apply(JanetTable *env) {
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG, janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm), "apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
JDOC("(apply f & args)\n\n" JDOC("(apply f & args)\n\n"
"Applies a function f to a variable number of arguments. Each " "Applies a function f to a variable number of arguments. Each "
"element in args is used as an argument to f, except the last " "element in args is used as an argument to f, except the last "
"element in args, which is expected to be an array or a tuple. " "element in args, which is expected to be an array or a tuple. "
"Each element in this last argument is then also pushed as an " "Each element in this last argument is then also pushed as an "
"argument to f.")); "argument to f."));
} }
static const uint32_t error_asm[] = { static const uint32_t error_asm[] = {
@@ -1154,82 +1159,82 @@ JanetTable *janet_core_env(JanetTable *replacements) {
janet_quick_asm(env, JANET_FUN_CMP, janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm), "cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n" JDOC("(cmp x y)\n\n"
"Returns -1 if x is strictly less than y, 1 if y is strictly greater " "Returns -1 if x is strictly less than y, 1 if y is strictly greater "
"than x, and 0 otherwise. To return 0, x and y must be the exact same type.")); "than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
janet_quick_asm(env, JANET_FUN_NEXT, janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm), "next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n" JDOC("(next ds &opt key)\n\n"
"Gets the next key in a data structure. Can be used to iterate through " "Gets the next key in a data structure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed " "the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if the data structure is not mutated " "to be seen only once per iteration if the data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next " "during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through.")); "returns nil, there are no more keys to iterate through."));
janet_quick_asm(env, JANET_FUN_PROP, janet_quick_asm(env, JANET_FUN_PROP,
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm), "propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
JDOC("(propagate x fiber)\n\n" JDOC("(propagate x fiber)\n\n"
"Propagate a signal from a fiber to the current fiber and " "Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal " "set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. " "value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include " "The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, " "frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. " "resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing " "This function can be used to re-raise an error without losing "
"the original stack trace.")); "the original stack trace."));
janet_quick_asm(env, JANET_FUN_DEBUG, janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm), "debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n" JDOC("(debug &opt x)\n\n"
"Throws a debug signal that can be caught by a parent fiber and used to inspect " "Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns the value passed in by resume.")); "the running state of the current fiber. Returns the value passed in by resume."));
janet_quick_asm(env, JANET_FUN_ERROR, janet_quick_asm(env, JANET_FUN_ERROR,
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm), "error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
JDOC("(error e)\n\n" JDOC("(error e)\n\n"
"Throws an error e that can be caught and handled by a parent fiber.")); "Throws an error e that can be caught and handled by a parent fiber."));
janet_quick_asm(env, JANET_FUN_YIELD, janet_quick_asm(env, JANET_FUN_YIELD,
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm), "yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
JDOC("(yield &opt x)\n\n" JDOC("(yield &opt x)\n\n"
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until " "Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will " "another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume.")); "return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_CANCEL, janet_quick_asm(env, JANET_FUN_CANCEL,
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm), "cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
JDOC("(cancel fiber err)\n\n" JDOC("(cancel fiber err)\n\n"
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. " "Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume.")); "Returns the same result as resume."));
janet_quick_asm(env, JANET_FUN_RESUME, janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm), "resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n" JDOC("(resume fiber &opt x)\n\n"
"Resume a new or suspended fiber and optionally pass in a value to the fiber that " "Resume a new or suspended fiber and optionally pass in a value to the fiber that "
"will be returned to the last yield in the case of a pending fiber, or the argument to " "will be returned to the last yield in the case of a pending fiber, or the argument to "
"the dispatch function in the case of a new fiber. Returns either the return result of " "the dispatch function in the case of a new fiber. Returns either the return result of "
"the fiber's dispatch function, or the value from the next yield call in fiber.")); "the fiber's dispatch function, or the value from the next yield call in fiber."));
janet_quick_asm(env, JANET_FUN_IN, janet_quick_asm(env, JANET_FUN_IN,
"in", 3, 2, 3, 4, in_asm, sizeof(in_asm), "in", 3, 2, 3, 4, in_asm, sizeof(in_asm),
JDOC("(in ds key &opt dflt)\n\n" JDOC("(in ds key &opt dflt)\n\n"
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, " "Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, " "strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can " "and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
"take any value as a key except nil and will return nil or dflt if not found.")); "take any value as a key except nil and will return nil or dflt if not found."));
janet_quick_asm(env, JANET_FUN_GET, janet_quick_asm(env, JANET_FUN_GET,
"get", 3, 2, 3, 4, get_asm, sizeof(in_asm), "get", 3, 2, 3, 4, get_asm, sizeof(in_asm),
JDOC("(get ds key &opt dflt)\n\n" JDOC("(get ds key &opt dflt)\n\n"
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. " "Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
"Similar to in, but will not throw an error if the key is invalid for the data structure " "Similar to in, but will not throw an error if the key is invalid for the data structure "
"unless the data structure is an abstract type. In that case, the abstract type getter may throw " "unless the data structure is an abstract type. In that case, the abstract type getter may throw "
"an error.")); "an error."));
janet_quick_asm(env, JANET_FUN_PUT, janet_quick_asm(env, JANET_FUN_PUT,
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm), "put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
JDOC("(put ds key value)\n\n" JDOC("(put ds key value)\n\n"
"Associate a key with a value in any mutable associative data structure. Indexed data structures " "Associate a key with a value in any mutable associative data structure. Indexed data structures "
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds " "(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra " "value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype " "space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting " "will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
"a value nil into a table will remove the key from the table. Returns the data structure ds.")); "a value nil into a table will remove the key from the table. Returns the data structure ds."));
janet_quick_asm(env, JANET_FUN_LENGTH, janet_quick_asm(env, JANET_FUN_LENGTH,
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm), "length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
JDOC("(length ds)\n\n" JDOC("(length ds)\n\n"
"Returns the length or count of a data structure in constant time as an integer. For " "Returns the length or count of a data structure in constant time as an integer. For "
"structs and tables, returns the number of key-value pairs in the data structure.")); "structs and tables, returns the number of key-value pairs in the data structure."));
janet_quick_asm(env, JANET_FUN_BNOT, janet_quick_asm(env, JANET_FUN_BNOT,
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm), "bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x.")); JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
@@ -1238,74 +1243,74 @@ JanetTable *janet_core_env(JanetTable *replacements) {
/* Variadic ops */ /* Variadic ops */
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD, templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
JDOC("(+ & xs)\n\n" JDOC("(+ & xs)\n\n"
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0.")); "Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT, templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
JDOC("(- & xs)\n\n" JDOC("(- & xs)\n\n"
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the " "Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
"negative value of that element. Otherwise, returns the first element in xs minus the sum of " "negative value of that element. Otherwise, returns the first element in xs minus the sum of "
"the rest of the elements.")); "the rest of the elements."));
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY, templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
JDOC("(* & xs)\n\n" JDOC("(* & xs)\n\n"
"Returns the product of all elements in xs. If xs is empty, returns 1.")); "Returns the product of all elements in xs. If xs is empty, returns 1."));
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE, templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
JDOC("(/ & xs)\n\n" JDOC("(/ & xs)\n\n"
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns " "Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values.")); "values."));
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR, templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
JDOC("(div & xs)\n\n" JDOC("(div & xs)\n\n"
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns " "Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values.")); "values."));
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO, templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
JDOC("(mod & xs)\n\n" JDOC("(mod & xs)\n\n"
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. " "Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
"`(mod x 0)` is defined to be `x`.")); "`(mod x 0)` is defined to be `x`."));
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER, templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
JDOC("(% & xs)\n\n" JDOC("(% & xs)\n\n"
"Returns the remainder of dividing the first value of xs by each remaining value.")); "Returns the remainder of dividing the first value of xs by each remaining value."));
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND, templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
JDOC("(band & xs)\n\n" JDOC("(band & xs)\n\n"
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); "Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR, templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
JDOC("(bor & xs)\n\n" JDOC("(bor & xs)\n\n"
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer.")); "Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR, templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
JDOC("(bxor & xs)\n\n" JDOC("(bxor & xs)\n\n"
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer.")); "Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT, templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
JDOC("(blshift x & shifts)\n\n" JDOC("(blshift x & shifts)\n\n"
"Returns the value of x bit shifted left by the sum of all values in shifts. x " "Returns the value of x bit shifted left by the sum of all values in shifts. x "
"and each element in shift must be an integer.")); "and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT, templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
JDOC("(brshift x & shifts)\n\n" JDOC("(brshift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x " "Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer.")); "and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED, templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
JDOC("(brushift x & shifts)\n\n" JDOC("(brushift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x " "Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer. The sign of x is not preserved, so " "and each element in shift must be an integer. The sign of x is not preserved, so "
"for positive shifts the return value will always be positive.")); "for positive shifts the return value will always be positive."));
/* Variadic comparators */ /* Variadic comparators */
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN, templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
JDOC("(> & xs)\n\n" JDOC("(> & xs)\n\n"
"Check if xs is in descending order. Returns a boolean.")); "Check if xs is in descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN, templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
JDOC("(< & xs)\n\n" JDOC("(< & xs)\n\n"
"Check if xs is in ascending order. Returns a boolean.")); "Check if xs is in ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL, templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
JDOC("(>= & xs)\n\n" JDOC("(>= & xs)\n\n"
"Check if xs is in non-ascending order. Returns a boolean.")); "Check if xs is in non-ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL, templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
JDOC("(<= & xs)\n\n" JDOC("(<= & xs)\n\n"
"Check if xs is in non-descending order. Returns a boolean.")); "Check if xs is in non-descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS, templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
JDOC("(= & xs)\n\n" JDOC("(= & xs)\n\n"
"Check if all values in xs are equal. Returns a boolean.")); "Check if all values in xs are equal. Returns a boolean."));
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS, templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
JDOC("(not= & xs)\n\n" JDOC("(not= & xs)\n\n"
"Check if any values in xs are not equal. Returns a boolean.")); "Check if any values in xs are not equal. Returns a boolean."));
/* Platform detection */ /* Platform detection */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION), janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
@@ -1314,7 +1319,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("The build identifier of the running janet program.")); JDOC("The build identifier of the running janet program."));
janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS), janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS),
JDOC("The flag set of config options from janetconf.h which is used to check " JDOC("The flag set of config options from janetconf.h which is used to check "
"if native modules are compatible with the host program.")); "if native modules are compatible with the host program."));
/* Allow references to the environment */ /* Allow references to the environment */
janet_def(env, "root-env", janet_wrap_table(env), janet_def(env, "root-env", janet_wrap_table(env),

View File

@@ -117,9 +117,6 @@ typedef struct {
double sec; double sec;
JanetVM *vm; JanetVM *vm;
JanetFiber *fiber; JanetFiber *fiber;
#ifdef JANET_WINDOWS
HANDLE cancel_event;
#endif
} JanetThreadedTimeout; } JanetThreadedTimeout;
#define JANET_MAX_Q_CAPACITY 0x7FFFFFF #define JANET_MAX_Q_CAPACITY 0x7FFFFFF
@@ -607,43 +604,8 @@ void janet_ev_init_common(void) {
#endif #endif
} }
#if JANET_ANDROID
static void janet_timeout_stop(int sig_num) {
if (sig_num == SIGUSR1) {
pthread_exit(0);
}
}
#endif
static void handle_timeout_worker(JanetTimeout to, int cancel) {
if (!to.has_worker) return;
#ifdef JANET_WINDOWS
if (cancel && to.worker_event) {
SetEvent(to.worker_event);
}
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");
#else
if (cancel) janet_assert(!pthread_cancel(to.worker), "pthread_cancel");
#endif
void *res = NULL;
janet_assert(!pthread_join(to.worker, &res), "pthread_join");
#endif
}
/* Common deinit code */ /* Common deinit code */
void janet_ev_deinit_common(void) { void janet_ev_deinit_common(void) {
JanetTimeout to;
while (peek_timeout(&to)) {
handle_timeout_worker(to, 1);
pop_timeout(0);
}
janet_q_deinit(&janet_vm.spawn); janet_q_deinit(&janet_vm.spawn);
janet_free(janet_vm.tq); janet_free(janet_vm.tq);
janet_table_deinit(&janet_vm.threaded_abstracts); janet_table_deinit(&janet_vm.threaded_abstracts);
@@ -686,6 +648,19 @@ void janet_addtimeout_nil(double sec) {
add_timeout(to); add_timeout(to);
} }
#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);
}
}
#endif
static void janet_timeout_cb(JanetEVGenericMessage msg) { static void janet_timeout_cb(JanetEVGenericMessage msg) {
(void) msg; (void) msg;
janet_interpreter_interrupt_handled(&janet_vm); janet_interpreter_interrupt_handled(&janet_vm);
@@ -695,16 +670,8 @@ static void janet_timeout_cb(JanetEVGenericMessage msg) {
static DWORD WINAPI janet_timeout_body(LPVOID ptr) { static DWORD WINAPI janet_timeout_body(LPVOID ptr) {
JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr; JanetThreadedTimeout tto = *(JanetThreadedTimeout *)ptr;
janet_free(ptr); janet_free(ptr);
JanetTimestamp wait_begin = ts_now(); SleepEx((DWORD)(tto.sec * 1000), TRUE);
DWORD duration = (DWORD)round(tto.sec * 1000); if (janet_fiber_can_resume(tto.fiber)) {
DWORD res = WAIT_TIMEOUT;
JanetTimestamp wait_end = ts_now();
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); janet_interpreter_interrupt(tto.vm);
JanetEVGenericMessage msg = {0}; JanetEVGenericMessage msg = {0};
janet_ev_post_event(tto.vm, janet_timeout_cb, msg); janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
@@ -729,9 +696,11 @@ static void *janet_timeout_body(void *ptr) {
? (long)((tto.sec - ((uint32_t)tto.sec)) * 1000000000) ? (long)((tto.sec - ((uint32_t)tto.sec)) * 1000000000)
: 0; : 0;
nanosleep(&ts, &ts); nanosleep(&ts, &ts);
janet_interpreter_interrupt(tto.vm); if (janet_fiber_can_resume(tto.fiber)) {
JanetEVGenericMessage msg = {0}; janet_interpreter_interrupt(tto.vm);
janet_ev_post_event(tto.vm, janet_timeout_cb, msg); JanetEVGenericMessage msg = {0};
janet_ev_post_event(tto.vm, janet_timeout_cb, msg);
}
return NULL; return NULL;
} }
#endif #endif
@@ -851,34 +820,6 @@ static int janet_chanat_gc(void *p, size_t s) {
return 0; return 0;
} }
static void janet_chanat_remove_vmref(JanetQueue *fq) {
JanetChannelPending *pending = fq->data;
if (fq->head <= fq->tail) {
for (int32_t i = fq->head; i < fq->tail; i++) {
if (pending[i].thread == &janet_vm) pending[i].thread = NULL;
}
} else {
for (int32_t i = fq->head; i < fq->capacity; i++) {
if (pending[i].thread == &janet_vm) pending[i].thread = NULL;
}
for (int32_t i = 0; i < fq->tail; i++) {
if (pending[i].thread == &janet_vm) pending[i].thread = NULL;
}
}
}
static int janet_chanat_gcperthread(void *p, size_t s) {
(void) s;
JanetChannel *chan = p;
janet_chan_lock(chan);
/* Make sure that the internals of the threaded channel no longer reference _this_ thread. Replace
* those references with NULL. */
janet_chanat_remove_vmref(&chan->read_pending);
janet_chanat_remove_vmref(&chan->write_pending);
janet_chan_unlock(chan);
return 0;
}
static void janet_chanat_mark_fq(JanetQueue *fq) { static void janet_chanat_mark_fq(JanetQueue *fq) {
JanetChannelPending *pending = fq->data; JanetChannelPending *pending = fq->data;
if (fq->head <= fq->tail) { if (fq->head <= fq->tail) {
@@ -961,9 +902,8 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ); int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ);
if (is_read) { if (is_read) {
JanetChannelPending reader; JanetChannelPending reader;
while (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) { if (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
JanetVM *vm = reader.thread; JanetVM *vm = reader.thread;
if (!vm) continue;
JanetEVGenericMessage msg; JanetEVGenericMessage msg;
msg.tag = reader.mode; msg.tag = reader.mode;
msg.fiber = reader.fiber; msg.fiber = reader.fiber;
@@ -971,13 +911,11 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
msg.argp = channel; msg.argp = channel;
msg.argj = x; msg.argj = x;
janet_ev_post_event(vm, janet_thread_chan_cb, msg); janet_ev_post_event(vm, janet_thread_chan_cb, msg);
break;
} }
} else { } else {
JanetChannelPending writer; JanetChannelPending writer;
while (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) { if (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
JanetVM *vm = writer.thread; JanetVM *vm = writer.thread;
if (!vm) continue;
JanetEVGenericMessage msg; JanetEVGenericMessage msg;
msg.tag = writer.mode; msg.tag = writer.mode;
msg.fiber = writer.fiber; msg.fiber = writer.fiber;
@@ -985,7 +923,6 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
msg.argp = channel; msg.argp = channel;
msg.argj = janet_wrap_nil(); msg.argj = janet_wrap_nil();
janet_ev_post_event(vm, janet_thread_chan_cb, msg); janet_ev_post_event(vm, janet_thread_chan_cb, msg);
break;
} }
} }
} }
@@ -1049,9 +986,7 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
msg.argi = (int32_t) reader.sched_id; msg.argi = (int32_t) reader.sched_id;
msg.argp = channel; msg.argp = channel;
msg.argj = x; msg.argj = x;
if (vm) { janet_ev_post_event(vm, janet_thread_chan_cb, msg);
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else { } else {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) { if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
janet_schedule(reader.fiber, make_read_result(channel, x)); janet_schedule(reader.fiber, make_read_result(channel, x));
@@ -1106,9 +1041,7 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i
msg.argi = (int32_t) writer.sched_id; msg.argi = (int32_t) writer.sched_id;
msg.argp = channel; msg.argp = channel;
msg.argj = janet_wrap_nil(); msg.argj = janet_wrap_nil();
if (vm) { janet_ev_post_event(vm, janet_thread_chan_cb, msg);
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else { } else {
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) { if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
janet_schedule(writer.fiber, make_write_result(channel)); janet_schedule(writer.fiber, make_write_result(channel));
@@ -1372,9 +1305,7 @@ JANET_CORE_FN(cfun_channel_close,
msg.tag = JANET_CP_MODE_CLOSE; msg.tag = JANET_CP_MODE_CLOSE;
msg.argi = (int32_t) writer.sched_id; msg.argi = (int32_t) writer.sched_id;
msg.argj = janet_wrap_nil(); msg.argj = janet_wrap_nil();
if (vm) { janet_ev_post_event(vm, janet_thread_chan_cb, msg);
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else { } else {
if (janet_fiber_can_resume(writer.fiber)) { if (janet_fiber_can_resume(writer.fiber)) {
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) { if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
@@ -1395,9 +1326,7 @@ JANET_CORE_FN(cfun_channel_close,
msg.tag = JANET_CP_MODE_CLOSE; msg.tag = JANET_CP_MODE_CLOSE;
msg.argi = (int32_t) reader.sched_id; msg.argi = (int32_t) reader.sched_id;
msg.argj = janet_wrap_nil(); msg.argj = janet_wrap_nil();
if (vm) { janet_ev_post_event(vm, janet_thread_chan_cb, msg);
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else { } else {
if (janet_fiber_can_resume(reader.fiber)) { if (janet_fiber_can_resume(reader.fiber)) {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) { if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
@@ -1490,10 +1419,7 @@ const JanetAbstractType janet_channel_type = {
NULL, /* compare */ NULL, /* compare */
NULL, /* hash */ NULL, /* hash */
janet_chanat_next, janet_chanat_next,
NULL, /* call */ JANET_ATEND_NEXT
NULL, /* length */
NULL, /* bytes */
janet_chanat_gcperthread
}; };
/* Main event loop */ /* Main event loop */
@@ -1526,7 +1452,6 @@ JanetFiber *janet_loop1(void) {
} }
} }
} }
handle_timeout_worker(to, 0);
} }
/* Run scheduled fibers unless interrupts need to be handled. */ /* Run scheduled fibers unless interrupts need to be handled. */
@@ -1574,14 +1499,27 @@ JanetFiber *janet_loop1(void) {
while ((has_timeout = peek_timeout(&to))) { while ((has_timeout = peek_timeout(&to))) {
if (to.curr_fiber != NULL) { if (to.curr_fiber != NULL) {
if (!janet_fiber_can_resume(to.curr_fiber)) { if (!janet_fiber_can_resume(to.curr_fiber)) {
pop_timeout(0); if (to.has_worker) {
#ifdef JANET_WINDOWS
QueueUserAPC(janet_timeout_stop, to.worker, 0);
WaitForSingleObject(to.worker, INFINITE);
CloseHandle(to.worker);
#else
#ifdef JANET_ANDROID
pthread_kill(to.worker, SIGUSR1);
#else
pthread_cancel(to.worker);
#endif
void *res;
pthread_join(to.worker, &res);
#endif
}
janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(to.curr_fiber)); janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(to.curr_fiber));
handle_timeout_worker(to, 1); pop_timeout(0);
continue; continue;
} }
} else if (to.fiber->sched_id != to.sched_id) { } else if (to.fiber->sched_id != to.sched_id) {
pop_timeout(0); pop_timeout(0);
handle_timeout_worker(to, 1);
continue; continue;
} }
break; break;
@@ -1746,7 +1684,7 @@ void janet_stream_level_triggered(JanetStream *stream) {
static JanetTimestamp ts_now(void) { static JanetTimestamp ts_now(void) {
struct timespec now; struct timespec now;
janet_assert(-1 != janet_gettime(&now, JANET_TIME_MONOTONIC), "failed to get time"); janet_assert(-1 != clock_gettime(CLOCK_MONOTONIC, &now), "failed to get time");
uint64_t res = 1000 * now.tv_sec; uint64_t res = 1000 * now.tv_sec;
res += now.tv_nsec / 1000000; res += now.tv_nsec / 1000000;
return res; return res;
@@ -1904,7 +1842,7 @@ JanetTimestamp to_interval(const JanetTimestamp ts) {
static JanetTimestamp ts_now(void) { static JanetTimestamp ts_now(void) {
struct timespec now; struct timespec now;
janet_assert(-1 != janet_gettime(&now, JANET_TIME_MONOTONIC), "failed to get time"); janet_assert(-1 != clock_gettime(CLOCK_MONOTONIC, &now), "failed to get time");
uint64_t res = 1000 * now.tv_sec; uint64_t res = 1000 * now.tv_sec;
res += now.tv_nsec / 1000000; res += now.tv_nsec / 1000000;
return res; return res;
@@ -2058,7 +1996,7 @@ void janet_ev_deinit(void) {
static JanetTimestamp ts_now(void) { static JanetTimestamp ts_now(void) {
struct timespec now; struct timespec now;
janet_assert(-1 != janet_gettime(&now, JANET_TIME_MONOTONIC), "failed to get time"); janet_assert(-1 != clock_gettime(CLOCK_REALTIME, &now), "failed to get time");
uint64_t res = 1000 * now.tv_sec; uint64_t res = 1000 * now.tv_sec;
res += now.tv_nsec / 1000000; res += now.tv_nsec / 1000000;
return res; return res;
@@ -2230,7 +2168,7 @@ void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGenericMessage ms
event.cb = cb; event.cb = cb;
int fd = vm->selfpipe[1]; int fd = vm->selfpipe[1];
/* handle a bit of back pressure before giving up. */ /* handle a bit of back pressure before giving up. */
int tries = 20; int tries = 4;
while (tries > 0) { while (tries > 0) {
int status; int status;
do { do {
@@ -3236,7 +3174,6 @@ JANET_NO_RETURN void janet_sleep_await(double sec) {
to.is_error = 0; to.is_error = 0;
to.sched_id = to.fiber->sched_id; to.sched_id = to.fiber->sched_id;
to.curr_fiber = NULL; to.curr_fiber = NULL;
to.has_worker = 0;
add_timeout(to); add_timeout(to);
janet_await(); janet_await();
} }
@@ -3282,13 +3219,7 @@ JANET_CORE_FN(cfun_ev_deadline,
tto->vm = &janet_vm; tto->vm = &janet_vm;
tto->fiber = tocheck; tto->fiber = tocheck;
#ifdef JANET_WINDOWS #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) { if (NULL == worker) {
janet_free(tto); janet_free(tto);
janet_panic("failed to create thread"); janet_panic("failed to create thread");
@@ -3300,13 +3231,10 @@ JANET_CORE_FN(cfun_ev_deadline,
janet_free(tto); janet_free(tto);
janet_panicf("%s", janet_strerror(err)); janet_panicf("%s", janet_strerror(err));
} }
janet_assert(!pthread_detach(worker), "pthread_detach");
#endif #endif
to.has_worker = 1; to.has_worker = 1;
to.worker = worker; to.worker = worker;
#ifdef JANET_WINDOWS
to.worker_event = cancel_event;
ResumeThread(worker);
#endif
} else { } else {
to.has_worker = 0; to.has_worker = 0;
} }
@@ -3601,6 +3529,8 @@ void janet_lib_ev(JanetTable *env) {
janet_register_abstract_type(&janet_channel_type); janet_register_abstract_type(&janet_channel_type);
janet_register_abstract_type(&janet_mutex_type); janet_register_abstract_type(&janet_mutex_type);
janet_register_abstract_type(&janet_rwlock_type); janet_register_abstract_type(&janet_rwlock_type);
janet_lib_filewatch(env);
} }
#endif #endif

View File

@@ -633,7 +633,7 @@ JANET_CORE_FN(cfun_filewatch_add,
"* `:modified`\n\n" "* `:modified`\n\n"
"* `:renamed-old`\n\n" "* `:renamed-old`\n\n"
"* `:renamed-new`\n\n" "* `:renamed-new`\n\n"
"On Linux, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n" "On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n"
"") { "") {
janet_arity(argc, 2, -1); janet_arity(argc, 2, -1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);

View File

@@ -346,9 +346,6 @@ static void janet_deinit_block(JanetGCObject *mem) {
break; break;
case JANET_MEMORY_ABSTRACT: { case JANET_MEMORY_ABSTRACT: {
JanetAbstractHead *head = (JanetAbstractHead *)mem; JanetAbstractHead *head = (JanetAbstractHead *)mem;
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
if (head->type->gc) { if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
} }
@@ -500,12 +497,9 @@ void janet_sweep() {
/* If not visited... */ /* If not visited... */
if (!janet_truthy(items[i].value)) { if (!janet_truthy(items[i].value)) {
void *abst = janet_unwrap_abstract(items[i].key); void *abst = janet_unwrap_abstract(items[i].key);
JanetAbstractHead *head = janet_abstract_head(abst);
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
if (0 == janet_abstract_decref(abst)) { if (0 == janet_abstract_decref(abst)) {
/* Run finalizer */ /* Run finalizer */
JanetAbstractHead *head = janet_abstract_head(abst);
if (head->type->gc) { if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
} }
@@ -678,11 +672,8 @@ void janet_clear_memory(void) {
for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) { for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
if (janet_checktype(items[i].key, JANET_ABSTRACT)) { if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
void *abst = janet_unwrap_abstract(items[i].key); void *abst = janet_unwrap_abstract(items[i].key);
JanetAbstractHead *head = janet_abstract_head(abst);
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
if (0 == janet_abstract_decref(abst)) { if (0 == janet_abstract_decref(abst)) {
JanetAbstractHead *head = janet_abstract_head(abst);
if (head->type->gc) { if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed"); janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
} }

View File

@@ -341,7 +341,7 @@ static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
/* Needs argc >= offset + 2 */ /* Needs argc >= offset + 2 */
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1, /* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1,
* otherwise 0. Also, ignores is_bind when is a unix socket. */ * otherwise 0. Also, ignores is_bind when is a unix socket. */
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix, socklen_t *sizeout) { static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) {
/* Unix socket support - not yet supported on windows. */ /* Unix socket support - not yet supported on windows. */
#ifndef JANET_WINDOWS #ifndef JANET_WINDOWS
if (janet_keyeq(argv[offset], "unix")) { if (janet_keyeq(argv[offset], "unix")) {
@@ -352,14 +352,15 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
} }
saddr->sun_family = AF_UNIX; saddr->sun_family = AF_UNIX;
size_t path_size = sizeof(saddr->sun_path); size_t path_size = sizeof(saddr->sun_path);
snprintf(saddr->sun_path, path_size, "%s", path);
*sizeout = sizeof(struct sockaddr_un);
#ifdef JANET_LINUX #ifdef JANET_LINUX
if (path[0] == '@') { if (path[0] == '@') {
saddr->sun_path[0] = '\0'; saddr->sun_path[0] = '\0';
*sizeout = offsetof(struct sockaddr_un, sun_path) + janet_string_length(path); snprintf(saddr->sun_path + 1, path_size - 1, "%s", path + 1);
} } else
#endif #endif
{
snprintf(saddr->sun_path, path_size, "%s", path);
}
*is_unix = 1; *is_unix = 1;
return (struct addrinfo *) saddr; return (struct addrinfo *) saddr;
} }
@@ -384,11 +385,6 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
janet_panicf("could not get address info: %s", gai_strerror(status)); janet_panicf("could not get address info: %s", gai_strerror(status));
} }
*is_unix = 0; *is_unix = 0;
#ifdef JANET_WINDOWS
*sizeout = 0;
#else
*sizeout = sizeof(struct sockaddr_un);
#endif
return ai; return ai;
} }
@@ -409,13 +405,12 @@ JANET_CORE_FN(cfun_net_sockaddr,
int socktype = janet_get_sockettype(argv, argc, 2); int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0; int is_unix = 0;
int make_arr = (argc >= 3 && janet_truthy(argv[3])); int make_arr = (argc >= 3 && janet_truthy(argv[3]));
socklen_t addrsize = 0; struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix, &addrsize);
#ifndef JANET_WINDOWS #ifndef JANET_WINDOWS
/* no unix domain socket support on windows yet */ /* no unix domain socket support on windows yet */
if (is_unix) { if (is_unix) {
void *abst = janet_abstract(&janet_address_type, addrsize); void *abst = janet_abstract(&janet_address_type, sizeof(struct sockaddr_un));
memcpy(abst, ai, addrsize); memcpy(abst, ai, sizeof(struct sockaddr_un));
Janet ret = janet_wrap_abstract(abst); Janet ret = janet_wrap_abstract(abst);
return make_arr ? janet_wrap_array(janet_array_n(&ret, 1)) : ret; return make_arr ? janet_wrap_array(janet_array_n(&ret, 1)) : ret;
} }
@@ -466,8 +461,7 @@ JANET_CORE_FN(cfun_net_connect,
} }
/* Where we're connecting to */ /* Where we're connecting to */
socklen_t addrlen = 0; struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix, &addrlen);
/* Check if we're binding address */ /* Check if we're binding address */
struct addrinfo *binding = NULL; struct addrinfo *binding = NULL;
@@ -492,6 +486,7 @@ JANET_CORE_FN(cfun_net_connect,
/* Create socket */ /* Create socket */
JSock sock = JSOCKDEFAULT; JSock sock = JSOCKDEFAULT;
void *addr = NULL; void *addr = NULL;
socklen_t addrlen = 0;
#ifndef JANET_WINDOWS #ifndef JANET_WINDOWS
if (is_unix) { if (is_unix) {
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0); sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
@@ -501,6 +496,7 @@ JANET_CORE_FN(cfun_net_connect,
janet_panicf("could not create socket: %V", v); janet_panicf("could not create socket: %V", v);
} }
addr = (void *) ai; addr = (void *) ai;
addrlen = sizeof(struct sockaddr_un);
} else } else
#endif #endif
{ {
@@ -547,9 +543,7 @@ JANET_CORE_FN(cfun_net_connect,
} }
/* Wrap socket in abstract type JanetStream */ /* Wrap socket in abstract type JanetStream */
uint32_t udp_flag = 0; JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
if (socktype == SOCK_DGRAM) udp_flag = JANET_STREAM_UDPSERVER;
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | udp_flag);
/* Set up the socket for non-blocking IO before connecting */ /* Set up the socket for non-blocking IO before connecting */
janet_net_socknoblock(sock); janet_net_socknoblock(sock);
@@ -587,56 +581,6 @@ JANET_CORE_FN(cfun_net_connect,
net_sched_connect(stream); net_sched_connect(stream);
} }
JANET_CORE_FN(cfun_net_socket,
"(net/socket &opt type)",
"Creates a new unbound socket. Type is an optional keyword, "
"either a :stream (usually tcp), or :datagram (usually udp). The default is :stream.") {
janet_arity(argc, 0, 1);
int socktype = janet_get_sockettype(argv, argc, 0);
/* Create socket */
JSock sfd = JSOCKDEFAULT;
struct addrinfo *ai = NULL;
struct addrinfo hints;
memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_UNSPEC;
hints.ai_socktype = socktype;
hints.ai_flags = 0;
int status = getaddrinfo(NULL, "0", &hints, &ai);
if (status) {
janet_panicf("could not get address info: %s", gai_strerror(status));
}
struct addrinfo *rp = NULL;
for (rp = ai; rp != NULL; rp = rp->ai_next) {
#ifdef JANET_WINDOWS
sfd = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
#else
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
#endif
if (JSOCKVALID(sfd)) {
break;
}
}
freeaddrinfo(ai);
if (!JSOCKVALID(sfd)) {
Janet v = janet_ev_lasterr();
janet_panicf("could not create socket: %V", v);
}
/* Wrap socket in abstract type JanetStream */
uint32_t udp_flag = 0;
if (socktype == SOCK_DGRAM) udp_flag = JANET_STREAM_UDPSERVER;
JanetStream *stream = make_stream(sfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | udp_flag);
/* Set up the socket for non-blocking IO */
janet_net_socknoblock(sfd);
return janet_wrap_abstract(stream);
}
static const char *serverify_socket(JSock sfd, int reuse_addr, int reuse_port) { static const char *serverify_socket(JSock sfd, int reuse_addr, int reuse_port) {
/* Set various socket options */ /* Set various socket options */
int enable = 1; int enable = 1;
@@ -720,8 +664,7 @@ JANET_CORE_FN(cfun_net_listen,
/* Get host, port, and handler*/ /* Get host, port, and handler*/
int socktype = janet_get_sockettype(argv, argc, 2); int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0; int is_unix = 0;
socklen_t addrlen = 0; struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix);
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix, &addrlen);
int reuse = !(argc >= 4 && janet_truthy(argv[3])); int reuse = !(argc >= 4 && janet_truthy(argv[3]));
JSock sfd = JSOCKDEFAULT; JSock sfd = JSOCKDEFAULT;
@@ -733,7 +676,7 @@ JANET_CORE_FN(cfun_net_listen,
janet_panicf("could not create socket: %V", janet_ev_lasterr()); janet_panicf("could not create socket: %V", janet_ev_lasterr());
} }
const char *err = serverify_socket(sfd, reuse, 0); const char *err = serverify_socket(sfd, reuse, 0);
if (NULL != err || bind(sfd, (struct sockaddr *)ai, addrlen)) { if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
JSOCKCLOSE(sfd); JSOCKCLOSE(sfd);
janet_free(ai); janet_free(ai);
if (err) { if (err) {
@@ -1135,7 +1078,6 @@ void janet_lib_net(JanetTable *env) {
JanetRegExt net_cfuns[] = { JanetRegExt net_cfuns[] = {
JANET_CORE_REG("net/address", cfun_net_sockaddr), JANET_CORE_REG("net/address", cfun_net_sockaddr),
JANET_CORE_REG("net/listen", cfun_net_listen), JANET_CORE_REG("net/listen", cfun_net_listen),
JANET_CORE_REG("net/socket", cfun_net_socket),
JANET_CORE_REG("net/accept", cfun_stream_accept), JANET_CORE_REG("net/accept", cfun_stream_accept),
JANET_CORE_REG("net/accept-loop", cfun_stream_accept_loop), JANET_CORE_REG("net/accept-loop", cfun_stream_accept_loop),
JANET_CORE_REG("net/read", cfun_stream_read), JANET_CORE_REG("net/read", cfun_stream_read),

View File

@@ -66,8 +66,6 @@
#ifdef JANET_APPLE #ifdef JANET_APPLE
#include <crt_externs.h> #include <crt_externs.h>
#define environ (*_NSGetEnviron()) #define environ (*_NSGetEnviron())
#include <AvailabilityMacros.h>
int chroot(const char *dirname);
#else #else
extern char **environ; extern char **environ;
#endif #endif
@@ -83,14 +81,8 @@ extern char **environ;
#ifndef JANET_SPAWN_NO_CHDIR #ifndef JANET_SPAWN_NO_CHDIR
#ifdef __GLIBC__ #ifdef __GLIBC__
#define JANET_SPAWN_CHDIR #define JANET_SPAWN_CHDIR
#elif defined(JANET_APPLE) #elif defined(JANET_APPLE) /* Some older versions may not work here. */
/* The posix_spawn_file_actions_addchdir_np function
* has only been implemented since macOS 10.15 */
#if defined(MAC_OS_X_VERSION_10_15) && (MAC_OS_X_VERSION_MIN_REQUIRED >= MAC_OS_X_VERSION_10_15)
#define JANET_SPAWN_CHDIR #define JANET_SPAWN_CHDIR
#else
#define JANET_SPAWN_NO_CHDIR
#endif
#elif defined(__FreeBSD__) /* Not all BSDs work, for example openBSD doesn't seem to support this */ #elif defined(__FreeBSD__) /* Not all BSDs work, for example openBSD doesn't seem to support this */
#define JANET_SPAWN_CHDIR #define JANET_SPAWN_CHDIR
#endif #endif
@@ -181,8 +173,6 @@ JANET_CORE_FN(os_which,
return janet_ckeywordv("dragonfly"); return janet_ckeywordv("dragonfly");
#elif defined(JANET_BSD) #elif defined(JANET_BSD)
return janet_ckeywordv("bsd"); return janet_ckeywordv("bsd");
#elif defined(JANET_ILLUMOS)
return janet_ckeywordv("illumos");
#else #else
return janet_ckeywordv("posix"); return janet_ckeywordv("posix");
#endif #endif
@@ -322,13 +312,6 @@ JANET_CORE_FN(os_cpu_count,
return dflt; return dflt;
} }
return janet_wrap_integer(result); return janet_wrap_integer(result);
#elif defined(JANET_ILLUMOS)
(void) dflt;
long result = sysconf(_SC_NPROCESSORS_CONF);
if (result < 0) {
return dflt;
}
return janet_wrap_integer(result);
#else #else
return dflt; return dflt;
#endif #endif
@@ -1542,28 +1525,6 @@ JANET_CORE_FN(os_posix_fork,
#endif #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 #ifdef JANET_EV
/* Runs in a separate thread */ /* Runs in a separate thread */
static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) { static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
@@ -2896,16 +2857,12 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/shell", os_shell), JANET_CORE_REG("os/shell", os_shell),
JANET_CORE_REG("os/posix-fork", os_posix_fork), JANET_CORE_REG("os/posix-fork", os_posix_fork),
JANET_CORE_REG("os/posix-exec", os_posix_exec), JANET_CORE_REG("os/posix-exec", os_posix_exec),
JANET_CORE_REG("os/posix-chroot", os_posix_chroot),
/* no need to sandbox process management if you can't create processes /* no need to sandbox process management if you can't create processes
* (allows for limited functionality if use exposes C-functions to create specific processes) */ * (allows for limited functionality if use exposes C-functions to create specific processes) */
JANET_CORE_REG("os/proc-wait", os_proc_wait), JANET_CORE_REG("os/proc-wait", os_proc_wait),
JANET_CORE_REG("os/proc-kill", os_proc_kill), JANET_CORE_REG("os/proc-kill", os_proc_kill),
JANET_CORE_REG("os/proc-close", os_proc_close), JANET_CORE_REG("os/proc-close", os_proc_close),
JANET_CORE_REG("os/getpid", os_proc_getpid), JANET_CORE_REG("os/getpid", os_proc_getpid),
#ifdef JANET_EV
JANET_CORE_REG("os/sigaction", os_sigaction),
#endif
#endif #endif
/* high resolution timers */ /* high resolution timers */
@@ -2914,6 +2871,7 @@ void janet_lib_os(JanetTable *env) {
#ifdef JANET_EV #ifdef JANET_EV
JANET_CORE_REG("os/open", os_open), /* fs read and write */ JANET_CORE_REG("os/open", os_open), /* fs read and write */
JANET_CORE_REG("os/pipe", os_pipe), JANET_CORE_REG("os/pipe", os_pipe),
JANET_CORE_REG("os/sigaction", os_sigaction),
#endif #endif
#endif #endif
JANET_REG_END JANET_REG_END

View File

@@ -1060,11 +1060,19 @@ void janet_buffer_format(
break; break;
} }
case 's': { case 's': {
const char *s = janet_getcbytes(argv, arg); JanetByteView bytes = janet_getbytes(argv, arg);
const uint8_t *s = bytes.bytes;
int32_t l = bytes.len;
if (form[2] == '\0') if (form[2] == '\0')
janet_buffer_push_cstring(b, s); janet_buffer_push_bytes(b, s, l);
else { else {
nb = snprintf(item, MAX_ITEM, form, s); if (l != (int32_t) strlen((const char *) s))
janet_panic("string contains zeros");
if (!strchr(form, '.') && l >= 100) {
janet_panic("no precision and string is too long to be formatted");
} else {
nb = snprintf(item, MAX_ITEM, form, s);
}
} }
break; break;
} }

View File

@@ -26,8 +26,7 @@
#include "state.h" #include "state.h"
#endif #endif
/* Run a string of code. The return value is a set of error flags, JANET_DO_ERROR_RUNTIME, JANET_DO_ERROR_COMPILE, and JANET_DOR_ERROR_PARSE if /* Run a string */
* any errors were encountered in those phases. More information is printed to stderr. */
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) { int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
JanetParser *parser; JanetParser *parser;
int errflags = 0, done = 0; int errflags = 0, done = 0;
@@ -56,10 +55,11 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret); JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) { if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
janet_stacktrace_ext(fiber, ret, ""); janet_stacktrace_ext(fiber, ret, "");
errflags |= JANET_DO_ERROR_RUNTIME; errflags |= 0x01;
done = 1; done = 1;
} }
} else { } else {
ret = janet_wrap_string(cres.error);
int32_t line = (int32_t) parser->line; int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column; int32_t col = (int32_t) parser->column;
if ((cres.error_mapping.line > 0) && if ((cres.error_mapping.line > 0) &&
@@ -67,19 +67,15 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
line = cres.error_mapping.line; line = cres.error_mapping.line;
col = cres.error_mapping.column; 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) { 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, ""); janet_stacktrace_ext(cres.macrofiber, ret, "");
} else { } 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; errflags |= 0x02;
done = 1; done = 1;
} }
} }
@@ -92,14 +88,12 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
done = 1; done = 1;
break; break;
case JANET_PARSE_ERROR: { case JANET_PARSE_ERROR: {
errflags |= JANET_DO_ERROR_PARSE; const char *e = janet_parser_error(parser);
errflags |= 0x04;
ret = janet_cstringv(e);
int32_t line = (int32_t) parser->line; int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column; 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; done = 1;
break; break;
} }
@@ -127,8 +121,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
janet_loop(); janet_loop();
if (fiber) { if (fiber) {
janet_gcunroot(janet_wrap_fiber(fiber)); janet_gcunroot(janet_wrap_fiber(fiber));
if (!errflags) ret = fiber->last_value;
ret = fiber->last_value;
} }
} }
#endif #endif

View File

@@ -23,11 +23,8 @@
#ifndef JANET_STATE_H_defined #ifndef JANET_STATE_H_defined
#define JANET_STATE_H_defined #define JANET_STATE_H_defined
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h> #include <janet.h>
#include <stdint.h> #include <stdint.h>
#endif
#ifdef JANET_EV #ifdef JANET_EV
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
@@ -68,7 +65,6 @@ typedef struct {
int has_worker; int has_worker;
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
HANDLE worker; HANDLE worker;
HANDLE worker_event;
#else #else
pthread_t worker; pthread_t worker;
#endif #endif

View File

@@ -931,24 +931,27 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
#include <mach/clock.h> #include <mach/clock.h>
#include <mach/mach.h> #include <mach/mach.h>
int janet_gettime(struct timespec *spec, enum JanetTimeSource source) { int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
if (source == JANET_TIME_CPUTIME) { if (source == JANET_TIME_REALTIME) {
clock_t tmp = clock();
spec->tv_sec = tmp / CLOCKS_PER_SEC;
spec->tv_nsec = ((tmp - (spec->tv_sec * CLOCKS_PER_SEC)) * 1000000000) / CLOCKS_PER_SEC;
} else {
clock_serv_t cclock; clock_serv_t cclock;
mach_timespec_t mts; mach_timespec_t mts;
clock_id_t cid = CALENDAR_CLOCK; host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
if (source == JANET_TIME_REALTIME) {
cid = CALENDAR_CLOCK;
} else if (source == JANET_TIME_MONOTONIC) {
cid = SYSTEM_CLOCK;
}
host_get_clock_service(mach_host_self(), cid, &cclock);
clock_get_time(cclock, &mts); clock_get_time(cclock, &mts);
mach_port_deallocate(mach_task_self(), cclock); mach_port_deallocate(mach_task_self(), cclock);
spec->tv_sec = mts.tv_sec; spec->tv_sec = mts.tv_sec;
spec->tv_nsec = mts.tv_nsec; spec->tv_nsec = mts.tv_nsec;
} else if (source == JANET_TIME_MONOTONIC) {
clock_serv_t cclock;
int nsecs;
mach_msg_type_number_t count;
host_get_clock_service(mach_host_self(), clock, &cclock);
clock_get_attributes(cclock, CLOCK_GET_TIME_RES, (clock_attr_t)&nsecs, &count);
mach_port_deallocate(mach_task_self(), cclock);
clock_getres(CLOCK_MONOTONIC, spec);
}
if (source == JANET_TIME_CPUTIME) {
clock_t tmp = clock();
spec->tv_sec = tmp;
spec->tv_nsec = (tmp - spec->tv_sec) * 1.0e9;
} }
return 0; return 0;
} }

View File

@@ -322,8 +322,7 @@ int32_t janet_hash(Janet x) {
break; break;
case JANET_TUPLE: case JANET_TUPLE:
hash = janet_tuple_hash(janet_unwrap_tuple(x)); hash = janet_tuple_hash(janet_unwrap_tuple(x));
uint32_t inc = (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0; hash += (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
hash = (int32_t)((uint32_t)hash + inc); /* avoid overflow undefined behavior */
break; break;
case JANET_STRUCT: case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x)); hash = janet_struct_hash(janet_unwrap_struct(x));

View File

@@ -77,11 +77,6 @@ extern "C" {
#define JANET_CYGWIN 1 #define JANET_CYGWIN 1
#endif #endif
/* Check for Illumos */
#if defined(__illumos__)
#define JANET_ILLUMOS 1
#endif
/* Check Unix */ /* Check Unix */
#if defined(_AIX) \ #if defined(_AIX) \
|| defined(__APPLE__) /* Darwin */ \ || defined(__APPLE__) /* Darwin */ \
@@ -147,7 +142,6 @@ extern "C" {
|| defined(__s390x__) /* S390 64-bit */ \ || defined(__s390x__) /* S390 64-bit */ \
|| defined(__s390__) /* S390 32-bit */ \ || defined(__s390__) /* S390 32-bit */ \
|| defined(__ARMEB__) /* ARM big endian */ \ || defined(__ARMEB__) /* ARM big endian */ \
|| defined(__AARCH64EB__) /* ARM64 big endian */ \
|| ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \ || ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \
&& defined(__BIG_ENDIAN)) && defined(__BIG_ENDIAN))
#define JANET_BIG_ENDIAN 1 #define JANET_BIG_ENDIAN 1
@@ -168,7 +162,7 @@ extern "C" {
#endif #endif
/* Check sun */ /* Check sun */
#if defined(__sun) && !defined(JANET_ILLUMOS) #ifdef __sun
#define JANET_NO_UTC_MKTIME #define JANET_NO_UTC_MKTIME
#endif #endif
@@ -1189,7 +1183,6 @@ struct JanetAbstractType {
Janet(*call)(void *p, int32_t argc, Janet *argv); Janet(*call)(void *p, int32_t argc, Janet *argv);
size_t (*length)(void *p, size_t len); size_t (*length)(void *p, size_t len);
JanetByteView(*bytes)(void *p, size_t len); JanetByteView(*bytes)(void *p, size_t len);
int (*gcperthread)(void *data, size_t len);
}; };
/* Some macros to let us add extra types to JanetAbstract types without /* Some macros to let us add extra types to JanetAbstract types without
@@ -1209,8 +1202,7 @@ struct JanetAbstractType {
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL #define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
#define JANET_ATEND_CALL NULL,JANET_ATEND_LENGTH #define JANET_ATEND_CALL NULL,JANET_ATEND_LENGTH
#define JANET_ATEND_LENGTH NULL,JANET_ATEND_BYTES #define JANET_ATEND_LENGTH NULL,JANET_ATEND_BYTES
#define JANET_ATEND_BYTES NULL,JANET_ATEND_GCPERTHREAD #define JANET_ATEND_BYTES
#define JANET_ATEND_GCPERTHREAD
struct JanetReg { struct JanetReg {
const char *name; const char *name;
@@ -1468,10 +1460,10 @@ JANET_API int32_t janet_abstract_incref(void *abst);
JANET_API int32_t janet_abstract_decref(void *abst); JANET_API int32_t janet_abstract_decref(void *abst);
/* Expose channel utilities */ /* Expose channel utilities */
JANET_API JanetChannel *janet_channel_make(uint32_t limit); JanetChannel *janet_channel_make(uint32_t limit);
JANET_API JanetChannel *janet_channel_make_threaded(uint32_t limit); JanetChannel *janet_channel_make_threaded(uint32_t limit);
JANET_API JanetChannel *janet_getchannel(const Janet *argv, int32_t n); JanetChannel *janet_getchannel(const Janet *argv, int32_t n);
JANET_API JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt); 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_give(JanetChannel *channel, Janet x);
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out); JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
@@ -1619,9 +1611,6 @@ JANET_API JanetTable *janet_core_env(JanetTable *replacements);
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements); JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
/* Execute strings */ /* Execute strings */
#define JANET_DO_ERROR_RUNTIME 0x01
#define JANET_DO_ERROR_COMPILE 0x02
#define JANET_DO_ERROR_PARSE 0x04
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out); JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out); JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
@@ -1900,7 +1889,6 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
#define JANET_SANDBOX_FFI_USE 2048 #define JANET_SANDBOX_FFI_USE 2048
#define JANET_SANDBOX_FFI_JIT 4096 #define JANET_SANDBOX_FFI_JIT 4096
#define JANET_SANDBOX_SIGNAL 8192 #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_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_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) #define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)

View File

@@ -50,11 +50,6 @@
(def errsym (keyword (gensym))) (def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg)) ~(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 (defn check-compile-error
[form] [form]
(def result (compile form)) (def result (compile form))

View File

@@ -865,13 +865,6 @@
(assert (deep= ~(,import* "a" :as "b" :fresh maybe) (assert (deep= ~(,import* "a" :as "b" :fresh maybe)
(macex '(import a :as b :fresh maybe))) "import macro 2") (macex '(import a :as b :fresh maybe))) "import macro 2")
# 2af3f21d
(assert-error "import macro 2" (macex '(import a :fresh)))
(assert-error "import macro 3" (macex '(import a :as b :fresh)))
(assert-error "import macro 4" (macex '(import b "notakeyword" value)))
(assert (deep= ~(,import* "a" :fresh nil)
(macex '(import a :fresh nil))) "import macro 5")
# #477 walk preserving bracket type # #477 walk preserving bracket type
# 0a1d902f4 # 0a1d902f4
(assert (= :brackets (tuple/type (postwalk identity '[]))) (assert (= :brackets (tuple/type (postwalk identity '[])))
@@ -1023,11 +1016,4 @@
(assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"} (assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"}
@{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys") @{: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) (end-suite)

View File

@@ -117,17 +117,8 @@
(assert (= 0 (length (bundle/list))) "bundles are listed correctly 7") (assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
(assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8") (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 # 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/list))) "check failure 0")
(assert (= 0 (length (bundle/topolist))) "check failure 1") (assert (= 0 (length (bundle/topolist))) "check failure 1")

View File

@@ -106,8 +106,6 @@
(calc-2 "(+ 9 10 11 12)")) (calc-2 "(+ 9 10 11 12)"))
@[10 26 42]) "parallel subprocesses 2") @[10 26 42]) "parallel subprocesses 2")
# (print "file piping")
# File piping # File piping
# a1cc5ca04 # a1cc5ca04
(assert-no-error "file writing 1" (assert-no-error "file writing 1"
@@ -227,8 +225,6 @@
(++ iterations) (++ iterations)
(ev/write stream " "))) (ev/write stream " ")))
# (print "local name / peer name testing")
# Test localname and peername # Test localname and peername
# 077bf5eba # 077bf5eba
(repeat 10 (repeat 10
@@ -411,8 +407,6 @@
(while (def msg (ev/read connection 100)) (while (def msg (ev/read connection 100))
(broadcast name (string msg))))))) (broadcast name (string msg)))))))
# (print "chat app testing")
# Now launch the chat server # Now launch the chat server
(def chat-server (net/listen test-host test-port)) (def chat-server (net/listen test-host test-port))
(ev/spawn (ev/spawn
@@ -506,8 +500,6 @@
(let [s (net/listen :unix uds-path :stream)] (let [s (net/listen :unix uds-path :stream)]
(:close s)))))) (:close s))))))
# (print "accept loop testing")
# net/accept-loop level triggering # net/accept-loop level triggering
(gccollect) (gccollect)
(def maxconn 50) (def maxconn 50)
@@ -530,8 +522,6 @@
(assert (= maxconn connect-count)) (assert (= maxconn connect-count))
(:close s) (:close s)
# (print "running deadline tests...")
# Cancel os/proc-wait with ev/deadline # Cancel os/proc-wait with ev/deadline
(let [p (os/spawn [;run janet "-e" "(os/sleep 4)"] :p)] (let [p (os/spawn [;run janet "-e" "(os/sleep 4)"] :p)]
(var terminated-normally false) (var terminated-normally false)
@@ -556,35 +546,9 @@
(ev/sleep 0.15) (ev/sleep 0.15)
(assert (not terminated-normally) "early termination failure 3")) (assert (not terminated-normally) "early termination failure 3"))
# Deadline with interrupt (let [f (coro (forever :foo))]
(defmacro with-deadline2 (ev/deadline 0.01 nil f true)
`` (assert-error "deadline expired" (resume f)))
Create a fiber to execute `body`, schedule the event loop to cancel
the task (root fiber) associated with `body`'s fiber, and start
`body`'s fiber by resuming it.
The event loop will try to cancel the root fiber if `body`'s fiber
has not completed after at least `sec` seconds.
`sec` is a number that can have a fractional part.
``
[sec & body]
(with-syms [f]
~(let [,f (coro ,;body)]
(,ev/deadline ,sec nil ,f true)
(,resume ,f))))
(for i 0 10
# (print "deadline 1 iteration " i)
(assert (= :done (with-deadline2 10
(ev/sleep 0.01)
:done)) "deadline with interrupt exits normally"))
(for i 0 10
# (print "deadline 2 iteration " i)
(let [f (coro (forever :foo))]
(ev/deadline 0.01 nil f true)
(assert-error "deadline expired" (resume f))))
# Use :err :stdout # Use :err :stdout
(def- subproc-code '(do (eprint "hi") (eflush) (print "there") (flush))) (def- subproc-code '(do (eprint "hi") (eflush) (print "there") (flush)))

View File

@@ -1,58 +0,0 @@
# Copyright (c) 2025 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)
# Issue #1629
(def thread-channel (ev/thread-chan 100))
(def super (ev/thread-chan 10))
(defn worker []
(while true
(def item (ev/take thread-channel))
(when (= item :deadline)
(ev/deadline 0.1 nil (fiber/current) true))))
(ev/thread worker nil :n super)
(ev/give thread-channel :item)
(ev/sleep 0.05)
(ev/give thread-channel :item)
(ev/sleep 0.05)
(ev/give thread-channel :deadline)
(ev/sleep 0.05)
(ev/give thread-channel :item)
(ev/sleep 0.05)
(ev/give thread-channel :item)
(ev/sleep 0.15)
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
# Another variant
(def thread-channel (ev/thread-chan 100))
(def super (ev/thread-chan 10))
(defn worker []
(while true
(def item (ev/take thread-channel))
(when (= item :deadline)
(ev/deadline 0.1))))
(ev/thread worker nil :n super)
(ev/give thread-channel :deadline)
(ev/sleep 0.2)
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
(end-suite)

View File

@@ -136,8 +136,5 @@
"keyword slice") "keyword slice")
(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice") (assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
# Check string formatting, #1600
(assert (= "" (string/format "%.99s" @"")) "string/format %s buffer")
(end-suite) (end-suite)

View File

@@ -37,12 +37,6 @@
Version="$(var.Version)" Version="$(var.Version)"
Manufacturer="$(var.Manufacturer)" Manufacturer="$(var.Manufacturer)"
UpgradeCode="$(var.UpgradeCode)"> UpgradeCode="$(var.UpgradeCode)">
<!--
perUser means destination will be under user's %AppData% directory,
not Program Files or similar.
see: https://learn.microsoft.com/en-us/windows/win32/msi/installation-context
-->
<Package Compressed="yes" <Package Compressed="yes"
InstallScope="perUser" InstallScope="perUser"
Manufacturer="$(var.Manufacturer)" Manufacturer="$(var.Manufacturer)"