mirror of
https://github.com/janet-lang/janet
synced 2026-04-02 21:11:27 +00:00
Compare commits
100 Commits
cosmo-fixu
...
compile-op
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ead0ed5d41 | ||
|
|
42bc504188 | ||
|
|
c3317905a1 | ||
|
|
0066a5a304 | ||
|
|
3dd6e744de | ||
|
|
862b4e9688 | ||
|
|
c9305a0a42 | ||
|
|
3cbdf26aa2 | ||
|
|
11e6a5a315 | ||
|
|
871f8ebf4e | ||
|
|
c677c72a73 | ||
|
|
af73e214b2 | ||
|
|
a6e0a8228c | ||
|
|
9a1cd6fdd9 | ||
|
|
768c9b23e1 | ||
|
|
059253fdee | ||
|
|
4396f01297 | ||
|
|
046d299d77 | ||
|
|
9fa9286fca | ||
|
|
c13ef02ea2 | ||
|
|
52cedbc4b4 | ||
|
|
d345e551f1 | ||
|
|
0fb1773c19 | ||
|
|
a6ea38a23b | ||
|
|
bc79489068 | ||
|
|
b096babcbf | ||
|
|
bed80bf1d3 | ||
|
|
80ed6538d0 | ||
|
|
6577a18cef | ||
|
|
731592a80e | ||
|
|
ea332ff81e | ||
|
|
f36d544deb | ||
|
|
e96dd512f3 | ||
|
|
a588f1f242 | ||
|
|
ae15eadfaf | ||
|
|
3618b72f4d | ||
|
|
3510e235ee | ||
|
|
b6fb7ae69c | ||
|
|
e5765b26d4 | ||
|
|
cdb3baaca3 | ||
|
|
c413bc2b4e | ||
|
|
dfdf734fc7 | ||
|
|
314e684097 | ||
|
|
232a8faa35 | ||
|
|
c31d8b52ff | ||
|
|
f0395763b7 | ||
|
|
5b3c5a5969 | ||
|
|
af10c1d4b5 | ||
|
|
3995fa86e2 | ||
|
|
9d7a279999 | ||
|
|
3e273ce03a | ||
|
|
25b7c74089 | ||
|
|
9e47cd94bd | ||
|
|
7ea118f248 | ||
|
|
480c5b5e9d | ||
|
|
8a394f2506 | ||
|
|
2c208f5d01 | ||
|
|
08e6051af8 | ||
|
|
19212e6f5c | ||
|
|
8875adf69e | ||
|
|
745567a2e0 | ||
|
|
ef2dfcd7c3 | ||
|
|
f582fe1f69 | ||
|
|
3cc3312b7b | ||
|
|
f2d25a0da2 | ||
|
|
dfd05ddf7e | ||
|
|
31be7bad8e | ||
|
|
3a782d27b1 | ||
|
|
f08874e65e | ||
|
|
6a78b6d1c6 | ||
|
|
97963d1396 | ||
|
|
efbc46c69e | ||
|
|
9b9f67c371 | ||
|
|
61791e4a4c | ||
|
|
c3a4fb6735 | ||
|
|
e5893d0692 | ||
|
|
5f5e5cf693 | ||
|
|
46bda4e6fa | ||
|
|
fdbf4f2666 | ||
|
|
b939671b79 | ||
|
|
4b8e7a416f | ||
|
|
1e1e7a5cfd | ||
|
|
91e459e4a5 | ||
|
|
b6adc257f4 | ||
|
|
a2bd98390e | ||
|
|
d9912f38f8 | ||
|
|
8007806c8e | ||
|
|
de2440d458 | ||
|
|
43ab06467f | ||
|
|
3fe4cfd14c | ||
|
|
75be5fd4c6 | ||
|
|
7c7136fd70 | ||
|
|
cfa32d58a7 | ||
|
|
7cc176f0c0 | ||
|
|
4d7baef89e | ||
|
|
29af4a932d | ||
|
|
ef94a0f0b4 | ||
|
|
517dc208ca | ||
|
|
fd7579dd07 | ||
|
|
6b74400f2a |
@@ -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
8
.github/cosmo/setup
vendored
@@ -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
|
||||
|
||||
21
.github/workflows/test.yml
vendored
21
.github/workflows/test.yml
vendored
@@ -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
2
.gitignore
vendored
@@ -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
|
||||
|
||||
|
||||
30
CHANGELOG.md
30
CHANGELOG.md
@@ -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`.
|
||||
|
||||
@@ -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
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -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
|
||||
|
||||
53
Makefile
53
Makefile
@@ -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
|
||||
|
||||
56
README.md
56
README.md
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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"))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)]
|
||||
|
||||
@@ -1,3 +0,0 @@
|
||||
@{
|
||||
:name "sample-bad-bundle1"
|
||||
}
|
||||
@@ -1,3 +0,0 @@
|
||||
@{
|
||||
:name "sample-bad-bundle2"
|
||||
}
|
||||
71
examples/sysir/drawing.janet
Normal file
71
examples/sysir/drawing.janet
Normal 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)
|
||||
86
examples/sysir/drawing2.janet
Normal file
86
examples/sysir/drawing2.janet
Normal 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)
|
||||
567
examples/sysir/frontend.janet
Normal file
567
examples/sysir/frontend.janet
Normal 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))])
|
||||
16
examples/sysir/hello.janet
Normal file
16
examples/sysir/hello.janet
Normal 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
5
examples/sysir/run_drawing.sh
Executable 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
5
examples/sysir/run_drawing2.sh
Executable 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
|
||||
4
examples/sysir/run_samples.bat
Normal file
4
examples/sysir/run_samples.bat
Normal 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
5
examples/sysir/run_samples.sh
Executable 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
|
||||
72
examples/sysir/samples.janet
Normal file
72
examples/sysir/samples.janet
Normal 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)
|
||||
10
examples/sysir/typeerr1.janet
Normal file
10
examples/sysir/typeerr1.janet
Normal 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))
|
||||
14
examples/sysir/windows_samples.janet
Normal file
14
examples/sysir/windows_samples.janet
Normal 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
24
examples/sysir/x64.janet
Normal 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)))
|
||||
@@ -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))
|
||||
|
||||
8
janet.1
8
janet.1
@@ -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
|
||||
|
||||
12
meson.build
12
meson.build
@@ -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',
|
||||
|
||||
49
plan9.mk
49
plan9.mk
@@ -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]
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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");
|
||||
|
||||
@@ -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));
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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" */
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -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;
|
||||
}
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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);
|
||||
}
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 */
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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);
|
||||
|
||||
205
src/core/os.c
205
src/core/os.c
@@ -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),
|
||||
|
||||
@@ -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) \
|
||||
|
||||
@@ -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);
|
||||
|
||||
124
src/core/pp.c
124
src/core/pp.c
@@ -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));
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
1915
src/core/sysir.c
Normal file
File diff suppressed because it is too large
Load Diff
337
src/core/sysir.h
Normal file
337
src/core/sysir.h
Normal 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
376
src/core/sysir_c.c
Normal 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
1104
src/core/sysir_x86.c
Normal file
File diff suppressed because it is too large
Load Diff
@@ -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) {
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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) {
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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();
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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
Reference in New Issue
Block a user