1
0
mirror of https://github.com/janet-lang/janet synced 2026-04-02 21:11:27 +00:00

Compare commits

..

100 Commits

Author SHA1 Message Date
Calvin Rose
ead0ed5d41 Merge branch 'master' into compile-opt 2025-09-21 20:02:31 -05:00
Calvin Rose
42bc504188 Merge branch 'master' into compile-opt 2025-06-21 16:49:24 -05:00
Calvin Rose
c3317905a1 Move sysir C lowering to separate file 2025-05-07 07:25:05 -05:00
Calvin Rose
0066a5a304 Start removing NASM dependence.
Start setting up a test suite for sysir and work towards emitting jitted
x86 machine code.
2025-05-04 20:20:11 -05:00
Calvin Rose
3dd6e744de More work on e_mov - work on loading immediates. 2025-04-15 20:40:05 -05:00
Calvin Rose
862b4e9688 Add sysir test suite stub 2025-04-13 07:47:52 -05:00
Calvin Rose
c9305a0a42 Format. 2025-04-11 22:44:36 -05:00
Calvin Rose
3cbdf26aa2 Merge branch 'master' into compile-opt 2025-04-11 22:44:28 -05:00
Calvin Rose
11e6a5a315 More work on compile-opt. 2025-03-31 21:48:46 -05:00
Calvin Rose
871f8ebf4e More work on moving to machine code emission. 2025-03-30 13:38:33 -05:00
Calvin Rose
c677c72a73 Add tool that lets us more easily compare compilation paths.
Compare:
IR -> C -> x64
vs.
IR -> x64
2025-03-29 20:37:51 -05:00
Calvin Rose
af73e214b2 Begin work on emitting machine code directly.
Far from done, we are currently splicing raw bytes in NASM output.
2025-03-29 16:52:11 -05:00
Calvin Rose
a6e0a8228c Merge branch 'master' into compile-opt 2025-03-28 16:24:27 -05:00
Calvin Rose
9a1cd6fdd9 Add janet_sysir_scalarize
Makes it easier to add simpler backends without needing to completely
handle vectorization.
2025-02-24 19:12:17 -06:00
Calvin Rose
768c9b23e1 Update drawing 2. 2025-02-19 08:21:20 -06:00
Calvin Rose
059253fdee Merge branch 'master' into compile-opt 2025-02-17 18:08:17 -06:00
Calvin Rose
4396f01297 More work on drawing example and frontend changes. 2024-12-01 08:43:54 -06:00
Calvin Rose
046d299d77 More work on x86 backend. 2024-11-26 11:18:46 -06:00
Calvin Rose
9fa9286fca Add more drawing examples. 2024-11-25 09:42:00 -06:00
Calvin Rose
c13ef02ea2 Add drawing2.janet so we can keep the working drawing example. 2024-11-25 08:51:40 -06:00
Calvin Rose
52cedbc4b4 More work on drawing example. 2024-11-25 07:33:31 -06:00
Calvin Rose
d345e551f1 Correct pointer arith type checking. 2024-11-24 20:06:16 -06:00
Calvin Rose
0fb1773c19 Merge branch 'master' into compile-opt 2024-11-24 19:15:47 -06:00
Calvin Rose
a6ea38a23b More working on pointer arithmetic. 2024-11-24 18:44:26 -06:00
Calvin Rose
bc79489068 Begin working on drawing example. 2024-11-24 15:53:20 -06:00
Calvin Rose
b096babcbf Merge branch 'master' into compile-opt 2024-11-23 10:29:14 -06:00
Calvin Rose
bed80bf1d3 Merge branch 'master' into compile-opt 2024-10-12 07:58:43 -05:00
Calvin Rose
80ed6538d0 Add constant checking in sysir middle end. 2024-10-05 12:05:04 -05:00
Calvin Rose
6577a18cef Better printing for complex constants.
Also added stub for checking if constants are valid in IR, but it is
not currently used.
2024-09-30 08:14:01 -05:00
Calvin Rose
731592a80e Merge branch 'master' into compile-opt 2024-09-29 17:27:49 -05:00
Calvin Rose
ea332ff81e More work on making the temporary frontend a little nicer.
We need to create abstractions around more of the backend
to properly test and experiment with things, even if the frontend
is not final.
2024-09-29 15:55:10 -05:00
Calvin Rose
f36d544deb MSVC and strange errors. 2024-09-29 12:30:51 -05:00
Calvin Rose
e96dd512f3 Work on some local type inference.
Right to left type inference in expressions for binary operators.
2024-09-29 11:37:04 -05:00
Calvin Rose
a588f1f242 More small tweaks to compile-opt. 2024-09-29 07:13:27 -05:00
Calvin Rose
ae15eadfaf Merge branch 'master' into compile-opt 2024-09-28 16:00:30 -05:00
Calvin Rose
3618b72f4d Merge branch 'master' into compile-opt 2024-09-08 12:28:51 -05:00
Calvin Rose
3510e235ee More work on compile-opt 2024-06-21 17:16:56 -05:00
Calvin Rose
b6fb7ae69c x64 allow dynamically switching between windows and sysv target. 2024-06-17 23:02:05 -05:00
Calvin Rose
e5765b26d4 Working examples on windows.
Add some support for windows x64 ABI.
2024-06-17 07:07:20 -07:00
Calvin Rose
cdb3baaca3 Work on windows. 2024-06-16 13:37:25 -07:00
Calvin Rose
c413bc2b4e Don't assign variables positions on the stack that clobber import info.
(return address, previous basepoint, etc.)
2024-06-16 10:06:22 -05:00
Calvin Rose
dfdf734fc7 Merge branch 'master' into compile-opt 2024-06-16 09:31:11 -05:00
Calvin Rose
314e684097 More work on x64 backend. 2024-06-14 16:57:32 -05:00
Calvin Rose
232a8faa35 More work compile-opt. 2024-06-13 07:27:48 -05:00
Calvin Rose
c31d8b52ff Add typed constants and lots more. 2024-06-12 13:57:33 -05:00
Calvin Rose
f0395763b7 More work on x86 target.
Also remove all (limited) type inference from the sysir. Type
inference is better done in frontend, limited inference in backend
just covers compilers issues.

Simple hello world with nasm working.
2024-06-10 20:16:04 -05:00
Calvin Rose
5b3c5a5969 Lots of work on calling conventions and x86 backend.
We need the ability to represent multiple calling conventions in IR.
All backends need to support a :default CC, but can also support more
for interop with system libraries, code from other compilers, syscalls, etc.

Also allow void returns.
2024-06-10 08:47:27 -05:00
Calvin Rose
af10c1d4b5 More work on x64 backend, especially branching.
Needs changes to IR to allow encoding immediates in all
instructions where possible. This makes the IR denser, means
we don't need `constant` and `callk`, and allows certain optimizations
like comparing to zero, using `inc` and `dec`, etc which are
specializations of more general instructions with constants.
2024-06-08 13:20:34 -05:00
Calvin Rose
3995fa86e2 More work on function calls. 2024-06-07 20:20:16 -05:00
Calvin Rose
9d7a279999 Merge branch 'master' into compile-opt 2024-06-07 19:28:17 -05:00
Calvin Rose
3e273ce03a More work on sysir. 2024-06-07 10:09:53 -05:00
Calvin Rose
25b7c74089 More work on register allocation and spilling.
Setup frontend.janet to show the basics of what is going on. Currently
emitting "fake" instructions just to hash out the idea.

One apparent issue is how we handle register spilling during variable
argument IR instructions (function calls). Arguments should come
_before_ the function call not after.
2024-06-05 17:50:11 -05:00
Calvin Rose
9e47cd94bd Delete extra code. 2024-06-04 21:10:35 -05:00
Calvin Rose
7ea118f248 Begin work on simple x64 backend.
Introduce register allocation, spilling, etc. First implementation
will likely emit textual assembly and use a very bad register allocation
algorithm.
2024-06-03 08:35:08 -05:00
Calvin Rose
480c5b5e9d Change how labels are recorded.
Disallow jumping to arbitrary instructions - instead, only allow jumps
to label ids. This will make various transformations and validations
easier since adding or remove instructions does not break jumps.
2024-06-02 09:43:33 -05:00
Calvin Rose
8a394f2506 Merge branch 'master' into compile-opt 2024-06-01 13:03:36 -05:00
Calvin Rose
2c208f5d01 Merge branch 'master' into compile-opt 2024-05-15 07:49:46 -05:00
Calvin Rose
08e6051af8 More work on sysir compiler - basic function calls (without prototypes). 2024-05-15 07:24:15 -05:00
Calvin Rose
19212e6f5c Remove net.c changes. 2024-05-12 18:09:22 -05:00
Calvin Rose
8875adf69e Merge branch 'master' into compile-opt 2024-05-12 16:22:06 -05:00
Calvin Rose
745567a2e0 More work on frontend. 2024-05-09 22:22:38 -05:00
Calvin Rose
ef2dfcd7c3 More work on a proof of concept frontend.
Basic frontend being prototyped in examples/sysir/frontend.janet. Still
a lot of work needs to be done here, and some of this code will
eventually move to C most likely, but this is a good way to better
exercise our backend.

Type inference - at the very least _forward_ inference, is the most
needed change here. While one could do this in the compiler
frontend, doing so in sysir/asm is not so much of an issue. "Inference"
here means inserting "bind" instructions when there is only a single
type that will work correctly.
2024-05-05 14:45:00 -05:00
Calvin Rose
f582fe1f69 Update compiler opt 2024-05-04 16:14:59 -05:00
Calvin Rose
3cc3312b7b Merge branch 'master' into compile-opt 2024-05-04 16:14:35 -05:00
Calvin Rose
f2d25a0da2 Add test case. 2024-05-04 16:14:26 -05:00
Calvin Rose
dfd05ddf7e Merge branch 'master' into compile-opt 2023-11-02 10:58:51 -05:00
Calvin Rose
31be7bad8e Merge branch 'master' into compile-opt 2023-11-01 17:36:14 -05:00
Calvin Rose
3a782d27b1 Allow for multiple functions in a sysir "context".
Allows for in memory linking.
2023-10-22 16:05:38 -05:00
Calvin Rose
f08874e65e Merge branch 'master' into compile-opt 2023-10-22 09:03:52 -05:00
Calvin Rose
6a78b6d1c6 Merge remote-tracking branch 'origin/compile-opt' into compile-opt 2023-10-10 20:28:09 -05:00
Calvin Rose
97963d1396 Update printing for operating on pointers. 2023-09-05 17:01:31 -05:00
Calvin Rose
efbc46c69e Add support for using operators on arrays (and pointers to arrays).
Allows more expressive yet type checked representation of array
algorithms.
2023-09-03 12:32:28 -05:00
Calvin Rose
9b9f67c371 Merge branch 'master' into compile-opt 2023-09-03 10:18:54 -05:00
Calvin Rose
61791e4a4c Update docstring. 2023-09-03 10:18:37 -05:00
Calvin Rose
c3a4fb6735 Merge branch 'master' into compile-opt 2023-08-20 18:55:15 -05:00
Calvin Rose
e5893d0692 Fix reference counting for threaded abstract types.
Was very borked. The sweep phase should drop references to unused
abstracts but wasn't, resulting in each collection decrementing the
count by one until 0 was hit, even if other threads maintained a
reference.
2023-08-20 14:50:46 -05:00
Calvin Rose
5f5e5cf693 Merge branch 'master' into compile-opt 2023-08-20 13:08:56 -05:00
Calvin Rose
46bda4e6fa Stub out type inference pass. 2023-08-16 14:09:25 -05:00
Calvin Rose
fdbf4f2666 Merge branch 'master' into compile-opt 2023-08-13 12:36:19 -05:00
Calvin Rose
b939671b79 Add check for redefining types. 2023-08-13 11:09:20 -05:00
Calvin Rose
4b8e7a416f Have separate instructions for pointer arith 2023-08-12 17:36:06 -05:00
Calvin Rose
1e1e7a5cfd Update garbage collection for sysir abstract type. 2023-08-12 13:47:23 -05:00
Calvin Rose
91e459e4a5 Format sysir. 2023-08-12 13:43:51 -05:00
Calvin Rose
b6adc257f4 Merge branch 'master' into compile-opt 2023-08-12 13:43:28 -05:00
Calvin Rose
a2bd98390e More work on the sysir. 2023-08-12 13:42:52 -05:00
Calvin Rose
d9912f38f8 Add union types and change name of type constructor instructions. 2023-08-12 10:29:24 -05:00
Calvin Rose
8007806c8e Add better support for arrays and struct fields in IR.
Also add option for named registers.
2023-08-08 18:56:02 -05:00
Calvin Rose
de2440d458 Lots todo 2023-08-07 10:54:41 -05:00
Calvin Rose
43ab06467f Merge branch 'master' into compile-opt 2023-08-07 09:40:27 -05:00
Calvin Rose
3fe4cfd14c Add labels back to sysir 2023-08-07 09:39:35 -05:00
Calvin Rose
75be5fd4c6 Update sysir to have better field support. 2023-08-06 20:00:49 -05:00
Calvin Rose
7c7136fd70 Merge branch 'master' into compile-opt 2023-08-06 17:09:13 -05:00
Calvin Rose
cfa32d58a7 More work on sysir, add initial work for recursive types. 2023-08-06 15:50:21 -05:00
Calvin Rose
7cc176f0c0 Add source mapping to emitted C. 2023-07-16 16:08:28 -05:00
Calvin Rose
4d7baef89e Merge branch 'master' into compile-opt 2023-07-04 13:52:54 -05:00
Calvin Rose
29af4a932d Fix NAN typo. 2023-05-12 19:08:00 -05:00
Calvin Rose
ef94a0f0b4 Rename sysdialect to sysir 2023-05-12 18:11:14 -05:00
Calvin Rose
517dc208ca Merge branch 'master' into compile-opt 2023-05-11 20:59:11 -05:00
Calvin Rose
fd7579dd07 More work on the sys-ir. 2023-04-08 10:51:46 -05:00
Calvin Rose
6b74400f2a Create system IR that can compile to C.
Work ongoing, still needs better pointer support, as well
as composite types.
2023-04-03 09:30:23 -05:00
146 changed files with 5775 additions and 2188 deletions

View File

@@ -1,4 +1,4 @@
image: openbsd/7.7
image: openbsd/7.6
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
@@ -10,17 +10,13 @@ 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

8
.github/cosmo/setup vendored
View File

@@ -1,19 +1,19 @@
#!/bin/sh
set -e
sudo apt-get update
sudo apt update
sudo apt-get install -y ca-certificates libssl-dev\
qemu-utils qemu-user-static\
qemu 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/4.0.2/cosmocc-4.0.2.zip
wget https://github.com/jart/cosmopolitan/releases/download/3.3.3/cosmocc-3.3.3.zip
mkdir -p cosmocc
cd cosmocc
unzip ../cosmocc-4.0.2.zip
unzip ../cosmocc-3.3.3.zip
# register
cd /sc/cosmocc

View File

@@ -12,7 +12,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, macos-latest, macos-14 ]
os: [ ubuntu-latest, macos-latest, macos-13 ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -136,22 +136,3 @@ 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

2
.gitignore vendored
View File

@@ -12,7 +12,6 @@ janet
/src/include/generated/*.h
janet-*.tar.gz
dist
/tmp
# jpm lockfile
lockfile.janet
@@ -38,6 +37,7 @@ temp.janet
temp.c
temp*janet
temp*.c
temp.*
scratch.janet
scratch.c

View File

@@ -1,35 +1,7 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.41.0 - 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
## Unreleased - ???
- Add `os/posix-chroot`
- Fix `ev/deadline` with interrupt race condition bug on Windows.
- Improve `flycheck` by allowing functions and macros to define their own flycheck behavior via the metadata `:flycheck`.

View File

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

View File

@@ -1,4 +1,4 @@
Copyright (c) 2026 Calvin Rose and contributors
Copyright (c) 2025 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

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2026 Calvin Rose
# Copyright (c) 2025 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
@@ -53,11 +53,12 @@ STRIPFLAGS=-x -S
HOSTCC?=$(CC)
HOSTAR?=$(AR)
# Symbols are (optionally) removed later, keep -g as default!
CFLAGS?=-O2 -g
CFLAGS?=-O0 -g
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)
@@ -137,7 +138,8 @@ JANET_LOCAL_HEADERS=src/core/features.h \
src/core/regalloc.h \
src/core/compile.h \
src/core/emit.h \
src/core/symcache.h
src/core/symcache.h \
src/core/sysir.h
JANET_CORE_SOURCES=src/core/abstract.c \
src/core/array.c \
@@ -172,6 +174,9 @@ JANET_CORE_SOURCES=src/core/abstract.c \
src/core/strtod.c \
src/core/struct.c \
src/core/symcache.c \
src/core/sysir.c \
src/core/sysir_c.c \
src/core/sysir_x86.c \
src/core/table.c \
src/core/tuple.c \
src/core/util.c \
@@ -219,9 +224,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.41.dylib
SONAME=libjanet.1.40.dylib
else
SONAME=libjanet.so.1.41
SONAME=libjanet.so.1.40
endif
ifeq ($(MINGW_COMPILER), clang)
@@ -260,7 +265,6 @@ $(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
# Testing assumes HOSTCC=CC
TEST_SCRIPTS=$(wildcard test/suite*.janet)
EXAMPLE_SCRIPTS=$(wildcard examples/*.janet)
repl: $(JANET_TARGET)
$(RUN) ./$(JANET_TARGET)
@@ -268,26 +272,21 @@ repl: $(JANET_TARGET)
debug: $(JANET_TARGET)
$(DEBUGGER) ./$(JANET_TARGET)
VALGRIND_COMMAND=$(RUN) valgrind --leak-check=full --quiet
CALLGRIND_COMMAND=$(RUN) valgrind --tool=callgrind
VALGRIND_COMMAND=valgrind --leak-check=full --quiet
valgrind: $(JANET_TARGET)
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
test: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
test: $(JANET_TARGET) $(TEST_PROGRAMS)
for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
valtest: $(JANET_TARGET) $(TEST_SCRIPTS) $(EXAMPLE_SCRIPTS)
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) -k "$$f"; done
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
callgrind: $(JANET_TARGET)
$(CALLGRIND_COMMAND) ./$(JANET_TARGET)
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
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
########################
##### Distribution #####
@@ -346,7 +345,6 @@ 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'
@@ -356,13 +354,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.$(JANET_VERSION).dylib' ; \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib' ; \
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \
ln -sf libjanet.$(JANET_VERSION).dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
ln -sf libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
else \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(JANET_VERSION)' ; \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' ; \
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \
ln -sf libjanet.so.$(JANET_VERSION) $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
fi
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
@@ -419,6 +417,9 @@ clean:
-rm -rf build vgcore.* callgrind.*
-rm -rf test/install/build test/install/modpath
test-install:
echo "JPM has been removed from default install."
help:
@echo
@echo 'Janet: A Dynamic Language & Bytecode VM'
@@ -430,8 +431,7 @@ help:
@echo ' make test Test a built Janet'
@echo ' make valgrind Assess Janet with Valgrind'
@echo ' make callgrind Assess Janet with Valgrind, using Callgrind'
@echo ' make valtest Run the test suite and examples with Valgrind to check for memory leaks'
@echo ' make calltest Run the test suite and examples with Callgrind'
@echo ' make valtest Run the test suite with Valgrind to check for memory leaks'
@echo ' make dist Create a distribution tarball'
@echo ' make docs Generate documentation'
@echo ' make debug Run janet with GDB or LLDB'
@@ -441,9 +441,6 @@ help:
@echo " make format Format Janet's own source files"
@echo ' make grammar Generate a TextMate language grammar'
@echo
@echo ' make install-jpm-git Install jpm into the current filesystem'
@echo ' make install-spork-git Install spork into the current filesystem'
@echo
.PHONY: clean install install-jpm-git install-spork-git repl debug valgrind test \
valtest callgrind callgrind-test dist uninstall docs grammar format help compile-commands
.PHONY: clean install repl debug valgrind test \
valtest dist uninstall docs grammar format help compile-commands

View File

@@ -148,40 +148,8 @@ 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.
@@ -192,18 +160,15 @@ make
make test
make repl
make install
make install-spork-git # optional
make install-jpm-git # optional
make install-jpm-git
```
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. This is a great way to try Janet without committing to a full
install or needing to customize the default install.
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.
```sh
docker run -it --rm alpine /bin/ash
@@ -213,13 +178,8 @@ $ 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,
@@ -231,8 +191,7 @@ make CC=gcc-x86
make test
make repl
make install
make install-spork-git # optional
make install-jpm-git # optional
make install-jpm-git
```
### FreeBSD
@@ -246,8 +205,7 @@ gmake
gmake test
gmake repl
gmake install
gmake install-spork-git # optional
gmake install-jpm-git # optional
gmake install-jpm-git
```
### NetBSD
@@ -362,8 +320,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/c/janet.c`, a C source code file that
that contains the amalgamated source to Janet. This file, along with
will create a file `build/janet.c`, which is a single C file
that contains all the 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

View File

@@ -20,11 +20,11 @@
@setlocal
@rem Example use asan
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi
@rem set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib
@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
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
@set JANET_LINK=link /nologo
@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
@set JANET_LINK_STATIC=lib /nologo
@@ -49,7 +49,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 syspath being baked in
@rem note that there is no default sysroot being baked in
build\janet_boot . > build\c\janet.c
@if errorlevel 1 goto :BUILDFAIL

View File

@@ -26,7 +26,7 @@
(broadcast name (string msg)))
(print name " disconnected")))))
(defn main [&]
(defn main [& args]
(printf "STARTING SERVER...")
(flush)
(def my-server (net/listen "127.0.0.1" "8000"))

View File

@@ -132,7 +132,7 @@
"Go to the next breakpoint."
[&opt n]
(var res nil)
(repeat (or n 1)
(for i 0 (or n 1)
(set res (resume (.fiber))))
res)
@@ -146,6 +146,6 @@
"Execute the next n instructions."
[&opt n]
(var res nil)
(repeat (or n 1)
(for i 0 (or n 1)
(set res (debug/step (.fiber))))
res)

View File

@@ -2,7 +2,7 @@
(def counts (seq [_ :range [0 100]] 0))
(repeat 1000000
(for i 0 1000000
(let [x (math/random)
intrange (math/floor (* 100 x))
oldcount (counts intrange)]

View File

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

View File

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

View File

@@ -0,0 +1,71 @@
###
### Create a .bmp file on linux.
###
# Quick run and view on Linux:
# build/janet examples/sysir/drawing.janet > temp.c && cc temp.c && ./a.out > temp.bmp && feh temp.bmp
(use ./frontend)
(defn-external write:void [fd:int mem:pointer size:uint])
(defn-external exit:void [x:int])
# assume 128x128 32 bit color image
# Size : 128 * 128 * 4 + align(14 + 40, 4) = 65592
# dib offset : align(14 + 40, 4) = 56
(defsys write_32:void [x:uint]
(write 1 (address x) 4)
(return))
(defsys write_16:void [x:uint]
(write 1 (address x) 2)
(return))
(defsys write_header:void [w:uint h:uint]
(write 1 "BM" 2)
(def size:uint (+ 56 (* w h 4)))
(write_32 size)
(write_32 0)
(write_32 56) # pixel array offset
# Begin DIB
(write_32 40) # dib size
(write_32 w)
(write_32 h)
(write_16 1) # color panes - must be 1
(write_16 32) # bits per pixel
(write_32 0) # compression method - no compression
(write_32 0) # image size - not needed when no compression, 0 should be fine
(write_32 4096) # pixels per meter - horizontal resolution
(write_32 4096) # pixels per meter - vertical resolution
(write_32 0) # number of colors in palette - no palette so 0
(write_32 0) # number of "important colors" ignored in practice
(write_16 0) # add "gap 1" to align pixel array to multiple of 4 bytes
(return))
(defsys draw:void [w:uint h:uint]
(def red:uint 0xFFFF0000)
(def blue:uint 0xFF0000FF)
(def size:uint (* w h 4))
(var y:uint 0)
(while (< y h)
(var x:uint 0)
(while (< x w)
(write_32 (if (> y 64) blue red))
(set x (+ 1 x)))
(set y (+ y 1)))
(return))
(defsys main:int []
(def w:uint 512)
(def h:uint 512)
(write_header w h)
(draw w h)
(return 0))
####
#(dump)
(print "#include <unistd.h>")
(dumpc)
#(dumpx64)

View File

@@ -0,0 +1,86 @@
###
### Create a .bmp file on linux.
###
# Quick run and view on Linux:
# build/janet examples/sysir/drawing2.janet > temp.c && cc temp.c && ./a.out > temp.bmp && feh temp.bmp
(use ./frontend)
(setdyn :verbose true)
# Pointer types
(defpointer p32 uint)
(defpointer p16 u16)
(defpointer cursor p32)
# External
(defn-external write:void [fd:int mem:pointer size:uint])
(defn-external exit:void [x:int])
(defn-external malloc:p32 [size:uint])
(defsys w32:void [c:cursor x:uint]
(def p:p32 (load c))
(store p x)
(store c (the p32 (pointer-add p 1)))
(return))
(defsys w16:void [c:cursor x:uint]
# Casting needs revisiting
(def p:p16 (cast (the p32 (load c))))
(store p (the u16 (cast x)))
(store c (the p32 (cast (the p16 (pointer-add p 1)))))
(return))
(defsys makebmp:p32 [w:uint h:uint]
(def size:uint (+ 56 (* w h 4)))
(def mem:p32 (malloc size))
(def c:cursor (cast (malloc 4)))
#(def cursor_data:p32 mem)
#(def c:cursor (address cursor_data))
(store c mem)
(w16 c 0x4D42) # ascii "BM"
(w32 c size)
(w32 c 0)
(w32 c 56)
(w32 c 40)
(w32 c w)
(w32 c h)
(w16 c 1)
(w16 c 32)
(w32 c 0)
(w32 c 0)
(w32 c 4096)
(w32 c 4096)
(w32 c 0)
(w32 c 0)
(w16 c 0) # padding
# Draw
(def red:uint 0xFFFF0000)
(def blue:uint 0xFF0000FF)
(def green:uint 0xFF00FF00)
(var y:uint 0)
(while (< y h)
(var x:uint 0)
(while (< x w)
(def d2:uint (+ (* x x) (* y y)))
(if (> d2 100000)
(if (> d2 200000) (w32 c green) (w32 c blue))
(w32 c red))
(set x (+ 1 x)))
(set y (+ y 1)))
(write 1 mem size)
(return mem))
(defsys main:int []
(def w:uint 512)
(def h:uint 512)
(makebmp w h)
(return 0))
####
(dumpx64)
#(print "#include <unistd.h>")
#(dumpc)

View File

@@ -0,0 +1,567 @@
# Make a language frontend for the sysir.
# Dialect:
# TODO -
# * arrays (declaration, loads, stores)
(defdyn *ret-type* "Current function return type")
(def slot-to-name @[])
(def name-to-slot @{})
(def type-to-name @[])
(def name-to-type @{})
(def slot-types @{})
(def functions @{})
(def type-fields @{})
(def syscalls @{})
(defn get-slot
[&opt new-name]
(def next-slot (length slot-to-name))
(array/push slot-to-name new-name)
(if new-name (put name-to-slot new-name next-slot))
next-slot)
(defn named-slot
[name]
(assert (get name-to-slot name)))
(defn make-type
[&opt new-name]
(def next-type (length type-to-name))
(array/push type-to-name new-name)
(if new-name (put name-to-type new-name next-type))
next-type)
(defn named-type
[name]
(def t (get name-to-type name))
(assert t)
t)
(defn binding-type
[name]
(def slot (assert (get name-to-slot name)))
(assert (get slot-types slot)))
(defn slot-type
[slot]
(assert (get slot-types slot)))
(defn assign-type
[name typ]
(def slot (get name-to-slot name))
(put slot-types slot typ))
(defn assign-slot-type
[slot typ]
(put slot-types slot typ))
(defn setup-default-types
[ctx]
(def into @[])
(defn add-prim-type
[name native-name]
(array/push into ~(type-prim ,name ,native-name))
(make-type name))
(add-prim-type 'float 'f32)
(add-prim-type 'double 'f64)
(add-prim-type 'int 's32)
(add-prim-type 'uint 'u32)
(add-prim-type 'long 's64)
(add-prim-type 'ulong 'u64)
(add-prim-type 'boolean 'boolean)
(add-prim-type 's16 's16)
(add-prim-type 'u16 'u16)
(add-prim-type 'byte 'u8)
(add-prim-type 'void 'void)
(array/push into ~(type-pointer pointer void))
(make-type 'pointer)
(sysir/asm ctx into)
ctx)
(defn type-extract
"Given a symbol:type combination, extract the proper name and the type separately"
[combined-name &opt default-type]
(def parts (string/split ":" combined-name 0 2))
(def [name tp] parts)
[(symbol name) (symbol (or tp default-type))])
(var do-binop nil)
(var do-comp nil)
###
### Inside functions
###
(defn visit1
"Take in a form and compile code and put it into `into`. Return result slot."
[code into &opt no-return type-hint]
(def subresult
(cond
# Compile a constant
(string? code) ~(pointer ,code)
(boolean? code) ~(boolean ,code)
(number? code) ~(,(or type-hint 'double) ,code) # TODO - should default to double
# Needed?
(= :core/u64 (type code)) ~(ulong ,code)
(= :core/s64 (type code)) ~(long ,code)
# Binding
(symbol? code)
(named-slot code)
# Array literals
(and (tuple? code) (= :brackets (tuple/type code)))
(do
(assert type-hint (string/format "unknown type for array literal %v" code))
~(,type-hint ,code))
# Compile forms
(and (tuple? code) (= :parens (tuple/type code)))
(do
(assert (> (length code) 0))
(def [op & args] code)
(case op
# Arithmetic
'+ (do-binop 'add args into type-hint)
'- (do-binop 'subtract args into type-hint)
'* (do-binop 'multiply args into type-hint)
'/ (do-binop 'divide args into type-hint)
'<< (do-binop 'shl args into type-hint)
'>> (do-binop 'shr args into type-hint)
# Comparison
'= (do-comp 'eq args into)
'not= (do-comp 'neq args into)
'< (do-comp 'lt args into)
'<= (do-comp 'lte args into)
'> (do-comp 'gt args into)
'>= (do-comp 'gte args into)
# Pointers
'pointer-add
(do
(assert (= 2 (length args)))
(def [base offset] args)
(def base-slot (visit1 base into false type-hint))
(def offset-slot (visit1 offset into false 'int))
(def slot (get-slot))
(when type-hint (array/push into ~(bind ,slot ,type-hint)))
(array/push into ~(pointer-add ,slot ,base-slot ,offset-slot))
slot)
'pointer-sub
(do
(assert (= 2 (length args)))
(def [base offset] args)
(def base-slot (visit1 base into false type-hint))
(def offset-slot (visit1 offset into false 'int))
(def slot (get-slot))
(when type-hint (array/push into ~(bind ,slot ,type-hint)))
(array/push into ~(pointer-subtract ,slot ,base-slot ,offset-slot))
slot)
# Type hinting
'the
(do
(assert (= 2 (length args)))
(def [xtype x] args)
(def result (visit1 x into false xtype))
(if (tuple? result) # constant
(let [[t y] result]
(assertf (= t xtype) "type mismatch, %p doesn't match %p" t xtype)
[xtype y])
(do
(array/push into ~(bind ,result ,xtype))
result)))
# Casting
'cast
(do
(assert (= 1 (length args)))
(assert type-hint) # should we add an explicit cast type?
(def [x] args)
(def slot (get-slot))
(def result (visit1 x into false))
(array/push into ~(bind ,slot ,type-hint))
(array/push into ~(cast ,slot ,result))
slot)
# Named bindings
'def
(do
(assert (= 2 (length args)))
(def [full-name value] args)
(assert (symbol? full-name))
(def [name tp] (type-extract full-name 'int))
(def result (visit1 value into false tp))
(def slot (get-slot name))
(assign-type name tp)
(array/push into ~(bind ,slot ,tp))
(array/push into ~(move ,slot ,result))
slot)
# Named variables
'var
(do
(assert (= 2 (length args)))
(def [full-name value] args)
(assert (symbol? full-name))
(def [name tp] (type-extract full-name 'int))
(def result (visit1 value into false tp))
(def slot (get-slot name))
(assign-type name tp)
(array/push into ~(bind ,slot ,tp))
(array/push into ~(move ,slot ,result))
slot)
# Address of (& operator in C)
'address
(do
(assert (= 1 (length args)))
(def [thing] args)
(def [name tp] (type-extract thing 'int))
(def result (visit1 thing into false tp))
(def slot (get-slot))
#
(array/push into ~(bind ,slot ,type-hint))
(array/push into ~(address ,slot ,result))
slot)
'load
(do
(assert (= 1 (length args)))
(assert type-hint)
(def [thing] args)
# (def [name tp] (type-extract thing 'pointer))
(def result (visit1 thing into false))
(def slot (get-slot))
(def ptype type-hint)
(array/push into ~(bind ,slot ,ptype))
(array/push into ~(load ,slot ,result))
slot)
'store
(do
(assert (= 2 (length args)))
(def [dest value] args)
# (def [name tp] (type-extract dest 'pointer))
(def dest-r (visit1 dest into false))
(def value-r (visit1 value into false))
(array/push into ~(store ,dest-r ,value-r))
value-r)
# Assignment
'set
(do
(assert (= 2 (length args)))
(def [to x] args)
(def type-hint (binding-type to))
(def result (visit1 x into false type-hint))
(def toslot (named-slot to))
(array/push into ~(move ,toslot ,result))
toslot)
# Return
'return
(do
(assert (>= 1 (length args)))
(if (empty? args)
(array/push into '(return))
(do
(def [x] args)
(array/push into ~(return ,(visit1 x into false (dyn *ret-type*))))))
nil)
# Sequence of operations
'do
(do
(each form (slice args 0 -2) (visit1 form into true))
(visit1 (last args) into false type-hint))
# While loop
'while
(do
(def lab-test (keyword (gensym)))
(def lab-exit (keyword (gensym)))
(assert (< 1 (length args)))
(def [cnd & body] args)
(array/push into lab-test)
(def condition-slot (visit1 cnd into false 'boolean))
(array/push into ~(branch-not ,condition-slot ,lab-exit))
(each code body
(visit1 code into true))
(array/push into ~(jump ,lab-test))
(array/push into lab-exit)
nil)
# Branch
'if
(do
(def lab (keyword (gensym)))
(def lab-end (keyword (gensym)))
(assert (< 2 (length args) 4))
(def [cnd tru fal] args)
(def condition-slot (visit1 cnd into false 'boolean))
(def ret (if type-hint (get-slot)))
(when type-hint (array/push into ~(bind ,ret ,type-hint)))
(array/push into ~(branch ,condition-slot ,lab))
# false path
(if type-hint
(array/push into ~(move ,ret ,(visit1 fal into false type-hint)))
(visit1 fal into true))
(array/push into ~(jump ,lab-end))
(array/push into lab)
# true path
(if type-hint
(array/push into ~(move ,ret ,(visit1 tru into false type-hint)))
(visit1 tru into true))
(array/push into lab-end)
ret)
# Insert IR
'ir
(do
(assert no-return)
(array/push into ;args)
nil)
# Assume function call or syscall
(do
(def slots @[])
(def signature (get functions op))
(def is-syscall (get syscalls op))
(assert signature (string "unknown function " op))
(def ret (if no-return nil (get-slot)))
(when ret
(array/push into ~(bind ,ret ,(first signature)))
(assign-type ret (first signature)))
(each [arg-type arg] (map tuple (drop 1 signature) args)
(array/push slots (visit1 arg into false arg-type)))
(if is-syscall
(array/push into ~(syscall :default ,ret (int ,is-syscall) ,;slots))
(array/push into ~(call :default ,ret [pointer ,op] ,;slots)))
ret)))
(errorf "cannot compile %q" code)))
# Check type-hint matches return type
(if type-hint
(when-let [t (first subresult)] # TODO - Disallow empty types
(assert (= type-hint t) (string/format "%j, expected type %v, got %v" code type-hint t))))
subresult)
(varfn do-binop
"Emit an operation such as (+ x y).
Extended to support any number of arguments such as (+ x y z ...)"
[opcode args into type-hint]
(var typ type-hint)
(var final nil)
(def slots @[])
(each arg args
(def right (visit1 arg into false typ))
(when (number? right) (array/push slots right))
# If we don't have a type hint, infer types from bottom up
(when (nil? typ)
(when-let [new-typ (get slot-types right)]
(set typ new-typ)))
(set final
(if final
(let [result (get-slot)]
(array/push slots result)
(array/push into ~(,opcode ,result ,final ,right))
result)
right)))
(assert typ (string "unable to infer type for %j" [opcode ;args]))
(each slot (distinct slots)
(array/push into ~(bind ,slot ,typ)))
(assert final))
(varfn do-comp
"Emit a comparison form such as (= x y z ...)"
[opcode args into]
(def result (get-slot))
(def needs-temp (> 2 (length args)))
(def temp-result (if needs-temp (get-slot) nil))
(array/push into ~(bind ,result boolean))
(when needs-temp
(array/push into ~(bind ,temp-result boolean)))
(var left nil)
(var first-compare true)
(var typ nil)
(each arg args
(def right (visit1 arg into false typ))
# If we don't have a type hint, infer types from bottom up
(when (nil? typ)
(when-let [new-typ (get slot-types right)]
(set typ new-typ)))
(when left
(if first-compare
(array/push into ~(,opcode ,result ,left ,right))
(do
(array/push into ~(,opcode ,temp-result ,left ,right))
(array/push into ~(and ,result ,temp-result ,result))))
(set first-compare false))
(set left right))
result)
###
### Top level
###
(defn top
"Visit and emit code for a top level form."
[ctx form]
(assert (tuple? form))
(def [head & rest] form)
(case head
# Declare a struct
'defstruct
(do
(def into @[])
(def [name & fields] rest)
(assert (even? (length fields)) "expected an even number of fields for struct definition")
(def field-types @[])
(each [field-name typ] (partition 2 fields)
# TODO - don't ignore field names
(array/push field-types typ))
(array/push into ~(type-struct ,name ,;field-types))
# (eprintf "%.99M" into)
(sysir/asm ctx into))
# Declare a union
'defunion
(do
(def into @[])
(def [name & fields] rest)
(assert (even? (length fields)) "expected an even number of fields for struct definition")
(def field-types @[])
(each [field-name typ] (partition 2 fields)
# TODO - don't ignore field names
(array/push field-types typ))
(array/push into ~(type-union ,name ,;field-types))
# (eprintf "%.99M" into)
(sysir/asm ctx into))
# Declare a pointer type
'defpointer
(do
(def into @[])
(def [name element] rest)
(def field-types @[])
(array/push into ~(type-pointer ,name ,element))
# (eprintf "%.99M" into)
(sysir/asm ctx into))
# Declare an array type
'defarray
(do
(def into @[])
(def [name element cnt] rest)
(assert (and (pos? cnt) (int? cnt)) "expected positive integer for array count")
(array/push into ~(type-array ,name ,element ,cnt))
# (eprintf "%.99M" into)
(sysir/asm ctx into))
# External function
'defn-external
(do
(def [name args] rest)
(assert (tuple? args))
(def [fn-name fn-tp] (type-extract name 'void))
(def pcount (length args)) #TODO - more complicated signatures
(def signature @[fn-tp])
(each arg args
(def [name tp] (type-extract arg 'int))
(array/push signature tp))
(put functions fn-name (freeze signature)))
# External syscall
'defn-syscall
(do
(def [name sysnum args] rest)
(assert (tuple? args))
(def [fn-name fn-tp] (type-extract name 'void))
(def pcount (length args)) #TODO - more complicated signatures
(def signature @[fn-tp])
(each arg args
(def [name tp] (type-extract arg 'int))
(array/push signature tp))
(put syscalls fn-name sysnum)
(put functions fn-name (freeze signature)))
# Top level function definition
'defn
(do
# TODO doc strings
(table/clear name-to-slot)
(table/clear slot-types)
(array/clear slot-to-name)
(def [name args & body] rest)
(assert (tuple? args))
(def [fn-name fn-tp] (type-extract name 'void))
(def pcount (length args)) #TODO - more complicated signatures
(def ir-asm
@[~(link-name ,(string fn-name))
~(parameter-count ,pcount)])
(def signature @[fn-tp])
(each arg args
(def [name tp] (type-extract arg 'int))
(def slot (get-slot name))
(assign-type name tp)
(array/push signature tp)
(array/push ir-asm ~(bind ,slot ,tp)))
(with-dyns [*ret-type* fn-tp]
(each part body
(visit1 part ir-asm true)))
(put functions fn-name (freeze signature))
(when (dyn :verbose) (eprintf "%.99M" ir-asm))
(sysir/asm ctx ir-asm))
(errorf "unknown form %p" form)))
###
### Setup
###
(def ctx (sysir/context))
(setup-default-types ctx)
(defn compile1
[x]
(top ctx x))
(defn dump
[]
(eprintf "%.99M\n" (sysir/to-ir ctx)))
(defn dumpx64
[]
(print (sysir/to-x64 ctx)))
(defn dumpx64-windows
[]
(print (sysir/to-x64 ctx @"" :windows)))
(defn dumpc
[]
(print (sysir/to-c ctx)))
###
### Top Level aliases
###
(defmacro defstruct [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defstruct ,;args))])
(defmacro defunion [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defunion ,;args))])
(defmacro defarray [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defarray ,;args))])
(defmacro defpointer [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defpointer ,;args))])
(defmacro defn-external [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn-external ,;args))])
(defmacro defn-syscall [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn-syscall ,;args))])
(defmacro defsys [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn ,;args))])

View File

@@ -0,0 +1,16 @@
(use ./frontend)
(defn-external printf:int [fmt:pointer])
(defn-external exit:void [x:int])
(defsys _start:void []
(printf "hello, world!\n")
(exit (the int 0))
(return))
(defn main [& args]
(def [_ what] args)
(eprint "MODE: " what)
(case what
"c" (dumpc)
"x64" (dumpx64)))

5
examples/sysir/run_drawing.sh Executable file
View File

@@ -0,0 +1,5 @@
#!/usr/bin/env bash
valgrind build/janet examples/sysir/drawing.janet > temp.c
cc temp.c
./a.out > temp.bmp
feh temp.bmp

5
examples/sysir/run_drawing2.sh Executable file
View File

@@ -0,0 +1,5 @@
#!/usr/bin/env bash
valgrind build/janet examples/sysir/drawing2.janet > temp.nasm
nasm -felf64 temp.nasm -l temp.lst -o temp.o
ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
valgrind ./temp.bin

View File

@@ -0,0 +1,4 @@
janet.exe examples/sysir/windows_samples.janet > temp.nasm
nasm -fwin64 temp.nasm -l temp.lst -o temp.o
link /entry:Start /subsystem:windows kernel32.lib user32.lib temp.o /out:temp.exe
temp.exe

5
examples/sysir/run_samples.sh Executable file
View File

@@ -0,0 +1,5 @@
#!/usr/bin/env bash
valgrind build/janet examples/sysir/samples.janet > temp.nasm
nasm -felf64 temp.nasm -l temp.lst -o temp.o
ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
valgrind ./temp.bin

View File

@@ -0,0 +1,72 @@
(use ./frontend)
(defstruct vec3
a float
b float
c float)
(defunion myunion
a float
b double
c long)
(defarray myvec float 4)
(defarray mymat myvec 4)
(defn-external printf:int [fmt:pointer x:int]) # TODO varargs
(defn-external exit:void [x:int])
(defsys square:int
[num:int]
(return (* 1 num num)))
(defsys simple:int [x:int]
(def xyz:int (+ 1 2 3))
(return (* x 2 x)))
(defsys myprog:int []
(def xyz:int (+ 1 2 3))
(def abc:int (* 4 5 6))
(def x:boolean (= xyz 5))
(var i:int 0)
(while (< i 10)
(set i (+ 1 i))
(printf "i = %d\n" i))
(printf "hello, world!\n%d\n" (if x abc xyz))
(return (simple (* abc xyz))))
(defsys doloop [x:int y:int]
(var i:int x)
(while (< i y)
(set i (+ 1 i))
(printf "i = %d\n" i))
(myprog)
(return x))
(defsys _start:void []
#(syscall 1 1 "Hello, world!\n" 14)
(doloop 10 20)
(exit (the int 0))
(return))
(defsys test_inttypes:ulong []
(def x:ulong 123:u)
(return (+ x x)))
(defsys test_arrays:myvec [a:myvec b:myvec]
(return (+ a b)))
'(defsys make_array:myvec []
(def vec:myvec [0 0 0 0])
(return vec))
'(defsys make_mat:mymat []
(def mat:mymat [[1 0 0 0] [0 1 0 0] [0 0 1 0] [0 0 0 1]])
(return mat))
####
#(dump)
#(dumpc)
(dumpx64)

View File

@@ -0,0 +1,10 @@
(def ir-asm
'((link-name "redefine_type_fail")
(type-prim Real f32)
(type-prim 1 s32)
(bind bob Real)
(return bob)))
(def ctx (sysir/context))
(sysir/asm ctx ir-asm)
(print (sysir/to-c ctx))

View File

@@ -0,0 +1,14 @@
(use ./frontend)
(def winmain
'(defn Start:void []
(MessageBoxExA (the pointer 0) "Hello, world!" "Test" 0 (the s16 0))
(ExitProcess (the int 0))
(return)))
####
(compile1 winmain)
#(dump)
#(dumpc)
(dumpx64-windows)

24
examples/sysir/x64.janet Normal file
View File

@@ -0,0 +1,24 @@
(use ./frontend)
(defn-external printf:int [fmt:pointer x:int])
(defn-external exit:void [x:int])
(defsys doloop [x:int y:int]
(var i:int x)
(printf "initial i = %d\n" i)
(while (< i y)
(set i (+ 1 i))
(printf "i = %d\n" i))
(return x))
(defsys _start:void []
(doloop 10 20)
(exit (the int 0))
(return))
(defn main [& args]
(def [_ what] args)
(eprint "MODE: " what)
(case what
"c" (dumpc)
"x64" (dumpx64)))

View File

@@ -7,7 +7,7 @@
(ev/give chan (math/random))
(ev/give chan (math/random))
(ev/sleep 0.5)
(repeat 10
(for i 0 10
(print "giving to channel...")
(ev/give chan (math/random))
(ev/sleep 1))

View File

@@ -156,7 +156,7 @@ Shows the version text and exits immediately.
.TP
.BR \-s
Read raw input from stdin and forgo fancy input, which includes prompt history and other readline-like features.
Read raw input from stdin and forgo prompt history and other readline-like features.
.TP
.BR \-e\ code
@@ -272,12 +272,6 @@ 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

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2026 Calvin Rose and contributors
# Copyright (c) 2025 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.41.0')
version : '1.40.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -126,7 +126,8 @@ core_headers = [
'src/core/regalloc.h',
'src/core/compile.h',
'src/core/emit.h',
'src/core/symcache.h'
'src/core/symcache.h',
'src/core/sysir.h',
]
core_src = [
@@ -163,6 +164,9 @@ core_src = [
'src/core/strtod.c',
'src/core/struct.c',
'src/core/symcache.c',
'src/core/sysir.c',
'src/core/sysir_c.c',
'src/core/sysir_x86.c',
'src/core/table.c',
'src/core/tuple.c',
'src/core/util.c',
@@ -288,7 +292,6 @@ 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',
@@ -298,6 +301,7 @@ test_files = [
'test/suite-strtod.janet',
'test/suite-struct.janet',
'test/suite-symcache.janet',
'test/suite-sysir.janet',
'test/suite-table.janet',
'test/suite-tuple.janet',
'test/suite-unknown.janet',

View File

@@ -1,49 +0,0 @@
</$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]

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
# The core janet library
# Copyright 2026 © Calvin Rose
# Copyright 2025 © Calvin Rose
###
###
@@ -105,9 +105,9 @@
(defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword))
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
(defn function? "Check if x is a function (not a cfunction)." [x] (= (type x) :function))
(defn cfunction? "Check if x is a cfunction." [x] (= (type x) :cfunction))
(defn table? "Check if x is a table." [x] (= (type x) :table))
(defn struct? "Check if x is a struct." [x] (= (type x) :struct))
(defn cfunction? "Check if x a cfunction." [x] (= (type x) :cfunction))
(defn table? "Check if x a table." [x] (= (type x) :table))
(defn struct? "Check if x a struct." [x] (= (type x) :struct))
(defn array? "Check if x is an array." [x] (= (type x) :array))
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
@@ -115,7 +115,7 @@
(defn true? "Check if x is true." [x] (= x true))
(defn false? "Check if x is false." [x] (= x false))
(defn nil? "Check if x is nil." [x] (= x nil))
(defn empty? "Check if an iterable, `iter`, is empty." [iter] (= nil (next iter nil)))
(defn empty? "Check if xs is empty." [xs] (= nil (next xs nil)))
# For macros, we define an incomplete odd? function that will be overridden.
(defn odd? [x] (= 1 (mod x 2)))
@@ -348,15 +348,12 @@
[body catch]
(assert (and (not (empty? catch)) (indexed? (catch 0))) "the first element of `catch` must be a tuple or array")
(let [[err fib] (catch 0)
r (gensym)
f (gensym)]
r (or err (gensym))
f (or fib (gensym))]
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
,r (,resume ,f)]
(if (,= (,fiber/status ,f) :error)
(do
,(if err ~(def ,err ,r))
,(if fib ~(def ,fib ,f))
,;(tuple/slice catch 1))
(do ,;(tuple/slice catch 1))
,r))))
(defmacro with-syms
@@ -370,24 +367,19 @@
(++ i))
~(let (,;accum) ,;body))
(defn- defer-impl
"Defer but allow custom name for stack traces"
[name form body]
(defmacro defer
``Run `form` unconditionally after `body`, even if the body throws an error.
Will also run `form` if a user signal 0-4 is received.``
[form & body]
(with-syms [f r]
~(do
(def ,f (,fiber/new (fn ,name [] ,;body) :ti))
(def ,f (,fiber/new (fn :defer [] ,;body) :ti))
(def ,r (,resume ,f))
,form
(if (= (,fiber/status ,f) :dead)
,r
(,propagate ,r ,f)))))
(defmacro defer
``Run `form` unconditionally after `body`, even if the body throws an error.
Will also run `form` if a user signal 0-4 is received.``
[form & body]
(defer-impl :defer form body))
(defmacro edefer
``Run `form` after `body` in the case that body terminates abnormally (an error or user signal 0-4).
Otherwise, return last form in `body`.``
@@ -441,14 +433,14 @@
[[binding ctor dtor] & body]
~(do
(def ,binding ,ctor)
,(defer-impl :with [(or dtor :close) binding] body)))
,(apply defer [(or dtor :close) binding] body)))
(defmacro when-with
``Similar to with, but if binding is false or nil, returns
nil without evaluating the body. Otherwise, the same as `with`.``
[[binding ctor dtor] & body]
~(if-let [,binding ,ctor]
,(defer-impl :when-with [(or dtor :close) binding] body)))
,(apply defer [(or dtor :close) binding] body)))
(defmacro if-with
``Similar to `with`, but if binding is false or nil, evaluates
@@ -456,7 +448,7 @@
`ctor` is bound to binding.``
[[binding ctor dtor] truthy &opt falsey]
~(if-let [,binding ,ctor]
,(defer-impl :if-with [(or dtor :close) binding] [truthy])
,(apply defer [(or dtor :close) binding] [truthy])
,falsey))
(defn- for-var-template
@@ -1462,12 +1454,6 @@
(put ret (f k) (f (in form k))))
ret)
(defn- walk-dict-values [f form]
(def ret @{})
(loop [k :keys form]
(put ret k (f (in form k))))
ret)
(defn walk
``Iterate over the values in ast and apply `f`
to them. Collect the results in a data structure. If ast is not a
@@ -1817,8 +1803,8 @@
(flatten-into @[] xs))
(defn kvs
``Takes a table or struct and returns a new array of key value pairs
like `@[k v k v ...]`.``
``Takes a table or struct and returns and array of key value pairs
like `@[k v k v ...]`. Returns a new array.``
[dict]
(def ret @[])
(loop [k :keys dict] (array/push ret k (in dict k)))
@@ -2033,11 +2019,6 @@
(put b2g (pattern (inc i)) @[[slice s i]])
(break))
(when (= sub-pattern '$)
(when (not= (length pattern) (inc i))
(error "expected $ to be last symbol in pattern"))
(break))
(visit-pattern-1 b2g s i sub-pattern)))
# match global unification
@@ -2057,10 +2038,11 @@
(def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
(when isarr
(array/push anda (get-length-sym s))
(def amp-index (find-index (fn [x] (= x '&)) pattern))
(def dollar-index (find-index (fn [x] (= x '$)) pattern))
(def pattern-len (or dollar-index amp-index (length pattern)))
(array/push anda [(if dollar-index = <=) pattern-len (get-length-sym s)]))
(def pattern-len
(if-let [rest-idx (find-index (fn [x] (= x '&)) pattern)]
rest-idx
(length pattern)))
(array/push anda [<= pattern-len (get-length-sym s)]))
(cond
# match data structure template
@@ -2072,7 +2054,7 @@
isarr
(eachp [i sub-pattern] pattern
# stop recursing to sub-patterns if the rest sigil is found
(when (or (= sub-pattern '$) (= sub-pattern '&))
(when (= sub-pattern '&)
(break))
(visit-pattern-2 anda gun preds s i sub-pattern))
@@ -2118,15 +2100,11 @@
(array/concat anda unify)
# Final binding
(def defs (seq [[k v] :in (sort (pairs b2g))] ['def k (first v)]))
(def unused-defs (seq [[k v] :in (sort (pairs b2g))] ['def k :unused (first v)]))
# Predicates
(unless (empty? preds)
(def pred-join ~(do ,;unused-defs (and ,;preds)))
(def pred-join ~(do ,;defs (and ,;preds)))
(array/push anda pred-join))
# Use `unused-defs` instead of `defs` when we have predicates to avoid unused binding lint
# e.g. (match x (n (even? n)) :yes :no) should not warn on unused binding `n`.
# This is unfortunately not perfect since one programmer written binding is expanded for use in multiple places.
(emit-branch (tuple/slice anda) ['do ;(if (next preds) unused-defs defs) expression]))
(emit-branch (tuple/slice anda) ['do ;defs expression]))
# Expand branches
(def stack @[else])
@@ -2173,7 +2151,7 @@
(defn expand-bindings [x]
(case (type x)
:array (map expand-bindings x)
:tuple (keep-syntax! x (map expand-bindings x))
:tuple (tuple/slice (map expand-bindings x))
:table (dotable x expand-bindings)
:struct (table/to-struct (dotable x expand-bindings))
(recur x)))
@@ -2181,11 +2159,11 @@
(defn expanddef [t]
(def last (in t (- (length t) 1)))
(def bound (in t 1))
(keep-syntax! t
(array/concat
@[(in t 0) (expand-bindings bound)]
(tuple/slice t 2 -2)
@[(recur last)])))
(tuple/slice
(array/concat
@[(in t 0) (expand-bindings bound)]
(tuple/slice t 2 -2)
@[(recur last)])))
(defn expandall [t]
(def args (map recur (tuple/slice t 1)))
@@ -2196,10 +2174,10 @@
(if (symbol? t1)
(do
(def args (map recur (tuple/slice t 3)))
(keep-syntax t (tuple 'fn t1 (in t 2) ;args)))
(tuple 'fn t1 (in t 2) ;args))
(do
(def args (map recur (tuple/slice t 2)))
(keep-syntax t (tuple 'fn t1 ;args)))))
(tuple 'fn t1 ;args))))
(defn expandqq [t]
(defn qq [x]
@@ -2313,11 +2291,9 @@
x))
(defn thaw
```
Thaw an object (make it mutable) and do a deep copy, making
`Thaw an object (make it mutable) and do a deep copy, making
child values also mutable. Closures, fibers, and abstract
types will not be recursively thawed, but all other types will.
```
types will not be recursively thawed, but all other types will.`
[ds]
(case (type ds)
:array (walk-ind thaw ds)
@@ -2327,19 +2303,6 @@
:string (buffer ds)
ds))
(defn thaw-keep-keys
```
Similar to `thaw`, but do not modify table or struct keys.
```
[ds]
(case (type ds)
:array (walk-ind thaw-keep-keys ds)
:tuple (walk-ind thaw-keep-keys ds)
:table (walk-dict-values thaw-keep-keys (table/proto-flatten ds))
:struct (walk-dict-values thaw-keep-keys (struct/proto-flatten ds))
:string (buffer ds)
ds))
(defn deep-not=
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `not=`.``
@@ -2408,7 +2371,6 @@
(cond
(keyword? m) (put metadata m true)
(string? m) (put metadata :doc m)
(dictionary? m) (merge-into metadata m)
(error (string "invalid metadata " m))))
(with-syms [entry old-entry f]
~(let [,old-entry (,dyn ',name)]
@@ -2845,8 +2807,7 @@
(defmacro comptime
"Evals x at compile time and returns the result. Similar to a top level unquote."
[x]
(def y (eval x))
y)
(eval x))
(defmacro compif
"Check the condition `cnd` at compile time -- if truthy, compile `tru`, else compile `fals`."
@@ -2874,8 +2835,7 @@
(defn- check-dyn-relative [x] (if (string/has-prefix? "@" x) x))
(defn- check-relative [x] (if (string/has-prefix? "." x) x))
# Don't try to preload absolute or relative paths
(defn- check-preloadable [x] (if-not (or (string/has-prefix? "/" x) (string/find "." x) (string/find "@" x)) x))
(defn- check-not-relative [x] (if-not (string/has-prefix? "." x) x))
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
@@ -2925,7 +2885,6 @@
(array/insert mp sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(def curall-index (find-prefix ":cur:/:all:"))
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
(array/insert mp 0 [":all:" loader (fn :check-ext [x] (string/has-suffix? ext x))])
mp)
# Don't expose this externally yet - could break if custom module/paths is setup.
@@ -2950,10 +2909,7 @@
(module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source)
(module/add-paths ".jimage" :image)
(array/insert module/paths 0
[(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path))
:preload
check-preloadable])
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path)) :preload check-not-relative])
# Version of fexists that works even with a reduced OS
(defn- fexists
@@ -2981,22 +2937,20 @@
or :image if the module is found, otherwise a tuple with nil followed by
an error message.
```
[path &opt find-all]
[path]
(var ret nil)
(def mp (dyn *module-paths* module/paths))
(def all-matches (if find-all @[]))
(each [p mod-kind checker] mp
(when (mod-filter checker path)
(if (function? p)
(when-let [res (p path)]
(set ret [res mod-kind])
(if find-all (array/push all-matches ret) (break)))
(break))
(do
(def fullpath (string (module/expand-path path p)))
(when (fexists fullpath)
(set ret [fullpath mod-kind])
(if find-all (array/push all-matches ret) (break)))))))
(if find-all (break all-matches))
(break))))))
(if ret ret
(let [expander (fn :expander [[t _ chk]]
(when (string? t)
@@ -3107,7 +3061,7 @@
(os/exit 1))
(put env :exit true)
(def buf @"")
(with-dyns [*err* buf]
(with-dyns [*err* buf *err-color* false]
(bad-parse x y))
(set exit-error (string/slice buf 0 -2)))
(defn bc [&opt x y z a b]
@@ -3116,7 +3070,7 @@
(os/exit 1))
(put env :exit true)
(def buf @"")
(with-dyns [*err* buf]
(with-dyns [*err* buf *err-color* false]
(bad-compile x nil z a b))
(set exit-error (string/slice buf 0 -2))
(set exit-fiber y))
@@ -3171,20 +3125,17 @@
(defn- require-1
[path args kargs]
(def [fullpath mod-kind]
(if-let [loader (get kargs :loader)]
[path loader]
(module/find path)))
(def [fullpath mod-kind] (module/find path))
(unless fullpath (error mod-kind))
(def mc (dyn *module-cache* module/cache))
(def ml (dyn *module-loading* module/loading))
(def mls (dyn *module-loaders* module/loaders))
(if-let [check (if-not (get kargs :fresh) (in mc fullpath))]
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
check
(if (get ml fullpath)
(if (ml fullpath)
(error (string "circular dependency " fullpath " detected"))
(do
(def loader (if (keyword? mod-kind) (get mls mod-kind) mod-kind))
(def loader (if (keyword? mod-kind) (mls mod-kind) mod-kind))
(unless loader (error (string "module type " mod-kind " unknown")))
(def env (loader fullpath args))
(put mc fullpath env)
@@ -3223,7 +3174,7 @@
(def prefix (or
(and as (string as "/"))
prefix
(string (first (string/split "." (last (string/split "/" path)))) "/")))
(string (last (string/split "/" path)) "/")))
(merge-module env newenv prefix ep only))
(defmacro import
@@ -3738,7 +3689,7 @@
(def digits (inc (math/floor (math/log10 end))))
(def fmt-str (string "%" digits "d: %s"))
(for i beg end
(eprin " ")
(eprin " ") # breakpoint someday?
(eprin (if (= i cur) "> " " "))
(eprintf fmt-str i (get lines i))))
(let [[sl _] (sourcemap pc)]
@@ -3845,16 +3796,13 @@
(default env (make-env))
(default chunks
(fn :chunks [buf p]
(def custom-prompt (get env *repl-prompt*))
(def repl-prompt
(if custom-prompt
(custom-prompt p)
(string
"repl:"
((:where p) 0)
":"
(:state p :delimiters) "> ")))
(getline repl-prompt buf env)))
(getline
(string
"repl:"
((:where p) 0)
":"
(:state p :delimiters) "> ")
buf env)))
(run-context {:env env
:chunks chunks
:on-status (or onsignal (debugger-on-status env 1 true))
@@ -3875,16 +3823,13 @@
(defn ev/call
```
Call a function asynchronously.
Returns a task fiber that is scheduled to run the function.
Returns a fiber that is scheduled to run the function.
```
[f & args]
(ev/go (fn :call [&] (f ;args))))
(defmacro ev/spawn
``
Run some code in a new task fiber. This is shorthand for
`(ev/go (fn [] ;body))`."
``
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
[& body]
~(,ev/go (fn :spawn [&] ,;body)))
@@ -3957,33 +3902,23 @@
(cancel-all chan fibers "sibling canceled")
(propagate (fiber/last-value fiber) fiber))))))
(defn ev/go-gather
```
Run a dyanmic number of fibers in parallel and resume the current fiber after they complete. Takes
an array of functions or fibers, `thunks`, that will be run via `ev/go` in another task.
Returns the gathered results in an array.
```
[thunks]
(def fset @{})
(def chan (ev/chan))
(def results @[])
(each thunk thunks
(def ftemp (ev/go thunk nil chan))
(array/push results ftemp)
(put fset ftemp ftemp))
(wait-for-fibers chan fset)
(for i 0 (length results) # avoid extra copy from map
(set (results i) (fiber/last-value (in results i))))
results)
(defmacro ev/gather
``
Create and run a number of fibers in parallel (created from `bodies`) and resume the
current fiber after they complete. Shorthand for `ev/go-gather`. Returns the gathered results in an
array.
Run a number of fibers in parallel on the event loop, and join when they complete.
Returns the gathered results in an array.
``
[& bodies]
~(,ev/go-gather ,(seq [body :in bodies] ~(fn :ev/gather [] ,body)))))
(with-syms [chan res fset ftemp]
~(do
(def ,fset @{})
(def ,chan (,ev/chan))
(def ,res @[])
,;(seq [[i body] :pairs bodies]
~(do
(def ,ftemp (,ev/go (fn :ev/gather [] (put ,res ,i ,body)) nil ,chan))
(,put ,fset ,ftemp ,ftemp)))
(,wait-for-fibers ,chan ,fset)
,res))))
(compwhen (dyn 'net/listen)
(defn net/server
@@ -4117,6 +4052,7 @@
Other arguments to `flycheck` are the same as `dofile`. Returns nil.
```
[path &keys kwargs]
(def mc @{})
(def new-env (make-env (get kwargs :env)))
(put new-env *flychecking* true)
(put new-env *module-cache* @{})
@@ -4144,17 +4080,8 @@
true))
(defn- is-safe-def [thunk source env where]
(if-let [ve (get env (source 1))
fc (get ve :flycheck)]
(cond
# Sometimes safe form
(function? fc)
(fc thunk source env where)
# Always safe form
fc
(thunk))
(if (no-side-effects (last source))
(thunk))))
(if (no-side-effects (last source))
(thunk)))
(defn- flycheck-importer
[thunk source env where]
@@ -4267,7 +4194,7 @@
(spit manifest-name b))
(defn bundle/manifest
"Get the manifest for a given installed bundle."
"Get the manifest for a give installed bundle"
[bundle-name]
(def name (get-manifest-filename bundle-name))
(assertf (fexists name) "no bundle %v found" bundle-name)
@@ -4292,15 +4219,7 @@
(put new-env *syspath* fixed-syspath)
(with-env new-env
(put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right
(try
(require (string "@syspath/bundle/" bundle-name))
([e f]
(def pfx "could not find module @syspath/bundle/")
(def msg (if (and (string? e)
(string/has-prefix? pfx e))
"bundle must contain bundle.janet or bundle/init.janet"
e))
(propagate msg f))))))
(require (string "@syspath/bundle/" bundle-name)))))
(defn- do-hook
[module bundle-name hook & args]
@@ -4337,9 +4256,7 @@
nil)
(defn bundle/uninstall
``Remove a bundle from the current syspath. There is 1 hook called during
uninstallation (uninstall). A user can register a hook by defining a
function with the same name in the bundle script.``
"Remove a bundle from the current syspath"
[bundle-name]
(def breakage @{})
(each b (bundle/list)
@@ -4375,8 +4292,8 @@
order)
(defn bundle/prune
``Remove all orphaned bundles from the current syspath. An orphaned bundle is a
bundle that is marked for :auto-remove and is not depended on by any other bundle.``
"Remove all orphaned bundles from the syspath. An orphaned bundle is a bundle that is
marked for :auto-remove and is not depended on by any other bundle."
[]
(def topo (bundle/topolist))
(def rtopo (reverse topo))
@@ -4405,44 +4322,33 @@
(not (not (os/stat (bundle-dir bundle-name) :mode))))
(defn bundle/install
``Install a bundle from the local filesystem. The name of the bundle is
the value mapped to :name in either `config` or the info file. There are
5 hooks called during installation (postdeps, clean, build, install and
check). A user can register a hook by defining a function with the same name
in the bundle script.``
"Install a bundle from the local filesystem. The name of the bundle will be inferred from the bundle, or passed as a parameter :name in `config`."
[path &keys config]
(def path (bundle-rpath path))
(def s (sep))
# Detect bundle name
(def infofile-src1 (string path s "bundle" s "info.jdn"))
(def infofile-src2 (string path s "info.jdn"))
(def infofile-src (cond
(fexists infofile-src1) infofile-src1
(def infofile-src (cond (fexists infofile-src1) infofile-src1
(fexists infofile-src2) infofile-src2))
(def info (-?> infofile-src slurp parse))
(def bundle-name (get config :name (get info :name)))
(assertf bundle-name
"unable to infer bundle name for %v, use :name argument or add :name to info file" path)
(assertf bundle-name "unable to infer bundle name for %v, use :name argument" path)
(assertf (not (string/check-set "\\/" bundle-name))
"bundle name %v cannot contain path separators" bundle-name)
(assert (next bundle-name) "cannot use empty bundle-name")
(assertf (not (fexists (get-manifest-filename bundle-name)))
"bundle %v is already installed" bundle-name)
# Check bscript
(def bscript-src1 (string path s "bundle" s "init.janet"))
(def bscript-src2 (string path s "bundle.janet"))
(def bscript-src (cond
(fexists bscript-src1) bscript-src1
(fexists bscript-src2) bscript-src2))
# Setup installed paths
(prime-bundle-paths)
(os/mkdir (bundle-dir bundle-name))
# Copy aliased infofile
(when (fexists infofile-src2)
(copyfile infofile-src2 (bundle-file bundle-name "info.jdn")))
# Copy aliased bscript
(when (fexists bscript-src2)
(copyfile bscript-src2 (bundle-file bundle-name "init.janet")))
# Copy infofile
(def infofile-dest (bundle-file bundle-name "info.jdn"))
(when infofile-src (copyfile infofile-src infofile-dest))
# Copy aliased initfile
(def initfile-alias (string path s "bundle.janet"))
(def initfile-dest (bundle-file bundle-name "init.janet"))
(when (fexists initfile-alias) (copyfile initfile-alias initfile-dest))
# Copy some files into the new location unconditionally
(def implicit-sources (string path s "bundle"))
(when (= :directory (os/stat implicit-sources :mode))
@@ -4451,7 +4357,8 @@
(merge-into man config)
(sync-manifest man)
(edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name))
(when info
(when (os/stat infofile-dest :mode)
(def info (-> infofile-dest slurp parse))
(def deps (seq [d :in (get info :dependencies @[])]
(string (if (dictionary? d) (get d :name) d))))
(def missing (filter (complement bundle/installed?) deps))
@@ -4459,13 +4366,12 @@
(error (string "missing dependencies " (string/join missing ", "))))
(put man :dependencies deps)
(put man :info info))
(def module (get-bundle-module bundle-name))
(def clean (get config :clean))
(def check (get config :check))
(def module (get-bundle-module bundle-name))
(def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k)))
(put man :hooks all-hooks)
(do-hook module bundle-name :dependencies man) # deprecated, use :postdeps
(do-hook module bundle-name :postdeps man)
(do-hook module bundle-name :dependencies man)
(when clean
(do-hook module bundle-name :clean man))
(do-hook module bundle-name :build man)
@@ -4475,21 +4381,15 @@
(when check
(do-hook module bundle-name :check man)))
(print "installed " bundle-name)
(when (or (get man :has-exe)
# remove eventually
(get man :has-bin-script))
(when (get man :has-bin-script)
(def binpath (string (dyn *syspath*) s "bin"))
(eprintf "executable files have been installed to %s" binpath))
(when (get man :has-man)
(def manpath (string (dyn *syspath*) s "man"))
(eprintf "man pages have been installed to %s" manpath))
(eprintf "executable scripts have been installed to %s" binpath))
bundle-name)
(defn- bundle/pack
``Take an installed bundle and create a bundle source directory that can be
used to reinstall the bundle on a compatible system. This is used to create
backups for installed bundles without rebuilding, or make a prebuilt bundle
for other systems.``
"Take an installed bundle and create a bundle source directory that can be used to
reinstall the bundle on a compatible system. This is used to create backups for installed
bundles without rebuilding, or make a prebuilt bundle for other systems."
[bundle-name dest-dir &opt is-backup]
(var i 0)
(def man (bundle/manifest bundle-name))
@@ -4519,9 +4419,9 @@
dest-dir)
(defn bundle/replace
``Reinstall an existing bundle from a new directory. Similar to
bundle/reinstall, but installs the replacement bundle from any directory.
This is necessary to replace a package without breaking any dependencies.``
"Reinstall an existing bundle from a new directory. Similar to bundle/reinstall,
but installs the replacement bundle from any directory. This is necesarry to replace a package without
breaking any dependencies."
[bundle-name path &keys new-config]
(def manifest (bundle/manifest bundle-name))
(def config (get manifest :config @{}))
@@ -4548,7 +4448,7 @@
bundle-name)
(defn bundle/add-directory
"Add a directory during an install relative to `(dyn *syspath*)`."
"Add a directory during the install process relative to `(dyn *syspath*)`"
[manifest dest &opt chmod-mode]
(def files (get-files manifest))
(def s (sep))
@@ -4576,7 +4476,7 @@
ret)
(defn bundle/add-file
"Add a file during an install relative to `(dyn *syspath*)`."
"Add files during an install relative to `(dyn *syspath*)`"
[manifest src &opt dest chmod-mode]
(default dest src)
(def files (get-files manifest))
@@ -4593,9 +4493,9 @@
absdest)
(defn bundle/add
``Add a file or directory during an install relative to `(dyn *syspath*)`.
Added files and directories will be recorded in the bundle manifest such
that they are properly tracked and removed during an upgrade or uninstall.``
"Add files and directories during a bundle install relative to `(dyn *syspath*)`.
Added files and directories will be recorded in the bundle manifest such that they are properly tracked
and removed during an upgrade or uninstall."
[manifest src &opt dest chmod-mode]
(default dest src)
(def s (sep))
@@ -4610,31 +4510,20 @@
(errorf "bad path %s - file is a %s" src mode)))
(defn bundle/add-bin
``Add a file to the "bin" subdirectory of the current syspath. By default,
files will be set to be executable.``
[manifest src &opt filename chmod-mode]
``
Shorthand for adding scripts during an install. Scripts will be installed to
`(string (dyn *syspath*) "/bin")` by default and will be set to be executable.
``
[manifest src &opt dest chmod-mode]
(def s (sep))
(default filename (last (string/split s src)))
(default dest (last (string/split s src)))
(default chmod-mode 8r755)
(os/mkdir (string (dyn *syspath*) s "bin"))
(put manifest :has-exe true)
(put manifest :has-bin-script true) # remove eventually
(bundle/add-file manifest src (string "bin" s filename) chmod-mode))
(defn bundle/add-manpage
``Add a file to the man subdirectory of the current syspath. Files are
copied inside a directory `mansec`. By default, `mansec` is "man1".``
[manifest src &opt mansec]
(def s (sep))
(default mansec "man1")
(def filename (last (string/split s src)))
(os/mkdir (string (dyn *syspath*) s "man"))
(os/mkdir (string (dyn *syspath*) s "man" s mansec))
(put manifest :has-man true)
(bundle/add-file manifest src (string "man" s mansec s filename)))
(put manifest :has-bin-script true)
(bundle/add-file manifest src (string "bin" s dest) chmod-mode))
(defn bundle/update-all
"Reinstall all bundles."
"Reinstall all bundles"
[&keys configs]
(each bundle (bundle/topolist)
(bundle/reinstall bundle ;(kvs configs)))))
@@ -4646,10 +4535,7 @@
###
# conditional compilation for reduced os
(def- getenv-raw (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
(defn- getenv-alias [env-var &opt dflt]
(def x (getenv-raw env-var dflt))
(if (= x "") nil x)) # empty string is coerced to nil
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
(defn- run-main
[env subargs arg]
@@ -4706,17 +4592,6 @@
"-lint-warn" "w"
"-lint-error" "x"})
(defn- apply-color
[colorize]
(setdyn *pretty-format* (if colorize "%.20Q" "%.20q"))
(setdyn *err-color* (if colorize true))
(setdyn *doc-color* (if colorize true)))
(defn- getstdin [prompt buf _]
(file/write stdout prompt)
(file/flush stdout)
(file/read stdin :line buf))
(defn cli-main
`Entrance for the Janet CLI tool. Call this function with the command line
arguments as an array or tuple of strings to invoke the CLI interface.`
@@ -4730,7 +4605,11 @@
(var raw-stdin false)
(var handleopts true)
(var exit-on-error true)
(var colorize true)
(var debug-flag false)
(var compile-only false)
(var warn-level nil)
(var error-level nil)
(var expect-image false)
(when-let [jp (getenv-alias "JANET_PATH")]
@@ -4740,10 +4619,9 @@
(module/add-syspath (get paths i)))
(setdyn *syspath* (first paths)))
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
(apply-color
(and
(not (getenv-alias "NO_COLOR"))
(os/isatty stdout)))
(set colorize (and
(not (getenv-alias "NO_COLOR"))
(os/isatty stdout)))
(defn- get-lint-level
[i]
@@ -4793,8 +4671,8 @@
"q" (fn [&] (set quiet true) 1)
"i" (fn [&] (set expect-image true) 1)
"k" (fn [&] (set compile-only true) (set exit-on-error false) 1)
"n" (fn [&] (apply-color false) 1)
"N" (fn [&] (apply-color true) 1)
"n" (fn [&] (set colorize false) 1)
"N" (fn [&] (set colorize true) 1)
"m" (fn [i &] (setdyn *syspath* (in args (+ i 1))) 2)
"c" (fn c-switch [i &]
(def path (in args (+ i 1)))
@@ -4850,9 +4728,9 @@
(compif (dyn 'bundle/list)
(fn [i &] (each l (bundle/list) (print l)) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
(fn [i &] (eprint "--list not supported with reduced os") 1))
"d" (fn [&] (setdyn *debug* true) (setdyn *redef* true) 1)
"w" (fn [i &] (setdyn *lint-warn* (get-lint-level i)) 2)
"x" (fn [i &] (setdyn *lint-error* (get-lint-level i)) 2)
"d" (fn [&] (set debug-flag true) 1)
"w" (fn [i &] (set warn-level (get-lint-level i)) 2)
"x" (fn [i &] (set error-level (get-lint-level i)) 2)
"R" (fn [&] (setdyn *profilepath* nil) 1)})
(defn- dohandler [n i &]
@@ -4873,10 +4751,20 @@
(do
(def env (load-image (slurp arg)))
(put env *args* subargs)
(put env *lint-error* error-level)
(put env *lint-warn* warn-level)
(when debug-flag
(put env *debug* true)
(put env *redef* true))
(run-main env subargs arg))
(do
(def env (make-env))
(put env *args* subargs)
(put env *lint-error* error-level)
(put env *lint-warn* warn-level)
(when debug-flag
(put env *debug* true)
(put env *redef* true))
(if compile-only
(flycheck arg :exit exit-on-error :env env)
(do
@@ -4896,9 +4784,21 @@
(when-let [custom-prompt (get env *repl-prompt*)] (break (custom-prompt p)))
(def [line] (parser/where p))
(string "repl:" line ":" (parser/state p :delimiters) "> "))
(defn getstdin [prompt buf _]
(file/write stdout prompt)
(file/flush stdout)
(file/read stdin :line buf))
(when debug-flag
(put env *debug* true)
(put env *redef* true))
(def getter (if raw-stdin getstdin getline))
(defn getchunk [buf p]
(getter (getprompt p) buf env))
(setdyn *pretty-format* (if colorize "%.20Q" "%.20q"))
(setdyn *err-color* (if colorize true))
(setdyn *doc-color* (if colorize true))
(setdyn *lint-error* error-level)
(setdyn *lint-warn* error-level)
(when-let [profile.janet (dyn *profilepath*)]
(dofile profile.janet :exit true :env env)
(put env *current-file* nil))
@@ -4965,7 +4865,8 @@
"src/core/regalloc.h"
"src/core/compile.h"
"src/core/emit.h"
"src/core/symcache.h"])
"src/core/symcache.h"
"src/core/sysir.h"])
(def core-sources
["src/core/abstract.c"
@@ -5001,6 +4902,9 @@
"src/core/strtod.c"
"src/core/struct.c"
"src/core/symcache.c"
"src/core/sysir.c"
"src/core/sysir_c.c"
"src/core/sysir_x86.c"
"src/core/table.c"
"src/core/tuple.c"
"src/core/util.c"
@@ -5010,15 +4914,14 @@
"src/core/wrap.c"])
# Print janet.c to stdout
(def image-only (has-value? boot/args "image-only"))
(print "/* " (if image-only "Image-only" "Amalgamated") " build - DO NOT EDIT */")
(print "/* Amalgamated build - DO NOT EDIT */")
(print "/* Generated from janet version " janet/version "-" janet/build " */")
(print "#define JANET_BUILD \"" janet/build "\"")
(print ```#define JANET_AMALG```)
(defn do-one-file
[fname]
(unless image-only
(unless (has-value? boot/args "image-only")
(print "\n/* " fname " */")
(print "#line 0 \"" fname "\"\n")
(def source (slurp fname))

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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,9 +44,7 @@ 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");

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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];
snprintf(version_combined, sizeof(version_combined), "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
assert(!strcmp(JANET_VERSION, version_combined));
/* Reflexive testing and nanbox testing */
@@ -51,10 +51,6 @@ 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));

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 41
#define JANET_VERSION_MINOR 40
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.41.0-dev"
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.40.0"
/* #define JANET_BUILD "local" */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -164,7 +164,7 @@ void janet_os_mutex_lock(JanetOSMutex *mutex) {
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
if (ret) janet_panic("cannot release lock");
if (ret) janet_panicf("cannot release lock: %s", strerror(ret));
}
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
@@ -201,17 +201,4 @@ 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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,13 +567,6 @@ 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);
@@ -989,14 +982,6 @@ 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++) {
@@ -1047,7 +1032,6 @@ 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));
@@ -1064,7 +1048,6 @@ 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);
@@ -1084,8 +1067,6 @@ 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"
@@ -1095,7 +1076,6 @@ 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) {
@@ -1108,7 +1088,6 @@ 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, "constants")) return janet_disasm_constants(f->def);
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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,7 +74,6 @@ 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;
}
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -522,7 +522,6 @@ JanetFuncDef *janet_funcdef_alloc(void) {
def->bytecode_length = 0;
def->environments_length = 0;
def->symbolmap_length = 0;
def->named_args_count = 0;
return def;
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -460,7 +460,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_keyword(janet_vm.fiber->env, name);
return janet_table_get(janet_vm.fiber->env, janet_ckeywordv(name));
} else {
return janet_wrap_nil();
}
@@ -557,18 +557,6 @@ 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) {
@@ -576,8 +564,6 @@ 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
@@ -588,8 +574,6 @@ 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
@@ -598,8 +582,6 @@ 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
@@ -610,8 +592,6 @@ 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -98,22 +98,6 @@ void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
sp.sym2 = sym;
sp.slot = s;
sp.keep = 0;
sp.referenced = sym[0] == '_'; /* Fake ref if symbol is _ to avoid lints */
sp.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX;
janet_v_push(c->scope->syms, sp);
}
/* Same as janetc_nameslot, but don't have a lint for unused bindings. */
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
SymPair sp;
int32_t cnt = janet_v_count(c->buffer);
sp.sym = sym;
sp.sym2 = sym;
sp.slot = s;
sp.keep = 0;
sp.referenced = 1;
sp.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX;
@@ -186,10 +170,6 @@ 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) {
@@ -282,7 +262,6 @@ JanetSlot janetc_resolve(
pair = scope->syms + i;
if (pair->sym == sym) {
ret = pair->slot;
pair->referenced = 1;
goto found;
}
}
@@ -295,7 +274,7 @@ JanetSlot janetc_resolve(
{
JanetBinding binding = janet_resolve_ext(c->env, sym);
if (binding.type == JANET_BINDING_NONE) {
Janet handler = janet_table_get_keyword(c->env, "missing-symbol");
Janet handler = janet_table_get(c->env, janet_ckeywordv("missing-symbol"));
switch (janet_type(handler)) {
case JANET_NIL:
break;
@@ -367,7 +346,6 @@ 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");
@@ -459,22 +437,11 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
const JanetKV *kvs = NULL;
int32_t cap = 0, len = 0;
janet_dictionary_view(ds, &kvs, &len, &cap);
/* 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;
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));
}
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;
}
@@ -547,9 +514,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, "unused");
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
janetc_value(opts, x);
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.4q", x);
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.2q", x);
janetc_popscope(c);
if (c->buffer) {
janet_v__cnt(c->buffer) = bufstart;
@@ -559,7 +526,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
}
/* Compile a call or tailcall instruction */
static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun, const Janet *form) {
static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
JanetSlot retslot;
JanetCompiler *c = opts.compiler;
int specialized = 0;
@@ -585,8 +552,6 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun, c
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;
@@ -610,47 +575,6 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun, c
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;
@@ -885,16 +809,14 @@ 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, tup);
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head);
janetc_freeslot(c, head);
}
ret.flags &= ~JANET_SLOT_SPLICED;
}
break;
/* Data Constructors */
case JANET_SYMBOL:
ret = janetc_resolve(c, janet_unwrap_symbol(x));
break;
@@ -934,21 +856,19 @@ 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->named_args_count) set_flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
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;
/* 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->named_args_count) unset_flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
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;
/* Update flags */
def->flags |= set_flags;
def->flags &= ~unset_flags;
@@ -1019,9 +939,8 @@ 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 && slotchunks > 7) chunks[7] &= 0xFFFFU;
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
def->closure_bitset = chunks;
}
@@ -1055,10 +974,6 @@ 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 {
@@ -1167,7 +1082,6 @@ 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;
@@ -1213,4 +1127,5 @@ void janet_lib_compile(JanetTable *env) {
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, cfuns);
janet_lib_sysir(env);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -114,7 +114,6 @@ 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;
@@ -223,7 +222,6 @@ const JanetSpecial *janetc_special(const uint8_t *name);
void janetc_freeslot(JanetCompiler *c, JanetSlot s);
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
JanetSlot janetc_farslot(JanetCompiler *c);
/* Throw away some code after checking that it is well formed. */
@@ -270,6 +268,9 @@ JanetSlot janetc_cslot(Janet x);
/* Search for a symbol */
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
/* Load the system dialect IR */
void janet_lib_sysir(JanetTable *env);
/* Bytecode optimization */
void janet_bytecode_movopt(JanetFuncDef *def);
void janet_bytecode_remove_noops(JanetFuncDef *def);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -746,9 +746,7 @@ 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},
{"ffi", JANET_SANDBOX_FFI},
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
@@ -766,8 +764,6 @@ 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}
};
@@ -776,9 +772,7 @@ 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"
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
@@ -795,9 +789,7 @@ 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\n"
"* :threads - disallow spawning threads with `ev/thread`. Certain helper threads may still be spawned.\n"
"* :unmarshal - disallow calling the unmarshal function.\n") {
"* :subprocess - disallow running subprocesses") {
uint32_t flags = 0;
for (int32_t i = 0; i < argc; i++) {
JanetKeyword kw = janet_getkeyword(argv, i);
@@ -1005,11 +997,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[] = {
@@ -1162,82 +1154,82 @@ 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."));
"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."));
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."));
"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."));
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."));
"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."));
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."));
"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."));
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."));
"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."));
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."));
@@ -1246,74 +1238,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. If xs is empty, return 0."));
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
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 x in xs must be an integer."));
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
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),
@@ -1322,7 +1314,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),
@@ -1362,16 +1354,12 @@ 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);
/* 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);
}
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);
}
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -539,9 +539,6 @@ void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig) {
}
void janet_cancel(JanetFiber *fiber, Janet value) {
if (!(fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
janet_panic("cannot cancel non-task fiber");
}
janet_schedule_signal(fiber, value, JANET_SIGNAL_ERROR);
}
@@ -702,7 +699,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 (DWORD i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) {
for (size_t i = 1; res == WAIT_TIMEOUT && (wait_end - wait_begin) < duration; i++) {
res = WaitForSingleObject(tto.cancel_event, (duration + i));
wait_end = ts_now();
}
@@ -1085,7 +1082,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,
@@ -1272,13 +1269,11 @@ 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);
}
}
@@ -1381,7 +1376,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) && writer.sched_id == writer.fiber->sched_id) {
if (janet_fiber_can_resume(writer.fiber)) {
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
janet_schedule(writer.fiber, make_close_result(channel));
} else {
@@ -1404,7 +1399,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) && reader.sched_id == reader.fiber->sched_id) {
if (janet_fiber_can_resume(reader.fiber)) {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
janet_schedule(reader.fiber, make_close_result(channel));
} else {
@@ -2416,7 +2411,7 @@ Janet janet_ev_lasterr(void) {
msgbuf,
sizeof(msgbuf),
NULL);
if (!*msgbuf) snprintf(msgbuf, sizeof(msgbuf), "%d", code);
if (!*msgbuf) sprintf(msgbuf, "%d", code);
char *c = msgbuf;
while (*c) {
if (*c == '\n' || *c == '\r') {
@@ -3007,14 +3002,12 @@ 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. "
"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.") {
"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.") {
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);
@@ -3040,9 +3033,6 @@ 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);
@@ -3178,7 +3168,6 @@ 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);
@@ -3327,8 +3316,7 @@ JANET_CORE_FN(cfun_ev_deadline,
JANET_CORE_FN(cfun_ev_cancel,
"(ev/cancel fiber err)",
"Cancel a suspended task fiber in the event loop. Differs from "
"`cancel` in that it returns the canceled fiber immediately.") {
"Cancel a suspended 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];
@@ -3561,7 +3549,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 task fibers that are being used by the scheduler.") {
"Get an array of all active fibers that are being used by the scheduler.") {
janet_fixarity(argc, 0);
(void) argv;
JanetArray *array = janet_array(janet_vm.active_tasks.count);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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,15 +1344,6 @@ 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;
@@ -1502,10 +1493,6 @@ 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -610,9 +610,8 @@ 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. Note that a root fiber "
"is also a task fiber.") {
"Returns the current root fiber. The root fiber is the oldest ancestor "
"that does not have a parent.") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_fiber(janet_vm.root_fiber);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -521,23 +521,23 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
(void) watcher;
(void) flags;
(void) path;
janet_panic("filewatch not supported on this platform");
janet_panic("nyi");
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
(void) watcher;
(void) path;
janet_panic("filewatch not supported on this platform");
janet_panic("nyi");
}
static void janet_watcher_listen(JanetWatcher *watcher) {
(void) watcher;
janet_panic("filewatch not supported on this platform");
janet_panic("nyi");
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
(void) watcher;
janet_panic("filewatch not supported on this platform");
janet_panic("nyi");
}
#endif
@@ -573,7 +573,7 @@ static const JanetAbstractType janet_filewatch_at = {
};
JANET_CORE_FN(cfun_filewatch_make,
"(filewatch/new channel & default-flags)",
"(filewatch/new channel &opt default-flags)",
"Create a new filewatcher that will give events to a channel channel. See `filewatch/add` for available flags.\n\n"
"When an event is triggered by the filewatcher, a struct containing information will be given to channel as with `ev/give`. "
"The contents of the channel depend on the OS, but will contain some common keys:\n\n"
@@ -597,7 +597,7 @@ JANET_CORE_FN(cfun_filewatch_make,
}
JANET_CORE_FN(cfun_filewatch_add,
"(filewatch/add watcher path flag & more-flags)",
"(filewatch/add watcher path &opt flags)",
"Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
"Windows/MINGW (flags correspond to `FILE_NOTIFY_CHANGE_*` flags in win32 documentation):\n\n"
"* `:all` - trigger an event for all of the below triggers.\n\n"

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -132,7 +132,7 @@ static void janet_mark_many(const Janet *values, int32_t n) {
}
}
/* Mark a bunch of key values items in memory */
/* Mark only the keys from a sequence of key-value pairs */
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
@@ -141,7 +141,7 @@ static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
}
}
/* Mark a bunch of key values items in memory */
/* Mark only the values from a sequence of key-value pairs */
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
@@ -150,7 +150,7 @@ static void janet_mark_values(const JanetKV *kvs, int32_t n) {
}
}
/* Mark a bunch of key values items in memory */
/* Mark key-value pairs */
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
@@ -504,7 +504,14 @@ void janet_sweep() {
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
janet_abstract_decref_maybe_free(abst);
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));
}
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
@@ -675,7 +682,12 @@ void janet_clear_memory(void) {
if (head->type->gcperthread) {
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
}
janet_abstract_decref_maybe_free(abst);
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));
}
}
}
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose & contributors
* Copyright (c) 2025 Calvin Rose & contributors
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -113,7 +113,7 @@ static void *makef(FILE *f, int32_t flags) {
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
iof->file = f;
iof->flags = flags;
#if !(defined(JANET_WINDOWS) || defined(JANET_PLAN9))
#ifndef JANET_WINDOWS
/* 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))
@@ -165,7 +165,7 @@ JANET_CORE_FN(cfun_io_fopen,
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
if (f != NULL) {
#if !(defined(JANET_WINDOWS) || defined(JANET_PLAN9))
#ifndef JANET_WINDOWS
struct stat st;
fstat(fileno(f), &st);
if (S_ISDIR(st.st_mode)) {
@@ -249,9 +249,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 `f`. Each value of `bytes` must be a "
"string, buffer, symbol, or keyword. Returns the file.") {
"(file/write f bytes)",
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
"file.") {
janet_arity(argc, 1, -1);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
@@ -721,15 +721,8 @@ 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);
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);
}
Janet x = janet_dyn(name);
JanetType xtype = janet_type(x);
switch (xtype) {
default:
/* Other values simply do nothing */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -276,8 +276,6 @@ 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)
@@ -916,7 +914,6 @@ 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 */
@@ -936,8 +933,6 @@ 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)
@@ -1698,7 +1693,6 @@ 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;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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,30 +271,28 @@ 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) {\
@@ -307,9 +305,7 @@ 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);
@@ -390,17 +386,7 @@ 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),
@@ -408,6 +394,8 @@ 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),
@@ -417,8 +405,14 @@ 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),
@@ -441,9 +435,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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose and contributors.
* Copyright (c) 2025 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,25 +120,6 @@ 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 */
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
@@ -570,16 +551,15 @@ 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);
/* 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);
@@ -592,19 +572,10 @@ JANET_CORE_FN(cfun_net_connect,
}
#endif
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);
}
if (status) {
#ifdef JANET_WINDOWS
if (status == SOCKET_ERROR) {
if (err != WSAEWOULDBLOCK) {
#else
if (status == -1) {
if (err != EINPROGRESS) {
#endif
JSOCKCLOSE(sock);
@@ -617,11 +588,10 @@ JANET_CORE_FN(cfun_net_connect,
}
JANET_CORE_FN(cfun_net_socket,
"(net/socket &opt type address-family)",
"(net/socket &opt type)",
"Creates a new unbound socket. Type is an optional keyword, "
"either a :stream (usually tcp), or :datagram (usually udp). The default is :stream. "
"`address-family` should be one of :ipv4 or :ipv6.") {
janet_arity(argc, 0, 2);
"either a :stream (usually tcp), or :datagram (usually udp). The default is :stream.") {
janet_arity(argc, 0, 1);
int socktype = janet_get_sockettype(argv, argc, 0);
@@ -632,14 +602,7 @@ 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));
@@ -1058,6 +1021,7 @@ struct sockopt_type {
/* List of supported socket options; The type JANET_POINTER is used
* for options that require special handling depending on the type. */
static const struct sockopt_type sockopt_type_list[] = {
{ "tcp-nodelay", IPPROTO_TCP, TCP_NODELAY, JANET_BOOLEAN },
{ "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
{ "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
{ "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
@@ -1067,8 +1031,6 @@ 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 }
};
@@ -1081,14 +1043,12 @@ JANET_CORE_FN(cfun_net_setsockopt,
"- :so-broadcast boolean\n"
"- :so-reuseaddr boolean\n"
"- :so-keepalive boolean\n"
"- :tcp-nodelay boolean\n"
"- :ip-multicast-ttl number\n"
"- :ip-add-membership string\n"
"- :ip-drop-membership string\n"
"- :ipv6-join-group string\n"
"- :ipv6-leave-group string\n"
"- :ipv6-multicast-hops number\n"
"- :ipv6-unicast-hops number\n"
) {
"- :ipv6-leave-group string\n") {
janet_arity(argc, 3, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_SOCKET);
@@ -1107,7 +1067,6 @@ JANET_CORE_FN(cfun_net_setsockopt,
}
union {
unsigned char v_uchar;
int v_int;
struct ip_mreq v_mreq;
#ifndef JANET_NO_IPV6
@@ -1122,19 +1081,8 @@ JANET_CORE_FN(cfun_net_setsockopt,
val.v_int = janet_getboolean(argv, 2);
optlen = sizeof(val.v_int);
} else if (st->type == JANET_NUMBER) {
#ifdef JANET_BSD
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);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose and contributors.
* Copyright (c) 2025 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
@@ -57,9 +57,7 @@
#include <process.h>
#define JANET_SPAWN_CHDIR
#else
#ifndef JANET_PLAN9
#include <spawn.h>
#endif
#include <utime.h>
#include <unistd.h>
#include <dirent.h>
@@ -70,7 +68,7 @@
#define environ (*_NSGetEnviron())
#include <AvailabilityMacros.h>
int chroot(const char *dirname);
#elif !defined(JANET_PLAN9)
#else
extern char **environ;
#endif
#ifdef JANET_THREADS
@@ -142,8 +140,8 @@ static void janet_unlock_environ(void) {
#define janet_stringify(x) janet_stringify1(x)
JANET_CORE_FN(os_which,
"(os/which &opt test)",
"Check the current operating system. If `test` is nil or unset, Returns one of:\n\n"
"(os/which)",
"Check the current operating system. Returns one of:\n\n"
"* :windows\n\n"
"* :mingw\n\n"
"* :cygwin\n\n"
@@ -156,12 +154,9 @@ JANET_CORE_FN(os_which,
"* :dragonfly\n\n"
"* :bsd\n\n"
"* :posix - A POSIX compatible system (default)\n\n"
"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)));
}
"May also return a custom keyword specified at build time.") {
janet_fixarity(argc, 0);
(void) argv;
#if defined(JANET_OS_NAME)
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
#elif defined(JANET_MINGW)
@@ -249,7 +244,6 @@ 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;
@@ -259,8 +253,6 @@ 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
@@ -299,43 +291,46 @@ 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);
(void) argv; /* Prevent unused argument warning */
Janet dflt = argc > 0 ? argv[0] : janet_wrap_nil();
#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 argc > 0 ? argv[0] : janet_wrap_nil();
return dflt;
}
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 argc > 0 ? argv[0] : janet_wrap_nil();
return dflt;
}
return janet_wrap_integer(result);
#elif defined(JANET_ILLUMOS)
(void) dflt;
long result = sysconf(_SC_NPROCESSORS_CONF);
if (result < 0) {
return argc > 0 ? argv[0] : janet_wrap_nil();
return dflt;
}
return janet_wrap_integer(result);
#elif defined(JANET_PLAN9)
return janet_wrap_integer(atoi(getenv("NPROC")));
#else
return argc > 0 ? argv[0] : janet_wrap_nil();
return dflt;
#endif
}
@@ -365,8 +360,6 @@ 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);
@@ -1214,7 +1207,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 (janet_keyeq(maybe_stderr, "out")) {
} else if (is_spawn && 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);
@@ -1300,7 +1293,6 @@ 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 */
@@ -1312,7 +1304,6 @@ 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);
@@ -1322,25 +1313,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
os_execute_cleanup(envp, NULL);
if (cp_failed) {
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), "%d", 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));
janet_panic("failed to create process");
}
pHandle = processInfo.hProcess;
@@ -1366,9 +1339,6 @@ 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;
}
@@ -1379,11 +1349,9 @@ 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 */
@@ -1452,8 +1420,6 @@ 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
@@ -1491,7 +1457,6 @@ 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,
@@ -1552,7 +1517,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 and Plan 9 only).") {
"Not supported on all systems (POSIX only).") {
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
janet_fixarity(argc, 0);
(void) argv;
@@ -1560,13 +1525,9 @@ 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));
}
@@ -1587,9 +1548,8 @@ JANET_CORE_FN(os_posix_chroot,
"Not supported on all systems (POSIX only).") {
janet_sandbox_assert(JANET_SANDBOX_CHROOT);
janet_fixarity(argc, 1);
#if defined(JANET_WINDOWS) || defined(JANET_PLAN9)
(void) argv;
janet_panic("not supported on Windows or Plan 9");
#ifdef JANET_WINDOWS
janet_panic("not supported on Windows");
#else
const char *root = janet_getcstring(argv, 0);
int result;
@@ -1638,7 +1598,6 @@ 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.") {
@@ -1670,7 +1629,6 @@ JANET_CORE_FN(os_environ,
janet_unlock_environ();
return janet_wrap_table(t);
}
#endif
JANET_CORE_FN(os_getenv,
"(os/getenv variable &opt dflt)",
@@ -1695,9 +1653,6 @@ 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)
@@ -1870,8 +1825,6 @@ 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);
@@ -1881,8 +1834,6 @@ 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
@@ -1893,8 +1844,9 @@ 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. Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
"the local timezone.\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"
@@ -1903,9 +1855,7 @@ 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\n\n"
"You can set local timezone by setting TZ environment variable. "
"See tzset(<time.h>) or _tzset(<time.h>) for further details.") {
"* :dst - if Day Light Savings is in effect") {
janet_arity(argc, 0, 2);
(void) argv;
struct tm t_infos;
@@ -1923,15 +1873,14 @@ 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. You can set local timezone by setting TZ environment variable. "
"See tzset(<time.h>) or _tzset(<time.h>) for further details.") {
"the local timezone.") {
janet_arity(argc, 1, 3);
const char *fmt = janet_getcstring(argv, 0);
/* ANSI X3.159-1989, section 4.12.3.5 "The strftime function" */
@@ -1939,9 +1888,6 @@ 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);
}
@@ -1951,7 +1897,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, sizeof(buf), fmt, t_info);
(void)strftime(buf, SIZETIMEFMT, fmt, t_info);
return janet_cstringv(buf);
}
@@ -1959,7 +1905,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_keyword(entry, "dst");
v = janet_table_get(entry, janet_ckeywordv("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"));
@@ -1983,7 +1929,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_keyword(entry, field);
i = janet_table_get(entry, janet_ckeywordv(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));
@@ -2062,7 +2008,6 @@ 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. "
@@ -2099,20 +2044,19 @@ 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 or Plan 9.") {
"creates a hard link. Does not work on Windows.") {
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
janet_arity(argc, 2, 3);
#if defined(JANET_WINDOWS) || defined(JANET_PLAN9)
#ifdef JANET_WINDOWS
(void) argc;
(void) argv;
janet_panic("not supported on Windows or Plan 9");
janet_panic("not supported on Windows");
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
@@ -2127,10 +2071,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);
#if defined(JANET_WINDOWS) || defined(JANET_PLAN9)
#ifdef JANET_WINDOWS
(void) argc;
(void) argv;
janet_panic("not supported on Windows or Plan 9");
janet_panic("not supported on Windows");
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
@@ -2168,8 +2112,6 @@ 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
@@ -2296,13 +2238,11 @@ 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);
}
@@ -2467,9 +2407,6 @@ 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) {
@@ -2530,13 +2467,9 @@ 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."
"Unsupported on plan9.") {
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") {
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));
@@ -2545,7 +2478,6 @@ 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
@@ -2644,15 +2576,7 @@ 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
}
@@ -2696,11 +2620,10 @@ 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"
@@ -2710,24 +2633,19 @@ 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 fileFlags = FILE_FLAG_OVERLAPPED;
DWORD fileAttributes = 0;
DWORD flagsAndAttributes = FILE_FLAG_OVERLAPPED;
/* We map unix-like open flags to the creationDisp parameter */
int creatUnix = 0;
#define OCREAT 1
@@ -2747,11 +2665,6 @@ 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);
@@ -2774,29 +2687,22 @@ JANET_CORE_FN(os_open,
shareMode |= FILE_SHARE_WRITE;
break;
case 'H':
fileAttributes |= FILE_ATTRIBUTE_HIDDEN;
flagsAndAttributes |= FILE_ATTRIBUTE_HIDDEN;
break;
case 'O':
fileAttributes |= FILE_ATTRIBUTE_READONLY;
flagsAndAttributes |= FILE_ATTRIBUTE_READONLY;
break;
case 'F':
fileAttributes |= FILE_ATTRIBUTE_OFFLINE;
flagsAndAttributes |= FILE_ATTRIBUTE_OFFLINE;
break;
case 'T':
fileAttributes |= FILE_ATTRIBUTE_TEMPORARY;
flagsAndAttributes |= FILE_ATTRIBUTE_TEMPORARY;
break;
case 'd':
fileFlags |= FILE_FLAG_DELETE_ON_CLOSE;
flagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE;
break;
case 'b':
fileFlags |= FILE_FLAG_NO_BUFFERING;
break;
case 'I':
inherited_handle = 1;
break;
case 'V':
fileFlags &= ~FILE_FLAG_OVERLAPPED;
disable_stream_mode = 1;
flagsAndAttributes |= FILE_FLAG_NO_BUFFERING;
break;
/* we could potentially add more here -
* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
@@ -2822,16 +2728,7 @@ JANET_CORE_FN(os_open,
creationDisp = TRUNCATE_EXISTING;
break;
}
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);
fd = CreateFileA(path, desiredAccess, shareMode, NULL, creationDisp, flagsAndAttributes, NULL);
if (fd == INVALID_HANDLE_VALUE) janet_panicv(janet_ev_lasterr());
#else
int open_flags = O_NONBLOCK;
@@ -2875,10 +2772,6 @@ 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 */
@@ -2895,7 +2788,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, disable_stream_mode ? 0 : stream_flags, NULL));
return janet_wrap_abstract(janet_stream(fd, stream_flags, NULL));
}
JANET_CORE_FN(os_pipe,
@@ -2963,14 +2856,10 @@ 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),
@@ -2982,6 +2871,7 @@ 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
@@ -3006,7 +2896,6 @@ 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),

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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,6 +105,15 @@ 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) \

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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,41 +194,6 @@ 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;
@@ -657,7 +622,6 @@ tail:
}
case RULE_REPLACE:
case RULE_MATCHSPLICE:
case RULE_MATCHTIME: {
uint32_t tag = rule[3];
int oldmode = s->mode;
@@ -698,17 +662,8 @@ tail:
break;
}
cap_load_keept(s, cs);
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);
}
if (rule[0] == RULE_MATCHTIME && !janet_truthy(cap)) return NULL;
pushcap(s, cap, tag);
return result;
}
@@ -1280,14 +1235,6 @@ 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);
@@ -1297,7 +1244,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_impl(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 2, 3);
Reserve r = reserve(b, 4);
uint32_t subrule = peg_compile1(b, argv[0]);
@@ -1308,15 +1255,7 @@ static void spec_matchtime_impl(Builder *b, int32_t argc, const Janet *argv, uin
}
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
uint32_t cindex = emit_constant(b, fun);
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);
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
}
static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
@@ -1392,7 +1331,6 @@ static const SpecialPair peg_specials[] = {
{"<-", spec_capture},
{">", spec_look},
{"?", spec_opt},
{"??", spec_debug},
{"accumulate", spec_accumulate},
{"any", spec_any},
{"argument", spec_argument},
@@ -1403,11 +1341,9 @@ 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},
@@ -1661,7 +1597,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
* referenced (0x01) or is in a main bytecode position
* reference (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
@@ -1684,10 +1620,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
case RULE_LITERAL:
i += 2 + ((rule[1] + 3) >> 2);
break;
case RULE_DEBUG:
/* [0 words] */
i += 1;
break;
case RULE_NCHAR:
case RULE_NOTNCHAR:
case RULE_RANGE:
@@ -1771,7 +1703,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
break;
case RULE_REPLACE:
case RULE_MATCHTIME:
case RULE_MATCHSPLICE:
/* [rule, constant, tag] */
if (rule[1] >= blen) goto bad;
if (rule[2] >= clen) goto bad;
@@ -1903,8 +1834,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. `(dyn :peg-grammar)` replaces "
"`default-peg-grammar` for the grammar of the peg.") {
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement "
"the grammar of the peg for otherwise undefined peg keywords.") {
janet_fixarity(argc, 1);
JanetPeg *peg = compile_peg(argv[0]);
return janet_wrap_abstract(peg);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -487,7 +487,6 @@ static const char *janet_pretty_colors[] = {
#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 */
@@ -626,78 +625,55 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "...");
} else {
int32_t len = 0, cap = 0;
int32_t i = 0, 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;
/* 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;
}
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, len < JANET_PRETTY_DICT_ONELINE);
janet_pretty_one(S, kvs[j].key, 0);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[j].value, 1);
j++;
}
if (truncated) {
print_newline(S, 0);
janet_buffer_push_cstring(S->buffer, "...");
}
} else {
/* Sorted keys dictionaries */
/* 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;
}
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;
}
}
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, 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 (truncated) {
print_newline(S, 0);
janet_buffer_push_cstring(S->buffer, "...");
}
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);
}
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
if (NULL == S->keysort_buffer) {
JANET_OUT_OF_MEMORY;
}
}
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 (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 (truncated) {
print_newline(S, 0);
janet_buffer_push_cstring(S->buffer, "...");
}
S->keysort_start = ks_start;
}
S->indent -= 2;
@@ -921,7 +897,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')
@@ -1047,20 +1023,10 @@ 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 */
#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");
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));

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -307,14 +307,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;
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>";
if (argn < 2) {
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
return NULL;
}
for (i = 1; i < argn - 1; i++) {
Janet attr = argv[i];
switch (janet_type(attr)) {
@@ -362,23 +362,6 @@ 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;
@@ -386,7 +369,7 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
break;
}
}
if (!found_amp && !found_splice) {
if (!found_amp) {
for (int32_t i = 0; i < view_lhs.len; i++) {
Janet sub_rhs = view_rhs.len <= i ? janet_wrap_nil() : view_rhs.items[i];
into = dohead_destructure(c, into, subopts, view_lhs.items[i], sub_rhs);
@@ -404,7 +387,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, int no_unused) {
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret) {
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
ret.index > 0 &&
ret.envindex >= 0;
@@ -425,11 +408,7 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
ret = localslot;
}
ret.flags |= flags;
if ((c->scope->flags & JANET_SCOPE_TOP) || no_unused) {
janetc_nameslot_no_unused(c, head, ret);
} else {
janetc_nameslot(c, head, ret);
}
janetc_nameslot(c, head, ret);
return !isUnnamedRegister;
}
@@ -443,7 +422,8 @@ static int varleaf(
JanetSlot refslot;
JanetTable *entry = janet_table_clone(reftab);
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
Janet redef_kw = janet_ckeywordv("redef");
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
JanetArray *ref;
JanetBinding old_binding;
@@ -463,17 +443,7 @@ static int varleaf(
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
return 1;
} else {
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused"));
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, no_unused);
}
}
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");
}
return namelocal(c, sym, JANET_SLOT_MUTABLE, s);
}
}
@@ -483,7 +453,6 @@ 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) {
@@ -510,8 +479,9 @@ static int defleaf(
janet_table_put(entry, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c)));
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
if (is_redef) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
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());
if (is_redef) {
JanetBinding binding = janet_resolve_ext(c->env, sym);
@@ -534,8 +504,7 @@ static int defleaf(
/* Add env entry to env */
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
}
int no_unused = tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "unused"));
return namelocal(c, sym, 0, s, no_unused);
return namelocal(c, sym, 0, s);
}
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -544,7 +513,6 @@ 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]);
@@ -684,10 +652,8 @@ 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);
if (labeljr < labeld) {
c->buffer[labeljr] |= (labelr - labeljr) << 16;
if (!tail && labeljd < labeld) c->buffer[labeljd] |= (labeld - labeljd) << 8;
}
c->buffer[labeljr] |= (labelr - labeljr) << 16;
if (!tail) c->buffer[labeljd] |= (labeld - labeljd) << 8;
if (tail) target.flags |= JANET_SLOT_RETURNED;
return target;
@@ -1076,14 +1042,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
}
}
/* 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++) {
@@ -1097,6 +1055,14 @@ 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;
@@ -1118,7 +1084,7 @@ 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_no_unused(c, sym, slot);
janetc_nameslot(c, sym, slot);
}
}
@@ -1139,12 +1105,8 @@ 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);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

1915
src/core/sysir.c Normal file

File diff suppressed because it is too large Load Diff

337
src/core/sysir.h Normal file
View File

@@ -0,0 +1,337 @@
/*
* Copyright (c) 2024 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
/****
* The System Dialect Intermediate Representation (sysir) is a compiler intermediate representation
* that for "System Janet" a dialect for "System Programming". Sysir can then be retargeted to C or direct to machine
* code for JIT or AOT compilation.
*/
/* TODO
* [x] encode constants directly in 3 address codes - makes codegen easier
* [x] typed constants
* [x] named registers and types
* [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top)
* [-] x86/x64 machine code target - in progress
* [ ] handle floating point types
* [ ] handle array types
* [ ] emit machine code directly
* [ ] target specific extensions - custom instructions and custom primitives
* [ ] better casting semantics
* [x] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)?
* [x] fixed-size array types
* [x] recursive pointer types
* [ ] global and thread local state
* [x] union types?
* [x] incremental compilation - save type definitions for later
* [ ] Extension to C target for interfacing with Janet
* [x] pointer math, pointer types
* [x] composite types - support for load, store, move, and function args.
* [x] Have some mechanism for field access (dest = src.offset)
* [x] Related, move type creation as opcodes like in SPIRV - have separate virtual "type slots" and value slots for this.
* [x] support for stack allocation of arrays
* [ ] more math intrinsics
* [x] source mapping (using built in Janet source mapping metadata on tuples)
* [x] unit type or void type
* [ ] (typed) function pointer types and remove calling untyped pointers
* [x] APL array semantics for binary operands (maybe?)
* [ ] a few built-in array combinators (maybe?)
* [ ] multiple error messages in one pass
* [ ] better verification of constants
* [x] don't allow redefining types
* [ ] generate elf/mach-o/pe directly
* [ ] elf
* [ ] mach-o
* [ ] pe
* [ ] generate dwarf info
*/
#ifndef JANET_SYSIR_H
#define JANET_SYSIR_H
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#endif
typedef enum {
JANET_PRIM_U8,
JANET_PRIM_S8,
JANET_PRIM_U16,
JANET_PRIM_S16,
JANET_PRIM_U32,
JANET_PRIM_S32,
JANET_PRIM_U64,
JANET_PRIM_S64,
JANET_PRIM_F32,
JANET_PRIM_F64,
JANET_PRIM_POINTER,
JANET_PRIM_BOOLEAN,
JANET_PRIM_STRUCT,
JANET_PRIM_UNION,
JANET_PRIM_ARRAY,
JANET_PRIM_VOID,
JANET_PRIM_UNKNOWN
} JanetPrim;
typedef struct {
const char *name;
JanetPrim prim;
} JanetPrimName;
typedef enum {
JANET_SYSOP_LINK_NAME,
JANET_SYSOP_PARAMETER_COUNT,
JANET_SYSOP_CALLING_CONVENTION,
JANET_SYSOP_MOVE,
JANET_SYSOP_CAST,
JANET_SYSOP_ADD,
JANET_SYSOP_SUBTRACT,
JANET_SYSOP_MULTIPLY,
JANET_SYSOP_DIVIDE,
JANET_SYSOP_BAND,
JANET_SYSOP_BOR,
JANET_SYSOP_BXOR,
JANET_SYSOP_BNOT,
JANET_SYSOP_SHL,
JANET_SYSOP_SHR,
JANET_SYSOP_LOAD,
JANET_SYSOP_STORE,
JANET_SYSOP_GT,
JANET_SYSOP_LT,
JANET_SYSOP_EQ,
JANET_SYSOP_NEQ,
JANET_SYSOP_GTE,
JANET_SYSOP_LTE,
JANET_SYSOP_CALL,
JANET_SYSOP_SYSCALL,
JANET_SYSOP_RETURN,
JANET_SYSOP_JUMP,
JANET_SYSOP_BRANCH,
JANET_SYSOP_BRANCH_NOT,
JANET_SYSOP_ADDRESS,
JANET_SYSOP_TYPE_PRIMITIVE,
JANET_SYSOP_TYPE_STRUCT,
JANET_SYSOP_TYPE_BIND,
JANET_SYSOP_ARG,
JANET_SYSOP_FIELD_GETP,
JANET_SYSOP_ARRAY_GETP,
JANET_SYSOP_ARRAY_PGETP,
JANET_SYSOP_TYPE_POINTER,
JANET_SYSOP_TYPE_ARRAY,
JANET_SYSOP_TYPE_UNION,
JANET_SYSOP_POINTER_ADD,
JANET_SYSOP_POINTER_SUBTRACT,
JANET_SYSOP_LABEL
} JanetSysOp;
typedef struct {
JanetPrim prim;
union {
struct {
uint32_t field_count;
uint32_t field_start;
} st;
struct {
uint32_t type;
} pointer;
struct {
uint32_t type;
uint64_t fixed_count;
} array;
};
} JanetSysTypeInfo;
typedef struct {
uint32_t type;
} JanetSysTypeField;
#define JANET_SYS_CALLFLAG_HAS_DEST 1
#define JANET_SYS_CALLFLAG_VARARGS 2
/* Allow read arguments to be constants to allow
* encoding immediates. This makes codegen easier. */
#define JANET_SYS_MAX_OPERAND 0x7FFFFFFFU
#define JANET_SYS_CONSTANT_PREFIX 0x80000000U
typedef enum {
JANET_SYS_CC_DEFAULT, /* Reasonable default - maps to a specific cc based on target */
JANET_SYS_CC_SYSCALL, /* Reasonable default for platform syscalls - maps to a specific cc based on target */
JANET_SYS_CC_X86_CDECL,
JANET_SYS_CC_X86_STDCALL,
JANET_SYS_CC_X86_FASTCALL,
JANET_SYS_CC_X64_SYSV,
JANET_SYS_CC_X64_SYSV_SYSCALL,
JANET_SYS_CC_X64_WINDOWS,
} JanetSysCallingConvention;
typedef enum {
JANET_SYS_TARGET_X64_WINDOWS, /* 64 bit, modern windows */
JANET_SYS_TARGET_X64_LINUX, /* x64 linux with recent kernel */
} JanetSysTarget;
typedef struct {
JanetSysOp opcode;
union {
struct {
uint32_t dest;
uint32_t lhs;
uint32_t rhs;
} three;
struct {
uint32_t dest;
uint32_t callee;
uint32_t arg_count;
uint8_t flags;
JanetSysCallingConvention calling_convention;
} call;
struct {
uint32_t dest;
uint32_t src;
} two;
struct {
uint32_t src;
} one;
struct {
uint32_t to;
} jump;
struct {
uint32_t cond;
uint32_t to;
} branch;
struct {
uint32_t dest_type;
uint32_t prim;
} type_prim;
struct {
uint32_t dest_type;
uint32_t arg_count;
} type_types;
struct {
uint32_t dest;
uint32_t type;
} type_bind;
struct {
uint32_t args[3];
} arg;
struct {
uint32_t r;
uint32_t st;
uint32_t field;
} field;
struct {
uint32_t dest_type;
uint32_t type;
// Include address space?
} pointer;
struct {
uint32_t dest_type;
uint32_t type;
uint64_t fixed_count;
} array;
struct {
uint32_t id;
} label;
struct {
uint32_t value;
uint32_t has_value;
} ret;
};
int32_t line;
int32_t column;
} JanetSysInstruction;
/* Shared data between multiple
* IR Function bodies. Used to link
* multiple functions together in a
* single executable or shared object with
* multiple entry points. Contains shared
* type declarations, as well as a table of linked
* functions. */
typedef struct {
uint32_t old_type_def_count;
uint32_t type_def_count;
uint32_t field_def_count;
JanetSysTypeInfo *type_defs;
JanetString *type_names;
JanetSysTypeField *field_defs;
JanetTable *irs;
JanetArray *ir_ordered;
JanetTable *type_name_lookup;
} JanetSysIRLinkage;
/* Keep source code information as well as
* typing information along with constants */
typedef struct {
uint32_t type;
Janet value;
// TODO - source and line
} JanetSysConstant;
/* IR representation for a single function.
* Allow for incremental compilation and linking. */
typedef struct {
JanetSysIRLinkage *linkage;
JanetString link_name;
uint32_t instruction_count;
uint32_t register_count;
uint32_t constant_count;
uint32_t return_type;
uint32_t has_return_type;
uint32_t parameter_count;
uint32_t label_count;
uint32_t *types;
JanetSysInstruction *instructions;
JanetString *register_names;
JanetSysConstant *constants;
JanetTable *register_name_lookup;
JanetTable *labels;
JanetSysCallingConvention calling_convention;
Janet error_ctx; /* Temporary for holding error messages */
} JanetSysIR;
/* Delay alignment info for the most part to the lowering phase */
typedef struct {
uint32_t size;
uint32_t alignment;
} JanetSysTypeLayout;
/* Keep track of names for each instruction */
extern const char *janet_sysop_names[];
extern const char *prim_to_prim_name[];
/* Utilities */
uint32_t janet_sys_optype(JanetSysIR *ir, uint32_t op);
/* Get list of uint32_t instruction arguments from a call or other variable length instruction.
Needs to be free with janet_sfree (or you can leak it and the garbage collector will eventually clean
* it up). */
uint32_t *janet_sys_callargs(JanetSysInstruction *instr, uint32_t *count);
/* Lowering */
void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into);
void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer);
void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetSysTarget target, JanetBuffer *buffer);
#endif

376
src/core/sysir_c.c Normal file
View File

@@ -0,0 +1,376 @@
/*
* Copyright (c) 2024 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "sysir.h"
#include "vector.h"
#include "util.h"
#endif
/* Lowering to C */
static const char *c_prim_names[] = {
"uint8_t",
"int8_t",
"uint16_t",
"int16_t",
"uint32_t",
"int32_t",
"uint64_t",
"int64_t",
"float",
"double",
"void *",
"bool",
"!!!struct",
"!!!union",
"!!!array",
"void",
"!!!unknown"
};
/* Print a C constant */
static void print_const_c(JanetSysIR *ir, JanetBuffer *buf, Janet c, uint32_t tid) {
/* JanetSysTypeInfo *tinfo = &ir->linkage->type_defs[tid]; */
if (janet_checktype(c, JANET_TUPLE)) {
const Janet *elements = janet_unwrap_tuple(c);
janet_formatb(buf, "((_t%d){", tid);
for (int32_t i = 0; i < janet_tuple_length(elements); i++) {
if (i > 0) janet_formatb(buf, ", ");
/* TODO - limit recursion? */
uint32_t sub_type = ir->linkage->type_defs[tid].array.type;
print_const_c(ir, buf, elements[i], sub_type);
}
janet_formatb(buf, "})");
} else if (janet_checktype(c, JANET_ABSTRACT)) {
/* Allow printing int types */
janet_formatb(buf, "%V", c);
} else {
janet_formatb(buf, "%v", c);
}
}
static void c_op_or_const(JanetSysIR *ir, JanetBuffer *buf, uint32_t reg) {
if (reg < JANET_SYS_MAX_OPERAND) {
janet_formatb(buf, "_r%u", reg);
} else {
uint32_t constant_id = reg - JANET_SYS_CONSTANT_PREFIX;
uint32_t tid = ir->constants[constant_id].type;
Janet c = ir->constants[constant_id].value;
print_const_c(ir, buf, c, tid);
}
}
static void c_emit_binop(JanetSysIR *ir, JanetBuffer *buffer, JanetBuffer *tempbuf, JanetSysInstruction instruction, const char *op, int pointer_sugar) {
uint32_t operand_type = ir->types[instruction.three.dest];
tempbuf->count = 0;
uint32_t index_index = 0;
int is_pointer = 0;
JanetSysIRLinkage *linkage = ir->linkage;
/* Top-level pointer semantics */
if (pointer_sugar && janet_sys_optype(ir, instruction.three.dest) == JANET_PRIM_POINTER) {
operand_type = linkage->type_defs[operand_type].pointer.type;
is_pointer = 1;
}
/* Add nested for loops for any dimensionality of array */
while (linkage->type_defs[operand_type].prim == JANET_PRIM_ARRAY) {
janet_formatb(buffer, " for (size_t _j%u = 0; _j%u < %u; _j%u++) ",
index_index, index_index,
linkage->type_defs[operand_type].array.fixed_count,
index_index);
if (is_pointer) {
janet_formatb(tempbuf, "->els[_j%u]", index_index);
is_pointer = 0;
} else {
janet_formatb(tempbuf, ".els[_j%u]", index_index);
}
operand_type = linkage->type_defs[operand_type].array.type;
index_index++;
}
if (is_pointer) {
janet_formatb(buffer, " *_r%u = *_r%u %s *_r%u;\n",
instruction.three.dest,
instruction.three.lhs,
op,
instruction.three.rhs);
janet_formatb(buffer, " *_r%u = *", instruction.three.dest);
c_op_or_const(ir, buffer, instruction.three.lhs);
janet_formatb(buffer, " %s ", op);
c_op_or_const(ir, buffer, instruction.three.rhs);
janet_formatb(buffer, ";\n");
} else {
Janet index_part = janet_wrap_buffer(tempbuf);
janet_formatb(buffer, " _r%u%V = ", instruction.three.dest, index_part);
c_op_or_const(ir, buffer, instruction.three.lhs);
janet_formatb(buffer, "%V %s ", index_part, op);
c_op_or_const(ir, buffer, instruction.three.rhs);
janet_formatb(buffer, "%V;\n", index_part);
}
}
void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
JanetBuffer *tempbuf = janet_buffer(0);
#define EMITBINOP(OP) c_emit_binop(ir, buffer, tempbuf, instruction, OP, 1)
#define EMITBINOP_NOSUGAR(OP) c_emit_binop(ir, buffer, tempbuf, instruction, OP, 0)
/* Prelude */
janet_formatb(buffer, "#include <stddef.h>\n#include <unistd.h>\n#include <stdlib.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stdio.h>\n#include <sys/syscall.h>\n#define _t0 void\n\n");
/* Emit type defs */
for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) {
JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]);
for (uint32_t i = 0; i < ir->instruction_count; i++) {
JanetSysInstruction instruction = ir->instructions[i];
switch (instruction.opcode) {
default:
continue;
case JANET_SYSOP_TYPE_PRIMITIVE:
case JANET_SYSOP_TYPE_STRUCT:
case JANET_SYSOP_TYPE_UNION:
case JANET_SYSOP_TYPE_POINTER:
case JANET_SYSOP_TYPE_ARRAY:
break;
}
if (instruction.line > 0) {
janet_formatb(buffer, "#line %d\n", instruction.line);
}
switch (instruction.opcode) {
default:
break;
case JANET_SYSOP_TYPE_PRIMITIVE:
janet_formatb(buffer, "typedef %s _t%u;\n", c_prim_names[instruction.type_prim.prim], instruction.type_prim.dest_type);
break;
case JANET_SYSOP_TYPE_STRUCT:
case JANET_SYSOP_TYPE_UNION:
janet_formatb(buffer, (instruction.opcode == JANET_SYSOP_TYPE_STRUCT) ? "typedef struct {\n" : "typedef union {\n");
for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) {
uint32_t offset = j / 3 + 1;
uint32_t index = j % 3;
JanetSysInstruction arg_instruction = ir->instructions[i + offset];
janet_formatb(buffer, " _t%u _f%u;\n", arg_instruction.arg.args[index], j);
}
janet_formatb(buffer, "} _t%u;\n", instruction.type_types.dest_type);
break;
case JANET_SYSOP_TYPE_POINTER:
janet_formatb(buffer, "typedef _t%u *_t%u;\n", instruction.pointer.type, instruction.pointer.dest_type);
break;
case JANET_SYSOP_TYPE_ARRAY:
janet_formatb(buffer, "typedef struct { _t%u els[%u]; } _t%u;\n", instruction.array.type, instruction.array.fixed_count, instruction.array.dest_type);
break;
}
}
}
/* Emit function header */
for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) {
JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]);
if (ir->link_name == NULL) {
continue;
}
janet_formatb(buffer, "\n\n_t%u %s(", ir->return_type, (ir->link_name != NULL) ? ir->link_name : janet_cstring("_thunk"));
for (uint32_t i = 0; i < ir->parameter_count; i++) {
if (i) janet_buffer_push_cstring(buffer, ", ");
janet_formatb(buffer, "_t%u _r%u", ir->types[i], i);
}
janet_buffer_push_cstring(buffer, ")\n{\n");
for (uint32_t i = ir->parameter_count; i < ir->register_count; i++) {
janet_formatb(buffer, " _t%u _r%u;\n", ir->types[i], i);
}
janet_buffer_push_cstring(buffer, "\n");
/* Emit body */
for (uint32_t i = 0; i < ir->instruction_count; i++) {
JanetSysInstruction instruction = ir->instructions[i];
if (instruction.line > 0) {
janet_formatb(buffer, "#line %d\n", instruction.line);
}
switch (instruction.opcode) {
case JANET_SYSOP_TYPE_PRIMITIVE:
case JANET_SYSOP_TYPE_BIND:
case JANET_SYSOP_TYPE_STRUCT:
case JANET_SYSOP_TYPE_UNION:
case JANET_SYSOP_TYPE_POINTER:
case JANET_SYSOP_TYPE_ARRAY:
case JANET_SYSOP_ARG:
case JANET_SYSOP_LINK_NAME:
case JANET_SYSOP_PARAMETER_COUNT:
case JANET_SYSOP_CALLING_CONVENTION:
break;
case JANET_SYSOP_LABEL: {
janet_formatb(buffer, "\n_label_%u:\n", instruction.label.id);
break;
}
case JANET_SYSOP_ADDRESS:
janet_formatb(buffer, " _r%u = (void *) &", instruction.two.dest);
c_op_or_const(ir, buffer, instruction.two.src);
janet_formatb(buffer, ";\n");
break;
case JANET_SYSOP_JUMP:
janet_formatb(buffer, " goto _label_%u;\n", instruction.jump.to);
break;
case JANET_SYSOP_BRANCH:
case JANET_SYSOP_BRANCH_NOT:
janet_formatb(buffer, instruction.opcode == JANET_SYSOP_BRANCH ? " if (" : " if (!");
c_op_or_const(ir, buffer, instruction.branch.cond);
janet_formatb(buffer, ") goto _label_%u;\n", instruction.branch.to);
break;
case JANET_SYSOP_RETURN:
if (instruction.ret.has_value) {
janet_buffer_push_cstring(buffer, " return ");
c_op_or_const(ir, buffer, instruction.ret.value);
janet_buffer_push_cstring(buffer, ";\n");
} else {
janet_buffer_push_cstring(buffer, " return;\n");
}
break;
case JANET_SYSOP_ADD:
EMITBINOP("+");
break;
case JANET_SYSOP_POINTER_ADD:
EMITBINOP_NOSUGAR("+");
break;
case JANET_SYSOP_SUBTRACT:
EMITBINOP("-");
break;
case JANET_SYSOP_POINTER_SUBTRACT:
EMITBINOP_NOSUGAR("-");
break;
case JANET_SYSOP_MULTIPLY:
EMITBINOP("*");
break;
case JANET_SYSOP_DIVIDE:
EMITBINOP("/");
break;
case JANET_SYSOP_GT:
EMITBINOP(">");
break;
case JANET_SYSOP_GTE:
EMITBINOP(">");
break;
case JANET_SYSOP_LT:
EMITBINOP("<");
break;
case JANET_SYSOP_LTE:
EMITBINOP("<=");
break;
case JANET_SYSOP_EQ:
EMITBINOP("==");
break;
case JANET_SYSOP_NEQ:
EMITBINOP("!=");
break;
case JANET_SYSOP_BAND:
EMITBINOP("&");
break;
case JANET_SYSOP_BOR:
EMITBINOP("|");
break;
case JANET_SYSOP_BXOR:
EMITBINOP("^");
break;
case JANET_SYSOP_SHL:
EMITBINOP("<<");
break;
case JANET_SYSOP_SHR:
EMITBINOP(">>");
break;
case JANET_SYSOP_SYSCALL:
case JANET_SYSOP_CALL: {
if (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) {
janet_formatb(buffer, " _r%u = ", instruction.call.dest);
} else {
janet_formatb(buffer, " ");
}
if (instruction.opcode == JANET_SYSOP_SYSCALL) {
janet_formatb(buffer, "syscall(");
c_op_or_const(ir, buffer, instruction.call.callee);
} else {
c_op_or_const(ir, buffer, instruction.call.callee);
janet_formatb(buffer, "(");
}
uint32_t count;
uint32_t *args = janet_sys_callargs(ir->instructions + i, &count);
for (uint32_t j = 0; j < count; j++) {
if (j || instruction.opcode == JANET_SYSOP_SYSCALL) janet_formatb(buffer, ", ");
c_op_or_const(ir, buffer, args[j]);
}
janet_formatb(buffer, ");\n");
break;
}
case JANET_SYSOP_CAST: {
uint32_t to = ir->types[instruction.two.dest];
janet_formatb(buffer, " _r%u = (_t%u) ", instruction.two.dest, to);
c_op_or_const(ir, buffer, instruction.two.src);
janet_formatb(buffer, ";\n");
break;
}
case JANET_SYSOP_MOVE:
janet_formatb(buffer, " _r%u = ", instruction.two.dest);
c_op_or_const(ir, buffer, instruction.two.src);
janet_formatb(buffer, ";\n");
break;
case JANET_SYSOP_BNOT:
janet_formatb(buffer, " _r%u = ~", instruction.two.dest);
c_op_or_const(ir, buffer, instruction.two.src);
janet_formatb(buffer, ";\n");
break;
case JANET_SYSOP_LOAD:
janet_formatb(buffer, " _r%u = *(", instruction.two.dest);
c_op_or_const(ir, buffer, instruction.two.src);
janet_formatb(buffer, ");\n");
break;
case JANET_SYSOP_STORE:
janet_formatb(buffer, " *(_r%u) = ", instruction.two.dest);
c_op_or_const(ir, buffer, instruction.two.src);
janet_formatb(buffer, ";\n");
break;
case JANET_SYSOP_FIELD_GETP:
janet_formatb(buffer, " _r%u = &(_r%u._f%u);\n", instruction.field.r, instruction.field.st, instruction.field.field);
janet_formatb(buffer, " _r%u = &(", instruction.field.r);
janet_formatb(buffer, "._f%u);\n", instruction.field.field);
break;
case JANET_SYSOP_ARRAY_GETP:
janet_formatb(buffer, " _r%u = &(_r%u.els[", instruction.three.dest, instruction.three.lhs);
c_op_or_const(ir, buffer, instruction.three.rhs);
janet_buffer_push_cstring(buffer, "]);\n");
break;
case JANET_SYSOP_ARRAY_PGETP:
janet_formatb(buffer, " _r%u = &(_r%u->els[", instruction.three.dest, instruction.three.lhs);
c_op_or_const(ir, buffer, instruction.three.rhs);
janet_buffer_push_cstring(buffer, "]);\n");
break;
}
}
janet_buffer_push_cstring(buffer, "}\n");
#undef EMITBINOP
#undef EMITBINOP_NOSUGAR
}
}

1104
src/core/sysir_x86.c Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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,17 +155,6 @@ 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) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -321,54 +321,6 @@ 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);
@@ -676,11 +628,8 @@ JanetBinding janet_binding_from_entry(Janet entry) {
return binding;
entry_table = janet_unwrap_table(entry);
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");
/* deprecation check */
Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
if (janet_checktype(deprecate, JANET_KEYWORD)) {
JanetKeyword depkw = janet_unwrap_keyword(deprecate);
if (!janet_cstrcmp(depkw, "relaxed")) {
@@ -694,8 +643,11 @@ 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_keyword(entry_table, "redef"));
int redef = ref_is_valid && janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef")));
if (macro) {
binding.value = redef ? ref : value;
@@ -896,15 +848,11 @@ int janet_checksize(Janet x) {
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) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -66,72 +66,42 @@
/* 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,
@@ -197,11 +167,7 @@ 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
/* Initialize builtin libraries */
void janet_lib_io(JanetTable *env);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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,8 +322,7 @@ int32_t janet_hash(Janet x) {
break;
case JANET_TUPLE:
hash = janet_tuple_hash(janet_unwrap_tuple(x));
uint32_t inc = (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
hash = (int32_t)((uint32_t)hash + inc); /* avoid overflow undefined behavior */
hash += (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
break;
case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x));
@@ -335,9 +334,10 @@ int32_t janet_hash(Janet x) {
} as;
as.d = janet_unwrap_number(x);
as.d += 0.0; /* normalize negative 0 */
as.u = murmur64(as.u);
uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
uint32_t hi = (uint32_t)(as.u >> 32);
hash = (int32_t)hi;
uint32_t hilo = (hi ^ lo) * 2654435769u;
hash = (int32_t)((hilo << 16) | (hilo >> 16));
break;
}
case JANET_ABSTRACT: {
@@ -767,8 +767,7 @@ 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_ensure(array, index + 1, 2);
array->count = index + 1;
janet_array_setcount(array, index + 1);
}
array->data[index] = value;
break;
@@ -779,8 +778,7 @@ 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_ensure(buffer, index + 1, 2);
buffer->count = index + 1;
janet_buffer_setcount(buffer, index + 1);
}
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
break;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -121,7 +121,6 @@ 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 */
@@ -148,7 +147,6 @@ extern "C" {
|| defined(__s390x__) /* S390 64-bit */ \
|| defined(__s390__) /* S390 32-bit */ \
|| defined(__ARMEB__) /* ARM big endian */ \
|| defined(__AARCH64EB__) /* ARM64 big endian */ \
|| ((defined(__CC_ARM) || defined(__ARMCC__)) /* ARM RealView compiler */ \
&& defined(__BIG_ENDIAN))
#define JANET_BIG_ENDIAN 1
@@ -668,8 +666,6 @@ 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
@@ -1074,7 +1070,6 @@ 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 */
@@ -1116,7 +1111,6 @@ struct JanetFuncDef {
int32_t environments_length;
int32_t defs_length;
int32_t symbolmap_length;
int32_t named_args_count;
};
/* A function environment */
@@ -1140,21 +1134,9 @@ 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,
@@ -1190,10 +1172,7 @@ typedef struct {
const JanetAbstractType *at;
} JanetMarshalContext;
/* 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)); */
/* Defines an abstract type */
struct JanetAbstractType {
const char *name;
int (*gc)(void *data, size_t len);
@@ -1445,7 +1424,6 @@ JANET_API void janet_loop(void);
* } else {
* janet_schedule(interrupted_fiber, janet_wrap_nil());
* }
* janet_interpreter_interrupt_handled(NULL);
* }
* }
*
@@ -1485,18 +1463,9 @@ 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);
@@ -1505,7 +1474,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 - mutexes and reader-writer locks */
/* Expose some OS sync primitives */
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);
@@ -1573,8 +1542,7 @@ 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. 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. */
/* Read async from a stream */
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
@@ -1583,8 +1551,7 @@ 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. 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. */
/* Write async to a stream */
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
@@ -1596,63 +1563,17 @@ JANET_NO_RETURN JANET_API void janet_ev_sendto_string(JanetStream *stream, Janet
#endif
/* 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);
*
* */
/* Parsing */
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 */
@@ -1696,10 +1617,7 @@ 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.
*
* These functions wrap parsing, compilation, and evalutation into convenient functions.
* */
/* Execute strings */
#define JANET_DO_ERROR_RUNTIME 0x01
#define JANET_DO_ERROR_COMPILE 0x02
#define JANET_DO_ERROR_PARSE 0x04
@@ -1893,41 +1811,21 @@ 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 */
/* The main interface to garbage collection. Call this to do a full mark and sweep cleanup. */
JANET_API void janet_collect(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);
/* 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_collect(void);
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 void janet_gcroot(Janet root);
JANET_API int janet_gcunroot(Janet root);
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 int janet_gclock(void);
JANET_API void janet_gcunlock(int handle);
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 */
@@ -1976,7 +1874,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); /* Call this after running interrupt handler */
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
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);
@@ -2005,10 +1903,6 @@ 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_ALL (UINT32_MAX)
JANET_API void janet_sandbox(uint32_t flags);
JANET_API void janet_sandbox_assert(uint32_t forbidden_flags);
@@ -2053,14 +1947,7 @@ 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
*
* 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.
*
* */
/* New C API */
/* Shorthand for janet C function declarations */
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
@@ -2215,8 +2102,6 @@ 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);
@@ -2317,9 +2202,7 @@ typedef enum {
RULE_SPLIT, /* [rule, rule] */
RULE_NTH, /* [nth, rule, tag] */
RULE_ONLY_TAGS, /* [rule] */
RULE_MATCHSPLICE, /* [rule, constant, tag] */
RULE_DEBUG, /* [] */
} JanetPegOpcode;
} JanetPegOpcod;
typedef struct {
uint32_t *bytecode;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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
@@ -79,11 +79,9 @@ 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;
}
@@ -112,8 +110,6 @@ 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 */
@@ -311,9 +307,7 @@ 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;
@@ -385,12 +379,10 @@ static void refresh(void) {
janet_buffer_push_cstring(&b, gbl_prompt);
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
/* Erase to right */
janet_buffer_push_cstring(&b, "\x1b[0K\r");
janet_buffer_push_cstring(&b, "\x1b[0K");
/* Move cursor to original position. */
if (_pos + gbl_plen) {
snprintf(seq, 64, "\x1b[%dC", (int)(_pos + gbl_plen));
janet_buffer_push_cstring(&b, seq);
}
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
janet_buffer_push_cstring(&b, seq);
if (write_console((char *) b.data, b.count) == -1) {
exit(1);
}
@@ -432,63 +424,6 @@ 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]);
@@ -955,7 +890,6 @@ static int line() {
case 3: /* ctrl-c */
clearlines();
norawmode();
savehistory();
#ifdef _WIN32
ExitProcess(1);
#else
@@ -1149,21 +1083,17 @@ void janet_line_init() {
}
void janet_line_deinit() {
int i;
norawmode();
for (int i = 0; i < gbl_history_count; i++)
for (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()) {
@@ -1199,10 +1129,6 @@ int main(int argc, char **argv) {
JanetArray *args;
JanetTable *env;
#ifdef JANET_PLAN9
setfcr(0);
#endif
#ifdef _WIN32
setup_console_output();
#endif
@@ -1258,10 +1184,6 @@ 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();

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2026 Calvin Rose
* Copyright (c) 2025 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

View File

@@ -1,8 +1,5 @@
# 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)
@@ -10,7 +7,7 @@
(var skip-count 0)
(var skip-n 0)
(var is-verbose (os/getenv "VERBOSE"))
(def is-verbose (os/getenv "VERBOSE"))
(defn- assert-no-tail
"Override's the default assert with some nice error handling."
@@ -22,6 +19,7 @@
(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"
@@ -29,7 +27,7 @@
(if x
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
(do
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (string e) x) (eflush)))
x)
(defn skip-asserts
@@ -52,11 +50,6 @@
(def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defmacro assert-error-value
[msg errval & forms]
(def e (gensym))
~(assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
(defn check-compile-error
[form]
(def result (compile form))
@@ -67,8 +60,8 @@
(def e (gensym))
(def f (gensym))
(if is-verbose
~(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)))))
~(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)))))
(defn start-suite [&opt x]
(default x (dyn :current-file))

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2026 Calvin Rose
# Copyright (c) 2025 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

Some files were not shown because too many files have changed in this diff Show More