mirrors/janet
1
0 Fork 0
mirror of https://github.com/janet-lang/janet synced 2026-11-09 06:34:27 +00:00
Code Issues 1 Releases Wiki Activity

Merge branch 'master' into compile-opt

Browse Source
This commit is contained in:
Calvin Rose committed 2026-08-24 20:50:02 -05:00
2 parents ead0ed5d41 cea6dd2261
commit 79ada2fdfd
136 files changed
+5248 -1700
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

.builds/freebsd.yml
+6
View File
@@ -10,3 +10,9 @@ tasks:
gmake test
sudo gmake install
sudo gmake uninstall
- build-sanitizers: |
cd janet
CFLAGS="-g -O2 -fsanitize=address,undefined" gmake
gmake test
sudo gmake install
sudo gmake uninstall
.builds/openbsd.yml
+6 -2
View File
@@ -1,4 +1,4 @@
image: openbsd/7.6
image: openbsd/7.7
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
@@ -10,13 +10,17 @@ tasks:
gmake
gmake test
doas gmake install
gmake test-install
doas gmake uninstall
- meson_min: |
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
cd build_meson_min
ninja
- meson_reduced: |
cd janet
meson setup build_meson_reduced --buildtype=release -Dreduced_os=true
cd build_meson_reduced
ninja
- meson_prf: |
cd janet
meson setup build_meson_prf --buildtype=release -Dprf=true
.github/cosmo/setup
+4 -4
View File
@@ -1,19 +1,19 @@
#!/bin/sh
set -e
sudo apt update
sudo apt-get update
sudo apt-get install -y ca-certificates libssl-dev\
qemu qemu-utils qemu-user-static\
qemu-utils qemu-user-static\
texinfo groff\
cmake ninja-build bison zip\
pkg-config build-essential autoconf re2c
# download cosmocc
cd /sc
wget https://github.com/jart/cosmopolitan/releases/download/3.3.3/cosmocc-3.3.3.zip
wget https://github.com/jart/cosmopolitan/releases/download/4.0.2/cosmocc-4.0.2.zip
mkdir -p cosmocc
cd cosmocc
unzip ../cosmocc-3.3.3.zip
unzip ../cosmocc-4.0.2.zip
# register
cd /sc/cosmocc
.github/workflows/release.yml
+2 -2
View File
@@ -17,7 +17,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, macos-13 ]
os: [ ubuntu-latest ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -46,7 +46,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ macos-latest ]
os: [ macos-latest, macos-15-intel ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
.github/workflows/test.yml
+55 -1
View File
@@ -12,7 +12,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, macos-latest, macos-13 ]
os: [ ubuntu-latest, ubuntu-24.04-arm, macos-latest, macos-14, macos-15-intel ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -21,6 +21,20 @@ jobs:
- name: Test the project
run: make test
test-posix-sanitizers:
name: Build and test on POSIX systems with sanitizers turned on
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Compile the project
run: make clean && CFLAGS="-g -O2 -fsanitize=address,undefined" make
- name: Test the project
run: make test
test-windows:
name: Build and test on Windows
strategy:
@@ -42,6 +56,27 @@ jobs:
shell: cmd
run: build_win dist
test-windows-sanitizers:
name: Build and test on Windows with sanitizers
strategy:
matrix:
os: [ windows-latest ]
runs-on: ${{ matrix.os }}
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup MSVC
uses: ilammy/msvc-dev-cmd@v1
- name: Build the project
shell: cmd
run: set SANITIZE=1 & build_win
- name: Test the project
shell: cmd
run: set VERBOSE=1 & build_win test
- name: Test installer build
shell: cmd
run: build_win dist
test-windows-min:
name: Build and test on Windows Minimal build
strategy:
@@ -136,3 +171,22 @@ jobs:
run: docker run --privileged --rm tonistiigi/binfmt --install s390x
- name: Build and run on emulated architecture
run: docker run --rm -v .:/janet --platform linux/s390x alpine sh -c "apk update && apk add --no-interactive git build-base && cd /janet && make -j3 && make test"
test-cosmo:
name: Test build for Cosmo
runs-on: ubuntu-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: create build folder
run: |
sudo mkdir -p /sc
sudo chmod -R 0777 /sc
- name: setup Cosmopolitan Libc
run: bash ./.github/cosmo/setup
- name: Set the version
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
- name: Set the platform
run: echo "platform=cosmo" >> $GITHUB_ENV
- name: build Janet APE binary
run: bash ./.github/cosmo/build
.gitignore
+1
View File
@@ -12,6 +12,7 @@ janet
/src/include/generated/*.h
janet-*.tar.gz
dist
/tmp
# jpm lockfile
lockfile.janet
CHANGELOG.md
+47
View File
@@ -2,6 +2,53 @@
All notable changes to this project will be documented in this file.
## Unreleased - ???
- JANET_PATH will now be searched strictly left-to-right for modules.
- Add `-t` (`--tool`) flag for using installed libraries as command line tools
- Numerous documentation improvements and fixes
- Add support for GNU/Hurd
- Improve pretty printing layout for %M and %m modifiers to be more code-like.
- Add filewatch support to BSD and macos.
- Add linting support for shadowed bindings.
- Add nanboxing support for Linux on ARM64 and turn on nanboxing by default on macos on ARM64 (aarch64).
- ev/thread-chan deadlock bug fixed
- Re-add removed support for non-blocking net/connect on windows with bug fixes.
## 1.41.2 - 2026-02-18
- Fix regressions in `put` for arrays and buffers.
- Add `module/add-file-extension`
- Add `module/add-syspath`
- Fix issue with possible stack corrpution with abstract types that modify the current fiber.
- Allow use of the interpreter and garbage collection inside module entry for native modules.
## 1.41.1 - 2026-02-15
- Revert to blocking behaior of `net/connect` on windows to fix spurious errors.
- Allow overriding the loader when doing imports with the `:loader` argument.
- Allow importing modules with a path extension to do what one would expect.
- Add `find-all` argument to `module/find`
- Add :threads, :unmarshal, :compiler, and :asm sandbox flags.
- Add support for persistent REPL history with the environment variable `JANET_HISTFILE`
- Fix a number of fuzzer-found compiler bugs
- Fix windows processes launching bug with empty environment table that caused process-launch failures.
- Add `:I`, `:V`, and `:N` flags to `os/open` for more control when creating streams.
- Add `ev/go-gather` for a dynamic `ev/gather`.
- Use color in script output if color is being used in REPL output.
- Fix `varfn` macros handling of extra metadata.
- Disallow certain degenerate uses of fibers with the ev/ module.
- Add linting for unused bindings.
- Add linting for extra or wrong parameters to &named functions.
- Add `janet_optuinteger` and `janet_optuinteger64` to the C API.
- Add `cms` combinator to PEGs.
- Add `thaw-keep-keys` as a variant of thaw
- The `repl` function now respects the `*repl-prompt*` dynamic binding by default.
- Allow matching exact lengths of datastructures with the `match` macro using a dollar suffix.
- Add initial support for Plan 9. Some modules (e.g. ev) are not yet enabled.
- Allow specifying `:flycheck` for individual defines to annotate that they are safe to evaluate for flychecking.
## 1.40.1 - 2025-11-16
- 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`.
CONTRIBUTING.md
+22 -1
View File
@@ -37,6 +37,12 @@ may require changes before being merged.
do this indentation, or approximate as close as possible. There is a janet formatter
in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well.
Bot pull requests will not be accepted, and anonymous submissions, including
new accounts, unknown emails, and first time contributors will be subjected
to greater scrutiny and code reivew. Automatically generated and filed bug
reports MAY be ok, if they are of consistent and good quality, such as
OSSFuzz or well constructed CI pipelines.
## C style
For changes to the VM and Core code, you will probably need to know C. Janet is programmed with
@@ -61,7 +67,7 @@ ensure a consistent code style for C.
## Janet style
All janet code in the project should be formatted similar to the code in core.janet.
All janet code in the project should be formatted similar to the code in src/boot/boot.janet.
The auto formatting from janet.vim will work well.
## Typo Fixing and One-Line changes
@@ -90,3 +96,18 @@ timely manner. In short, if you want extra functionality now, then build it.
* Include a good description of the problem that is being solved
* Include descriptions of potential solutions if you have some in mind.
## LLMs, Tool Usage, and Transparency
All usage of Large Language Models (LLMs), Neural Networks, "AI" tools, and
other tools such as software fuzzers or static analyzers must be disclosed.
This applies to pull requests, email patches, bug reports, and any other
meaningful contribution to Janet's source code. Please also refrain from using
generative AI for code that will be embedded in the Janet runtime, which include
all C source files as well as boot.janet. All code should be well
and completely understood by the human author, including test cases. Large and
obviously AI-driven changes will be rejected. Be mindful and transparent on the
copyright implications of any submitted code. We will use discretion when
accepting generated test cases for bug reproductions, one-line bug
fixes, or typo fixes. Often, these can be trivially rewritten by a human to
avoid the problem.
LICENSE
+1 -1
View File
@@ -1,4 +1,4 @@
Copyright (c) 2025 Calvin Rose and contributors
Copyright (c) 2026 Calvin Rose and contributors
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
Makefile
+26 -19
View File
@@ -1,4 +1,4 @@
# Copyright (c) 2025 Calvin Rose
# Copyright (c) 2026 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -58,7 +58,6 @@ LDFLAGS?=-rdynamic
LIBJANET_LDFLAGS?=$(LDFLAGS)
RUN:=$(RUN)
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
@@ -224,9 +223,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.40.dylib
SONAME=libjanet.1.41.dylib
else
SONAME=libjanet.so.1.40
SONAME=libjanet.so.1.41
endif
ifeq ($(MINGW_COMPILER), clang)
@@ -265,6 +264,7 @@ $(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
# Testing assumes HOSTCC=CC
TEST_SCRIPTS=$(wildcard test/suite*.janet)
EXAMPLE_SCRIPTS=$(wildcard examples/*.janet)
repl: $(JANET_TARGET)
$(RUN) ./$(JANET_TARGET)
@@ -272,21 +272,26 @@ repl: $(JANET_TARGET)
debug: $(JANET_TARGET)
$(DEBUGGER) ./$(JANET_TARGET)
VALGRIND_COMMAND=valgrind --leak-check=full --quiet
VALGRIND_COMMAND=$(RUN) valgrind --leak-check=full --quiet
CALLGRIND_COMMAND=$(RUN) valgrind --tool=callgrind
valgrind: $(JANET_TARGET)
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
test: $(JANET_TARGET) $(TEST_PROGRAMS)
test: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
valtest: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
for f in examples/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) -k "$$f"; done
callgrind: $(JANET_TARGET)
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
$(CALLGRIND_COMMAND) ./$(JANET_TARGET)
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 #####
@@ -345,6 +350,7 @@ build/janet.pc: $(JANET_TARGET)
echo 'Libs.private: $(CLIBS)' >> $@
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)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
strip $(STRIPFLAGS) '$(DESTDIR)$(BINDIR)/janet'
@@ -354,13 +360,13 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
mkdir -p '$(DESTDIR)$(JANET_PATH)'
mkdir -p '$(DESTDIR)$(LIBDIR)'
if test $(UNAME) = Darwin ; then \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib' ; \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(JANET_VERSION).dylib' ; \
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \
ln -sf libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
ln -sf libjanet.$(JANET_VERSION).dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
else \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' ; \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(JANET_VERSION)' ; \
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
ln -sf libjanet.so.$(JANET_VERSION) $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
fi
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
@@ -417,9 +423,6 @@ clean:
-rm -rf build vgcore.* callgrind.*
-rm -rf test/install/build test/install/modpath
test-install:
echo "JPM has been removed from default install."
help:
@echo
@echo 'Janet: A Dynamic Language & Bytecode VM'
@@ -431,7 +434,8 @@ help:
@echo ' make test Test a built Janet'
@echo ' make valgrind Assess Janet with Valgrind'
@echo ' make callgrind Assess Janet with Valgrind, using Callgrind'
@echo ' make valtest Run the test suite with Valgrind to check for memory leaks'
@echo ' make valtest Run the test suite and examples with Valgrind to check for memory leaks'
@echo ' make calltest Run the test suite and examples with Callgrind'
@echo ' make dist Create a distribution tarball'
@echo ' make docs Generate documentation'
@echo ' make debug Run janet with GDB or LLDB'
@@ -441,6 +445,9 @@ help:
@echo " make format Format Janet's own source files"
@echo ' make grammar Generate a TextMate language grammar'
@echo
@echo ' make install-jpm-git Install jpm into the current filesystem'
@echo ' make install-spork-git Install spork into the current filesystem'
@echo
.PHONY: clean install repl debug valgrind test \
valtest dist uninstall docs grammar format help compile-commands
.PHONY: clean install install-jpm-git install-spork-git repl debug valgrind test \
valtest callgrind callgrind-test dist uninstall docs grammar format help compile-commands
README.md
+49 -7
View File
@@ -148,8 +148,40 @@ You can get the source on [GitHub](https://github.com/janet-lang/janet) or
[SourceHut](https://git.sr.ht/~bakpakin/janet). While the GitHub repo is the official repo,
the SourceHut mirror is actively maintained.
## Spork and JPM
Spork and JPM are two companion projects to Janet. They are optional, especially in an embedding use case.
Spork is a collection of common utility modules, and several packaged scripts
like `janet-format` for code formatting, `janet-netrepl` for a socket-based
REPL, and `janet-pm` for a comprehensive Janet project manager tool. The
modules in `spork` are less stable than the interfaces in core Janet, although
we try to prevent breaking changes to existing modules, with a preference to
add new modules and functions. Spork requires a C compiler to build and install
various extenstion components such as miniz and JSON utilities. Many spork
sub-modules, for example spork/path, are independent and can be manually
vendored in programmer projects without fully installing spork.
When install Spork, scripts will be installed to $JANET_PATH/bin/ on POSIX systems by default.
This likely needs to be added to the path to use these scripts.
JPM is the older, more opinionated, project manager tool, which has it's pros
and cons. It does not require a C compiler to build and install, but is less
flexible and is not receiving many changes and improvements going forward. It
may also be harder to configure correctly on new systems. In that sense, it may
be more stable.
JPM will install to /usr/local/bin/ on posix systems by default, which may or
may not be on your PATH.
## Building
When building from source, for stability, please use the latest tagged release. For
example, run `git checkout $(git describe --tags --abbrev=0)` after cloning but
before building. For the latest development, build directly on the master
branch. The master branch is not-necessarily stable as most Janet development
happens directly on the master branch.
### macOS and Unix-like
The Makefile is non-portable and requires GNU-flavored make.
@@ -160,15 +192,18 @@ make
make test
make repl
make install
make install-jpm-git
make install-spork-git # optional
make install-jpm-git # optional
```
Find out more about the available make targets by running `make help`.
### Alpine Linux
To build a statically-linked build of Janet, Alpine Linux + MUSL is a good combination. Janet can also
be built inside a docker container or similar in this manner.
To build a statically-linked build of Janet, Alpine Linux + MUSL is a good
combination. Janet can also be built inside a docker container or similar in
this manner. This is a great way to try Janet without committing to a full
install or needing to customize the default install.
```sh
docker run -it --rm alpine /bin/ash
@@ -178,8 +213,13 @@ $ cd janet
$ make -j10
$ make test
$ make install
$ make install-spork-git # optional
$ make install-jpm-git # optional
```
Note that for a true statically-linked binary with MUSL, one needs to add `-static` to the Makefile flags. This
will also disable runtime loading of native modules (plugins) as well as the FFI.
### 32-bit Haiku
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
@@ -191,7 +231,8 @@ make CC=gcc-x86
make test
make repl
make install
make install-jpm-git
make install-spork-git # optional
make install-jpm-git # optional
```
### FreeBSD
@@ -205,7 +246,8 @@ gmake
gmake test
gmake repl
gmake install
gmake install-jpm-git
gmake install-spork-git # optional
gmake install-jpm-git # optional
```
### NetBSD
@@ -320,8 +362,8 @@ If installed, you can also run `man janet` to get usage information.
## Embedding
Janet can be embedded in a host program very easily. The normal build
will create a file `build/janet.c`, which is a single C file
that contains all the source to Janet. This file, along with
will create a file `build/c/janet.c`, a C source code file that
that contains the amalgamated source to Janet. This file, along with
`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C
project and compiled into it. Janet should be compiled with `-std=c99`
on most compilers, and will need to be linked to the math library, `-lm`, and
build_win.bat
+13 -3
View File
@@ -23,8 +23,18 @@
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi /DEBUG
@set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib /DEBUG
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
@rem set JANET_LINK=link /nologo
if DEFINED CLANG (
@set COMPILER=clang-cl.exe
) else (
@set COMPILER=cl.exe
)
if DEFINED SANITIZE (
@set "SANITIZERS=/fsanitize=address"
) else (
@set "SANITIZERS="
)
@set JANET_COMPILE=%COMPILER% /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD %SANITIZERS%
@set JANET_LINK=link /nologo
@set JANET_LINK_STATIC=lib /nologo
@@ -49,7 +59,7 @@ for %%f in (src\boot\*.c) do (
)
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
@if errorlevel 1 goto :BUILDFAIL
@rem note that there is no default sysroot being baked in
@rem note that there is no default syspath being baked in
build\janet_boot . > build\c\janet.c
@if errorlevel 1 goto :BUILDFAIL
examples/chatserver.janet
+1 -1
View File
@@ -26,7 +26,7 @@
(broadcast name (string msg)))
(print name " disconnected")))))
(defn main [& args]
(defn main [&]
(printf "STARTING SERVER...")
(flush)
(def my-server (net/listen "127.0.0.1" "8000"))
examples/debugger.janet
+2 -2
View File
@@ -132,7 +132,7 @@
"Go to the next breakpoint."
[&opt n]
(var res nil)
(for i 0 (or n 1)
(repeat (or n 1)
(set res (resume (.fiber))))
res)
@@ -146,6 +146,6 @@
"Execute the next n instructions."
[&opt n]
(var res nil)
(for i 0 (or n 1)
(repeat (or n 1)
(set res (debug/step (.fiber))))
res)
examples/error.janet
+3 -3
View File
@@ -3,10 +3,10 @@
(defn bork [x]
(defn bark [x]
(defn bark [y]
(print "Woof!")
(print x)
(error x)
(print y)
(error y)
(print "Woof!"))
(bark (* 2 x))
examples/filewatch.janet
+14
View File
@@ -0,0 +1,14 @@
###
### example/filewatch.janet ...files
###
### Watch for all changes in a list of files and directories. Behavior
### depends on the filewatch module, and different operating systems will
### report different events.
(def chan (ev/chan 1000))
(def fw (filewatch/new chan))
(each arg (drop 1 (dyn *args* []))
(filewatch/add fw arg :all))
(filewatch/listen fw)
(forever (let [event (ev/take chan)] (pp event)))
examples/iterate-fiber.janet
+3 -3
View File
@@ -7,13 +7,13 @@
(print "simple yielding")
(each item f (print "got: " item ", now " (fiber/status f)))
(def f
(def f2
(coro
(for i 0 10
(yield (string "yield " i))
(ev/sleep 0))))
(print "complex yielding")
(each item f (print "got: " item ", now " (fiber/status f)))
(each item f2 (print "got: " item ", now " (fiber/status f2)))
(print (fiber/status f))
(print (fiber/status f2))
examples/lazyseqs.janet
+14 -14
View File
@@ -4,7 +4,7 @@
# that must be called (realizing it), and the memoized.
# Use with (import "./path/to/this/file" :prefix "seq.")
(defmacro delay
(defmacro dolazy
"Lazily evaluate a series of expressions. Returns a function that
returns the result of the last expression. Will only evaluate the
body once, and then memoizes the result."
@@ -35,7 +35,7 @@
(def x (tuple h t))
(fn [] x))
(defn empty?
(defn lazy-empty?
"Check if a sequence is empty."
[s]
(not (s)))
@@ -55,14 +55,14 @@
[start end &]
(if end
(if (< start end)
(delay (tuple start (lazy-range (+ 1 start) end)))
(dolazy (tuple start (lazy-range (+ 1 start) end)))
empty-seq)
(lazy-range 0 start)))
(defn lazy-map
"Return a sequence that is the result of applying f to each value in s."
[f s]
(delay
(dolazy
(def x (s))
(if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
@@ -76,31 +76,31 @@
[f s]
(when (s) (f (head s)) (realize-map f (tail s))))
(defn drop
(defn lazy-drop
"Ignores the first n values of the sequence and returns the rest."
[n s]
(delay
(dolazy
(def x (s))
(if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
(if (and x (pos? n)) ((lazy-drop (- n 1) (get x TAIL))))))
(defn take
(defn lazy-take
"Returns at most the first n values of s."
[n s]
(delay
(dolazy
(def x (s))
(if (and x (pos? n))
(tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
(tuple (get x HEAD) (lazy-take (- n 1) (get x TAIL))))))
(defn randseq
"Return a sequence of random numbers."
[]
(delay (tuple (math/random) (randseq))))
(dolazy (tuple (math/random) (randseq))))
(defn take-while
(defn lazy-take-while
"Returns a sequence of values until the predicate is false."
[pred s]
(delay
(dolazy
(def x (s))
(when x
(def thehead (get HEAD x))
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))
(if thehead (tuple thehead (lazy-take-while pred (get TAIL x)))))))
examples/life.janet
+2 -2
View File
@@ -16,8 +16,8 @@
(def cell-set (frequencies state))
(def neighbor-set (frequencies (mapcat neighbors state)))
(seq [coord :keys neighbor-set
:let [count (get neighbor-set coord)]
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
:let [ncount (get neighbor-set coord)]
:when (or (= ncount 3) (and (get cell-set coord) (= ncount 2)))]
coord))
(defn draw
examples/rtest.janet
+1 -1
View File
@@ -2,7 +2,7 @@
(def counts (seq [_ :range [0 100]] 0))
(for i 0 1000000
(repeat 1000000
(let [x (math/random)
intrange (math/floor (* 100 x))
oldcount (counts intrange)]
examples/sample-bad-bundle1/info.jdn
+3
View File
@@ -0,0 +1,3 @@
@{
:name "sample-bad-bundle1"
}
examples/sample-bad-bundle/badmod.janet → examples/sample-bad-bundle2/badmod.janet
View File
File renamed without changes.
examples/sample-bad-bundle/bundle.janet → examples/sample-bad-bundle2/bundle.janet
View File
File renamed without changes.
examples/sample-bad-bundle2/info.jdn
+3
View File
@@ -0,0 +1,3 @@
@{
:name "sample-bad-bundle2"
}
examples/threaded-channels.janet
+1 -1
View File
@@ -7,7 +7,7 @@
(ev/give chan (math/random))
(ev/give chan (math/random))
(ev/sleep 0.5)
(for i 0 10
(repeat 10
(print "giving to channel...")
(ev/give chan (math/random))
(ev/sleep 1))
janet.1
+7 -1
View File
@@ -156,7 +156,7 @@ Shows the version text and exits immediately.
.TP
.BR \-s
Read raw input from stdin and forgo prompt history and other readline-like features.
Read raw input from stdin and forgo fancy input, which includes prompt history and other readline-like features.
.TP
.BR \-e\ code
@@ -272,6 +272,12 @@ This variable does nothing in the default configuration of Janet, as PRF is disa
cannot be defined for this variable to have an effect.
.RE
.B JANET_HISTFILE
.RS
A file location to use for the default shell's REPL history when using fancy input. This relative path is where commands are persisted between sessions.
If unset, no repl history well be used. Does not work with the -s flag where fancy input is disabled.
.RE
.B NO_COLOR
.RS
Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime
meson.build
+6 -2
View File
@@ -1,4 +1,4 @@
# Copyright (c) 2025 Calvin Rose and contributors
# Copyright (c) 2026 Calvin Rose and contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.40.0')
version : '1.41.3')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -72,6 +72,9 @@ conf.set_quoted('JANET_VERSION', meson.project_version())
# Use options
conf.set_quoted('JANET_BUILD', get_option('git_hash'))
conf.set('JANET_NO_NANBOX', not get_option('nanbox'))
if get_option('nanbox_pointer_shift') != -1 # -1 is auto-detect
conf.set('JANET_NANBOX_64_POINTER_SHIFT', get_option('nanbox_pointer_shift'))
endif
conf.set('JANET_SINGLE_THREADED', get_option('single_threaded'))
conf.set('JANET_NO_DYNAMIC_MODULES', not get_option('dynamic_modules'))
conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
@@ -292,6 +295,7 @@ test_files = [
'test/suite-io.janet',
'test/suite-marsh.janet',
'test/suite-math.janet',
'test/suite-net.janet',
'test/suite-os.janet',
'test/suite-parse.janet',
'test/suite-peg.janet',
meson_options.txt
+1
View File
@@ -2,6 +2,7 @@ option('git_hash', type : 'string', value : 'meson')
option('single_threaded', type : 'boolean', value : false)
option('nanbox', type : 'boolean', value : true)
option('nanbox_pointer_shift', type : 'integer', min : -1, max : 4, value : -1)
option('dynamic_modules', type : 'boolean', value : true)
option('docstrings', type : 'boolean', value : true)
option('sourcemaps', type : 'boolean', value : true)
misc/completion/README.md
+33
View File
@@ -0,0 +1,33 @@
# Shell completions for Janet
This directory contains shell completion scripts for the `janet` interpreter.
## Bash
```sh
# Temporary (current session only)
source /path/to/janet.bash
# Permanent (system-wide)
sudo cp janet.bash /etc/bash_completion.d/janet
# Permanent (user only)
cp janet.bash ~/.local/share/bash-completion/completions/janet
```
## Zsh
```sh
# Copy to a directory in your $fpath, e.g.:
cp janet.zsh ~/.zsh/completions/_janet
# Ensure the directory is in $fpath (add to ~/.zshrc if needed):
# fpath=(~/.zsh/completions $fpath)
# autoload -Uz compinit && compinit
```
## Fish
```sh
cp janet.fish ~/.config/fish/completions/janet.fish
```
misc/completion/janet.bash
+42
View File
@@ -0,0 +1,42 @@
# Bash completion for janet
# Install: source this file, or place it in /etc/bash_completion.d/janet
# or ~/.local/share/bash-completion/completions/janet
_janet() {
local cur prev words cword
_init_completion || return
local flags="-h -v -s -e -E -d -n -N -r -R -p -q -k -m -c -i -l -w -x --"
case "$prev" in
-e|-E)
# Argument is Janet source code — no file completion
return
;;
-m)
# syspath: complete directories
_filedir -d
return
;;
-c|-l)
# source file: complete .janet files
_filedir janet
return
;;
-w|-x)
# linting level
COMPREPLY=($(compgen -W ":none :relaxed :normal :strict" -- "$cur"))
return
;;
esac
if [[ "$cur" == -* ]]; then
COMPREPLY=($(compgen -W "$flags" -- "$cur"))
return
fi
# Default: complete .janet files and directories
_filedir janet
}
complete -F _janet janet
misc/completion/janet.fish
+28
View File
@@ -0,0 +1,28 @@
# Fish completion for janet
# Disable file completion by default; re-enable for specific flags
complete -c janet -f
# Flags
complete -c janet -s h -d 'Show usage and exit'
complete -c janet -s v -d 'Show version and exit'
complete -c janet -s s -d 'Read raw stdin (no readline features)'
complete -c janet -s e -r -d 'Execute Janet source string'
complete -c janet -s E -r -d 'Execute Janet expression as short-fn with remaining args'
complete -c janet -s d -d 'Enable debug mode'
complete -c janet -s n -d 'Disable ANSI colors in REPL'
complete -c janet -s N -d 'Enable ANSI colors in REPL'
complete -c janet -s r -d 'Open REPL after executing sources'
complete -c janet -s R -d 'Disable loading user profile in REPL'
complete -c janet -s p -d 'Persistent mode (continue after errors)'
complete -c janet -s q -d 'Hide logo in REPL'
complete -c janet -s k -d 'Compile only (lint), do not execute'
complete -c janet -s i -d 'Treat script as a .jimage file'
complete -c janet -s m -r -d 'Set syspath for module loading' -a '(__fish_complete_directories)'
complete -c janet -s c -r -d 'Precompile source to .jimage'
complete -c janet -s l -r -d 'Import module before script/REPL' -a '(find . -name "*.janet" -printf "%f\n" 2>/dev/null)'
complete -c janet -s w -r -d 'Set warning linting level' -a ':none :relaxed :normal :strict'
complete -c janet -s x -r -d 'Set error linting level' -a ':none :relaxed :normal :strict'
# File arguments: .janet files and directories
complete -c janet -F -a '*.janet'
misc/completion/janet.zsh
+35
View File
@@ -0,0 +1,35 @@
#compdef janet
# Zsh completion for janet
_janet() {
local -a opts
opts=(
'-h[Show usage and exit]'
'-v[Show version and exit]'
'-s[Read raw stdin (no readline features)]'
'-e[Execute Janet source string]:source code:'
'-E[Execute Janet expression as short-fn with remaining args]:expression:'
'-d[Enable debug mode]'
'-n[Disable ANSI colors in REPL]'
'-N[Enable ANSI colors in REPL]'
'-r[Open REPL after executing sources]'
'-R[Disable loading user profile in REPL]'
'-p[Persistent mode (continue after errors)]'
'-q[Hide logo in REPL]'
'-k[Compile only (lint), do not execute]'
'-i[Treat script as a .jimage file]'
'-m[Set syspath for module loading]:syspath:_directories'
'-c[Precompile source to .jimage]:source:_files -g "*.janet" :output:_files'
'-l[Import module before script/REPL]:module:_files -g "*.janet"'
'-w[Set warning linting level]:level:(none relaxed normal strict)'
'-x[Set error linting level]:level:(none relaxed normal strict)'
'--[End of options]'
'*:script:_files -g "*.janet"'
)
_arguments -s $opts
}
_janet "$@"
plan9.mk
Executable
+49
View File
@@ -0,0 +1,49 @@
</$objtype/mkfile
TARG=janet
HFILES=src/include/janet.h src/conf/janetconf.h
JANET_PATH=/sys/lib/janet
BIN=/$objtype/bin/
DISABLED=EV NET ASSEMBLER FFI UTC_MKTIME REALPATH DYNAMIC_MODULES THREADS SYMLINKS LOCALES UMASK SPAWN
JANET_CONFIG=JANET_SINGLE_THREADED JANET_OS_NAME=plan9 JANET_ARCH_NAME=$objtype JANET_API='' JANET_NO_RETURN='' JANET_SIMPLE_GETLINE `{echo JANET_NO_^$DISABLED} PLAN9_`{echo -n $objtype}
CFLAGS=-FTVBNcwp -D _POSIX_SOURCE -DJANET_PLAN9 -D_BSD_EXTENSION -D_LIMITS_EXTENSION -Isrc/include -Isrc/conf -I/sys/include/npe -Dtypestr=janettypestr -DJANET_API `{echo '-D'^$JANET_CONFIG}
BOOT_CFLAGS=$CFLAGS -DJANET_BOOTSTRAP
JANET_CORE_HEADERS=`{ls src/core/*.h}
JANET_CORE_SOURCES=`{ls src/core/*.c}
JANET_BOOT_SOURCES=src/boot/array_test.c \
src/boot/boot.c \
src/boot/buffer_test.c \
src/boot/number_test.c \
src/boot/system_test.c \
src/boot/table_test.c
JANET_BOOT_HEADERS=src/boot/tests.h
JANET_BOOT_OBJECTS=`{echo $JANET_CORE_SOURCES $JANET_BOOT_SOURCES | sed -e 's/\.c/.boot.'$O'/g'}
OFILES=janet.$O src/mainclient/shell.$O
default:V:all
src/%.boot.$O: src/%.c $JANET_HEADERS $JANET_CORE_HEADERS $JANET_BOOT_HEADERS
$CC $BOOT_CFLAGS -o $target $prereq(1)
src/mainclient/shell.$O: src/mainclient/shell.c
$CC $BOOT_CFLAGS -o $target $prereq(1)
$O.janetboot: $JANET_BOOT_OBJECTS
$LD $LDFLAGS -o $target $prereq
janet.c: $O.janetboot src/boot/boot.janet
$prereq(1) . JANET_PATH $JANET_PATH >$target
build/janet.$O: build/c/janet.c src/conf/janetconf.h src/include/janet.h
$CC $CFLAGS -D^$JANET_CONFIG -o $target $prereq(1)
build/shell.$O: src/mainclient/shell.c src/conf/janetconf.h src/include/janet.h
$CC $CFLAGS -D^$JANET_CONFIG -o $target $prereq(1)
</sys/src/cmd/mkone
clean:V:
rm -f src/core/*.[$OS] src/boot/*.[$OS] *.a[$OS] y.tab.? lex.yy.c y.debug y.output [$OS].??* $TARG janet.[$OS] janet.c src/mainclient/shell.[$OS]
src/boot/array_test.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/boot/boot.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/boot/boot.janet
+999 -597
View File
File diff suppressed because it is too large. Load diff
src/boot/buffer_test.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/boot/number_test.c
+4 -2
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -44,7 +44,9 @@ static void test_valid_str(const char *str) {
}
int number_test() {
#ifdef JANET_PLAN9
return 0;
#endif
test_valid_str("1.0");
test_valid_str("1");
test_valid_str("2.1");
src/boot/system_test.c
+6 -2
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -37,7 +37,7 @@ int system_test() {
/* Check the version defines are self consistent */
char version_combined[256];
sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
snprintf(version_combined, sizeof(version_combined), "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
assert(!strcmp(JANET_VERSION, version_combined));
/* Reflexive testing and nanbox testing */
@@ -51,6 +51,10 @@ int system_test() {
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
#ifdef NAN
#ifdef JANET_PLAN9
// Plan 9 traps NaNs by default; disable that.
setfcr(0);
#endif
assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER));
#else
assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER));
src/boot/table_test.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/conf/janetconf.h
+5 -4
View File
@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 40
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.40.0"
#define JANET_VERSION_MINOR 41
#define JANET_VERSION_PATCH 3
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.41.3-dev"
/* #define JANET_BUILD "local" */
@@ -16,6 +16,7 @@
/* #define JANET_THREAD_LOCAL _Thread_local */
/* #define JANET_NO_DYNAMIC_MODULES */
/* #define JANET_NO_NANBOX */
/* #define JANET_NANBOX_64_POINTER_SHIFT 0 */
/* #define JANET_API __attribute__((visibility ("default"))) */
/* These settings should be specified before amalgamation is
src/core/abstract.c
+15 -2
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -37,7 +37,7 @@
/* Create new userdata */
void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_NONE,
sizeof(JanetAbstractHead) + size);
sizeof(JanetAbstractHead) + size);
header->size = size;
header->type = atype;
return (void *) & (header->data);
@@ -201,4 +201,17 @@ int32_t janet_abstract_decref(void *abst) {
return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
}
int32_t janet_abstract_decref_maybe_free(void *abst) {
int32_t result = janet_abstract_decref(abst);
if (0 == result) {
JanetAbstractHead *head = janet_abstract_head(abst);
if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
}
/* Free memory */
janet_free(head);
}
return result;
}
#endif
src/core/array.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/asm.c
+23 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -567,6 +567,13 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
x = janet_get1(s, janet_ckeywordv("structarg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
/* Check namedarg */
x = janet_get1(s, janet_ckeywordv("namedargs"));
if (janet_checkint(x)) {
def->flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
def->named_args_count = janet_unwrap_integer(x);
}
/* Check source */
x = janet_get1(s, janet_ckeywordv("source"));
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
@@ -982,6 +989,14 @@ static Janet janet_disasm_structarg(JanetFuncDef *def) {
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG);
}
static Janet janet_disasm_namedargs(JanetFuncDef *def) {
if (def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS) {
return janet_wrap_integer(def->named_args_count);
} else {
return janet_wrap_nil();
}
}
static Janet janet_disasm_constants(JanetFuncDef *def) {
JanetArray *constants = janet_array(def->constants_length);
for (int32_t i = 0; i < def->constants_length; i++) {
@@ -1032,6 +1047,7 @@ Janet janet_disasm(JanetFuncDef *def) {
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
janet_table_put(ret, janet_ckeywordv("namedargs"), janet_disasm_namedargs(def));
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
@@ -1048,6 +1064,7 @@ JANET_CORE_FN(cfun_asm,
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
"to the return value of disasm. Will throw an\n"
"error on invalid assembly.") {
janet_sandbox_assert(JANET_SANDBOX_ASM);
janet_fixarity(argc, 1);
JanetAssembleResult res;
res = janet_asm(argv[0], 0);
@@ -1067,6 +1084,8 @@ JANET_CORE_FN(cfun_disasm,
"* :min-arity - minimum number of arguments function can be called with.\n"
"* :max-arity - maximum number of arguments function can be called with.\n"
"* :vararg - true if function can take a variable number of arguments.\n"
"* :structarg - true if function can take a variable number of arguments using the &keys option.\n"
"* :namedargs - if function can take a variable number of arguments using the &named option, this will be the number of named arguments.\n"
"* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
"* :source - name of source file that this function was compiled from.\n"
"* :name - name of function.\n"
@@ -1076,6 +1095,7 @@ JANET_CORE_FN(cfun_disasm,
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
"* :defs - other function definitions that this function may instantiate.\n") {
janet_sandbox_assert(JANET_SANDBOX_ASM);
janet_arity(argc, 1, 2);
JanetFunction *f = janet_getfunction(argv, 0);
if (argc == 2) {
@@ -1088,7 +1108,9 @@ JANET_CORE_FN(cfun_disasm,
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
if (!janet_cstrcmp(kw, "namedargs")) return janet_disasm_namedargs(f->def);
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
if (!janet_cstrcmp(kw, "symbolmap")) return janet_disasm_symbolslots(f->def);
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);
src/core/buffer.c
+18 -12
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -74,6 +74,7 @@ JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t
void janet_buffer_deinit(JanetBuffer *buffer) {
if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
janet_free(buffer->data);
buffer->data = NULL;
}
}
@@ -271,8 +272,8 @@ JANET_CORE_FN(cfun_buffer_trim,
JANET_CORE_FN(cfun_buffer_u8,
"(buffer/push-byte buffer & xs)",
"Append bytes to a buffer. Will expand the buffer as necessary. "
"Returns the modified buffer. Will throw an error if the buffer overflows.") {
"Append bytes to a buffer. Returns the modified buffer. "
"Expands the buffer as necessary. Throws an error if size limit is exceeded.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -285,8 +286,8 @@ JANET_CORE_FN(cfun_buffer_u8,
JANET_CORE_FN(cfun_buffer_word,
"(buffer/push-word buffer & xs)",
"Append machine words to a buffer. The 4 bytes of the integer are appended "
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
"throw an error if the buffer overflows.") {
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. "
"Expands the buffer as necessary. Throws an error if size limit is exceeded.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -305,7 +306,7 @@ JANET_CORE_FN(cfun_buffer_chars,
"Push byte sequences onto the end of a buffer. "
"Will accept any of strings, keywords, symbols, and buffers. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.") {
"Expands the buffer as necessary. Throws an error if size limit is exceeded.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -367,7 +368,8 @@ static void reverse_u64(uint8_t bytes[8]) {
JANET_CORE_FN(cfun_buffer_push_uint16,
"(buffer/push-uint16 buffer order data)",
"Push a 16 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
"Returns the modified buffer."
"Expands the buffer as necessary. Throws an error if size limit is exceeded.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
@@ -386,7 +388,8 @@ JANET_CORE_FN(cfun_buffer_push_uint16,
JANET_CORE_FN(cfun_buffer_push_uint32,
"(buffer/push-uint32 buffer order data)",
"Push a 32 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
"Returns the modified buffer."
"Expands the buffer as necessary. Throws an error if size limit is exceeded.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
@@ -402,7 +405,8 @@ JANET_CORE_FN(cfun_buffer_push_uint32,
JANET_CORE_FN(cfun_buffer_push_uint64,
"(buffer/push-uint64 buffer order data)",
"Push a 64 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
"Returns the modified buffer."
"Expands the buffer as necessary. Throws an error if size limit is exceeded.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
@@ -418,7 +422,8 @@ JANET_CORE_FN(cfun_buffer_push_uint64,
JANET_CORE_FN(cfun_buffer_push_float32,
"(buffer/push-float32 buffer order data)",
"Push the underlying bytes of a 32 bit float data onto the end of the buffer. "
"Returns the modified buffer.") {
"Returns the modified buffer."
"Expands the buffer as necessary. Throws an error if size limit is exceeded.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
@@ -434,7 +439,8 @@ JANET_CORE_FN(cfun_buffer_push_float32,
JANET_CORE_FN(cfun_buffer_push_float64,
"(buffer/push-float64 buffer order data)",
"Push the underlying bytes of a 64 bit float data onto the end of the buffer. "
"Returns the modified buffer.") {
"Returns the modified buffer."
"Expands the buffer as necessary. Throws an error if size limit is exceeded.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
@@ -487,7 +493,7 @@ JANET_CORE_FN(cfun_buffer_push,
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.") {
"Expands the buffer as necessary. Throws an error if size limit is exceeded.") {
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
buffer_push_impl(buffer, argv, 1, argc);
src/core/bytecode.c
+31 -2
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -29,7 +29,7 @@
#endif
/* Look up table for instructions */
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
const enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_0, /* JOP_NOOP, */
JINT_S, /* JOP_ERROR, */
JINT_ST, /* JOP_TYPECHECK, */
@@ -139,6 +139,8 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
case JOP_JUMP:
/* relative pc is in DS field of instruction */
old_jump_target = i + (((int32_t)instr) >> 8);
janet_assert(old_jump_target >= 0, "bounds");
janet_assert(old_jump_target < def->bytecode_length, "bounds");
new_jump_target = pc_map[old_jump_target];
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 8;
break;
@@ -148,6 +150,8 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
case JOP_JUMP_IF_NOT_NIL:
/* relative pc is in ES field of instruction */
old_jump_target = i + (((int32_t)instr) >> 16);
janet_assert(old_jump_target >= 0, "bounds");
janet_assert(old_jump_target < def->bytecode_length, "bounds");
new_jump_target = pc_map[old_jump_target];
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 16;
break;
@@ -496,6 +500,30 @@ int janet_verify(JanetFuncDef *def) {
}
}
/* Verify debug info - slotmapping, etc. */
for (int32_t i = def->symbolmap_length - 1; i >= 0; i--) {
JanetSymbolMap jsm = def->symbolmap[i];
if (jsm.birth_pc == UINT32_MAX) {
if (jsm.death_pc >= (uint32_t) def->environments_length) {
return 10;
/* We should also check jsm.slot_index */
}
} else {
if (jsm.slot_index >= (uint32_t) def->slotcount) {
return 11;
}
if (jsm.birth_pc != UINT32_MAX && jsm.birth_pc >= (uint32_t) def->bytecode_length) {
return 12;
}
if (jsm.death_pc != UINT32_MAX && jsm.death_pc > (uint32_t) def->bytecode_length) {
return 13;
}
}
if (jsm.symbol == NULL) {
return 14;
}
}
return 0;
}
@@ -522,6 +550,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
def->bytecode_length = 0;
def->environments_length = 0;
def->symbolmap_length = 0;
def->named_args_count = 0;
return def;
}
src/core/capi.c
+45 -3
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -50,11 +50,18 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
JANET_TOP_LEVEL_SIGNAL(msg);
#else
fputs(msg, stdout);
if (!(janet_vm.sandbox_flags & JANET_SANDBOX_EXIT)) {
/* Exit is not forbidden */
exit(EXIT_FAILURE);
}
/* If not able to signal, then select good default behavior - for single threaded programs, we have no
* choice but to exit. */
# ifdef JANET_SINGLE_THREADED
exit(-1);
exit(EXIT_FAILURE);
# elif defined(JANET_WINDOWS)
ExitThread(-1);
# else
/* Other threads will continue as usual */
pthread_exit(NULL);
# endif
#endif
@@ -339,6 +346,21 @@ uint16_t janet_getuinteger16(const Janet *argv, int32_t n) {
return (uint16_t) janet_unwrap_number(x);
}
int8_t janet_getinteger8(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkint8(x)) {
janet_panicf("bad slot #%d, expected 8 bit signed integer, got %v", n, x);
}
return (int16_t) janet_unwrap_number(x);
}
uint8_t janet_getuinteger8(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkuint8(x)) {
janet_panicf("bad slot #%d, expected 8 bit unsigned integer, got %v", n, x);
}
return (uint16_t) janet_unwrap_number(x);
}
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
#ifdef JANET_INT_TYPES
@@ -460,7 +482,7 @@ Janet janet_dyn(const char *name) {
return janet_table_get(janet_vm.top_dyns, janet_ckeywordv(name));
}
if (janet_vm.fiber->env) {
return janet_table_get(janet_vm.fiber->env, janet_ckeywordv(name));
return janet_table_get_keyword(janet_vm.fiber->env, name);
} else {
return janet_wrap_nil();
}
@@ -557,6 +579,18 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
return janet_getabstract(argv, n, at);
}
uint32_t janet_optuinteger(const Janet *argv, int32_t argc, int32_t n, uint32_t dflt) {
if (argc <= n) return dflt;
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
return janet_getuinteger(argv, n);
}
uint64_t janet_optuinteger64(const Janet *argv, int32_t argc, int32_t n, uint64_t dflt) {
if (argc <= n) return dflt;
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
return janet_getuinteger64(argv, n);
}
/* Atomic refcounts */
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
@@ -564,6 +598,8 @@ JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
return _InterlockedIncrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
#elif defined(JANET_PLAN9)
return aincl((void *)x, 1);
#else
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
#endif
@@ -574,6 +610,8 @@ JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
return _InterlockedDecrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
#elif defined(JANET_PLAN9)
return aincl((void *)x, -1);
#else
return __atomic_add_fetch(x, -1, __ATOMIC_ACQ_REL);
#endif
@@ -582,6 +620,8 @@ JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
#ifdef _MSC_VER
return _InterlockedOr(x, 0);
#elif defined(JANET_PLAN9)
return agetl((void *)x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_load_explicit(x, memory_order_acquire);
#else
@@ -592,6 +632,8 @@ JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
JanetAtomicInt janet_atomic_load_relaxed(JanetAtomicInt volatile *x) {
#ifdef _MSC_VER
return _InterlockedOr(x, 0);
#elif defined(JANET_PLAN9)
return agetl((void *)x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_load_explicit(x, memory_order_relaxed);
#else
src/core/cfuns.c
+25 -10
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -188,7 +188,7 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
janetc_copy(c, t, dflt_slot);
if (target_is_default) janetc_freeslot(c, dflt_slot);
int32_t current = janet_v_count(c->buffer);
c->buffer[label] |= (current - label) << 16;
c->buffer[label] |= (uint32_t)(current - label) << 16;
return t;
} else {
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil());
@@ -201,14 +201,29 @@ static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
}
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
if (opts.flags & JANET_FOPTS_DROP) {
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
return janetc_cslot(janet_wrap_nil());
int8_t inline_index = 0;
if (can_slot_be_imm(args[1], &inline_index)) {
/* Use JOP_PUT_INDEX */
if (opts.flags & JANET_FOPTS_DROP) {
janetc_emit_ssi(opts.compiler, JOP_PUT_INDEX, args[0], args[2], inline_index, 0);
return janetc_cslot(janet_wrap_nil());
} else {
JanetSlot t = janetc_gettarget(opts);
janetc_copy(opts.compiler, t, args[0]);
janetc_emit_ssi(opts.compiler, JOP_PUT_INDEX, t, args[2], inline_index, 0);
return t;
}
} else {
JanetSlot t = janetc_gettarget(opts);
janetc_copy(opts.compiler, t, args[0]);
janetc_emit_sss(opts.compiler, JOP_PUT, t, args[1], args[2], 0);
return t;
/* Use JOP_PUT */
if (opts.flags & JANET_FOPTS_DROP) {
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
return janetc_cslot(janet_wrap_nil());
} else {
JanetSlot t = janetc_gettarget(opts);
janetc_copy(opts.compiler, t, args[0]);
janetc_emit_sss(opts.compiler, JOP_PUT, t, args[1], args[2], 0);
return t;
}
}
}
static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
@@ -330,7 +345,7 @@ static JanetSlot compreduce(
int32_t end = janet_v_count(c->buffer);
for (i = 0; i < janet_v_count(labels); i++) {
int32_t label = labels[i];
c->buffer[label] |= ((end - label) << 16);
c->buffer[label] |= ((uint32_t)(end - label) << 16);
}
janet_v_free(labels);
return t;
src/core/compile.c
+157 -25
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -91,13 +91,38 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
}
/* Add a slot to a scope with a symbol associated with it (def or var). */
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags) {
if (!(flags & JANET_DEFFLAG_NO_SHADOWCHECK)) {
if (sym[0] != '_') {
switch (janetc_shadowcheck(c, sym)) {
default:
break;
case JANETC_SHADOW_MACRO:
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a macro", janet_wrap_symbol(sym));
break;
case JANETC_SHADOW_LOCAL_HIDES_LOCAL:
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is shadowing a binding", janet_wrap_symbol(sym));
break;
case JANETC_SHADOW_LOCAL_HIDES_GLOBAL:
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is shadowing a top-level binding", janet_wrap_symbol(sym));
break;
case JANETC_SHADOW_GLOBAL_HIDES_GLOBAL:
janetc_lintf(c, JANET_C_LINT_STRICT, "top-level binding %q is shadowing another top-level binding", janet_wrap_symbol(sym));
break;
}
}
}
SymPair sp;
int32_t cnt = janet_v_count(c->buffer);
sp.sym = sym;
sp.sym2 = sym;
sp.slot = s;
sp.keep = 0;
if (flags & JANET_DEFFLAG_NO_UNUSED) {
sp.referenced = 1;
} else {
sp.referenced = sym[0] == '_'; /* Fake ref if symbol starts with _ to avoid lints */
}
sp.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX;
@@ -170,6 +195,10 @@ void janetc_popscope(JanetCompiler *c) {
/* Keep upvalue slots and symbols for debugging. */
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
SymPair pair = oldscope->syms[i];
/* Check for unused symbols */
if (pair.referenced == 0 && pair.sym) {
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is unused", janet_wrap_symbol(pair.sym));
}
/* The variable should not be lexically accessible */
pair.sym = NULL;
if (pair.death_pc == UINT32_MAX) {
@@ -240,6 +269,42 @@ static int lookup_missing(
return 1;
}
/* Check if a binding is defined in an upper scope. This lets us check for
* variable shadowing. */
Shadowing janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym) {
/* Check locals */
JanetScope *scope = c->scope;
int is_global = (scope->flags & JANET_SCOPE_TOP);
while (scope) {
int32_t len = janet_v_count(scope->syms);
for (int32_t i = len - 1; i >= 0; i--) {
SymPair *pair = scope->syms + i;
if (pair->sym == sym) {
if (is_global) {
/* This can happen in a top level form like (def [x [x y]] [1 [2 3]])` where a symbol is reused in one expression */
/* janet_assert(!is_global, "shadowing analysis is incorrect. compiler bug"); */
return JANETC_SHADOW_GLOBAL_HIDES_GLOBAL;
}
return JANETC_SHADOW_LOCAL_HIDES_LOCAL;
}
}
scope = scope->parent;
}
/* Check globals */
JanetBinding binding = janet_resolve_ext(c->env, sym);
if (binding.type == JANET_BINDING_MACRO || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
return JANETC_SHADOW_MACRO;
} else if (binding.type == JANET_BINDING_NONE) {
return JANETC_SHADOW_NONE;
} else {
if (is_global) {
return JANETC_SHADOW_GLOBAL_HIDES_GLOBAL;
} else {
return JANETC_SHADOW_LOCAL_HIDES_GLOBAL;
}
}
}
/* Allow searching for symbols. Return information about the symbol */
JanetSlot janetc_resolve(
JanetCompiler *c,
@@ -262,6 +327,7 @@ JanetSlot janetc_resolve(
pair = scope->syms + i;
if (pair->sym == sym) {
ret = pair->slot;
pair->referenced = 1;
goto found;
}
}
@@ -274,7 +340,7 @@ JanetSlot janetc_resolve(
{
JanetBinding binding = janet_resolve_ext(c->env, sym);
if (binding.type == JANET_BINDING_NONE) {
Janet handler = janet_table_get(c->env, janet_ckeywordv("missing-symbol"));
Janet handler = janet_table_get_keyword(c->env, "missing-symbol");
switch (janet_type(handler)) {
case JANET_NIL:
break;
@@ -346,6 +412,7 @@ found:
/* non-local scope needs to expose its environment */
JanetScope *original_scope = scope;
pair->keep = 1;
pair->referenced = 1;
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
scope = scope->parent;
janet_assert(scope, "invalid scopes");
@@ -437,11 +504,22 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
const JanetKV *kvs = NULL;
int32_t cap = 0, len = 0;
janet_dictionary_view(ds, &kvs, &len, &cap);
for (int32_t i = 0; i < cap; i++) {
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
janet_v_push(ret, janetc_value(subopts, kvs[i].key));
janet_v_push(ret, janetc_value(subopts, kvs[i].value));
/* Sort keys for stability of order? */
int32_t *index_buf;
int32_t index_buf_stack[32];
int32_t *index_buf_heap = NULL;
if (len < 32) {
index_buf = index_buf_stack;
} else {
index_buf_heap = janet_smalloc(sizeof(int32_t) * len);
index_buf = index_buf_heap;
}
if (len) janet_sorted_keys(kvs, cap, index_buf);
for (int32_t i = 0; i < len; i++) {
janet_v_push(ret, janetc_value(subopts, kvs[index_buf[i]].key));
janet_v_push(ret, janetc_value(subopts, kvs[index_buf[i]].value));
}
if (index_buf_heap) janet_sfree(index_buf_heap);
return ret;
}
@@ -514,9 +592,9 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
JanetScope unusedScope;
int32_t bufstart = janet_v_count(c->buffer);
int32_t mapbufstart = janet_v_count(c->mapbuffer);
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unused");
janetc_value(opts, x);
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.2q", x);
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.4q", x);
janetc_popscope(c);
if (c->buffer) {
janet_v__cnt(c->buffer) = bufstart;
@@ -526,7 +604,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
}
/* Compile a call or tailcall instruction */
static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun, const Janet *form) {
JanetSlot retslot;
JanetCompiler *c = opts.compiler;
int specialized = 0;
@@ -552,6 +630,8 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
JanetFunction *f = janet_unwrap_function(fun.constant);
int32_t min = f->def->min_arity;
int32_t max = f->def->max_arity;
int structarg = f->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
int namedarg = f->def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS;
if (min_arity < 0) {
/* Call has splices */
min_arity = -1 - min_arity;
@@ -575,6 +655,47 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
fun.constant, min, min == 1 ? "" : "s", min_arity);
janetc_error(c, es);
}
if (structarg && (min_arity > f->def->arity) && ((min_arity - f->def->arity) & 1)) {
/* If we have an odd number of variadic arguments to a `&keys` function, that is almost certainly wrong. */
if (namedarg) {
janetc_lintf(c, JANET_C_LINT_NORMAL,
"odd number of named arguments to `&named` function %v", fun.constant);
} else {
janetc_lintf(c, JANET_C_LINT_NORMAL,
"odd number of named arguments to `&keys` function %v", fun.constant);
}
}
if (namedarg && f->def->named_args_count > 0) {
/* For each argument passed in, check if it is one of the used named arguments
* by checking the list defined in the function def. If not, raise a normal compiler
* lint. We can also do a strict lint for _missing_ named arguments, although in many
* cases those are assumed to have some kind of default, or we have dynamic keys. */
int32_t first_arg_key_index = f->def->arity + 1;
for (int32_t i = first_arg_key_index; i < janet_tuple_length(form); i += 2) {
Janet argkey = form[i];
/* Assumption: The first N constants of a function are its named argument keys. This
* may change if the compiler changes, but is true for all Janet generated functions. */
int found = 0;
if (janet_checktype(argkey, JANET_KEYWORD)) {
for (int32_t j = 0; j < f->def->named_args_count && j < f->def->constants_length; j++) {
if (janet_equals(argkey, f->def->constants[j])) {
found = 1;
break;
}
}
} else if (janet_checktype(argkey, JANET_TUPLE)) {
/* Possible lint : too dynamic, be dumber
* (defn f [&named x] [x])
* (f (if (coin-flip) :x :w) 10)
* A tuple could be a function call the evaluates to a valid key */
found = 1;
}
if (!found) {
janetc_lintf(c, JANET_C_LINT_NORMAL,
"unused named argument %v to function %v", argkey, fun.constant);
}
}
}
}
}
break;
@@ -809,14 +930,16 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
} else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */
ret = janetc_tuple(opts, x);
} else {
/* Function calls */
JanetSlot head = janetc_value(subopts, tup[0]);
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head);
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head, tup);
janetc_freeslot(c, head);
}
ret.flags &= ~JANET_SLOT_SPLICED;
}
break;
/* Data Constructors */
case JANET_SYMBOL:
ret = janetc_resolve(c, janet_unwrap_symbol(x));
break;
@@ -856,19 +979,21 @@ void janet_def_addflags(JanetFuncDef *def) {
int32_t set_flags = 0;
int32_t unset_flags = 0;
/* pos checks */
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
if (def->named_args_count) set_flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
/* negative checks */
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
if (!def->named_args_count) unset_flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
/* Update flags */
def->flags |= set_flags;
def->flags &= ~unset_flags;
@@ -939,8 +1064,9 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
JANET_OUT_OF_MEMORY;
}
memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks);
/* fprintf(stderr, "slot chunks: %d, scope->ua.count: %d, numchunks: %d\n", slotchunks, scope->ua.count, numchunks); */
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
if (scope->ua.count > 7 && slotchunks > 7) chunks[7] &= 0xFFFFU;
def->closure_bitset = chunks;
}
@@ -960,7 +1086,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
if (pair.sym2) {
JanetSymbolMap jsm;
jsm.birth_pc = UINT32_MAX;
jsm.death_pc = j;
jsm.death_pc = j; /* Use death_pc to encode environment index */
jsm.slot_index = pair.slot.index;
jsm.symbol = pair.sym2;
janet_v_push(locals, jsm);
@@ -974,6 +1100,10 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
SymPair pair = scope->syms[i];
if (pair.sym2) {
JanetSymbolMap jsm;
/* Check for unused symbols */
if (pair.referenced == 0 && pair.sym) {
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is unused", janet_wrap_symbol(pair.sym));
}
if (pair.death_pc == UINT32_MAX) {
jsm.death_pc = def->bytecode_length;
} else {
@@ -1018,6 +1148,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where,
c->current_mapping.line = -1;
c->current_mapping.column = -1;
c->lints = lints;
c->is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
/* Init result */
c->result.error = NULL;
c->result.status = JANET_COMPILE_OK;
@@ -1082,6 +1213,7 @@ JANET_CORE_FN(cfun_compile,
"struct with keys :line, :column, and :error if compilation fails. "
"If a `lints` array is given, linting messages will be appended to the array. "
"Each message will be a tuple of the form `(level line col message)`.") {
janet_sandbox_assert(JANET_SANDBOX_COMPILE);
janet_arity(argc, 1, 4);
JanetTable *env = (argc > 1 && !janet_checktype(argv[1], JANET_NIL))
? janet_gettable(argv, 1) : janet_vm.fiber->env;
src/core/compile.h
+22 -3
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -36,6 +36,15 @@ typedef enum {
JANET_C_LINT_STRICT
} JanetCompileLintLevel;
/* Kinds of variable shadowing for linting */
typedef enum {
JANETC_SHADOW_NONE,
JANETC_SHADOW_MACRO,
JANETC_SHADOW_GLOBAL_HIDES_GLOBAL,
JANETC_SHADOW_LOCAL_HIDES_GLOBAL,
JANETC_SHADOW_LOCAL_HIDES_LOCAL
} Shadowing;
/* Tags for some functions for the prepared inliner */
#define JANET_FUN_DEBUG 1
#define JANET_FUN_ERROR 2
@@ -114,6 +123,7 @@ typedef struct SymPair {
const uint8_t *sym;
const uint8_t *sym2;
int keep;
int referenced; /* Has this value been used */
uint32_t birth_pc;
uint32_t death_pc;
} SymPair;
@@ -183,6 +193,9 @@ struct JanetCompiler {
/* Collect linting results */
JanetArray *lints;
/* Cached version of (dyn *redef*) */
int is_redef;
};
#define JANET_FOPTS_TAIL 0x10000
@@ -220,8 +233,11 @@ const JanetFunOptimizer *janetc_funopt(uint32_t flags);
/* Get a special. Return NULL if none exists */
const JanetSpecial *janetc_special(const uint8_t *name);
#define JANET_DEFFLAG_NO_SHADOWCHECK 1
#define JANET_DEFFLAG_NO_UNUSED 2
void janetc_freeslot(JanetCompiler *c, JanetSlot s);
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags);
JanetSlot janetc_farslot(JanetCompiler *c);
/* Throw away some code after checking that it is well formed. */
@@ -265,12 +281,15 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
/* Create a destroy slot */
JanetSlot janetc_cslot(Janet x);
/* Search for a symbol */
/* Search for a symbol, and mark any found symbols as "used" for dead code elimination and linting */
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
/* Load the system dialect IR */
void janet_lib_sysir(JanetTable *env);
/* Check if a symbol is already in scope for shadowing lints */
Shadowing janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym);
/* Bytecode optimization */
void janet_bytecode_movopt(JanetFuncDef *def);
void janet_bytecode_remove_noops(JanetFuncDef *def);
src/core/corelib.c
+169 -123
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -27,6 +27,7 @@
#include "compile.h"
#include "state.h"
#include "util.h"
#include "fiber.h"
#endif
/* Generated bytes */
@@ -69,7 +70,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
host.minor != modconf.minor ||
host.bits != modconf.bits) {
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) - native needs to be recompiled!",
host.major,
host.minor,
host.patch,
@@ -294,6 +295,7 @@ JANET_CORE_FN(janet_core_native,
"from the native module.") {
JanetModule init;
janet_arity(argc, 1, 2);
Janet argv0 = argv[0];
const uint8_t *path = janet_getstring(argv, 0);
const uint8_t *error = NULL;
JanetTable *env;
@@ -306,17 +308,19 @@ JANET_CORE_FN(janet_core_native,
if (!init) {
janet_panicf("could not load native %S: %S", path, error);
}
/* GC root incase garbage collection called inside module entry */
janet_fiber_push(janet_vm.fiber, janet_wrap_table(env));
init(env);
janet_table_put(env, janet_ckeywordv("native"), argv[0]);
janet_table_put(env, janet_ckeywordv("native"), argv0);
return janet_wrap_table(env);
}
JANET_CORE_FN(janet_core_describe,
"(describe x)",
"Returns a string that is a human-readable description of `x`. "
"For recursive data structures, the string returned contains a "
"pointer value from which the identity of `x` "
"can be determined.") {
"Returns a string that is a human-readable description of "
"`x`. For indexed, dictionary, fiber, pointer, and some "
"abstract types, the string returned contains a pointer "
"value from which the identity of `x` can be determined.") {
JanetBuffer *b = janet_buffer(0);
for (int32_t i = 0; i < argc; ++i)
janet_description_b(b, argv[i]);
@@ -437,28 +441,33 @@ JANET_CORE_FN(janet_core_range,
start = janet_getnumber(argv, 0);
stop = janet_getnumber(argv, 1);
step = janet_getnumber(argv, 2);
count = (step > 0) ? (stop - start) / step :
((step < 0) ? (stop - start) / step : 0);
count = (step > 0.0) ? (stop - start) / step :
((step < 0.0) ? (stop - start) / step : 0.0);
} else if (argc == 2) {
start = janet_getnumber(argv, 0);
stop = janet_getnumber(argv, 1);
start = janet_getnumber(argv, 0.0);
stop = janet_getnumber(argv, 1.0);
count = stop - start;
} else {
stop = janet_getnumber(argv, 0);
stop = janet_getnumber(argv, 0.0);
count = stop;
}
count = (count > 0) ? count : 0;
if (isinf(step)) {
janet_panic("infinite step not allowed");
}
count = (count > 0.0) ? count : 0.0;
int32_t int_count;
janet_assert(count >= 0, "bad range code");
janet_assert(count >= 0.0, "bad range code (count)");
if (count > (double) INT32_MAX) {
janet_panicf("range is too large, %f elements", count);
} else {
int_count = (int32_t) ceil(count);
}
if (step > 0.0) {
janet_assert(start + int_count * step >= stop, "bad range code");
} else {
janet_assert(start + int_count * step <= stop, "bad range code");
if (int_count) { /* e.g. (range 10 0 0) */
if (step > 0.0) {
janet_assert(start + int_count * step >= stop, "bad range code (+step)");
} else {
janet_assert(start + int_count * step <= stop, "bad range code (-step)");
}
}
JanetArray *array = janet_array(int_count);
for (int32_t i = 0; i < int_count; i++) {
@@ -568,20 +577,21 @@ JANET_CORE_FN(janet_core_gcinterval,
JANET_CORE_FN(janet_core_type,
"(type x)",
"Returns the type of `x` as a keyword. `x` is one of:\n\n"
"* :nil\n\n"
"* :boolean\n\n"
"* :number\n\n"
"* :array\n\n"
"* :tuple\n\n"
"* :table\n\n"
"* :struct\n\n"
"* :string\n\n"
"* :buffer\n\n"
"* :symbol\n\n"
"* :keyword\n\n"
"* :function\n\n"
"* :cfunction\n\n"
"* :fiber\n\n"
"* :number\n"
"* :nil\n"
"* :boolean\n"
"* :fiber\n"
"* :string\n"
"* :symbol\n"
"* :keyword\n"
"* :array\n"
"* :tuple\n"
"* :table\n"
"* :struct\n"
"* :buffer\n"
"* :function\n"
"* :cfunction\n"
"* :pointer\n\n"
"or another keyword for an abstract type.") {
janet_fixarity(argc, 1);
JanetType t = janet_type(argv[0]);
@@ -746,8 +756,11 @@ typedef struct SandboxOption {
static const SandboxOption sandbox_options[] = {
{"all", JANET_SANDBOX_ALL},
{"asm", JANET_SANDBOX_ASM},
{"chroot", JANET_SANDBOX_CHROOT},
{"compile", JANET_SANDBOX_COMPILE},
{"env", JANET_SANDBOX_ENV},
{"exit", JANET_SANDBOX_EXIT},
{"ffi", JANET_SANDBOX_FFI},
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
{"ffi-jit", JANET_SANDBOX_FFI_JIT},
@@ -764,6 +777,8 @@ static const SandboxOption sandbox_options[] = {
{"sandbox", JANET_SANDBOX_SANDBOX},
{"signal", JANET_SANDBOX_SIGNAL},
{"subprocess", JANET_SANDBOX_SUBPROCESS},
{"threads", JANET_SANDBOX_THREADS},
{"unmarshal", JANET_SANDBOX_UNMARSHAL},
{NULL, 0}
};
@@ -772,8 +787,11 @@ JANET_CORE_FN(janet_core_sandbox,
"Disable feature sets to prevent the interpreter from using certain system resources. "
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
"* :asm - disallow calling `asm` and `disasm` functions.\n"
"* :chroot - disallow calling `os/posix-chroot`\n"
"* :compile - disallow calling `compile`. This will disable a lot of functionality, such as `eval`.\n"
"* :env - disallow reading and write env variables\n"
"* :exit - disallow calling `os/exit` or otherwise early exiting the process in trivial ways.\n"
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
"* :ffi-jit - disallow calling `ffi/jitfn`\n"
@@ -789,7 +807,9 @@ JANET_CORE_FN(janet_core_sandbox,
"* :net-listen - disallow accepting inbound network connections\n"
"* :sandbox - disallow calling this function\n"
"* :signal - disallow adding or removing signal handlers\n"
"* :subprocess - disallow running subprocesses") {
"* :subprocess - disallow running subprocesses\n"
"* :threads - disallow spawning threads with `ev/thread`. Certain helper threads may still be spawned.\n"
"* :unmarshal - disallow calling the `unmarshal` function.\n") {
uint32_t flags = 0;
for (int32_t i = 0; i < argc; i++) {
JanetKeyword kw = janet_getkeyword(argv, i);
@@ -997,11 +1017,11 @@ static void make_apply(JanetTable *env) {
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
JDOC("(apply f & args)\n\n"
"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, which is expected to be an array or a tuple. "
"Each element in this last argument is then also pushed as an "
"argument to f."));
"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, which is expected to be an array or a tuple. "
"Each element in this last argument is then also pushed as an "
"argument to f."));
}
static const uint32_t error_asm[] = {
@@ -1154,82 +1174,104 @@ JanetTable *janet_core_env(JanetTable *replacements) {
janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n"
"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."));
"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."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"
"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 "
"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 "
"returns nil, there are no more keys to iterate through."));
JDOC("(next x &opt key)\n\n"
"Gets the next key in `x`. Can be used to iterate through "
"the keys of `x` in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if `x` is not mutated "
"during iteration. If `key` is `nil`, returns the first key. "
"If `nil` is returned, there are no more keys to iterate "
"through.\n"
"\n"
"`x` can be a bytes, indexed, dictionary, fiber, or abstract "
"type with a suitable `next` method."));
janet_quick_asm(env, JANET_FUN_PROP,
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
JDOC("(propagate x fiber)\n\n"
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n"
"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."));
"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."));
janet_quick_asm(env, JANET_FUN_ERROR,
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
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,
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
JDOC("(yield &opt x)\n\n"
"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 "
"return the value that was passed to resume."));
"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 "
"return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_CANCEL,
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
JDOC("(cancel fiber err)\n\n"
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n"
"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 "
"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."));
"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 "
"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."));
janet_quick_asm(env, JANET_FUN_IN,
"in", 3, 2, 3, 4, in_asm, sizeof(in_asm),
JDOC("(in ds key &opt dflt)\n\n"
"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, "
"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."));
JDOC("(in x key &opt dflt)\n\n"
"Get value in `x` at `key`. For bytes and indexed "
"types, `key` must be a non-negative interger in "
"bounds or an error is raised. For dictionaries "
"`key` must be a non-nil value and if not found, "
"will return `dflt` if provided or `nil` otherwise.\n"
"\n"
"`x` can be a bytes, indexed, dictionary, fiber, or "
"abstract type with a suitable `get` method."));
janet_quick_asm(env, JANET_FUN_GET,
"get", 3, 2, 3, 4, get_asm, sizeof(in_asm),
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. "
"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 "
"an error."));
JDOC("(get x key &opt dflt)\n\n"
"Get the value mapped to `key` in `x`. Returns `dflt` "
"or `nil` if `key` is not found. Similar to `in`, but "
"will not throw an error if `key` is invalid for `x`. "
"However, if `x` is an abstract type, its getter may "
"throw an error.\n"
"\n"
"`x` can be a bytes, indexed, dictionary, fiber, or "
"abstract type with a suitable `get` method."));
janet_quick_asm(env, JANET_FUN_PUT,
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
JDOC("(put ds key value)\n\n"
"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 "
"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 "
"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."));
JDOC("(put x key val)\n\n"
"Associate `key` with `val` for mutable `x`. Arrays "
"and buffers only accept non-negative integer keys, "
"and will expand if an out of bounds value is "
"provided. For an array, extra space will be filled "
"with `nil`s, while for buffers, 0 bytes are used "
"instead. For a table, putting a key that is in the "
"table prototype will hide the association defined by "
"the prototype, but will not mutate the prototype "
"table. Putting a `nil` value into a table will "
"remove the table's corresponding association. "
"Returns `x`."));
janet_quick_asm(env, JANET_FUN_LENGTH,
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
JDOC("(length ds)\n\n"
"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."));
JDOC("(length x)\n\n"
"Returns the length or count of `x` as an integer. "
"Returns are guaranteed to be in constant time "
"except for abstract types. For dictionaries, "
"returns the number of key-value pairs.\n"
"\n"
"`x` can be a bytes, indexed, dictionary, or "
"abstract type with a suitable `length` method."));
janet_quick_asm(env, JANET_FUN_BNOT,
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
@@ -1238,74 +1280,74 @@ JanetTable *janet_core_env(JanetTable *replacements) {
/* Variadic ops */
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
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. If xs is empty, return 0."));
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
JDOC("(- & xs)\n\n"
"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 "
"the rest of the elements."));
"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 "
"the rest of the elements."));
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
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,
JDOC("(/ & xs)\n\n"
"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 "
"values."));
"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 "
"values."));
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
JDOC("(div & xs)\n\n"
"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 "
"values."));
"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 "
"values."));
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
JDOC("(mod & xs)\n\n"
"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`."));
"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`."));
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
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,
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,
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,
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 x in xs must be an integer."));
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
JDOC("(blshift x & shifts)\n\n"
"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."));
"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."));
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
JDOC("(brshift x & shifts)\n\n"
"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."));
"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."));
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
JDOC("(brushift x & shifts)\n\n"
"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 "
"for positive shifts the return value will always be positive."));
"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 "
"for positive shifts the return value will always be positive."));
/* Variadic comparators */
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
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,
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,
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,
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,
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,
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 */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
@@ -1314,7 +1356,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("The build identifier of the running janet program."));
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 "
"if native modules are compatible with the host program."));
"if native modules are compatible with the host program."));
/* Allow references to the environment */
janet_def(env, "root-env", janet_wrap_table(env),
@@ -1354,12 +1396,16 @@ JanetTable *janet_core_env(JanetTable *replacements) {
lidv = midv = janet_wrap_nil();
janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
JanetTable *lid = janet_unwrap_table(lidv);
JanetTable *mid = janet_unwrap_table(midv);
for (int32_t i = 0; i < lid->capacity; i++) {
const JanetKV *kv = lid->data + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_table_put(mid, kv->value, kv->key);
/* Check that we actually got tables - if we are using a smaller corelib, may not exist */
if (janet_checktype(lidv, JANET_TABLE) && janet_checktype(midv, JANET_TABLE)) {
JanetTable *lid = janet_unwrap_table(lidv);
JanetTable *mid = janet_unwrap_table(midv);
for (int32_t i = 0; i < lid->capacity; i++) {
const JanetKV *kv = lid->data + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_table_put(mid, kv->value, kv->key);
}
}
}
src/core/debug.c
+22 -9
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -343,14 +343,25 @@ static Janet doframe(JanetStackFrame *frame) {
Janet value = janet_wrap_nil();
uint32_t pc = (uint32_t)(frame->pc - def->bytecode);
if (jsm.birth_pc == UINT32_MAX) {
JanetFuncEnv *env = frame->func->envs[jsm.death_pc];
if (env->offset > 0) {
value = env->as.fiber->data[env->offset + jsm.slot_index];
} else {
value = env->as.values[jsm.slot_index];
/* death_pc has secondary meaning here, we use it to encode the environment index */
if (jsm.death_pc < (uint32_t) def->environments_length) {
/* death_pc is in valid range */
JanetFuncEnv *env = frame->func->envs[jsm.death_pc];
if (jsm.slot_index < (uint32_t) env->length) {
/* slot_index range good */
if (env->offset > 0) {
/* On stack */
value = env->as.fiber->data[env->offset + jsm.slot_index];
} else {
/* Off stack */
value = env->as.values[jsm.slot_index];
}
}
}
} else if (pc >= jsm.birth_pc && pc < jsm.death_pc) {
value = stack[jsm.slot_index];
if (jsm.slot_index < (uint32_t) def->slotcount) {
value = stack[jsm.slot_index];
}
}
janet_table_put(local_bindings, janet_wrap_symbol(jsm.symbol), value);
}
@@ -411,8 +422,10 @@ JANET_CORE_FN(cfun_debug_argstack,
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
memcpy(array->data, fiber->data + fiber->stackstart, array->capacity * sizeof(Janet));
array->count = array->capacity;
if (array->capacity) {
memcpy(array->data, fiber->data + fiber->stackstart, array->capacity * sizeof(Janet));
array->count = array->capacity;
}
return janet_wrap_array(array);
}
src/core/emit.c
+31 -18
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -78,10 +78,10 @@ static int32_t janetc_const(JanetCompiler *c, Janet x) {
static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
switch (janet_type(k)) {
case JANET_NIL:
janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
janetc_emit(c, ((uint32_t) reg << 8) | JOP_LOAD_NIL);
break;
case JANET_BOOLEAN:
janetc_emit(c, (reg << 8) |
janetc_emit(c, ((uint32_t) reg << 8) |
(janet_unwrap_boolean(k) ? JOP_LOAD_TRUE : JOP_LOAD_FALSE));
break;
case JANET_NUMBER: {
@@ -93,8 +93,8 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
goto do_constant;
uint32_t iu = (uint32_t)i;
janetc_emit(c,
(iu << 16) |
(reg << 8) |
((uint32_t) iu << 16) |
((uint32_t) reg << 8) |
JOP_LOAD_INTEGER);
break;
}
@@ -102,8 +102,8 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
do_constant: {
int32_t cindex = janetc_const(c, k);
janetc_emit(c,
(cindex << 16) |
(reg << 8) |
((uint32_t) cindex << 16) |
((uint32_t) reg << 8) |
JOP_LOAD_CONSTANT);
break;
}
@@ -114,13 +114,14 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
static void janetc_movenear(JanetCompiler *c,
int32_t dest,
JanetSlot src) {
janet_assert(dest <= 255, "dest slot index must be <= 255");
if (src.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) {
janetc_loadconst(c, src.constant, dest);
/* If we also are a reference, deref the one element array */
if (src.flags & JANET_SLOT_REF) {
janetc_emit(c,
(dest << 16) |
(dest << 8) |
((uint32_t) dest << 16) |
((uint32_t) dest << 8) |
JOP_GET_INDEX);
}
} else if (src.envindex >= 0) {
@@ -138,7 +139,7 @@ static void janetc_movenear(JanetCompiler *c,
}
}
/* Move a near register to a Slot. */
/* Move a near or far register to a Slot. */
static void janetc_moveback(JanetCompiler *c,
JanetSlot dest,
int32_t src) {
@@ -146,11 +147,17 @@ static void janetc_moveback(JanetCompiler *c,
int32_t refreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_5);
janetc_loadconst(c, dest.constant, refreg);
janetc_emit(c,
(src << 16) |
(refreg << 8) |
((uint32_t) src << 16) |
((uint32_t) refreg << 8) |
JOP_PUT_INDEX);
janetc_regalloc_freetemp(&c->scope->ra, refreg, JANETC_REGTEMP_5);
} else if (dest.envindex >= 0) {
/* Convert src to near reg */
if (src > 255) {
int32_t newsrc = JANETC_REGTEMP_5 + 0xF0;
janetc_emit(c, JOP_MOVE_NEAR | ((uint32_t)(src) << 16) | ((uint32_t) newsrc << 8));
src = newsrc;
}
janetc_emit(c,
((uint32_t)(dest.index) << 24) |
((uint32_t)(dest.envindex) << 16) |
@@ -158,6 +165,12 @@ static void janetc_moveback(JanetCompiler *c,
JOP_SET_UPVALUE);
} else if (dest.index != src) {
janet_assert(dest.index >= 0, "bad slot");
/* Convert src to near reg */
if (src > 255) {
int32_t newsrc = JANETC_REGTEMP_5 + 0xF0;
janetc_emit(c, JOP_MOVE_NEAR | ((uint32_t)(src) << 16) | ((uint32_t)newsrc << 8));
src = newsrc;
}
janetc_emit(c,
((uint32_t)(dest.index) << 16) |
((uint32_t)(src) << 8) |
@@ -186,7 +199,7 @@ static int32_t janetc_regfar(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp t
janetc_movenear(c, nearreg, s);
if (nearreg >= 0xF0) {
reg = janetc_allocfar(c);
janetc_emit(c, JOP_MOVE_FAR | (nearreg << 8) | (reg << 16));
janetc_emit(c, JOP_MOVE_FAR | ((uint32_t) nearreg << 8) | ((uint32_t) reg << 16));
janetc_regalloc_freetemp(&c->scope->ra, nearreg, tag);
} else {
reg = nearreg;
@@ -255,7 +268,7 @@ void janetc_copy(
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
int32_t reg = janetc_regnear(c, s, JANETC_REGTEMP_0);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg << 8) | ((uint32_t)rest << 16));
janetc_emit(c, op | ((uint32_t) reg << 8) | ((uint32_t) rest << 16));
if (wr)
janetc_moveback(c, s, reg);
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
@@ -265,7 +278,7 @@ static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, i
int32_t janetc_emit_s(JanetCompiler *c, uint8_t op, JanetSlot s, int wr) {
int32_t reg = janetc_regfar(c, s, JANETC_REGTEMP_0);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg << 8));
janetc_emit(c, op | ((uint32_t) reg << 8));
if (wr)
janetc_moveback(c, s, reg);
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
@@ -297,7 +310,7 @@ static int32_t emit2s(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2,
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)rest << 24));
janetc_emit(c, op | ((uint32_t) reg1 << 8) | ((uint32_t) reg2 << 16) | ((uint32_t)rest << 24));
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
if (wr)
janetc_moveback(c, s1, reg1);
@@ -309,7 +322,7 @@ int32_t janetc_emit_ss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2,
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
int32_t reg2 = janetc_regfar(c, s2, JANETC_REGTEMP_1);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16));
janetc_emit(c, op | ((uint32_t) reg1 << 8) | ((uint32_t) reg2 << 16));
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
if (wr)
janetc_moveback(c, s1, reg1);
@@ -330,7 +343,7 @@ int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
int32_t reg3 = janetc_regnear(c, s3, JANETC_REGTEMP_2);
int32_t label = janet_v_count(c->buffer);
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)reg3 << 24));
janetc_emit(c, op | ((uint32_t) reg1 << 8) | ((uint32_t) reg2 << 16) | ((uint32_t) reg3 << 24));
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
janetc_free_regnear(c, s3, reg3, JANETC_REGTEMP_2);
if (wr)
src/core/emit.h
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/ev.c
+171 -100
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -326,6 +326,9 @@ static void janet_stream_checktoclose(JanetStream *stream) {
/* Forward declaration */
static void janet_register_stream(JanetStream *stream);
#ifndef JANET_WINDOWS
static void janet_unregister_stream(JanetStream *stream);
#endif
static const JanetMethod ev_default_stream_methods[] = {
{"close", janet_cfun_stream_close},
@@ -357,6 +360,8 @@ JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod
static void janet_stream_close_impl(JanetStream *stream) {
stream->flags |= JANET_STREAM_CLOSED;
int canclose = !(stream->flags & JANET_STREAM_NOT_CLOSEABLE);
/* If we are positive that the stream is the last instance of the underlying file description (such that "dup" was never called on the file description)
* then skip unregister to save a syscall */
#ifdef JANET_WINDOWS
if (stream->handle != INVALID_HANDLE_VALUE) {
#ifdef JANET_NET
@@ -370,19 +375,11 @@ static void janet_stream_close_impl(JanetStream *stream) {
stream->handle = INVALID_HANDLE_VALUE;
}
#else
int canunregister = !(stream->flags & JANET_STREAM_UNREGISTERED);
if (stream->handle != -1) {
if (canunregister) janet_unregister_stream(stream);
if (canclose) close(stream->handle);
stream->handle = -1;
#ifdef JANET_EV_POLL
uint32_t i = stream->index;
size_t j = janet_vm.stream_count - 1;
JanetStream *last = janet_vm.streams[j];
struct pollfd lastfd = janet_vm.fds[j + 1];
janet_vm.fds[i + 1] = lastfd;
janet_vm.streams[i] = last;
last->index = stream->index;
janet_vm.stream_count--;
#endif
}
#endif
}
@@ -433,9 +430,10 @@ static int janet_stream_getter(void *p, Janet key, Janet *out) {
static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
JanetStream *s = p;
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
if (!(janet_marshal_flags(ctx) & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only marshal stream with unsafe flag");
}
s->flags &= ~JANET_STREAM_NODUPS; /* This stream now might be duplicated, invalidates some EV optimizations */
janet_marshal_abstract(ctx, p);
janet_marshal_int(ctx, (int32_t) s->flags);
janet_marshal_ptr(ctx, s->methods);
@@ -467,7 +465,7 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
}
static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
if (!(janet_unmarshal_flags(ctx) & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only unmarshal stream with unsafe flag");
}
JanetStream *p = janet_unmarshal_abstract(ctx, sizeof(JanetStream));
@@ -515,18 +513,18 @@ const JanetAbstractType janet_stream_type = {
/* Register a fiber to resume with value */
static void janet_schedule_general(JanetFiber *fiber, Janet value, JanetSignal sig, int soon) {
if (fiber->gc.flags & JANET_FIBER_EV_FLAG_CANCELED) return;
if (!(fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
if (fiber->gc.flags & JANET_FIBER_EV_GCFLAG_CANCELED) return;
if (!(fiber->gc.flags & JANET_FIBER_EV_GCFLAG_ROOT)) {
fiber->gc.flags |= JANET_FIBER_EV_GCFLAG_ROOT;
Janet task_element = janet_wrap_fiber(fiber);
janet_table_put(&janet_vm.active_tasks, task_element, janet_wrap_true());
}
JanetTask t = { fiber, value, sig, ++fiber->sched_id };
fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_FLAG_CANCELED;
if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_GCFLAG_CANCELED;
if (soon) {
janet_q_push_head(&janet_vm.spawn, &t, sizeof(t));
janet_assert(!janet_q_push_head(&janet_vm.spawn, &t, sizeof(t)), "schedule queue overflow");
} else {
janet_q_push(&janet_vm.spawn, &t, sizeof(t));
janet_assert(!janet_q_push(&janet_vm.spawn, &t, sizeof(t)), "schedule queue overflow");
}
}
@@ -539,6 +537,9 @@ void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig) {
}
void janet_cancel(JanetFiber *fiber, Janet value) {
if (!(fiber->gc.flags & JANET_FIBER_EV_GCFLAG_ROOT)) {
janet_panic("cannot cancel non-task fiber");
}
janet_schedule_signal(fiber, value, JANET_SIGNAL_ERROR);
}
@@ -610,7 +611,7 @@ void janet_ev_init_common(void) {
#if JANET_ANDROID
static void janet_timeout_stop(int sig_num) {
if (sig_num == SIGUSR1) {
pthread_exit(0);
pthread_exit(NULL);
}
}
#endif
@@ -699,7 +700,7 @@ static DWORD WINAPI janet_timeout_body(LPVOID ptr) {
DWORD duration = (DWORD)round(tto.sec * 1000);
DWORD res = WAIT_TIMEOUT;
JanetTimestamp wait_end = ts_now();
for (size_t i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) {
for (DWORD i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) {
res = WaitForSingleObject(tto.cancel_event, (duration + i));
wait_end = ts_now();
}
@@ -956,11 +957,12 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
janet_schedule(fiber, janet_wrap_nil());
}
} else if (mode != JANET_CP_MODE_CLOSE) {
/* Fiber has already been cancelled or resumed. */
/* Fiber has already been canceled or resumed. */
/* Resend event to another waiting thread, depending on mode */
int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ);
if (is_read) {
JanetChannelPending reader;
int sent = 0;
while (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
JanetVM *vm = reader.thread;
if (!vm) continue;
@@ -971,8 +973,12 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
msg.argp = channel;
msg.argj = x;
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
sent = 1;
break;
}
if (!sent) {
janet_chan_unpack(channel, &x, 1);
}
} else {
JanetChannelPending writer;
while (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
@@ -998,14 +1004,14 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode) {
JanetChannelPending reader;
int is_empty;
if (janet_chan_pack(channel, &x)) {
janet_chan_unlock(channel);
janet_panicf("failed to pack value for channel: %v", x);
}
if (channel->closed) {
janet_chan_unlock(channel);
janet_panic("cannot write to closed channel");
}
if (janet_chan_pack(channel, &x)) {
janet_chan_unlock(channel);
janet_panicf("failed to pack value for channel: %v", x);
}
int is_threaded = janet_chan_is_threaded(channel);
if (is_threaded) {
/* don't dereference fiber from another thread */
@@ -1018,6 +1024,7 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
if (is_empty) {
/* No pending reader */
if (janet_q_push(&channel->items, &x, sizeof(Janet))) {
janet_chan_unpack(channel, &x, 1);
janet_chan_unlock(channel);
janet_panicf("channel overflow: %v", x);
} else if (janet_q_count(&channel->items) > channel->limit) {
@@ -1051,6 +1058,9 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
msg.argj = x;
if (vm) {
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
} else {
/* If no vm to send to, we must clean up (unpack) the packed payload to avoid leak */
janet_chan_unpack(channel, &x, 1);
}
} else {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
@@ -1082,7 +1092,7 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i
int is_threaded = janet_chan_is_threaded(channel);
if (janet_q_pop(&channel->items, item, sizeof(Janet))) {
/* Queue empty */
if (is_choice == 2) return 0; // Skip pending read
if (is_choice == 2) return 0; /* Skip pending read */
JanetChannelPending pending;
pending.thread = &janet_vm;
pending.fiber = janet_vm.root_fiber,
@@ -1160,7 +1170,7 @@ JanetChannel *janet_channel_make(uint32_t limit) {
JanetChannel *janet_channel_make_threaded(uint32_t limit) {
janet_assert(limit <= INT32_MAX, "bad limit");
JanetChannel *channel = janet_abstract_threaded(&janet_channel_type, sizeof(JanetChannel));
janet_chan_init(channel, (int32_t) limit, 0);
janet_chan_init(channel, (int32_t) limit, 1);
return channel;
}
@@ -1196,20 +1206,6 @@ JANET_CORE_FN(cfun_channel_pop,
janet_await();
}
static void chan_unlock_args(const Janet *argv, int32_t n) {
for (int32_t i = 0; i < n; i++) {
int32_t len;
const Janet *data;
JanetChannel *chan;
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
chan = janet_getchannel(data, 0);
} else {
chan = janet_getchannel(argv, i);
}
janet_chan_unlock(chan);
}
}
JANET_CORE_FN(cfun_channel_choice,
"(ev/select & clauses)",
"Block until the first of several channel operations occur. Returns a "
@@ -1238,29 +1234,27 @@ JANET_CORE_FN(cfun_channel_choice,
janet_chan_lock(chan);
if (chan->closed) {
janet_chan_unlock(chan);
chan_unlock_args(argv, i);
return make_close_result(chan);
}
if (janet_q_count(&chan->items) < chan->limit) {
janet_channel_push_with_lock(chan, data[1], 1);
chan_unlock_args(argv, i);
return make_write_result(chan);
}
janet_chan_unlock(chan);
} else {
/* Read */
JanetChannel *chan = janet_getchannel(argv, i);
janet_chan_lock(chan);
if (chan->closed) {
janet_chan_unlock(chan);
chan_unlock_args(argv, i);
return make_close_result(chan);
}
if (chan->items.head != chan->items.tail) {
Janet item;
janet_channel_pop_with_lock(chan, &item, 1);
chan_unlock_args(argv, i);
return make_read_result(chan, item);
}
janet_chan_unlock(chan);
}
}
@@ -1269,11 +1263,13 @@ JANET_CORE_FN(cfun_channel_choice,
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
/* Write */
JanetChannel *chan = janet_getchannel(data, 0);
janet_chan_lock(chan);
janet_channel_push_with_lock(chan, data[1], 1);
} else {
/* Read */
Janet item;
JanetChannel *chan = janet_getchannel(argv, i);
janet_chan_lock(chan);
janet_channel_pop_with_lock(chan, &item, 1);
}
}
@@ -1376,7 +1372,7 @@ JANET_CORE_FN(cfun_channel_close,
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else {
if (janet_fiber_can_resume(writer.fiber)) {
if (janet_fiber_can_resume(writer.fiber) && writer.sched_id == writer.fiber->sched_id) {
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
janet_schedule(writer.fiber, make_close_result(channel));
} else {
@@ -1399,7 +1395,7 @@ JANET_CORE_FN(cfun_channel_close,
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
}
} else {
if (janet_fiber_can_resume(reader.fiber)) {
if (janet_fiber_can_resume(reader.fiber) && reader.sched_id == reader.fiber->sched_id) {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
janet_schedule(reader.fiber, make_close_result(channel));
} else {
@@ -1469,11 +1465,12 @@ static void *janet_chanat_unmarshal(JanetMarshalContext *ctx) {
int32_t limit = janet_unmarshal_int(ctx);
int32_t count = janet_unmarshal_int(ctx);
if (count < 0) janet_panic("invalid negative channel count");
if (count > limit) janet_panic("invalid channel count");
janet_chan_init(abst, limit, 0);
abst->closed = !!is_closed;
for (int32_t i = 0; i < count; i++) {
Janet item = janet_unmarshal_janet(ctx);
janet_q_push(&abst->items, &item, sizeof(item));
janet_assert(!janet_q_push(&abst->items, &item, sizeof(item)), "bad unmarshal channel");
}
return abst;
}
@@ -1535,8 +1532,8 @@ JanetFiber *janet_loop1(void) {
if (janet_atomic_load_relaxed(&janet_vm.auto_suspend)) break;
JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK, 0};
janet_q_pop(&janet_vm.spawn, &task, sizeof(task));
if (task.fiber->gc.flags & JANET_FIBER_EV_FLAG_SUSPENDED) janet_ev_dec_refcount();
task.fiber->gc.flags &= ~(JANET_FIBER_EV_FLAG_CANCELED | JANET_FIBER_EV_FLAG_SUSPENDED);
if (task.fiber->gc.flags & JANET_FIBER_EV_GCFLAG_SUSPENDED) janet_ev_dec_refcount();
task.fiber->gc.flags &= ~(JANET_FIBER_EV_GCFLAG_CANCELED | JANET_FIBER_EV_GCFLAG_SUSPENDED);
if (task.expected_sched_id != task.fiber->sched_id) continue;
Janet res;
JanetSignal sig = janet_continue_signal(task.fiber, task.value, &res, task.sig);
@@ -1546,7 +1543,7 @@ JanetFiber *janet_loop1(void) {
void *sv = task.fiber->supervisor_channel;
int is_suspended = sig == JANET_SIGNAL_EVENT || sig == JANET_SIGNAL_YIELD || sig == JANET_SIGNAL_INTERRUPT;
if (is_suspended) {
task.fiber->gc.flags |= JANET_FIBER_EV_FLAG_SUSPENDED;
task.fiber->gc.flags |= JANET_FIBER_EV_GCFLAG_SUSPENDED;
janet_ev_inc_refcount();
}
if (NULL == sv) {
@@ -1556,7 +1553,7 @@ JanetFiber *janet_loop1(void) {
} else if (sig == JANET_SIGNAL_OK || (task.fiber->flags & (1 << sig))) {
JanetChannel *chan = janet_channel_unwrap(sv);
janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig],
task.fiber, chan->is_threaded), 2);
task.fiber, chan->is_threaded), 2);
} else if (!is_suspended) {
janet_stacktrace_ext(task.fiber, res, "");
}
@@ -1713,20 +1710,20 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
janet_free(response);
} else {
/* Normal event */
JanetOverlapped *jo = (JanetOverlapped *) overlapped;
JanetStream *stream = (JanetStream *) completionKey;
JanetFiber *fiber = NULL;
if (stream->read_fiber && stream->read_fiber->ev_state == overlapped) {
if (stream->read_fiber && stream->read_fiber->ev_state == jo) {
fiber = stream->read_fiber;
} else if (stream->write_fiber && stream->write_fiber->ev_state == overlapped) {
} else if (stream->write_fiber && stream->write_fiber->ev_state == jo) {
fiber = stream->write_fiber;
}
if (fiber != NULL) {
fiber->flags &= ~JANET_FIBER_EV_FLAG_IN_FLIGHT;
/* System is done with this, we can reused this data */
overlapped->InternalHigh = (ULONG_PTR) num_bytes_transferred;
jo->bytes_transfered = (ULONG_PTR) num_bytes_transferred;
fiber->ev_callback(fiber, result ? JANET_ASYNC_EVENT_COMPLETE : JANET_ASYNC_EVENT_FAILED);
} else {
janet_free((void *) overlapped);
janet_free((void *) jo);
janet_ev_dec_refcount();
}
janet_stream_checktoclose(stream);
@@ -1787,6 +1784,18 @@ void janet_stream_level_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1, 0);
}
void janet_unregister_stream(JanetStream *stream) {
if (stream->flags & JANET_STREAM_NODUPS) return;
int status;
do {
status = epoll_ctl(janet_vm.epoll, EPOLL_CTL_DEL, stream->handle, NULL);
} while (status == -1 && errno == EINTR);
if (status == -1) {
janet_panicv(janet_ev_lasterr());
}
stream->flags |= JANET_STREAM_UNREGISTERED;
}
#define JANET_EPOLL_MAX_EVENTS 64
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
struct itimerspec its;
@@ -1963,7 +1972,25 @@ void janet_stream_level_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 0);
}
#define JANET_KQUEUE_MAX_EVENTS 64
void janet_unregister_stream(JanetStream *stream) {
if (stream->flags & JANET_STREAM_NODUPS) return;
struct kevent kevs[2];
int length = 0;
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_DELETE, 0, 0, stream);
}
if (stream->flags & JANET_STREAM_WRITABLE) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_DELETE, 0, 0, stream);
}
int status;
do {
status = kevent(janet_vm.kq, kevs, length, NULL, 0, NULL);
} while (status == -1 && errno == EINTR);
/* Status might be -1 on BSDs for subprocesses */
stream->flags |= JANET_STREAM_UNREGISTERED;
}
#define JANET_KQUEUE_MAX_EVENTS 512
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
/* Poll for events */
@@ -2027,6 +2054,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
void janet_ev_init(void) {
janet_ev_init_common();
/* TODO - replace selfpipe with EVFILT_USER (or other events) */
janet_ev_setup_selfpipe();
janet_vm.kq = kqueue();
janet_vm.timer_enabled = 0;
@@ -2085,6 +2113,18 @@ void janet_register_stream(JanetStream *stream) {
janet_vm.stream_count = new_count;
}
void janet_unregister_stream(JanetStream *stream) {
uint32_t i = stream->index;
size_t j = janet_vm.stream_count - 1;
JanetStream *last = janet_vm.streams[j];
struct pollfd lastfd = janet_vm.fds[j + 1];
janet_vm.fds[i + 1] = lastfd;
janet_vm.streams[i] = last;
last->index = stream->index;
janet_vm.stream_count--;
stream->flags |= JANET_STREAM_UNREGISTERED;
}
void janet_stream_edge_triggered(JanetStream *stream) {
(void) stream;
}
@@ -2326,6 +2366,14 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
/* Default callback for janet_ev_threaded_await. */
void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
if (return_value.fiber == NULL) {
/* Clean up */
switch (return_value.tag) {
default:
case JANET_EV_TCTAG_STRINGF:
case JANET_EV_TCTAG_ERR_STRINGF:
janet_free(return_value.argp);
break;
}
return;
}
if (janet_fiber_can_resume(return_value.fiber)) {
@@ -2340,7 +2388,6 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
case JANET_EV_TCTAG_STRING:
case JANET_EV_TCTAG_STRINGF:
janet_schedule(return_value.fiber, janet_cstringv((const char *) return_value.argp));
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
break;
case JANET_EV_TCTAG_KEYWORD:
janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
@@ -2348,7 +2395,6 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
case JANET_EV_TCTAG_ERR_STRING:
case JANET_EV_TCTAG_ERR_STRINGF:
janet_cancel(return_value.fiber, janet_cstringv((const char *) return_value.argp));
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
break;
case JANET_EV_TCTAG_ERR_KEYWORD:
janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
@@ -2358,6 +2404,14 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
break;
}
}
/* Clean up */
switch (return_value.tag) {
default:
case JANET_EV_TCTAG_STRINGF:
case JANET_EV_TCTAG_ERR_STRINGF:
janet_free(return_value.argp);
break;
}
janet_gcunroot(janet_wrap_fiber(return_value.fiber));
}
@@ -2411,7 +2465,7 @@ Janet janet_ev_lasterr(void) {
msgbuf,
sizeof(msgbuf),
NULL);
if (!*msgbuf) sprintf(msgbuf, "%d", code);
if (!*msgbuf) snprintf(msgbuf, sizeof(msgbuf), "%d", code);
char *c = msgbuf;
while (*c) {
if (*c == '\n' || *c == '\r') {
@@ -2438,7 +2492,7 @@ typedef enum {
typedef struct {
#ifdef JANET_WINDOWS
OVERLAPPED overlapped;
JanetOverlapped overlapped;
DWORD flags;
#ifdef JANET_NET
WSABUF wbuf;
@@ -2473,7 +2527,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
case JANET_ASYNC_EVENT_FAILED:
case JANET_ASYNC_EVENT_COMPLETE: {
/* Called when read finished */
uint32_t ev_bytes = (uint32_t) state->overlapped.InternalHigh;
uint32_t ev_bytes = (uint32_t) state->overlapped.bytes_transfered;
state->bytes_read += ev_bytes;
if (state->bytes_read == 0 && (state->mode != JANET_ASYNC_READMODE_RECVFROM)) {
janet_schedule(fiber, janet_wrap_nil());
@@ -2505,7 +2559,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
/* fallthrough */
case JANET_ASYNC_EVENT_INIT: {
int32_t chunk_size = state->bytes_left > JANET_EV_CHUNKSIZE ? JANET_EV_CHUNKSIZE : state->bytes_left;
memset(&(state->overlapped), 0, sizeof(OVERLAPPED));
memset(&(state->overlapped), 0, sizeof(JanetOverlapped));
int status;
#ifdef JANET_NET
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
@@ -2513,7 +2567,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
state->wbuf.buf = (char *) state->chunk_buf;
state->fromlen = sizeof(state->from);
status = WSARecvFrom((SOCKET) stream->handle, &state->wbuf, 1,
NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped, NULL);
NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped.as.wsaoverlapped, NULL);
if (status && (WSA_IO_PENDING != WSAGetLastError())) {
janet_cancel(fiber, janet_ev_lasterr());
janet_async_end(fiber);
@@ -2524,9 +2578,9 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
{
/* Some handles (not all) read from the offset in lpOverlapped
* if its not set before calling `ReadFile` these streams will always read from offset 0 */
state->overlapped.Offset = (DWORD) state->bytes_read;
state->overlapped.as.overlapped.Offset = (DWORD) state->bytes_read;
status = ReadFile(stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped);
status = ReadFile(stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped.as.overlapped);
if (!status && (ERROR_IO_PENDING != GetLastError())) {
if (GetLastError() == ERROR_BROKEN_PIPE) {
if (state->bytes_read) {
@@ -2682,7 +2736,7 @@ typedef enum {
typedef struct {
#ifdef JANET_WINDOWS
OVERLAPPED overlapped;
JanetOverlapped overlapped;
DWORD flags;
#ifdef JANET_NET
WSABUF wbuf;
@@ -2723,7 +2777,7 @@ void ev_callback_write(JanetFiber *fiber, JanetAsyncEvent event) {
case JANET_ASYNC_EVENT_FAILED:
case JANET_ASYNC_EVENT_COMPLETE: {
/* Called when write finished */
uint32_t ev_bytes = (uint32_t) state->overlapped.InternalHigh;
uint32_t ev_bytes = (uint32_t) state->overlapped.bytes_transfered;
if (ev_bytes == 0 && (state->mode != JANET_ASYNC_WRITEMODE_SENDTO)) {
janet_cancel(fiber, janet_cstringv("disconnect"));
janet_async_end(fiber);
@@ -2752,7 +2806,7 @@ void ev_callback_write(JanetFiber *fiber, JanetAsyncEvent event) {
bytes = state->src.str;
len = janet_string_length(bytes);
}
memset(&(state->overlapped), 0, sizeof(WSAOVERLAPPED));
memset(&(state->overlapped), 0, sizeof(JanetOverlapped));
int status;
#ifdef JANET_NET
@@ -2762,7 +2816,7 @@ void ev_callback_write(JanetFiber *fiber, JanetAsyncEvent event) {
state->wbuf.len = len;
const struct sockaddr *to = state->dest_abst;
int tolen = (int) janet_abstract_size((void *) to);
status = WSASendTo(sock, &state->wbuf, 1, NULL, state->flags, to, tolen, &state->overlapped, NULL);
status = WSASendTo(sock, &state->wbuf, 1, NULL, state->flags, to, tolen, &state->overlapped.as.wsaoverlapped, NULL);
if (status) {
if (WSA_IO_PENDING == WSAGetLastError()) {
janet_async_in_flight(fiber);
@@ -2785,9 +2839,9 @@ void ev_callback_write(JanetFiber *fiber, JanetAsyncEvent event) {
* for more details see the lpOverlapped parameter in
* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-writefile
*/
state->overlapped.Offset = (DWORD) 0xFFFFFFFF;
state->overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF;
status = WriteFile(stream->handle, bytes, len, NULL, &state->overlapped);
state->overlapped.as.overlapped.Offset = (DWORD) 0xFFFFFFFF;
state->overlapped.as.overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF;
status = WriteFile(stream->handle, bytes, len, NULL, &state->overlapped.as.overlapped);
if (!status) {
if (ERROR_IO_PENDING == GetLastError()) {
janet_async_in_flight(fiber);
@@ -2943,10 +2997,11 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
if (!CreatePipe(handles, handles + 1, &saAttr, 0)) return -1;
return 0;
}
sprintf(PipeNameBuffer,
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
(unsigned int) GetCurrentProcessId(),
(unsigned int) InterlockedIncrement(&PipeSerialNumber));
snprintf(PipeNameBuffer,
sizeof(PipeNameBuffer),
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
(unsigned int) GetCurrentProcessId(),
(unsigned int) InterlockedIncrement(&PipeSerialNumber));
/* server handle goes to subprocess */
shandle = CreateNamedPipeA(
@@ -3002,12 +3057,14 @@ error:
JANET_CORE_FN(cfun_ev_go,
"(ev/go fiber-or-fun &opt value supervisor)",
"Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped "
"with `fiber/new` first. "
"Optionally pass a value to resume with, otherwise resumes with nil. Returns the fiber. "
"An optional `core/channel` can be provided as a supervisor. When various "
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
"If not provided, the new fiber will inherit the current supervisor.") {
"Put a fiber on the event loop to be resumed later. If a "
"function is used, it is wrapped with `fiber/new` first. "
"Returns a task fiber. Optionally pass a value to resume "
"with, otherwise resumes with nil. An optional `core/channel` "
"can be provided as a supervisor. When various events occur "
"in the newly scheduled fiber, an event will be pushed to the "
"supervisor. If not provided, the new fiber will inherit the "
"current supervisor.") {
janet_arity(argc, 1, 3);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
void *supervisor = janet_optabstract(argv, argc, 2, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
@@ -3033,6 +3090,9 @@ JANET_CORE_FN(cfun_ev_go,
fiber->env->proto = janet_vm.fiber->env;
} else {
fiber = janet_getfiber(argv, 0);
if (janet_fiber_status(fiber) != JANET_STATUS_NEW) {
janet_panic("can only schedule new fibers where (= (fiber/status f) :new)");
}
}
fiber->supervisor_channel = supervisor;
janet_schedule(fiber, value);
@@ -3048,6 +3108,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
const uint8_t *endbytes = nextbytes + buffer->count;
uint32_t flags = args.tag;
args.tag = 0;
args.argp = NULL;
janet_init();
janet_vm.sandbox_flags = (uint32_t) args.argi;
JanetTryState tstate;
@@ -3058,7 +3119,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
if (!(flags & 0x2)) {
Janet aregv = janet_unmarshal(nextbytes, endbytes - nextbytes,
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
if (!janet_checktype(aregv, JANET_TABLE)) janet_panic("expected table for abstract registry");
janet_assert(janet_checktype(aregv, JANET_TABLE), "expected table for abstract registry");
janet_vm.abstract_registry = janet_unwrap_table(aregv);
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
}
@@ -3078,9 +3139,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
memcpy(&count1, nextbytes, sizeof(count1));
size_t count = (size_t) count1;
/* Use division to avoid overflowing size_t */
if (count > (endbytes - nextbytes - sizeof(count1)) / sizeof(JanetCFunRegistry)) {
janet_panic("thread message invalid");
}
janet_assert(count <= (endbytes - nextbytes - sizeof(count1)) / sizeof(JanetCFunRegistry), "thread message invalid");
janet_vm.registry_count = count;
janet_vm.registry_cap = count;
janet_vm.registry = janet_malloc(count * sizeof(JanetCFunRegistry));
@@ -3099,14 +3158,13 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
JanetFiber *fiber;
if (!janet_checktype(fiberv, JANET_FIBER)) {
if (!janet_checktype(fiberv, JANET_FUNCTION)) {
janet_panicf("expected function or fiber, got %v", fiberv);
}
janet_assert(janet_checktype(fiberv, JANET_FUNCTION), "expected function or fiber");
JanetFunction *func = janet_unwrap_function(fiberv);
/* TODO - normal panics here do not seem to work correctly on Wine + Mingw. This needs to be investigated, and while it appears to be related to longjmp behavior
* on the platform not working correctly, it is not obvious the issue is. That said, we probably should assert and hard-exit anyway if there is an issue there. */
janet_assert(func->def->min_arity >= 0 && func->def->min_arity <= 1, "thread function must accept 0 or 1 arguments");
fiber = janet_fiber(func, 64, func->def->min_arity, &value);
if (fiber == NULL) {
janet_panicf("thread function must accept 0 or 1 arguments");
}
janet_assert(fiber != NULL, "bad fiber in thread setup");
fiber->flags |=
JANET_FIBER_MASK_ERROR |
JANET_FIBER_MASK_USER0 |
@@ -3125,7 +3183,9 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
janet_schedule(fiber, value);
janet_loop();
args.tag = JANET_EV_TCTAG_NIL;
janet_restore(&tstate);
} else {
janet_restore(&tstate);
void *supervisor = janet_vm.user;
if (NULL != supervisor) {
/* Got a supervisor, write error there */
@@ -3142,14 +3202,15 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
/* Make ev/thread call from parent thread error */
if (janet_checktype(tstate.payload, JANET_STRING)) {
args.tag = JANET_EV_TCTAG_ERR_STRINGF;
args.argp = strdup((const char *) janet_unwrap_string(tstate.payload));
JanetString msg = janet_unwrap_string(tstate.payload);
args.argp = janet_malloc(janet_string_length(msg) + 1);
memcpy(args.argp, msg, janet_string_length(msg) + 1);
} else {
args.tag = JANET_EV_TCTAG_ERR_STRING;
args.argp = "failed to start thread";
}
}
}
janet_restore(&tstate);
janet_buffer_deinit(buffer);
janet_free(buffer);
janet_deinit();
@@ -3168,9 +3229,17 @@ JANET_CORE_FN(cfun_ev_thread,
"* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n"
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
janet_sandbox_assert(JANET_SANDBOX_THREADS);
janet_arity(argc, 1, 4);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
if (janet_checktype(argv[0], JANET_FUNCTION)) {
JanetFunction *func = janet_getfunction(argv, 0);
if (func->def->arity < 0 || func->def->min_arity > 1) {
janet_panic("function must take 0 or 1 arguments");
}
} else {
janet_getfiber(argv, 0); /* arg check for fiber */
}
uint64_t flags = 0;
if (argc >= 3) {
flags = janet_getflags(argv, 2, "nact");
@@ -3316,7 +3385,8 @@ JANET_CORE_FN(cfun_ev_deadline,
JANET_CORE_FN(cfun_ev_cancel,
"(ev/cancel fiber err)",
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately.") {
"Cancel a suspended task fiber in the event loop. Differs from "
"`cancel` in that it returns the canceled fiber immediately.") {
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet err = argv[1];
@@ -3506,6 +3576,7 @@ static JanetFile *get_file_for_stream(JanetStream *stream) {
}
if (index == 0) return NULL;
/* duplicate handle when converting stream to file */
stream->flags &= ~JANET_STREAM_NODUPS;
#ifdef JANET_WINDOWS
int htype = 0;
if (fmt[0] == 'r' && fmt[1] == '+') {
@@ -3549,7 +3620,7 @@ JANET_CORE_FN(janet_cfun_to_file,
JANET_CORE_FN(janet_cfun_ev_all_tasks,
"(ev/all-tasks)",
"Get an array of all active fibers that are being used by the scheduler.") {
"Get an array of all active task fibers that are being used by the scheduler.") {
janet_fixarity(argc, 0);
(void) argv;
JanetArray *array = janet_array(janet_vm.active_tasks.count);
src/core/features.h
+4 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -45,6 +45,9 @@
#ifdef __linux__
#define _GNU_SOURCE
#endif
#ifdef __gnu_hurd__
#define _GNU_SOURCE
#endif
#if defined(WIN32) || defined(_WIN32)
#define WIN32_LEAN_AND_MEAN
src/core/ffi.c
+21 -3
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -1344,6 +1344,15 @@ typedef double (win64_variant_f_ffif)(double, double, uint64_t, double);
typedef double (win64_variant_f_fffi)(double, double, double, uint64_t);
typedef double (win64_variant_f_ffff)(double, double, double, double);
/* MSVC stack frame runtime error checking (/RTCs) prepends alloca() allocations with an _RTC_ALLOCA_NODE
* header; misalligning stack-based FFI arguments and causing the memmove() (by stack_shift) to corrupt
* the _RTC_ALLOCA_NODE header.
*
* We turn off the RTC-instrumented alloca() and adding of _RTC_CheckStackVars to function prologue just
* for janet_ffi_win64() */
#ifdef __MSVC_RUNTIME_CHECKS
#pragma runtime_checks( "s", off )
#endif
static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) {
union {
uint64_t integer;
@@ -1493,6 +1502,10 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR);
}
#ifdef __MSVC_RUNTIME_CHECKS
// Restore stack frame runtime error checking (/RTCs) if it was enabled.
#pragma runtime_checks ( "s", restore )
#endif
#endif
@@ -1615,7 +1628,11 @@ JANET_CORE_FN(cfun_ffi_jitfn,
fn->size = 0;
#ifdef JANET_WINDOWS
void *ptr = VirtualAlloc(NULL, alloc_size, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
#elif defined(MAP_ANONYMOUS)
if (!ptr) {
janet_panic("failed to allocate writable memory");
}
#else
#ifdef MAP_ANONYMOUS
void *ptr = mmap(0, alloc_size, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
#elif defined(MAP_ANON)
/* macos doesn't have MAP_ANONYMOUS */
@@ -1625,9 +1642,10 @@ JANET_CORE_FN(cfun_ffi_jitfn,
/* #define MAP_ANONYMOUS 0x20 should work, though. */
void *ptr = mmap(0, alloc_size, PROT_READ | PROT_WRITE, MAP_PRIVATE, -1, 0);
#endif
if (!ptr) {
if (ptr == MAP_FAILED) {
janet_panic("failed to memory map writable memory");
}
#endif
memcpy(ptr, bytes.bytes, bytes.len);
#ifdef JANET_WINDOWS
DWORD old = 0;
src/core/fiber.c
+11 -11
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -106,7 +106,7 @@ static void janet_fiber_refresh_memory(JanetFiber *fiber) {
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
memcpy(newData, fiber->data, n * sizeof(Janet));
janet_free(fiber->data);
fiber->data = newData;
}
@@ -180,7 +180,8 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
/* Create a struct with n values. If n is odd, the last value is ignored. */
static Janet make_struct_n(const Janet *args, int32_t n) {
int32_t i = 0;
JanetKV *st = janet_struct_begin(n & (~1));
if (n & 1) n--;
JanetKV *st = janet_struct_begin(n);
for (; i < n; i += 2) {
janet_struct_put(st, args[i], args[i + 1]);
}
@@ -228,6 +229,7 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
/* Check varargs */
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
int32_t tuplehead = fiber->frame + func->def->arity;
janet_assert(tuplehead > 0, "fiber stack overflow");
int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
if (tuplehead >= oldtop) {
fiber->data[tuplehead] = st
@@ -346,9 +348,6 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
#endif
}
Janet *stack = fiber->data + fiber->frame;
Janet *args = fiber->data + fiber->stackstart;
/* Detach old function */
if (NULL != janet_fiber_frame(fiber)->func)
janet_env_detach(janet_fiber_frame(fiber)->env);
@@ -378,7 +377,7 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
stacksize = fiber->stacktop - fiber->stackstart;
}
if (stacksize) memmove(stack, args, stacksize * sizeof(Janet));
if (stacksize) memmove(fiber->data + fiber->frame, fiber->data + fiber->stackstart, stacksize * sizeof(Janet));
/* Nil unset locals (Needed for functional correctness) */
for (i = fiber->frame + stacksize; i < nextframetop; ++i)
@@ -592,8 +591,8 @@ JANET_CORE_FN(cfun_fiber_status,
"* :user(0-7) - the fiber is suspended by a user signal\n"
"* :interrupted - the fiber was interrupted\n"
"* :suspended - the fiber is waiting to be resumed by the scheduler\n"
"* :alive - the fiber is currently running and cannot be resumed\n"
"* :new - the fiber has just been created and not yet run") {
"* :new - the fiber has just been created and not yet run\n"
"* :alive - the fiber is currently running and cannot be resumed") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
uint32_t s = janet_fiber_status(fiber);
@@ -610,8 +609,9 @@ JANET_CORE_FN(cfun_fiber_current,
JANET_CORE_FN(cfun_fiber_root,
"(fiber/root)",
"Returns the current root fiber. The root fiber is the oldest ancestor "
"that does not have a parent.") {
"Returns the current root fiber. The root fiber is the oldest "
"ancestor that does not have a parent. Note that a root fiber "
"is also a task fiber.") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_fiber(janet_vm.root_fiber);
src/core/fiber.h
+8 -6
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -56,12 +56,14 @@
#define JANET_FIBER_DID_LONGJUMP 0x8000000
#define JANET_FIBER_FLAG_MASK 0xF000000
#define JANET_FIBER_EV_FLAG_CANCELED 0x10000
#define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
#define JANET_FIBER_FLAG_ROOT 0x40000
#define JANET_FIBER_EV_FLAG_IN_FLIGHT 0x1
/* Flags on the gc header (don't confuse flags with gc.flags!) */
/* Don't collide with JANET_FIBER_STATUS_MASK to enable flag smuggling in vm.c */
#define JANET_FIBER_EV_GCFLAG_CANCELED 0x1000000
#define JANET_FIBER_EV_GCFLAG_SUSPENDED 0x2000000
#define JANET_FIBER_EV_GCFLAG_ROOT 0x4000000
/* used only on windows, should otherwise be unset */
/* Not on gc header */
#define JANET_FIBER_EV_FLAG_IN_FLIGHT 0x1
#define janet_fiber_set_status(f, s) do {\
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\
src/core/filewatch.c
+302 -22
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -38,6 +38,13 @@
#include <windows.h>
#endif
#if defined(JANET_APPLE) || defined(JANET_BSD)
#include <sys/event.h>
#include <sys/stat.h>
#include <unistd.h>
#include <fcntl.h>
#endif
typedef struct {
const char *name;
uint32_t flag;
@@ -85,11 +92,11 @@ static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_linux,
sizeof(watcher_flags_linux) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
sizeof(watcher_flags_linux) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown inotify flag %v", options[i]);
janet_panicf("unknown linux flag %v", options[i]);
}
flags |= result->flag;
}
@@ -128,8 +135,11 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
if (watcher->stream == NULL) janet_panic("watcher closed");
Janet check = janet_table_get(watcher->watch_descriptors, janet_cstringv(path));
janet_assert(janet_checktype(check, JANET_NUMBER), "bad watch descriptor");
Janet pathv = janet_cstringv(path);
Janet check = janet_table_get(watcher->watch_descriptors, pathv);
if (!janet_checktype(check, JANET_NUMBER)) {
janet_panic("bad watch descriptor");
}
int watch_handle = janet_unwrap_integer(check);
int result;
do {
@@ -138,6 +148,10 @@ static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
if (result == -1) {
janet_panicv(janet_ev_lasterr());
}
/*
janet_table_put(watcher->watch_descriptors, pathv, janet_wrap_nil());
janet_table_put(watcher->watch_descriptors, janet_wrap_integer(watch_handle), janet_wrap_nil());
*/
}
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
@@ -302,9 +316,9 @@ static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_windows,
sizeof(watcher_flags_windows) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
sizeof(watcher_flags_windows) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown windows filewatch flag %v", options[i]);
}
@@ -326,7 +340,7 @@ static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uin
#define FILE_INFO_PADDING (4096 * 4)
typedef struct {
OVERLAPPED overlapped;
JanetOverlapped overlapped;
JanetStream *stream;
JanetWatcher *watcher;
JanetFiber *fiber;
@@ -456,7 +470,7 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
Janet pathv = janet_wrap_string(ow->dir_path);
ow->flags = flags | watcher->default_flags;
ow->watcher = watcher;
ow->overlapped.hEvent = CreateEvent(NULL, FALSE, 0, NULL); /* Do we need this */
ow->overlapped.as.overlapped.hEvent = CreateEvent(NULL, FALSE, 0, NULL); /* Do we need this */
Janet streamv = janet_wrap_pointer(ow);
janet_table_put(watcher->watch_descriptors, pathv, streamv);
if (watcher->is_watching) {
@@ -500,6 +514,254 @@ static void janet_watcher_unlisten(JanetWatcher *watcher) {
janet_gcunroot(janet_wrap_abstract(watcher));
}
#elif defined(JANET_APPLE) || defined(JANET_BSD)
/* kqueue implementation */
/* Cribbed from ev.c */
#define EV_SETx(ev, a, b, c, d, e, f) EV_SET((ev), (a), (b), (c), (d), (e), ((__typeof__((ev)->udata))(f)))
/* Different BSDs define different NOTE_* constants for different kinds of events. Use ifdef to
determine when they are available (assuming they are defines and not enums */
static const JanetWatchFlagName watcher_flags_kqueue[] = {
{
"all", NOTE_ATTRIB | NOTE_DELETE | NOTE_EXTEND | NOTE_RENAME | NOTE_REVOKE | NOTE_WRITE | NOTE_LINK
#ifdef NOTE_CLOSE
| NOTE_CLOSE
#endif
#ifdef NOTE_CLOSE_WRITE
| NOTE_CLOSE_WRITE
#endif
#ifdef NOTE_OPEN
| NOTE_OPEN
#endif
#ifdef NOTE_READ
| NOTE_READ
#endif
#ifdef NOTE_FUNLOCK
| NOTE_FUNLOCK
#endif
#ifdef NOTE_TRUNCATE
| NOTE_TRUNCATE
#endif
},
{"attrib", NOTE_ATTRIB},
#ifdef NOTE_CLOSE
{"close", NOTE_CLOSE},
#endif
#ifdef NOTE_CLOSE_WRITE
{"close-write", NOTE_CLOSE_WRITE},
#endif
{"delete", NOTE_DELETE},
{"extend", NOTE_EXTEND},
#ifdef NOTE_FUNLOCK
{"funlock", NOTE_FUNLOCK},
#endif
{"link", NOTE_LINK},
#ifdef NOTE_OPEN
{"open", NOTE_OPEN},
#endif
#ifdef NOTE_READ
{"read", NOTE_READ},
#endif
{"rename", NOTE_RENAME},
{"revoke", NOTE_REVOKE},
#ifdef NOTE_TRUNCATE
{"truncate", NOTE_TRUNCATE},
#endif
{"write", NOTE_WRITE},
};
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
uint32_t flags = 0;
for (int32_t i = 0; i < n; i++) {
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
janet_panicf("expected keyword, got %v", options[i]);
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_kqueue,
sizeof(watcher_flags_kqueue) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown bsd flag %v", options[i]);
}
flags |= result->flag;
}
return flags;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
int kq = kqueue();
watcher->watch_descriptors = janet_table(0);
watcher->channel = channel;
watcher->default_flags = default_flags;
watcher->is_watching = 0;
watcher->stream = janet_stream(kq, JANET_STREAM_READABLE, NULL);
janet_stream_level_triggered(watcher->stream);
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
if (watcher->stream == NULL) janet_panic("watcher closed");
int kq = watcher->stream->handle;
struct kevent kev = {0};
/* Get file descriptor for path */
int file_fd;
do {
file_fd = open(path, O_RDONLY);
} while (file_fd == -1 && errno == EINTR);
if (file_fd == -1) {
janet_panicf("failed to open: %v", janet_ev_lasterr());
}
/* Watch for EVFILT_VNODE on the file descriptor */
EV_SETx(&kev, file_fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, flags, 0, NULL);
int status;
do {
status = kevent(kq, &kev, 1, NULL, 0, NULL);
} while (status == -1 && errno == EINTR);
if (status == -1) {
close(file_fd);
janet_panicf("failed to listen: %v", janet_ev_lasterr());
}
/* Bookkeeping */
Janet name = janet_cstringv(path);
Janet wd = janet_wrap_integer(file_fd);
janet_table_put(watcher->watch_descriptors, name, wd);
janet_table_put(watcher->watch_descriptors, wd, name);
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
if (watcher->stream == NULL) janet_panic("watcher closed");
Janet pathv = janet_cstringv(path);
Janet check = janet_table_get(watcher->watch_descriptors, pathv);
if (!janet_checktype(check, JANET_NUMBER)) {
janet_panic("bad watch descriptor");
}
/* Closing the file descriptor will also remove it from the kqueue */
int wd = janet_unwrap_integer(check);
int result;
do {
result = close(wd);
} while (result != -1 && errno == EINTR);
if (result == -1) {
janet_panicv(janet_ev_lasterr());
}
janet_table_put(watcher->watch_descriptors, pathv, janet_wrap_nil());
janet_table_put(watcher->watch_descriptors, janet_wrap_integer(wd), janet_wrap_nil());
}
typedef struct {
JanetWatcher *watcher;
uint32_t cookie;
} KqueueWatcherState;
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
KqueueWatcherState *state = fiber->ev_state;
JanetWatcher *watcher = state->watcher;
switch (event) {
case JANET_ASYNC_EVENT_MARK:
janet_mark(janet_wrap_abstract(watcher));
break;
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
case JANET_ASYNC_EVENT_ERR: {
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
}
case JANET_ASYNC_EVENT_HUP:
case JANET_ASYNC_EVENT_INIT:
break;
case JANET_ASYNC_EVENT_READ: {
/* Pump events from the sub kqueue */
const int num_events = 512; /* Extra will be pumped after another event loop rotation. */
struct kevent events[num_events];
int kq = stream->handle;
int status;
do {
status = kevent(kq, NULL, 0, events, num_events, NULL);
} while (status == -1 && errno == EINTR);
if (status == -1) {
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
}
for (int i = 0; i < status; i++) {
state->cookie += 6700417;
struct kevent kev = events[i];
/* TODO - avoid stat call here, maybe just when adding listener? */
struct stat stat_buf = {0};
int status;
do {
status = fstat(kev.ident, &stat_buf);
} while (status == -1 && errno == EINTR);
if (status == -1) continue;
int is_dir = S_ISDIR(stat_buf.st_mode);
Janet ident = janet_wrap_integer(kev.ident);
Janet path = janet_table_get(watcher->watch_descriptors, ident);
for (unsigned int j = 1; j < (sizeof(watcher_flags_kqueue) / sizeof(watcher_flags_kqueue[0])); j++) {
uint32_t flagcheck = watcher_flags_kqueue[j].flag;
if (kev.fflags & flagcheck) {
JanetKV *event = janet_struct_begin(6);
janet_struct_put(event, janet_ckeywordv("wd"), ident);
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_number((double) state->cookie));
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_flags_kqueue[j].name));
if (is_dir) {
/* Pass in directly */
janet_struct_put(event, janet_ckeywordv("file-name"), janet_cstringv(""));
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
} else {
/* Split path */
JanetString spath = janet_unwrap_string(path);
const uint8_t *cursor = spath + janet_string_length(spath);
const uint8_t *cursor_end = cursor;
while (cursor > spath && cursor[0] != '/') {
cursor--;
}
if (cursor == spath) {
/* No path separators */
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_cstringv("."));
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(spath));
} else {
/* Found path separator */
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath))));
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1))));
}
}
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
}
}
}
break;
}
default:
break;
}
}
static void janet_watcher_listen(JanetWatcher *watcher) {
if (watcher->is_watching) janet_panic("already watching");
watcher->is_watching = 1;
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
KqueueWatcherState *state = janet_malloc(sizeof(KqueueWatcherState));
state->watcher = watcher;
janet_async_start_fiber(fiber, watcher->stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, state);
janet_gcroot(janet_wrap_abstract(watcher));
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
if (!watcher->is_watching) return;
watcher->is_watching = 0;
janet_stream_close(watcher->stream);
janet_gcunroot(janet_wrap_abstract(watcher));
}
#else
/* Default implementation */
@@ -521,23 +783,23 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
(void) watcher;
(void) flags;
(void) path;
janet_panic("nyi");
janet_panic("filewatch not supported on this platform");
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
(void) watcher;
(void) path;
janet_panic("nyi");
janet_panic("filewatch not supported on this platform");
}
static void janet_watcher_listen(JanetWatcher *watcher) {
(void) watcher;
janet_panic("nyi");
janet_panic("filewatch not supported on this platform");
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
(void) watcher;
janet_panic("nyi");
janet_panic("filewatch not supported on this platform");
}
#endif
@@ -573,7 +835,7 @@ static const JanetAbstractType janet_filewatch_at = {
};
JANET_CORE_FN(cfun_filewatch_make,
"(filewatch/new channel &opt default-flags)",
"(filewatch/new channel & default-flags)",
"Create a new filewatcher that will give events to a channel channel. See `filewatch/add` for available flags.\n\n"
"When an event is triggered by the filewatcher, a struct containing information will be given to channel as with `ev/give`. "
"The contents of the channel depend on the OS, but will contain some common keys:\n\n"
@@ -582,10 +844,10 @@ JANET_CORE_FN(cfun_filewatch_make,
"* `:dir-name` -- the directory name of the file that triggered the event.\n\n"
"Events also will contain keys specific to the host OS.\n\n"
"Windows has no extra properties on events.\n\n"
"Linux has the following extra properties on events:\n\n"
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n"
"Linux and the BSDs have the following extra properties on events:\n\n"
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this. This is a file descriptor integer on BSD and macos.\n\n"
"* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
"* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
"* `:cookie` -- a semi-randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
"") {
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
janet_arity(argc, 1, -1);
@@ -597,9 +859,10 @@ JANET_CORE_FN(cfun_filewatch_make,
}
JANET_CORE_FN(cfun_filewatch_add,
"(filewatch/add watcher path &opt flags)",
"(filewatch/add watcher path flag & more-flags)",
"Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
"Windows/MINGW (flags correspond to `FILE_NOTIFY_CHANGE_*` flags in win32 documentation):\n\n"
"FLAGS\n\n"
"* `:all` - trigger an event for all of the below triggers.\n\n"
"* `:attributes` - `FILE_NOTIFY_CHANGE_ATTRIBUTES`\n\n"
"* `:creation` - `FILE_NOTIFY_CHANGE_CREATION`\n\n"
@@ -626,6 +889,22 @@ JANET_CORE_FN(cfun_filewatch_add,
"* `:open` - `IN_OPEN`\n\n"
"* `:q-overflow` - `IN_Q_OVERFLOW`\n\n"
"* `:unmount` - `IN_UNMOUNT`\n\n\n"
"BSDs and macos (flags correspond to `NOTE_*` flags from <sys/event.h>). Not all flags are available on all systems:\n\n"
"* `:all` - `All available NOTE_* flags on the current platform`\n\n"
"* `:attrib` - `NOTE_ATTRIB`\n\n"
"* `:close-write` - `NOTE_CLOSE_WRITE`\n\n"
"* `:close` - `NOTE_CLOSE`\n\n"
"* `:delete` - `NOTE_DELETE`\n\n"
"* `:extend` - `NOTE_EXTEND`\n\n"
"* `:funlock` - `NOTE_FUNLOCK`\n\n"
"* `:link` - `NOTE_LINK`\n\n"
"* `:open` - `NOTE_OPEN`\n\n"
"* `:read` - `NOTE_READ`\n\n"
"* `:rename` - `NOTE_RENAME`\n\n"
"* `:revoke` - `NOTE_REVOKE`\n\n"
"* `:truncate` - `NOTE_TRUNCATE`\n\n"
"* `:write` - `NOTE_WRITE`\n\n\n"
"EVENT TYPES\n\n"
"On Windows, events will have the following possible types:\n\n"
"* `:unknown`\n\n"
"* `:added`\n\n"
@@ -633,7 +912,7 @@ JANET_CORE_FN(cfun_filewatch_add,
"* `:modified`\n\n"
"* `:renamed-old`\n\n"
"* `:renamed-new`\n\n"
"On Linux, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n"
"On Linux and BSDs, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n"
"") {
janet_arity(argc, 2, -1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
@@ -648,6 +927,7 @@ JANET_CORE_FN(cfun_filewatch_remove,
"Remove a path from the watcher.") {
janet_fixarity(argc, 2);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
/* TODO - pass string in directly to avoid extra allocation */
const char *path = janet_getcstring(argv, 1);
janet_watcher_remove(watcher, path);
return argv[0];
src/core/gc.c
+8 -16
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -336,6 +336,8 @@ static void janet_deinit_block(JanetGCObject *mem) {
if (f->ev_state && !(f->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
janet_ev_dec_refcount();
janet_free(f->ev_state);
} else if (f->gc.flags & JANET_FIBER_EV_GCFLAG_SUSPENDED) {
janet_ev_dec_refcount();
}
#endif
janet_free(f->data);
@@ -504,14 +506,7 @@ void janet_sweep() {
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
if (0 == janet_abstract_decref(abst)) {
/* Run finalizer */
if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
}
/* Free memory */
janet_free(janet_abstract_head(abst));
}
janet_abstract_decref_maybe_free(abst);
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
@@ -597,7 +592,9 @@ void janet_collect(void) {
#ifdef JANET_EV
janet_ev_mark();
#endif
janet_mark_fiber(janet_vm.root_fiber);
if (janet_vm.root_fiber != NULL) { /* Can be NULL if janet_collect called outside of interpreter loop */
janet_mark_fiber(janet_vm.root_fiber);
}
for (i = 0; i < orig_rootcount; i++)
janet_mark(janet_vm.roots[i]);
while (orig_rootcount < janet_vm.root_count) {
@@ -682,12 +679,7 @@ void janet_clear_memory(void) {
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
if (0 == janet_abstract_decref(abst)) {
if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
}
janet_free(janet_abstract_head(abst));
}
janet_abstract_decref_maybe_free(abst);
}
}
#endif
src/core/gc.h
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/inttypes.c
+14 -14
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose & contributors
* Copyright (c) 2026 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
@@ -333,7 +333,7 @@ static int compare_uint64_double(uint64_t x, double y) {
}
}
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_S64) {
janet_panic("compare method requires int/s64 as first argument");
@@ -368,7 +368,7 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
static JANET_CFUNCTION_ALIGN Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_U64) {
janet_panic("compare method requires int/u64 as first argument");
@@ -416,7 +416,7 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
* This will not affect the end result (property of twos complement).
*/
#define OPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
@@ -427,7 +427,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \
#define OPMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
@@ -437,7 +437,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
} \
#define UNARYMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = oper(janet_unwrap_##type(argv[0])); \
@@ -450,7 +450,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
#define DIVZERO_mod return janet_wrap_abstract(box)
#define DIVMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
@@ -463,7 +463,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \
#define DIVMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
@@ -474,7 +474,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
} \
#define DIVMETHOD_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
@@ -488,7 +488,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
@@ -499,7 +499,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
return janet_wrap_abstract(box); \
} \
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
@@ -510,7 +510,7 @@ static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]);
@@ -521,7 +521,7 @@ static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
@@ -535,7 +535,7 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]);
src/core/io.c
+47 -17
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -43,6 +43,7 @@ static void *io_file_unmarshal(JanetMarshalContext *ctx);
static Janet io_file_next(void *p, Janet key);
#ifdef JANET_WINDOWS
#include <io.h>
#define ftell _ftelli64
#define fseek _fseeki64
#endif
@@ -109,11 +110,12 @@ static int32_t checkflags(const uint8_t *str) {
return flags;
}
static void *makef(FILE *f, int32_t flags) {
static void *makef(FILE *f, int32_t flags, size_t bufsize) {
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
iof->file = f;
iof->flags = flags;
#ifndef JANET_WINDOWS
iof->vbufsize = bufsize;
#if !(defined(JANET_WINDOWS) || defined(JANET_PLAN9))
/* While we would like fopen to set cloexec by default (like O_CLOEXEC) with the e flag, that is
* not standard. */
if (!(flags & JANET_FILE_NOT_CLOSEABLE))
@@ -164,8 +166,9 @@ JANET_CORE_FN(cfun_io_fopen,
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
size_t bufsize = BUFSIZ;
if (f != NULL) {
#ifndef JANET_WINDOWS
#if !(defined(JANET_WINDOWS) || defined(JANET_PLAN9))
struct stat st;
fstat(fileno(f), &st);
if (S_ISDIR(st.st_mode)) {
@@ -173,7 +176,7 @@ JANET_CORE_FN(cfun_io_fopen,
janet_panicf("cannot open directory: %s", fname);
}
#endif
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
if (bufsize != BUFSIZ) {
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
if (result) {
@@ -181,7 +184,7 @@ JANET_CORE_FN(cfun_io_fopen,
}
}
}
return f ? janet_makefile(f, flags)
return f ? janet_wrap_abstract(makef(f, flags, bufsize))
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil())
: janet_wrap_nil();
}
@@ -249,9 +252,9 @@ JANET_CORE_FN(cfun_io_fread,
/* Write bytes to a file */
JANET_CORE_FN(cfun_io_fwrite,
"(file/write f bytes)",
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
"file.") {
"(file/write f & bytes)",
"Writes to a file `f`. Each value of `bytes` must be a "
"string, buffer, symbol, or keyword. Returns the file.") {
janet_arity(argc, 1, -1);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
@@ -408,21 +411,36 @@ static Janet io_file_next(void *p, Janet key) {
static void io_file_marshal(void *p, JanetMarshalContext *ctx) {
JanetFile *iof = (JanetFile *)p;
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
if (janet_marshal_flags(ctx) & JANET_MARSHAL_UNSAFE) {
janet_marshal_abstract(ctx, p);
int fno = -1;
#ifdef JANET_WINDOWS
janet_marshal_int(ctx, _fileno(iof->file));
if (iof->flags & JANET_FILE_NOT_CLOSEABLE) {
fno = _fileno(iof->file);
} else {
fno = _dup(_fileno(iof->file));
}
#else
janet_marshal_int(ctx, fileno(iof->file));
if (iof->flags & JANET_FILE_NOT_CLOSEABLE) {
fno = fileno(iof->file);
} else {
#ifdef JANET_PLAN9
fno = dup(fileno(iof->file), -1);
#else
fno = dup(fileno(iof->file));
#endif
}
#endif
janet_marshal_int(ctx, fno);
janet_marshal_int(ctx, iof->flags);
janet_marshal_size(ctx, iof->vbufsize);
} else {
janet_panic("cannot marshal file in safe mode");
}
}
static void *io_file_unmarshal(JanetMarshalContext *ctx) {
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
if (janet_unmarshal_flags(ctx) & JANET_MARSHAL_UNSAFE) {
JanetFile *iof = janet_unmarshal_abstract(ctx, sizeof(JanetFile));
int32_t fd = janet_unmarshal_int(ctx);
int32_t flags = janet_unmarshal_int(ctx);
@@ -444,6 +462,11 @@ static void *io_file_unmarshal(JanetMarshalContext *ctx) {
} else {
iof->flags = flags;
}
iof->vbufsize = janet_unmarshal_size(ctx);
if (iof->vbufsize != BUFSIZ) {
int result = setvbuf(iof->file, NULL, iof->vbufsize ? _IOFBF : _IONBF, iof->vbufsize);
janet_assert(!result, "unmarshal setvbuf");
}
return iof;
} else {
janet_panic("cannot unmarshal file in safe mode");
@@ -721,8 +744,15 @@ JANET_CORE_FN(cfun_io_eflush,
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
va_list args;
va_start(args, format);
Janet x = janet_dyn(name);
JanetType xtype = janet_type(x);
JanetType xtype;
Janet x;
if (!name || name[0] == '\0') { /* Allow NULL or empty string to just use dflt_file directly */
x = janet_wrap_nil();
xtype = JANET_NIL;
} else {
x = janet_dyn(name);
xtype = janet_type(x);
}
switch (xtype) {
default:
/* Other values simply do nothing */
@@ -778,11 +808,11 @@ FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags) {
}
JanetFile *janet_makejfile(FILE *f, int32_t flags) {
return makef(f, flags);
return makef(f, flags, BUFSIZ);
}
Janet janet_makefile(FILE *f, int32_t flags) {
return janet_wrap_abstract(makef(f, flags));
return janet_wrap_abstract(makef(f, flags, BUFSIZ));
}
JanetAbstract janet_checkfile(Janet j) {
src/core/marsh.c
+23 -3
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -30,6 +30,7 @@
#include "util.h"
#endif
typedef struct {
JanetBuffer *buf;
JanetTable seen;
@@ -276,6 +277,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
pushint(st, def->max_arity);
pushint(st, def->constants_length);
pushint(st, def->bytecode_length);
if (def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS)
pushint(st, def->named_args_count);
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
pushint(st, def->environments_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
@@ -431,6 +434,10 @@ void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
MARK_SEEN();
}
int janet_marshal_flags(JanetMarshalContext *ctx) {
return ctx->flags;
}
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
void *abstract = janet_unwrap_abstract(x);
#ifdef JANET_EV
@@ -914,6 +921,7 @@ static const uint8_t *unmarshal_one_def(
def->sourcemap = NULL;
def->symbolmap = NULL;
def->symbolmap_length = 0;
def->named_args_count = 0;
janet_v_push(st->lookup_defs, def);
/* Set default lengths to zero */
@@ -933,6 +941,8 @@ static const uint8_t *unmarshal_one_def(
/* Read some lengths */
constants_length = readnat(st, &data);
bytecode_length = readnat(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS)
def->named_args_count = readnat(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
environments_length = readnat(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
@@ -1106,7 +1116,12 @@ static const uint8_t *unmarshal_one_fiber(
}
/* Allocate stack memory */
fiber->capacity = fiber_stacktop + 10;
if (fiber_stacktop < INT32_MAX - 10) {
fiber->capacity = fiber_stacktop + 10;
} else {
/* Extra capacity is usually nice to avoid immediately reallocing on pushed arguments, but not needed */
fiber->capacity = INT32_MAX;
}
fiber->data = janet_malloc(sizeof(Janet) * fiber->capacity);
if (!fiber->data) {
JANET_OUT_OF_MEMORY;
@@ -1291,6 +1306,10 @@ void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
#endif
}
int janet_unmarshal_flags(JanetMarshalContext *ctx) {
return ctx->flags;
}
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);
@@ -1467,7 +1486,7 @@ static const uint8_t *unmarshal_one(
/* Tuple */
Janet *tup = janet_tuple_begin(len);
int32_t flag = readint(st, &data);
janet_tuple_flag(tup) |= flag << 16;
janet_tuple_flag(tup) |= (int32_t) (((uint32_t) flag) << 16); /* Avoid left shift of negative value */
for (int32_t i = 0; i < len; i++) {
data = unmarshal_one(st, data, tup + i, flags + 1);
}
@@ -1693,6 +1712,7 @@ JANET_CORE_FN(cfun_unmarshal,
"Unmarshal a value from a buffer. An optional lookup table "
"can be provided to allow for aliases to be resolved. Returns the value "
"unmarshalled from the buffer.") {
janet_sandbox_assert(JANET_SANDBOX_UNMARSHAL);
janet_arity(argc, 1, 2);
JanetByteView view = janet_getbytes(argv, 0);
JanetTable *reg = NULL;
src/core/math.c
+25 -19
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -271,28 +271,30 @@ JANET_DEFINE_MATHOP(cosh, "Returns the hyperbolic cosine of x.")
JANET_DEFINE_MATHOP(acosh, "Returns the hyperbolic arccosine of x.")
JANET_DEFINE_MATHOP(sin, "Returns the sine of x.")
JANET_DEFINE_MATHOP(sinh, "Returns the hyperbolic sine of x.")
JANET_DEFINE_MATHOP(asinh, "Returns the hyperbolic arcsine of x.")
JANET_DEFINE_MATHOP(tan, "Returns the tangent of x.")
JANET_DEFINE_MATHOP(tanh, "Returns the hyperbolic tangent of x.")
JANET_DEFINE_MATHOP(atanh, "Returns the hyperbolic arctangent of x.")
JANET_DEFINE_MATHOP(exp, "Returns e to the power of x.")
JANET_DEFINE_MATHOP(exp2, "Returns 2 to the power of x.")
JANET_DEFINE_MATHOP(log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
#ifndef JANET_PLAN9
JANET_DEFINE_MATHOP(expm1, "Returns e to the power of x minus 1.")
JANET_DEFINE_MATHOP(cbrt, "Returns the cube root of x.")
JANET_DEFINE_MATHOP(erf, "Returns the error function of x.")
JANET_DEFINE_MATHOP(erfc, "Returns the complementary error function of x.")
JANET_DEFINE_NAMED_MATHOP("log-gamma", lgamma, "Returns log-gamma(x).")
JANET_DEFINE_NAMED_MATHOP("gamma", tgamma, "Returns gamma(x).")
JANET_DEFINE_MATHOP(atanh, "Returns the hyperbolic arctangent of x.")
JANET_DEFINE_MATHOP(asinh, "Returns the hyperbolic arcsine of x.")
#endif
JANET_DEFINE_MATHOP(log, "Returns the natural logarithm of x.")
JANET_DEFINE_MATHOP(log10, "Returns the log base 10 of x.")
JANET_DEFINE_MATHOP(log2, "Returns the log base 2 of x.")
JANET_DEFINE_MATHOP(sqrt, "Returns the square root of x.")
JANET_DEFINE_MATHOP(cbrt, "Returns the cube root of x.")
JANET_DEFINE_MATHOP(ceil, "Returns the smallest integer value number that is not less than x.")
JANET_DEFINE_MATHOP(floor, "Returns the largest integer value number that is not greater than x.")
JANET_DEFINE_MATHOP(trunc, "Returns the integer between x and 0 nearest to x.")
JANET_DEFINE_MATHOP(round, "Returns the integer nearest to x.")
JANET_DEFINE_MATHOP(log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
JANET_DEFINE_MATHOP(erf, "Returns the error function of x.")
JANET_DEFINE_MATHOP(erfc, "Returns the complementary error function of x.")
JANET_DEFINE_NAMED_MATHOP("log-gamma", lgamma, "Returns log-gamma(x).")
JANET_DEFINE_NAMED_MATHOP("abs", fabs, "Return the absolute value of x.")
JANET_DEFINE_NAMED_MATHOP("gamma", tgamma, "Returns gamma(x).")
#define JANET_DEFINE_MATH2OP(name, fop, signature, doc)\
JANET_CORE_FN(janet_##name, signature, doc) {\
@@ -305,7 +307,9 @@ JANET_CORE_FN(janet_##name, signature, doc) {\
JANET_DEFINE_MATH2OP(atan2, atan2, "(math/atan2 y x)", "Returns the arctangent of y/x. Works even when x is 0.")
JANET_DEFINE_MATH2OP(pow, pow, "(math/pow a x)", "Returns a to the power of x.")
JANET_DEFINE_MATH2OP(hypot, hypot, "(math/hypot a b)", "Returns c from the equation c^2 = a^2 + b^2.")
#ifndef JANET_PLAN9
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point value after x in the direction of y.")
#endif
JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
janet_fixarity(argc, 1);
@@ -386,7 +390,17 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_REG("math/log10", janet_log10),
JANET_CORE_REG("math/log2", janet_log2),
JANET_CORE_REG("math/sqrt", janet_sqrt),
#ifndef JANET_PLAN9
JANET_CORE_REG("math/cbrt", janet_cbrt),
JANET_CORE_REG("math/gamma", janet_tgamma),
JANET_CORE_REG("math/log-gamma", janet_lgamma),
JANET_CORE_REG("math/erfc", janet_erfc),
JANET_CORE_REG("math/erf", janet_erf),
JANET_CORE_REG("math/expm1", janet_expm1),
JANET_CORE_REG("math/atanh", janet_atanh),
JANET_CORE_REG("math/asinh", janet_asinh),
JANET_CORE_REG("math/next", janet_nextafter),
#endif
JANET_CORE_REG("math/floor", janet_floor),
JANET_CORE_REG("math/ceil", janet_ceil),
JANET_CORE_REG("math/pow", janet_pow),
@@ -394,8 +408,6 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_REG("math/sinh", janet_sinh),
JANET_CORE_REG("math/cosh", janet_cosh),
JANET_CORE_REG("math/tanh", janet_tanh),
JANET_CORE_REG("math/atanh", janet_atanh),
JANET_CORE_REG("math/asinh", janet_asinh),
JANET_CORE_REG("math/acosh", janet_acosh),
JANET_CORE_REG("math/atan2", janet_atan2),
JANET_CORE_REG("math/rng", cfun_rng_make),
@@ -405,14 +417,8 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_REG("math/hypot", janet_hypot),
JANET_CORE_REG("math/exp2", janet_exp2),
JANET_CORE_REG("math/log1p", janet_log1p),
JANET_CORE_REG("math/gamma", janet_tgamma),
JANET_CORE_REG("math/log-gamma", janet_lgamma),
JANET_CORE_REG("math/erfc", janet_erfc),
JANET_CORE_REG("math/erf", janet_erf),
JANET_CORE_REG("math/expm1", janet_expm1),
JANET_CORE_REG("math/trunc", janet_trunc),
JANET_CORE_REG("math/round", janet_round),
JANET_CORE_REG("math/next", janet_nextafter),
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
JANET_CORE_REG("math/frexp", janet_cfun_frexp),
@@ -435,9 +441,9 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
"The maximum contiguous integer representable by a 32 bit signed integer");
JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
"The minimum contiguous integer representable by a double (2^53)");
"The minimum contiguous integer representable by a double (-(2^53))");
JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
"The maximum contiguous integer representable by a double (-(2^53))");
"The maximum contiguous integer representable by a double (2^53)");
#ifdef NAN
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
#else
src/core/net.c
+142 -23
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose and contributors.
* Copyright (c) 2026 Calvin Rose and contributors.
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -120,7 +120,55 @@ static void janet_net_socknoblock(JSock s) {
#endif
}
/* Allow specifying IPV6 vs. IPV4 (or unix domain socket) */
static int net_get_address_family(Janet x) {
if (janet_checktype(x, JANET_NIL)) {
return AF_UNSPEC;
}
if (janet_keyeq(x, "ipv4")) {
return AF_INET;
}
if (janet_keyeq(x, "ipv6")) {
return AF_INET6;
}
#ifndef JANET_WINDOWS
if (janet_keyeq(x, "unix")) {
return AF_UNIX;
}
#endif
return AF_UNSPEC;
}
/* State machine for async connect */
#ifdef JANET_WINDOWS
typedef struct NetStateConnect {
/* Only used for ConnectEx */
JanetOverlapped overlapped;
} NetStateConnect;
static LPFN_CONNECTEX lazy_get_connectex(JSock sock) {
/* Get ConnectEx */
if (janet_vm.connect_ex_loaded) {
return janet_vm.connect_ex;
}
GUID guid = WSAID_CONNECTEX;
LPFN_CONNECTEX connect_ex_ptr = NULL;
DWORD byte_len = 0;
int success = WSAIoctl(sock, SIO_GET_EXTENSION_FUNCTION_POINTER,
(void *)&guid, sizeof(guid),
(void *)&connect_ex_ptr, sizeof(connect_ex_ptr),
&byte_len, NULL, NULL);
if (success) {
janet_vm.connect_ex = connect_ex_ptr;
} else {
janet_vm.connect_ex = NULL;
}
janet_vm.connect_ex_loaded = 1;
return janet_vm.connect_ex;
}
#endif
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
@@ -140,15 +188,21 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
return;
}
#ifdef JANET_WINDOWS
/* We should be using ConnectEx here */
int res = 0;
int size = sizeof(res);
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_CONNECT_TIME, (char *)&res, &size);
if (r == NO_ERROR && res == (~0)) {
return; /* This apparently indicates we haven't yet gotten a connection */
}
const int no_error = NO_ERROR;
#else
int res = 0;
socklen_t size = sizeof res;
socklen_t size = sizeof(res);
int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
const int no_error = 0;
#endif
if (r == 0) {
if (r == no_error) {
if (res == 0) {
janet_schedule(fiber, janet_wrap_abstract(stream));
} else {
@@ -162,8 +216,8 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
janet_async_end(fiber);
}
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL);
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream, void *state) {
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, state);
}
/* State machine for accepting connections. */
@@ -171,7 +225,7 @@ static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
#ifdef JANET_WINDOWS
typedef struct {
WSAOVERLAPPED overlapped;
JanetOverlapped overlapped;
JanetFunction *function;
JanetStream *lstream;
JanetStream *astream;
@@ -234,7 +288,7 @@ void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
Janet err;
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
memset(&state->overlapped, 0, sizeof(JanetOverlapped));
memset(&state->buf, 0, 1024);
state->function = fun;
state->lstream = stream;
@@ -255,7 +309,7 @@ static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet
JanetStream *astream = make_stream(asock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
state->astream = astream;
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped.as.wsaoverlapped)) {
int code = WSAGetLastError();
if (code == WSA_IO_PENDING) {
/* indicates io is happening async */
@@ -551,15 +605,44 @@ JANET_CORE_FN(cfun_net_connect,
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 */
janet_net_socknoblock(sock);
/* Connect to socket */
#ifdef JANET_WINDOWS
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
int err = WSAGetLastError();
freeaddrinfo(ai);
int status = 0;
int err = 0;
LPFN_CONNECTEX connect_ex = NULL;
if (socktype == SOCK_STREAM && ((connect_ex = lazy_get_connectex(sock)))) {
/* Prefer ConnecEx as it works well with overlapped IO. */
janet_net_socknoblock(sock);
NetStateConnect *state = janet_malloc(sizeof(NetStateConnect));
memset(state, 0, sizeof(NetStateConnect));
BOOL success = connect_ex(sock, addr, addrlen, NULL, 0, NULL, &state->overlapped.as.overlapped);
freeaddrinfo(ai);
if (success) {
/* Did not fail */
} else {
int err = WSAGetLastError();
if (err == ERROR_IO_PENDING) {
/* Did not actually fail yet */
} else {
janet_free(state);
Janet lasterr = janet_ev_lasterr();
janet_panicf("could not connect socket (ConnectEx): %V", lasterr);
}
}
net_sched_connect(stream, state);
} else {
/* Default to blocking connect if ConnectEx not available */
status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
err = WSAGetLastError();
freeaddrinfo(ai);
/* Set up the socket for non-blocking IO after connecting on windows by default */
janet_net_socknoblock(sock);
}
#else
/* Set up the socket for non-blocking IO before connecting */
janet_net_socknoblock(sock);
int status;
do {
status = connect(sock, addr, addrlen);
@@ -572,10 +655,19 @@ JANET_CORE_FN(cfun_net_connect,
}
#endif
if (status) {
if (status == 0) {
/* Connect completed synchronously (common for unix domain sockets).
* Return the stream directly without scheduling an async wait,
* as edge-triggered kqueue may not signal EVFILT_WRITE if the socket
* is already connected when registered. */
return janet_wrap_abstract(stream);
}
#ifdef JANET_WINDOWS
if (status == SOCKET_ERROR) {
if (err != WSAEWOULDBLOCK) {
#else
if (status == -1) {
if (err != EINPROGRESS) {
#endif
JSOCKCLOSE(sock);
@@ -584,14 +676,15 @@ JANET_CORE_FN(cfun_net_connect,
}
}
net_sched_connect(stream);
net_sched_connect(stream, NULL);
}
JANET_CORE_FN(cfun_net_socket,
"(net/socket &opt type)",
"(net/socket &opt type address-family)",
"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);
"either a :stream (usually tcp), or :datagram (usually udp). The default is :stream. "
"`address-family` should be one of :ipv4 or :ipv6.") {
janet_arity(argc, 0, 2);
int socktype = janet_get_sockettype(argv, argc, 0);
@@ -602,7 +695,14 @@ JANET_CORE_FN(cfun_net_socket,
memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_UNSPEC;
hints.ai_socktype = socktype;
#ifdef AI_NUMERICSERV
hints.ai_flags = AI_NUMERICSERV; /* Explicitly prevent name resolution */
#else
hints.ai_flags = 0;
#endif
if (argc >= 2) {
hints.ai_family = net_get_address_family(argv[1]);
}
int status = getaddrinfo(NULL, "0", &hints, &ai);
if (status) {
janet_panicf("could not get address info: %s", gai_strerror(status));
@@ -646,7 +746,7 @@ static const char *serverify_socket(JSock sfd, int reuse_addr, int reuse_port) {
}
}
if (reuse_port) {
#ifdef SO_REUSEPORT
#if defined(SO_REUSEPORT) && !JANET_GNU_HURD
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEPORT) failed";
}
@@ -1031,6 +1131,8 @@ static const struct sockopt_type sockopt_type_list[] = {
#ifndef JANET_NO_IPV6
{ "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
{ "ipv6-multicast-hops", IPPROTO_IPV6, IPV6_MULTICAST_HOPS, JANET_NUMBER },
{ "ipv6-unicast-hops", IPPROTO_IPV6, IPV6_UNICAST_HOPS, JANET_NUMBER },
#endif
{ NULL, 0, 0, JANET_POINTER }
};
@@ -1048,7 +1150,10 @@ JANET_CORE_FN(cfun_net_setsockopt,
"- :ip-add-membership string\n"
"- :ip-drop-membership string\n"
"- :ipv6-join-group string\n"
"- :ipv6-leave-group string\n") {
"- :ipv6-leave-group string\n"
"- :ipv6-multicast-hops number\n"
"- :ipv6-unicast-hops number\n"
) {
janet_arity(argc, 3, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_SOCKET);
@@ -1067,6 +1172,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
}
union {
unsigned char v_uchar;
int v_int;
struct ip_mreq v_mreq;
#ifndef JANET_NO_IPV6
@@ -1081,8 +1187,19 @@ JANET_CORE_FN(cfun_net_setsockopt,
val.v_int = janet_getboolean(argv, 2);
optlen = sizeof(val.v_int);
} else if (st->type == JANET_NUMBER) {
#if defined(JANET_BSD) || defined(JANET_ILLUMOS)
int v_int = janet_getinteger(argv, 2);
if (st->optname == IP_MULTICAST_TTL) {
val.v_uchar = v_int;
optlen = sizeof(val.v_uchar);
} else {
val.v_int = v_int;
optlen = sizeof(val.v_int);
}
#else
val.v_int = janet_getinteger(argv, 2);
optlen = sizeof(val.v_int);
#endif
} else if (st->optname == IP_ADD_MEMBERSHIP || st->optname == IP_DROP_MEMBERSHIP) {
const char *addr = janet_getcstring(argv, 2);
memset(&val.v_mreq, 0, sizeof val.v_mreq);
@@ -1130,7 +1247,7 @@ static const JanetMethod net_stream_methods[] = {
};
static JanetStream *make_stream(JSock handle, uint32_t flags) {
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET | JANET_STREAM_NODUPS, net_stream_methods);
}
void janet_lib_net(JanetTable *env) {
@@ -1161,6 +1278,8 @@ void janet_net_init(void) {
#ifdef JANET_WINDOWS
WSADATA wsaData;
janet_assert(!WSAStartup(MAKEWORD(2, 2), &wsaData), "could not start winsock");
janet_vm.connect_ex_loaded = 0;
janet_vm.connect_ex = NULL;
#endif
}
src/core/os.c
+187 -53
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose and contributors.
* Copyright (c) 2026 Calvin Rose and contributors.
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -40,6 +40,7 @@
#include <sys/stat.h>
#include <signal.h>
#include <locale.h>
#include <inttypes.h>
#ifdef JANET_BSD
#include <sys/sysctl.h>
@@ -49,6 +50,11 @@
#include <sched.h>
#endif
#ifdef JANET_GNU_HURD
/* Ideally we would try to dynamically allocate */
#define PATH_MAX 8192
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
#include <direct.h>
@@ -57,7 +63,9 @@
#include <process.h>
#define JANET_SPAWN_CHDIR
#else
#ifndef JANET_PLAN9
#include <spawn.h>
#endif
#include <utime.h>
#include <unistd.h>
#include <dirent.h>
@@ -68,7 +76,7 @@
#define environ (*_NSGetEnviron())
#include <AvailabilityMacros.h>
int chroot(const char *dirname);
#else
#elif !defined(JANET_PLAN9)
extern char **environ;
#endif
#ifdef JANET_THREADS
@@ -140,23 +148,27 @@ static void janet_unlock_environ(void) {
#define janet_stringify(x) janet_stringify1(x)
JANET_CORE_FN(os_which,
"(os/which)",
"Check the current operating system. Returns one of:\n\n"
"(os/which &opt test)",
"Check the current operating system. If `test` is nil or unset, Returns one of:\n\n"
"* :windows\n\n"
"* :mingw\n\n"
"* :cygwin\n\n"
"* :macos\n\n"
"* :web - Web assembly (emscripten)\n\n"
"* :linux\n\n"
"* :hurd\n\n"
"* :freebsd\n\n"
"* :openbsd\n\n"
"* :netbsd\n\n"
"* :dragonfly\n\n"
"* :bsd\n\n"
"* :posix - A POSIX compatible system (default)\n\n"
"May also return a custom keyword specified at build time.") {
janet_fixarity(argc, 0);
(void) argv;
"May also return a custom keyword specified at build time. Is `test` is truthy, will check if the current operating system equals `test` and return true if they are the same, false otherwise.") {
janet_arity(argc, 0, 1);
if (argc == 1 && janet_truthy(argv[0])) {
janet_getkeyword(argv, 0); /* Constrain to keywords */
return janet_wrap_boolean(janet_equals(argv[0], os_which(0, NULL)));
}
#if defined(JANET_OS_NAME)
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
#elif defined(JANET_MINGW)
@@ -171,6 +183,8 @@ JANET_CORE_FN(os_which,
return janet_ckeywordv("web");
#elif defined(JANET_LINUX)
return janet_ckeywordv("linux");
#elif defined(JANET_GNU_HURD)
return janet_ckeywordv("hurd");
#elif defined(__FreeBSD__)
return janet_ckeywordv("freebsd");
#elif defined(__NetBSD__)
@@ -244,6 +258,7 @@ JANET_CORE_FN(os_compiler,
"* :gcc\n\n"
"* :clang\n\n"
"* :msvc\n\n"
"* :kencc\n\n"
"* :unknown\n\n") {
janet_fixarity(argc, 0);
(void) argv;
@@ -253,6 +268,8 @@ JANET_CORE_FN(os_compiler,
return janet_ckeywordv("clang");
#elif defined(__GNUC__)
return janet_ckeywordv("gcc");
#elif defined(JANET_PLAN9)
return janet_ckeywordv("kencc");
#else
return janet_ckeywordv("unknown");
#endif
@@ -267,6 +284,7 @@ JANET_CORE_FN(os_exit,
"the exit with status equal the hash of x. If `force` is truthy will exit immediately and "
"skip cleanup code.") {
janet_arity(argc, 0, 2);
janet_sandbox_assert(JANET_SANDBOX_EXIT);
int status;
if (argc == 0) {
status = EXIT_SUCCESS;
@@ -275,9 +293,14 @@ JANET_CORE_FN(os_exit,
} else {
status = EXIT_FAILURE;
}
int force = (argc >= 2 && janet_truthy(argv[1]));
janet_deinit();
if (argc >= 2 && janet_truthy(argv[1])) {
if (force) {
#ifdef JANET_PLAN9
exits(nil);
#else
_Exit(status);
#endif
} else {
exit(status);
}
@@ -291,46 +314,43 @@ JANET_CORE_FN(os_cpu_count,
"Get an approximate number of CPUs available on for this process to use. If "
"unable to get an approximation, will return a default value dflt.") {
janet_arity(argc, 0, 1);
Janet dflt = argc > 0 ? argv[0] : janet_wrap_nil();
(void) argv; /* Prevent unused argument warning */
#ifdef JANET_WINDOWS
(void) dflt;
SYSTEM_INFO info;
GetSystemInfo(&info);
return janet_wrap_integer(info.dwNumberOfProcessors);
#elif defined(JANET_LINUX)
(void) dflt;
cpu_set_t cs;
CPU_ZERO(&cs);
sched_getaffinity(0, sizeof(cs), &cs);
int count = CPU_COUNT(&cs);
return janet_wrap_integer(count);
#elif defined(JANET_BSD) && defined(HW_NCPUONLINE)
(void) dflt;
const int name[2] = {CTL_HW, HW_NCPUONLINE};
int result = 0;
size_t len = sizeof(int);
if (-1 == sysctl(name, 2, &result, &len, NULL, 0)) {
return dflt;
return argc > 0 ? argv[0] : janet_wrap_nil();
}
return janet_wrap_integer(result);
#elif defined(JANET_BSD) && defined(HW_NCPU)
(void) dflt;
const int name[2] = {CTL_HW, HW_NCPU};
int result = 0;
size_t len = sizeof(int);
if (-1 == sysctl(name, 2, &result, &len, NULL, 0)) {
return dflt;
return argc > 0 ? argv[0] : janet_wrap_nil();
}
return janet_wrap_integer(result);
#elif defined(JANET_ILLUMOS)
(void) dflt;
long result = sysconf(_SC_NPROCESSORS_CONF);
if (result < 0) {
return dflt;
return argc > 0 ? argv[0] : janet_wrap_nil();
}
return janet_wrap_integer(result);
#elif defined(JANET_PLAN9)
return janet_wrap_integer(atoi(getenv("NPROC")));
#else
return dflt;
return argc > 0 ? argv[0] : janet_wrap_nil();
#endif
}
@@ -360,6 +380,8 @@ static EnvBlock os_execute_env(int32_t argc, const Janet *argv) {
janet_buffer_push_bytes(temp, vals, janet_string_length(vals));
janet_buffer_push_u8(temp, '\0');
}
/* Windows environment blocks must be double-NULL terminated */
if (temp->count == 0) janet_buffer_push_u8(temp, '\0');
janet_buffer_push_u8(temp, '\0');
char *ret = janet_smalloc(temp->count);
memcpy(ret, temp->data, temp->count);
@@ -1207,7 +1229,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
if (is_spawn && janet_keyeq(maybe_stderr, "pipe")) {
new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
pipe_owner_flags |= JANET_PROC_OWNS_STDERR;
} else if (is_spawn && janet_keyeq(maybe_stderr, "out")) {
} else if (janet_keyeq(maybe_stderr, "out")) {
stderr_is_stdout = 1;
} else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
new_err = janet_getjstream(&maybe_stderr, 0, &orig_err);
@@ -1293,6 +1315,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
}
int cp_failed = 0;
DWORD cp_error_code = 0;
if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path,
(char *) buf->data, /* Single CLI argument */
&saAttr, /* no proc inheritance */
@@ -1304,6 +1327,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
&startupInfo,
&processInfo)) {
cp_failed = 1;
cp_error_code = GetLastError();
}
if (pipe_in != JANET_HANDLE_NONE) CloseHandle(pipe_in);
@@ -1313,7 +1337,25 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
os_execute_cleanup(envp, NULL);
if (cp_failed) {
janet_panic("failed to create process");
char msgbuf[256];
msgbuf[0] = '\0';
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL,
cp_error_code,
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
msgbuf,
sizeof(msgbuf),
NULL);
if (!*msgbuf) snprintf(msgbuf, sizeof(msgbuf), "%" PRIu32, (uint32_t) cp_error_code);
char *c = msgbuf;
while (*c) {
if (*c == '\n' || *c == '\r') {
*c = '\0';
break;
}
c++;
}
janet_panicf("failed to create process: %s", janet_cstringv(msgbuf));
}
pHandle = processInfo.hProcess;
@@ -1339,6 +1381,9 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
/* exec mode */
if (mode == JANET_EXECUTE_EXEC) {
int status;
#ifdef JANET_PLAN9
status = exec(cargv[0], cargv);
#else
if (!use_environ) {
environ = envp;
}
@@ -1349,9 +1394,11 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
status = execv(cargv[0], cargv);
}
} while (status == -1 && errno == EINTR);
#endif
janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
}
#ifndef JANET_NO_SPAWN
/* Use posix_spawn to spawn new process */
/* Posix spawn setup */
@@ -1420,6 +1467,8 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
}
#endif
#endif
#ifndef JANET_NO_SPAWN
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
proc->return_code = -1;
#ifdef JANET_WINDOWS
@@ -1457,6 +1506,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
return os_proc_wait_impl(proc);
#endif
}
#endif
}
JANET_CORE_FN(os_execute,
@@ -1517,7 +1567,7 @@ JANET_CORE_FN(os_posix_exec,
JANET_CORE_FN(os_posix_fork,
"(os/posix-fork)",
"Make a `fork` system call and create a new process. Return nil if in the new process, otherwise a core/process object (as returned by os/spawn). "
"Not supported on all systems (POSIX only).") {
"Not supported on all systems (POSIX and Plan 9 only).") {
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
janet_fixarity(argc, 0);
(void) argv;
@@ -1525,9 +1575,13 @@ JANET_CORE_FN(os_posix_fork,
janet_panic("not supported on Windows");
#else
pid_t result;
#ifdef JANET_PLAN9
result = fork();
#else
do {
result = fork();
} while (result == -1 && errno == EINTR);
#endif
if (result == -1) {
janet_panic(janet_strerror(errno));
}
@@ -1548,8 +1602,9 @@ JANET_CORE_FN(os_posix_chroot,
"Not supported on all systems (POSIX only).") {
janet_sandbox_assert(JANET_SANDBOX_CHROOT);
janet_fixarity(argc, 1);
#ifdef JANET_WINDOWS
janet_panic("not supported on Windows");
#if defined(JANET_WINDOWS) || defined(JANET_PLAN9)
(void) argv;
janet_panic("not supported on Windows or Plan 9");
#else
const char *root = janet_getcstring(argv, 0);
int result;
@@ -1587,7 +1642,14 @@ JANET_CORE_FN(os_shell,
? janet_getcstring(argv, 0)
: NULL;
#ifdef JANET_EV
janet_ev_threaded_await(os_shell_subr, 0, argc, cmd ? strdup(cmd) : NULL);
char *cmd_copy = NULL;
if (cmd != NULL) {
size_t cmdlen = strlen(cmd);
cmd_copy = janet_malloc(cmdlen + 1);
memcpy(cmd_copy, cmd, cmdlen);
cmd_copy[cmdlen] = '\0';
}
janet_ev_threaded_await(os_shell_subr, 0, argc, cmd_copy);
#else
int stat = system(cmd);
return argc
@@ -1598,6 +1660,7 @@ JANET_CORE_FN(os_shell,
#endif /* JANET_NO_PROCESSES */
#ifndef JANET_PLAN9
JANET_CORE_FN(os_environ,
"(os/environ)",
"Get a copy of the OS environment table.") {
@@ -1629,6 +1692,7 @@ JANET_CORE_FN(os_environ,
janet_unlock_environ();
return janet_wrap_table(t);
}
#endif
JANET_CORE_FN(os_getenv,
"(os/getenv variable &opt dflt)",
@@ -1653,6 +1717,9 @@ JANET_CORE_FN(os_setenv,
#ifdef JANET_WINDOWS
#define SETENV(K,V) _putenv_s(K, V)
#define UNSETENV(K) _putenv_s(K, "")
#elif defined(JANET_PLAN9)
#define SETENV(K,V) putenv(K, V)
#define UNSETENV(K) unsetenv(K)
#else
#define SETENV(K,V) setenv(K, V, 1)
#define UNSETENV(K) unsetenv(K)
@@ -1825,6 +1892,8 @@ static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct
_tzset();
localtime_s(t_infos, &t);
t_info = t_infos;
#elif defined(JANET_PLAN9)
t_info = localtime(&t);
#else
tzset();
t_info = localtime_r(&t, t_infos);
@@ -1834,6 +1903,8 @@ static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct
#ifdef JANET_WINDOWS
gmtime_s(t_infos, &t);
t_info = t_infos;
#elif defined(JANET_PLAN9)
t_info = gmtime(&t);
#else
t_info = gmtime_r(&t, t_infos);
#endif
@@ -1844,9 +1915,8 @@ static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct
JANET_CORE_FN(os_date,
"(os/date &opt time local)",
"Returns the given time as a date struct, or the current time if `time` is not given. "
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
"Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
"the local timezone.\n\n"
"the local timezone. Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
"* :seconds - number of seconds [0-61]\n\n"
"* :minutes - number of minutes [0-59]\n\n"
"* :hours - number of hours [0-23]\n\n"
@@ -1855,7 +1925,9 @@ JANET_CORE_FN(os_date,
"* :year - years since year 0 (e.g. 2019)\n\n"
"* :week-day - day of the week [0-6]\n\n"
"* :year-day - day of the year [0-365]\n\n"
"* :dst - if Day Light Savings is in effect") {
"* :dst - if Day Light Savings is in effect\n\n"
"You can set local timezone by setting TZ environment variable. "
"See tzset(<time.h>) or _tzset(<time.h>) for further details.") {
janet_arity(argc, 0, 2);
(void) argv;
struct tm t_infos;
@@ -1873,14 +1945,15 @@ JANET_CORE_FN(os_date,
return janet_wrap_struct(janet_struct_end(st));
}
#define SIZETIMEFMT 250
#define SIZETIMEFMT 250
JANET_CORE_FN(os_strftime,
"(os/strftime fmt &opt time local)",
"Format the given time as a string, or the current time if `time` is not given. "
"The time is formatted according to the same rules as the ISO C89 function strftime(). "
"The time is formatted in UTC unless `local` is truthy, in which case the date is formatted for "
"the local timezone.") {
"the local timezone. You can set local timezone by setting TZ environment variable. "
"See tzset(<time.h>) or _tzset(<time.h>) for further details.") {
janet_arity(argc, 1, 3);
const char *fmt = janet_getcstring(argv, 0);
/* ANSI X3.159-1989, section 4.12.3.5 "The strftime function" */
@@ -1888,6 +1961,9 @@ JANET_CORE_FN(os_strftime,
const char *p = fmt;
while (*p) {
if (*p++ == '%') {
if (!*p) {
janet_panic("invalid conversion specifier");
}
if (!strchr(valid, *p)) {
janet_panicf("invalid conversion specifier '%%%c'", *p);
}
@@ -1897,7 +1973,7 @@ JANET_CORE_FN(os_strftime,
struct tm t_infos;
struct tm *t_info = time_to_tm(argv, argc, 1, &t_infos);
char buf[SIZETIMEFMT];
(void)strftime(buf, SIZETIMEFMT, fmt, t_info);
(void)strftime(buf, sizeof(buf), fmt, t_info);
return janet_cstringv(buf);
}
@@ -1905,7 +1981,7 @@ static int entry_getdst(Janet env_entry) {
Janet v;
if (janet_checktype(env_entry, JANET_TABLE)) {
JanetTable *entry = janet_unwrap_table(env_entry);
v = janet_table_get(entry, janet_ckeywordv("dst"));
v = janet_table_get_keyword(entry, "dst");
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
const JanetKV *entry = janet_unwrap_struct(env_entry);
v = janet_struct_get(entry, janet_ckeywordv("dst"));
@@ -1929,7 +2005,7 @@ static timeint_t entry_getint(Janet env_entry, char *field) {
Janet i;
if (janet_checktype(env_entry, JANET_TABLE)) {
JanetTable *entry = janet_unwrap_table(env_entry);
i = janet_table_get(entry, janet_ckeywordv(field));
i = janet_table_get_keyword(entry, field);
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
const JanetKV *entry = janet_unwrap_struct(env_entry);
i = janet_struct_get(entry, janet_ckeywordv(field));
@@ -2008,6 +2084,7 @@ JANET_CORE_FN(os_mktime,
#define j_symlink symlink
#endif
#ifndef JANET_NO_LOCALES
JANET_CORE_FN(os_setlocale,
"(os/setlocale &opt locale category)",
"Set the system locale, which affects how dates and numbers are formatted. "
@@ -2044,19 +2121,20 @@ JANET_CORE_FN(os_setlocale,
if (old == NULL) return janet_wrap_nil();
return janet_cstringv(old);
}
#endif
JANET_CORE_FN(os_link,
"(os/link oldpath newpath &opt symlink)",
"Create a link at newpath that points to oldpath and returns nil. "
"Iff symlink is truthy, creates a symlink. "
"Iff symlink is falsey or not provided, "
"creates a hard link. Does not work on Windows.") {
"creates a hard link. Does not work on Windows or Plan 9.") {
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_arity(argc, 2, 3);
#ifdef JANET_WINDOWS
#if defined(JANET_WINDOWS) || defined(JANET_PLAN9)
(void) argc;
(void) argv;
janet_panic("not supported on Windows");
janet_panic("not supported on Windows or Plan 9");
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
@@ -2071,10 +2149,10 @@ JANET_CORE_FN(os_symlink,
"Create a symlink from oldpath to newpath, returning nil. Same as `(os/link oldpath newpath true)`.") {
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_fixarity(argc, 2);
#ifdef JANET_WINDOWS
#if defined(JANET_WINDOWS) || defined(JANET_PLAN9)
(void) argc;
(void) argv;
janet_panic("not supported on Windows");
janet_panic("not supported on Windows or Plan 9");
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
@@ -2112,6 +2190,8 @@ JANET_CORE_FN(os_rmdir,
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
int res = _rmdir(path);
#elif defined(JANET_PLAN9)
int res = remove(path);
#else
int res = rmdir(path);
#endif
@@ -2178,7 +2258,7 @@ JANET_CORE_FN(os_readlink,
(void) argv;
janet_panic("not supported on Windows");
#else
static char buffer[PATH_MAX];
char buffer[PATH_MAX];
const char *path = janet_getcstring(argv, 0);
ssize_t len = readlink(path, buffer, sizeof buffer);
if (len < 0 || (size_t)len >= sizeof buffer)
@@ -2238,11 +2318,13 @@ static const uint8_t *janet_decode_mode(mode_t m) {
const char *str = "other";
if (S_ISREG(m)) str = "file";
else if (S_ISDIR(m)) str = "directory";
#ifndef JANET_PLAN9
else if (S_ISFIFO(m)) str = "fifo";
else if (S_ISBLK(m)) str = "block";
else if (S_ISSOCK(m)) str = "socket";
else if (S_ISLNK(m)) str = "link";
else if (S_ISCHR(m)) str = "character";
#endif
return janet_ckeyword(str);
}
@@ -2407,6 +2489,9 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
#ifdef JANET_WINDOWS
(void) do_lstat;
int res = _stat(path, &st);
#elif defined(JANET_PLAN9)
(void)do_lstat;
int res = stat(path, &st);
#else
int res;
if (do_lstat) {
@@ -2437,8 +2522,9 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
JANET_CORE_FN(os_stat,
"(os/stat path &opt tab|key)",
"Gets information about a file or directory. Returns a table if the second argument is a keyword, returns "
"only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
"Gets information about a file or directory. Returns a table unless the second argument is a keyword, "
"in which case it returns only that field/value from stat. If the file or directory does not exist, returns nil."
"The keys are:\n\n"
"* :dev - the device that the file is on\n\n"
"* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
"* :int-permissions - A Unix permission integer like 8r744\n\n"
@@ -2467,9 +2553,13 @@ JANET_CORE_FN(os_chmod,
"Change file permissions, where `mode` is a permission string as returned by "
"`os/perm-string`, or an integer as returned by `os/perm-int`. "
"When `mode` is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") {
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil."
"Unsupported on plan9.") {
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_fixarity(argc, 2);
#ifdef JANET_PLAN9
janet_panic("not supported on Plan 9");
#else
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
int res = _chmod(path, os_getmode(argv, 1));
@@ -2478,6 +2568,7 @@ JANET_CORE_FN(os_chmod,
#endif
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_wrap_nil();
#endif
}
#ifndef JANET_NO_UMASK
@@ -2510,7 +2601,7 @@ JANET_CORE_FN(os_dir,
char pattern[MAX_PATH + 1];
if (strlen(dir) > (sizeof(pattern) - 3))
janet_panicf("path too long: %s", dir);
sprintf(pattern, "%s/*", dir);
snprintf(pattern, sizeof(pattern), "%s/*", dir);
intptr_t res = _findfirst(pattern, &afile);
if (-1 == res) janet_panicv(janet_cstringv(janet_strerror(errno)));
do {
@@ -2576,7 +2667,15 @@ JANET_CORE_FN(os_realpath,
#endif
if (NULL == dest) janet_panicf("%s: %s", janet_strerror(errno), src);
Janet ret = janet_cstringv(dest);
#ifdef JANET_WINDOWS
DWORD attrib = GetFileAttributes(dest);
free(dest); /* if janet_malloc is redefined, still use free to correspond with _fullpath */
if (attrib == INVALID_FILE_ATTRIBUTES) {
janet_panicf("path does not exist: %v", ret);
}
#else
janet_free(dest);
#endif
return ret;
#endif
}
@@ -2620,10 +2719,11 @@ JANET_CORE_FN(os_open,
" * :c - create a new file (O\\_CREATE)\n"
" * :e - fail if the file exists (O\\_EXCL)\n"
" * :t - shorten an existing file to length 0 (O\\_TRUNC)\n\n"
" * :a - append to a file (O\\_APPEND on posix, FILE_APPEND_DATA on windows)\n"
"Posix-only flags:\n\n"
" * :a - append to a file (O\\_APPEND)\n"
" * :x - O\\_SYNC\n"
" * :C - O\\_NOCTTY\n\n"
" * :N - Turn off O\\_NONBLOCK and disable ev reading/writing\n\n"
"Windows-only flags:\n\n"
" * :R - share reads (FILE\\_SHARE\\_READ)\n"
" * :W - share writes (FILE\\_SHARE\\_WRITE)\n"
@@ -2633,19 +2733,24 @@ JANET_CORE_FN(os_open,
" * :F - FILE\\_ATTRIBUTE\\_OFFLINE\n"
" * :T - FILE\\_ATTRIBUTE\\_TEMPORARY\n"
" * :d - FILE\\_FLAG\\_DELETE\\_ON\\_CLOSE\n"
" * :V - Turn off FILE\\_FLAG\\_OVERLAPPED and disable ev reading/writing\n"
" * :I - set bInheritHandle on the created file so it can be passed to other processes.\n"
" * :b - FILE\\_FLAG\\_NO\\_BUFFERING\n") {
janet_arity(argc, 1, 3);
const char *path = janet_getcstring(argv, 0);
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
jmode_t mode = os_optmode(argc, argv, 2, 0666);
uint32_t stream_flags = 0;
int disable_stream_mode = 0;
JanetHandle fd;
#ifdef JANET_WINDOWS
(void) mode;
int inherited_handle = 0;
DWORD desiredAccess = 0;
DWORD shareMode = 0;
DWORD creationDisp = 0;
DWORD flagsAndAttributes = FILE_FLAG_OVERLAPPED;
DWORD fileFlags = FILE_FLAG_OVERLAPPED;
DWORD fileAttributes = 0;
/* We map unix-like open flags to the creationDisp parameter */
int creatUnix = 0;
#define OCREAT 1
@@ -2665,6 +2770,11 @@ JANET_CORE_FN(os_open,
stream_flags |= JANET_STREAM_WRITABLE;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
case 'a':
desiredAccess |= FILE_APPEND_DATA;
stream_flags |= JANET_STREAM_WRITABLE;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
case 'c':
creatUnix |= OCREAT;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
@@ -2687,22 +2797,29 @@ JANET_CORE_FN(os_open,
shareMode |= FILE_SHARE_WRITE;
break;
case 'H':
flagsAndAttributes |= FILE_ATTRIBUTE_HIDDEN;
fileAttributes |= FILE_ATTRIBUTE_HIDDEN;
break;
case 'O':
flagsAndAttributes |= FILE_ATTRIBUTE_READONLY;
fileAttributes |= FILE_ATTRIBUTE_READONLY;
break;
case 'F':
flagsAndAttributes |= FILE_ATTRIBUTE_OFFLINE;
fileAttributes |= FILE_ATTRIBUTE_OFFLINE;
break;
case 'T':
flagsAndAttributes |= FILE_ATTRIBUTE_TEMPORARY;
fileAttributes |= FILE_ATTRIBUTE_TEMPORARY;
break;
case 'd':
flagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE;
fileFlags |= FILE_FLAG_DELETE_ON_CLOSE;
break;
case 'b':
flagsAndAttributes |= FILE_FLAG_NO_BUFFERING;
fileFlags |= FILE_FLAG_NO_BUFFERING;
break;
case 'I':
inherited_handle = 1;
break;
case 'V':
fileFlags &= ~FILE_FLAG_OVERLAPPED;
disable_stream_mode = 1;
break;
/* we could potentially add more here -
* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
@@ -2728,7 +2845,16 @@ JANET_CORE_FN(os_open,
creationDisp = TRUNCATE_EXISTING;
break;
}
fd = CreateFileA(path, desiredAccess, shareMode, NULL, creationDisp, flagsAndAttributes, NULL);
if (fileAttributes == 0) {
fileAttributes = FILE_ATTRIBUTE_NORMAL;
}
SECURITY_ATTRIBUTES saAttr;
memset(&saAttr, 0, sizeof(saAttr));
saAttr.nLength = sizeof(saAttr);
if (inherited_handle) {
saAttr.bInheritHandle = TRUE; /* Needed to do interesting things with file */
}
fd = CreateFileA(path, desiredAccess, shareMode, &saAttr, creationDisp, fileFlags | fileAttributes, NULL);
if (fd == INVALID_HANDLE_VALUE) janet_panicv(janet_ev_lasterr());
#else
int open_flags = O_NONBLOCK;
@@ -2772,6 +2898,10 @@ JANET_CORE_FN(os_open,
case 'a':
open_flags |= O_APPEND;
break;
case 'N':
open_flags &= ~O_NONBLOCK;
disable_stream_mode = 1;
break;
}
}
/* If both read and write, fix up to O_RDWR */
@@ -2788,7 +2918,7 @@ JANET_CORE_FN(os_open,
} while (fd == -1 && errno == EINTR);
if (fd == -1) janet_panicv(janet_ev_lasterr());
#endif
return janet_wrap_abstract(janet_stream(fd, stream_flags, NULL));
return janet_wrap_abstract(janet_stream(fd, disable_stream_mode ? 0 : stream_flags, NULL));
}
JANET_CORE_FN(os_pipe,
@@ -2856,10 +2986,14 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/strftime", os_strftime),
JANET_CORE_REG("os/sleep", os_sleep),
JANET_CORE_REG("os/isatty", os_isatty),
#ifndef JANET_NO_LOCALES
JANET_CORE_REG("os/setlocale", os_setlocale),
#endif
/* env functions */
#ifndef JANET_PLAN9
JANET_CORE_REG("os/environ", os_environ),
#endif
JANET_CORE_REG("os/getenv", os_getenv),
JANET_CORE_REG("os/setenv", os_setenv),
@@ -2871,7 +3005,6 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/touch", os_touch),
JANET_CORE_REG("os/realpath", os_realpath),
JANET_CORE_REG("os/cd", os_cd),
JANET_CORE_REG("os/posix-chroot", os_posix_chroot),
#ifndef JANET_NO_UMASK
JANET_CORE_REG("os/umask", os_umask),
#endif
@@ -2896,6 +3029,7 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/shell", os_shell),
JANET_CORE_REG("os/posix-fork", os_posix_fork),
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
* (allows for limited functionality if use exposes C-functions to create specific processes) */
JANET_CORE_REG("os/proc-wait", os_proc_wait),
src/core/parse.c
+1 -10
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -105,15 +105,6 @@ static int to_hex(uint8_t c) {
}
}
typedef int (*Consumer)(JanetParser *p, JanetParseState *state, uint8_t c);
struct JanetParseState {
int32_t counter;
int32_t argn;
int flags;
size_t line;
size_t column;
Consumer consumer;
};
/* Define a stack on the main parser struct */
#define DEF_PARSER_STACK(NAME, T, STACK, STACKCOUNT, STACKCAP) \
src/core/peg.c
+95 -8
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -194,6 +194,41 @@ tail:
return memcmp(text, rule + 2, len) ? NULL : text + len;
}
case RULE_DEBUG: {
char buffer[32] = {0};
size_t len = (size_t)(s->outer_text_end - text);
memcpy(buffer, text, (len > 31 ? 31 : len));
janet_eprintf("?? at [%s] (index %d)\n", buffer, (int32_t)(text - s->text_start));
int has_color = janet_truthy(janet_dyn("err-color"));
/* Accumulate buffer */
if (s->scratch->count) {
janet_eprintf("accumulate buffer: %v\n", janet_wrap_buffer(s->scratch));
}
/* Normal captures */
if (s->captures->count) {
janet_eprintf("stack [%d]:\n", s->captures->count);
for (int32_t i = 0; i < s->captures->count; i++) {
if (has_color) {
janet_eprintf(" [%d]: %M\n", i, s->captures->data[i]);
} else {
janet_eprintf(" [%d]: %m\n", i, s->captures->data[i]);
}
}
}
/* Tagged captures */
if (s->tagged_captures->count) {
janet_eprintf("tag stack [%d]:\n", s->tagged_captures->count);
for (int32_t i = 0; i < s->tagged_captures->count; i++) {
if (has_color) {
janet_eprintf(" [%d] tag=%d: %M\n", i, (int32_t) s->tags->data[i], s->tagged_captures->data[i]);
} else {
janet_eprintf(" [%d] tag=%d: %m\n", i, (int32_t) s->tags->data[i], s->tagged_captures->data[i]);
}
}
}
return text;
}
case RULE_NCHAR: {
uint32_t n = rule[1];
return (text + n > s->text_end) ? NULL : text + n;
@@ -622,6 +657,7 @@ tail:
}
case RULE_REPLACE:
case RULE_MATCHSPLICE:
case RULE_MATCHTIME: {
uint32_t tag = rule[3];
int oldmode = s->mode;
@@ -662,8 +698,17 @@ tail:
break;
}
cap_load_keept(s, cs);
if (rule[0] == RULE_MATCHTIME && !janet_truthy(cap)) return NULL;
pushcap(s, cap, tag);
if (rule[0] != RULE_REPLACE && !janet_truthy(cap)) return NULL; /* matchtime or matchtime flatten */
const Janet *elements = NULL;
int32_t len = 0;
if ((rule[0] == RULE_MATCHSPLICE) && janet_indexed_view(cap, &elements, &len)) {
/* unpack and flatten capture */
for (int32_t i = 0; i < len; i++) {
pushcap(s, elements[i], tag);
}
} else {
pushcap(s, cap, tag);
}
return result;
}
@@ -1235,6 +1280,14 @@ static void spec_constant(Builder *b, int32_t argc, const Janet *argv) {
emit_2(r, RULE_CONSTANT, emit_constant(b, argv[0]), tag);
}
static void spec_debug(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 0, 0);
Reserve r = reserve(b, 1);
uint32_t empty = 0;
(void) argv;
emit_rule(r, RULE_DEBUG, 0, &empty);
}
static void spec_replace(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 2, 3);
Reserve r = reserve(b, 4);
@@ -1244,7 +1297,7 @@ static void spec_replace(Builder *b, int32_t argc, const Janet *argv) {
emit_3(r, RULE_REPLACE, subrule, constant, tag);
}
static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
static void spec_matchtime_impl(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
peg_arity(b, argc, 2, 3);
Reserve r = reserve(b, 4);
uint32_t subrule = peg_compile1(b, argv[0]);
@@ -1255,7 +1308,15 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
}
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
uint32_t cindex = emit_constant(b, fun);
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
emit_3(r, op, subrule, cindex, tag);
}
static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
spec_matchtime_impl(b, argc, argv, RULE_MATCHTIME);
}
static void spec_matchtime_splice(Builder *b, int32_t argc, const Janet *argv) {
spec_matchtime_impl(b, argc, argv, RULE_MATCHSPLICE);
}
static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
@@ -1331,6 +1392,7 @@ static const SpecialPair peg_specials[] = {
{"<-", spec_capture},
{">", spec_look},
{"?", spec_opt},
{"??", spec_debug},
{"accumulate", spec_accumulate},
{"any", spec_any},
{"argument", spec_argument},
@@ -1341,9 +1403,11 @@ static const SpecialPair peg_specials[] = {
{"between", spec_between},
{"capture", spec_capture},
{"choice", spec_choice},
{"cms", spec_matchtime_splice},
{"cmt", spec_matchtime},
{"column", spec_column},
{"constant", spec_constant},
{"debug", spec_debug},
{"drop", spec_drop},
{"error", spec_error},
{"group", spec_group},
@@ -1566,6 +1630,8 @@ static size_t size_padded(size_t offset, size_t size) {
return x - (x % size);
}
#define OVERFLOW_CHECK(n) do { if (i > blen - (n)) goto bad; } while (0) /* overflow */
static void *peg_unmarshal(JanetMarshalContext *ctx) {
size_t bytecode_len = janet_unmarshal_size(ctx);
uint32_t num_constants = (uint32_t) janet_unmarshal_int(ctx);
@@ -1597,7 +1663,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
/* After here, no panics except for the bad: label. */
/* Keep track at each index if an instruction was
* reference (0x01) or is in a main bytecode position
* referenced (0x01) or is in a main bytecode position
* (0x02). This lets us do a linear scan and not
* need to a depth first traversal. It is stricter
* than a dfs by not allowing certain kinds of unused
@@ -1618,8 +1684,13 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
op_flags[i] |= 0x02;
switch (instr) {
case RULE_LITERAL:
OVERFLOW_CHECK(1); /* We only read rule[1] */
i += 2 + ((rule[1] + 3) >> 2);
break;
case RULE_DEBUG:
/* [0 words] */
i += 1;
break;
case RULE_NCHAR:
case RULE_NOTNCHAR:
case RULE_RANGE:
@@ -1640,6 +1711,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
break;
case RULE_LOOK:
/* [offset, rule] */
OVERFLOW_CHECK(3);
if (rule[2] >= blen) goto bad;
op_flags[rule[2]] |= 0x1;
i += 3;
@@ -1648,7 +1720,9 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
case RULE_SEQUENCE:
/* [len, rules...] */
{
OVERFLOW_CHECK(2);
uint32_t len = rule[1];
OVERFLOW_CHECK(2 + len);
for (uint32_t j = 0; j < len; j++) {
if (rule[2 + j] >= blen) goto bad;
op_flags[rule[2 + j]] |= 0x1;
@@ -1660,6 +1734,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
case RULE_IFNOT:
case RULE_LENPREFIX:
/* [rule_a, rule_b (b if not a)] */
OVERFLOW_CHECK(3);
if (rule[1] >= blen) goto bad;
if (rule[2] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
@@ -1668,6 +1743,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
break;
case RULE_BETWEEN:
/* [lo, hi, rule] */
OVERFLOW_CHECK(4);
if (rule[3] >= blen) goto bad;
op_flags[rule[3]] |= 0x01;
i += 4;
@@ -1683,11 +1759,13 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
break;
case RULE_CONSTANT:
/* [constant, tag] */
OVERFLOW_CHECK(3);
if (rule[1] >= clen) goto bad;
i += 3;
break;
case RULE_CAPTURE_NUM:
/* [rule, base, tag] */
OVERFLOW_CHECK(4);
if (rule[1] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
i += 4;
@@ -1697,13 +1775,16 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
case RULE_CAPTURE:
case RULE_UNREF:
/* [rule, tag] */
OVERFLOW_CHECK(3);
if (rule[1] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
i += 3;
break;
case RULE_REPLACE:
case RULE_MATCHTIME:
case RULE_MATCHSPLICE:
/* [rule, constant, tag] */
OVERFLOW_CHECK(4);
if (rule[1] >= blen) goto bad;
if (rule[2] >= clen) goto bad;
op_flags[rule[1]] |= 0x01;
@@ -1713,6 +1794,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
case RULE_TIL:
case RULE_SPLIT:
/* [rule, rule] */
OVERFLOW_CHECK(3);
if (rule[1] >= blen) goto bad;
if (rule[2] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
@@ -1726,17 +1808,20 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
case RULE_TO:
case RULE_THRU:
/* [rule] */
OVERFLOW_CHECK(2);
if (rule[1] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
i += 2;
break;
case RULE_READINT:
/* [ width | (endianness << 5) | (signedness << 6), tag ] */
OVERFLOW_CHECK(3);
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
i += 3;
break;
case RULE_NTH:
/* [nth, rule, tag] */
OVERFLOW_CHECK(4);
if (rule[2] >= blen) goto bad;
op_flags[rule[2]] |= 0x01;
i += 4;
@@ -1766,6 +1851,8 @@ bad:
janet_panic("invalid peg bytecode");
}
#undef OVERFLOW_CHECK
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
static Janet peg_next(void *p, Janet key);
@@ -1834,8 +1921,8 @@ static JanetPeg *compile_peg(Janet x) {
JANET_CORE_FN(cfun_peg_compile,
"(peg/compile peg)",
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement "
"the grammar of the peg for otherwise undefined peg keywords.") {
"if the same peg will be used multiple times. `(dyn :peg-grammar)` replaces "
"`default-peg-grammar` for the grammar of the peg.") {
janet_fixarity(argc, 1);
JanetPeg *peg = compile_peg(argv[0]);
return janet_wrap_abstract(peg);
src/core/pp.c
+225 -82
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -72,7 +72,7 @@ static int count_dig10(int32_t x) {
}
}
static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
static int32_t integer_to_string_b(JanetBuffer *buffer, int32_t x) {
janet_buffer_extra(buffer, BUFSIZE);
uint8_t *buf = buffer->data + buffer->count;
int32_t neg = 0;
@@ -80,7 +80,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
if (x == 0) {
buf[0] = '0';
buffer->count++;
return;
return 1;
}
if (x > 0) {
x = -x;
@@ -96,6 +96,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
x /= 10;
}
buffer->count += len + neg;
return len + neg;
}
#define HEX(i) (((uint8_t *) janet_base64)[(i)])
@@ -134,43 +135,55 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
#undef POINTSIZE
}
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
static int janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
janet_buffer_push_u8(buffer, '"');
int align = 1;
for (int32_t i = 0; i < len; ++i) {
uint8_t c = str[i];
switch (c) {
case '"':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\"", 2);
align += 2;
break;
case '\n':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\n", 2);
align += 2;
break;
case '\r':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\r", 2);
align += 2;
break;
case '\0':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2);
align += 2;
break;
case '\f':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\f", 2);
align += 2;
break;
case '\v':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
align += 2;
break;
case '\a':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
align += 2;
break;
case '\b':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
align += 2;
break;
case 27:
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
align += 2;
break;
case '\\':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
align += 2;
break;
case '\t':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
align += 2;
break;
default:
if (c < 32 || c > 126) {
@@ -180,13 +193,16 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
buf[2] = janet_base64[(c >> 4) & 0xF];
buf[3] = janet_base64[c & 0xF];
janet_buffer_push_bytes(buffer, buf, 4);
align += 4;
} else {
janet_buffer_push_u8(buffer, c);
align++;
}
break;
}
}
janet_buffer_push_u8(buffer, '"');
return align + 1;
}
static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
@@ -358,9 +374,12 @@ const uint8_t *janet_to_string(Janet x) {
struct pretty {
JanetBuffer *buffer;
int depth;
int indent;
int width;
int align;
int leaf_align;
int flags;
int32_t bufstartlen;
int32_t lookback_barrier;
int32_t *keysort_buffer;
int32_t keysort_capacity;
int32_t keysort_start;
@@ -450,14 +469,76 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
return 0;
}
static void print_newline(struct pretty *S, int just_a_space) {
static void backtrack_newlines(const struct pretty *S) {
if (S->flags & JANET_PRETTY_ONELINE || S->buffer->count <= 0)
return;
switch (S->buffer->data[S->buffer->count - 1]) {
case ')':
case '}':
case ']':
break;
default:
return;
}
int32_t removed = 0;
int32_t old_count = S->buffer->count;
int32_t offset = old_count;
int32_t b0 = S->lookback_barrier;
int32_t columns = S->width;
int32_t align = 0;
while (--offset >= b0) {
const char *s = (const char *)S->buffer->data + offset;
if (*s == '\n') {
if (align < S->leaf_align) {
break;
}
columns += align;
removed += align;
align = 0;
} else if (*s == ' ') {
align++;
} else {
align = 0;
/* Don't count color sequences: \x1B(0|3\d)m */
if (S->flags & JANET_PRETTY_COLOR && *s == 'm') {
if (offset >= (3 + b0) && strncmp("\x1B[0m", s - 3, 4) == 0) {
offset -= 3;
columns++;
} else if (offset >= (4 + b0) && strncmp("\x1B[3", s - 4, 3) == 0) {
offset -= 4;
columns++;
}
}
}
if (--columns <= 0) {
return;
}
}
offset++; /* Don't mess with the last newline we found */
janet_assert(offset >= b0, "bad buffer index");
S->buffer->count -= removed;
for (int32_t i = offset; i < S->buffer->count; i++) {
if (S->buffer->data[offset] == '\n') {
S->buffer->data[i] = ' ';
while (S->buffer->data[++offset] == ' ') {
janet_assert(offset < old_count, "bad replacement of newline");
}
} else {
S->buffer->data[i] = S->buffer->data[offset++];
}
}
}
static void print_newline(struct pretty *S, int align) {
int i;
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
if (S->flags & JANET_PRETTY_ONELINE) {
janet_buffer_push_u8(S->buffer, ' ');
return;
}
backtrack_newlines(S);
janet_buffer_push_u8(S->buffer, '\n');
for (i = 0; i < S->indent; i++) {
S->leaf_align = S->align = align;
for (i = 0; i < S->align; i++) {
janet_buffer_push_u8(S->buffer, ' ');
}
}
@@ -484,13 +565,12 @@ static const char *janet_pretty_colors[] = {
"\x1B[36m"
};
#define JANET_PRETTY_DICT_ONELINE 4
#define JANET_PRETTY_IND_ONELINE 10
#define JANET_PRETTY_DICT_LIMIT 30
#define JANET_PRETTY_DICT_KEYSORT_LIMIT 2000
#define JANET_PRETTY_ARRAY_LIMIT 160
/* Helper for pretty printing */
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
static void janet_pretty_one(struct pretty *S, Janet x) {
/* Add to seen */
switch (janet_type(x)) {
case JANET_NIL:
@@ -505,7 +585,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, janet_cycle_color);
}
janet_buffer_push_cstring(S->buffer, "<cycle ");
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
S->align += 8 + integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
janet_buffer_push_u8(S->buffer, '>');
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
@@ -527,9 +607,12 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (janet_checktype(x, JANET_BUFFER) && janet_unwrap_buffer(x) == S->buffer) {
janet_buffer_ensure(S->buffer, S->buffer->count + S->bufstartlen * 4 + 3, 1);
janet_buffer_push_u8(S->buffer, '@');
janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
/* Use start len to print to self better */
S->align += 1 + janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
} else {
S->align -= S->buffer->count;
janet_description_b(S->buffer, x);
S->align += S->buffer->count;
}
if (color && (S->flags & JANET_PRETTY_COLOR)) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
@@ -546,35 +629,35 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "(";
const char endchar = isarray ? ']' : hasbrackets ? ']' : ')';
janet_buffer_push_cstring(S->buffer, startstr);
S->align += strlen(startstr);
const int align = S->leaf_align = S->align;
S->depth--;
S->indent += 2;
if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} else {
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
for (i = 0; i < 3; i++) {
if (i) print_newline(S, 0);
janet_pretty_one(S, arr[i], 0);
if (i) print_newline(S, align);
janet_pretty_one(S, arr[i]);
}
print_newline(S, 0);
print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "...");
for (i = 0; i < 3; i++) {
print_newline(S, 0);
janet_pretty_one(S, arr[len - 3 + i], 0);
S->align += 3;
for (i = len - 3; i < len; i++) {
print_newline(S, align);
janet_pretty_one(S, arr[i]);
}
} else {
for (i = 0; i < len; i++) {
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
janet_pretty_one(S, arr[i], 0);
if (i) print_newline(S, align);
janet_pretty_one(S, arr[i]);
}
}
}
S->indent -= 2;
S->depth++;
janet_buffer_push_u8(S->buffer, endchar);
S->align++;
break;
}
case JANET_STRUCT:
@@ -585,6 +668,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (istable) {
JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto;
S->align++;
janet_buffer_push_cstring(S->buffer, "@");
if (NULL != proto) {
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
@@ -595,6 +679,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, janet_class_color);
}
janet_buffer_push_bytes(S->buffer, n, len);
S->align += len;
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
}
@@ -612,73 +697,99 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, janet_class_color);
}
janet_buffer_push_bytes(S->buffer, n, len);
S->align += len;
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
}
}
}
}
janet_buffer_push_cstring(S->buffer, "{");
janet_buffer_push_u8(S->buffer, '{');
const int align = S->leaf_align = ++S->align;
S->depth--;
S->indent += 2;
if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} else {
int32_t i = 0, len = 0, cap = 0;
int32_t len = 0, cap = 0;
const JanetKV *kvs = NULL;
janet_dictionary_view(x, &kvs, &len, &cap);
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
int32_t ks_start = S->keysort_start;
/* Ensure buffer is large enough to sort keys. */
int truncated = 0;
int64_t mincap = (int64_t) len + (int64_t) ks_start;
if (mincap > INT32_MAX) {
truncated = 1;
len = 0;
mincap = ks_start;
}
if (S->keysort_capacity < mincap) {
if (mincap >= INT32_MAX / 2) {
S->keysort_capacity = INT32_MAX;
} else {
S->keysort_capacity = (int32_t)(mincap * 2);
/* Shortcut for huge dictionaries, don't bother sorting keys */
if (len > JANET_PRETTY_DICT_KEYSORT_LIMIT) {
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
len = JANET_PRETTY_DICT_LIMIT;
truncated = 1;
}
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
if (NULL == S->keysort_buffer) {
JANET_OUT_OF_MEMORY;
int32_t j = 0;
for (int32_t i = 0; i < len; i++) {
while (janet_checktype(kvs[j].key, JANET_NIL)) j++;
if (i) print_newline(S, align);
janet_pretty_one(S, kvs[j].key);
janet_buffer_push_u8(S->buffer, ' ');
S->align++;
janet_pretty_one(S, kvs[j].value);
j++;
}
}
if (truncated) {
print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
}
} else {
/* Sorted keys dictionaries */
janet_sorted_keys(kvs, cap, S->keysort_buffer == NULL ? NULL : S->keysort_buffer + ks_start);
S->keysort_start += len;
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
len = JANET_PRETTY_DICT_LIMIT;
truncated = 1;
}
/* Ensure buffer is large enough to sort keys. */
int64_t mincap = (int64_t) len + (int64_t) ks_start;
if (mincap > INT32_MAX) {
truncated = 1;
len = 0;
mincap = ks_start;
}
for (i = 0; i < len; i++) {
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
int32_t j = S->keysort_buffer[i + ks_start];
janet_pretty_one(S, kvs[j].key, 0);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[j].value, 1);
}
if (S->keysort_capacity < mincap) {
if (mincap >= INT32_MAX / 2) {
S->keysort_capacity = INT32_MAX;
} else {
S->keysort_capacity = (int32_t)(mincap * 2);
}
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
if (NULL == S->keysort_buffer) {
JANET_OUT_OF_MEMORY;
}
}
if (truncated) {
print_newline(S, 0);
janet_buffer_push_cstring(S->buffer, "...");
}
janet_sorted_keys(kvs, cap, S->keysort_buffer == NULL ? NULL : S->keysort_buffer + ks_start);
S->keysort_start += len;
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
len = JANET_PRETTY_DICT_LIMIT;
truncated = 1;
}
for (int32_t i = 0; i < len; i++) {
if (i) print_newline(S, align);
int32_t j = S->keysort_buffer[i + ks_start];
janet_pretty_one(S, kvs[j].key);
janet_buffer_push_u8(S->buffer, ' ');
S->align++;
janet_pretty_one(S, kvs[j].value);
}
if (truncated) {
print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
}
}
S->keysort_start = ks_start;
}
S->indent -= 2;
S->depth++;
janet_buffer_push_u8(S->buffer, '}');
S->align++;
break;
}
}
@@ -687,21 +798,27 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
return;
}
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Janet x, int32_t startlen) {
#define JANET_COLUMNS 80
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int width,
int flags, Janet x, int32_t startlen, int32_t lookback_barrier) {
struct pretty S;
if (NULL == buffer) {
buffer = janet_buffer(0);
}
S.buffer = buffer;
S.depth = depth;
S.indent = 0;
S.width = width;
S.align = 0;
S.flags = flags;
S.bufstartlen = startlen;
S.lookback_barrier = lookback_barrier;
S.keysort_capacity = 0;
S.keysort_buffer = NULL;
S.keysort_start = 0;
janet_table_init(&S.seen, 10);
janet_pretty_one(&S, x, 0);
janet_pretty_one(&S, x);
backtrack_newlines(&S);
janet_table_deinit(&S.seen);
return S.buffer;
}
@@ -709,19 +826,21 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
/* Helper for printing a janet value in a pretty form. Not meant to be used
* for serialization or anything like that. */
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
return janet_pretty_(buffer, depth, JANET_COLUMNS, flags,
x, buffer ? buffer->count : 0, buffer ? buffer->count : 0);
}
static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen) {
static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen, int32_t lookback_barrier) {
struct pretty S;
if (NULL == buffer) {
buffer = janet_buffer(0);
}
S.buffer = buffer;
S.depth = depth;
S.indent = 0;
S.align = 0;
S.flags = 0;
S.bufstartlen = startlen;
S.lookback_barrier = lookback_barrier;
S.keysort_capacity = 0;
S.keysort_buffer = NULL;
S.keysort_start = 0;
@@ -735,7 +854,7 @@ static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t
}
JanetBuffer *janet_jdn(JanetBuffer *buffer, int depth, Janet x) {
return janet_jdn_(buffer, depth, x, buffer ? buffer->count : 0);
return janet_jdn_(buffer, depth, x, buffer ? buffer->count : 0, buffer ? buffer->count : 0);
}
static const char *typestr(Janet x) {
@@ -897,7 +1016,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
case 's':
case 'S': {
const char *str = va_arg(args, const char *);
int32_t len = c[-1] == 's'
int32_t len = (c[-1] == 's')
? (int32_t) strlen(str)
: janet_string_length((JanetString) str);
if (form[2] == '\0')
@@ -941,18 +1060,26 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
int columns = atoi(width);
if (columns == 0) {
columns = JANET_COLUMNS;
} else if (columns < 0) {
has_oneline = 1;
}
int flags = 0;
flags |= has_color ? JANET_PRETTY_COLOR : 0;
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
janet_pretty_(b, depth, columns, flags,
va_arg(args, Janet), startlen, b->count);
break;
}
case 'j': {
int depth = atoi(precision);
if (depth < 1)
if (depth < 1) {
depth = JANET_RECURSION_GUARD;
janet_jdn_(b, depth, va_arg(args, Janet), startlen);
}
janet_jdn_(b, depth, va_arg(args, Janet), startlen, b->count);
break;
}
default: {
@@ -1023,10 +1150,20 @@ void janet_buffer_format(
char form[MAX_FORMAT], item[MAX_ITEM];
char width[3], precision[3];
int nb = 0; /* number of bytes in added item */
if (++arg >= argc)
janet_panic("not enough values for format");
#ifdef JANET_PLAN9
if (*strfrmt == 'r') {
rerrstr(item, MAX_ITEM);
nb = strlen(item);
} else
#endif
if (++arg >= argc)
janet_panic("not enough values for format");
strfrmt = scanformat(strfrmt, form, width, precision);
switch (*strfrmt++) {
#ifdef JANET_PLAN9
case 'r':
break;
#endif
case 'c': {
nb = snprintf(item, MAX_ITEM, form, (int)
janet_getinteger(argv, arg));
@@ -1093,18 +1230,24 @@ void janet_buffer_format(
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
int columns = atoi(width);
if (columns == 0)
columns = JANET_COLUMNS;
else if (columns < 0)
has_oneline = 1;
int flags = 0;
flags |= has_color ? JANET_PRETTY_COLOR : 0;
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
janet_pretty_(b, depth, flags, argv[arg], startlen);
janet_pretty_(b, depth, columns, flags,
argv[arg], startlen, b->count);
break;
}
case 'j': {
int depth = atoi(precision);
if (depth < 1)
depth = JANET_RECURSION_GUARD;
janet_jdn_(b, depth, argv[arg], startlen);
janet_jdn_(b, depth, argv[arg], startlen, b->count);
break;
}
default: {
src/core/regalloc.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/regalloc.h
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/run.c
+16 -10
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -60,7 +60,6 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
done = 1;
}
} else {
ret = janet_wrap_string(cres.error);
int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column;
if ((cres.error_mapping.line > 0) &&
@@ -68,13 +67,17 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
line = cres.error_mapping.line;
col = cres.error_mapping.column;
}
JanetString ctx = janet_formatc("%s:%d:%d: compile error",
sourcePath, line, col);
JanetString errstr = janet_formatc("%s: %s",
(const char *)ctx,
(const char *)cres.error);
ret = janet_wrap_string(errstr);
if (cres.macrofiber) {
janet_eprintf("%s:%d:%d: compile error", sourcePath,
line, col);
janet_eprintf("%s", (const char *)ctx);
janet_stacktrace_ext(cres.macrofiber, ret, "");
} else {
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
line, col, (const char *)cres.error);
janet_eprintf("%s\n", (const char *)errstr);
}
errflags |= JANET_DO_ERROR_COMPILE;
done = 1;
@@ -89,12 +92,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
done = 1;
break;
case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(parser);
errflags |= JANET_DO_ERROR_PARSE;
ret = janet_cstringv(e);
int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column;
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
JanetString errstr = janet_formatc("%s:%d:%d: parse error: %s",
sourcePath, line, col,
janet_parser_error(parser));
ret = janet_wrap_string(errstr);
janet_eprintf("%s\n", (const char *)errstr);
done = 1;
break;
}
@@ -122,7 +127,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
janet_loop();
if (fiber) {
janet_gcunroot(janet_wrap_fiber(fiber));
ret = fiber->last_value;
if (!errflags)
ret = fiber->last_value;
}
}
#endif
src/core/specials.c
+142 -44
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -29,6 +29,30 @@
#include "emit.h"
#endif
static int bad_16bit_jump(int32_t lab1, int32_t lab2) {
if (lab2 - lab1 > INT16_MAX) return 1;
if (lab2 - lab1 < INT16_MIN) return 1;
return 0;
}
static void check_16bit_jump(JanetCompiler *c, int32_t lab1, int32_t lab2) {
if (bad_16bit_jump(lab1, lab2)) {
janetc_cerror(c, "bad 16-bit jump, too large");
}
}
static int bad_24bit_jump(int32_t lab1, int32_t lab2) {
if (lab2 - lab1 > 0xFFFFFF) return 1;
if (lab2 - lab1 < -0x1000000) return 1;
return 0;
}
static void check_24bit_jump(JanetCompiler *c, int32_t lab1, int32_t lab2) {
if (bad_24bit_jump(lab1, lab2)) {
janetc_cerror(c, "bad 24-bit jump, too large");
}
}
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
if (argn != 1) {
janetc_cerror(opts.compiler, "expected 1 argument to quote");
@@ -126,7 +150,7 @@ static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *a
janetc_cerror(opts.compiler, "expected 1 argument to quasiquote");
return janetc_cslot(janet_wrap_nil());
}
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
return quasiquote(opts, argv[0], opts.compiler->recursion_guard, 0);
}
static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -147,6 +171,10 @@ static int destructure(JanetCompiler *c,
JanetSlot s,
JanetTable *attr),
JanetTable *attr) {
if (c->recursion_guard <= 0) {
janetc_error(c, janet_cstring("C stack recursed too deeply"));
return 1;
}
switch (janet_type(left)) {
default:
janetc_error(c, janet_formatc("unexpected type in destructuring, got %v", left));
@@ -209,6 +237,8 @@ static int destructure(JanetCompiler *c,
int32_t label_loop_exit = janet_v_count(c->buffer);
/* avoid shifting negative numbers */
check_16bit_jump(c, label_loop_cond_jump, label_loop_exit);
check_24bit_jump(c, label_loop_start, label_loop_loop);
c->buffer[label_loop_cond_jump] |= (uint32_t)(label_loop_exit - label_loop_cond_jump) << 16;
c->buffer[label_loop_loop] |= (uint32_t)(label_loop_start - label_loop_loop) << 8;
@@ -229,8 +259,10 @@ static int destructure(JanetCompiler *c,
JanetSlot k = janetc_cslot(janet_wrap_integer(i));
janetc_emit_sss(c, JOP_IN, nextright, right, k, 1);
}
c->recursion_guard--;
if (destructure(c, subval, nextright, leaf, attr))
janetc_freeslot(c, nextright);
c->recursion_guard++;
}
}
return 1;
@@ -244,8 +276,10 @@ static int destructure(JanetCompiler *c,
JanetSlot nextright = janetc_farslot(c);
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
janetc_emit_sss(c, JOP_IN, nextright, right, k, 1);
c->recursion_guard--;
if (destructure(c, kvs[i].value, nextright, leaf, attr))
janetc_freeslot(c, nextright);
c->recursion_guard++;
}
}
return 1;
@@ -307,14 +341,14 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
/* Add attributes to a global def or var table */
static JanetTable *handleattr(JanetCompiler *c, const char *kind, int32_t argn, const Janet *argv) {
int32_t i;
JanetTable *tab = janet_table(2);
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
? ((const char *)janet_unwrap_symbol(argv[0]))
: "<multiple bindings>";
if (argn < 2) {
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
return NULL;
}
JanetTable *tab = janet_table(2);
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
? ((const char *)janet_unwrap_symbol(argv[0]))
: "<multiple bindings>";
for (i = 1; i < argn - 1; i++) {
Janet attr = argv[i];
switch (janet_type(attr)) {
@@ -344,7 +378,10 @@ typedef struct SlotHeadPair {
} SlotHeadPair;
SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopts opts, Janet lhs, Janet rhs) {
if (c->recursion_guard <= 0) {
janetc_error(c, janet_cstring("C stack recursed too deeply"));
return NULL;
}
/* Detect if we can do an optimization to avoid some allocations */
int can_destructure_lhs = janet_checktype(lhs, JANET_TUPLE)
|| janet_checktype(lhs, JANET_ARRAY);
@@ -362,6 +399,23 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
int found_amp = 0;
int found_splice = 0;
/* Check for (def [x y z] [(splice [1 2 3]) 4 5 6]), bail out of optimization */
for (int32_t i = 0; i < view_rhs.len; i++) {
if (!janet_checktype(view_rhs.items[i], JANET_TUPLE)) {
continue;
}
JanetTuple tup = janet_unwrap_tuple(view_rhs.items[i]);
if (janet_tuple_length(tup) == 0) {
continue;
}
if (janet_symeq(tup[0], "splice")) {
found_splice = 1;
/* Good error will be generated later. */
break;
}
}
/* Check for (def [x & more] [1 2 3]), bail out of optimization */
for (int32_t i = 0; i < view_lhs.len; i++) {
if (janet_symeq(view_lhs.items[i], "&")) {
found_amp = 1;
@@ -369,10 +423,12 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
break;
}
}
if (!found_amp) {
if (!found_amp && !found_splice) {
for (int32_t i = 0; i < view_lhs.len; i++) {
Janet sub_rhs = view_rhs.len <= i ? janet_wrap_nil() : view_rhs.items[i];
c->recursion_guard--;
into = dohead_destructure(c, into, subopts, view_lhs.items[i], sub_rhs);
c->recursion_guard++;
}
return into;
}
@@ -387,7 +443,7 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
}
/* Def or var a symbol in a local scope */
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret) {
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, uint32_t def_flags) {
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
ret.index > 0 &&
ret.envindex >= 0;
@@ -408,7 +464,10 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
ret = localslot;
}
ret.flags |= flags;
janetc_nameslot(c, head, ret);
if (c->scope->flags & JANET_SCOPE_TOP) {
def_flags |= JANET_DEFFLAG_NO_UNUSED;
}
janetc_nameslot(c, head, ret, def_flags);
return !isUnnamedRegister;
}
@@ -422,8 +481,7 @@ static int varleaf(
JanetSlot refslot;
JanetTable *entry = janet_table_clone(reftab);
Janet redef_kw = janet_ckeywordv("redef");
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
int is_redef = c->is_redef;
JanetArray *ref;
JanetBinding old_binding;
@@ -443,7 +501,21 @@ static int varleaf(
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
return 1;
} else {
return namelocal(c, sym, JANET_SLOT_MUTABLE, s);
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused"));
int no_shadow = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "shadow"));
uint32_t def_flags = 0;
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, def_flags);
}
}
static void check_metadata_lint(JanetCompiler *c, JanetTable *attr_table) {
if (!(c->scope->flags & JANET_SCOPE_TOP) && attr_table && attr_table->count) {
/* A macro is a normal lint, other metadata is a strict lint */
if (janet_truthy(janet_table_get_keyword(attr_table, "macro"))) {
janetc_lintf(c, JANET_C_LINT_NORMAL, "macro tag is ignored in inner scopes");
}
}
}
@@ -453,14 +525,14 @@ static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
if (c->result.status == JANET_COMPILE_ERROR) {
return janetc_cslot(janet_wrap_nil());
}
check_metadata_lint(c, attr_table);
SlotHeadPair *into = NULL;
into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
if (c->result.status == JANET_COMPILE_ERROR) {
janet_v_free(into);
return janetc_cslot(janet_wrap_nil());
}
JanetSlot ret;
janet_assert(janet_v_count(into) > 0, "bad destructure");
JanetSlot ret = janetc_cslot(janet_wrap_nil());
for (int32_t i = 0; i < janet_v_count(into); i++) {
destructure(c, into[i].lhs, into[i].rhs, varleaf, attr_table);
ret = into[i].rhs;
@@ -474,14 +546,15 @@ static int defleaf(
const uint8_t *sym,
JanetSlot s,
JanetTable *tab) {
JanetTable *entry = NULL;
int is_redef = 0;
if (c->scope->flags & JANET_SCOPE_TOP) {
JanetTable *entry = janet_table_clone(tab);
entry = janet_table_clone(tab);
janet_table_put(entry, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c)));
Janet redef_kw = janet_ckeywordv("redef");
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
if (is_redef) janet_table_put(entry, redef_kw, janet_wrap_true());
is_redef = c->is_redef;
if (is_redef) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
if (is_redef) {
JanetBinding binding = janet_resolve_ext(c->env, sym);
@@ -500,11 +573,18 @@ static int defleaf(
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
}
/* Add env entry to env */
}
int no_unused = tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "unused"));
int no_shadow = is_redef || (tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "shadow")));
uint32_t def_flags = 0;
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
int result = namelocal(c, sym, 0, s, def_flags);
if (entry) {
/* Add env entry to env AFTER namelocal to avoid the shadowcheck false positive */
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
}
return namelocal(c, sym, 0, s);
return result;
}
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -513,6 +593,7 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
if (c->result.status == JANET_COMPILE_ERROR) {
return janetc_cslot(janet_wrap_nil());
}
check_metadata_lint(c, attr_table);
opts.flags &= ~JANET_FOPTS_HINT;
SlotHeadPair *into = NULL;
into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
@@ -520,8 +601,7 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
janet_v_free(into);
return janetc_cslot(janet_wrap_nil());
}
JanetSlot ret;
janet_assert(janet_v_count(into) > 0, "bad destructure");
JanetSlot ret = janetc_cslot(janet_wrap_nil());
for (int32_t i = 0; i < janet_v_count(into); i++) {
destructure(c, into[i].lhs, into[i].rhs, defleaf, attr_table);
ret = into[i].rhs;
@@ -652,8 +732,14 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Write jumps - only add jump lengths if jump actually emitted */
labeld = janet_v_count(c->buffer);
c->buffer[labeljr] |= (labelr - labeljr) << 16;
if (!tail) c->buffer[labeljd] |= (labeld - labeljd) << 8;
if (labeljr < labeld) {
check_16bit_jump(c, labeljr, labelr);
c->buffer[labeljr] |= (uint32_t) (labelr - labeljr) << 16;
if (!tail && labeljd < labeld) {
check_24bit_jump(c, labeljd, labeld);
c->buffer[labeljd] |= (uint32_t) (labeld - labeljd) << 8;
}
}
if (tail) target.flags |= JANET_SLOT_RETURNED;
return target;
@@ -870,18 +956,18 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
}
/* But now add tail recursion */
int32_t tempself = janetc_regalloc_temp(&tempscope.ra, JANETC_REGTEMP_0);
janetc_emit(c, JOP_LOAD_SELF | (tempself << 8));
janetc_emit(c, JOP_TAILCALL | (tempself << 8));
janetc_emit(c, JOP_LOAD_SELF | ((uint32_t) tempself << 8));
janetc_emit(c, JOP_TAILCALL | ((uint32_t) tempself << 8));
janetc_regalloc_freetemp(&c->scope->ra, tempself, JANETC_REGTEMP_0);
/* Compile function */
JanetFuncDef *def = janetc_pop_funcdef(c);
def->name = janet_cstring("_while");
def->name = janet_cstring("while");
janet_def_addflags(def);
int32_t defindex = janetc_addfuncdef(c, def);
/* And then load the closure and call it. */
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
janetc_emit(c, JOP_CLOSURE | (cloreg << 8) | (defindex << 16));
janetc_emit(c, JOP_CALL | (cloreg << 8) | (cloreg << 16));
janetc_emit(c, JOP_CLOSURE | ((uint32_t) cloreg << 8) | ((uint32_t) defindex << 16));
janetc_emit(c, JOP_CALL | ((uint32_t) cloreg << 8) | ((uint32_t) cloreg << 16));
janetc_regalloc_freetemp(&c->scope->ra, cloreg, JANETC_REGTEMP_0);
c->scope->flags |= JANET_SCOPE_CLOSURE;
return janetc_cslot(janet_wrap_nil());
@@ -893,13 +979,19 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Calculate jumps */
labeld = janet_v_count(c->buffer);
if (!infinite) c->buffer[labelc] |= (uint32_t)(labeld - labelc) << 16;
if (!infinite) {
check_16bit_jump(c, labelc, labeld);
c->buffer[labelc] |= (uint32_t)(labeld - labelc) << 16;
}
check_24bit_jump(c, labeljt, labelwt);
c->buffer[labeljt] |= (uint32_t)(labelwt - labeljt) << 8;
/* Calculate breaks */
for (int32_t i = labelwt; i < labeld; i++) {
if (c->buffer[i] == (0x80 | JOP_JUMP)) {
c->buffer[i] = JOP_JUMP | ((labeld - i) << 8);
check_24bit_jump(c, i, labeld);
c->buffer[i] = JOP_JUMP | ((uint32_t) (labeld - i) << 8);
}
}
@@ -1032,16 +1124,24 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
named_table = janet_table(10);
named_slot = janetc_farslot(c);
} else {
janetc_nameslot(c, sym, janetc_farslot(c));
janetc_nameslot(c, sym, janetc_farslot(c), 0);
}
} else {
janetc_nameslot(c, sym, janetc_farslot(c));
janetc_nameslot(c, sym, janetc_farslot(c), 0);
}
} else {
janet_v_push(destructed_params, janetc_farslot(c));
}
}
/* Compile named arguments */
if (namedargs) {
Janet param = janet_wrap_table(named_table);
destructure(c, param, named_slot, defleaf, NULL);
janetc_freeslot(c, named_slot);
janet_v_free(named_params);
}
/* Compile destructed params */
int32_t j = 0;
for (i = 0; i < paramcount; i++) {
@@ -1055,14 +1155,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
}
janet_v_free(destructed_params);
/* Compile named arguments */
if (namedargs) {
Janet param = janet_wrap_table(named_table);
destructure(c, param, named_slot, defleaf, NULL);
janetc_freeslot(c, named_slot);
janet_v_free(named_params);
}
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
if (!seenopt) min_arity = arity;
@@ -1084,7 +1176,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetSlot slot = janetc_farslot(c);
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
janetc_nameslot(c, sym, slot);
/* We should figure out a better way to avoid `(def x 1) (def x :shadow (fn x [...] ...))` triggering a
* shadow lint for the last x */
janetc_nameslot(c, sym, slot, JANET_DEFFLAG_NO_UNUSED | JANET_DEFFLAG_NO_SHADOWCHECK);
}
}
@@ -1105,8 +1199,12 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
def->arity = arity;
def->min_arity = min_arity;
def->max_arity = max_arity;
if (named_table != NULL) {
def->named_args_count = named_table->count;
}
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
if (namedargs) def->flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
janet_def_addflags(def);
src/core/state.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/state.h
+3 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -182,6 +182,8 @@ struct JanetVM {
JanetTable signal_handlers;
#ifdef JANET_WINDOWS
void **iocp;
void *connect_ex; /* MSWsock extension if available */
int connect_ex_loaded;
#elif defined(JANET_EV_EPOLL)
pthread_attr_t new_thread_attr;
JanetHandle selfpipe[2];
src/core/string.c
+6 -4
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -476,13 +476,13 @@ JANET_CORE_FN(cfun_string_checkset,
/* Populate set */
for (int32_t i = 0; i < set.len; i++) {
int index = set.bytes[i] >> 5;
uint32_t mask = 1 << (set.bytes[i] & 0x1F);
uint32_t mask = (uint32_t) 1 << (set.bytes[i] & 0x1F);
bitset[index] |= mask;
}
/* Check set */
for (int32_t i = 0; i < str.len; i++) {
int index = str.bytes[i] >> 5;
uint32_t mask = 1 << (str.bytes[i] & 0x1F);
uint32_t mask = (uint32_t) 1 << (str.bytes[i] & 0x1F);
if (!(bitset[index] & mask)) {
return janet_wrap_false();
}
@@ -555,7 +555,9 @@ JANET_CORE_FN(cfun_string_format,
"\n"
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
"variants generate colored output. These specifiers can take a precision "
"argument to specify the maximum nesting depth to print.\n"
"argument to specify the maximum nesting depth to print. "
"The multiline specifiers can also take a width argument, "
"which defaults to 80 columns.\n"
"- `p`, `P`: pretty format, truncating if necessary\n"
"- `m`, `M`: pretty format without truncating.\n"
"- `q`, `Q`: pretty format on one line, truncating if necessary.\n"
src/core/strtod.c
+5 -6
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -49,6 +49,8 @@
#include <math.h>
#include <string.h>
#define JANET_NUMBER_LENGTH_RIDICULOUS 0xFFFF
/* Lookup table for getting values of characters when parsing numbers. Handles
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
static uint8_t digit_lookup[128] = {
@@ -266,7 +268,7 @@ int janet_scan_number_base(
* the decimal point, exponent could wrap around and become positive. It's
* easier to reject ridiculously large inputs than to check for overflows.
* */
if (len > INT32_MAX / 40) goto error;
if (len > JANET_NUMBER_LENGTH_RIDICULOUS) goto error;
/* Get sign */
if (str >= end) goto error;
@@ -410,10 +412,7 @@ static int scan_uint64(
*neg = 0;
*out = 0;
uint64_t accum = 0;
/* len max is INT64_MAX in base 2 with _ between each bits */
/* '2r' + 64 bits + 63 _ + sign = 130 => 150 for some leading */
/* zeros */
if (len > 150) return 0;
if (len > JANET_NUMBER_LENGTH_RIDICULOUS) return 0;
/* Get sign */
if (str >= end) return 0;
if (*str == '-') {
src/core/struct.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/symcache.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/symcache.h
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/table.c
+12 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -155,6 +155,17 @@ Janet janet_table_get(JanetTable *t, Janet key) {
return janet_wrap_nil();
}
/* Used internally for compiler stuff */
Janet janet_table_get_keyword(JanetTable *t, const char *keyword) {
int32_t keyword_len = (int32_t) strlen(keyword);
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
JanetKV *bucket = (JanetKV *) janet_dict_find_keyword(t->data, t->capacity, (const uint8_t *) keyword, keyword_len);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
return bucket->value;
}
return janet_wrap_nil();
}
/* Get a value out of the table, and record which prototype it was from. */
Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
src/core/tuple.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/util.c
+97 -9
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -50,6 +50,7 @@
#endif
#include <inttypes.h>
#include <float.h>
/* Base 64 lookup table for digits */
const char janet_base64[65] =
@@ -268,7 +269,7 @@ int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
return (int32_t) hash;
}
/* Calculate next power of 2. May overflow. If n is 0,
/* Calculate next power of 2. May overflow. If n < 0,
* will return 0. */
int32_t janet_tablen(int32_t n) {
if (n < 0) return 0;
@@ -277,7 +278,7 @@ int32_t janet_tablen(int32_t n) {
n |= n >> 4;
n |= n >> 8;
n |= n >> 16;
return n + 1;
return n == INT32_MAX ? INT32_MAX : n + 1;
}
/* Avoid some undefined behavior that was common in the code base. */
@@ -321,6 +322,54 @@ const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
return first_bucket;
}
/* Helper to find a keyword, symbol, or string in a Janet struct or table without allocating
* memory or needing to find interned symbols */
const JanetKV *janet_dict_find_keyword(
const JanetKV *buckets, int32_t cap,
const uint8_t *cstr, int32_t cstr_len) {
int32_t hash = janet_string_calchash(cstr, cstr_len);
int32_t index = janet_maphash(cap, hash);
int32_t i;
const JanetKV *first_bucket = NULL;
/* Higher half */
for (i = index; i < cap; i++) {
const JanetKV *kv = buckets + i;
if (janet_checktype(kv->key, JANET_NIL)) {
if (janet_checktype(kv->value, JANET_NIL)) {
return kv;
} else if (NULL == first_bucket) {
first_bucket = kv;
}
} else if (janet_checktype(kv->key, JANET_KEYWORD)) {
/* Works for symbol and keyword, too */
JanetString str = janet_unwrap_string(kv->key);
int32_t len = janet_string_length(str);
if (hash == janet_string_hash(str) && len == cstr_len && !memcmp(str, cstr, len)) {
return buckets + i;
}
}
}
/* Lower half */
for (i = 0; i < index; i++) {
const JanetKV *kv = buckets + i;
if (janet_checktype(kv->key, JANET_NIL)) {
if (janet_checktype(kv->value, JANET_NIL)) {
return kv;
} else if (NULL == first_bucket) {
first_bucket = kv;
}
} else if (janet_checktype(kv->key, JANET_KEYWORD)) {
/* Works for symbol and keyword, too */
JanetString str = janet_unwrap_string(kv->key);
int32_t len = janet_string_length(str);
if (hash == janet_string_hash(str) && len == cstr_len && !memcmp(str, cstr, len)) {
return buckets + i;
}
}
}
return first_bucket;
}
/* Get a value from a janet struct or table. */
Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key) {
const JanetKV *kv = janet_dict_find(data, cap, key);
@@ -525,8 +574,24 @@ static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
return (char *)(namebuf->buf);
}
/* Add a little bit of safety when using nanboxing on arm. Instead of inserting run-time checks everywhere, we are
* only doing it during registration which has much less cost (1 shift and mask). */
static void janet_check_pointer_align(void *p) {
(void) p;
#if defined(JANET_NANBOX_64) && JANET_NANBOX_64_POINTER_SHIFT != 0
union {
void *p;
uintptr_t u;
} un;
un.p = p;
janet_assert(!(un.u & (uintptr_t) ((1 << JANET_NANBOX_64_POINTER_SHIFT) - 1)),
"unaligned pointer wrap - cfunction pointers and abstract types must be aligned with this nanboxing configuration.");
#endif
}
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
if (env) janet_def(env, cfuns->name, fun, cfuns->documentation);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
@@ -536,6 +601,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
if (env) janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
@@ -547,6 +613,7 @@ void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *
NameBuf nb;
if (env) namebuf_init(&nb, regprefix);
while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
@@ -559,6 +626,7 @@ void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetR
NameBuf nb;
if (env) namebuf_init(&nb, regprefix);
while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
if (env) janet_def_sm(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
@@ -575,6 +643,7 @@ void janet_register(const char *name, JanetCFunction cfun) {
/* Abstract type introspection */
void janet_register_abstract_type(const JanetAbstractType *at) {
janet_check_pointer_align((void *) at);
Janet sym = janet_csymbolv(at->name);
Janet check = janet_table_get(janet_vm.abstract_registry, sym);
if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
@@ -607,6 +676,7 @@ void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
(void) regprefix;
while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_table_put(env, janet_csymbolv(cfuns->name), fun);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
@@ -628,8 +698,11 @@ JanetBinding janet_binding_from_entry(Janet entry) {
return binding;
entry_table = janet_unwrap_table(entry);
/* deprecation check */
Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
Janet deprecate = janet_table_get_keyword(entry_table, "deprecated");
int macro = janet_truthy(janet_table_get_keyword(entry_table, "macro"));
Janet value = janet_table_get_keyword(entry_table, "value");
Janet ref = janet_table_get_keyword(entry_table, "ref");
if (janet_checktype(deprecate, JANET_KEYWORD)) {
JanetKeyword depkw = janet_unwrap_keyword(deprecate);
if (!janet_cstrcmp(depkw, "relaxed")) {
@@ -643,11 +716,8 @@ JanetBinding janet_binding_from_entry(Janet entry) {
binding.deprecation = JANET_BINDING_DEP_NORMAL;
}
int macro = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("macro")));
Janet value = janet_table_get(entry_table, janet_ckeywordv("value"));
Janet ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
int ref_is_valid = janet_checktype(ref, JANET_ARRAY);
int redef = ref_is_valid && janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef")));
int redef = ref_is_valid && janet_truthy(janet_table_get_keyword(entry_table, "redef"));
if (macro) {
binding.value = redef ? ref : value;
@@ -843,16 +913,34 @@ int janet_checkuint16(Janet x) {
return janet_checkuint16range(dval);
}
int janet_checkint8(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkint8range(dval);
}
int janet_checkuint8(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkuint8range(dval);
}
int janet_checksize(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
if (dval != (double)((size_t) dval)) return 0;
#ifdef JANET_PLAN9
return dval <= SIZE_MAX;
#else
if (SIZE_MAX > JANET_INTMAX_INT64) {
return dval <= JANET_INTMAX_INT64;
} else {
return dval <= SIZE_MAX;
}
#endif
}
JanetTable *janet_get_core_table(const char *name) {
src/core/util.h
+52 -3
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -50,9 +50,9 @@
#ifndef JANET_EXIT
#include <stdio.h>
#define JANET_EXIT(m) do { \
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\
__LINE__,\
fprintf(stderr, "janet abort at %s:%d: %s\n",\
__FILE__,\
__LINE__,\
(m));\
abort();\
} while (0)
@@ -66,42 +66,72 @@
/* Utils */
uint32_t janet_hash_mix(uint32_t input, uint32_t more);
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
int janet_valid_utf8(const uint8_t *str, int32_t len);
int janet_is_symbol_char(uint8_t c);
extern const char janet_base64[65];
int32_t janet_array_calchash(const Janet *array, int32_t len);
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
int32_t janet_string_calchash(const uint8_t *str, int32_t len);
int32_t janet_tablen(int32_t n);
void safe_memcpy(void *dest, const void *src, size_t len);
void janet_buffer_push_types(JanetBuffer *buffer, int types);
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
void janet_memempty(JanetKV *mem, int32_t count);
void *janet_memalloc_empty(int32_t count);
JanetTable *janet_get_core_table(const char *name);
void janet_def_addflags(JanetFuncDef *def);
void janet_buffer_dtostr(JanetBuffer *buffer, double x);
const char *janet_strerror(int e);
const void *janet_strbinsearch(
const void *tab,
size_t tabcount,
size_t itemsize,
const uint8_t *key);
void janet_buffer_format(
JanetBuffer *b,
const char *strfrmt,
int32_t argstart,
int32_t argc,
Janet *argv);
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
JanetBinding janet_binding_from_entry(Janet entry);
JanetByteView janet_text_substitution(
Janet *subst,
const uint8_t *bytes,
uint32_t len,
JanetArray *extra_args);
const JanetKV *janet_dict_find_keyword(
const JanetKV *buckets,
int32_t cap,
const uint8_t *cstr,
int32_t cstr_len);
Janet janet_table_get_keyword(JanetTable *t, const char *keyword);
/* Registry functions */
void janet_registry_put(
JanetCFunction key,
@@ -167,7 +197,26 @@ typedef void *Clib;
#endif
char *get_processed_name(const char *name);
#ifdef JANET_PLAN9
#define RETRY_EINTR(RC, CALL) (RC) = CALL;
#else
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
#endif
#ifdef JANET_EV
#ifdef JANET_WINDOWS
#include <winsock2.h>
#include <windows.h>
#include <io.h>
typedef struct {
union {
OVERLAPPED overlapped;
WSAOVERLAPPED wsaoverlapped;
} as;
uint32_t bytes_transfered;
} JanetOverlapped;
#endif
#endif
/* Initialize builtin libraries */
void janet_lib_io(JanetTable *env);
src/core/value.c
+19 -9
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -322,7 +322,8 @@ int32_t janet_hash(Janet x) {
break;
case JANET_TUPLE:
hash = janet_tuple_hash(janet_unwrap_tuple(x));
hash += (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
uint32_t inc = (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;
case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x));
@@ -334,10 +335,9 @@ int32_t janet_hash(Janet x) {
} as;
as.d = janet_unwrap_number(x);
as.d += 0.0; /* normalize negative 0 */
uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
as.u = murmur64(as.u);
uint32_t hi = (uint32_t)(as.u >> 32);
uint32_t hilo = (hi ^ lo) * 2654435769u;
hash = (int32_t)((hilo << 16) | (hilo >> 16));
hash = (int32_t)hi;
break;
}
case JANET_ABSTRACT: {
@@ -495,7 +495,7 @@ Janet janet_in(Janet ds, Janet key) {
if (!(type->get)(janet_unwrap_abstract(ds), key, &value))
janet_panicf("key %v not found in %v ", key, ds);
} else {
janet_panicf("no getter for %v ", ds);
janet_panicf("no getter for %v", ds);
}
break;
}
@@ -622,7 +622,7 @@ Janet janet_getindex(Janet ds, int32_t index) {
if (!(type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index), &value))
value = janet_wrap_nil();
} else {
janet_panicf("no getter for %v ", ds);
janet_panicf("no getter for %v", ds);
}
break;
}
@@ -724,6 +724,9 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
JanetArray *array = janet_unwrap_array(ds);
if (index >= array->count) {
janet_array_ensure(array, index + 1, 2);
for (int32_t i = array->count; i < index + 1; i++) {
array->data[i] = janet_wrap_nil();
}
array->count = index + 1;
}
array->data[index] = value;
@@ -735,6 +738,7 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
janet_panicf("can only put integers in buffers, got %v", value);
if (index >= buffer->count) {
janet_buffer_ensure(buffer, index + 1, 2);
memset(buffer->data + buffer->count, 0, index + 1 - buffer->count);
buffer->count = index + 1;
}
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
@@ -767,7 +771,11 @@ void janet_put(Janet ds, Janet key, Janet value) {
JanetArray *array = janet_unwrap_array(ds);
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
if (index >= array->count) {
janet_array_setcount(array, index + 1);
janet_array_ensure(array, index + 1, 2);
for (int32_t i = array->count; i < index + 1; i++) {
array->data[i] = janet_wrap_nil();
}
array->count = index + 1;
}
array->data[index] = value;
break;
@@ -778,7 +786,9 @@ void janet_put(Janet ds, Janet key, Janet value) {
if (!janet_checkint(value))
janet_panicf("can only put integers in buffers, got %v", value);
if (index >= buffer->count) {
janet_buffer_setcount(buffer, index + 1);
janet_buffer_ensure(buffer, index + 1, 2);
memset(buffer->data + buffer->count, 0, index + 1 - buffer->count);
buffer->count = index + 1;
}
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
break;
src/core/vector.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/vector.h
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
src/core/vm.c
+94 -32
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -129,7 +129,9 @@
if (!janet_checktype(op1, JANET_NUMBER)) {\
vm_commit();\
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
stack[A] = janet_mcall(#op, 2, _argv);\
Janet a = janet_mcall(#op, 2, _argv);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
} else {\
double x1 = janet_unwrap_number(op1);\
@@ -143,7 +145,9 @@
if (!janet_checktype(op1, JANET_NUMBER)) {\
vm_commit();\
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
stack[A] = janet_mcall(#op, 2, _argv);\
Janet a = janet_mcall(#op, 2, _argv);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
} else {\
double y1 = janet_unwrap_number(op1);\
@@ -166,7 +170,9 @@
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
Janet a = janet_binop_call(#op, "r" #op, op1, op2);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
}\
}
@@ -186,7 +192,9 @@
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
Janet a = janet_binop_call(#op, "r" #op, op1, op2);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
}\
}
@@ -203,7 +211,9 @@
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
Janet a = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
}\
}
@@ -217,23 +227,29 @@
vm_pcnext();\
} else {\
vm_commit();\
stack[A] = janet_wrap_boolean(janet_compare(op1, janet_wrap_integer(CS)) op 0);\
Janet a = janet_wrap_boolean(janet_compare(op1, janet_wrap_integer(CS)) op 0);\
stack = fiber->data + fiber->frame;\
stack[A] = a;\
vm_checkgc_pcnext();\
}\
}
/* Trace a function call */
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
if (func->def->name) {
janet_eprintf("trace (%S", func->def->name);
} else {
janet_eprintf("trace (%p", janet_wrap_function(func));
}
for (int32_t i = 0; i < argc; i++) {
janet_eprintf(" %p", argv[i]);
}
janet_eprintf(")\n");
}
/* Trace a function call.
* This is a macro to avoid stale argv if janet_eprintf resizes the stack
*/
#define vm_do_trace(func, argc, argv) do { \
JanetFunction* _func = (func);\
if (_func->def->name) {\
janet_eprintf("trace (%S", _func->def->name);\
} else {\
janet_eprintf("trace (%p", janet_wrap_function(_func));\
}\
int32_t _argc = (argc);\
for (int32_t i = 0; i < _argc; i++) {\
janet_eprintf(" %p", (argv)[i]);\
}\
janet_eprintf(")\n");\
} while (0)
/* Invoke a method once we have looked it up */
static Janet janet_method_invoke(Janet method, int32_t argc, Janet *argv) {
@@ -602,10 +618,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
register uint32_t *pc;
register JanetFunction *func;
/* NOTE: Flag smuggling! We "smuggle" the fiber sigal in the gc.flags field instead of the usual flags field */
if (fiber->flags & JANET_FIBER_RESUME_SIGNAL) {
/* Get the signal */
JanetSignal sig = (fiber->gc.flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
/* Clear the signal */
fiber->gc.flags &= ~JANET_FIBER_STATUS_MASK;
fiber->flags &= ~(JANET_FIBER_RESUME_SIGNAL | JANET_FIBER_FLAG_MASK);
fiber->flags &= ~JANET_FIBER_RESUME_SIGNAL;
janet_vm.return_reg[0] = in;
return sig;
}
@@ -710,7 +729,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("div", "rdiv", op1, op2);
Janet a = janet_binop_call("div", "rdiv", op1, op2);
stack = fiber->data + fiber->frame;
stack[A] = a;
vm_checkgc_pcnext();
}
}
@@ -730,7 +751,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("mod", "rmod", op1, op2);
Janet a = janet_binop_call("mod", "rmod", op1, op2);
stack = fiber->data + fiber->frame;
stack[A] = a;
vm_checkgc_pcnext();
}
}
@@ -745,7 +768,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("%", "r%", op1, op2);
Janet a = janet_binop_call("%", "r%", op1, op2);
stack = fiber->data + fiber->frame;
stack[A] = a;
vm_checkgc_pcnext();
}
}
@@ -766,7 +791,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_unary_call("~", op);
Janet a = janet_unary_call("~", op);
stack = fiber->data + fiber->frame;
stack[A] = a;
vm_checkgc_pcnext();
}
}
@@ -872,8 +899,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
stack[A] = janet_wrap_boolean(!janet_checktype(stack[B], JANET_NUMBER) || (janet_unwrap_number(stack[B]) != (double) CS));
vm_pcnext();
VM_OP(JOP_COMPARE)
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
VM_OP(JOP_COMPARE) {
Janet a = janet_wrap_integer(janet_compare(stack[B], stack[C]));
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_NEXT)
@@ -1104,11 +1134,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
}
fiber->child = child;
JanetSignal sig = janet_continue_no_check(child, stack[C], &retreg);
stack = fiber->data + fiber->frame;
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
vm_return(sig, retreg);
}
fiber->child = NULL;
stack = fiber->data + fiber->frame;
stack[A] = retreg;
vm_checkgc_pcnext();
}
@@ -1157,6 +1187,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_commit();
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
janet_put(stack[A], stack[B], stack[C]);
stack = fiber->data + fiber->frame;
fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
vm_checkgc_pcnext();
@@ -1164,27 +1195,44 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_commit();
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
janet_putindex(stack[A], C, stack[B]);
stack = fiber->data + fiber->frame;
fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
vm_checkgc_pcnext();
VM_OP(JOP_IN)
vm_commit();
stack[A] = janet_in(stack[B], stack[C]);
{
Janet a = janet_in(stack[B], stack[C]);
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_GET)
vm_commit();
stack[A] = janet_get(stack[B], stack[C]);
{
Janet a = janet_get(stack[B], stack[C]);
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_GET_INDEX)
vm_commit();
stack[A] = janet_getindex(stack[B], C);
{
Janet a = janet_getindex(stack[B], C);
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_LENGTH)
vm_commit();
stack[A] = janet_lengthv(stack[E]);
{
Janet a = janet_lengthv(stack[E]);
stack = fiber->data + fiber->frame;
stack[A] = a;
}
vm_pcnext();
VM_OP(JOP_MAKE_ARRAY) {
@@ -1412,7 +1460,7 @@ static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out, int is_
}
/* If a "task" fiber is trying to be used as a normal fiber, detect that. See bug #920.
* Fibers must be marked as root fibers manually, or by the ev scheduler. */
if (janet_vm.fiber != NULL && (fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
if (janet_vm.fiber != NULL && (fiber->gc.flags & JANET_FIBER_EV_GCFLAG_ROOT)) {
#ifdef JANET_EV
*out = janet_cstringv(is_cancel
? "cannot cancel root fiber, use ev/cancel"
@@ -1518,6 +1566,15 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
}
}
/* If this is a nested continue (root_fiber already set), root the fiber
* so it survives GC. janet_collect only marks root_fiber, so without
* this a nested fiber (e.g., from janet_pcall in a C function) would be
* invisible to GC and could be collected while actively running. */
int fiber_rooted = (janet_vm.root_fiber != NULL);
if (fiber_rooted) {
janet_gcroot(janet_wrap_fiber(fiber));
}
/* Save global state */
JanetTryState tstate;
JanetSignal sig = janet_try(&tstate);
@@ -1533,6 +1590,9 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
if (janet_vm.root_fiber == fiber) janet_vm.root_fiber = NULL;
janet_fiber_set_status(fiber, sig);
janet_restore(&tstate);
if (fiber_rooted) {
janet_gcunroot(janet_wrap_fiber(fiber));
}
fiber->last_value = tstate.payload;
*out = tstate.payload;
@@ -1554,6 +1614,8 @@ JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, Janet
if (sig != JANET_SIGNAL_OK) {
JanetFiber *child = fiber;
while (child->child) child = child->child;
/* NOTE: We are "smuggling" flags in for later use in an unusal place. This is odd but intentional and
* saves a bit of memory per fiber rather than creating a new field. There is likely a better way to do this. */
child->gc.flags &= ~JANET_FIBER_STATUS_MASK;
child->gc.flags |= sig << JANET_FIBER_STATUS_OFFSET;
child->flags |= JANET_FIBER_RESUME_SIGNAL;
src/core/wrap.c
+12 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -194,12 +194,18 @@ Janet janet_wrap_number_safe(double d) {
void *janet_nanbox_to_pointer(Janet x) {
x.i64 &= JANET_NANBOX_PAYLOADBITS;
x.u64 <<= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
return x.pointer;
}
Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) {
Janet ret;
ret.pointer = p;
/* Should be noop when pointer shift is 0 */
/*
janet_assert(!(ret.u64 & (uint64_t) ((1 << JANET_NANBOX_64_POINTER_SHIFT) - 1)), "unaligned pointer wrap");
*/
ret.u64 >>= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
ret.u64 |= tagmask;
return ret;
}
@@ -207,6 +213,11 @@ Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) {
Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
Janet ret;
ret.pointer = (void *)p;
/* Should be noop when pointer shift is 0 */
/*
janet_assert(!(ret.u64 & (uint64_t) ((1 << JANET_NANBOX_64_POINTER_SHIFT) - 1)), "unaligned pointer wrap");
*/
ret.u64 >>= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
ret.u64 |= tagmask;
return ret;
}
src/include/janet.h
+191 -30
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -67,6 +67,11 @@ extern "C" {
#define JANET_LINUX 1
#endif
/* Check for GNU Hurd */
#ifdef __gnu_hurd__
#define JANET_GNU_HURD 1
#endif
/* Check for Android */
#ifdef __ANDROID__
#define JANET_ANDROID 1
@@ -121,6 +126,7 @@ extern "C" {
|| (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|| (defined(__ppc64__) || defined(__PPC64__)) \
|| defined(PLAN9_arm64) || defined(PLAN9_amd64) \
|| defined(__aarch64__) /* ARM 64-bit */ \
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */ \
|| defined(__loongarch64) /* LoongArch64 64-bit */
@@ -147,6 +153,7 @@ extern "C" {
|| defined(__s390x__) /* S390 64-bit */ \
|| defined(__s390__) /* S390 32-bit */ \
|| defined(__ARMEB__) /* ARM big endian */ \
|| defined(__AARCH64EB__) /* ARM64 big endian */ \
|| ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \
&& defined(__BIG_ENDIAN))
#define JANET_BIG_ENDIAN 1
@@ -305,25 +312,38 @@ extern "C" {
* architectures (Nanboxing only tested on x86 and x64), comment out
* the JANET_NANBOX define.*/
#if defined(_M_ARM64) || defined(_M_ARM) || defined(__aarch64__)
#define JANET_NO_NANBOX
#endif
#ifndef JANET_NO_NANBOX
#ifdef JANET_32
#define JANET_NANBOX_32
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv)
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv) || defined(__aarch64__) || defined(_M_ARM64)
/* We will only enable nanboxing by default on 64 bit systems
* for x64 and risc-v. This is mainly because the approach is tied to the
* for x64, risc-v, and arm64. This is mainly because the approach is tied to the
* implicit 47 bit address space. Many arches allow/require this, but not all,
* and it requires cooperation from the OS. ARM should also work in many configurations. */
* and it requires cooperation from the OS. ARM should also work in many configurations by taking advantage
* of pointer alignment to allow for 48 or 49 bits of address space. */
#define JANET_NANBOX_64
/* Allow 64-bit nanboxing to assume aligned pointers to get back some extra bits for representation.
* This is needed to use nanboxing on systems with larger than 47-bit address spaces, such as many
* aarch64 systems. */
#ifndef JANET_NANBOX_64_POINTER_SHIFT
#if (defined(_M_ARM64) || defined(__aarch64__)) && !defined(JANET_APPLE)
/* All pointers, including function pointers, should be 4-byte aligned on aarch64 by default.
* The exception is aarch64 macos, as it uses the same 47-bit userland address-space as on amd64. */
#define JANET_NANBOX_64_POINTER_SHIFT 2
#endif
#endif
#endif
#endif
/* Allow for custom pointer alignment as well */
#if defined(JANET_NANBOX_64) && !defined(JANET_NANBOX_64_POINTER_SHIFT)
#define JANET_NANBOX_64_POINTER_SHIFT 0
#endif
/* Runtime config constants */
#ifdef JANET_NO_NANBOX
#define JANET_NANBOX_BIT 0
#define JANET_NANBOX_BIT 0x0
#else
#define JANET_NANBOX_BIT 0x1
#endif
@@ -334,9 +354,16 @@ extern "C" {
#define JANET_SINGLE_THREADED_BIT 0
#endif
#ifdef JANET_NANBOX_64_POINTER_SHIFT
#define JANET_NANBOX_POINTER_SHIFT_BITS (JANET_NANBOX_64_POINTER_SHIFT ? (0x4 << JANET_NANBOX_64_POINTER_SHIFT) : 0)
#else
#define JANET_NANBOX_POINTER_SHIFT_BITS 0
#endif
#define JANET_CURRENT_CONFIG_BITS \
(JANET_SINGLE_THREADED_BIT | \
JANET_NANBOX_BIT)
JANET_NANBOX_BIT | \
JANET_NANBOX_POINTER_SHIFT_BITS)
/* Represents the settings used to compile Janet, as well as the version */
typedef struct {
@@ -601,6 +628,7 @@ typedef void *JanetAbstract;
#define JANET_STREAM_UDPSERVER 0x1000
#define JANET_STREAM_NOT_CLOSEABLE 0x2000
#define JANET_STREAM_TOCLOSE 0x10000
#define JANET_STREAM_NODUPS 0x20000
typedef enum {
JANET_ASYNC_EVENT_INIT = 0,
@@ -666,6 +694,8 @@ JANET_API void janet_stream_level_triggered(JanetStream *stream);
* signals. Define them here */
#ifdef JANET_WINDOWS
typedef long JanetAtomicInt;
#elif defined(JANET_PLAN9)
typedef long JanetAtomicInt;
#else
typedef int32_t JanetAtomicInt;
#endif
@@ -915,6 +945,8 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
/* End of tagged union implementation */
#endif
JANET_API int janet_checkint8(Janet x);
JANET_API int janet_checkuint8(Janet x);
JANET_API int janet_checkint16(Janet x);
JANET_API int janet_checkuint16(Janet x);
JANET_API int janet_checkint(Janet x);
@@ -923,6 +955,8 @@ JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checkuint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkint8range(x) ((x) >= INT8_MIN && (x) <= INT8_MAX && (x) == (int8_t)(x))
#define janet_checkuint8range(x) ((x) >= 0 && (x) <= UINT8_MAX && (x) == (uint8_t)(x))
#define janet_checkint16range(x) ((x) >= INT16_MIN && (x) <= INT16_MAX && (x) == (int16_t)(x))
#define janet_checkuint16range(x) ((x) >= 0 && (x) <= UINT16_MAX && (x) == (uint16_t)(x))
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
@@ -1070,6 +1104,7 @@ struct JanetAbstractHead {
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000
#define JANET_FUNCDEF_FLAG_NAMEDARGS 0x4000000
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
/* Source mapping structure for a bytecode instruction */
@@ -1111,6 +1146,7 @@ struct JanetFuncDef {
int32_t environments_length;
int32_t defs_length;
int32_t symbolmap_length;
int32_t named_args_count;
};
/* A function environment */
@@ -1134,9 +1170,21 @@ struct JanetFunction {
JanetFuncEnv *envs[];
};
/* Use to read Janet data structures into memory from source code */
typedef struct JanetParseState JanetParseState;
typedef struct JanetParser JanetParser;
typedef int (*Consumer)(JanetParser *p, JanetParseState *state, uint8_t c);
struct JanetParseState {
int32_t counter;
int32_t argn;
int flags;
size_t line;
size_t column;
Consumer consumer;
};
enum JanetParserStatus {
JANET_PARSE_ROOT,
JANET_PARSE_ERROR,
@@ -1164,15 +1212,19 @@ struct JanetParser {
};
/* A context for marshaling and unmarshaling abstract types */
typedef struct {
struct JanetMarshalContext {
void *m_state;
void *u_state;
int flags;
const uint8_t *data;
const JanetAbstractType *at;
} JanetMarshalContext;
};
typedef struct JanetMarshalContext JanetMarshalContext;
/* Defines an abstract type */
/* Defines an abstract type. Use a const pointer to one of these structures
* when creating abstract types. The memory for this pointer should not be free
* until after janet_deinit is called. Usually, this means declaring JanetAbstractType's
* as const data at file scope, and creating instances with janet_abstract(&MyType, sizeof(MyTypeStruct)); */
struct JanetAbstractType {
const char *name;
int (*gc)(void *data, size_t len);
@@ -1260,6 +1312,7 @@ typedef struct JanetFile JanetFile;
struct JanetFile {
FILE *file;
int32_t flags;
size_t vbufsize;
};
/* For janet_try and janet_restore */
@@ -1393,7 +1446,7 @@ enum JanetOpCode {
};
/* Info about all instructions */
extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
extern const enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
/***** END SECTION OPCODES *****/
@@ -1424,6 +1477,7 @@ JANET_API void janet_loop(void);
* } else {
* janet_schedule(interrupted_fiber, janet_wrap_nil());
* }
* janet_interpreter_interrupt_handled(NULL);
* }
* }
*
@@ -1463,9 +1517,18 @@ JANET_API void janet_ev_dec_refcount(void);
JANET_API void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size);
JANET_API void *janet_abstract_end_threaded(void *x);
JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size);
/* Allow reference counting on threaded abstract types. This is useful when external code , either
* in the current OS thread or in a different OS thread, takes a pointer to this abstract type. The programmer
* should tncrement the reference count when taking the pointer, and then decrement and possibly cleanup and free
* if the reference count is 0. */
JANET_API int32_t janet_abstract_incref(void *abst);
JANET_API int32_t janet_abstract_decref(void *abst);
/* If this returns 0, *abst will be deinitialized and freed. Useful shorthand if there is no other cleanup for
* this abstract type before calling `janet_free` on it's backing memory. */
JANET_API int32_t janet_abstract_decref_maybe_free(void *abst);
/* Expose channel utilities */
JANET_API JanetChannel *janet_channel_make(uint32_t limit);
JANET_API JanetChannel *janet_channel_make_threaded(uint32_t limit);
@@ -1474,7 +1537,7 @@ JANET_API JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_
JANET_API int janet_channel_give(JanetChannel *channel, Janet x);
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
/* Expose some OS sync primitives */
/* Expose some OS sync primitives - mutexes and reader-writer locks */
JANET_API size_t janet_os_mutex_size(void);
JANET_API size_t janet_os_rwlock_size(void);
JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
@@ -1542,7 +1605,8 @@ JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGeneric
/* Callback used by janet_ev_threaded_await */
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
/* Read async from a stream */
/* Read async from a stream. These function yield to the event-loop with janet_await(), and so do not return.
* When the fiber is resumed, the fiber will simply continue to the next Janet abstract machine instruction. */
JANET_NO_RETURN JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
JANET_NO_RETURN JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
#ifdef JANET_NET
@@ -1551,7 +1615,8 @@ JANET_NO_RETURN JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuff
JANET_NO_RETURN JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
#endif
/* Write async to a stream */
/* Write async to a stream. These function yield to the event-loop with janet_await(), and so do not return.
* When the fiber is resumed, the fiber will simply continue to the next Janet abstract machine instruction. */
JANET_NO_RETURN JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
JANET_NO_RETURN JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
#ifdef JANET_NET
@@ -1563,17 +1628,63 @@ JANET_NO_RETURN JANET_API void janet_ev_sendto_string(JanetStream *stream, Janet
#endif
/* Parsing */
/* Parsing.
*
* E.g.
*
* JanetParser parser;
* janet_parser_init(&parser);
* for (int i = 0; i < source_code_length + 1; i++) {
* if (i >= source_code_length) {
* janet_parser_eof(&parser);
* } else {
* janet_parser_consume(&parser, source_code[i]);
* }
* while (janet_parser_has_more(&parser)) {
* Janet x = janet_parser_produce(&parser);
* janet_printf("got value: %v\n", x);
* }
* switch (janet_parser_status(&parser)) {
* case JANET_PARSE_PENDING: break;
* case JANET_PARSE_ERROR: janet_eprintf("error: %s\n", janet_parser_error(&parser)); break;
* case JANET_PARSE_ROOT: break;
* case JANET_PARSE_DEAD: break;
* }
* }
* janet_parser_deinit(&parser);
*
* */
extern JANET_API const JanetAbstractType janet_parser_type;
/* Construct/destruct a parser. Parsers can be allocated on the stack or the heap. */
JANET_API void janet_parser_init(JanetParser *parser);
JANET_API void janet_parser_deinit(JanetParser *parser);
/* Feed bytes into the parser. Check the parser state after every byte to handle errors. */
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
/* Check the current status of the parser */
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
/* Produce a value from the parser. Call this when janet_parser_has_more(&parser) is non-zero. */
JANET_API Janet janet_parser_produce(JanetParser *parser);
/* Produce a value from the parser, wrapped in a tuple. The tuple is used to carry the source mapping information of the
* top level form, such as a line number or symbol. */
JANET_API Janet janet_parser_produce_wrapped(JanetParser *parser);
/* When there is an error while parsing (janet_parser_status(&parser) == JANET_PARSE_ERROR), get a nice error string.
* Calling this will also flush the parser. */
JANET_API const char *janet_parser_error(JanetParser *parser);
/* If there is a parsing error, flush the parser to set the state back to empty.
* This allows for better error recover and less confusing error messages on bad syntax deep inside nested data structures. */
JANET_API void janet_parser_flush(JanetParser *parser);
/* Indicate that there is no more source code */
JANET_API void janet_parser_eof(JanetParser *parser);
/* If non-zero, the parser has values ready to be produced. */
JANET_API int janet_parser_has_more(JanetParser *parser);
/* Assembly */
@@ -1617,7 +1728,10 @@ JANET_API JanetCompileResult janet_compile_lint(
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
/* Execute strings */
/* Execute strings.
*
* These functions wrap parsing, compilation, and evalutation into convenient functions.
* */
#define JANET_DO_ERROR_RUNTIME 0x01
#define JANET_DO_ERROR_COMPILE 0x02
#define JANET_DO_ERROR_PARSE 0x04
@@ -1811,21 +1925,41 @@ JANET_API JanetTable *janet_env_lookup(JanetTable *env);
JANET_API void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse);
/* GC */
JANET_API void janet_mark(Janet x);
JANET_API void janet_sweep(void);
/* The main interface to garbage collection. Call this to do a full mark and sweep cleanup. */
JANET_API void janet_collect(void);
JANET_API void janet_clear_memory(void);
/* Add "roots" to the garbage collector to prevent the runtime from freeing objects.
* This is only needed if code outside of Janet keeps references to Janet values */
JANET_API void janet_gcroot(Janet root);
JANET_API int janet_gcunroot(Janet root);
JANET_API int janet_gcunrootall(Janet root);
/* Allow disabling garbage collection temporarily or for certain sections of code.
* this is a very cheap operation. */
JANET_API int janet_gclock(void);
JANET_API void janet_gcunlock(int handle);
/* The mark and sweep components of the mark and sweep collector. Prefer using janet_collect directly. */
JANET_API void janet_mark(Janet x);
JANET_API void janet_sweep(void);
/* Clear all gced memory and call all destructors. Used as part of the standard cleanup routune, most programmers will not need this. */
JANET_API void janet_clear_memory(void);
/* Remove all GC roots. Used as part of the standard cleanup routine, most programmers will not need this. */
JANET_API int janet_gcunrootall(Janet root);
/* Hint to the collector that memory of size s was just allocated to help it better understand when to free memory. */
JANET_API void janet_gcpressure(size_t s);
/* Functions */
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
/* Get a function that when called with no args, will return x. */
JANET_API JanetFunction *janet_thunk_delay(Janet x);
/* Do some simple verfification on constructed bytecode to disallow any trivial incorrect bytecode. */
JANET_API int janet_verify(JanetFuncDef *def);
/* Pretty printing */
@@ -1874,7 +2008,7 @@ JANET_API void janet_vm_free(JanetVM *vm);
JANET_API void janet_vm_save(JanetVM *into);
JANET_API void janet_vm_load(JanetVM *from);
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm); /* Call this after running interrupt handler */
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
@@ -1903,6 +2037,11 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
#define JANET_SANDBOX_COMPILE 32768
#define JANET_SANDBOX_ASM 65536
#define JANET_SANDBOX_THREADS 131072
#define JANET_SANDBOX_UNMARSHAL 262144
#define JANET_SANDBOX_EXIT 524288
#define JANET_SANDBOX_ALL (UINT32_MAX)
JANET_API void janet_sandbox(uint32_t flags);
JANET_API void janet_sandbox_assert(uint32_t forbidden_flags);
@@ -1947,10 +2086,23 @@ JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym);
/* Get values from the core environment. */
JANET_API Janet janet_resolve_core(const char *name);
/* New C API */
/* New C API
*
* The "New" C API is intended to make constructing good documentation and source maps
* much more straightforward. This not only ensures doc strings for functions in native
* modules, it also add source code mapping for C functions so that programmers can see which
* file and line a native function that calls janet_panic came from.
*
* */
#if defined(JANET_NANBOX_64) && (JANET_NANBOX_64_POINTER_SHIFT != 0) && !defined(JANET_MSVC)
#define JANET_CFUNCTION_ALIGN __attribute__((aligned(1 << JANET_NANBOX_64_POINTER_SHIFT)))
#else
#define JANET_CFUNCTION_ALIGN
#endif
/* Shorthand for janet C function declarations */
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
#define JANET_CFUN(name) JANET_CFUNCTION_ALIGN Janet name (int32_t argc, Janet *argv)
/* Declare a C function with documentation and source mapping */
#define JANET_REG_END {NULL, NULL, NULL, NULL, 0}
@@ -1966,7 +2118,7 @@ JANET_API Janet janet_resolve_core(const char *name);
#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_}
#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \
static const int32_t CNAME##_sourceline_ = __LINE__; \
Janet CNAME (int32_t argc, Janet *argv)
Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
@@ -1974,7 +2126,7 @@ JANET_API Janet janet_resolve_core(const char *name);
#define JANET_REG_D(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, NULL, 0}
#define JANET_FN_D(CNAME, USAGE, DOCSTRING) \
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
Janet CNAME (int32_t argc, Janet *argv)
Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_D(ENV, JNAME, VAL, DOC) \
janet_def(ENV, JNAME, VAL, DOC)
@@ -1983,7 +2135,7 @@ JANET_API Janet janet_resolve_core(const char *name);
#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \
static const int32_t CNAME##_sourceline_ = __LINE__; \
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
Janet CNAME (int32_t argc, Janet *argv)
Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)
@@ -2066,9 +2218,12 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
JANET_API float janet_getfloat(const Janet *argv, int32_t n);
JANET_API int8_t janet_getinteger8(const Janet *argv, int32_t n);
JANET_API int16_t janet_getinteger16(const Janet *argv, int32_t n);
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
JANET_API uint32_t janet_getuinteger(const Janet *argv, int32_t n);
JANET_API uint8_t janet_getuinteger8(const Janet *argv, int32_t n);
JANET_API uint16_t janet_getuinteger16(const Janet *argv, int32_t n);
JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
@@ -2102,6 +2257,8 @@ JANET_API int32_t janet_optinteger(const Janet *argv, int32_t argc, int32_t n, i
JANET_API int64_t janet_optinteger64(const Janet *argv, int32_t argc, int32_t n, int64_t dflt);
JANET_API size_t janet_optsize(const Janet *argv, int32_t argc, int32_t n, size_t dflt);
JANET_API JanetAbstract janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, JanetAbstract dflt);
JANET_API uint32_t janet_optuinteger(const Janet *argv, int32_t argc, int32_t n, uint32_t dflt);
JANET_API uint64_t janet_optuinteger64(const Janet *argv, int32_t argc, int32_t n, uint64_t dflt);
/* Mutable optional types specify a size default, and construct a new value if none is provided */
JANET_API JanetBuffer *janet_optbuffer(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len);
@@ -2143,6 +2300,7 @@ JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
JANET_API void janet_marshal_abstract(JanetMarshalContext *ctx, JanetAbstract abstract);
JANET_API int janet_marshal_flags(JanetMarshalContext *ctx);
JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size);
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
@@ -2155,6 +2313,7 @@ JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
JANET_API JanetAbstract janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size);
JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
JANET_API int janet_unmarshal_flags(JanetMarshalContext *ctx);
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
@@ -2202,7 +2361,9 @@ typedef enum {
RULE_SPLIT, /* [rule, rule] */
RULE_NTH, /* [nth, rule, tag] */
RULE_ONLY_TAGS, /* [rule] */
} JanetPegOpcod;
RULE_MATCHSPLICE, /* [rule, constant, tag] */
RULE_DEBUG, /* [] */
} JanetPegOpcode;
typedef struct {
uint32_t *bytecode;
src/mainclient/shell.c
+118 -14
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -26,6 +26,7 @@
#include <janet.h>
#include <errno.h>
#include <assert.h>
#ifdef _WIN32
#include <windows.h>
@@ -79,9 +80,11 @@ static void simpleline(JanetBuffer *buffer) {
int c;
for (;;) {
c = fgetc(in);
#ifndef JANET_PLAN9
if (c < 0 && !feof(in) && errno == EINTR) {
continue;
}
#endif
if (feof(in) || c < 0) {
break;
}
@@ -110,6 +113,8 @@ static JANET_THREAD_LOCAL int gbl_historyi = 0;
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
static JANET_THREAD_LOCAL int gbl_match_count = 0;
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
static JANET_THREAD_LOCAL int gbl_history_loaded = 0;
static JANET_THREAD_LOCAL char *gbl_history_file = NULL;
#endif
/* Fallback */
@@ -307,7 +312,9 @@ static int curpos(void) {
char buf[32];
int cols, rows;
unsigned int i = 0;
#ifndef JANET_PLAN9
if (write_console("\x1b[6n", 4) != 4) return -1;
#endif
while (i < sizeof(buf) - 1) {
if (read_console(buf + i, 1) != 1) break;
if (buf[i] == 'R') break;
@@ -356,33 +363,52 @@ static void clear(void) {
}
}
static int getplen(void) {
int _plen = gbl_plen;
/* Ensure at least 16 characters of data entry; */
while (_plen && (_plen + 16 > gbl_cols)) {
_plen--;
}
return _plen;
}
static void refresh(void) {
char seq[64];
JanetBuffer b;
/* If prompt is too long, truncate */
int _plen = getplen();
/* Keep cursor position on screen */
char *_buf = gbl_buf;
int _len = gbl_len;
int _pos = gbl_pos;
while ((gbl_plen + _pos) >= gbl_cols) {
while ((_plen + _pos) >= gbl_cols) {
_buf++;
_len--;
_pos--;
}
while ((gbl_plen + _len) > gbl_cols) {
while ((_plen + _len) > gbl_cols) {
_len--;
}
janet_buffer_init(&b, 0);
/* Cursor to left edge, gbl_prompt and buffer */
janet_buffer_push_u8(&b, '\r');
janet_buffer_push_cstring(&b, gbl_prompt);
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
janet_buffer_push_bytes(&b, (const uint8_t *) gbl_prompt, _plen);
if (_len > 0) {
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
}
/* Erase to right */
janet_buffer_push_cstring(&b, "\x1b[0K");
janet_buffer_push_cstring(&b, "\x1b[0K\r");
/* Move cursor to original position. */
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
janet_buffer_push_cstring(&b, seq);
if (_pos + _plen) {
snprintf(seq, 64, "\x1b[%dC", (int)(_pos + _plen));
janet_buffer_push_cstring(&b, seq);
}
if (write_console((char *) b.data, b.count) == -1) {
exit(1);
}
@@ -406,7 +432,8 @@ static int insert(char c, int draw) {
gbl_buf[gbl_pos++] = c;
gbl_buf[++gbl_len] = '\0';
if (draw) {
if (gbl_plen + gbl_len < gbl_cols) {
int _plen = getplen();
if (_plen + gbl_len < gbl_cols) {
/* Avoid a full update of the line in the
* trivial case. */
if (write_console(&c, 1) == -1) return -1;
@@ -424,6 +451,63 @@ static int insert(char c, int draw) {
return 0;
}
static void calc_history_file(void) {
char *hist = getenv("JANET_HISTFILE");
if (hist != NULL) {
gbl_history_file = sdup(hist);
} else {
gbl_history_file = NULL;
}
}
static void loadhistory(void) {
if (gbl_history_loaded) return;
calc_history_file();
gbl_history_loaded = 1;
if (NULL == gbl_history_file) return;
FILE *history_file = fopen(gbl_history_file, "rb");
if (NULL == history_file) return;
JanetParser p;
janet_parser_init(&p);
int c = 0;
while ((c = fgetc(history_file))) {
if (c == EOF) {
janet_parser_eof(&p);
} else {
janet_parser_consume(&p, c);
}
while (janet_parser_has_more(&p) && gbl_history_count < JANET_HISTORY_MAX) {
if (janet_parser_status(&p) == JANET_PARSE_ERROR) {
janet_eprintf("bad history file: %s\n", janet_parser_error(&p));
goto parsing_done;
}
Janet x = janet_parser_produce(&p);
const char *cstr = (const char *) janet_to_string(x);
if (cstr[0]) { /* Drop empty strings */
gbl_history[gbl_history_count++] = sdup(cstr);
}
}
if (c == EOF) break;
}
parsing_done:
janet_parser_deinit(&p);
gbl_historyi = 0;
fclose(history_file);
}
static void savehistory(void) {
if (gbl_history_count < 1 || (gbl_history_file == NULL)) return;
FILE *history_file = fopen(gbl_history_file, "wb");
for (int i = 0; i < gbl_history_count; i++) {
if (gbl_history[i][0]) { /* Drop empty strings */
janet_dynprintf(NULL, history_file, "%j\n", janet_cstringv(gbl_history[i]));
}
}
fclose(history_file);
}
static void historymove(int delta) {
if (gbl_history_count > 1) {
janet_free(gbl_history[gbl_historyi]);
@@ -435,8 +519,13 @@ static void historymove(int delta) {
} else if (gbl_historyi >= gbl_history_count) {
gbl_historyi = gbl_history_count - 1;
}
gbl_len = (int) strlen(gbl_history[gbl_historyi]);
/* If history element is longer the JANET_LINE_MAX - 1, truncate */
if (gbl_len > JANET_LINE_MAX - 1) {
gbl_len = JANET_LINE_MAX - 1;
}
gbl_pos = gbl_len;
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
gbl_pos = gbl_len = (int) strlen(gbl_buf);
gbl_buf[gbl_len] = '\0';
refresh();
@@ -860,11 +949,12 @@ static int line() {
gbl_len = 0;
gbl_pos = 0;
while (gbl_prompt[gbl_plen]) gbl_plen++;
int _plen = getplen();
gbl_buf[0] = '\0';
addhistory();
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
if (write_console((char *) gbl_prompt, _plen) == -1) return -1;
for (;;) {
char c;
char seq[5];
@@ -890,6 +980,7 @@ static int line() {
case 3: /* ctrl-c */
clearlines();
norawmode();
savehistory();
#ifdef _WIN32
ExitProcess(1);
#else
@@ -1083,17 +1174,21 @@ void janet_line_init() {
}
void janet_line_deinit() {
int i;
norawmode();
for (i = 0; i < gbl_history_count; i++)
for (int i = 0; i < gbl_history_count; i++)
janet_free(gbl_history[i]);
gbl_historyi = 0;
if (gbl_history_file) {
janet_free(gbl_history_file);
gbl_history_file = NULL;
}
}
void janet_line_get(const char *p, JanetBuffer *buffer) {
gbl_prompt = p;
buffer->count = 0;
gbl_historyi = 0;
loadhistory();
if (check_simpleline(buffer)) return;
FILE *out = janet_dynfile("err", stderr);
if (line()) {
@@ -1129,6 +1224,10 @@ int main(int argc, char **argv) {
JanetArray *args;
JanetTable *env;
#ifdef JANET_PLAN9
setfcr(0);
#endif
#ifdef _WIN32
setup_console_output();
#endif
@@ -1138,7 +1237,7 @@ int main(int argc, char **argv) {
#endif
#if defined(JANET_PRF)
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1] = {0};
#ifdef JANET_REDUCED_OS
char *envvar = NULL;
#else
@@ -1146,6 +1245,7 @@ int main(int argc, char **argv) {
#endif
if (NULL != envvar) {
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
hash_key[JANET_HASH_KEY_SIZE] = '\0'; /* in case copy didn't get null byte */
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
fputs("unable to initialize janet PRF hash function.\n", stderr);
return 1;
@@ -1184,6 +1284,10 @@ int main(int argc, char **argv) {
status = janet_loop_fiber(fiber);
/* Deinitialize vm */
#if !defined(JANET_SIMPLE_GETLINE)
savehistory();
#endif
janet_deinit();
janet_line_deinit();
test/amalg/main.c
+1 -1
View File
@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2026 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
test/c/test-gc-pcall.c
+143
View File
@@ -0,0 +1,143 @@
/*
* Test that GC does not collect fibers during janet_pcall.
*
* Bug: janet_collect() marks janet_vm.root_fiber but not janet_vm.fiber.
* When janet_pcall is called from a C function, the inner fiber becomes
* janet_vm.fiber while root_fiber still points to the outer fiber. If GC
* triggers inside the inner fiber's execution, the inner fiber is not in
* any GC root set and can be collected — including its stack memory —
* while it is actively running.
*
* Two tests:
* 1. Single nesting: F1 -> C func -> janet_pcall -> F2
* F2 is not marked (it's janet_vm.fiber but not root_fiber)
* 2. Deep nesting: F1 -> C func -> janet_pcall -> F2 -> C func -> janet_pcall -> F3
* F2 is not marked (saved only in a C stack local tstate.vm_fiber)
*
* Build (after building janet):
* cc -o build/test-gc-pcall test/test-gc-pcall.c \
* -Isrc/include -Isrc/conf build/libjanet.a -lm -lpthread -ldl
*
* Run:
* ./build/test-gc-pcall
*/
#include "janet.h"
#include <stdio.h>
/* C function that calls a Janet callback via janet_pcall. */
static Janet cfun_call_via_pcall(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetFunction *fn = janet_getfunction(argv, 0);
Janet result;
JanetFiber *fiber = NULL;
JanetSignal sig = janet_pcall(fn, 0, NULL, &result, &fiber);
if (sig != JANET_SIGNAL_OK) {
janet_panicv(result);
}
return result;
}
static int run_test(JanetTable *env, const char *name, const char *source) {
printf(" %s... ", name);
fflush(stdout);
Janet result;
int status = janet_dostring(env, source, name, &result);
if (status != 0) {
printf("FAIL (crashed or errored)\n");
return 1;
}
printf("PASS\n");
return 0;
}
/* Test 1: Single nesting.
* F1 -> cfun_call_via_pcall -> janet_pcall -> F2
* F2 is janet_vm.fiber but not root_fiber, so GC can collect it.
*
* All allocations are done in Janet code so GC checks trigger in the
* VM loop (janet_gcalloc does NOT call janet_collect — only the VM's
* vm_checkgc_next does). */
static const char test_single[] =
"(gcsetinterval 1024)\n"
"(def cb\n"
" (do\n"
" (def captured @{:key \"value\" :nested @[1 2 3 4 5]})\n"
" (fn []\n"
" (var result nil)\n"
" (for i 0 500\n"
" (def t @{:i i :s (string \"iter-\" i) :arr @[i (+ i 1) (+ i 2)]})\n"
" (set result (get captured :key)))\n"
" result)))\n"
"(for round 0 200\n"
" (def result (call-via-pcall cb))\n"
" (assert (= result \"value\")\n"
" (string \"round \" round \": expected 'value', got \" (describe result))))\n";
/* Test 2: Deep nesting.
* F1 -> cfun_call_via_pcall -> janet_pcall -> F2 -> cfun_call_via_pcall -> janet_pcall -> F3
* F2 is saved only in C stack local tstate.vm_fiber, invisible to GC.
* F2's stack data can be freed if F2 is collected during F3's execution.
*
* The inner callback allocates in Janet code (not C) to ensure the
* VM loop triggers GC checks during F3's execution. */
static const char test_deep[] =
"(gcsetinterval 1024)\n"
"(def inner-cb\n"
" (do\n"
" (def captured @{:key \"deep\" :nested @[10 20 30]})\n"
" (fn []\n"
" (var result nil)\n"
" (for i 0 500\n"
" (def t @{:i i :s (string \"iter-\" i) :arr @[i (+ i 1) (+ i 2)]})\n"
" (set result (get captured :key)))\n"
" result)))\n"
"\n"
"(def outer-cb\n"
" (do\n"
" (def state @{:count 0 :data @[\"a\" \"b\" \"c\" \"d\" \"e\"]})\n"
" (fn []\n"
" # This runs on F2. Calling call-via-pcall here creates F3.\n"
" # F2 becomes unreachable: it's not root_fiber (that's F1)\n"
" # and it's no longer janet_vm.fiber (that's now F3).\n"
" (def inner-result (call-via-pcall inner-cb))\n"
" # If F2 was collected during F3's execution, accessing\n"
" # state here reads freed memory.\n"
" (put state :count (+ (state :count) 1))\n"
" (string inner-result \"-\" (state :count)))))\n"
"\n"
"(for round 0 200\n"
" (def result (call-via-pcall outer-cb))\n"
" (def expected (string \"deep-\" (+ round 1)))\n"
" (assert (= result expected)\n"
" (string \"round \" round \": expected '\" expected \"', got '\" (describe result) \"'\")))\n";
int main(int argc, char **argv) {
(void)argc;
(void)argv;
int failures = 0;
janet_init();
JanetTable *env = janet_core_env(NULL);
janet_def(env, "call-via-pcall",
janet_wrap_cfunction(cfun_call_via_pcall),
"Call a function via janet_pcall from C.");
printf("Testing janet_pcall GC safety:\n");
failures += run_test(env, "single-nesting", test_single);
failures += run_test(env, "deep-nesting", test_deep);
janet_deinit();
if (failures > 0) {
printf("\n%d test(s) FAILED\n", failures);
return 1;
}
printf("\nAll tests passed.\n");
return 0;
}
test/fuzzers/fuzz_compile.c
+41
View File
@@ -0,0 +1,41 @@
#include <stdint.h>
#include <janet.h>
/* Disable leak sanitizer */
int __lsan_is_turned_off(void) {
return 1;
}
int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size) {
/* init Janet */
janet_init();
/* fuzz the compiler in src/core/compile.c: parse the untrusted source and
compile each produced form to bytecode */
JanetTable *env = janet_core_env(NULL);
JanetParser parser;
janet_parser_init(&parser);
JanetTryState tstate;
if (janet_try(&tstate) == JANET_SIGNAL_OK) {
for (size_t i = 0; i < size; i++) {
if (janet_parser_status(&parser) == JANET_PARSE_ERROR)
break;
janet_parser_consume(&parser, data[i]);
while (janet_parser_has_more(&parser)) {
Janet form = janet_parser_produce(&parser);
JanetCompileResult res = janet_compile(form, env, janet_cstring("fuzz"));
(void) res;
}
}
}
janet_restore(&tstate);
janet_parser_deinit(&parser);
/* cleanup Janet */
janet_deinit();
return 0;
}
test/fuzzers/fuzz_dobytes.c
+27
View File
@@ -0,0 +1,27 @@
#include <stdint.h>
#include <janet.h>
/* Disable leak sanitizer */
int __lsan_is_turned_off(void) {
return 1;
}
int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size) {
/* init Janet */
janet_init();
/* fuzz the compile + bytecode VM path (parse, compile, run) in src/core/compile.c and src/core/vm.c */
JanetTable *env = janet_core_env(NULL);
JanetTryState tstate;
if (janet_try(&tstate) == JANET_SIGNAL_OK) {
Janet out;
janet_dobytes(env, data, (int32_t) size, "<fuzz>", &out);
}
janet_restore(&tstate);
/* cleanup Janet */
janet_deinit();
return 0;
}
test/fuzzers/fuzz_unmarshal.c
+27
View File
@@ -0,0 +1,27 @@
#include <stdint.h>
#include <janet.h>
/* Disable leak sanitizer */
int __lsan_is_turned_off(void) {
return 1;
}
int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size) {
/* init Janet */
janet_init();
/* fuzz the binary unmarshal (deserialization) path in src/core/marsh.c */
JanetTable *reg = janet_env_lookup(janet_core_env(NULL));
JanetTryState tstate;
if (janet_try(&tstate) == JANET_SIGNAL_OK) {
const uint8_t *next = NULL;
janet_unmarshal(data, size, 0, reg, &next);
}
janet_restore(&tstate);
/* cleanup Janet */
janet_deinit();
return 0;
}
test/helper.janet
+17 -8
View File
@@ -1,5 +1,8 @@
# Helper code for running tests
# Turn on strict linting by default in test suite.
(put root-env *lint-warn* :strict)
(var num-tests-passed 0)
(var num-tests-run 0)
(var suite-name 0)
@@ -7,7 +10,7 @@
(var skip-count 0)
(var skip-n 0)
(def is-verbose (os/getenv "VERBOSE"))
(var is-verbose (os/getenv "VERBOSE"))
(defn- assert-no-tail
"Override's the default assert with some nice error handling."
@@ -19,15 +22,16 @@
(break x))
(default e "assert error")
(when x (++ num-tests-passed))
(def str (string e))
(def stack (debug/stack (fiber/current)))
(def frame (last stack))
(def line-info (string/format "%s:%d"
(frame :source) (frame :source-line)))
(if x
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
(when is-verbose
(eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x)
(eflush) (flush))
(do
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (string e) x) (eflush)))
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush) (flush)))
x)
(defn skip-asserts
@@ -36,7 +40,7 @@
(+= skip-n n)
nil)
(defmacro assert
(defmacro assert :shadow
[x &opt e]
(def xx (gensym))
(default e (string/format "%j" x))
@@ -48,7 +52,12 @@
(defmacro assert-error
[msg & forms]
(def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
~(as-macro ,assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defmacro assert-error-value
[msg errval & forms]
(def e (gensym))
~(as-macro ,assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
(defn check-compile-error
[form]
@@ -60,8 +69,8 @@
(def e (gensym))
(def f (gensym))
(if is-verbose
~(try (do ,;forms (,assert true ,msg)) ([,e ,f] (,assert false ,msg) (,debug/stacktrace ,f ,e "\e[31m✘\e[0m ")))
~(try (do ,;forms (,assert true ,msg)) ([_] (,assert false ,msg)))))
~(try (do ,;forms (as-macro ,assert true ,msg)) ([,e ,f] (as-macro ,assert false ,msg) (,debug/stacktrace ,f ,e "\e[31m✘\e[0m ")))
~(try (do ,;forms (as-macro ,assert true ,msg)) ([_] (as-macro ,assert false ,msg)))))
(defn start-suite [&opt x]
(default x (dyn :current-file))
test/suite-array.janet
+9 -4
View File
@@ -1,4 +1,4 @@
# Copyright (c) 2025 Calvin Rose
# Copyright (c) 2026 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -70,9 +70,9 @@
(assert (= (array/pop @[]) nil) "array/pop empty")
# Code coverage
(def a @[1])
(array/pop a)
(array/trim a)
(def a1 @[1])
(array/pop a1)
(array/trim a1)
(array/ensure @[1 1] 6 2)
# array/join
@@ -86,5 +86,10 @@
(assert-error "array/join error 4" (array/join @[] "abc123"))
(assert-error "array/join error 5" (array/join @[] "abc123"))
# Regression 1714
(repeat 10
(assert (deep= (put @[] 100 10) (put (seq [_ :range [0 101]] nil) 100 10)) "regression 1714")
(assert (deep= (put @[] 200 10) (put (seq [_ :range [0 201]] nil) 200 10)) "regression 1714"))
(end-suite)
Loaded 100 of 136 files, more files were not shown because too many files have changed in this diff. Show more