1
0
mirror of https://github.com/janet-lang/janet synced 2025-10-28 06:07:43 +00:00

Compare commits

..

11 Commits

Author SHA1 Message Date
Calvin Rose
fbb0711ae1 Distinguish between subprocess when testing. 2023-06-24 12:07:55 -05:00
Calvin Rose
676b233566 Hack for qemu based testing (also should work with valgrind) 2023-06-24 11:59:17 -05:00
Calvin Rose
d7431c7cdb Revert "Test removing 32bit ptr marshalling."
This reverts commit 566b45ea44.
2023-06-24 11:54:04 -05:00
Calvin Rose
566b45ea44 Test removing 32bit ptr marshalling. 2023-06-24 11:52:22 -05:00
Calvin Rose
ff2f71d2bc Conditionally compile marshal_ptr code. 2023-06-24 11:42:10 -05:00
Calvin Rose
bd420aeb0e Add range checking to bit-shift code to prevent undefined behavior. 2023-06-24 11:38:34 -05:00
Calvin Rose
b738319f8d Remove range check on 32 bit arch since it will always pass. 2023-06-24 11:17:30 -05:00
Calvin Rose
7248626235 Quiet some build warnings. 2023-06-24 10:56:45 -05:00
Calvin Rose
141c1de946 Add marshal utilities for pointers. 2023-06-24 10:50:13 -05:00
Calvin Rose
c2d77d6720 Merge branch 'master' into armtest 2023-06-24 10:40:35 -05:00
Ico Doornekamp
677b8a6f32 Added ARM32 test 2023-06-12 21:02:51 +02:00
118 changed files with 1823 additions and 6603 deletions

View File

@@ -1,4 +1,4 @@
image: freebsd/14.x
image: freebsd/12.x
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
@@ -9,4 +9,3 @@ tasks:
gmake
gmake test
sudo gmake install
sudo gmake uninstall

View File

@@ -19,8 +19,3 @@ tasks:
ninja
ninja test
sudo ninja install
- 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

View File

@@ -1,4 +1,4 @@
image: openbsd/7.4
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
@@ -11,7 +11,6 @@ tasks:
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
@@ -30,3 +29,4 @@ tasks:
ninja
ninja test
doas ninja install

38
.github/cosmo/build vendored
View File

@@ -1,38 +0,0 @@
#!/bin/sh
set -eux
COSMO_DIR="/sc/cosmocc"
# build x86_64
X86_64_CC="/sc/cosmocc/bin/x86_64-unknown-cosmo-cc"
X86_64_AR="/sc/cosmocc/bin/x86_64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/x86_64
make -j CC="$X86_64_CC" AR="$X86_64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/x86_64/janet
make clean
# build aarch64
AARCH64_CC="/sc/cosmocc/bin/aarch64-unknown-cosmo-cc"
AARCH64_AR="/sc/cosmocc/bin/aarch64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/aarch64
make -j CC="$AARCH64_CC" AR="$AARCH64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/aarch64/janet
make clean
# fat binary
apefat () {
OUTPUT="$1"
OLDNAME_X86_64="$(basename -- "$2")"
OLDNAME_AARCH64="$(basename -- "$3")"
TARG_FOLD="$(dirname "$OUTPUT")"
"$COSMO_DIR/bin/apelink" -l "$COSMO_DIR/bin/ape-x86_64.elf" \
-l "$COSMO_DIR/bin/ape-aarch64.elf" \
-M "$COSMO_DIR/bin/ape-m1.c" \
-o "$OUTPUT" \
"$2" \
"$3"
cp "$2" "$TARG_FOLD/$OLDNAME_X86_64.x86_64"
cp "$3" "$TARG_FOLD/$OLDNAME_AARCH64.aarch64"
}
apefat /sc/cosmocc/janet.com /sc/cosmocc/x86_64/janet /sc/cosmocc/aarch64/janet

21
.github/cosmo/setup vendored
View File

@@ -1,21 +0,0 @@
#!/bin/sh
set -e
sudo apt update
sudo apt-get install -y ca-certificates libssl-dev\
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/3.3.3/cosmocc-3.3.3.zip
mkdir -p cosmocc
cd cosmocc
unzip ../cosmocc-3.3.3.zip
# register
cd /sc/cosmocc
sudo cp ./bin/ape-x86_64.elf /usr/bin/ape
sudo sh -c "echo ':APE:M::MZqFpD::/usr/bin/ape:' >/proc/sys/fs/binfmt_misc/register"

View File

@@ -17,7 +17,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, macos-13 ]
os: [ ubuntu-latest, macos-latest ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -39,35 +39,6 @@ jobs:
build/c/janet.c
build/c/shell.c
release-arm:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
name: Build release binaries
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ macos-latest ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Set the version
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
- name: Set the platform
run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV
- name: Compile the project
run: make clean && make
- name: Build the artifact
run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-aarch64.tar.gz
- name: Draft the release
uses: softprops/action-gh-release@v1
with:
draft: true
files: |
build/*.gz
build/janet.h
build/c/janet.c
build/c/shell.c
release-windows:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
@@ -89,30 +60,3 @@ jobs:
./dist/*.zip
./*.zip
./*.msi
release-cosmo:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
name: Build release binaries 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
- name: push binary to github
uses: softprops/action-gh-release@v1
with:
draft: true
files: |
/sc/cosmocc/janet.com

View File

@@ -12,7 +12,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, macos-latest, macos-13 ]
os: [ ubuntu-latest, macos-latest ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -23,10 +23,7 @@ jobs:
test-windows:
name: Build and test on Windows
strategy:
matrix:
os: [ windows-latest, windows-2019 ]
runs-on: ${{ matrix.os }}
runs-on: windows-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -39,57 +36,27 @@ jobs:
shell: cmd
run: build_win test
test-windows-min:
name: Build and test on Windows Minimal build
strategy:
matrix:
os: [ windows-2019 ]
runs-on: ${{ matrix.os }}
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup MSVC
uses: ilammy/msvc-dev-cmd@v1
- name: Setup Python
uses: actions/setup-python@v2
with:
python-version: '3.x'
- name: Install Python Dependencies
run: pip install meson ninja
- name: Build
shell: cmd
run: |
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
test-mingw:
name: Build on Windows with Mingw
name: Build on Windows with Mingw (no test yet)
runs-on: windows-latest
defaults:
run:
shell: msys2 {0}
strategy:
matrix:
msystem: [ UCRT64, CLANG64 ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup Mingw
uses: msys2/setup-msys2@v2
with:
msystem: ${{ matrix.msystem }}
msystem: UCRT64
update: true
install: >-
base-devel
git
gcc
- name: Build
- name: Build the project
shell: cmd
run: make -j4 CC=gcc
- name: Test
shell: cmd
run: make -j4 CC=gcc test
run: make -j CC=gcc
test-mingw-linux:
name: Build and test with Mingw on Linux + Wine
@@ -106,7 +73,7 @@ jobs:
- name: Compile the project
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
- name: Test the project
run: make test UNAME=MINGW RUN=wine VERBOSE=1
run: make test UNAME=MINGW RUN=wine
test-arm-linux:
name: Build and test ARM32 cross compilation
@@ -121,15 +88,4 @@ jobs:
- name: Compile the project
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
- name: Test the project
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1
test-s390x-linux:
name: Build and test s390x in qemu
runs-on: ubuntu-22.04
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Do Qemu build and test
run: |
docker run --rm --privileged multiarch/qemu-user-static --reset -p yes
docker run --rm -v .:/janet -t s390x/ubuntu bash -c "apt-get -y update && apt-get -y install git build-essential && cd /janet && make -j3 && make test"
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test

14
.gitignore vendored
View File

@@ -34,11 +34,8 @@ local
# Common test files I use.
temp.janet
temp.c
temp*janet
temp*.c
temp*.janet
scratch.janet
scratch.c
# Emscripten
*.bc
@@ -48,8 +45,6 @@ janet.wasm
# Generated files
*.gen.h
*.gen.c
*.tmp
temp.*
# Generate test files
*.out
@@ -62,7 +57,6 @@ xxd.exe
# VSCode
.vs
.clangd
.cache
# Swap files
*.swp
@@ -128,9 +122,6 @@ vgcore.*
*.idb
*.pdb
# GGov
*.gcov
# Kernel Module Compile Results
*.mod*
*.cmd
@@ -139,9 +130,6 @@ Module.symvers
Mkfile.old
dkms.conf
# Coverage files
*.cov
# End of https://www.gitignore.io/api/c
# Created by https://www.gitignore.io/api/cmake

View File

@@ -1,118 +1,6 @@
# Changelog
All notable changes to this project will be documented in this file.
## ??? - Unreleased
- Change how JANET_PROFILE is loaded to allow more easily customizing the environment.
- Add `*repl-prompt*` dynamic binding to allow customizing the built in repl.
- Add multiple path support in the `JANET_PATH` environment variables. This lets
user more easily import modules from many directories.
- Add `nth` and `only-tags` PEG specials to select from sub-captures while
dropping the rest.
## 1.36.0 - 2024-09-07
- Improve error messages in `bundle/add*` functions.
- Add CI testing and verify tests pass on the s390x architecture.
- Save `:source-form` in environment entries when `*debug*` is set.
- Add experimental `filewatch/` module for listening to file system changes on Linux and Windows.
- Add `bundle/who-is` to query which bundle a file on disk was installed by.
- Add `geomean` function
- Add `:R` and `:W` flags to `os/pipe` to create blocking pipes on Posix and Windows systems.
These streams cannot be directly read to and written from, but can be passed to subprocesses.
- Add `array/join`
- Add `tuple/join`
- Add `bundle/add-bin` to make installing scripts easier. This also establishes a packaging convention for it.
- Fix marshalling weak tables and weak arrays.
- Fix bug in `ev/` module that could accidentally close sockets on accident.
- Expose C functions for constructing weak tables in janet.h
- Let range take non-integer values.
## 1.35.2 - 2024-06-16
- Fix some documentation typos.
- Allow using `:only` in import without quoting.
## 1.35.0 - 2024-06-15
- Add `:only` argument to `import` to allow for easier control over imported bindings.
- Add extra optional `env` argument to `eval` and `eval-string`.
- Allow naming function literals with a keyword. This allows better stacktraces for macros without
accidentally adding new bindings.
- Add `bundle/` module for managing packages within Janet. This should replace the jpm packaging
format eventually and is much simpler and amenable to more complicated builds.
- Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks.
- Add `with-env`
- Add *module-make-env* dynamic binding
- Add buffer/format-at
- Add long form command line options for readable CLI usage
- Fix bug with `net/accept-loop` that would sometimes miss connections.
## 1.34.0 - 2024-03-22
- Add a new (split) PEG special by @ianthehenry
- Add buffer/push-* sized int and float by @pnelson
- Documentation improvements: @amano-kenji, @llmII, @MaxGyver83, @pepe, @sogaiu.
- Expose _exit to skip certain cleanup with os/exit.
- Swap set / body order for each by @sogaiu.
- Abort on assert failure instead of exit.
- Fix: os/proc-wait by @llmII.
- Fix macex1 to keep syntax location for all tuples.
- Restore if-let tail calls.
- Don't try and resume fibers that can't be resumed.
- Register stream on unmarshal.
- Fix asm roundtrip issue.
## 1.33.0 - 2024-01-07
- Add more + and * keywords to default-peg-grammar by @sogaiu.
- Use libc strlen in janet_buffer_push_cstring by @williewillus.
- Be a bit safer with reference counting.
- Add support for atomic loads in Janet's atomic abstraction.
- Fix poll event loop CPU usage issue.
- Add ipv6, shared, and cryptorand options to meson.
- Add more ipv6 feature detection.
- Fix loop for forever loop.
- Cleaned up unused NetStateConnect, fixed janet_async_end() ev refcount by @zevv.
- Fix warnings w/ MSVC and format.
- Fix marshal_one_env w/ JANET_MARSHAL_UNSAFE.
- Fix `(default)`.
- Fix cannot marshal fiber with c stackframe, in a dynamic way that is fairly conservative.
- Fix typo for SIGALARM in os/proc-kill.
- Prevent bytecode optimization from remove mk* instructions.
- Fix arity typo in peg.c by @pepe.
- Update Makefile for MinGW.
- Fix canceling waiting fiber.
- Add a new (sub) PEG special by @ianthehenry.
- Fix if net/server's handler has incorrect arity.
- Fix macex raising on ().
## 1.32.1 - 2023-10-15
- Fix return value from C function `janet_dobytes` when called on Janet functions that yield to event loop.
- Change C API for event loop interaction - get rid of JanetListener and instead use `janet_async_start` and `janet_async_end`.
- Rework event loop to make fewer system calls on kqueue and epoll.
- Expose atomic refcount abstraction in janet.h
- Add `array/weak` for weak references in arrays
- Add support for weak tables via `table/weak`, `table/weak-keys`, and `table/weak-values`.
- Fix compiler bug with using the result of `(break x)` expression in some contexts.
- Rework internal event loop code to be better behaved on Windows
- Update meson build to work better on windows
## 1.31.0 - 2023-09-17
- Report line and column when using `janet_dobytes`
- Add `:unless` loop modifier
- Allow calling `reverse` on generators.
- Improve performance of a number of core functions including `partition`, `mean`, `keys`, `values`, `pairs`, `interleave`.
- Add `lengthable?`
- Add `os/sigaction`
- Change `every?` and `any?` to behave like the functional versions of the `and` and `or` macros.
- Fix bug with garbage collecting threaded abstract types.
- Add `:signal` to the `sandbox` function to allow intercepting signals.
## 1.30.0 - 2023-08-05
- Change indexing of `array/remove` to start from -1 at the end instead of -2.
- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
- Fix bug with marshalling channels
- Add `div` for floored division
- Make `div` and `mod` variadic
- Support `bnot` for integer types.
- Define `(mod x 0)` as `x`
- Add `ffi/pointer-cfunction` to convert pointers to cfunctions
## 1.29.1 - 2023-06-19
- Add support for passing booleans to PEGs for "always" and "never" matching.
- Allow dictionary types for `take` and `drop`
@@ -143,7 +31,7 @@ All notable changes to this project will be documented in this file.
See http://no-color.org/
- Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`.
Instead, raise a compiler error.
- Change the names of `:user8` and `:user9` signals to `:interrupt` and `:await`
- Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await`
- Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`.
- Add `ev/all-tasks` to see all currently suspended fibers.
- Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier.
@@ -314,7 +202,7 @@ All notable changes to this project will be documented in this file.
- Add the ability to close channels with `ev/chan-close` (or `:close`).
- Add threaded channels with `ev/thread-chan`.
- Add `JANET_FN` and `JANET_REG` macros to more easily define C functions that export their source mapping information.
- Add `janet_interpreter_interrupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
- Add `janet_interpreter_interupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
- Add `table/clear`
- Add build option to disable the threading library without disabling all threads.
- Remove JPM from the main Janet distribution. Instead, JPM must be installed
@@ -368,7 +256,7 @@ saving and restoring the entire VM state.
- Sort keys in pretty printing output.
## 1.15.3 - 2021-02-28
- Fix a fiber bug that occurred in deeply nested fibers
- Fix a fiber bug that occured in deeply nested fibers
- Add `unref` combinator to pegs.
- Small docstring changes.
@@ -518,13 +406,13 @@ saving and restoring the entire VM state.
- Add `symbol/slice`
- Add `keyword/slice`
- Allow cross compilation with Makefile.
- Change `compare-primitive` to `cmp` and make it more efficient.
- Change `compare-primitve` to `cmp` and make it more efficient.
- Add `reverse!` for reversing an array or buffer in place.
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
- Add `repeat` macro for iterating something n times.
- Add `eachy` (each yield) macro for iterating a fiber.
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexadecimal digits.
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
## 1.10.1 - 2020-06-18

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2024 Calvin Rose
# Copyright (c) 2023 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
@@ -33,7 +33,6 @@ CLIBS=-lm -lpthread
JANET_TARGET=build/janet
JANET_BOOT=build/janet_boot
JANET_IMPORT_LIB=build/janet.lib
JANET_LIBRARY_IMPORT_LIB=build/libjanet.lib
JANET_LIBRARY=build/libjanet.so
JANET_STATIC_LIBRARY=build/libjanet.a
JANET_PATH?=$(LIBDIR)/janet
@@ -43,18 +42,14 @@ JANET_DIST_DIR?=janet-dist
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
JANET_TARGET_OBJECTS=build/janet.o build/shell.o
JPM_TAG?=master
SPORK_TAG?=master
HAS_SHARED?=1
DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname,
# For cross compilation
HOSTCC?=$(CC)
HOSTAR?=$(AR)
# Symbols are (optionally) removed later, keep -g as default!
CFLAGS?=-O2 -g
LDFLAGS?=-rdynamic
LIBJANET_LDFLAGS?=$(LD_FLAGS)
RUN:=$(RUN)
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
@@ -97,17 +92,12 @@ endif
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
CLIBS:=-lws2_32 -lpsapi -lwsock32
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
LIBJANET_LDFLAGS:=-Wl,--out-implib,$(JANET_LIBRARY_IMPORT_LIB)
JANET_TARGET:=$(JANET_TARGET).exe
JANET_BOOT:=$(JANET_BOOT).exe
endif
$(shell mkdir -p build/core build/c build/boot build/mainclient)
all: $(JANET_TARGET) $(JANET_STATIC_LIBRARY) build/janet.h
ifeq ($(HAS_SHARED), 1)
all: $(JANET_LIBRARY)
endif
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
######################
##### Name Files #####
@@ -140,7 +130,6 @@ JANET_CORE_SOURCES=src/core/abstract.c \
src/core/ev.c \
src/core/ffi.c \
src/core/fiber.c \
src/core/filewatch.c \
src/core/gc.c \
src/core/inttypes.c \
src/core/io.c \
@@ -206,9 +195,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.37.dylib
SONAME=libjanet.1.29.dylib
else
SONAME=libjanet.so.1.37
SONAME=libjanet.so.1.29
endif
build/c/shell.c: src/mainclient/shell.c
@@ -230,7 +219,7 @@ $(JANET_TARGET): $(JANET_TARGET_OBJECTS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
$(HOSTCC) $(LIBJANET_LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
$(HOSTAR) rcs $@ $^
@@ -273,25 +262,20 @@ dist: build/janet-dist.tar.gz
build/janet-%.tar.gz: $(JANET_TARGET) \
build/janet.h \
janet.1 LICENSE CONTRIBUTING.md $(JANET_STATIC_LIBRARY) \
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
README.md build/c/janet.c build/c/shell.c
mkdir -p build/$(JANET_DIST_DIR)/bin
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
mkdir -p build/$(JANET_DIST_DIR)/include
cp build/janet.h build/$(JANET_DIST_DIR)/include/
mkdir -p build/$(JANET_DIST_DIR)/lib/
cp $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
cp $(JANET_LIBRARY) build/$(JANET_DIST_DIR)/lib/ || true
cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
mkdir -p build/$(JANET_DIST_DIR)/man/man1/
cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1
mkdir -p build/$(JANET_DIST_DIR)/src/
cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
ifeq ($(HAS_SHARED), 1)
build/janet-%.tar.gz: $(JANET_LIBRARY)
endif
#########################
##### Documentation #####
@@ -324,7 +308,7 @@ build/janet.pc: $(JANET_TARGET)
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
mkdir -p '$(DESTDIR)$(BINDIR)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
strip -x -S '$(DESTDIR)$(BINDIR)/janet'
strip '$(DESTDIR)$(BINDIR)/janet'
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
@@ -345,7 +329,6 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
cp '$(JANET_LIBRARY_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
install-jpm-git: $(JANET_TARGET)
@@ -360,12 +343,6 @@ install-jpm-git: $(JANET_TARGET)
JANET_LIBPATH='$(LIBDIR)' \
$(RUN) ../../$(JANET_TARGET) ./bootstrap.janet
install-spork-git: $(JANET_TARGET)
mkdir -p build
rm -rf build/spork
git clone --depth=1 --branch='$(SPORK_TAG)' https://github.com/janet-lang/spork.git build/spork
$(JANET_TARGET) -e '(bundle/install "build/spork")'
uninstall:
-rm '$(DESTDIR)$(BINDIR)/janet'
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
@@ -380,14 +357,14 @@ uninstall:
#################
format:
sh tools/format.sh
tools/format.sh
grammar: build/janet.tmLanguage
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
$(RUN) $(JANET_TARGET) $< > $@
compile-commands:
# Requires pip install compiledb
# Requires pip install copmiledb
compiledb make
clean:

View File

@@ -1,4 +1,4 @@
[![Join the chat](https://img.shields.io/badge/zulip-join_chat-brightgreen.svg)](https://janet.zulipchat.com)
[![Join the chat](https://badges.gitter.im/janet-language/community.svg)](https://gitter.im/janet-language/community)
&nbsp;
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
@@ -18,6 +18,9 @@ to run script files. This client program is separate from the core runtime, so
Janet can be embedded in other programs. Try Janet in your browser at
<https://janet-lang.org>.
If you'd like to financially support the ongoing development of Janet, consider
[sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub.
<br>
## Examples
@@ -250,10 +253,8 @@ Emacs, and Atom each have syntax packages for the Janet language, though.
## Installation
If you just want to try out the language, you don't need to install anything.
In this case you can also move the `janet` executable wherever you want on
your system and run it. However, for a fuller setup, please see the
[Introduction](https://janet-lang.org/docs/index.html) for more details.
See the [Introduction](https://janet-lang.org/docs/index.html) for more details. If you just want
to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
## Usage
@@ -314,7 +315,8 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w
## Discussion
Feel free to ask questions and join the discussion on the [Janet Zulip Instance](https://janet.zulipchat.com/)
Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
Gitter provides Matrix and IRC bridges as well.
## FAQ
@@ -381,7 +383,7 @@ Usually, one of a few reasons:
### Can I bind to Rust/Zig/Go/Java/Nim/C++/D/Pascal/Fortran/Odin/Jai/(Some new "Systems" Programming Language)?
Probably, if that language has a good interface with C. But the programmer may need to do
some extra work to map Janet's internal memory model to that of the bound language. Janet
some extra work to map Janet's internal memory model may need some to that of the bound language. Janet
also uses `setjmp`/`longjmp` for non-local returns internally. This
approach is out of favor with many programmers now and doesn't always play well with other languages
that have exceptions or stack-unwinding.

View File

@@ -41,34 +41,32 @@ if not exist build\boot mkdir build\boot
@rem Build the bootstrap interpreter
for %%f in (src\core\*.c) do (
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
@if not errorlevel 0 goto :BUILDFAIL
@if errorlevel 1 goto :BUILDFAIL
)
for %%f in (src\boot\*.c) do (
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
@if not errorlevel 0 goto :BUILDFAIL
@if errorlevel 1 goto :BUILDFAIL
)
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
@if not errorlevel 0 goto :BUILDFAIL
@if errorlevel 1 goto :BUILDFAIL
build\janet_boot . > build\c\janet.c
@if not errorlevel 0 goto :BUILDFAIL
@rem Build the sources
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
@if not errorlevel 0 goto :BUILDFAIL
@if errorlevel 1 goto :BUILDFAIL
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
@if not errorlevel 0 goto :BUILDFAIL
@if errorlevel 1 goto :BUILDFAIL
@rem Build the resources
rc /nologo /fobuild\janet_win.res janet_win.rc
@if not errorlevel 0 goto :BUILDFAIL
@rem Link everything to main client
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
@if not errorlevel 0 goto :BUILDFAIL
@if errorlevel 1 goto :BUILDFAIL
@rem Build static library (libjanet.lib)
@rem Build static library (libjanet.a)
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
@if not errorlevel 0 goto :BUILDFAIL
@if errorlevel 1 goto :BUILDFAIL
echo === Successfully built janet.exe for Windows ===
echo === Run 'build_win test' to run tests. ==
@@ -93,16 +91,14 @@ exit /b 0
:CLEAN
del *.exe *.lib *.exp
rd /s /q build
if exist dist (
rd /s /q dist
)
rd /s /q dist
exit /b 0
@rem Run tests
:TEST
for %%f in (test/suite*.janet) do (
janet.exe test\%%f
@if not errorlevel 0 goto TESTFAIL
@if errorlevel 1 goto TESTFAIL
)
exit /b 0

View File

@@ -1,35 +0,0 @@
(def conmap @{})
(defn broadcast [em msg]
(eachk par conmap
(if (not= par em)
(if-let [tar (get conmap par)]
(net/write tar (string/format "[%s]:%s" em msg))))))
(defn handler
[connection]
(print "connection: " connection)
(net/write connection "Whats your name?\n")
(def name (string/trim (string (ev/read connection 100))))
(print name " connected")
(if (get conmap name)
(do
(net/write connection "Name already taken!")
(:close connection))
(do
(put conmap name connection)
(net/write connection (string/format "Welcome %s\n" name))
(defer (do
(put conmap name nil)
(:close connection))
(while (def msg (ev/read connection 100))
(broadcast name (string msg)))
(print name " disconnected")))))
(defn main [& args]
(printf "STARTING SERVER...")
(flush)
(def my-server (net/listen "127.0.0.1" "8000"))
(forever
(def connection (net/accept my-server))
(ev/call handler connection)))

View File

@@ -35,11 +35,6 @@ typedef struct {
int c;
} intintint;
typedef struct {
uint64_t a;
uint64_t b;
} uint64pair;
typedef struct {
int64_t a;
int64_t b;
@@ -208,20 +203,3 @@ EXPORTER
int sixints_fn_3(SixInts s, int x) {
return x + s.u + s.v + s.w + s.x + s.y + s.z;
}
EXPORTER
intint stack_spill_fn(uint8_t a, uint8_t b, uint8_t c, uint8_t d,
uint8_t e, uint8_t f, uint8_t g, uint8_t h,
float i, float j, float k, float l,
float m, float n, float o, float p,
float s1, int8_t s2, uint8_t s3, double s4, uint8_t s5, intint s6) {
return (intint) {
(a | b | c | d | e | f | g | h) + (i + j + k + l + m + n + o + p),
s1 *s6.a + s2 *s6.b + s3 *s4 *s5
};
}
EXPORTER
double stack_spill_fn_2(uint64pair a, uint64pair b, uint64pair c, int8_t d, uint64pair e, int8_t f) {
return (double)(a.a * c.a + a.b * c.b + b.a * e.a) * f - (double)(b.b * e.b) + d;
}

View File

@@ -8,13 +8,11 @@
(if is-windows
(os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
(os/execute ["cc" ffi/source-loc "-g" "-shared" "-o" ffi/loc] :px))
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px))
(ffi/context ffi/loc)
(def intint (ffi/struct :int :int))
(def intintint (ffi/struct :int :int :int))
(def uint64pair (ffi/struct :u64 :u64))
(def big (ffi/struct :s64 :s64 :s64))
(def split (ffi/struct :int :int :float :float))
(def split-flip (ffi/struct :float :float :int :int))
@@ -57,14 +55,6 @@
(ffi/defbind sixints-fn six-ints [])
(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
(ffi/defbind stack-spill-fn intint
[a :u8 b :u8 c :u8 d :u8
e :u8 f :u8 g :u8 h :u8
i :float j :float k :float l :float
m :float n :float o :float p :float
s1 :float s2 :s8 s3 :u8 s4 :double s5 :u8 s6 intint])
(ffi/defbind stack-spill-fn-2 :double [a uint64pair b uint64pair c uint64pair d :s8 e uint64pair f :s8])
(ffi/defbind-alias int-fn int-fn-aliased :int [a :int b :int])
#
# Struct reading and writing
@@ -129,7 +119,6 @@
(tracev (return-struct 42))
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
(tracev (struct-big 11 99.5))
(tracev (int-fn-aliased 10 20))
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
@@ -141,10 +130,5 @@
(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
(assert (= 204 (float-fn 8 4 17)))
(assert (= [0 38534415] (stack-spill-fn
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
1.5 -32 196 65536.5 3 [-15 32])))
(assert (= -2806 (stack-spill-fn-2 [2 3] [5 7] [9 11] -19 [13 17] -23)))
(print "Done.")

View File

@@ -1,5 +0,0 @@
# Switch to python
(print "running in Janet")
(os/posix-exec ["python"] :p)
(print "will not print")

View File

@@ -1 +0,0 @@
(def abc 123)

View File

@@ -1,7 +0,0 @@
(defn install
[manifest &]
(bundle/add-file manifest "badmod.janet"))
(defn check
[&]
(error "Check failed!"))

View File

@@ -1 +0,0 @@
(defn fun [x] (range x))

View File

@@ -1,3 +0,0 @@
(defn install
[manifest &]
(bundle/add-file manifest "aliases-mod.janet"))

View File

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

View File

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

View File

@@ -1,3 +0,0 @@
(defn install
[manifest &]
(bundle/add-file manifest "mymod.janet"))

View File

@@ -1,7 +0,0 @@
(import dep1)
(import dep2)
(defn myfn
[x]
(def y (dep2/function x))
(dep1/function y))

View File

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

View File

@@ -1,3 +0,0 @@
(defn install
[manifest &]
(bundle/add-file manifest "dep1.janet"))

View File

@@ -1,3 +0,0 @@
(defn function
[x]
(+ x x))

View File

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

View File

@@ -1,3 +0,0 @@
(defn install
[manifest &]
(bundle/add-file manifest "dep2.janet"))

View File

@@ -1,3 +0,0 @@
(defn function
[x]
(* x x))

View File

@@ -1,41 +0,0 @@
###
### Usage: janet examples/sigaction.janet 1|2|3|4 &
###
### Then at shell: kill -s SIGTERM $!
###
(defn action
[]
(print "Handled SIGTERM!")
(flush)
(os/exit 1))
(defn main1
[]
(os/sigaction :term action true)
(forever))
(defn main2
[]
(os/sigaction :term action)
(forever))
(defn main3
[]
(os/sigaction :term action true)
(forever (ev/sleep math/inf)))
(defn main4
[]
(os/sigaction :term action)
(forever (ev/sleep math/inf)))
(defn main
[& args]
(def which (scan-number (get args 1 "1")))
(case which
1 (main1) # should work
2 (main2) # will not work
3 (main3) # should work
4 (main4) # should work
(error "bad main")))

View File

@@ -1,20 +0,0 @@
(def weak-k (table/weak-keys 10))
(def weak-v (table/weak-values 10))
(def weak-kv (table/weak 10))
(put weak-kv (gensym) 10)
(put weak-kv :hello :world)
(put weak-k :abc123zz77asda :stuff)
(put weak-k true :abc123zz77asda)
(put weak-k :zyzzyz false)
(put weak-v (gensym) 10)
(put weak-v 20 (gensym))
(print "before gc")
(tracev weak-k)
(tracev weak-v)
(tracev weak-kv)
(gccollect)
(print "after gc")
(tracev weak-k)
(tracev weak-v)
(tracev weak-kv)

View File

@@ -255,8 +255,7 @@ and then arguments to the script.
.RS
The location to look for Janet libraries. This is the only environment variable Janet needs to
find native and source code modules. If no JANET_PATH is set, Janet will look in
the default location set at compile time. This should be a list of as well as a colon
separate list of such directories.
the default location set at compile time.
.RE
.B JANET_PROFILE

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2024 Calvin Rose and contributors
# Copyright (c) 2023 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.37.0')
version : '1.29.1')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -61,7 +61,6 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
conf.set('JANET_NO_PEG', not get_option('peg'))
conf.set('JANET_NO_NET', not get_option('net'))
conf.set('JANET_NO_IPV6', not get_option('ipv6'))
conf.set('JANET_NO_EV', not get_option('ev') or get_option('single_threaded'))
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
@@ -79,8 +78,6 @@ conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
conf.set('JANET_NO_FFI', not get_option('ffi'))
conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit'))
conf.set('JANET_NO_FILEWATCH', not get_option('filewatch'))
conf.set('JANET_NO_CRYPTORAND', not get_option('cryptorand'))
if get_option('os_name') != ''
conf.set('JANET_OS_NAME', get_option('os_name'))
endif
@@ -123,7 +120,6 @@ core_src = [
'src/core/ev.c',
'src/core/ffi.c',
'src/core/fiber.c',
'src/core/filewatch.c',
'src/core/gc.c',
'src/core/inttypes.c',
'src/core/io.c',
@@ -173,7 +169,7 @@ janet_boot = executable('janet-boot', core_src, boot_src,
# Build janet.c
janetc = custom_target('janetc',
input : [janet_boot, 'src/boot/boot.janet'],
input : [janet_boot],
output : 'janet.c',
capture : true,
command : [
@@ -186,41 +182,25 @@ if not get_option('single_threaded')
janet_dependencies += thread_dep
endif
# Allow building with no shared library
if cc.has_argument('-fvisibility=hidden')
lib_cflags = ['-fvisibility=hidden']
else
lib_cflags = []
endif
if get_option('shared')
libjanet = library('janet', janetc,
include_directories : incdir,
dependencies : janet_dependencies,
version: meson.project_version(),
soversion: version_parts[0] + '.' + version_parts[1],
c_args : lib_cflags,
install : true)
libjanet = library('janet', janetc,
include_directories : incdir,
dependencies : janet_dependencies,
version: meson.project_version(),
soversion: version_parts[0] + '.' + version_parts[1],
install : true)
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
# shaves off about 10k on linux x64, likely similar on other platforms.
if cc.has_argument('-fvisibility=hidden')
extra_cflags = ['-fvisibility=hidden', '-DJANET_DLL_IMPORT']
else
extra_cflags = ['-DJANET_DLL_IMPORT']
endif
janet_mainclient = executable('janet', mainclient_src,
include_directories : incdir,
dependencies : janet_dependencies,
link_with: [libjanet],
c_args : extra_cflags,
install : true)
if cc.has_argument('-fvisibility=hidden')
extra_cflags = ['-fvisibility=hidden']
else
# No shared library
janet_mainclient = executable('janet', mainclient_src, janetc,
include_directories : incdir,
dependencies : janet_dependencies,
c_args : lib_cflags,
install : true)
extra_cflags = []
endif
janet_mainclient = executable('janet', janetc, mainclient_src,
include_directories : incdir,
dependencies : janet_dependencies,
c_args : extra_cflags,
install : true)
if meson.is_cross_build()
native_cc = meson.get_compiler('c', native: true)
@@ -251,7 +231,6 @@ test_files = [
'test/suite-asm.janet',
'test/suite-boot.janet',
'test/suite-buffer.janet',
'test/suite-bundle.janet',
'test/suite-capi.janet',
'test/suite-cfuns.janet',
'test/suite-compile.janet',
@@ -259,7 +238,6 @@ test_files = [
'test/suite-debug.janet',
'test/suite-ev.janet',
'test/suite-ffi.janet',
'test/suite-filewatch.janet',
'test/suite-inttypes.janet',
'test/suite-io.janet',
'test/suite-marsh.janet',
@@ -274,7 +252,6 @@ test_files = [
'test/suite-struct.janet',
'test/suite-symcache.janet',
'test/suite-table.janet',
'test/suite-tuple.janet',
'test/suite-unknown.janet',
'test/suite-value.janet',
'test/suite-vm.janet'
@@ -287,15 +264,14 @@ endforeach
run_target('repl', command : [janet_nativeclient])
# For use as meson subproject (wrap)
if get_option('shared')
janet_dep = declare_dependency(include_directories : incdir,
link_with : libjanet)
janet_dep = declare_dependency(include_directories : incdir,
link_with : libjanet)
# pkgconfig
pkg = import('pkgconfig')
pkg.generate(libjanet,
subdirs: 'janet',
description: 'Library for the Janet programming language.')
endif
pkg = import('pkgconfig')
pkg.generate(libjanet,
subdirs: 'janet',
description: 'Library for the Janet programming language.')
# Installation
install_man('janet.1')
@@ -305,12 +281,11 @@ patched_janet = custom_target('patched-janeth',
install : true,
install_dir : join_paths(get_option('includedir'), 'janet'),
build_by_default : true,
output : ['janet_' + meson.project_version() + '.h'],
output : ['janet.h'],
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
# Create a version of the janet.h header that matches what jpm often expects
if meson.version().version_compare('>=0.61')
install_symlink('janet.h', pointing_to: 'janet/janet_' + meson.project_version() + '.h', install_dir: get_option('includedir'))
install_symlink('janet.h', pointing_to: 'janet_' + meson.project_version() + '.h', install_dir: join_paths(get_option('includedir'), 'janet'))
install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir'))
endif

View File

@@ -11,18 +11,16 @@ option('peg', type : 'boolean', value : true)
option('int_types', type : 'boolean', value : true)
option('prf', type : 'boolean', value : false)
option('net', type : 'boolean', value : true)
option('ipv6', type : 'boolean', value : true)
option('ev', type : 'boolean', value : true)
option('processes', type : 'boolean', value : true)
option('umask', type : 'boolean', value : true)
option('realpath', type : 'boolean', value : true)
option('simple_getline', type : 'boolean', value : false)
option('epoll', type : 'boolean', value : true)
option('kqueue', type : 'boolean', value : true)
option('interpreter_interrupt', type : 'boolean', value : true)
option('epoll', type : 'boolean', value : false)
option('kqueue', type : 'boolean', value : false)
option('interpreter_interrupt', type : 'boolean', value : false)
option('ffi', type : 'boolean', value : true)
option('ffi_jit', type : 'boolean', value : true)
option('filewatch', type : 'boolean', value : true)
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
@@ -31,5 +29,3 @@ option('stack_max', type : 'integer', min : 8096, max : 0x7fffffff, value : 0x7f
option('arch_name', type : 'string', value: '')
option('os_name', type : 'string', value: '')
option('shared', type : 'boolean', value: true)
option('cryptorand', type : 'boolean', value: true)

View File

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

View File

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

File diff suppressed because it is too large Load Diff

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -22,7 +22,7 @@
#include <janet.h>
#include <assert.h>
#include <string.h>
#include <stdio.h>
#include <math.h>
#include "tests.h"
@@ -35,11 +35,6 @@ int system_test() {
assert(sizeof(void *) == 8);
#endif
/* Check the version defines are self consistent */
char version_combined[256];
sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
assert(!strcmp(JANET_VERSION, version_combined));
/* Reflexive testing and nanbox testing */
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));

View File

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

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 37
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.37.0-dev"
#define JANET_VERSION_MINOR 29
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.29.1"
/* #define JANET_BUILD "local" */
@@ -29,7 +29,6 @@
/* #define JANET_NO_NET */
/* #define JANET_NO_INT_TYPES */
/* #define JANET_NO_EV */
/* #define JANET_NO_FILEWATCH */
/* #define JANET_NO_REALPATH */
/* #define JANET_NO_SYMLINKS */
/* #define JANET_NO_UMASK */
@@ -53,9 +52,6 @@
/* #define JANET_EV_NO_EPOLL */
/* #define JANET_EV_NO_KQUEUE */
/* #define JANET_NO_INTERPRETER_INTERRUPT */
/* #define JANET_NO_IPV6 */
/* #define JANET_NO_CRYPTORAND */
/* #define JANET_USE_STDATOMIC */
/* Custom vm allocator support */
/* #include <mimalloc.h> */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -31,6 +31,8 @@
#ifdef JANET_EV
#ifdef JANET_WINDOWS
#include <windows.h>
#else
#include <stdatomic.h>
#endif
#endif
@@ -95,6 +97,14 @@ size_t janet_os_rwlock_size(void) {
return sizeof(void *);
}
static int32_t janet_incref(JanetAbstractHead *ab) {
return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount);
}
static int32_t janet_decref(JanetAbstractHead *ab) {
return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount);
}
void janet_os_mutex_init(JanetOSMutex *mutex) {
InitializeCriticalSection((CRITICAL_SECTION *) mutex);
}
@@ -147,6 +157,14 @@ size_t janet_os_rwlock_size(void) {
return sizeof(pthread_rwlock_t);
}
static int32_t janet_incref(JanetAbstractHead *ab) {
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
}
static int32_t janet_decref(JanetAbstractHead *ab) {
return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
}
void janet_os_mutex_init(JanetOSMutex *mutex) {
pthread_mutexattr_t attr;
pthread_mutexattr_init(&attr);
@@ -194,11 +212,11 @@ void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
#endif
int32_t janet_abstract_incref(void *abst) {
return janet_atomic_inc(&janet_abstract_head(abst)->gc.data.refcount);
return janet_incref(janet_abstract_head(abst));
}
int32_t janet_abstract_decref(void *abst) {
return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
return janet_decref(janet_abstract_head(abst));
}
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -30,7 +30,9 @@
#include <string.h>
static void janet_array_impl(JanetArray *array, int32_t capacity) {
/* Creates a new array */
JanetArray *janet_array(int32_t capacity) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
Janet *data = NULL;
if (capacity > 0) {
janet_vm.next_collection += capacity * sizeof(Janet);
@@ -42,19 +44,6 @@ static void janet_array_impl(JanetArray *array, int32_t capacity) {
array->count = 0;
array->capacity = capacity;
array->data = data;
}
/* Creates a new array */
JanetArray *janet_array(int32_t capacity) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
janet_array_impl(array, capacity);
return array;
}
/* Creates a new array with weak references */
JanetArray *janet_array_weak(int32_t capacity) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY_WEAK, sizeof(JanetArray));
janet_array_impl(array, capacity);
return array;
}
@@ -143,15 +132,6 @@ JANET_CORE_FN(cfun_array_new,
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_weak,
"(array/weak capacity)",
"Creates a new empty array with a pre-allocated capacity and support for weak references. Similar to `array/new`.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getinteger(argv, 0);
JanetArray *array = janet_array_weak(cap);
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_new_filled,
"(array/new-filled count &opt value)",
"Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") {
@@ -197,8 +177,8 @@ JANET_CORE_FN(cfun_array_peek,
}
JANET_CORE_FN(cfun_array_push,
"(array/push arr & xs)",
"Push all the elements of xs to the end of an array. Modifies the input array and returns it.") {
"(array/push arr x)",
"Insert an element in the end of an array. Modifies the input array and returns it.") {
janet_arity(argc, 1, -1);
JanetArray *array = janet_getarray(argv, 0);
if (INT32_MAX - argc + 1 <= array->count) {
@@ -231,7 +211,7 @@ JANET_CORE_FN(cfun_array_slice,
"Takes a slice of array or tuple from `start` to `end`. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the "
"end of the array. By default, `start` is 0 and `end` is the length of the array. "
"Note that if the range is negative, it is taken as (start, end] to allow a full "
"Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
"negative slice range. Returns a new array.") {
JanetView view = janet_getindexed(argv, 0);
JanetRange range = janet_getslice(argc, argv);
@@ -275,37 +255,12 @@ JANET_CORE_FN(cfun_array_concat,
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_join,
"(array/join arr & parts)",
"Join a variable number of arrays and tuples into the first argument, "
"which must be an array. "
"Return the modified array `arr`.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetArray *array = janet_getarray(argv, 0);
for (i = 1; i < argc; i++) {
int32_t j, len = 0;
const Janet *vals = NULL;
if (!janet_indexed_view(argv[i], &vals, &len)) {
janet_panicf("expected indexed type for argument %d, got %v", i, argv[i]);
}
if (array->data == vals) {
int32_t newcount = array->count + len;
janet_array_ensure(array, newcount, 2);
janet_indexed_view(argv[i], &vals, &len);
}
for (j = 0; j < len; j++)
janet_array_push(array, vals[j]);
}
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_insert,
"(array/insert arr at & xs)",
"Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
"0 and the length of the array. A negative value for `at` will index backwards from "
"the end of the array, inserting after the index such that inserting at -1 appends to "
"the array. Returns the array.") {
"the end of the array, such that inserting at -1 appends to the array. "
"Returns the array.") {
size_t chunksize, restsize;
janet_arity(argc, 2, -1);
JanetArray *array = janet_getarray(argv, 0);
@@ -342,7 +297,7 @@ JANET_CORE_FN(cfun_array_remove,
int32_t at = janet_getinteger(argv, 1);
int32_t n = 1;
if (at < 0) {
at = array->count + at;
at = array->count + at + 1;
}
if (at < 0 || at > array->count)
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
@@ -397,7 +352,6 @@ JANET_CORE_FN(cfun_array_clear,
void janet_lib_array(JanetTable *env) {
JanetRegExt array_cfuns[] = {
JANET_CORE_REG("array/new", cfun_array_new),
JANET_CORE_REG("array/weak", cfun_array_weak),
JANET_CORE_REG("array/new-filled", cfun_array_new_filled),
JANET_CORE_REG("array/fill", cfun_array_fill),
JANET_CORE_REG("array/pop", cfun_array_pop),
@@ -410,7 +364,6 @@ void janet_lib_array(JanetTable *env) {
JANET_CORE_REG("array/remove", cfun_array_remove),
JANET_CORE_REG("array/trim", cfun_array_trim),
JANET_CORE_REG("array/clear", cfun_array_clear),
JANET_CORE_REG("array/join", cfun_array_join),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, array_cfuns);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -75,7 +75,6 @@ static const JanetInstructionDef janet_ops[] = {
{"cmp", JOP_COMPARE},
{"cncl", JOP_CANCEL},
{"div", JOP_DIVIDE},
{"divf", JOP_DIVIDE_FLOOR},
{"divim", JOP_DIVIDE_IMMEDIATE},
{"eq", JOP_EQUALS},
{"eqim", JOP_EQUALS_IMMEDIATE},
@@ -138,7 +137,6 @@ static const JanetInstructionDef janet_ops[] = {
{"sru", JOP_SHIFT_RIGHT_UNSIGNED},
{"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
{"sub", JOP_SUBTRACT},
{"subim", JOP_SUBTRACT_IMMEDIATE},
{"tcall", JOP_TAILCALL},
{"tchck", JOP_TYPECHECK}
};
@@ -560,9 +558,6 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
x = janet_get1(s, janet_ckeywordv("vararg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
/* Initialize slotcount */
def->slotcount = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG) + def->arity;
/* Check structarg */
x = janet_get1(s, janet_ckeywordv("structarg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
@@ -787,9 +782,8 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Verify the func def */
int verify_status = janet_verify(def);
if (verify_status) {
janet_asm_errorv(&a, janet_formatc("invalid assembly (%d)", verify_status));
if (janet_verify(def)) {
janet_asm_error(&a, "invalid assembly");
}
/* Add final flags */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -135,7 +135,8 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
/* Push a cstring to buffer */
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
int32_t len = (int32_t) strlen(cstring);
int32_t len = 0;
while (cstring[len]) ++len;
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
}
@@ -220,20 +221,6 @@ JANET_CORE_FN(cfun_buffer_new_filled,
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_frombytes,
"(buffer/from-bytes & byte-vals)",
"Creates a buffer from integer parameters with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.") {
int32_t i;
JanetBuffer *buffer = janet_buffer(argc);
for (i = 0; i < argc; i++) {
int32_t c = janet_getinteger(argv, i);
buffer->data[i] = c & 0xFF;
}
buffer->count = argc;
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_fill,
"(buffer/fill buffer &opt byte)",
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
@@ -320,133 +307,6 @@ JANET_CORE_FN(cfun_buffer_chars,
return argv[0];
}
static int should_reverse_bytes(const Janet *argv, int32_t argc) {
JanetKeyword order_kw = janet_getkeyword(argv, argc);
if (!janet_cstrcmp(order_kw, "le")) {
#if JANET_BIG_ENDIAN
return 1;
#endif
} else if (!janet_cstrcmp(order_kw, "be")) {
#if JANET_LITTLE_ENDIAN
return 1;
#endif
} else if (!janet_cstrcmp(order_kw, "native")) {
return 0;
} else {
janet_panicf("expected endianness :le, :be or :native, got %v", argv[1]);
}
return 0;
}
static void reverse_u32(uint8_t bytes[4]) {
uint8_t temp;
temp = bytes[3];
bytes[3] = bytes[0];
bytes[0] = temp;
temp = bytes[2];
bytes[2] = bytes[1];
bytes[1] = temp;
}
static void reverse_u64(uint8_t bytes[8]) {
uint8_t temp;
temp = bytes[7];
bytes[7] = bytes[0];
bytes[0] = temp;
temp = bytes[6];
bytes[6] = bytes[1];
bytes[1] = temp;
temp = bytes[5];
bytes[5] = bytes[2];
bytes[2] = temp;
temp = bytes[4];
bytes[4] = bytes[3];
bytes[3] = temp;
}
JANET_CORE_FN(cfun_buffer_push_uint16,
"(buffer/push-uint16 buffer order data)",
"Push a 16 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
uint16_t data = janet_getuinteger16(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse) {
uint8_t temp = bytes[1];
bytes[1] = bytes[0];
bytes[0] = temp;
}
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_uint32,
"(buffer/push-uint32 buffer order data)",
"Push a 32 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
uint32_t data = janet_getuinteger(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse)
reverse_u32(bytes);
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_uint64,
"(buffer/push-uint64 buffer order data)",
"Push a 64 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
uint64_t data = janet_getuinteger64(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse)
reverse_u64(bytes);
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_float32,
"(buffer/push-float32 buffer order data)",
"Push the underlying bytes of a 32 bit float data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
float data = (float) janet_getnumber(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse)
reverse_u32(bytes);
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_float64,
"(buffer/push-float64 buffer order data)",
"Push the underlying bytes of a 64 bit float data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
double data = janet_getnumber(argv, 2);
uint8_t bytes[sizeof(data)];
memcpy(bytes, &data, sizeof(bytes));
if (reverse)
reverse_u64(bytes);
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0];
}
static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) {
for (int32_t i = argc_offset; i < argc; i++) {
if (janet_checktype(argv[i], JANET_NUMBER)) {
@@ -602,15 +462,13 @@ JANET_CORE_FN(cfun_buffer_blit,
int same_buf = src.bytes == dest->data;
int32_t offset_dest = 0;
int32_t offset_src = 0;
if (argc > 2 && !janet_checktype(argv[2], JANET_NIL))
if (argc > 2)
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
if (argc > 3 && !janet_checktype(argv[3], JANET_NIL))
if (argc > 3)
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
int32_t length_src;
if (argc > 4) {
int32_t src_end = src.len;
if (!janet_checktype(argv[4], JANET_NIL))
src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
length_src = src_end - offset_src;
if (length_src < 0) length_src = 0;
} else {
@@ -645,42 +503,15 @@ JANET_CORE_FN(cfun_buffer_format,
return argv[0];
}
JANET_CORE_FN(cfun_buffer_format_at,
"(buffer/format-at buffer at format & args)",
"Snprintf like functionality for printing values into a buffer. Returns "
"the modified buffer.") {
janet_arity(argc, 2, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int32_t at = janet_getinteger(argv, 1);
if (at < 0) {
at += buffer->count + 1;
}
if (at > buffer->count || at < 0) janet_panicf("expected index at to be in range [0, %d), got %d", buffer->count, at);
int32_t oldcount = buffer->count;
buffer->count = at;
const char *strfrmt = (const char *) janet_getstring(argv, 2);
janet_buffer_format(buffer, strfrmt, 2, argc, argv);
if (buffer->count < oldcount) {
buffer->count = oldcount;
}
return argv[0];
}
void janet_lib_buffer(JanetTable *env) {
JanetRegExt buffer_cfuns[] = {
JANET_CORE_REG("buffer/new", cfun_buffer_new),
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
JANET_CORE_REG("buffer/from-bytes", cfun_buffer_frombytes),
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
JANET_CORE_REG("buffer/push-uint16", cfun_buffer_push_uint16),
JANET_CORE_REG("buffer/push-uint32", cfun_buffer_push_uint32),
JANET_CORE_REG("buffer/push-uint64", cfun_buffer_push_uint64),
JANET_CORE_REG("buffer/push-float32", cfun_buffer_push_float32),
JANET_CORE_REG("buffer/push-float64", cfun_buffer_push_float64),
JANET_CORE_REG("buffer/push", cfun_buffer_push),
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
@@ -692,7 +523,6 @@ void janet_lib_buffer(JanetTable *env) {
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
JANET_CORE_REG("buffer/format", cfun_buffer_format),
JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, buffer_cfuns);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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,13 +37,11 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_0, /* JOP_RETURN_NIL, */
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
JINT_SSS, /* JOP_ADD, */
JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */
JINT_SSS, /* JOP_SUBTRACT, */
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
JINT_SSS, /* JOP_MULTIPLY, */
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
JINT_SSS, /* JOP_DIVIDE, */
JINT_SSS, /* JOP_DIVIDE_FLOOR */
JINT_SSS, /* JOP_MODULO, */
JINT_SSS, /* JOP_REMAINDER, */
JINT_SSS, /* JOP_BAND, */
@@ -140,7 +138,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
/* relative pc is in DS field of instruction */
old_jump_target = i + (((int32_t)instr) >> 8);
new_jump_target = pc_map[old_jump_target];
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 8;
instr += (new_jump_target - old_jump_target + (i - j)) << 8;
break;
case JOP_JUMP_IF:
case JOP_JUMP_IF_NIL:
@@ -149,7 +147,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
/* relative pc is in ES field of instruction */
old_jump_target = i + (((int32_t)instr) >> 16);
new_jump_target = pc_map[old_jump_target];
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 16;
instr += (new_jump_target - old_jump_target + (i - j)) << 16;
break;
default:
break;
@@ -226,7 +224,6 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_LOAD_TRUE:
case JOP_LOAD_FALSE:
case JOP_LOAD_SELF:
break;
case JOP_MAKE_ARRAY:
case JOP_MAKE_BUFFER:
case JOP_MAKE_STRING:
@@ -234,8 +231,6 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_MAKE_TABLE:
case JOP_MAKE_TUPLE:
case JOP_MAKE_BRACKET_TUPLE:
/* Reads from the stack, don't remove */
janetc_regalloc_touch(&ra, DD);
break;
/* Read A */
@@ -255,7 +250,6 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_SIGNAL:
/* Write A, Read B */
case JOP_ADD_IMMEDIATE:
case JOP_SUBTRACT_IMMEDIATE:
case JOP_MULTIPLY_IMMEDIATE:
case JOP_DIVIDE_IMMEDIATE:
case JOP_SHIFT_LEFT_IMMEDIATE:
@@ -307,7 +301,6 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_SUBTRACT:
case JOP_MULTIPLY:
case JOP_DIVIDE:
case JOP_DIVIDE_FLOOR:
case JOP_MODULO:
case JOP_REMAINDER:
case JOP_SHIFT_LEFT:

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -25,24 +25,14 @@
#include <janet.h>
#include "state.h"
#include "fiber.h"
#include "util.h"
#endif
#ifndef JANET_SINGLE_THREADED
#ifndef JANET_WINDOWS
#include <pthread.h>
#endif
#endif
#ifdef JANET_WINDOWS
#else
#include <windows.h>
#endif
#ifdef JANET_USE_STDATOMIC
#include <stdatomic.h>
/* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations.
* Some (TCC), explicitly require using stdatomic.h and don't have any exposed builtins (that I know of).
* For TCC and similar compilers, one would need -std=c11 or similar then to get access. */
#endif
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
@@ -226,32 +216,12 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
}
const char *janet_getcbytes(const Janet *argv, int32_t n) {
/* Ensure buffer 0-padded */
if (janet_checktype(argv[n], JANET_BUFFER)) {
JanetBuffer *b = janet_unwrap_buffer(argv[n]);
if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) {
/* Make a copy with janet_smalloc in the rare case we have a buffer that
* cannot be realloced and pushing a 0 byte would panic. */
char *new_string = janet_smalloc(b->count + 1);
memcpy(new_string, b->data, b->count);
new_string[b->count] = 0;
if (strlen(new_string) != (size_t) b->count) goto badzeros;
return new_string;
} else {
/* Ensure trailing 0 */
janet_buffer_push_u8(b, 0);
b->count--;
if (strlen((char *)b->data) != (size_t) b->count) goto badzeros;
return (const char *) b->data;
}
}
JanetByteView view = janet_getbytes(argv, n);
const char *cstr = (const char *)view.bytes;
if (strlen(cstr) != (size_t) view.len) goto badzeros;
if (strlen(cstr) != (size_t) view.len) {
janet_panic("bytes contain embedded 0s");
}
return cstr;
badzeros:
janet_panic("bytes contain embedded 0s");
}
const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
@@ -306,28 +276,11 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkuint(x)) {
janet_panicf("bad slot #%d, expected 32 bit unsigned integer, got %v", n, x);
janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
}
return (uint32_t) janet_unwrap_number(x);
return janet_unwrap_integer(x);
}
int16_t janet_getinteger16(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkint16(x)) {
janet_panicf("bad slot #%d, expected 16 bit signed integer, got %v", n, x);
}
return (int16_t) janet_unwrap_number(x);
}
uint16_t janet_getuinteger16(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkuint16(x)) {
janet_panicf("bad slot #%d, expected 16 bit unsigned integer, got %v", n, x);
}
return (uint16_t) janet_unwrap_number(x);
}
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
#ifdef JANET_INT_TYPES
return janet_unwrap_s64(argv[n]);
@@ -365,30 +318,16 @@ int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const c
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length + 1;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d]", which, (int64_t) raw, -(int64_t)length - 1, (int64_t) length);
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
return not_raw;
}
int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return 0;
}
return janet_gethalfrange(argv, n, length, "start");
}
int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return length;
}
return janet_gethalfrange(argv, n, length, "end");
}
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d)", which, (int64_t)raw, -(int64_t)length, (int64_t)length);
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
return not_raw;
}
@@ -435,10 +374,24 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
janet_arity(argc, 1, 3);
JanetRange range;
int32_t length = janet_length(argv[0]);
range.start = janet_getstartrange(argv, argc, 1, length);
range.end = janet_getendrange(argv, argc, 2, length);
if (range.end < range.start)
range.end = range.start;
if (argc == 1) {
range.start = 0;
range.end = length;
} else if (argc == 2) {
range.start = janet_checktype(argv[1], JANET_NIL)
? 0
: janet_gethalfrange(argv, 1, length, "start");
range.end = length;
} else {
range.start = janet_checktype(argv[1], JANET_NIL)
? 0
: janet_gethalfrange(argv, 1, length, "start");
range.end = janet_checktype(argv[2], JANET_NIL)
? length
: janet_gethalfrange(argv, 2, length, "end");
if (range.end < range.start)
range.end = range.start;
}
return range;
}
@@ -466,33 +419,6 @@ void janet_setdyn(const char *name, Janet value) {
}
}
/* Create a function that when called, returns X. Trivial in Janet, a pain in C. */
JanetFunction *janet_thunk_delay(Janet x) {
static const uint32_t bytecode[] = {
JOP_LOAD_CONSTANT,
JOP_RETURN
};
JanetFuncDef *def = janet_funcdef_alloc();
def->arity = 0;
def->min_arity = 0;
def->max_arity = INT32_MAX;
def->flags = JANET_FUNCDEF_FLAG_VARARG;
def->slotcount = 1;
def->bytecode = janet_malloc(sizeof(bytecode));
def->bytecode_length = (int32_t)(sizeof(bytecode) / sizeof(uint32_t));
def->constants = janet_malloc(sizeof(Janet));
def->constants_length = 1;
def->name = NULL;
if (!def->bytecode || !def->constants) {
JANET_OUT_OF_MEMORY;
}
def->constants[0] = x;
memcpy(def->bytecode, bytecode, sizeof(bytecode));
janet_def_addflags(def);
/* janet_verify(def); */
return janet_thunk(def);
}
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
uint64_t ret = 0;
const uint8_t *keyw = janet_getkeyword(argv, n);
@@ -545,41 +471,9 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
return janet_getabstract(argv, n, at);
}
/* Atomic refcounts */
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
#ifdef _MSC_VER
return _InterlockedIncrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
#else
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
#endif
}
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
#ifdef _MSC_VER
return _InterlockedDecrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
#else
return __atomic_add_fetch(x, -1, __ATOMIC_ACQ_REL);
#endif
}
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
#ifdef _MSC_VER
return _InterlockedOr(x, 0);
#elif defined(JANET_USE_STDATOMIC)
return atomic_load_explicit(x, memory_order_acquire);
#else
return __atomic_load_n(x, __ATOMIC_ACQUIRE);
#endif
}
/* Some definitions for function-like macros */
JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
return janet_struct_head(st);
}
@@ -587,10 +481,10 @@ JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
return janet_abstract_head(abstract);
}
JANET_API JanetStringHead *(janet_string_head)(JanetString s) {
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
return janet_string_head(s);
}
JANET_API JanetTupleHead *(janet_tuple_head)(JanetTuple tuple) {
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
return janet_tuple_head(tuple);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -99,7 +99,7 @@ static JanetSlot opfunction(
static int can_be_imm(Janet x, int8_t *out) {
if (!janet_checkint(x)) return 0;
int32_t integer = janet_unwrap_integer(x);
if (integer > INT8_MAX || integer < INT8_MIN) return 0;
if (integer > 127 || integer < -127) return 0;
*out = (int8_t) integer;
return 1;
}
@@ -116,11 +116,12 @@ static JanetSlot opreduce(
JanetSlot *args,
int op,
int opim,
Janet nullary,
Janet unary) {
Janet nullary) {
JanetCompiler *c = opts.compiler;
int32_t i, len;
int8_t imm = 0;
int neg = opim < 0;
if (opim < 0) opim = -opim;
len = janet_v_count(args);
JanetSlot t;
if (len == 0) {
@@ -131,19 +132,19 @@ static JanetSlot opreduce(
if (op == JOP_SUBTRACT) {
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
} else {
janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1);
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
}
return t;
}
t = janetc_gettarget(opts);
if (opim && can_slot_be_imm(args[1], &imm)) {
janetc_emit_ssi(c, opim, t, args[0], imm, 1);
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
} else {
janetc_emit_sss(c, op, t, args[0], args[1], 1);
}
for (i = 2; i < len; i++) {
if (opim && can_slot_be_imm(args[i], &imm)) {
janetc_emit_ssi(c, opim, t, t, imm, 1);
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
} else {
janetc_emit_sss(c, op, t, t, args[i], 1);
}
@@ -154,7 +155,7 @@ static JanetSlot opreduce(
/* Function optimizers */
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil());
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
}
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
@@ -171,7 +172,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
return t;
}
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil());
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
}
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
if (janet_v_count(args) == 3) {
@@ -191,14 +192,20 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
c->buffer[label] |= (current - label) << 16;
return t;
} else {
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil());
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
}
}
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
}
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
}
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
}
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
}
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
if (opts.flags & JANET_FOPTS_DROP) {
@@ -255,43 +262,34 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Variadic operators specialization */
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
}
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SUBTRACT, JOP_SUBTRACT_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
}
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
}
static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1));
}
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1));
}
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1));
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1));
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
}
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
}
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
}
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
return genericSS(opts, JOP_BNOT, args[0]);
@@ -385,11 +383,10 @@ static const JanetFunOptimizer optimizers[] = {
{fixarity2, do_propagate},
{arity2or3, do_get},
{arity1or2, do_next},
{NULL, do_modulo},
{NULL, do_remainder},
{fixarity2, do_modulo},
{fixarity2, do_remainder},
{fixarity2, do_cmp},
{fixarity2, do_cancel},
{NULL, do_divf}
};
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -934,7 +934,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
int32_t slotchunks = (def->slotcount + 31) >> 5;
/* numchunks is min of slotchunks and scope->ua.count */
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
uint32_t *chunks = janet_calloc(slotchunks, sizeof(uint32_t));
uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
if (NULL == chunks) {
JANET_OUT_OF_MEMORY;
}
@@ -1056,7 +1056,7 @@ JanetCompileResult janet_compile_lint(Janet source,
if (c.result.status == JANET_COMPILE_OK) {
JanetFuncDef *def = janetc_pop_funcdef(&c);
def->name = janet_cstring("thunk");
def->name = janet_cstring("_thunk");
janet_def_addflags(def);
c.result.funcdef = def;
} else {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -69,7 +69,6 @@ typedef enum {
#define JANET_FUN_REMAINDER 30
#define JANET_FUN_CMP 31
#define JANET_FUN_CANCEL 32
#define JANET_FUN_DIVIDE_FLOOR 33
/* Compiler typedefs */
typedef struct JanetCompiler JanetCompiler;
@@ -262,7 +261,7 @@ void janetc_popscope(JanetCompiler *c);
void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot);
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
/* Create a destroy slot */
/* Create a destory slots */
JanetSlot janetc_cslot(Janet x);
/* Search for a symbol */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -69,15 +69,15 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
host.minor < modconf.minor ||
host.bits != modconf.bits) {
char errbuf[128];
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,
host.bits,
modconf.major,
modconf.minor,
modconf.patch,
modconf.bits);
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,
host.bits,
modconf.major,
modconf.minor,
modconf.patch,
modconf.bits);
*error = janet_cstring(errbuf);
return NULL;
}
@@ -110,14 +110,14 @@ JANET_CORE_FN(janet_core_expand_path,
"(module/expand-path path template)",
"Expands a path template as found in `module/paths` for `module/find`. "
"This takes in a path (the argument to require) and a template string, "
"to expand the path to a path that can be used for importing files. "
"The replacements are as follows:\n\n"
"to expand the path to a path that can be "
"used for importing files. The replacements are as follows:\n\n"
"* :all: -- the value of path verbatim.\n\n"
"* :@all: -- Same as :all:, but if `path` starts with the @ character, "
"the first path segment is replaced with a dynamic binding "
"`(dyn <first path segment as keyword>)`.\n\n"
"* :cur: -- the directory portion, if any, of (dyn :current-file)\n\n"
"* :dir: -- the directory portion, if any, of the path argument\n\n"
"* :@all: -- Same as :all:, but if `path` starts with the @ character,\n"
" the first path segment is replaced with a dynamic binding\n"
" `(dyn <first path segment as keyword>)`.\n\n"
"* :cur: -- the current file, or (dyn :current-file)\n\n"
"* :dir: -- the directory containing the current file\n\n"
"* :name: -- the name component of path, with extension if given\n\n"
"* :native: -- the extension used to load natives, .so or .dll\n\n"
"* :sys: -- the system path, or (dyn :syspath)") {
@@ -426,47 +426,6 @@ JANET_CORE_FN(janet_core_slice,
}
}
JANET_CORE_FN(janet_core_range,
"(range & args)",
"Create an array of values [start, end) with a given step. "
"With one argument, returns a range [0, end). With two arguments, returns "
"a range [start, end). With three, returns a range with optional step size.") {
janet_arity(argc, 1, 3);
double start = 0, stop = 0, step = 1, count = 0;
if (argc == 3) {
start = janet_getnumber(argv, 0);
stop = janet_getnumber(argv, 1);
step = janet_getnumber(argv, 2);
count = (step > 0) ? (stop - start) / step :
((step < 0) ? (stop - start) / step : 0);
} else if (argc == 2) {
start = janet_getnumber(argv, 0);
stop = janet_getnumber(argv, 1);
count = stop - start;
} else {
stop = janet_getnumber(argv, 0);
count = stop;
}
count = (count > 0) ? count : 0;
int32_t int_count;
if (count > (double) INT32_MAX) {
int_count = INT32_MAX;
} else {
int_count = (int32_t) ceil(count);
}
if (step > 0.0) {
janet_assert(start + int_count * step >= stop, "bad range code");
} else {
janet_assert(start + int_count * step <= stop, "bad range code");
}
JanetArray *array = janet_array(int_count);
for (int32_t i = 0; i < int_count; i++) {
array->data[i] = janet_wrap_number((double) start + (double) i * step);
}
array->count = int_count;
return janet_wrap_array(array);
}
JANET_CORE_FN(janet_core_table,
"(table & kvs)",
"Creates a new table from a variadic number of keys and values. "
@@ -670,45 +629,9 @@ ret_false:
return janet_wrap_false();
}
JANET_CORE_FN(janet_core_is_bytes,
"(bytes? x)",
"Check if x is a string, symbol, keyword, or buffer.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_BYTES));
}
JANET_CORE_FN(janet_core_is_indexed,
"(indexed? x)",
"Check if x is an array or tuple.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_INDEXED));
}
JANET_CORE_FN(janet_core_is_dictionary,
"(dictionary? x)",
"Check if x is a table or struct.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_DICTIONARY));
}
JANET_CORE_FN(janet_core_is_lengthable,
"(lengthable? x)",
"Check if x is a bytes, indexed, or dictionary.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_LENGTHABLE));
}
JANET_CORE_FN(janet_core_signal,
"(signal what x)",
"Raise a signal with payload x. `what` can be an integer\n"
"from 0 through 7 indicating user(0-7), or one of:\n\n"
"* :ok\n"
"* :error\n"
"* :debug\n"
"* :yield\n"
"* :user(0-7)\n"
"* :interrupt\n"
"* :await") {
"Raise a signal with payload x. ") {
janet_arity(argc, 1, 2);
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
if (janet_checkint(argv[0])) {
@@ -767,7 +690,6 @@ static const SandboxOption sandbox_options[] = {
{"net-connect", JANET_SANDBOX_NET_CONNECT},
{"net-listen", JANET_SANDBOX_NET_LISTEN},
{"sandbox", JANET_SANDBOX_SANDBOX},
{"signal", JANET_SANDBOX_SIGNAL},
{"subprocess", JANET_SANDBOX_SUBPROCESS},
{NULL, 0}
};
@@ -792,7 +714,6 @@ JANET_CORE_FN(janet_core_sandbox,
"* :net-connect - disallow making outbound network connections\n"
"* :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") {
uint32_t flags = 0;
for (int32_t i = 0; i < argc; i++) {
@@ -995,7 +916,7 @@ static void make_apply(JanetTable *env) {
/* Push the array */
S(JOP_PUSH_ARRAY, 5),
/* Call the function */
/* Call the funciton */
S(JOP_TAILCALL, 0)
};
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
@@ -1064,6 +985,14 @@ static const uint32_t next_asm[] = {
JOP_NEXT | (1 << 24),
JOP_RETURN
};
static const uint32_t modulo_asm[] = {
JOP_MODULO | (1 << 24),
JOP_RETURN
};
static const uint32_t remainder_asm[] = {
JOP_REMAINDER | (1 << 24),
JOP_RETURN
};
static const uint32_t cmp_asm[] = {
JOP_COMPARE | (1 << 24),
JOP_RETURN
@@ -1102,12 +1031,7 @@ static void janet_load_libs(JanetTable *env) {
JANET_CORE_REG("module/expand-path", janet_core_expand_path),
JANET_CORE_REG("int?", janet_core_check_int),
JANET_CORE_REG("nat?", janet_core_check_nat),
JANET_CORE_REG("bytes?", janet_core_is_bytes),
JANET_CORE_REG("indexed?", janet_core_is_indexed),
JANET_CORE_REG("dictionary?", janet_core_is_dictionary),
JANET_CORE_REG("lengthable?", janet_core_is_lengthable),
JANET_CORE_REG("slice", janet_core_slice),
JANET_CORE_REG("range", janet_core_range),
JANET_CORE_REG("signal", janet_core_signal),
JANET_CORE_REG("memcmp", janet_core_memcmp),
JANET_CORE_REG("getproto", janet_core_getproto),
@@ -1140,9 +1064,6 @@ static void janet_load_libs(JanetTable *env) {
#endif
#ifdef JANET_EV
janet_lib_ev(env);
#ifdef JANET_FILEWATCH
janet_lib_filewatch(env);
#endif
#endif
#ifdef JANET_NET
janet_lib_net(env);
@@ -1156,6 +1077,14 @@ static void janet_load_libs(JanetTable *env) {
JanetTable *janet_core_env(JanetTable *replacements) {
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
janet_quick_asm(env, JANET_FUN_MODULO,
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
JDOC("(mod dividend divisor)\n\n"
"Returns the modulo of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_REMAINDER,
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n"
@@ -1166,20 +1095,17 @@ JanetTable *janet_core_env(JanetTable *replacements) {
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 "
"to be seen only once per iteration if they 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. 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"
@@ -1257,18 +1183,6 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"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."));
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`."));
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."));
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."));

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -102,7 +102,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
}
/* Error reporting. This can be emulated from within Janet, but for
* consistency with the top level code it is defined once. */
* consitency with the top level code it is defined once. */
void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
int32_t fi;
@@ -164,7 +164,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
}
}
if (frame->flags & JANET_STACKFRAME_TAILCALL)
janet_eprintf(" (tail call)");
janet_eprintf(" (tailcall)");
if (frame->func && frame->pc) {
int32_t off = (int32_t)(frame->pc - def->bytecode);
if (def->sourcemap) {
@@ -180,11 +180,6 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
}
}
janet_eprintf("\n");
/* Print fiber points optionally. Clutters traces but provides info
if (i <= 0 && fi > 0) {
janet_eprintf(" in parent fiber\n");
}
*/
}
}
@@ -393,8 +388,8 @@ JANET_CORE_FN(cfun_debug_stack,
JANET_CORE_FN(cfun_debug_stacktrace,
"(debug/stacktrace fiber &opt err prefix)",
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
"an error value to print the stack trace with. If `prefix` is nil or not "
"provided, will skip the error line. Returns the fiber.") {
"an error value to print the stack trace with. If `err` is nil or not "
"provided, and no prefix is given, will skip the error line. Returns the fiber.") {
janet_arity(argc, 1, 3);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -26,7 +26,6 @@
#include "emit.h"
#include "vector.h"
#include "regalloc.h"
#include "util.h"
#endif
/* Get a register */
@@ -129,8 +128,7 @@ static void janetc_movenear(JanetCompiler *c,
((uint32_t)(src.envindex) << 16) |
((uint32_t)(dest) << 8) |
JOP_LOAD_UPVALUE);
} else if (src.index != dest) {
janet_assert(src.index >= 0, "bad slot");
} else if (src.index > 0xFF || src.index != dest) {
janetc_emit(c,
((uint32_t)(src.index) << 16) |
((uint32_t)(dest) << 8) |
@@ -157,7 +155,6 @@ static void janetc_moveback(JanetCompiler *c,
((uint32_t)(src) << 8) |
JOP_SET_UPVALUE);
} else if (dest.index != src) {
janet_assert(dest.index >= 0, "bad slot");
janetc_emit(c,
((uint32_t)(dest.index) << 16) |
((uint32_t)(src) << 8) |

View File

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

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -76,6 +76,4 @@
#define __BSD_VISIBLE 1
#endif
#define _FILE_OFFSET_BITS 64
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -56,9 +56,6 @@
#if (defined(__x86_64__) || defined(_M_X64)) && !defined(JANET_WINDOWS)
#define JANET_FFI_SYSV64_ENABLED
#endif
#if (defined(__aarch64__) || defined(_M_ARM64)) && !defined(JANET_WINDOWS)
#define JANET_FFI_AAPCS64_ENABLED
#endif
typedef struct JanetFFIType JanetFFIType;
typedef struct JanetFFIStruct JanetFFIStruct;
@@ -143,13 +140,7 @@ typedef enum {
JANET_WIN64_REGISTER,
JANET_WIN64_STACK,
JANET_WIN64_REGISTER_REF,
JANET_WIN64_STACK_REF,
JANET_AAPCS64_GENERAL,
JANET_AAPCS64_SSE,
JANET_AAPCS64_GENERAL_REF,
JANET_AAPCS64_STACK,
JANET_AAPCS64_STACK_REF,
JANET_AAPCS64_NONE
JANET_WIN64_STACK_REF
} JanetFFIWordSpec;
/* Describe how each Janet argument is interpreted in terms of machine words
@@ -164,16 +155,13 @@ typedef struct {
typedef enum {
JANET_FFI_CC_NONE,
JANET_FFI_CC_SYSV_64,
JANET_FFI_CC_WIN_64,
JANET_FFI_CC_AAPCS64
JANET_FFI_CC_WIN_64
} JanetFFICallingConvention;
#ifdef JANET_FFI_WIN64_ENABLED
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_WIN_64
#elif defined(JANET_FFI_SYSV64_ENABLED)
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_SYSV_64
#elif defined(JANET_FFI_AAPCS64_ENABLED)
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_AAPCS64
#else
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_NONE
#endif
@@ -313,9 +301,6 @@ static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) {
#endif
#ifdef JANET_FFI_SYSV64_ENABLED
if (!janet_cstrcmp(name, "sysv64")) return JANET_FFI_CC_SYSV_64;
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
if (!janet_cstrcmp(name, "aapcs64")) return JANET_FFI_CC_AAPCS64;
#endif
if (!janet_cstrcmp(name, "default")) return JANET_FFI_CC_DEFAULT;
janet_panicf("unknown calling convention %s", name);
@@ -400,7 +385,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
JanetFFIStruct *st = janet_abstract(&janet_struct_type,
sizeof(JanetFFIStruct) + argc * sizeof(JanetFFIStructMember));
st->field_count = 0;
st->field_count = member_count;
st->size = 0;
st->align = 1;
if (argc == 0) {
@@ -418,7 +403,6 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
st->fields[i].type = decode_ffi_type(argv[j]);
size_t el_size = type_size(st->fields[i].type);
size_t el_align = type_align(st->fields[i].type);
if (el_align <= 0) janet_panicf("bad field type %V", argv[j]);
if (all_packed || pack_one) {
if (st->size % el_align != 0) is_aligned = 0;
st->fields[i].offset = st->size;
@@ -434,7 +418,6 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
st->size += (st->align - 1);
st->size /= st->align;
st->size *= st->align;
st->field_count = member_count;
return st;
}
@@ -492,7 +475,7 @@ JANET_CORE_FN(cfun_ffi_align,
static void *janet_ffi_getpointer(const Janet *argv, int32_t n) {
switch (janet_type(argv[n])) {
default:
janet_panicf("bad slot #%d, expected ffi pointer convertible type, got %v", n, argv[n]);
janet_panicf("bad slot #%d, expected ffi pointer convertable type, got %v", n, argv[n]);
case JANET_POINTER:
case JANET_STRING:
case JANET_KEYWORD:
@@ -780,101 +763,6 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
}
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
/* Procedure Call Standard for the Arm® 64-bit Architecture (AArch64) 2023Q3 October 6, 2023
* See section 6.8.2 Parameter passing rules.
* https://github.com/ARM-software/abi-aa/releases/download/2023Q3/aapcs64.pdf
*
* Additional documentation needed for Apple platforms.
* https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms */
#define JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, alignment) (ptr = ((ptr) + ((alignment) - 1)) & ~((alignment) - 1))
#if !defined(JANET_APPLE)
#define JANET_FFI_AAPCS64_STACK_ALIGN(ptr, alignment) ((void) alignment, JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, 8))
#else
#define JANET_FFI_AAPCS64_STACK_ALIGN(ptr, alignment) JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, alignment)
#endif
typedef struct {
uint64_t a;
uint64_t b;
} Aapcs64Variant1ReturnGeneral;
typedef struct {
double a;
double b;
double c;
double d;
} Aapcs64Variant2ReturnSse;
/* Workaround for passing a return value pointer through x8.
* Limits struct returns to 128 bytes. */
typedef struct {
uint64_t a;
uint64_t b;
uint64_t c;
uint64_t d;
uint64_t e;
uint64_t f;
uint64_t g;
uint64_t h;
uint64_t i;
uint64_t j;
uint64_t k;
uint64_t l;
uint64_t m;
uint64_t n;
uint64_t o;
uint64_t p;
} Aapcs64Variant3ReturnPointer;
static JanetFFIWordSpec aapcs64_classify(JanetFFIType type) {
switch (type.prim) {
case JANET_FFI_TYPE_PTR:
case JANET_FFI_TYPE_STRING:
case JANET_FFI_TYPE_BOOL:
case JANET_FFI_TYPE_INT8:
case JANET_FFI_TYPE_INT16:
case JANET_FFI_TYPE_INT32:
case JANET_FFI_TYPE_INT64:
case JANET_FFI_TYPE_UINT8:
case JANET_FFI_TYPE_UINT16:
case JANET_FFI_TYPE_UINT32:
case JANET_FFI_TYPE_UINT64:
return JANET_AAPCS64_GENERAL;
case JANET_FFI_TYPE_DOUBLE:
case JANET_FFI_TYPE_FLOAT:
return JANET_AAPCS64_SSE;
case JANET_FFI_TYPE_STRUCT: {
JanetFFIStruct *st = type.st;
if (st->field_count <= 4 && aapcs64_classify(st->fields[0].type) == JANET_AAPCS64_SSE) {
bool is_hfa = true;
for (uint32_t i = 1; i < st->field_count; i++) {
if (st->fields[0].type.prim != st->fields[i].type.prim) {
is_hfa = false;
break;
}
}
if (is_hfa) {
return JANET_AAPCS64_SSE;
}
}
if (type_size(type) > 16) {
return JANET_AAPCS64_GENERAL_REF;
}
return JANET_AAPCS64_GENERAL;
}
case JANET_FFI_TYPE_VOID:
return JANET_AAPCS64_NONE;
default:
janet_panic("nyi");
return JANET_AAPCS64_NONE;
}
}
#endif
JANET_CORE_FN(cfun_ffi_signature,
"(ffi/signature calling-convention ret-type & arg-types)",
"Create a function signature object that can be used to make calls "
@@ -1072,96 +960,6 @@ JANET_CORE_FN(cfun_ffi_signature,
}
break;
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
case JANET_FFI_CC_AAPCS64: {
uint32_t next_general_reg = 0;
uint32_t next_fp_reg = 0;
uint32_t stack_offset = 0;
uint32_t ref_stack_offset = 0;
JanetFFIWordSpec ret_spec = aapcs64_classify(ret_type);
ret.spec = ret_spec;
if (ret_spec == JANET_AAPCS64_SSE) {
variant = 1;
} else if (ret_spec == JANET_AAPCS64_GENERAL_REF) {
if (type_size(ret_type) > sizeof(Aapcs64Variant3ReturnPointer)) {
janet_panic("return value bigger than supported");
}
variant = 2;
} else {
variant = 0;
}
for (uint32_t i = 0; i < arg_count; i++) {
mappings[i].type = decode_ffi_type(argv[i + 2]);
mappings[i].spec = aapcs64_classify(mappings[i].type);
size_t arg_size = type_size(mappings[i].type);
switch (mappings[i].spec) {
case JANET_AAPCS64_GENERAL: {
bool arg_is_struct = mappings[i].type.prim == JANET_FFI_TYPE_STRUCT;
uint32_t needed_registers = (arg_size + 7) / 8;
if (next_general_reg + needed_registers <= 8) {
mappings[i].offset = next_general_reg;
next_general_reg += needed_registers;
} else {
size_t arg_align = arg_is_struct ? 8 : type_align(mappings[i].type);
mappings[i].spec = JANET_AAPCS64_STACK;
mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, arg_align);
#if !defined(JANET_APPLE)
stack_offset += arg_size > 8 ? arg_size : 8;
#else
stack_offset += arg_size;
#endif
next_general_reg = 8;
}
break;
}
case JANET_AAPCS64_GENERAL_REF:
if (next_general_reg < 8) {
mappings[i].offset = next_general_reg++;
} else {
mappings[i].spec = JANET_AAPCS64_STACK_REF;
mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, 8);
stack_offset += 8;
}
mappings[i].offset2 = JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ref_stack_offset, 8);
ref_stack_offset += arg_size;
break;
case JANET_AAPCS64_SSE: {
uint32_t needed_registers = (arg_size + 7) / 8;
if (next_fp_reg + needed_registers <= 8) {
mappings[i].offset = next_fp_reg;
next_fp_reg += needed_registers;
} else {
mappings[i].spec = JANET_AAPCS64_STACK;
mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, 8);
#if !defined(JANET_APPLE)
stack_offset += 8;
#else
stack_offset += arg_size;
#endif
}
break;
}
default:
janet_panic("nyi");
}
}
stack_offset = (stack_offset + 15) & ~0xFUL;
ref_stack_offset = (ref_stack_offset + 15) & ~0xFUL;
stack_count = stack_offset + ref_stack_offset;
for (uint32_t i = 0; i < arg_count; i++) {
if (mappings[i].spec == JANET_AAPCS64_GENERAL_REF || mappings[i].spec == JANET_AAPCS64_STACK_REF) {
mappings[i].offset2 = stack_offset + mappings[i].offset2;
}
}
}
break;
#endif
}
/* Create signature abstract value */
@@ -1496,99 +1294,6 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
static void janet_ffi_aapcs64_standard_callback(void *ctx, void *userdata) {
janet_ffi_trampoline(ctx, userdata);
}
typedef Aapcs64Variant1ReturnGeneral janet_aapcs64_variant_1(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7,
double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7);
typedef Aapcs64Variant2ReturnSse janet_aapcs64_variant_2(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7,
double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7);
typedef Aapcs64Variant3ReturnPointer janet_aapcs64_variant_3(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7,
double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7);
static Janet janet_ffi_aapcs64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) {
union {
Aapcs64Variant1ReturnGeneral general_return;
Aapcs64Variant2ReturnSse sse_return;
Aapcs64Variant3ReturnPointer pointer_return;
} retu;
uint64_t regs[8];
double fp_regs[8];
void *ret_mem = &retu.general_return;
/* Apple's stack values do not need to be 8-byte aligned,
* thus all stack offsets refer to actual byte positions. */
uint8_t *stack = alloca(signature->stack_count);
#if defined(JANET_APPLE)
/* Values must be zero-extended by the caller instead of the callee. */
memset(stack, 0, signature->stack_count);
#endif
for (uint32_t i = 0; i < signature->arg_count; i++) {
int32_t n = i + 2;
JanetFFIMapping arg = signature->args[i];
void *to = NULL;
switch (arg.spec) {
case JANET_AAPCS64_GENERAL:
to = regs + arg.offset;
break;
case JANET_AAPCS64_GENERAL_REF:
to = stack + arg.offset2;
regs[arg.offset] = (uint64_t) to;
break;
case JANET_AAPCS64_SSE:
to = fp_regs + arg.offset;
break;
case JANET_AAPCS64_STACK:
to = stack + arg.offset;
break;
case JANET_AAPCS64_STACK_REF:
to = stack + arg.offset2;
uint64_t *ptr = (uint64_t *) stack + arg.offset;
*ptr = (uint64_t) to;
break;
default:
janet_panic("nyi");
}
if (to) {
janet_ffi_write_one(to, argv, n, arg.type, JANET_FFI_MAX_RECUR);
}
}
switch (signature->variant) {
case 0:
retu.general_return = ((janet_aapcs64_variant_1 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3],
regs[4], regs[5], regs[6], regs[7],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
case 1:
retu.sse_return = ((janet_aapcs64_variant_2 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3],
regs[4], regs[5], regs[6], regs[7],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
case 2: {
retu.pointer_return = ((janet_aapcs64_variant_3 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3],
regs[4], regs[5], regs[6], regs[7],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
}
}
return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR);
}
#endif
/* Allocate executable memory chunks in sizes of a page. Ideally we would keep
* an allocator around so that multiple JIT allocations would point to the same
* region but it isn't really worth it. */
@@ -1668,10 +1373,6 @@ JANET_CORE_FN(cfun_ffi_call,
#ifdef JANET_FFI_SYSV64_ENABLED
case JANET_FFI_CC_SYSV_64:
return janet_ffi_sysv64(signature, function_pointer, argv);
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
case JANET_FFI_CC_AAPCS64:
return janet_ffi_aapcs64(signature, function_pointer, argv);
#endif
}
}
@@ -1680,7 +1381,7 @@ JANET_CORE_FN(cfun_ffi_buffer_write,
"(ffi/write ffi-type data &opt buffer index)",
"Append a native type to a buffer such as it would appear in memory. This can be used "
"to pass pointers to structs in the ffi, or send C/C++/native structs over the network "
"or to files. Returns a modified buffer or a new buffer if one is not supplied.") {
"or to files. Returns a modifed buffer or a new buffer if one is not supplied.") {
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
janet_arity(argc, 2, 4);
JanetFFIType type = decode_ffi_type(argv[0]);
@@ -1741,10 +1442,6 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline,
#ifdef JANET_FFI_SYSV64_ENABLED
case JANET_FFI_CC_SYSV_64:
return janet_wrap_pointer(janet_ffi_sysv64_standard_callback);
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
case JANET_FFI_CC_AAPCS64:
return janet_wrap_pointer(janet_ffi_aapcs64_standard_callback);
#endif
}
}
@@ -1833,25 +1530,9 @@ JANET_CORE_FN(cfun_ffi_pointer_buffer,
return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
}
JANET_CORE_FN(cfun_ffi_pointer_cfunction,
"(ffi/pointer-cfunction pointer &opt name source-file source-line)",
"Create a C Function from a raw pointer. Optionally give the cfunction a name and "
"source location for stack traces and debugging.") {
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
janet_arity(argc, 1, 4);
void *pointer = janet_getpointer(argv, 0);
const char *name = janet_optcstring(argv, argc, 1, NULL);
const char *source = janet_optcstring(argv, argc, 2, NULL);
int32_t line = janet_optinteger(argv, argc, 3, -1);
if ((name != NULL) || (source != NULL) || (line != -1)) {
janet_registry_put((JanetCFunction) pointer, name, NULL, source, line);
}
return janet_wrap_cfunction((JanetCFunction) pointer);
}
JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
"(ffi/calling-conventions)",
"Get an array of all supported calling conventions on the current architecture. Some architectures may have some FFI "
"Get an array of all supported calling conventions on the current arhcitecture. Some architectures may have some FFI "
"functionality (ffi/malloc, ffi/free, ffi/read, ffi/write, etc.) but not support "
"any calling conventions. This function can be used to get all supported calling conventions "
"that can be used on this architecture. All architectures support the :none calling "
@@ -1864,9 +1545,6 @@ JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
#endif
#ifdef JANET_FFI_SYSV64_ENABLED
janet_array_push(array, janet_ckeywordv("sysv64"));
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
janet_array_push(array, janet_ckeywordv("aapcs64"));
#endif
janet_array_push(array, janet_ckeywordv("none"));
return janet_wrap_array(array);
@@ -1889,7 +1567,6 @@ void janet_lib_ffi(JanetTable *env) {
JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
JANET_CORE_REG("ffi/free", cfun_ffi_free),
JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
JANET_CORE_REG("ffi/pointer-cfunction", cfun_ffi_pointer_cfunction),
JANET_CORE_REG("ffi/calling-conventions", cfun_ffi_supported_calling_conventions),
JANET_REG_END
};

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -39,10 +39,8 @@ static void fiber_reset(JanetFiber *fiber) {
fiber->env = NULL;
fiber->last_value = janet_wrap_nil();
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
fiber->ev_callback = NULL;
fiber->ev_state = NULL;
fiber->ev_stream = NULL;
fiber->supervisor_channel = NULL;
#endif
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
@@ -87,6 +85,7 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
if (janet_fiber_funcframe(fiber, callee)) return NULL;
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->supervisor_channel = NULL;
#endif
return fiber;
@@ -239,8 +238,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
fiber->data + tuplehead,
oldtop - tuplehead)
: janet_wrap_tuple(janet_tuple_n(
fiber->data + tuplehead,
oldtop - tuplehead));
fiber->data + tuplehead,
oldtop - tuplehead));
}
}
@@ -370,8 +369,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
fiber->data + tuplehead,
fiber->stacktop - tuplehead)
: janet_wrap_tuple(janet_tuple_n(
fiber->data + tuplehead,
fiber->stacktop - tuplehead));
fiber->data + tuplehead,
fiber->stacktop - tuplehead));
}
stacksize = tuplehead - fiber->stackstart + 1;
} else {
@@ -662,7 +661,7 @@ JANET_CORE_FN(cfun_fiber_can_resume,
}
JANET_CORE_FN(cfun_fiber_last_value,
"(fiber/last-value fiber)",
"(fiber/last-value)",
"Get the last value returned or signaled from the fiber.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -59,9 +59,6 @@
#define JANET_FIBER_EV_FLAG_CANCELED 0x10000
#define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
#define JANET_FIBER_FLAG_ROOT 0x40000
#define JANET_FIBER_EV_FLAG_IN_FLIGHT 0x1
/* used only on windows, should otherwise be unset */
#define janet_fiber_set_status(f, s) do {\
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\

View File

@@ -1,688 +0,0 @@
/*
* 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 "util.h"
#endif
#ifdef JANET_EV
#ifdef JANET_FILEWATCH
#ifdef JANET_LINUX
#include <sys/inotify.h>
#include <unistd.h>
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
#endif
typedef struct {
const char *name;
uint32_t flag;
} JanetWatchFlagName;
typedef struct {
#ifndef JANET_WINDOWS
JanetStream *stream;
#endif
JanetTable *watch_descriptors;
JanetChannel *channel;
uint32_t default_flags;
int is_watching;
} JanetWatcher;
#ifdef JANET_LINUX
#include <sys/inotify.h>
#include <unistd.h>
static const JanetWatchFlagName watcher_flags_linux[] = {
{"access", IN_ACCESS},
{"all", IN_ALL_EVENTS},
{"attrib", IN_ATTRIB},
{"close-nowrite", IN_CLOSE_NOWRITE},
{"close-write", IN_CLOSE_WRITE},
{"create", IN_CREATE},
{"delete", IN_DELETE},
{"delete-self", IN_DELETE_SELF},
{"ignored", IN_IGNORED},
{"modify", IN_MODIFY},
{"move-self", IN_MOVE_SELF},
{"moved-from", IN_MOVED_FROM},
{"moved-to", IN_MOVED_TO},
{"open", IN_OPEN},
{"q-overflow", IN_Q_OVERFLOW},
{"unmount", IN_UNMOUNT},
};
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
uint32_t flags = 0;
for (int32_t i = 0; i < n; i++) {
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
janet_panicf("expected keyword, got %v", options[i]);
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_linux,
sizeof(watcher_flags_linux) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown inotify flag %v", options[i]);
}
flags |= result->flag;
}
return flags;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
int fd;
do {
fd = inotify_init1(IN_NONBLOCK | IN_CLOEXEC);
} while (fd == -1 && errno == EINTR);
if (fd == -1) {
janet_panicv(janet_ev_lasterr());
}
watcher->watch_descriptors = janet_table(0);
watcher->channel = channel;
watcher->default_flags = default_flags;
watcher->is_watching = 0;
watcher->stream = janet_stream(fd, JANET_STREAM_READABLE, NULL);
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
if (watcher->stream == NULL) janet_panic("watcher closed");
int result;
do {
result = inotify_add_watch(watcher->stream->handle, path, flags);
} while (result == -1 && errno == EINTR);
if (result == -1) {
janet_panicv(janet_ev_lasterr());
}
Janet name = janet_cstringv(path);
Janet wd = janet_wrap_integer(result);
janet_table_put(watcher->watch_descriptors, name, wd);
janet_table_put(watcher->watch_descriptors, wd, name);
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
if (watcher->stream == NULL) janet_panic("watcher closed");
Janet check = janet_table_get(watcher->watch_descriptors, janet_cstringv(path));
janet_assert(janet_checktype(check, JANET_NUMBER), "bad watch descriptor");
int watch_handle = janet_unwrap_integer(check);
int result;
do {
result = inotify_rm_watch(watcher->stream->handle, watch_handle);
} while (result != -1 && errno == EINTR);
if (result == -1) {
janet_panicv(janet_ev_lasterr());
}
}
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
JanetWatcher *watcher = *((JanetWatcher **) fiber->ev_state);
char buf[1024];
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_MARK:
janet_mark(janet_wrap_abstract(watcher));
break;
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
case JANET_ASYNC_EVENT_ERR: {
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
}
read_more:
case JANET_ASYNC_EVENT_HUP:
case JANET_ASYNC_EVENT_INIT:
case JANET_ASYNC_EVENT_READ: {
Janet name = janet_wrap_nil();
/* Assumption - read will never return partial events *
* From documentation:
*
* The behavior when the buffer given to read(2) is too small to
* return information about the next event depends on the kernel
* version: before Linux 2.6.21, read(2) returns 0; since Linux
* 2.6.21, read(2) fails with the error EINVAL. Specifying a buffer
* of size
*
* sizeof(struct inotify_event) + NAME_MAX + 1
*
* will be sufficient to read at least one event. */
ssize_t nread;
do {
nread = read(stream->handle, buf, sizeof(buf));
} while (nread == -1 && errno == EINTR);
/* Check for errors - special case errors that can just be waited on to fix */
if (nread == -1) {
if (errno == EAGAIN || errno == EWOULDBLOCK) {
break;
}
janet_cancel(fiber, janet_ev_lasterr());
fiber->ev_state = NULL;
janet_async_end(fiber);
break;
}
if (nread < (ssize_t) sizeof(struct inotify_event)) break;
/* Iterate through all events read from the buffer */
char *cursor = buf;
while (cursor < buf + nread) {
struct inotify_event inevent;
memcpy(&inevent, cursor, sizeof(inevent));
cursor += sizeof(inevent);
/* Read path of inevent */
if (inevent.len) {
name = janet_cstringv(cursor);
cursor += inevent.len;
}
/* Got an event */
Janet path = janet_table_get(watcher->watch_descriptors, janet_wrap_integer(inevent.wd));
JanetKV *event = janet_struct_begin(6);
janet_struct_put(event, janet_ckeywordv("wd"), janet_wrap_integer(inevent.wd));
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
if (janet_checktype(name, JANET_NIL)) {
/* We were watching a file directly, so path is the full path. Split into dirname / basename */
JanetString spath = janet_unwrap_string(path);
const uint8_t *cursor = spath + janet_string_length(spath);
const uint8_t *cursor_end = cursor;
while (cursor > spath && cursor[0] != '/') {
cursor--;
}
if (cursor == spath) {
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
janet_struct_put(event, janet_ckeywordv("file-name"), name);
} else {
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath))));
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1))));
}
} else {
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
janet_struct_put(event, janet_ckeywordv("file-name"), name);
}
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_integer(inevent.cookie));
Janet etype = janet_ckeywordv("type");
const JanetWatchFlagName *wfn_end = watcher_flags_linux + sizeof(watcher_flags_linux) / sizeof(watcher_flags_linux[0]);
for (const JanetWatchFlagName *wfn = watcher_flags_linux; wfn < wfn_end; wfn++) {
if ((inevent.mask & wfn->flag) == wfn->flag) janet_struct_put(event, etype, janet_ckeywordv(wfn->name));
}
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
}
/* Read some more if possible */
goto read_more;
}
break;
}
}
static void janet_watcher_listen(JanetWatcher *watcher) {
if (watcher->is_watching) janet_panic("already watching");
watcher->is_watching = 1;
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
JanetWatcher **state = janet_malloc(sizeof(JanetWatcher *)); /* Gross */
*state = watcher;
janet_async_start_fiber(fiber, watcher->stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, state);
janet_gcroot(janet_wrap_abstract(watcher));
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
if (!watcher->is_watching) return;
watcher->is_watching = 0;
janet_stream_close(watcher->stream);
janet_gcunroot(janet_wrap_abstract(watcher));
}
#elif JANET_WINDOWS
#define WATCHFLAG_RECURSIVE 0x100000u
static const JanetWatchFlagName watcher_flags_windows[] = {
{
"all",
FILE_NOTIFY_CHANGE_ATTRIBUTES |
FILE_NOTIFY_CHANGE_CREATION |
FILE_NOTIFY_CHANGE_DIR_NAME |
FILE_NOTIFY_CHANGE_FILE_NAME |
FILE_NOTIFY_CHANGE_LAST_ACCESS |
FILE_NOTIFY_CHANGE_LAST_WRITE |
FILE_NOTIFY_CHANGE_SECURITY |
FILE_NOTIFY_CHANGE_SIZE |
WATCHFLAG_RECURSIVE
},
{"attributes", FILE_NOTIFY_CHANGE_ATTRIBUTES},
{"creation", FILE_NOTIFY_CHANGE_CREATION},
{"dir-name", FILE_NOTIFY_CHANGE_DIR_NAME},
{"file-name", FILE_NOTIFY_CHANGE_FILE_NAME},
{"last-access", FILE_NOTIFY_CHANGE_LAST_ACCESS},
{"last-write", FILE_NOTIFY_CHANGE_LAST_WRITE},
{"recursive", WATCHFLAG_RECURSIVE},
{"security", FILE_NOTIFY_CHANGE_SECURITY},
{"size", FILE_NOTIFY_CHANGE_SIZE},
};
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
uint32_t flags = 0;
for (int32_t i = 0; i < n; i++) {
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
janet_panicf("expected keyword, got %v", options[i]);
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_windows,
sizeof(watcher_flags_windows) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown windows filewatch flag %v", options[i]);
}
flags |= result->flag;
}
return flags;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
watcher->watch_descriptors = janet_table(0);
watcher->channel = channel;
watcher->default_flags = default_flags;
watcher->is_watching = 0;
}
/* Since the file info padding includes embedded file names, we want to include more space for data.
* We also need to handle manually calculating changes if path names are too long, but ideally just avoid
* that scenario as much as possible */
#define FILE_INFO_PADDING (4096 * 4)
typedef struct {
OVERLAPPED overlapped;
JanetStream *stream;
JanetWatcher *watcher;
JanetFiber *fiber;
JanetString dir_path;
uint32_t flags;
uint64_t buf[FILE_INFO_PADDING / sizeof(uint64_t)]; /* Ensure alignment */
} OverlappedWatch;
#define NotifyChange FILE_NOTIFY_INFORMATION
static void read_dir_changes(OverlappedWatch *ow) {
BOOL result = ReadDirectoryChangesW(ow->stream->handle,
(NotifyChange *) ow->buf,
FILE_INFO_PADDING,
(ow->flags & WATCHFLAG_RECURSIVE) ? TRUE : FALSE,
ow->flags & ~WATCHFLAG_RECURSIVE,
NULL,
(OVERLAPPED *) ow,
NULL);
if (!result) {
janet_panicv(janet_ev_lasterr());
}
}
static const char *watcher_actions_windows[] = {
"unknown",
"added",
"removed",
"modified",
"renamed-old",
"renamed-new",
};
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
OverlappedWatch *ow = (OverlappedWatch *) fiber->ev_state;
JanetWatcher *watcher = ow->watcher;
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_INIT:
janet_async_in_flight(fiber);
break;
case JANET_ASYNC_EVENT_MARK:
janet_mark(janet_wrap_abstract(ow->stream));
janet_mark(janet_wrap_fiber(ow->fiber));
janet_mark(janet_wrap_abstract(watcher));
janet_mark(janet_wrap_string(ow->dir_path));
break;
case JANET_ASYNC_EVENT_CLOSE:
janet_table_remove(ow->watcher->watch_descriptors, janet_wrap_string(ow->dir_path));
break;
case JANET_ASYNC_EVENT_ERR:
case JANET_ASYNC_EVENT_FAILED:
janet_stream_close(ow->stream);
break;
case JANET_ASYNC_EVENT_COMPLETE: {
if (!watcher->is_watching) {
janet_stream_close(ow->stream);
break;
}
NotifyChange *fni = (NotifyChange *) ow->buf;
while (1) {
/* Got an event */
/* Extract name */
Janet filename;
if (fni->FileNameLength) {
int32_t nbytes = (int32_t) WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), NULL, 0, NULL, NULL);
janet_assert(nbytes, "bad utf8 path");
uint8_t *into = janet_string_begin(nbytes);
WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), (char *) into, nbytes, NULL, NULL);
filename = janet_wrap_string(janet_string_end(into));
} else {
filename = janet_cstringv("");
}
JanetKV *event = janet_struct_begin(3);
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_actions_windows[fni->Action]));
janet_struct_put(event, janet_ckeywordv("file-name"), filename);
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(ow->dir_path));
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
/* Next event */
if (!fni->NextEntryOffset) break;
fni = (NotifyChange *)((char *)fni + fni->NextEntryOffset);
}
/* Make another call to read directory changes */
read_dir_changes(ow);
janet_async_in_flight(fiber);
}
break;
}
}
static void start_listening_ow(OverlappedWatch *ow) {
read_dir_changes(ow);
JanetStream *stream = ow->stream;
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
fiber->supervisor_channel = janet_root_fiber()->supervisor_channel;
ow->fiber = fiber;
janet_async_start_fiber(fiber, stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, ow);
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
HANDLE handle = CreateFileA(path,
FILE_LIST_DIRECTORY | GENERIC_READ,
FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
NULL,
OPEN_EXISTING,
FILE_FLAG_OVERLAPPED | FILE_FLAG_BACKUP_SEMANTICS,
NULL);
if (handle == INVALID_HANDLE_VALUE) {
janet_panicv(janet_ev_lasterr());
}
JanetStream *stream = janet_stream(handle, JANET_STREAM_READABLE, NULL);
OverlappedWatch *ow = janet_malloc(sizeof(OverlappedWatch));
memset(ow, 0, sizeof(OverlappedWatch));
ow->stream = stream;
ow->dir_path = janet_cstring(path);
ow->fiber = NULL;
Janet pathv = janet_wrap_string(ow->dir_path);
ow->flags = flags | watcher->default_flags;
ow->watcher = watcher;
ow->overlapped.hEvent = CreateEvent(NULL, FALSE, 0, NULL); /* Do we need this */
Janet streamv = janet_wrap_pointer(ow);
janet_table_put(watcher->watch_descriptors, pathv, streamv);
if (watcher->is_watching) {
start_listening_ow(ow);
}
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
Janet pathv = janet_cstringv(path);
Janet streamv = janet_table_get(watcher->watch_descriptors, pathv);
if (janet_checktype(streamv, JANET_NIL)) {
janet_panicf("path %v is not being watched", pathv);
}
janet_table_remove(watcher->watch_descriptors, pathv);
OverlappedWatch *ow = janet_unwrap_pointer(streamv);
janet_stream_close(ow->stream);
}
static void janet_watcher_listen(JanetWatcher *watcher) {
if (watcher->is_watching) janet_panic("already watching");
watcher->is_watching = 1;
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
const JanetKV *kv = watcher->watch_descriptors->data + i;
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
start_listening_ow(ow);
}
janet_gcroot(janet_wrap_abstract(watcher));
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
if (!watcher->is_watching) return;
watcher->is_watching = 0;
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
const JanetKV *kv = watcher->watch_descriptors->data + i;
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
janet_stream_close(ow->stream);
}
janet_table_clear(watcher->watch_descriptors);
janet_gcunroot(janet_wrap_abstract(watcher));
}
#else
/* Default implementation */
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
(void) options;
(void) n;
return 0;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
(void) watcher;
(void) channel;
(void) default_flags;
janet_panic("filewatch not supported on this platform");
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
(void) watcher;
(void) flags;
(void) path;
janet_panic("nyi");
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
(void) watcher;
(void) path;
janet_panic("nyi");
}
static void janet_watcher_listen(JanetWatcher *watcher) {
(void) watcher;
janet_panic("nyi");
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
(void) watcher;
janet_panic("nyi");
}
#endif
/* C Functions */
static int janet_filewatch_mark(void *p, size_t s) {
JanetWatcher *watcher = (JanetWatcher *) p;
(void) s;
if (watcher->channel == NULL) return 0; /* Incomplete initialization */
#ifdef JANET_WINDOWS
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
const JanetKV *kv = watcher->watch_descriptors->data + i;
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
janet_mark(janet_wrap_fiber(ow->fiber));
janet_mark(janet_wrap_abstract(ow->stream));
janet_mark(janet_wrap_string(ow->dir_path));
}
#else
janet_mark(janet_wrap_abstract(watcher->stream));
#endif
janet_mark(janet_wrap_abstract(watcher->channel));
janet_mark(janet_wrap_table(watcher->watch_descriptors));
return 0;
}
static const JanetAbstractType janet_filewatch_at = {
"filewatch/watcher",
NULL,
janet_filewatch_mark,
JANET_ATEND_GCMARK
};
JANET_CORE_FN(cfun_filewatch_make,
"(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"
"* `:type` -- the type of the event that was raised.\n\n"
"* `:file-name` -- the base file name of the file that triggered the event.\n\n"
"* `:dir-name` -- the directory name of the file that triggered the event.\n\n"
"Events also will contain keys specific to the host OS.\n\n"
"Windows has no extra properties on events.\n\n"
"Linux has the following extra properties on events:\n\n"
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n"
"* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
"* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
"") {
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
janet_arity(argc, 1, -1);
JanetChannel *channel = janet_getchannel(argv, 0);
JanetWatcher *watcher = janet_abstract(&janet_filewatch_at, sizeof(JanetWatcher));
uint32_t default_flags = decode_watch_flags(argv + 1, argc - 1);
janet_watcher_init(watcher, channel, default_flags);
return janet_wrap_abstract(watcher);
}
JANET_CORE_FN(cfun_filewatch_add,
"(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"
"* `:attributes` - FILE_NOTIFY_CHANGE_ATTRIBUTES\n\n"
"* `:creation` - FILE_NOTIFY_CHANGE_CREATION\n\n"
"* `:dir-name` - FILE_NOTIFY_CHANGE_DIR_NAME\n\n"
"* `:last-access` - FILE_NOTIFY_CHANGE_LAST_ACCESS\n\n"
"* `:last-write` - FILE_NOTIFY_CHANGE_LAST_WRITE\n\n"
"* `:security` - FILE_NOTIFY_CHANGE_SECURITY\n\n"
"* `:size` - FILE_NOTIFY_CHANGE_SIZE\n\n"
"* `:recursive` - watch subdirectories recursively\n\n"
"Linux (flags correspond to IN_* flags from <sys/inotify.h>):\n\n"
"* `:access` - IN_ACCESS\n\n"
"* `:all` - IN_ALL_EVENTS\n\n"
"* `:attrib` - IN_ATTRIB\n\n"
"* `:close-nowrite` - IN_CLOSE_NOWRITE\n\n"
"* `:close-write` - IN_CLOSE_WRITE\n\n"
"* `:create` - IN_CREATE\n\n"
"* `:delete` - IN_DELETE\n\n"
"* `:delete-self` - IN_DELETE_SELF\n\n"
"* `:ignored` - IN_IGNORED\n\n"
"* `:modify` - IN_MODIFY\n\n"
"* `:move-self` - IN_MOVE_SELF\n\n"
"* `:moved-from` - IN_MOVED_FROM\n\n"
"* `:moved-to` - IN_MOVED_TO\n\n"
"* `:open` - IN_OPEN\n\n"
"* `:q-overflow` - IN_Q_OVERFLOW\n\n"
"* `:unmount` - IN_UNMOUNT\n\n\n"
"On Windows, events will have the following possible types:\n\n"
"* `:unknown`\n\n"
"* `:added`\n\n"
"* `:removed`\n\n"
"* `:modified`\n\n"
"* `:renamed-old`\n\n"
"* `:renamed-new`\n\n"
"On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n"
"") {
janet_arity(argc, 2, -1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
const char *path = janet_getcstring(argv, 1);
uint32_t flags = watcher->default_flags | decode_watch_flags(argv + 2, argc - 2);
janet_watcher_add(watcher, path, flags);
return argv[0];
}
JANET_CORE_FN(cfun_filewatch_remove,
"(filewatch/remove watcher path)",
"Remove a path from the watcher.") {
janet_fixarity(argc, 2);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
const char *path = janet_getcstring(argv, 1);
janet_watcher_remove(watcher, path);
return argv[0];
}
JANET_CORE_FN(cfun_filewatch_listen,
"(filewatch/listen watcher)",
"Listen for changes in the watcher.") {
janet_fixarity(argc, 1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
janet_watcher_listen(watcher);
return janet_wrap_nil();
}
JANET_CORE_FN(cfun_filewatch_unlisten,
"(filewatch/unlisten watcher)",
"Stop listening for changes on a given watcher.") {
janet_fixarity(argc, 1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
janet_watcher_unlisten(watcher);
return janet_wrap_nil();
}
/* Module entry point */
void janet_lib_filewatch(JanetTable *env) {
JanetRegExt cfuns[] = {
JANET_CORE_REG("filewatch/new", cfun_filewatch_make),
JANET_CORE_REG("filewatch/add", cfun_filewatch_add),
JANET_CORE_REG("filewatch/remove", cfun_filewatch_remove),
JANET_CORE_REG("filewatch/listen", cfun_filewatch_listen),
JANET_CORE_REG("filewatch/unlisten", cfun_filewatch_unlisten),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, cfuns);
}
#endif
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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,24 +132,6 @@ static void janet_mark_many(const Janet *values, int32_t n) {
}
}
/* Mark a bunch of key values items in memory */
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
janet_mark(kvs->key);
kvs++;
}
}
/* Mark a bunch of key values items in memory */
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
janet_mark(kvs->value);
kvs++;
}
}
/* Mark a bunch of key values items in memory */
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
@@ -164,9 +146,7 @@ static void janet_mark_array(JanetArray *array) {
if (janet_gc_reachable(array))
return;
janet_gc_mark(array);
if (janet_gc_type((JanetGCObject *) array) == JANET_MEMORY_ARRAY) {
janet_mark_many(array->data, array->count);
}
janet_mark_many(array->data, array->count);
}
static void janet_mark_table(JanetTable *table) {
@@ -174,15 +154,7 @@ recur: /* Manual tail recursion */
if (janet_gc_reachable(table))
return;
janet_gc_mark(table);
enum JanetMemoryType memtype = janet_gc_type(table);
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
janet_mark_values(table->data, table->capacity);
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
janet_mark_keys(table->data, table->capacity);
} else if (memtype == JANET_MEMORY_TABLE) {
janet_mark_kvs(table->data, table->capacity);
}
/* do nothing for JANET_MEMORY_TABLE_WEAKKV */
janet_mark_kvs(table->data, table->capacity);
if (table->proto) {
table = table->proto;
goto recur;
@@ -296,12 +268,6 @@ recur:
if (fiber->supervisor_channel) {
janet_mark_abstract(fiber->supervisor_channel);
}
if (fiber->ev_stream) {
janet_mark_abstract(fiber->ev_stream);
}
if (fiber->ev_callback) {
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_MARK);
}
#endif
/* Explicit tail recursion */
@@ -321,26 +287,14 @@ static void janet_deinit_block(JanetGCObject *mem) {
janet_symbol_deinit(((JanetStringHead *) mem)->data);
break;
case JANET_MEMORY_ARRAY:
case JANET_MEMORY_ARRAY_WEAK:
janet_free(((JanetArray *) mem)->data);
break;
case JANET_MEMORY_TABLE:
case JANET_MEMORY_TABLE_WEAKK:
case JANET_MEMORY_TABLE_WEAKV:
case JANET_MEMORY_TABLE_WEAKKV:
janet_free(((JanetTable *) mem)->data);
break;
case JANET_MEMORY_FIBER: {
JanetFiber *f = (JanetFiber *)mem;
#ifdef JANET_EV
if (f->ev_state && !(f->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
janet_ev_dec_refcount();
janet_free(f->ev_state);
}
#endif
janet_free(f->data);
}
break;
case JANET_MEMORY_FIBER:
janet_free(((JanetFiber *)mem)->data);
break;
case JANET_MEMORY_BUFFER:
janet_buffer_deinit((JanetBuffer *) mem);
break;
@@ -372,98 +326,12 @@ static void janet_deinit_block(JanetGCObject *mem) {
}
}
/* Check that a value x has been visited in the mark phase */
static int janet_check_liveref(Janet x) {
switch (janet_type(x)) {
default:
return 1;
case JANET_ARRAY:
case JANET_TABLE:
case JANET_FUNCTION:
case JANET_BUFFER:
case JANET_FIBER:
return janet_gc_reachable(janet_unwrap_pointer(x));
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD:
return janet_gc_reachable(janet_string_head(janet_unwrap_string(x)));
case JANET_ABSTRACT:
return janet_gc_reachable(janet_abstract_head(janet_unwrap_abstract(x)));
case JANET_TUPLE:
return janet_gc_reachable(janet_tuple_head(janet_unwrap_tuple(x)));
case JANET_STRUCT:
return janet_gc_reachable(janet_struct_head(janet_unwrap_struct(x)));
}
}
/* Iterate over all allocated memory, and free memory that is not
* marked as reachable. Flip the gc color flag for next sweep. */
void janet_sweep() {
JanetGCObject *previous = NULL;
JanetGCObject *current = janet_vm.weak_blocks;
JanetGCObject *current = janet_vm.blocks;
JanetGCObject *next;
/* Sweep weak heap to drop weak refs */
while (NULL != current) {
next = current->data.next;
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
/* Check for dead references */
enum JanetMemoryType type = janet_gc_type(current);
if (type == JANET_MEMORY_ARRAY_WEAK) {
JanetArray *array = (JanetArray *) current;
for (uint32_t i = 0; i < (uint32_t) array->count; i++) {
if (!janet_check_liveref(array->data[i])) {
array->data[i] = janet_wrap_nil();
}
}
} else {
JanetTable *table = (JanetTable *) current;
int check_values = (type == JANET_MEMORY_TABLE_WEAKV) || (type == JANET_MEMORY_TABLE_WEAKKV);
int check_keys = (type == JANET_MEMORY_TABLE_WEAKK) || (type == JANET_MEMORY_TABLE_WEAKKV);
JanetKV *end = table->data + table->capacity;
JanetKV *kvs = table->data;
while (kvs < end) {
int drop = 0;
if (check_keys && !janet_check_liveref(kvs->key)) drop = 1;
if (check_values && !janet_check_liveref(kvs->value)) drop = 1;
if (drop) {
/* Inlined from janet_table_remove without search */
table->count--;
table->deleted++;
kvs->key = janet_wrap_nil();
kvs->value = janet_wrap_false();
}
kvs++;
}
}
}
current = next;
}
/* Sweep weak heap to free blocks */
previous = NULL;
current = janet_vm.weak_blocks;
while (NULL != current) {
next = current->data.next;
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
previous = current;
current->flags &= ~JANET_MEM_REACHABLE;
} else {
janet_vm.block_count--;
janet_deinit_block(current);
if (NULL != previous) {
previous->data.next = next;
} else {
janet_vm.weak_blocks = next;
}
janet_free(current);
}
current = next;
}
/* Sweep main heap to free blocks */
previous = NULL;
current = janet_vm.blocks;
while (NULL != current) {
next = current->data.next;
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
@@ -481,7 +349,6 @@ void janet_sweep() {
}
current = next;
}
#ifdef JANET_EV
/* Sweep threaded abstract types for references to decrement */
JanetKV *items = janet_vm.threaded_abstracts.data;
@@ -503,15 +370,14 @@ void janet_sweep() {
if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
}
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
items[i].value = janet_wrap_false();
janet_vm.threaded_abstracts.deleted++;
janet_vm.threaded_abstracts.count--;
/* Free memory */
janet_free(janet_abstract_head(abst));
}
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
items[i].value = janet_wrap_false();
janet_vm.threaded_abstracts.deleted++;
janet_vm.threaded_abstracts.count--;
}
/* Reset for next sweep */
@@ -539,15 +405,8 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
/* Prepend block to heap list */
janet_vm.next_collection += size;
if (type < JANET_MEMORY_TABLE_WEAKK) {
/* normal heap */
mem->data.next = janet_vm.blocks;
janet_vm.blocks = mem;
} else {
/* weak heap */
mem->data.next = janet_vm.weak_blocks;
janet_vm.weak_blocks = mem;
}
mem->data.next = janet_vm.blocks;
janet_vm.blocks = mem;
janet_vm.block_count++;
return (void *)mem;
@@ -578,8 +437,7 @@ void janet_collect(void) {
uint32_t i;
if (janet_vm.gc_suspend) return;
depth = JANET_RECURSION_GUARD;
janet_vm.gc_mark_phase = 1;
/* Try to prevent many major collections back to back.
/* Try and prevent many major collections back to back.
* A full collection will take O(janet_vm.block_count) time.
* If we have a large heap, make sure our interval is not too
* small so we won't make many collections over it. This is just a
@@ -598,7 +456,6 @@ void janet_collect(void) {
Janet x = janet_vm.roots[--janet_vm.root_count];
janet_mark(x);
}
janet_vm.gc_mark_phase = 0;
janet_sweep();
janet_vm.next_collection = 0;
janet_free_all_scratch();
@@ -702,9 +559,7 @@ void janet_gcunlock(int handle) {
janet_vm.gc_suspend = handle;
}
/* Scratch memory API
* Scratch memory allocations do not need to be free (but optionally can be), and will be automatically cleaned
* up in the next call to janet_collect. */
/* Scratch memory API */
void *janet_smalloc(size_t size) {
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -57,14 +57,10 @@ enum JanetMemoryType {
JANET_MEMORY_FUNCENV,
JANET_MEMORY_FUNCDEF,
JANET_MEMORY_THREADED_ABSTRACT,
JANET_MEMORY_TABLE_WEAKK,
JANET_MEMORY_TABLE_WEAKV,
JANET_MEMORY_TABLE_WEAKKV,
JANET_MEMORY_ARRAY_WEAK
};
/* To allocate collectable memory, one must call janet_alloc, initialize the memory,
* and then call when janet_enablegc when it is initialized and reachable by the gc (on the JANET stack) */
* and then call when janet_enablegc when it is initailize and reachable by the gc (on the JANET stack) */
void *janet_gcalloc(enum JanetMemoryType type, size_t size);
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose & contributors
* Copyright (c) 2023 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
@@ -73,13 +73,13 @@ static void *int64_unmarshal(JanetMarshalContext *ctx) {
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
char str[32];
snprintf(str, sizeof(str), "%" PRId64, *((int64_t *)p));
sprintf(str, "%" PRId64, *((int64_t *)p));
janet_buffer_push_cstring(buffer, str);
}
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
char str[32];
snprintf(str, sizeof(str), "%" PRIu64, *((uint64_t *)p));
sprintf(str, "%" PRIu64, *((uint64_t *)p));
janet_buffer_push_cstring(buffer, str);
}
@@ -118,9 +118,10 @@ int64_t janet_unwrap_s64(Janet x) {
default:
break;
case JANET_NUMBER : {
double d = janet_unwrap_number(x);
if (!janet_checkint64range(d)) break;
return (int64_t) d;
double dbl = janet_unwrap_number(x);
if (fabs(dbl) <= MAX_INT_IN_DBL)
return (int64_t)dbl;
break;
}
case JANET_STRING: {
int64_t value;
@@ -146,9 +147,12 @@ uint64_t janet_unwrap_u64(Janet x) {
default:
break;
case JANET_NUMBER : {
double d = janet_unwrap_number(x);
if (!janet_checkuint64range(d)) break;
return (uint64_t) d;
double dbl = janet_unwrap_number(x);
/* Allow negative values to be cast to "wrap around".
* This let's addition and subtraction work as expected. */
if (fabs(dbl) <= MAX_INT_IN_DBL)
return (uint64_t)dbl;
break;
}
case JANET_STRING: {
uint64_t value;
@@ -239,7 +243,7 @@ JANET_CORE_FN(cfun_to_bytes,
"Write the bytes of an `int/s64` or `int/u64` into a buffer.\n"
"The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created.\n"
"Returns the modified buffer.\n"
"The `endianness` parameter indicates the byte order:\n"
"The `endianness` paramater indicates the byte order:\n"
"- `nil` (unset): system byte order\n"
"- `:le`: little-endian, least significant byte first\n"
"- `:be`: big-endian, most significant byte first\n") {
@@ -303,8 +307,8 @@ static int compare_double_double(double x, double y) {
static int compare_int64_double(int64_t x, double y) {
if (isnan(y)) {
return 0;
} else if ((y > JANET_INTMIN_DOUBLE) && (y < JANET_INTMAX_DOUBLE)) {
return 0; // clojure and python do this
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
double dx = (double) x;
return compare_double_double(dx, y);
} else if (y > ((double) INT64_MAX)) {
@@ -319,10 +323,10 @@ static int compare_int64_double(int64_t x, double y) {
static int compare_uint64_double(uint64_t x, double y) {
if (isnan(y)) {
return 0;
return 0; // clojure and python do this
} else if (y < 0) {
return 1;
} else if ((y >= 0) && (y < JANET_INTMAX_DOUBLE)) {
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
double dx = (double) x;
return compare_double_double(dx, y);
} else if (y > ((double) UINT64_MAX)) {
@@ -335,9 +339,8 @@ static int compare_uint64_double(uint64_t x, double y) {
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_S64) {
if (janet_is_int(argv[0]) != JANET_INT_S64)
janet_panic("compare method requires int/s64 as first argument");
}
int64_t x = janet_unwrap_s64(argv[0]);
switch (janet_type(argv[1])) {
default:
@@ -352,6 +355,7 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
int64_t y = *(int64_t *)abst;
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
} else if (janet_abstract_type(abst) == &janet_u64_type) {
// comparing signed to unsigned -- be careful!
uint64_t y = *(uint64_t *)abst;
if (x < 0) {
return janet_wrap_number(-1);
@@ -370,9 +374,8 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_U64) {
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
janet_panic("compare method requires int/u64 as first argument");
}
uint64_t x = janet_unwrap_u64(argv[0]);
switch (janet_type(argv[1])) {
default:
@@ -387,6 +390,7 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
uint64_t y = *(uint64_t *)abst;
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
} else if (janet_abstract_type(abst) == &janet_s64_type) {
// comparing unsigned to signed -- be careful!
int64_t y = *(int64_t *)abst;
if (y < 0) {
return janet_wrap_number(1);
@@ -427,7 +431,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \
#define OPMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
@@ -436,19 +440,6 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
return janet_wrap_abstract(box); \
} \
#define UNARYMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = oper(janet_unwrap_##type(argv[0])); \
return janet_wrap_abstract(box); \
} \
#define DIVZERO(name) DIVZERO_##name
#define DIVZERO_div janet_panic("division by zero")
#define DIVZERO_rem janet_panic("division by zero")
#define DIVZERO_mod return janet_wrap_abstract(box)
#define DIVMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
@@ -456,19 +447,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
*box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) DIVZERO(name); \
if (value == 0) janet_panic("division by zero"); \
*box oper##= value; \
} \
return janet_wrap_abstract(box); \
} \
#define DIVMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \
if (value == 0) DIVZERO(name); \
if (value == 0) janet_panic("division by zero"); \
*box oper##= value; \
return janet_wrap_abstract(box); \
} \
@@ -480,7 +471,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
*box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) DIVZERO(name); \
if (value == 0) janet_panic("division by zero"); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= value; \
} \
@@ -488,50 +479,26 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \
if (value == 0) DIVZERO(name); \
if (value == 0) janet_panic("division by zero"); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= value; \
return janet_wrap_abstract(box); \
} \
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
int64_t op2 = janet_unwrap_s64(argv[1]);
if (op2 == 0) janet_panic("division by zero");
int64_t x = op1 / op2;
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]);
int64_t op1 = janet_unwrap_s64(argv[1]);
if (op2 == 0) janet_panic("division by zero");
int64_t x = op1 / op2;
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
int64_t op2 = janet_unwrap_s64(argv[1]);
if (op2 == 0) {
*box = op1;
} else {
int64_t x = op1 % op2;
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
}
int64_t x = op1 % op2;
*box = (op1 > 0)
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
return janet_wrap_abstract(box);
}
@@ -540,43 +507,37 @@ static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]);
int64_t op1 = janet_unwrap_s64(argv[1]);
if (op2 == 0) {
*box = op1;
} else {
int64_t x = op1 % op2;
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
}
int64_t x = op1 % op2;
*box = (op1 > 0)
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
return janet_wrap_abstract(box);
}
OPMETHOD(int64_t, s64, add, +)
OPMETHOD(int64_t, s64, sub, -)
OPMETHODINVERT(int64_t, s64, sub, -)
OPMETHODINVERT(int64_t, s64, subi, -)
OPMETHOD(int64_t, s64, mul, *)
DIVMETHOD_SIGNED(int64_t, s64, div, /)
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, div, /)
DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
OPMETHOD(int64_t, s64, and, &)
OPMETHOD(int64_t, s64, or, |)
OPMETHOD(int64_t, s64, xor, ^)
UNARYMETHOD(int64_t, s64, not, ~)
OPMETHOD(int64_t, s64, lshift, <<)
OPMETHOD(int64_t, s64, rshift, >>)
OPMETHOD(uint64_t, u64, add, +)
OPMETHOD(uint64_t, u64, sub, -)
OPMETHODINVERT(uint64_t, u64, sub, -)
OPMETHODINVERT(uint64_t, u64, subi, -)
OPMETHOD(uint64_t, u64, mul, *)
DIVMETHOD(uint64_t, u64, div, /)
DIVMETHOD(uint64_t, u64, rem, %)
DIVMETHOD(uint64_t, u64, mod, %)
DIVMETHODINVERT(uint64_t, u64, div, /)
DIVMETHODINVERT(uint64_t, u64, rem, %)
DIVMETHODINVERT(uint64_t, u64, mod, %)
DIVMETHODINVERT(uint64_t, u64, divi, /)
DIVMETHODINVERT(uint64_t, u64, modi, %)
OPMETHOD(uint64_t, u64, and, &)
OPMETHOD(uint64_t, u64, or, |)
OPMETHOD(uint64_t, u64, xor, ^)
UNARYMETHOD(uint64_t, u64, not, ~)
OPMETHOD(uint64_t, u64, lshift, <<)
OPMETHOD(uint64_t, u64, rshift, >>)
@@ -594,8 +555,6 @@ static JanetMethod it_s64_methods[] = {
{"r*", cfun_it_s64_mul},
{"/", cfun_it_s64_div},
{"r/", cfun_it_s64_divi},
{"div", cfun_it_s64_divf},
{"rdiv", cfun_it_s64_divfi},
{"mod", cfun_it_s64_mod},
{"rmod", cfun_it_s64_modi},
{"%", cfun_it_s64_rem},
@@ -606,7 +565,6 @@ static JanetMethod it_s64_methods[] = {
{"r|", cfun_it_s64_or},
{"^", cfun_it_s64_xor},
{"r^", cfun_it_s64_xor},
{"~", cfun_it_s64_not},
{"<<", cfun_it_s64_lshift},
{">>", cfun_it_s64_rshift},
{"compare", cfun_it_s64_compare},
@@ -622,19 +580,16 @@ static JanetMethod it_u64_methods[] = {
{"r*", cfun_it_u64_mul},
{"/", cfun_it_u64_div},
{"r/", cfun_it_u64_divi},
{"div", cfun_it_u64_div},
{"rdiv", cfun_it_u64_divi},
{"mod", cfun_it_u64_mod},
{"rmod", cfun_it_u64_modi},
{"%", cfun_it_u64_rem},
{"r%", cfun_it_u64_remi},
{"%", cfun_it_u64_mod},
{"r%", cfun_it_u64_modi},
{"&", cfun_it_u64_and},
{"r&", cfun_it_u64_and},
{"|", cfun_it_u64_or},
{"r|", cfun_it_u64_or},
{"^", cfun_it_u64_xor},
{"r^", cfun_it_u64_xor},
{"~", cfun_it_u64_not},
{"<<", cfun_it_u64_lshift},
{">>", cfun_it_u64_rshift},
{"compare", cfun_it_u64_compare},

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -41,11 +41,6 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx);
static void *io_file_unmarshal(JanetMarshalContext *ctx);
static Janet io_file_next(void *p, Janet key);
#ifdef JANET_WINDOWS
#define ftell _ftelli64
#define fseek _fseeki64
#endif
const JanetAbstractType janet_file_type = {
"core/file",
cfun_io_gc,
@@ -131,12 +126,12 @@ JANET_CORE_FN(cfun_io_temp,
// XXX use mkostemp when we can to avoid CLOEXEC race.
FILE *tmp = tmpfile();
if (!tmp)
janet_panicf("unable to create temporary file - %s", janet_strerror(errno));
janet_panicf("unable to create temporary file - %s", strerror(errno));
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
}
JANET_CORE_FN(cfun_io_fopen,
"(file/open path &opt mode buffer-size)",
"(file/open path &opt mode)",
"Open a file. `path` is an absolute or relative path, and "
"`mode` is a set of flags indicating the mode to open the file in. "
"`mode` is a keyword where each character represents a flag. If the file "
@@ -148,9 +143,8 @@ JANET_CORE_FN(cfun_io_fopen,
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
"* b - open the file in binary mode (rather than text mode)\n\n"
"* + - append to the file instead of overwriting it\n\n"
"* n - error if the file cannot be opened instead of returning nil\n\n"
"See fopen (<stdio.h>, C99) for further details.") {
janet_arity(argc, 1, 3);
"* n - error if the file cannot be opened instead of returning nil") {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode;
int32_t flags;
@@ -163,17 +157,8 @@ JANET_CORE_FN(cfun_io_fopen,
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
if (f != NULL) {
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
if (bufsize != BUFSIZ) {
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
if (result) {
janet_panic("failed to set buffer size for file");
}
}
}
return f ? janet_makefile(f, flags)
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil())
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
: janet_wrap_nil();
}
@@ -294,7 +279,7 @@ int janet_file_close(JanetFile *file) {
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
ret = fclose(file->file);
file->flags |= JANET_FILE_CLOSED;
file->file = NULL; /* NULL dereference is easier to debug then other problems */
file->file = NULL; /* NULL derefence is easier to debug then other problems */
return ret;
}
return 0;
@@ -342,7 +327,7 @@ JANET_CORE_FN(cfun_io_fseek,
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
int64_t offset = 0;
long int offset = 0;
int whence = SEEK_CUR;
if (argc >= 2) {
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
@@ -356,7 +341,7 @@ JANET_CORE_FN(cfun_io_fseek,
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
}
if (argc == 3) {
offset = (int64_t) janet_getinteger64(argv, 2);
offset = (long) janet_getinteger64(argv, 2);
}
}
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
@@ -370,7 +355,7 @@ JANET_CORE_FN(cfun_io_ftell,
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
int64_t pos = ftell(iof->file);
long pos = ftell(iof->file);
if (pos == -1) janet_panic("error getting position in file");
return janet_wrap_number((double)pos);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -68,15 +68,8 @@ enum {
LB_STRUCT_PROTO, /* 223 */
#ifdef JANET_EV
LB_THREADED_ABSTRACT, /* 224 */
LB_POINTER_BUFFER, /* 225 */
LB_POINTER_BUFFER, /* 224 */
#endif
LB_TABLE_WEAKK, /* 226 */
LB_TABLE_WEAKV, /* 227 */
LB_TABLE_WEAKKV, /* 228 */
LB_TABLE_WEAKK_PROTO, /* 229 */
LB_TABLE_WEAKV_PROTO, /* 230 */
LB_TABLE_WEAKKV_PROTO, /* 231 */
LB_ARRAY_WEAK, /* 232 */
} LeadBytes;
/* Helper to look inside an entry in an environment */
@@ -161,7 +154,7 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
janet_buffer_push_bytes(st->buf, bytes, len);
}
static void pushpointer(MarshalState *st, const void *ptr) {
static void pushpointer(MarshalState *st, void *ptr) {
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
}
@@ -192,19 +185,6 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags);
/* Prevent stack overflows */
#define MARSH_STACKCHECK if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) janet_panic("stack overflow")
/* Quick check if a fiber cannot be marshalled. This is will
* have no false positives, but may have false negatives. */
static int fiber_cannot_be_marshalled(JanetFiber *fiber) {
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE) return 1;
int32_t i = fiber->frame;
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (!frame->func) return 1; /* has cfunction on stack */
i = frame->prevframe;
}
return 0;
}
/* Marshal a function env */
static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
MARSH_STACKCHECK;
@@ -217,9 +197,7 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
}
janet_env_valid(env);
janet_v_push(st->seen_envs, env);
/* Special case for early detachment */
if (env->offset > 0 && fiber_cannot_be_marshalled(env->as.fiber)) {
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
pushint(st, 0);
pushint(st, env->length);
Janet *values = env->as.fiber->data + env->offset;
@@ -268,7 +246,6 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
}
/* Add to lookup */
janet_v_push(st->seen_defs, def);
pushint(st, def->flags);
pushint(st, def->slotcount);
pushint(st, def->arity);
@@ -289,14 +266,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
/* marshal constants */
for (int32_t i = 0; i < def->constants_length; i++)
marshal_one(st, def->constants[i], flags + 1);
marshal_one(st, def->constants[i], flags);
/* Marshal symbol map, if needed */
for (int32_t i = 0; i < def->symbolmap_length; i++) {
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
pushint(st, (int32_t) def->symbolmap[i].death_pc);
pushint(st, (int32_t) def->symbolmap[i].slot_index);
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags + 1);
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
}
/* marshal the bytecode */
@@ -350,7 +327,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (frame->env) frame->flags |= JANET_STACKFRAME_HASENV;
if (!frame->func) janet_panicf("cannot marshal fiber with c stackframe (%v)", janet_wrap_cfunction((JanetCFunction) frame->pc));
if (!frame->func) janet_panic("cannot marshal fiber with c stackframe");
pushint(st, frame->flags);
pushint(st, frame->prevframe);
int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode);
@@ -387,11 +364,11 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
/* Only use in unsafe - don't marshal pointers otherwise */
void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only marshal pointers in unsafe mode");
}
MarshalState *st = (MarshalState *)(ctx->m_state);
pushpointer(st, ptr);
#ifdef JANET_32
janet_marshal_int(ctx, (intptr_t) ptr);
#else
janet_marshal_int64(ctx, (intptr_t) ptr);
#endif
}
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
@@ -410,27 +387,18 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
marshal_one(st, x, ctx->flags + 1);
}
#ifdef JANET_MARSHAL_DEBUG
#define MARK_SEEN() \
do { if (st->maybe_cycles) { \
Janet _check = janet_table_get(&st->seen, x); \
if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \
janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
} } while (0)
#else
#define MARK_SEEN() \
do { if (st->maybe_cycles) { \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
} } while (0)
#endif
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
MarshalState *st = (MarshalState *)(ctx->m_state);
Janet x = janet_wrap_abstract(abstract);
MARK_SEEN();
if (st->maybe_cycles) {
janet_table_put(&st->seen,
janet_wrap_abstract(abstract),
janet_wrap_integer(st->nextid++));
}
}
#define MARK_SEEN() \
do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
void *abstract = janet_unwrap_abstract(x);
#ifdef JANET_EV
@@ -452,7 +420,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
if (at->marshal) {
pushbyte(st, LB_ABSTRACT);
marshal_one(st, janet_csymbolv(at->name), flags + 1);
JanetMarshalContext context = {st, NULL, flags + 1, NULL, at};
JanetMarshalContext context = {st, NULL, flags, NULL, at};
at->marshal(abstract, &context);
} else {
janet_panicf("cannot marshal %p", x);
@@ -576,8 +544,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
int32_t i;
JanetArray *a = janet_unwrap_array(x);
MARK_SEEN();
enum JanetMemoryType memtype = janet_gc_type(a);
pushbyte(st, memtype == JANET_MEMORY_ARRAY_WEAK ? LB_ARRAY_WEAK : LB_ARRAY);
pushbyte(st, LB_ARRAY);
pushint(st, a->count);
for (i = 0; i < a->count; i++)
marshal_one(st, a->data[i], flags + 1);
@@ -600,16 +567,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_TABLE: {
JanetTable *t = janet_unwrap_table(x);
MARK_SEEN();
enum JanetMemoryType memtype = janet_gc_type(t);
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
pushbyte(st, t->proto ? LB_TABLE_WEAKK_PROTO : LB_TABLE_WEAKK);
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
pushbyte(st, t->proto ? LB_TABLE_WEAKV_PROTO : LB_TABLE_WEAKV);
} else if (memtype == JANET_MEMORY_TABLE_WEAKKV) {
pushbyte(st, t->proto ? LB_TABLE_WEAKKV_PROTO : LB_TABLE_WEAKKV);
} else {
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
}
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
pushint(st, t->count);
if (t->proto)
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
@@ -779,22 +737,9 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
return ret;
}
#ifdef JANET_MARSHAL_DEBUG
static void dump_reference_table(UnmarshalState *st) {
for (int32_t i = 0; i < janet_v_count(st->lookup); i++) {
janet_eprintf(" reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]);
}
}
#endif
/* Assert a janet type */
static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) {
static void janet_asserttype(Janet x, JanetType t) {
if (!janet_checktype(x, t)) {
#ifdef JANET_MARSHAL_DEBUG
dump_reference_table(st);
#else
(void) st;
#endif
janet_panicf("expected type %T, got %v", 1 << t, x);
}
}
@@ -846,7 +791,7 @@ static const uint8_t *unmarshal_one_env(
Janet fiberv;
/* On stack variant */
data = unmarshal_one(st, data, &fiberv, flags);
janet_asserttype(fiberv, JANET_FIBER, st);
janet_asserttype(fiberv, JANET_FIBER);
env->as.fiber = janet_unwrap_fiber(fiberv);
/* Negative offset indicates untrusted input */
env->offset = -offset;
@@ -944,13 +889,13 @@ static const uint8_t *unmarshal_one_def(
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
Janet x;
data = unmarshal_one(st, data, &x, flags + 1);
janet_asserttype(x, JANET_STRING, st);
janet_asserttype(x, JANET_STRING);
def->name = janet_unwrap_string(x);
}
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
Janet x;
data = unmarshal_one(st, data, &x, flags + 1);
janet_asserttype(x, JANET_STRING, st);
janet_asserttype(x, JANET_STRING);
def->source = janet_unwrap_string(x);
}
@@ -980,9 +925,8 @@ static const uint8_t *unmarshal_one_def(
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
Janet value;
data = unmarshal_one(st, data, &value, flags + 1);
if (!janet_checktype(value, JANET_SYMBOL)) {
janet_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value);
}
if (!janet_checktype(value, JANET_SYMBOL))
janet_panic("expected symbol in symbol map");
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
}
def->symbolmap_length = (uint32_t) symbolmap_length;
@@ -1080,11 +1024,9 @@ static const uint8_t *unmarshal_one_fiber(
fiber->env = NULL;
fiber->last_value = janet_wrap_nil();
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
fiber->supervisor_channel = NULL;
fiber->ev_state = NULL;
fiber->ev_callback = NULL;
fiber->ev_stream = NULL;
#endif
/* Push fiber to seen stack */
@@ -1133,7 +1075,7 @@ static const uint8_t *unmarshal_one_fiber(
/* Get function */
Janet funcv;
data = unmarshal_one(st, data, &funcv, flags + 1);
janet_asserttype(funcv, JANET_FUNCTION, st);
janet_asserttype(funcv, JANET_FUNCTION);
func = janet_unwrap_function(funcv);
def = func->def;
@@ -1179,7 +1121,7 @@ static const uint8_t *unmarshal_one_fiber(
Janet envv;
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
data = unmarshal_one(st, data, &envv, flags + 1);
janet_asserttype(envv, JANET_TABLE, st);
janet_asserttype(envv, JANET_TABLE);
fiber_env = janet_unwrap_table(envv);
}
@@ -1188,7 +1130,7 @@ static const uint8_t *unmarshal_one_fiber(
Janet fiberv;
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
data = unmarshal_one(st, data, &fiberv, flags + 1);
janet_asserttype(fiberv, JANET_FIBER, st);
janet_asserttype(fiberv, JANET_FIBER);
fiber->child = janet_unwrap_fiber(fiberv);
}
@@ -1233,15 +1175,12 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
}
void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only unmarshal pointers in unsafe mode");
}
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
void *ptr;
MARSH_EOS(st, ctx->data + sizeof(void *) - 1);
memcpy((char *) &ptr, ctx->data, sizeof(void *));
ctx->data += sizeof(void *);
return ptr;
#ifdef JANET_32
return (void *) ((intptr_t) readint(st, &(ctx->data)));
#else
return (void *) ((intptr_t) read64(st, &(ctx->data)));
#endif
}
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
@@ -1279,18 +1218,6 @@ void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
return p;
}
void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
#ifdef JANET_THREADS
void *p = janet_abstract_threaded(ctx->at, size);
janet_unmarshal_abstract_reuse(ctx, p);
return p;
#else
(void) ctx;
(void) size;
janet_panic("threaded abstracts not supported");
#endif
}
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);
@@ -1298,9 +1225,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
if (at == NULL) janet_panic("unknown abstract type");
if (at->unmarshal) {
JanetMarshalContext context = {NULL, st, flags, data, at};
void *abst = at->unmarshal(&context);
janet_assert(abst != NULL, "null pointer abstract");
*out = janet_wrap_abstract(abst);
*out = janet_wrap_abstract(at->unmarshal(&context));
if (context.at != NULL) {
janet_panic("janet_unmarshal_abstract not called");
}
@@ -1401,7 +1326,7 @@ static const uint8_t *unmarshal_one(
}
case LB_FIBER: {
JanetFiber *fiber;
data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1);
data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
*out = janet_wrap_fiber(fiber);
return data;
}
@@ -1416,9 +1341,6 @@ static const uint8_t *unmarshal_one(
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
len * sizeof(JanetFuncEnv));
func->def = NULL;
for (int32_t i = 0; i < len; i++) {
func->envs[i] = NULL;
}
*out = janet_wrap_function(func);
janet_v_push(st->lookup, *out);
data = unmarshal_one_def(st, data, &def, flags + 1);
@@ -1434,18 +1356,11 @@ static const uint8_t *unmarshal_one(
}
case LB_REFERENCE:
case LB_ARRAY:
case LB_ARRAY_WEAK:
case LB_TUPLE:
case LB_STRUCT:
case LB_STRUCT_PROTO:
case LB_TABLE:
case LB_TABLE_PROTO:
case LB_TABLE_WEAKK:
case LB_TABLE_WEAKV:
case LB_TABLE_WEAKKV:
case LB_TABLE_WEAKK_PROTO:
case LB_TABLE_WEAKV_PROTO:
case LB_TABLE_WEAKKV_PROTO:
/* Things that open with integers */
{
data++;
@@ -1454,9 +1369,9 @@ static const uint8_t *unmarshal_one(
if (lead != LB_REFERENCE) {
MARSH_EOS(st, data - 1 + len);
}
if (lead == LB_ARRAY || lead == LB_ARRAY_WEAK) {
if (lead == LB_ARRAY) {
/* Array */
JanetArray *array = (lead == LB_ARRAY_WEAK) ? janet_array_weak(len) : janet_array(len);
JanetArray *array = janet_array(len);
array->count = len;
*out = janet_wrap_array(array);
janet_v_push(st->lookup, *out);
@@ -1479,7 +1394,7 @@ static const uint8_t *unmarshal_one(
if (lead == LB_STRUCT_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_STRUCT, st);
janet_asserttype(proto, JANET_STRUCT);
janet_struct_proto(struct_) = janet_unwrap_struct(proto);
}
for (int32_t i = 0; i < len; i++) {
@@ -1496,22 +1411,13 @@ static const uint8_t *unmarshal_one(
*out = st->lookup[len];
} else {
/* Table */
JanetTable *t;
if (lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKK) {
t = janet_table_weakk(len);
} else if (lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKV) {
t = janet_table_weakv(len);
} else if (lead == LB_TABLE_WEAKKV_PROTO || lead == LB_TABLE_WEAKKV) {
t = janet_table_weakkv(len);
} else {
t = janet_table(len);
}
JanetTable *t = janet_table(len);
*out = janet_wrap_table(t);
janet_v_push(st->lookup, *out);
if (lead == LB_TABLE_PROTO || lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKKV_PROTO) {
if (lead == LB_TABLE_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_TABLE, st);
janet_asserttype(proto, JANET_TABLE);
t->proto = janet_unwrap_table(proto);
}
for (int32_t i = 0; i < len; i++) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -85,10 +85,10 @@ void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len) {
uint8_t state[16] = {0};
for (int32_t i = 0; i < len; i++)
state[i & 0xF] ^= bytes[i];
rng->a = state[0] + ((uint32_t) state[1] << 8) + ((uint32_t) state[2] << 16) + ((uint32_t) state[3] << 24);
rng->b = state[4] + ((uint32_t) state[5] << 8) + ((uint32_t) state[6] << 16) + ((uint32_t) state[7] << 24);
rng->c = state[8] + ((uint32_t) state[9] << 8) + ((uint32_t) state[10] << 16) + ((uint32_t) state[11] << 24);
rng->d = state[12] + ((uint32_t) state[13] << 8) + ((uint32_t) state[14] << 16) + ((uint32_t) state[15] << 24);
rng->a = state[0] + (state[1] << 8) + (state[2] << 16) + (state[3] << 24);
rng->b = state[4] + (state[5] << 8) + (state[6] << 16) + (state[7] << 24);
rng->c = state[8] + (state[9] << 8) + (state[10] << 16) + (state[11] << 24);
rng->d = state[12] + (state[13] << 8) + (state[14] << 16) + (state[15] << 24);
rng->counter = 0u;
/* a, b, c, d can't all be 0 */
if (rng->a == 0) rng->a = 1u;
@@ -119,7 +119,7 @@ double janet_rng_double(JanetRNG *rng) {
JANET_CORE_FN(cfun_rng_make,
"(math/rng &opt seed)",
"Creates a Pseudo-Random number generator, with an optional seed. "
"Creates a Psuedo-Random number generator, with an optional seed. "
"The seed should be an unsigned 32 bit integer or a buffer. "
"Do not use this for cryptography. Returns a core/rng abstract type."
) {
@@ -349,26 +349,6 @@ JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
return janet_wrap_number(janet_lcm(x, y));
}
JANET_CORE_FN(janet_cfun_frexp, "(math/frexp x)",
"Returns a tuple of (mantissa, exponent) from number.") {
janet_fixarity(argc, 1);
double x = janet_getnumber(argv, 0);
int exp;
x = frexp(x, &exp);
Janet *result = janet_tuple_begin(2);
result[0] = janet_wrap_number(x);
result[1] = janet_wrap_number((double) exp);
return janet_wrap_tuple(janet_tuple_end(result));
}
JANET_CORE_FN(janet_cfun_ldexp, "(math/ldexp m e)",
"Creates a new number from a mantissa and an exponent.") {
janet_fixarity(argc, 2);
double x = janet_getnumber(argv, 0);
int32_t y = janet_getinteger(argv, 1);
return janet_wrap_number(ldexp(x, y));
}
/* Module entry point */
void janet_lib_math(JanetTable *env) {
JanetRegExt math_cfuns[] = {
@@ -415,8 +395,6 @@ void janet_lib_math(JanetTable *env) {
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),
JANET_CORE_REG("math/ldexp", janet_cfun_ldexp),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, math_cfuns);
@@ -433,11 +411,11 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN),
"The minimum contiguous integer representable by a 32 bit signed integer");
JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
"The maximum contiguous integer representable by a 32 bit signed integer");
"The maximum contiguous integer represtenable 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)");
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 represtenable by a double (-(2^53))");
#ifdef NAN
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
#else

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose and contributors.
* Copyright (c) 2023 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
@@ -24,7 +24,6 @@
#include "features.h"
#include <janet.h>
#include "util.h"
#include "fiber.h"
#endif
#ifdef JANET_NET
@@ -79,20 +78,12 @@ const JanetAbstractType janet_address_type = {
/* maximum number of bytes in a socket address host (post name resolution) */
#ifdef JANET_WINDOWS
#ifdef JANET_NO_IPV6
#define SA_ADDRSTRLEN (INET_ADDRSTRLEN + 1)
#else
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
#endif
typedef unsigned short in_port_t;
#else
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
#ifdef JANET_NO_IPV6
#define SA_ADDRSTRLEN JANET_SA_MAX(INET_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
#else
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
#endif
#endif
static JanetStream *make_stream(JSock handle, uint32_t flags);
@@ -120,57 +111,12 @@ static void janet_net_socknoblock(JSock s) {
#endif
}
/* State machine for async connect */
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
switch (event) {
default:
break;
#ifndef JANET_WINDOWS
/* Wait until we have an actual event before checking.
* Windows doesn't support async connect with this, just try immediately.*/
case JANET_ASYNC_EVENT_INIT:
#endif
case JANET_ASYNC_EVENT_DEINIT:
return;
case JANET_ASYNC_EVENT_CLOSE:
janet_cancel(fiber, janet_cstringv("stream closed"));
janet_async_end(fiber);
return;
}
#ifdef JANET_WINDOWS
int res = 0;
int size = sizeof(res);
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
#else
int res = 0;
socklen_t size = sizeof res;
int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
#endif
if (r == 0) {
if (res == 0) {
janet_schedule(fiber, janet_wrap_abstract(stream));
} else {
janet_cancel(fiber, janet_cstringv(janet_strerror(res)));
stream->flags |= JANET_STREAM_TOCLOSE;
}
} else {
janet_cancel(fiber, janet_ev_lasterr());
stream->flags |= JANET_STREAM_TOCLOSE;
}
janet_async_end(fiber);
}
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL);
}
/* State machine for accepting connections. */
#ifdef JANET_WINDOWS
typedef struct {
JanetListenerState head;
WSAOVERLAPPED overlapped;
JanetFunction *function;
JanetStream *lstream;
@@ -178,10 +124,10 @@ typedef struct {
char buf[1024];
} NetStateAccept;
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err);
static int net_sched_accept_impl(NetStateAccept *state, Janet *err);
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
NetStateAccept *state = (NetStateAccept *)s;
switch (event) {
default:
break;
@@ -192,60 +138,55 @@ void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
break;
}
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
return;
janet_schedule(s->fiber, janet_wrap_nil());
return JANET_ASYNC_STATUS_DONE;
case JANET_ASYNC_EVENT_COMPLETE: {
if (state->astream->flags & JANET_STREAM_CLOSED) {
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
janet_async_end(fiber);
return;
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
return JANET_ASYNC_STATUS_DONE;
}
SOCKET lsock = (SOCKET) state->lstream->handle;
if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
(char *) &lsock, sizeof(lsock))) {
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
janet_async_end(fiber);
return;
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
return JANET_ASYNC_STATUS_DONE;
}
Janet streamv = janet_wrap_abstract(state->astream);
if (state->function) {
/* Schedule worker */
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
sub_fiber->supervisor_channel = fiber->supervisor_channel;
janet_schedule(sub_fiber, janet_wrap_nil());
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
fiber->supervisor_channel = s->fiber->supervisor_channel;
janet_schedule(fiber, janet_wrap_nil());
/* Now listen again for next connection */
Janet err;
if (net_sched_accept_impl(state, fiber, &err)) {
janet_cancel(fiber, err);
janet_async_end(fiber);
return;
if (net_sched_accept_impl(state, &err)) {
janet_cancel(s->fiber, err);
return JANET_ASYNC_STATUS_DONE;
}
} else {
janet_schedule(fiber, streamv);
janet_async_end(fiber);
return;
janet_schedule(s->fiber, streamv);
return JANET_ASYNC_STATUS_DONE;
}
}
}
return JANET_ASYNC_STATUS_NOT_DONE;
}
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
Janet err;
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
NetStateAccept *state = (NetStateAccept *)s;
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
memset(&state->buf, 0, 1024);
state->function = fun;
state->lstream = stream;
if (net_sched_accept_impl(state, janet_root_fiber(), &err)) {
janet_free(state);
janet_panicv(err);
}
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
s->tag = &state->overlapped;
if (net_sched_accept_impl(state, &err)) janet_panicv(err);
janet_await();
}
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err) {
static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
SOCKET lsock = (SOCKET) state->lstream->handle;
SOCKET asock = WSASocketW(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED);
if (asock == INVALID_SOCKET) {
@@ -257,11 +198,7 @@ static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
int code = WSAGetLastError();
if (code == WSA_IO_PENDING) {
/* indicates io is happening async */
janet_async_in_flight(fiber);
return 0;
}
if (code == WSA_IO_PENDING) return 0; /* indicates io is happening async */
*err = janet_ev_lasterr();
return 1;
}
@@ -271,12 +208,12 @@ static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet
#else
typedef struct {
JanetListenerState head;
JanetFunction *function;
} NetStateAccept;
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
NetStateAccept *state = (NetStateAccept *)s;
switch (event) {
default:
break;
@@ -285,47 +222,43 @@ void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
break;
}
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
return;
case JANET_ASYNC_EVENT_INIT:
janet_schedule(s->fiber, janet_wrap_nil());
return JANET_ASYNC_STATUS_DONE;
case JANET_ASYNC_EVENT_READ: {
#if defined(JANET_LINUX)
JSock connfd = accept4(stream->handle, NULL, NULL, SOCK_CLOEXEC);
JSock connfd = accept4(s->stream->handle, NULL, NULL, SOCK_CLOEXEC);
#else
/* On BSDs, CLOEXEC should be inherited from server socket */
JSock connfd = accept(stream->handle, NULL, NULL);
JSock connfd = accept(s->stream->handle, NULL, NULL);
#endif
if (JSOCKVALID(connfd)) {
janet_net_socknoblock(connfd);
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
Janet streamv = janet_wrap_abstract(stream);
if (state->function) {
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
sub_fiber->supervisor_channel = fiber->supervisor_channel;
janet_schedule(sub_fiber, janet_wrap_nil());
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
fiber->supervisor_channel = s->fiber->supervisor_channel;
janet_schedule(fiber, janet_wrap_nil());
} else {
janet_schedule(fiber, streamv);
janet_async_end(fiber);
return;
janet_schedule(s->fiber, streamv);
return JANET_ASYNC_STATUS_DONE;
}
}
break;
}
}
return JANET_ASYNC_STATUS_NOT_DONE;
}
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
memset(state, 0, sizeof(NetStateAccept));
NetStateAccept *state = (NetStateAccept *) janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
state->function = fun;
if (fun) janet_stream_level_triggered(stream);
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
janet_await();
}
#endif
/* Address info */
/* Adress info */
static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL);
@@ -563,7 +496,7 @@ JANET_CORE_FN(cfun_net_connect,
}
#endif
if (status) {
if (status != 0) {
#ifdef JANET_WINDOWS
if (err != WSAEWOULDBLOCK) {
#else
@@ -575,7 +508,10 @@ JANET_CORE_FN(cfun_net_connect,
}
}
net_sched_connect(stream);
/* Handle the connect() result in the event loop*/
janet_ev_connect(stream, MSG_NOSIGNAL);
janet_await();
}
static const char *serverify_socket(JSock sfd) {
@@ -746,7 +682,6 @@ static Janet janet_so_getname(const void *sa_any) {
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
return janet_wrap_tuple(janet_tuple_n(pair, 2));
}
#ifndef JANET_NO_IPV6
case AF_INET6: {
const struct sockaddr_in6 *sai6 = sa_any;
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
@@ -755,7 +690,6 @@ static Janet janet_so_getname(const void *sa_any) {
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
return janet_wrap_tuple(janet_tuple_n(pair, 2));
}
#endif
#ifndef JANET_WINDOWS
case AF_UNIX: {
const struct sockaddr_un *sun = sa_any;
@@ -822,7 +756,6 @@ JANET_CORE_FN(cfun_stream_accept_loop,
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
JanetFunction *fun = janet_getfunction(argv, 1);
if (fun->def->min_arity < 1) janet_panic("handler function must take at least 1 argument");
janet_sched_accept(stream, fun);
}
@@ -859,6 +792,7 @@ JANET_CORE_FN(cfun_stream_read,
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
}
janet_await();
}
JANET_CORE_FN(cfun_stream_chunk,
@@ -873,6 +807,7 @@ JANET_CORE_FN(cfun_stream_chunk,
double to = janet_optnumber(argv, argc, 3, INFINITY);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL);
janet_await();
}
JANET_CORE_FN(cfun_stream_recv_from,
@@ -887,6 +822,7 @@ JANET_CORE_FN(cfun_stream_recv_from,
double to = janet_optnumber(argv, argc, 3, INFINITY);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL);
janet_await();
}
JANET_CORE_FN(cfun_stream_write,
@@ -906,6 +842,7 @@ JANET_CORE_FN(cfun_stream_write,
if (to != INFINITY) janet_addtimeout(to);
janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL);
}
janet_await();
}
JANET_CORE_FN(cfun_stream_send_to,
@@ -926,6 +863,7 @@ JANET_CORE_FN(cfun_stream_send_to,
if (to != INFINITY) janet_addtimeout(to);
janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL);
}
janet_await();
}
JANET_CORE_FN(cfun_stream_flush,
@@ -959,10 +897,8 @@ static const struct sockopt_type sockopt_type_list[] = {
{ "ip-multicast-ttl", IPPROTO_IP, IP_MULTICAST_TTL, JANET_NUMBER },
{ "ip-add-membership", IPPROTO_IP, IP_ADD_MEMBERSHIP, JANET_POINTER },
{ "ip-drop-membership", IPPROTO_IP, IP_DROP_MEMBERSHIP, JANET_POINTER },
#ifndef JANET_NO_IPV6
{ "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
#endif
{ NULL, 0, 0, JANET_POINTER }
};
@@ -999,9 +935,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
union {
int v_int;
struct ip_mreq v_mreq;
#ifndef JANET_NO_IPV6
struct ipv6_mreq v_mreq6;
#endif
} val;
void *optval = (void *)&val;
@@ -1019,14 +953,12 @@ JANET_CORE_FN(cfun_net_setsockopt,
val.v_mreq.imr_interface.s_addr = htonl(INADDR_ANY);
inet_pton(AF_INET, addr, &val.v_mreq.imr_multiaddr.s_addr);
optlen = sizeof(val.v_mreq);
#ifndef JANET_NO_IPV6
} else if (st->optname == IPV6_JOIN_GROUP || st->optname == IPV6_LEAVE_GROUP) {
const char *addr = janet_getcstring(argv, 2);
memset(&val.v_mreq6, 0, sizeof val.v_mreq6);
val.v_mreq6.ipv6mr_interface = 0;
inet_pton(AF_INET6, addr, &val.v_mreq6.ipv6mr_multiaddr);
optlen = sizeof(val.v_mreq6);
#endif
} else {
janet_panicf("invalid socket option type");
}
@@ -1035,7 +967,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
if (r == -1) {
janet_panicf("setsockopt(%q): %s", argv[1], janet_strerror(errno));
janet_panicf("setsockopt(%q): %s", argv[1], strerror(errno));
}
return janet_wrap_nil();

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose and contributors.
* Copyright (c) 2023 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
@@ -27,10 +27,9 @@
#include "gc.h"
#endif
#include <stdlib.h>
#ifndef JANET_REDUCED_OS
#include <stdlib.h>
#include <time.h>
#include <fcntl.h>
#include <errno.h>
@@ -39,7 +38,6 @@
#include <string.h>
#include <sys/stat.h>
#include <signal.h>
#include <locale.h>
#ifdef JANET_BSD
#include <sys/sysctl.h>
@@ -175,8 +173,6 @@ JANET_CORE_FN(os_arch,
"* :riscv64\n\n"
"* :sparc\n\n"
"* :wasm\n\n"
"* :s390\n\n"
"* :s390x\n\n"
"* :unknown\n") {
janet_fixarity(argc, 0);
(void) argv;
@@ -203,10 +199,6 @@ JANET_CORE_FN(os_arch,
return janet_ckeywordv("ppc");
#elif (defined(__ppc64__) || defined(_ARCH_PPC64) || defined(_M_PPC))
return janet_ckeywordv("ppc64");
#elif (defined(__s390x__))
return janet_ckeywordv("s390x");
#elif (defined(__s390__))
return janet_ckeywordv("s390");
#else
return janet_ckeywordv("unknown");
#endif
@@ -237,11 +229,10 @@ JANET_CORE_FN(os_compiler,
#undef janet_stringify
JANET_CORE_FN(os_exit,
"(os/exit &opt x force)",
"(os/exit &opt x)",
"Exit from janet with an exit code equal to x. If x is not an integer, "
"the exit with status equal the hash of x. If `force` is truthy will exit immediately and "
"skip cleanup code.") {
janet_arity(argc, 0, 2);
"the exit with status equal the hash of x.") {
janet_arity(argc, 0, 1);
int status;
if (argc == 0) {
status = EXIT_SUCCESS;
@@ -251,11 +242,7 @@ JANET_CORE_FN(os_exit,
status = EXIT_FAILURE;
}
janet_deinit();
if (argc >= 2 && janet_truthy(argv[1])) {
_Exit(status);
} else {
exit(status);
}
exit(status);
return janet_wrap_nil();
}
@@ -513,11 +500,8 @@ static int proc_get_status(JanetProc *proc) {
status = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
status = WSTOPSIG(status) + 128;
} else if (WIFSIGNALED(status)) {
status = WTERMSIG(status) + 128;
} else {
/* Could possibly return -1 but for now, just panic */
janet_panicf("Undefined status code for process termination, %d.", status);
status = WTERMSIG(status) + 128;
}
return status;
}
@@ -533,6 +517,7 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
/* Callback that is called in main thread when subroutine completes. */
static void janet_proc_wait_cb(JanetEVGenericMessage args) {
janet_ev_dec_refcount();
JanetProc *proc = (JanetProc *) args.argp;
if (NULL != proc) {
int status = args.tag;
@@ -545,9 +530,7 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
janet_cancel(args.fiber, janet_wrap_string(s));
} else {
if (janet_fiber_can_resume(args.fiber)) {
janet_schedule(args.fiber, janet_wrap_integer(status));
}
janet_schedule(args.fiber, janet_wrap_integer(status));
}
}
}
@@ -629,11 +612,7 @@ os_proc_wait_impl(JanetProc *proc) {
JANET_CORE_FN(os_proc_wait,
"(os/proc-wait proc)",
"Suspend the current fiber until the subprocess completes. Returns the subprocess return code. "
"os/proc-wait cannot be called twice on the same process. If `ev/with-deadline` cancels `os/proc-wait` "
"with an error or os/proc-wait is cancelled with any error caused by anything else, os/proc-wait still "
"finishes in the background. Only after os/proc-wait finishes, a process is cleaned up by the operating "
"system. Thus, a process becomes a zombie process if os/proc-wait is not called.") {
"Block until the subprocess completes. Returns the subprocess return code.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
@@ -662,7 +641,7 @@ static const struct keyword_signal signal_keywords[] = {
#ifdef SIGTERM
{"term", SIGTERM},
#endif
#ifdef SIGALRM
#ifdef SIGARLM
{"alrm", SIGALRM},
#endif
#ifdef SIGHUP
@@ -727,28 +706,15 @@ static const struct keyword_signal signal_keywords[] = {
#endif
{NULL, 0},
};
static int get_signal_kw(const Janet *argv, int32_t n) {
JanetKeyword signal_kw = janet_getkeyword(argv, n);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
return ptr->signal;
}
ptr++;
}
janet_panicf("undefined signal %v", argv[n]);
}
#endif
JANET_CORE_FN(os_proc_kill,
"(os/proc-kill proc &opt wait signal)",
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
"handle on windows. If os/proc-wait already finished for proc, os/proc-kill raises an error. After "
"sending signal to proc, if `wait` is truthy, will wait for the process to finish and return the exit "
"code by calling os/proc-wait. Otherwise, returns `proc`. If signal is specified, send it instead. "
"Signal keywords are named after their C counterparts but in lowercase with the leading `SIG` stripped. "
"Signals are ignored on windows.") {
"handle on windows. If `wait` is truthy, will wait for the process to finish and "
"returns the exit code. Otherwise, returns `proc`. If signal is specified send it instead."
"Signal keywords are named after their C counterparts but in lowercase with the leading "
"`SIG` stripped. Signals are ignored on windows.") {
janet_arity(argc, 1, 3);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
if (proc->flags & JANET_PROC_WAITED) {
@@ -765,11 +731,22 @@ JANET_CORE_FN(os_proc_kill,
#else
int signal = -1;
if (argc == 3) {
signal = get_signal_kw(argv, 2);
JanetKeyword signal_kw = janet_getkeyword(argv, 2);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
signal = ptr->signal;
break;
}
ptr++;
}
if (signal == -1) {
janet_panic("undefined signal");
}
}
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
if (status) {
janet_panic(janet_strerror(errno));
janet_panic(strerror(errno));
}
#endif
/* After killing process we wait on it. */
@@ -787,9 +764,8 @@ JANET_CORE_FN(os_proc_kill,
JANET_CORE_FN(os_proc_close,
"(os/proc-close proc)",
"Close pipes created by `os/spawn` if they have not been closed. Then, if os/proc-wait was not already "
"called on proc, os/proc-wait is called on it, and it returns the exit code returned by os/proc-wait. "
"Otherwise, returns nil.") {
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
"if they have not been closed. Returns nil.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
@@ -827,106 +803,6 @@ static void close_handle(JanetHandle handle) {
#endif
}
#ifdef JANET_EV
#ifndef JANET_WINDOWS
static void janet_signal_callback(JanetEVGenericMessage msg) {
int sig = msg.tag;
if (msg.argi) janet_interpreter_interrupt_handled(NULL);
Janet handlerv = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
if (!janet_checktype(handlerv, JANET_FUNCTION)) {
/* Let another thread/process try to handle this */
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_BLOCK, &set, NULL);
#else
sigprocmask(SIG_BLOCK, &set, NULL);
#endif
raise(sig);
return;
}
JanetFunction *handler = janet_unwrap_function(handlerv);
JanetFiber *fiber = janet_fiber(handler, 64, 0, NULL);
janet_schedule_soon(fiber, janet_wrap_nil(), JANET_SIGNAL_OK);
}
static void janet_signal_trampoline_no_interrupt(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
}
static void janet_signal_trampoline(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
msg.argi = 1;
janet_interpreter_interrupt(NULL);
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
}
#endif
JANET_CORE_FN(os_sigaction,
"(os/sigaction which &opt handler interrupt-interpreter)",
"Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler. "
"All signal handlers are the same as supported by `os/proc-kill`.") {
janet_sandbox_assert(JANET_SANDBOX_SIGNAL);
janet_arity(argc, 1, 3);
#ifdef JANET_WINDOWS
(void) argv;
janet_panic("unsupported on this platform");
#else
/* TODO - per thread signal masks */
int rc;
int sig = get_signal_kw(argv, 0);
JanetFunction *handler = janet_optfunction(argv, argc, 1, NULL);
int can_interrupt = janet_optboolean(argv, argc, 2, 0);
Janet oldhandler = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
if (!janet_checktype(oldhandler, JANET_NIL)) {
janet_gcunroot(oldhandler);
}
if (NULL != handler) {
Janet handlerv = janet_wrap_function(handler);
janet_gcroot(handlerv);
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), handlerv);
} else {
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), janet_wrap_nil());
}
struct sigaction action;
sigset_t mask;
sigaddset(&mask, sig);
memset(&action, 0, sizeof(action));
action.sa_flags |= SA_RESTART;
if (can_interrupt) {
#ifdef JANET_NO_INTERPRETER_INTERRUPT
janet_panic("interpreter interrupt not enabled");
#else
action.sa_handler = janet_signal_trampoline;
#endif
} else {
action.sa_handler = janet_signal_trampoline_no_interrupt;
}
action.sa_mask = mask;
RETRY_EINTR(rc, sigaction(sig, &action, NULL));
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_UNBLOCK, &set, NULL);
#else
sigprocmask(SIG_UNBLOCK, &set, NULL);
#endif
return janet_wrap_nil();
#endif
}
#endif
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
up by the calling function. If everything goes well, *handle is owned by the calling function,
@@ -1106,18 +982,11 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri
}
#endif
typedef enum {
JANET_EXECUTE_EXECUTE,
JANET_EXECUTE_SPAWN,
JANET_EXECUTE_EXEC
} JanetExecuteMode;
static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
janet_arity(argc, 1, 3);
/* Get flags */
int is_spawn = mode == JANET_EXECUTE_SPAWN;
uint64_t flags = 0;
if (argc > 1) {
flags = janet_getflags(argv, 1, "epxd");
@@ -1141,7 +1010,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
int pipe_owner_flags = (is_spawn && (flags & 0x8)) ? JANET_PROC_ALLOW_ZOMBIE : 0;
/* Get optional redirections */
if (argc > 2 && (mode != JANET_EXECUTE_EXEC)) {
if (argc > 2) {
JanetDictView tab = janet_getdictionary(argv, 2);
Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
@@ -1262,32 +1131,12 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
* of posix_spawn would modify the argv array passed in. */
char *const *cargv = (char *const *)child_argv;
/* Use posix_spawn to spawn new process */
if (use_environ) {
janet_lock_environ();
}
/* exec mode */
if (mode == JANET_EXECUTE_EXEC) {
#ifdef JANET_WINDOWS
janet_panic("not supported on windows");
#else
int status;
if (!use_environ) {
environ = envp;
}
do {
if (janet_flag_at(flags, 1)) {
status = execvp(cargv[0], cargv);
} else {
status = execv(cargv[0], cargv);
}
} while (status == -1 && errno == EINTR);
janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
#endif
}
/* Use posix_spawn to spawn new process */
/* Posix spawn setup */
posix_spawn_file_actions_t actions;
posix_spawn_file_actions_init(&actions);
@@ -1339,7 +1188,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
os_execute_cleanup(envp, child_argv);
if (status) {
/* correct for macos bug where errno is not set */
janet_panicf("%p: %s", argv[0], janet_strerror(errno ? errno : ENOENT));
janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT));
}
#endif
@@ -1394,63 +1243,22 @@ JANET_CORE_FN(os_execute,
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
"`env` is a table or struct mapping environment variables to values. It can also "
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
":in, :out, and :err should be core/file values or core/stream values. core/file values and core/stream "
"values passed to :in, :out, and :err should be closed manually because os/execute doesn't close them. "
"Returns the exit code of the program.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_EXECUTE);
"These arguments should be core/file values. "
"Returns the exit status of the program.") {
return os_execute_impl(argc, argv, 0);
}
JANET_CORE_FN(os_spawn,
"(os/spawn args &opt flags env)",
"Execute a program on the system and return a handle to the process. Otherwise, takes the "
"same arguments as `os/execute`. Does not wait for the process. For each of the :in, :out, and :err keys "
"of the `env` argument, one can also pass in the keyword `:pipe` to get streams for standard IO of the "
"subprocess that can be read from and written to. The returned value `proc` has the fields :in, :out, "
":err, and the additional field :pid on unix-like platforms. `(os/proc-wait proc)` must be called to "
"rejoin the subprocess. After `(os/proc-wait proc)` finishes, proc gains a new field, :return-code. "
"If :x flag is passed to os/spawn, non-zero exit code will cause os/proc-wait to raise an error. "
"If pipe streams created with :pipe keyword are not closed in time, janet can run out of file "
"descriptors. They can be closed individually, or `os/proc-close` can close all pipe streams on proc. "
"If pipe streams aren't read before `os/proc-wait` finishes, then pipe buffers become full, and the "
"process cannot finish because the process cannot print more on pipe buffers which are already full. "
"If the process cannot finish, os/proc-wait cannot finish, either.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_SPAWN);
}
JANET_CORE_FN(os_posix_exec,
"(os/posix-exec args &opt flags env)",
"Use the execvpe or execve system calls to replace the current process with an interface similar to os/execute. "
"However, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and "
"does not allow redirection of stdio.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC);
}
JANET_CORE_FN(os_posix_fork,
"(os/posix-fork)",
"Make a `fork` system call and create a new process. Return nil if in the new process, otherwise a core/process object (as returned by os/spawn). "
"Not supported on all systems (POSIX only).") {
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
janet_fixarity(argc, 0);
(void) argv;
#ifdef JANET_WINDOWS
janet_panic("not supported");
#else
pid_t result;
do {
result = fork();
} while (result == -1 && errno == EINTR);
if (result == -1) {
janet_panic(janet_strerror(errno));
}
if (result) {
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
memset(proc, 0, sizeof(JanetProc));
proc->pid = result;
proc->flags = JANET_PROC_ALLOW_ZOMBIE;
return janet_wrap_abstract(proc);
}
return janet_wrap_nil();
#endif
"same arguments as `os/execute`. Does not wait for the process. "
"For each of the :in, :out, and :err keys to the `env` argument, one "
"can also pass in the keyword `:pipe` "
"to get streams for standard IO of the subprocess that can be read from and written to. "
"The returned value `proc` has the fields :in, :out, :err, :return-code, and "
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
"subprocess or `(os/proc-kill proc)`.") {
return os_execute_impl(argc, argv, 1);
}
#ifdef JANET_EV
@@ -1526,8 +1334,8 @@ JANET_CORE_FN(os_getenv,
janet_sandbox_assert(JANET_SANDBOX_ENV);
janet_arity(argc, 1, 2);
const char *cstr = janet_getcstring(argv, 0);
janet_lock_environ();
const char *res = getenv(cstr);
janet_lock_environ();
Janet ret = res
? janet_cstringv(res)
: argc == 2
@@ -1572,51 +1380,34 @@ JANET_CORE_FN(os_time,
}
JANET_CORE_FN(os_clock,
"(os/clock &opt source format)",
"Return the current time of the requested clock source.\n\n"
"(os/clock &opt source)",
"Return the number of whole + fractional seconds of the requested clock source.\n\n"
"The `source` argument selects the clock source to use, when not specified the default "
"is `:realtime`:\n"
"- :realtime: Return the real (i.e., wall-clock) time. This clock is affected by discontinuous "
" jumps in the system time\n"
"- :monotonic: Return the number of whole + fractional seconds since some fixed point in "
" time. The clock is guaranteed to be non-decreasing in real time.\n"
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n"
"The `format` argument selects the type of output, when not specified the default is `:double`:\n"
"- :double: Return the number of seconds + fractional seconds as a double\n"
"- :int: Return the number of seconds as an integer\n"
"- :tuple: Return a 2 integer tuple [seconds, nanoseconds]\n") {
enum JanetTimeSource source;
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n") {
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
janet_arity(argc, 0, 2);
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, NULL);
if (sourcestr == NULL || janet_cstrcmp(sourcestr, "realtime") == 0) {
source = JANET_TIME_REALTIME;
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
source = JANET_TIME_MONOTONIC;
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
source = JANET_TIME_CPUTIME;
} else {
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
janet_arity(argc, 0, 1);
enum JanetTimeSource source = JANET_TIME_REALTIME;
if (argc == 1) {
JanetKeyword sourcestr = janet_getkeyword(argv, 0);
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
source = JANET_TIME_REALTIME;
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
source = JANET_TIME_MONOTONIC;
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
source = JANET_TIME_CPUTIME;
} else {
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
}
}
struct timespec tv;
if (janet_gettime(&tv, source)) janet_panic("could not get time");
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, NULL);
if (formatstr == NULL || janet_cstrcmp(formatstr, "double") == 0) {
double dtime = (double)(tv.tv_sec + (tv.tv_nsec / 1E9));
return janet_wrap_number(dtime);
} else if (janet_cstrcmp(formatstr, "int") == 0) {
return janet_wrap_number((double)(tv.tv_sec));
} else if (janet_cstrcmp(formatstr, "tuple") == 0) {
Janet tup[2] = {janet_wrap_number((double)tv.tv_sec),
janet_wrap_number((double)tv.tv_nsec)
};
return janet_wrap_tuple(janet_tuple_n(tup, 2));
} else {
janet_panicf("expected :double, :int, or :tuple, got %v", argv[1]);
}
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
return janet_wrap_number(dtime);
}
JANET_CORE_FN(os_sleep,
@@ -1652,7 +1443,7 @@ JANET_CORE_FN(os_isatty,
return janet_wrap_boolean(_isatty(fd));
#else
int fd = fileno(f);
if (fd == -1) janet_panic(janet_strerror(errno));
if (fd == -1) janet_panic(strerror(errno));
return janet_wrap_boolean(isatty(fd));
#endif
}
@@ -1887,7 +1678,7 @@ JANET_CORE_FN(os_mktime,
}
if (t == (time_t) -1) {
janet_panicf("%s", janet_strerror(errno));
janet_panicf("%s", strerror(errno));
}
return janet_wrap_number((double)t);
@@ -1899,43 +1690,6 @@ JANET_CORE_FN(os_mktime,
#define j_symlink symlink
#endif
JANET_CORE_FN(os_setlocale,
"(os/setlocale &opt locale category)",
"Set the system locale, which affects how dates and numbers are formatted. "
"Passing nil to locale will return the current locale. Category can be one of:\n\n"
" * :all (default)\n"
" * :collate\n"
" * :ctype\n"
" * :monetary\n"
" * :numeric\n"
" * :time\n\n"
"Returns the new locale if set successfully, otherwise nil. Note that this will affect "
"other functions such as `os/strftime` and even `printf`.") {
janet_arity(argc, 0, 2);
const char *locale_name = janet_optcstring(argv, argc, 0, NULL);
int category_int = LC_ALL;
if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
if (janet_keyeq(argv[1], "all")) {
category_int = LC_ALL;
} else if (janet_keyeq(argv[1], "collate")) {
category_int = LC_COLLATE;
} else if (janet_keyeq(argv[1], "ctype")) {
category_int = LC_CTYPE;
} else if (janet_keyeq(argv[1], "monetary")) {
category_int = LC_MONETARY;
} else if (janet_keyeq(argv[1], "numeric")) {
category_int = LC_NUMERIC;
} else if (janet_keyeq(argv[1], "time")) {
category_int = LC_TIME;
} else {
janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[1]);
}
}
const char *old = setlocale(category_int, locale_name);
if (old == NULL) return janet_wrap_nil();
return janet_cstringv(old);
}
JANET_CORE_FN(os_link,
"(os/link oldpath newpath &opt symlink)",
"Create a link at newpath that points to oldpath and returns nil. "
@@ -1953,7 +1707,7 @@ JANET_CORE_FN(os_link,
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
return janet_wrap_nil();
#endif
}
@@ -1972,7 +1726,7 @@ JANET_CORE_FN(os_symlink,
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = j_symlink(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
return janet_wrap_nil();
#endif
}
@@ -1994,7 +1748,7 @@ JANET_CORE_FN(os_mkdir,
#endif
if (res == 0) return janet_wrap_true();
if (errno == EEXIST) return janet_wrap_false();
janet_panicf("%s: %s", janet_strerror(errno), path);
janet_panicf("%s: %s", strerror(errno), path);
}
JANET_CORE_FN(os_rmdir,
@@ -2008,7 +1762,7 @@ JANET_CORE_FN(os_rmdir,
#else
int res = rmdir(path);
#endif
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
return janet_wrap_nil();
}
@@ -2023,7 +1777,7 @@ JANET_CORE_FN(os_cd,
#else
int res = chdir(path);
#endif
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
return janet_wrap_nil();
}
@@ -2047,7 +1801,7 @@ JANET_CORE_FN(os_touch,
bufp = NULL;
}
int res = utime(path, bufp);
if (-1 == res) janet_panic(janet_strerror(errno));
if (-1 == res) janet_panic(strerror(errno));
return janet_wrap_nil();
}
@@ -2057,7 +1811,7 @@ JANET_CORE_FN(os_remove,
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
int status = remove(path);
if (-1 == status) janet_panicf("%s: %s", janet_strerror(errno), path);
if (-1 == status) janet_panicf("%s: %s", strerror(errno), path);
return janet_wrap_nil();
}
@@ -2076,7 +1830,7 @@ JANET_CORE_FN(os_readlink,
const char *path = janet_getcstring(argv, 0);
ssize_t len = readlink(path, buffer, sizeof buffer);
if (len < 0 || (size_t)len >= sizeof buffer)
janet_panicf("%s: %s", janet_strerror(errno), path);
janet_panicf("%s: %s", strerror(errno), path);
return janet_stringv((const uint8_t *)buffer, len);
#endif
}
@@ -2371,7 +2125,7 @@ JANET_CORE_FN(os_chmod,
#else
int res = chmod(path, os_getmode(argv, 1));
#endif
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
return janet_wrap_nil();
}
@@ -2407,7 +2161,7 @@ JANET_CORE_FN(os_dir,
janet_panicf("path too long: %s", dir);
sprintf(pattern, "%s/*", dir);
intptr_t res = _findfirst(pattern, &afile);
if (-1 == res) janet_panicv(janet_cstringv(janet_strerror(errno)));
if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
do {
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
janet_array_push(paths, janet_cstringv(afile.name));
@@ -2418,18 +2172,8 @@ JANET_CORE_FN(os_dir,
/* Read directory items with opendir / readdir / closedir */
struct dirent *dp;
DIR *dfd = opendir(dir);
if (dfd == NULL) janet_panicf("cannot open directory %s: %s", dir, janet_strerror(errno));
for (;;) {
errno = 0;
dp = readdir(dfd);
if (dp == NULL) {
if (errno) {
int olderr = errno;
closedir(dfd);
janet_panicf("failed to read directory %s: %s", dir, janet_strerror(olderr));
}
break;
}
if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
while ((dp = readdir(dfd)) != NULL) {
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
continue;
}
@@ -2449,7 +2193,7 @@ JANET_CORE_FN(os_rename,
const char *dest = janet_getcstring(argv, 1);
int status = rename(src, dest);
if (status) {
janet_panic(janet_strerror(errno));
janet_panic(strerror(errno));
}
return janet_wrap_nil();
}
@@ -2469,7 +2213,7 @@ JANET_CORE_FN(os_realpath,
#else
char *dest = realpath(src, NULL);
#endif
if (NULL == dest) janet_panicf("%s: %s", janet_strerror(errno), src);
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
Janet ret = janet_cstringv(dest);
janet_free(dest);
return ret;
@@ -2675,7 +2419,7 @@ JANET_CORE_FN(os_open,
} else if (write_flag && !read_flag) {
open_flags |= O_WRONLY;
} else {
open_flags |= O_RDWR;
open_flags = O_RDWR;
}
do {
@@ -2687,24 +2431,16 @@ JANET_CORE_FN(os_open,
}
JANET_CORE_FN(os_pipe,
"(os/pipe &opt flags)",
"(os/pipe)",
"Create a readable stream and a writable stream that are connected. Returns a two-element "
"tuple where the first element is a readable stream and the second element is the writable "
"stream. `flags` is a keyword set of flags to disable non-blocking settings on the ends of the pipe. "
"This may be desired if passing the pipe to a subprocess with `os/spawn`.\n\n"
"* :W - sets the writable end of the pipe to a blocking stream.\n"
"* :R - sets the readable end of the pipe to a blocking stream.\n\n"
"By default, both ends of the pipe are non-blocking for use with the `ev` module.") {
"stream.") {
(void) argv;
janet_arity(argc, 0, 1);
janet_fixarity(argc, 0);
JanetHandle fds[2];
int flags = 0;
if (argc > 0 && !janet_checktype(argv[0], JANET_NIL)) {
flags = (int) janet_getflags(argv, 0, "WR");
}
if (janet_make_pipe(fds, flags)) janet_panicv(janet_ev_lasterr());
JanetStream *reader = janet_stream(fds[0], (flags & 2) ? 0 : JANET_STREAM_READABLE, NULL);
JanetStream *writer = janet_stream(fds[1], (flags & 1) ? 0 : JANET_STREAM_WRITABLE, NULL);
if (janet_make_pipe(fds, 0)) janet_panicv(janet_ev_lasterr());
JanetStream *reader = janet_stream(fds[0], JANET_STREAM_READABLE, NULL);
JanetStream *writer = janet_stream(fds[1], JANET_STREAM_WRITABLE, NULL);
Janet tup[2] = {janet_wrap_abstract(reader), janet_wrap_abstract(writer)};
return janet_wrap_tuple(janet_tuple_n(tup, 2));
}
@@ -2751,7 +2487,6 @@ 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),
JANET_CORE_REG("os/setlocale", os_setlocale),
/* env functions */
JANET_CORE_REG("os/environ", os_environ),
@@ -2788,8 +2523,6 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/execute", os_execute),
JANET_CORE_REG("os/spawn", os_spawn),
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),
/* 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),
@@ -2803,7 +2536,6 @@ void janet_lib_os(JanetTable *env) {
#ifdef JANET_EV
JANET_CORE_REG("os/open", os_open), /* fs read and write */
JANET_CORE_REG("os/pipe", os_pipe),
JANET_CORE_REG("os/sigaction", os_sigaction),
#endif
#endif
JANET_REG_END

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -231,7 +231,7 @@ static void delim_error(JanetParser *parser, size_t stack_index, char c, const c
janet_buffer_push_u8(buffer, '`');
}
}
janet_formatb(buffer, " opened at line %d, column %d", (int32_t) s->line, (int32_t) s->column);
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
}
parser->error = (const char *) janet_string(buffer->data, buffer->count);
parser->flag |= JANET_PARSER_GENERATED_ERROR;
@@ -259,14 +259,6 @@ static int checkescape(uint8_t c) {
return '\f';
case 'v':
return '\v';
case 'a':
return '\a';
case 'b':
return '\b';
case '\'':
return '\'';
case '?':
return '?';
case 'e':
return 27;
case '"':
@@ -467,13 +459,8 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
return 0;
}
ret = janet_keywordv(p->buf + 1, blen - 1);
#ifdef JANET_INT_TYPES
} else if (start_num && !janet_scan_numeric(p->buf, blen, &ret)) {
(void) numval;
#else
} else if (start_num && !janet_scan_number(p->buf, blen, &numval)) {
ret = janet_wrap_number(numval);
#endif
} else if (!check_str_const("nil", p->buf, blen)) {
ret = janet_wrap_nil();
} else if (!check_str_const("false", p->buf, blen)) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -39,10 +39,6 @@
typedef struct {
const uint8_t *text_start;
const uint8_t *text_end;
/* text_end can be restricted by some rules, but
outer_text_end will always contain the real end of
input, which we need to generate a line mapping */
const uint8_t *outer_text_end;
const uint32_t *bytecode;
const Janet *constants;
JanetArray *captures;
@@ -118,12 +114,12 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
/* Generate if not made yet */
if (s->linemaplen < 0) {
int32_t newline_count = 0;
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
if (*c == '\n') newline_count++;
}
int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count);
size_t index = 0;
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
}
s->linemaplen = newline_count;
@@ -134,7 +130,7 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
* a newline character is consider to be on the same line as the character before
* (\n is line terminator, not line separator).
* - in the not-found case, we still want to find the greatest-indexed newline that
* is before position. we use that to calculate the line and column.
* is before position. we use that to calcuate the line and column.
* - in the case that lo = 0 and s->linemap[0] is still greater than position, we
* are on the first line and our column is position + 1. */
int32_t hi = s->linemaplen; /* hi is greater than the actual line */
@@ -183,7 +179,7 @@ static const uint8_t *peg_rule(
const uint32_t *rule,
const uint8_t *text) {
tail:
switch (*rule) {
switch (*rule & 0x1F) {
default:
janet_panic("unexpected opcode");
return NULL;
@@ -465,16 +461,6 @@ tail:
return result;
}
case RULE_ONLY_TAGS: {
CapState cs = cap_save(s);
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
if (!result) return NULL;
cap_load_keept(s, cs);
return result;
}
case RULE_GROUP: {
uint32_t tag = rule[2];
int oldmode = s->mode;
@@ -496,92 +482,6 @@ tail:
return result;
}
case RULE_NTH: {
uint32_t nth = rule[1];
if (nth > INT32_MAX) nth = INT32_MAX;
uint32_t tag = rule[3];
int oldmode = s->mode;
CapState cs = cap_save(s);
s->mode = PEG_MODE_NORMAL;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
up1(s);
s->mode = oldmode;
if (!result) return NULL;
int32_t num_sub_captures = s->captures->count - cs.cap;
Janet cap;
if (num_sub_captures > (int32_t) nth) {
cap = s->captures->data[cs.cap + nth];
} else {
return NULL;
}
cap_load_keept(s, cs);
pushcap(s, cap, tag);
return result;
}
case RULE_SUB: {
const uint8_t *text_start = text;
const uint32_t *rule_window = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
down1(s);
const uint8_t *window_end = peg_rule(s, rule_window, text);
up1(s);
if (!window_end) {
return NULL;
}
const uint8_t *saved_end = s->text_end;
s->text_end = window_end;
down1(s);
const uint8_t *next_text = peg_rule(s, rule_subpattern, text_start);
up1(s);
s->text_end = saved_end;
if (!next_text) {
return NULL;
}
return window_end;
}
case RULE_SPLIT: {
const uint8_t *saved_end = s->text_end;
const uint32_t *rule_separator = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
const uint8_t *separator_end = NULL;
do {
const uint8_t *text_start = text;
CapState cs = cap_save(s);
down1(s);
while (text <= s->text_end) {
separator_end = peg_rule(s, rule_separator, text);
cap_load(s, cs);
if (separator_end) {
break;
}
text++;
}
up1(s);
if (separator_end) {
s->text_end = text;
text = separator_end;
}
down1(s);
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
up1(s);
s->text_end = saved_end;
if (!subpattern_end) {
return NULL;
}
} while (separator_end);
return s->text_end;
}
case RULE_REPLACE:
case RULE_MATCHTIME: {
uint32_t tag = rule[3];
@@ -701,11 +601,11 @@ tail:
case RULE_READINT: {
uint32_t tag = rule[2];
uint32_t signedness = rule[1] & 0x10;
uint32_t endianness = rule[1] & 0x20;
uint32_t endianess = rule[1] & 0x20;
int width = (int)(rule[1] & 0xF);
if (text + width > s->text_end) return NULL;
uint64_t accum = 0;
if (endianness) {
if (endianess) {
/* BE */
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
} else {
@@ -1095,9 +995,6 @@ static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
spec_onerule(b, argc, argv, RULE_DROP);
}
static void spec_only_tags(Builder *b, int32_t argc, const Janet *argv) {
spec_onerule(b, argc, argv, RULE_ONLY_TAGS);
}
/* Rule of the form [rule, tag] */
static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
@@ -1121,15 +1018,6 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
spec_cap1(b, argc, argv, RULE_UNREF);
}
static void spec_nth(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 2, 3);
Reserve r = reserve(b, 4);
uint32_t nth = peg_getnat(b, argv[0]);
uint32_t rule = peg_compile1(b, argv[1]);
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
emit_3(r, RULE_NTH, nth, rule, tag);
}
static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 1, 3);
Reserve r = reserve(b, 4);
@@ -1219,22 +1107,6 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
}
static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
uint32_t subrule1 = peg_compile1(b, argv[0]);
uint32_t subrule2 = peg_compile1(b, argv[1]);
emit_2(r, RULE_SUB, subrule1, subrule2);
}
static void spec_split(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
uint32_t subrule1 = peg_compile1(b, argv[0]);
uint32_t subrule2 = peg_compile1(b, argv[1]);
emit_2(r, RULE_SPLIT, subrule1, subrule2);
}
#ifdef JANET_INT_TYPES
#define JANET_MAX_READINT_WIDTH 8
#else
@@ -1308,9 +1180,7 @@ static const SpecialPair peg_specials[] = {
{"line", spec_line},
{"look", spec_look},
{"not", spec_not},
{"nth", spec_nth},
{"number", spec_capture_number},
{"only-tags", spec_only_tags},
{"opt", spec_opt},
{"position", spec_position},
{"quote", spec_capture},
@@ -1320,8 +1190,6 @@ static const SpecialPair peg_specials[] = {
{"sequence", spec_sequence},
{"set", spec_set},
{"some", spec_some},
{"split", spec_split},
{"sub", spec_sub},
{"thru", spec_thru},
{"to", spec_to},
{"uint", spec_uint_le},
@@ -1563,7 +1431,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
uint32_t instr = bytecode[i];
uint32_t *rule = bytecode + i;
op_flags[i] |= 0x02;
switch (instr) {
switch (instr & 0x1F) {
case RULE_LITERAL:
i += 2 + ((rule[1] + 3) >> 2);
break;
@@ -1656,18 +1524,8 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
op_flags[rule[1]] |= 0x01;
i += 4;
break;
case RULE_SUB:
case RULE_SPLIT:
/* [rule, rule] */
if (rule[1] >= blen) goto bad;
if (rule[2] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
op_flags[rule[2]] |= 0x01;
i += 3;
break;
case RULE_ERROR:
case RULE_DROP:
case RULE_ONLY_TAGS:
case RULE_NOT:
case RULE_TO:
case RULE_THRU:
@@ -1677,16 +1535,10 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
i += 2;
break;
case RULE_READINT:
/* [ width | (endianness << 5) | (signedness << 6), tag ] */
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
i += 3;
break;
case RULE_NTH:
/* [nth, rule, tag] */
if (rule[2] >= blen) goto bad;
op_flags[rule[2]] |= 0x01;
i += 4;
break;
default:
goto bad;
}
@@ -1780,7 +1632,7 @@ static JanetPeg *compile_peg(Janet x) {
JANET_CORE_FN(cfun_peg_compile,
"(peg/compile peg)",
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement "
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment "
"the grammar of the peg for otherwise undefined peg keywords.") {
janet_fixarity(argc, 1);
JanetPeg *peg = compile_peg(argv[0]);
@@ -1800,7 +1652,7 @@ typedef struct {
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
PegCall ret;
int32_t min = get_replace ? 3 : 2;
janet_arity(argc, min, -1);
janet_arity(argc, get_replace, -1);
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
ret.peg = janet_unwrap_abstract(argv[0]);
@@ -1825,7 +1677,6 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
ret.s.mode = PEG_MODE_NORMAL;
ret.s.text_start = ret.bytes.bytes;
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
ret.s.outer_text_end = ret.s.text_end;
ret.s.depth = JANET_RECURSION_GUARD;
ret.s.captures = janet_array(0);
ret.s.tagged_captures = janet_array(0);
@@ -1920,7 +1771,7 @@ JANET_CORE_FN(cfun_peg_replace_all,
}
JANET_CORE_FN(cfun_peg_replace,
"(peg/replace peg subst text &opt start & args)",
"(peg/replace peg repl text &opt start & args)",
"Replace first match of `peg` in `text` with `subst`, returning a new buffer. "
"The peg does not need to make captures to do replacement. "
"If `subst` is a function, it will be called with the "

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -31,7 +31,6 @@
#include <string.h>
#include <ctype.h>
#include <inttypes.h>
#include <float.h>
/* Implements a pretty printer for Janet. The pretty printer
* is simple and not that flexible, but fast. */
@@ -39,15 +38,11 @@
/* Temporary buffer size */
#define BUFSIZE 64
/* Preprocessor hacks */
#define STR_HELPER(x) #x
#define STR(x) STR_HELPER(x)
static void number_to_string_b(JanetBuffer *buffer, double x) {
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
const char *fmt = (x == floor(x) &&
x <= JANET_INTMAX_DOUBLE &&
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : ("%." STR(DBL_DIG) "g");
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
int count;
if (x == 0.0) {
/* Prevent printing of '-0' */
@@ -157,12 +152,6 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
case '\v':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
break;
case '\a':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
break;
case '\b':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
break;
case 27:
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
break;
@@ -255,10 +244,6 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
case JANET_FUNCTION: {
JanetFunction *fun = janet_unwrap_function(x);
JanetFuncDef *def = fun->def;
if (def == NULL) {
janet_buffer_push_cstring(buffer, "<incomplete function>");
break;
}
if (def->name) {
const uint8_t *n = def->name;
janet_buffer_push_cstring(buffer, "<function ");
@@ -379,10 +364,8 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
break;
case JANET_NUMBER:
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
double num = janet_unwrap_number(x);
if (isnan(num)) return 1;
if (isinf(num)) return 1;
janet_buffer_dtostr(S->buffer, num);
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
S->buffer->count += count;
break;
case JANET_SYMBOL:
case JANET_KEYWORD:
@@ -779,8 +762,6 @@ struct FmtMapping {
/* Janet uses fixed width integer types for most things, so map
* format specifiers to these fixed sizes */
static const struct FmtMapping format_mappings[] = {
{'D', PRId64},
{'I', PRIi64},
{'d', PRId64},
{'i', PRIi64},
{'o', PRIo64},
@@ -832,7 +813,7 @@ static const char *scanformat(
if (loc != NULL && *loc != '\0') {
const char *mapping = get_fmt_mapping(*p2++);
size_t len = strlen(mapping);
memcpy(form, mapping, len);
strcpy(form, mapping);
form += len;
} else {
*(form++) = *(p2++);
@@ -859,19 +840,13 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
c = scanformat(c, form, width, precision);
switch (*c++) {
case 'c': {
int n = va_arg(args, int);
int n = va_arg(args, long);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
case 'd':
case 'i': {
int64_t n = (int64_t) va_arg(args, int32_t);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
case 'D':
case 'I': {
int64_t n = va_arg(args, int64_t);
int64_t n = va_arg(args, int);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
@@ -879,7 +854,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
case 'X':
case 'o':
case 'u': {
uint64_t n = va_arg(args, uint64_t);
uint64_t n = va_arg(args, unsigned int);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
@@ -923,7 +898,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
break;
case 'T': {
int types = va_arg(args, int);
int types = va_arg(args, long);
pushtypes(b, types);
break;
}
@@ -1032,8 +1007,6 @@ void janet_buffer_format(
janet_getinteger(argv, arg));
break;
}
case 'D':
case 'I':
case 'd':
case 'i': {
int64_t n = janet_getinteger64(argv, arg);

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -32,7 +32,6 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
int errflags = 0, done = 0;
int32_t index = 0;
Janet ret = janet_wrap_nil();
JanetFiber *fiber = NULL;
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
if (where) janet_gcroot(janet_wrap_string(where));
@@ -48,7 +47,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
JanetCompileResult cres = janet_compile(form, env, where);
if (cres.status == JANET_COMPILE_OK) {
JanetFunction *f = janet_thunk(cres.funcdef);
fiber = janet_fiber(f, 64, 0, NULL);
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
fiber->env = env;
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
@@ -58,20 +57,12 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
} 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) &&
(cres.error_mapping.column > 0)) {
line = cres.error_mapping.line;
col = cres.error_mapping.column;
}
if (cres.macrofiber) {
janet_eprintf("%s:%d:%d: compile error", sourcePath,
line, col);
janet_eprintf("compile error in %s: ", sourcePath);
janet_stacktrace_ext(cres.macrofiber, ret, "");
} else {
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
line, col, (const char *)cres.error);
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
}
errflags |= 0x02;
done = 1;
@@ -113,14 +104,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
#ifdef JANET_EV
/* Enter the event loop if we are not already in it */
if (janet_vm.stackn == 0) {
if (fiber) {
janet_gcroot(janet_wrap_fiber(fiber));
}
janet_gcroot(ret);
janet_loop();
if (fiber) {
janet_gcunroot(janet_wrap_fiber(fiber));
ret = fiber->last_value;
}
janet_gcunroot(ret);
}
#endif
if (out) *out = ret;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -149,7 +149,7 @@ static int destructure(JanetCompiler *c,
JanetTable *attr) {
switch (janet_type(left)) {
default:
janetc_error(c, janet_formatc("unexpected type in destructuring, got %v", left));
janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left));
return 1;
case JANET_SYMBOL:
/* Leaf, assign right to left */
@@ -530,26 +530,6 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
return ret;
}
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
static int janetc_check_nil_form(Janet x, Janet *capture, uint32_t fun_tag) {
if (!janet_checktype(x, JANET_TUPLE)) return 0;
JanetTuple tup = janet_unwrap_tuple(x);
if (3 != janet_tuple_length(tup)) return 0;
Janet op1 = tup[0];
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
JanetFunction *fun = janet_unwrap_function(op1);
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
if (tag != fun_tag) return 0;
if (janet_checktype(tup[1], JANET_NIL)) {
*capture = tup[2];
return 1;
} else if (janet_checktype(tup[2], JANET_NIL)) {
*capture = tup[1];
return 1;
}
return 0;
}
/*
* :condition
* ...
@@ -570,7 +550,6 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetScope condscope, tempscope;
const int tail = opts.flags & JANET_FOPTS_TAIL;
const int drop = opts.flags & JANET_FOPTS_DROP;
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
if (argn < 2 || argn > 3) {
janetc_cerror(c, "expected 2 or 3 arguments to if");
@@ -593,24 +572,12 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Compile condition */
janetc_scope(&condscope, c, 0, "if");
Janet condform = argv[0];
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
ifnjmp = JOP_JUMP_IF_NOT_NIL;
} else if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
ifnjmp = JOP_JUMP_IF_NIL;
}
cond = janetc_value(condopts, condform);
cond = janetc_value(condopts, argv[0]);
/* Check constant condition. */
/* TODO: Use type info for more short circuits */
if (cond.flags & JANET_SLOT_CONSTANT) {
int swap_condition = 0;
if (ifnjmp == JOP_JUMP_IF_NOT && !janet_truthy(cond.constant)) swap_condition = 1;
if (ifnjmp == JOP_JUMP_IF_NIL && janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
if (ifnjmp == JOP_JUMP_IF_NOT_NIL && !janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
if (swap_condition) {
if (!janet_truthy(cond.constant)) {
/* Swap the true and false bodies */
Janet temp = falsebody;
falsebody = truebody;
@@ -628,7 +595,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
}
/* Compile jump to right */
labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0);
labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
/* Condition left body */
janetc_scope(&tempscope, c, 0, "if-true");
@@ -638,7 +605,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Compile jump to done */
labeljd = janet_v_count(c->buffer);
if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP);
if (!tail) janetc_emit(c, JOP_JUMP);
/* Compile right body */
labelr = janet_v_count(c->buffer);
@@ -749,8 +716,9 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
/* Closure body with return argument */
subopts.flags |= JANET_FOPTS_TAIL;
janetc_value(subopts, argv[0]);
return janetc_cslot(janet_wrap_nil());
JanetSlot ret = janetc_value(subopts, argv[0]);
ret.flags |= JANET_SLOT_RETURNED;
return ret;
} else {
/* while loop IIFE or no argument */
if (argn) {
@@ -758,7 +726,9 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
janetc_value(subopts, argv[0]);
}
janetc_emit(c, JOP_RETURN_NIL);
return janetc_cslot(janet_wrap_nil());
JanetSlot s = janetc_cslot(janet_wrap_nil());
s.flags |= JANET_SLOT_RETURNED;
return s;
}
} else {
if (argn) {
@@ -771,6 +741,20 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
}
}
/* Check if a form matches the pattern (not= nil _) */
static int janetc_check_notnil_form(Janet x, Janet *capture) {
if (!janet_checktype(x, JANET_TUPLE)) return 0;
JanetTuple tup = janet_unwrap_tuple(x);
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
if (3 != janet_tuple_length(tup)) return 0;
JanetFunction *fun = janet_unwrap_function(tup[0]);
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
if (tag != JANET_FUN_NEQ) return 0;
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
*capture = tup[2];
return 1;
}
/*
* :whiletop
* ...
@@ -787,7 +771,6 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
JanetScope tempscope;
int32_t labelwt, labeld, labeljt, labelc, i;
int infinite = 0;
int is_nil_form = 0;
int is_notnil_form = 0;
uint8_t ifjmp = JOP_JUMP_IF;
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
@@ -801,16 +784,11 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
/* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the
/* Check for `(not= nil _)` in condition, and if so, use the
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
* more efficiently. */
Janet condform = argv[0];
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
is_nil_form = 1;
ifjmp = JOP_JUMP_IF_NIL;
ifnjmp = JOP_JUMP_IF_NOT_NIL;
}
if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
if (janetc_check_notnil_form(condform, &condform)) {
is_notnil_form = 1;
ifjmp = JOP_JUMP_IF_NOT_NIL;
ifnjmp = JOP_JUMP_IF_NIL;
@@ -822,9 +800,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Check for constant condition */
if (cond.flags & JANET_SLOT_CONSTANT) {
/* Loop never executes */
int never_executes = is_nil_form
? !janet_checktype(cond.constant, JANET_NIL)
: is_notnil_form
int never_executes = is_notnil_form
? janet_checktype(cond.constant, JANET_NIL)
: !janet_truthy(cond.constant);
if (never_executes) {
@@ -925,7 +901,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
int structarg = 0;
int allow_extra = 0;
int selfref = 0;
int hasname = 0;
int seenamp = 0;
int seenopt = 0;
int namedargs = 0;
@@ -944,10 +919,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
head = argv[0];
if (janet_checktype(head, JANET_SYMBOL)) {
selfref = 1;
hasname = 1;
parami = 1;
} else if (janet_checktype(head, JANET_KEYWORD)) {
hasname = 1;
parami = 1;
}
if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
@@ -1108,7 +1079,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
if (selfref) def->name = janet_unwrap_symbol(head);
janet_def_addflags(def);
defindex = janetc_addfuncdef(c, def);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -24,11 +24,6 @@
#include "features.h"
#include <janet.h>
#include "state.h"
#include "util.h"
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
#endif
JANET_THREAD_LOCAL JanetVM janet_vm;
@@ -58,14 +53,9 @@ void janet_vm_load(JanetVM *from) {
}
/* Trigger suspension of the Janet vm by trying to
* exit the interpreter loop when convenient. You can optionally
* exit the interpeter loop when convenient. You can optionally
* use NULL to interrupt the current VM when convenient */
void janet_interpreter_interrupt(JanetVM *vm) {
vm = vm ? vm : &janet_vm;
janet_atomic_inc(&vm->auto_suspend);
}
void janet_interpreter_interrupt_handled(JanetVM *vm) {
vm = vm ? vm : &janet_vm;
janet_atomic_dec(&vm->auto_suspend);
vm->auto_suspend = 1;
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -89,7 +89,7 @@ struct JanetVM {
/* If this flag is true, suspend on function calls and backwards jumps.
* When this occurs, this flag will be reset to 0. */
volatile JanetAtomicInt auto_suspend;
int auto_suspend;
/* The current running fiber on the current thread.
* Set and unset by functions in vm.c */
@@ -121,12 +121,10 @@ struct JanetVM {
/* Garbage collection */
void *blocks;
void *weak_blocks;
size_t gc_interval;
size_t next_collection;
size_t block_count;
int gc_suspend;
int gc_mark_phase;
/* GC roots */
Janet *roots;
@@ -149,11 +147,6 @@ struct JanetVM {
JanetTraversalNode *traversal_top;
JanetTraversalNode *traversal_base;
/* Thread safe strerror error buffer - for janet_strerror */
#ifndef JANET_WINDOWS
char strerror_buf[256];
#endif
/* Event loop and scheduler globals */
#ifdef JANET_EV
size_t tq_count;
@@ -161,10 +154,12 @@ struct JanetVM {
JanetQueue spawn;
JanetTimeout *tq;
JanetRNG ev_rng;
volatile JanetAtomicInt listener_count; /* used in signal handler, must be volatile */
JanetListenerState **listeners;
size_t listener_count;
size_t listener_cap;
size_t extra_listeners;
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
JanetTable signal_handlers;
#ifdef JANET_WINDOWS
void **iocp;
#elif defined(JANET_EV_EPOLL)
@@ -180,9 +175,6 @@ struct JanetVM {
int timer;
int timer_enabled;
#else
JanetStream **streams;
size_t stream_count;
size_t stream_capacity;
pthread_attr_t new_thread_attr;
JanetHandle selfpipe[2];
struct pollfd *fds;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -175,9 +175,8 @@ JANET_CORE_FN(cfun_string_slice,
"Returns a substring from a byte sequence. The substring is from "
"index `start` inclusive to index `end`, exclusive. All indexing "
"is from 0. `start` and `end` can also be negative to indicate indexing "
"from the end of the string. Note that if `start` is negative it is "
"exclusive, and if `end` is negative it is inclusive, to allow a full "
"negative slice range.") {
"from the end of the string. Note that index -1 is synonymous with "
"index `(length bytes)` to allow a full negative slice range. ") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_stringv(view.bytes + range.start, range.end - range.start);
@@ -549,12 +548,12 @@ JANET_CORE_FN(cfun_string_format,
"- `a`, `A`: floating point number, formatted as a hexadecimal number.\n"
"- `s`: formatted as a string, precision indicates padding and maximum length.\n"
"- `t`: emit the type of the given value.\n"
"- `v`: format with (describe x)\n"
"- `V`: format with (string x)\n"
"- `v`: format with (describe x)"
"- `V`: format with (string x)"
"- `j`: format to jdn (Janet data notation).\n"
"\n"
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
"variants generate colored output. These specifiers can take a precision "
"variants generate colored output. These speficiers can take a precision "
"argument to specify the maximum nesting depth to print.\n"
"- `p`, `P`: pretty format, truncating if necessary\n"
"- `m`, `M`: pretty format without truncating.\n"

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -34,9 +34,9 @@
* because E is a valid digit in bases 15 or greater. For bases greater than
* 10, the letters are used as digits. A through Z correspond to the digits 10
* through 35, and the lowercase letters have the same values. The radix number
* is always in base 10. For example, a hexadecimal number could be written
* is always in base 10. For example, a hexidecimal number could be written
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
* hexadecimal literals. The previous number could also be written
* hexidecimal literals. The previous number could also be written
* '0xdeadbeef'.
*/
@@ -489,53 +489,4 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
return 0;
}
/* Similar to janet_scan_number but allows for
* more numeric types with a given suffix. */
int janet_scan_numeric(
const uint8_t *str,
int32_t len,
Janet *out) {
int result;
double num;
int64_t i64 = 0;
uint64_t u64 = 0;
if (len < 2 || str[len - 2] != ':') {
result = janet_scan_number_base(str, len, 0, &num);
*out = janet_wrap_number(num);
return result;
}
switch (str[len - 1]) {
default:
return 1;
case 'n':
result = janet_scan_number_base(str, len - 2, 0, &num);
*out = janet_wrap_number(num);
return result;
/* Condition is inverted janet_scan_int64 and janet_scan_uint64 */
case 's':
result = !janet_scan_int64(str, len - 2, &i64);
*out = janet_wrap_s64(i64);
return result;
case 'u':
result = !janet_scan_uint64(str, len - 2, &u64);
*out = janet_wrap_u64(u64);
return result;
}
}
#endif
void janet_buffer_dtostr(JanetBuffer *buffer, double x) {
#define BUFSIZE 32
janet_buffer_extra(buffer, BUFSIZE);
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%.17g", x);
#undef BUFSIZE
/* fix locale issues with commas */
for (int i = 0; i < count; i++) {
char c = buffer->data[buffer->count + i];
if (c == ',') {
buffer->data[buffer->count + i] = '.';
}
}
buffer->count += count;
}

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -234,7 +234,6 @@ const uint8_t *janet_symbol_gen(void) {
head->hash = hash;
sym = (uint8_t *)(head->data);
memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
sym[head->length] = 0;
janet_symcache_put((const uint8_t *)sym, bucket);
return (const uint8_t *)sym;
}

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -67,7 +67,7 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in
return table;
}
/* Initialize a table (for use with scratch memory) */
/* Initialize a table (for use withs scratch memory) */
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
return janet_table_init_impl(table, capacity, 1);
}
@@ -87,27 +87,11 @@ void janet_table_deinit(JanetTable *table) {
}
/* Create a new table */
JanetTable *janet_table(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
return janet_table_init_impl(table, capacity, 0);
}
JanetTable *janet_table_weakk(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKK, sizeof(JanetTable));
return janet_table_init_impl(table, capacity, 0);
}
JanetTable *janet_table_weakv(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKV, sizeof(JanetTable));
return janet_table_init_impl(table, capacity, 0);
}
JanetTable *janet_table_weakkv(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKKV, sizeof(JanetTable));
return janet_table_init_impl(table, capacity, 0);
}
/* Find the bucket that contains the given key. Will also return
* bucket where key should go if not in the table. */
JanetKV *janet_table_find(JanetTable *t, Janet key) {
@@ -127,11 +111,12 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
JANET_OUT_OF_MEMORY;
}
}
int32_t oldcapacity = t->capacity;
int32_t i, oldcapacity;
oldcapacity = t->capacity;
t->data = newdata;
t->capacity = size;
t->deleted = 0;
for (int32_t i = 0; i < oldcapacity; i++) {
for (i = 0; i < oldcapacity; i++) {
JanetKV *kv = olddata + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
JanetKV *newkv = janet_table_find(t, kv->key);
@@ -313,40 +298,12 @@ JANET_CORE_FN(cfun_table_new,
"Creates a new empty table with pre-allocated memory "
"for `capacity` entries. This means that if one knows the number of "
"entries going into a table on creation, extra memory allocation "
"can be avoided. "
"Returns the new table.") {
"can be avoided. Returns the new table.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getnat(argv, 0);
return janet_wrap_table(janet_table(cap));
}
JANET_CORE_FN(cfun_table_weak,
"(table/weak capacity)",
"Creates a new empty table with weak references to keys and values. Similar to `table/new`. "
"Returns the new table.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getnat(argv, 0);
return janet_wrap_table(janet_table_weakkv(cap));
}
JANET_CORE_FN(cfun_table_weak_keys,
"(table/weak-keys capacity)",
"Creates a new empty table with weak references to keys and normal references to values. Similar to `table/new`. "
"Returns the new table.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getnat(argv, 0);
return janet_wrap_table(janet_table_weakk(cap));
}
JANET_CORE_FN(cfun_table_weak_values,
"(table/weak-values capacity)",
"Creates a new empty table with normal references to keys and weak references to values. Similar to `table/new`. "
"Returns the new table.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getnat(argv, 0);
return janet_wrap_table(janet_table_weakv(cap));
}
JANET_CORE_FN(cfun_table_getproto,
"(table/getproto tab)",
"Get the prototype table of a table. Returns nil if the table "
@@ -420,9 +377,6 @@ JANET_CORE_FN(cfun_table_proto_flatten,
void janet_lib_table(JanetTable *env) {
JanetRegExt table_cfuns[] = {
JANET_CORE_REG("table/new", cfun_table_new),
JANET_CORE_REG("table/weak", cfun_table_weak),
JANET_CORE_REG("table/weak-keys", cfun_table_weak_keys),
JANET_CORE_REG("table/weak-values", cfun_table_weak_values),
JANET_CORE_REG("table/to-struct", cfun_table_tostruct),
JANET_CORE_REG("table/getproto", cfun_table_getproto),
JANET_CORE_REG("table/setproto", cfun_table_setproto),

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -69,9 +69,9 @@ JANET_CORE_FN(cfun_tuple_slice,
"inclusive to index `end` exclusive. If `start` or `end` are not provided, "
"they default to 0 and the length of `arrtup`, respectively. "
"`start` and `end` can also be negative to indicate indexing "
"from the end of the input. Note that if `start` is negative it is "
"exclusive, and if `end` is negative it is inclusive, to allow a full "
"negative slice range. Returns the new tuple.") {
"from the end of the input. Note that index -1 is synonymous with "
"index `(length arrtup)` to allow a full negative slice range. "
"Returns the new tuple.") {
JanetView view = janet_getindexed(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
@@ -116,34 +116,6 @@ JANET_CORE_FN(cfun_tuple_setmap,
return argv[0];
}
JANET_CORE_FN(cfun_tuple_join,
"(tuple/join & parts)",
"Create a tuple by joining together other tuples and arrays.") {
janet_arity(argc, 0, -1);
int32_t total_len = 0;
for (int32_t i = 0; i < argc; i++) {
int32_t len = 0;
const Janet *vals = NULL;
if (!janet_indexed_view(argv[i], &vals, &len)) {
janet_panicf("expected indexed type for argument %d, got %v", i, argv[i]);
}
if (INT32_MAX - total_len < len) {
janet_panic("tuple too large");
}
total_len += len;
}
Janet *tup = janet_tuple_begin(total_len);
Janet *tup_cursor = tup;
for (int32_t i = 0; i < argc; i++) {
int32_t len = 0;
const Janet *vals = NULL;
janet_indexed_view(argv[i], &vals, &len);
memcpy(tup_cursor, vals, len * sizeof(Janet));
tup_cursor += len;
}
return janet_wrap_tuple(janet_tuple_end(tup));
}
/* Load the tuple module */
void janet_lib_tuple(JanetTable *env) {
JanetRegExt tuple_cfuns[] = {
@@ -152,7 +124,6 @@ void janet_lib_tuple(JanetTable *env) {
JANET_CORE_REG("tuple/type", cfun_tuple_type),
JANET_CORE_REG("tuple/sourcemap", cfun_tuple_sourcemap),
JANET_CORE_REG("tuple/setmap", cfun_tuple_setmap),
JANET_CORE_REG("tuple/join", cfun_tuple_join),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, tuple_cfuns);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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,7 +79,6 @@ const char *const janet_type_names[16] = {
"pointer"
};
/* Docstring for signal lists these */
const char *const janet_signal_names[14] = {
"ok",
"error",
@@ -97,7 +96,6 @@ const char *const janet_signal_names[14] = {
"await"
};
/* Docstring for fiber/status lists these */
const char *const janet_status_names[16] = {
"dead",
"error",
@@ -828,20 +826,6 @@ int janet_checkuint64(Janet x) {
return janet_checkuint64range(dval);
}
int janet_checkint16(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkint16range(dval);
}
int janet_checkuint16(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkuint16range(dval);
}
int janet_checksize(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
@@ -969,20 +953,6 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
#endif
#endif
/* Better strerror (thread-safe if available) */
const char *janet_strerror(int e) {
#ifdef JANET_WINDOWS
/* Microsoft strerror seems sane here and is thread safe by default */
return strerror(e);
#elif defined(__GLIBC__)
/* See https://linux.die.net/man/3/strerror_r */
return strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
#else
strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
return janet_vm.strerror_buf;
#endif
}
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
@@ -990,7 +960,6 @@ void arc4random_buf(void *buf, size_t nbytes);
#endif
int janet_cryptorand(uint8_t *out, size_t n) {
#ifndef JANET_NO_CRYPTORAND
#ifdef JANET_WINDOWS
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
unsigned int v;
@@ -1002,10 +971,7 @@ int janet_cryptorand(uint8_t *out, size_t n) {
}
}
return 0;
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
arc4random_buf(out, n);
return 0;
#else
#elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros.
On Mac, arc4random_buf wasn't available on until 10.7.
@@ -1027,10 +993,12 @@ int janet_cryptorand(uint8_t *out, size_t n) {
}
RETRY_EINTR(rc, close(randfd));
return 0;
#endif
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
arc4random_buf(out, n);
return 0;
#else
(void) out;
(void) n;
(void) out;
return -1;
#endif
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -33,7 +33,6 @@
#include <errno.h>
#include <stddef.h>
#include <stdbool.h>
#include <math.h>
#ifdef JANET_EV
#ifndef JANET_WINDOWS
@@ -50,11 +49,11 @@
#ifndef JANET_EXIT
#include <stdio.h>
#define JANET_EXIT(m) do { \
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
__LINE__,\
__FILE__,\
(m));\
abort();\
exit(1);\
} while (0)
#endif
@@ -81,8 +80,6 @@ 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,
@@ -142,7 +139,7 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source);
#define strdup(x) _strdup(x)
#endif
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libraries
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
* with native code. */
#if defined(JANET_NO_DYNAMIC_MODULES)
typedef int Clib;
@@ -190,6 +187,9 @@ void janet_lib_debug(JanetTable *env);
#ifdef JANET_PEG
void janet_lib_peg(JanetTable *env);
#endif
#ifdef JANET_TYPED_ARRAY
void janet_lib_typed_array(JanetTable *env);
#endif
#ifdef JANET_INT_TYPES
void janet_lib_inttypes(JanetTable *env);
#endif
@@ -200,14 +200,10 @@ extern const JanetAbstractType janet_address_type;
#ifdef JANET_EV
void janet_lib_ev(JanetTable *env);
void janet_ev_mark(void);
void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
int janet_make_pipe(JanetHandle handles[2], int mode);
#ifdef JANET_FILEWATCH
void janet_lib_filewatch(JanetTable *env);
#endif
#ifdef JANET_FFI
void janet_lib_ffi(JanetTable *env);
#endif
#endif
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -703,7 +703,7 @@ Janet janet_lengthv(Janet x) {
return janet_wrap_number(len);
#else
if (len < (size_t) JANET_INTMAX_INT64) {
return janet_wrap_number((double) len);
return janet_wrap_number(len);
} else {
janet_panicf("integer length %u too large", len);
}

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -116,6 +116,7 @@
#else
#define vm_maybe_auto_suspend(COND) do { \
if ((COND) && janet_vm.auto_suspend) { \
janet_vm.auto_suspend = 0; \
fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
} \
@@ -300,16 +301,6 @@ static Janet janet_method_lookup(Janet x, const char *name) {
return method_to_fun(janet_ckeywordv(name), x);
}
static Janet janet_unary_call(const char *method, Janet arg) {
Janet m = janet_method_lookup(arg, method);
if (janet_checktype(m, JANET_NIL)) {
janet_panicf("could not find method :%s for %v", method, arg);
} else {
Janet argv[1] = { arg };
return janet_method_invoke(m, 1, argv);
}
}
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
Janet lm = janet_method_lookup(lhs, lmethod);
@@ -318,7 +309,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
Janet lr = janet_method_lookup(rhs, rmethod);
Janet argv[2] = { rhs, lhs };
if (janet_checktype(lr, JANET_NIL)) {
janet_panicf("could not find method :%s for %v or :%s for %v",
janet_panicf("could not find method :%s for %v, or :%s for %v",
lmethod, lhs,
rmethod, rhs);
}
@@ -346,13 +337,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_JOP_RETURN_NIL,
&&label_JOP_ADD_IMMEDIATE,
&&label_JOP_ADD,
&&label_JOP_SUBTRACT_IMMEDIATE,
&&label_JOP_SUBTRACT,
&&label_JOP_MULTIPLY_IMMEDIATE,
&&label_JOP_MULTIPLY,
&&label_JOP_DIVIDE_IMMEDIATE,
&&label_JOP_DIVIDE,
&&label_JOP_DIVIDE_FLOOR,
&&label_JOP_MODULO,
&&label_JOP_REMAINDER,
&&label_JOP_BAND,
@@ -593,6 +582,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op
};
#endif
@@ -682,9 +673,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_ADD)
vm_binop(+);
VM_OP(JOP_SUBTRACT_IMMEDIATE)
vm_binop_immediate(-);
VM_OP(JOP_SUBTRACT)
vm_binop(-);
@@ -700,33 +688,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_DIVIDE)
vm_binop( /);
VM_OP(JOP_DIVIDE_FLOOR) {
Janet op1 = stack[B];
Janet op2 = stack[C];
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
double x1 = janet_unwrap_number(op1);
double x2 = janet_unwrap_number(op2);
stack[A] = janet_wrap_number(floor(x1 / x2));
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("div", "rdiv", op1, op2);
vm_checkgc_pcnext();
}
}
VM_OP(JOP_MODULO) {
Janet op1 = stack[B];
Janet op2 = stack[C];
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
double x1 = janet_unwrap_number(op1);
double x2 = janet_unwrap_number(op2);
if (x2 == 0) {
stack[A] = janet_wrap_number(x1);
} else {
double intres = x2 * floor(x1 / x2);
stack[A] = janet_wrap_number(x1 - intres);
}
double intres = x2 * floor(x1 / x2);
stack[A] = janet_wrap_number(x1 - intres);
vm_pcnext();
} else {
vm_commit();
@@ -761,14 +730,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_BNOT) {
Janet op = stack[E];
if (janet_checktype(op, JANET_NUMBER)) {
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_unary_call("~", op);
vm_checkgc_pcnext();
}
vm_assert_type(op, JANET_NUMBER);
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
vm_pcnext();
}
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
@@ -799,13 +763,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_JUMP)
pc += DS;
vm_maybe_auto_suspend(DS <= 0);
vm_maybe_auto_suspend(DS < 0);
vm_next();
VM_OP(JOP_JUMP_IF)
if (janet_truthy(stack[A])) {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
vm_maybe_auto_suspend(ES < 0);
} else {
pc++;
}
@@ -816,14 +780,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
vm_maybe_auto_suspend(ES < 0);
}
vm_next();
VM_OP(JOP_JUMP_IF_NIL)
if (janet_checktype(stack[A], JANET_NIL)) {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
vm_maybe_auto_suspend(ES < 0);
} else {
pc++;
}
@@ -834,7 +798,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
vm_maybe_auto_suspend(ES < 0);
}
vm_next();
@@ -861,7 +825,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
VM_OP(JOP_EQUALS_IMMEDIATE)
stack[A] = janet_wrap_boolean(janet_checktype(stack[B], JANET_NUMBER) && (janet_unwrap_number(stack[B]) == (double) CS));
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
vm_pcnext();
VM_OP(JOP_NOT_EQUALS)
@@ -869,7 +833,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
stack[A] = janet_wrap_boolean(!janet_checktype(stack[B], JANET_NUMBER) || (janet_unwrap_number(stack[B]) != (double) CS));
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
vm_pcnext();
VM_OP(JOP_COMPARE)
@@ -1268,7 +1232,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
/*
* Execute a single instruction in the fiber. Does this by inspecting
* the fiber, setting a breakpoint at the next instruction, executing, and
* resetting breakpoints to how they were prior. Yes, it's a bit hacky.
* reseting breakpoints to how they were prior. Yes, it's a bit hacky.
*/
JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
/* No finished or currently alive fibers. */
@@ -1585,11 +1549,9 @@ int janet_init(void) {
/* Garbage collection */
janet_vm.blocks = NULL;
janet_vm.weak_blocks = NULL;
janet_vm.next_collection = 0;
janet_vm.gc_interval = 0x400000;
janet_vm.block_count = 0;
janet_vm.gc_mark_phase = 0;
janet_symcache_init();
@@ -1613,7 +1575,7 @@ int janet_init(void) {
janet_vm.registry_count = 0;
janet_vm.registry_dirty = 0;
/* Initialize abstract registry */
/* Intialize abstract registry */
janet_vm.abstract_registry = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -43,10 +43,10 @@ int (janet_truthy)(Janet x) {
return janet_truthy(x);
}
JanetStruct(janet_unwrap_struct)(Janet x) {
const JanetKV *(janet_unwrap_struct)(Janet x) {
return janet_unwrap_struct(x);
}
JanetTuple(janet_unwrap_tuple)(Janet x) {
const Janet *(janet_unwrap_tuple)(Janet x) {
return janet_unwrap_tuple(x);
}
JanetFiber *(janet_unwrap_fiber)(Janet x) {
@@ -61,16 +61,16 @@ JanetTable *(janet_unwrap_table)(Janet x) {
JanetBuffer *(janet_unwrap_buffer)(Janet x) {
return janet_unwrap_buffer(x);
}
JanetString(janet_unwrap_string)(Janet x) {
const uint8_t *(janet_unwrap_string)(Janet x) {
return janet_unwrap_string(x);
}
JanetSymbol(janet_unwrap_symbol)(Janet x) {
const uint8_t *(janet_unwrap_symbol)(Janet x) {
return janet_unwrap_symbol(x);
}
JanetKeyword(janet_unwrap_keyword)(Janet x) {
const uint8_t *(janet_unwrap_keyword)(Janet x) {
return janet_unwrap_keyword(x);
}
JanetAbstract(janet_unwrap_abstract)(Janet x) {
void *(janet_unwrap_abstract)(Janet x) {
return janet_unwrap_abstract(x);
}
void *(janet_unwrap_pointer)(Janet x) {
@@ -102,22 +102,22 @@ Janet(janet_wrap_false)(void) {
Janet(janet_wrap_boolean)(int x) {
return janet_wrap_boolean(x);
}
Janet(janet_wrap_string)(JanetString x) {
Janet(janet_wrap_string)(const uint8_t *x) {
return janet_wrap_string(x);
}
Janet(janet_wrap_symbol)(JanetSymbol x) {
Janet(janet_wrap_symbol)(const uint8_t *x) {
return janet_wrap_symbol(x);
}
Janet(janet_wrap_keyword)(JanetKeyword x) {
Janet(janet_wrap_keyword)(const uint8_t *x) {
return janet_wrap_keyword(x);
}
Janet(janet_wrap_array)(JanetArray *x) {
return janet_wrap_array(x);
}
Janet(janet_wrap_tuple)(JanetTuple x) {
Janet(janet_wrap_tuple)(const Janet *x) {
return janet_wrap_tuple(x);
}
Janet(janet_wrap_struct)(JanetStruct x) {
Janet(janet_wrap_struct)(const JanetKV *x) {
return janet_wrap_struct(x);
}
Janet(janet_wrap_fiber)(JanetFiber *x) {
@@ -135,7 +135,7 @@ Janet(janet_wrap_cfunction)(JanetCFunction x) {
Janet(janet_wrap_table)(JanetTable *x) {
return janet_wrap_table(x);
}
Janet(janet_wrap_abstract)(JanetAbstract x) {
Janet(janet_wrap_abstract)(void *x) {
return janet_wrap_abstract(x);
}
Janet(janet_wrap_pointer)(void *x) {
@@ -317,3 +317,4 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
#undef JANET_WRAP_DEFINE
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -46,7 +46,7 @@ extern "C" {
#endif
/*
* Detect OS and endianness.
* Detect OS and endianess.
* From webkit source. There is likely some extreneous
* detection for unsupported platforms
*/
@@ -112,8 +112,7 @@ extern "C" {
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|| (defined(__ppc64__) || defined(__PPC64__)) \
|| defined(__aarch64__) /* ARM 64-bit */ \
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */ \
|| defined(__loongarch64) /* LoongArch64 64-bit */
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
#define JANET_64 1
#else
#define JANET_32 1
@@ -210,11 +209,6 @@ extern "C" {
#define JANET_EV
#endif
/* Enable or disable the filewatch/ module */
#if !defined(JANET_NO_FILEWATCH)
#define JANET_FILEWATCH
#endif
/* Enable or disable networking */
#if defined(JANET_EV) && !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
#define JANET_NET
@@ -240,34 +234,16 @@ extern "C" {
#define JANET_EV_KQUEUE
#endif
/* Use poll as last resort */
#if !defined(JANET_WINDOWS) && !defined(JANET_EV_EPOLL) && !defined(JANET_EV_KQUEUE)
#define JANET_EV_POLL
#endif
/* How to export symbols */
#ifndef JANET_EXPORT
#ifdef JANET_WINDOWS
#define JANET_EXPORT __declspec(dllexport)
#else
#define JANET_EXPORT __attribute__((visibility ("default")))
#endif
#endif
/* How declare API functions */
#ifndef JANET_API
#ifdef JANET_WINDOWS
#ifdef JANET_DLL_IMPORT
#define JANET_API __declspec(dllimport)
#else
#define JANET_API __declspec(dllexport)
#endif
#else
#define JANET_API __attribute__((visibility ("default")))
#endif
#endif
/* Tell compiler some functions don't return */
/* Tell complier some functions don't return */
#ifndef JANET_NO_RETURN
#ifdef JANET_WINDOWS
#define JANET_NO_RETURN __declspec(noreturn)
@@ -277,7 +253,7 @@ extern "C" {
#endif
/* Prevent some recursive functions from recursing too deeply
* and crashing (the parser). Instead, error out. */
* ands crashing (the parser). Instead, error out. */
#define JANET_RECURSION_GUARD 1024
/* Maximum depth to follow table prototypes before giving up and returning nil. */
@@ -359,7 +335,6 @@ typedef struct {
#ifdef JANET_EV
typedef struct JanetOSMutex JanetOSMutex;
typedef struct JanetOSRWLock JanetOSRWLock;
typedef struct JanetChannel JanetChannel;
#endif
/***** END SECTION CONFIG *****/
@@ -418,11 +393,12 @@ typedef enum {
JANET_SIGNAL_USER6,
JANET_SIGNAL_USER7,
JANET_SIGNAL_USER8,
JANET_SIGNAL_USER9,
JANET_SIGNAL_INTERRUPT = JANET_SIGNAL_USER8,
JANET_SIGNAL_EVENT = JANET_SIGNAL_USER9,
JANET_SIGNAL_USER9
} JanetSignal;
#define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
#define JANET_SIGNAL_INTERRUPT JANET_SIGNAL_USER8
/* Fiber statuses - mostly corresponds to signals. */
typedef enum {
JANET_STATUS_DEAD,
@@ -586,7 +562,7 @@ typedef void *JanetAbstract;
#define JANET_STREAM_CLOSED 0x1
#define JANET_STREAM_SOCKET 0x2
#define JANET_STREAM_UNREGISTERED 0x4
#define JANET_STREAM_IOCP 0x4
#define JANET_STREAM_READABLE 0x200
#define JANET_STREAM_WRITABLE 0x400
#define JANET_STREAM_ACCEPTABLE 0x800
@@ -594,75 +570,62 @@ typedef void *JanetAbstract;
#define JANET_STREAM_TOCLOSE 0x10000
typedef enum {
JANET_ASYNC_EVENT_INIT = 0,
JANET_ASYNC_EVENT_MARK = 1,
JANET_ASYNC_EVENT_DEINIT = 2,
JANET_ASYNC_EVENT_CLOSE = 3,
JANET_ASYNC_EVENT_ERR = 4,
JANET_ASYNC_EVENT_HUP = 5,
JANET_ASYNC_EVENT_READ = 6,
JANET_ASYNC_EVENT_WRITE = 7,
JANET_ASYNC_EVENT_COMPLETE = 8, /* Used on windows for IOCP */
JANET_ASYNC_EVENT_FAILED = 9 /* Used on windows for IOCP */
JANET_ASYNC_EVENT_INIT,
JANET_ASYNC_EVENT_MARK,
JANET_ASYNC_EVENT_DEINIT,
JANET_ASYNC_EVENT_CLOSE,
JANET_ASYNC_EVENT_ERR,
JANET_ASYNC_EVENT_HUP,
JANET_ASYNC_EVENT_READ,
JANET_ASYNC_EVENT_WRITE,
JANET_ASYNC_EVENT_CANCEL,
JANET_ASYNC_EVENT_COMPLETE, /* Used on windows for IOCP */
JANET_ASYNC_EVENT_USER
} JanetAsyncEvent;
typedef enum {
JANET_ASYNC_LISTEN_READ = 1,
JANET_ASYNC_LISTEN_WRITE,
JANET_ASYNC_LISTEN_BOTH
} JanetAsyncMode;
#define JANET_ASYNC_LISTEN_READ (1 << JANET_ASYNC_EVENT_READ)
#define JANET_ASYNC_LISTEN_WRITE (1 << JANET_ASYNC_EVENT_WRITE)
typedef enum {
JANET_ASYNC_STATUS_NOT_DONE,
JANET_ASYNC_STATUS_DONE
} JanetAsyncStatus;
/* Typedefs */
typedef struct JanetListenerState JanetListenerState;
typedef struct JanetStream JanetStream;
typedef JanetAsyncStatus(*JanetListener)(JanetListenerState *state, JanetAsyncEvent event);
/* Wrapper around file descriptors and HANDLEs that can be polled. */
struct JanetStream {
JanetHandle handle;
uint32_t flags;
uint32_t index;
JanetFiber *read_fiber;
JanetFiber *write_fiber;
/* Linked list of all in-flight IO routines for this stream */
JanetListenerState *state;
const void *methods; /* Methods for this stream */
/* internal - used to disallow multiple concurrent reads / writes on the same stream.
* this constraint may be lifted later but allowing such would require more internal book keeping
* for some implementations. You can read and write at the same time on the same stream, though. */
int _mask;
};
typedef void (*JanetEVCallback)(JanetFiber *fiber, JanetAsyncEvent event);
/* Start listening for events from a stream on the current root fiber. After
* calling this, users should call janet_await() before returning from the
* current C Function. This also will call janet_await.
* mode is which events to listen for, and callback is the function pointer to
* call when ever an event is sent from the event loop. state is an optional (can be NULL)
* pointer to data allocated with janet_malloc. This pointer will be passed to callback as
* fiber->ev_state. It will also be freed for you by the runtime when the event loop determines
* it can no longer be referenced. On windows, the contents of state MUST contained an OVERLAPPED struct at the 0 offset. */
JANET_API void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
JANET_API JANET_NO_RETURN void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
/* Do not send any more events to the given callback. Call this after scheduling fiber to be resume
* or canceled. */
JANET_API void janet_async_end(JanetFiber *fiber);
/* Needed for windows to mark a fiber as waiting for an IOCP completion event. Noop on other platforms. */
JANET_API void janet_async_in_flight(JanetFiber *fiber);
/* On some platforms, it is important to be able to control if a stream is edge-trigger or level triggered.
* For example, a server that is accepting connections might want to be level triggered or edge-triggered
* depending on expected service. */
JANET_API void janet_stream_edge_triggered(JanetStream *stream);
JANET_API void janet_stream_level_triggered(JanetStream *stream);
#endif
/* Janet uses atomic integers in several places for synchronization between threads and
* signals. Define them here */
/* Interface for state machine based event loop */
struct JanetListenerState {
JanetListener machine;
JanetFiber *fiber;
JanetStream *stream;
void *event; /* Used to pass data from asynchronous IO event. Contents depend on both
implementation of the event loop and the particular event. */
#ifdef JANET_WINDOWS
typedef long JanetAtomicInt;
#else
typedef int32_t JanetAtomicInt;
void *tag; /* Used to associate listeners with an overlapped structure */
int bytes; /* Used to track how many bytes were transfered. */
#endif
/* internal */
size_t _index;
int _mask;
JanetListenerState *_next;
};
#endif
JANET_API JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x);
JANET_API JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x);
JANET_API JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x);
/* We provide three possible implementations of Janets. The preferred
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
@@ -690,10 +653,10 @@ JANET_API JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x);
* external bindings, we should prefer using the Head structs directly, and
* use the host language to add sugar around the manipulation of the Janet types. */
JANET_API JanetStructHead *janet_struct_head(JanetStruct st);
JANET_API JanetStructHead *janet_struct_head(const JanetKV *st);
JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract);
JANET_API JanetStringHead *janet_string_head(JanetString s);
JANET_API JanetTupleHead *janet_tuple_head(JanetTuple tuple);
JANET_API JanetStringHead *janet_string_head(const uint8_t *s);
JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple);
/* Some language bindings won't have access to the macro versions. */
@@ -702,16 +665,16 @@ JANET_API int janet_checktype(Janet x, JanetType type);
JANET_API int janet_checktypes(Janet x, int typeflags);
JANET_API int janet_truthy(Janet x);
JANET_API JanetStruct janet_unwrap_struct(Janet x);
JANET_API JanetTuple janet_unwrap_tuple(Janet x);
JANET_API const JanetKV *janet_unwrap_struct(Janet x);
JANET_API const Janet *janet_unwrap_tuple(Janet x);
JANET_API JanetFiber *janet_unwrap_fiber(Janet x);
JANET_API JanetArray *janet_unwrap_array(Janet x);
JANET_API JanetTable *janet_unwrap_table(Janet x);
JANET_API JanetBuffer *janet_unwrap_buffer(Janet x);
JANET_API JanetString janet_unwrap_string(Janet x);
JANET_API JanetSymbol janet_unwrap_symbol(Janet x);
JANET_API JanetKeyword janet_unwrap_keyword(Janet x);
JANET_API JanetAbstract janet_unwrap_abstract(Janet x);
JANET_API const uint8_t *janet_unwrap_string(Janet x);
JANET_API const uint8_t *janet_unwrap_symbol(Janet x);
JANET_API const uint8_t *janet_unwrap_keyword(Janet x);
JANET_API void *janet_unwrap_abstract(Janet x);
JANET_API void *janet_unwrap_pointer(Janet x);
JANET_API JanetFunction *janet_unwrap_function(Janet x);
JANET_API JanetCFunction janet_unwrap_cfunction(Janet x);
@@ -724,18 +687,18 @@ JANET_API Janet janet_wrap_number(double x);
JANET_API Janet janet_wrap_true(void);
JANET_API Janet janet_wrap_false(void);
JANET_API Janet janet_wrap_boolean(int x);
JANET_API Janet janet_wrap_string(JanetString x);
JANET_API Janet janet_wrap_symbol(JanetSymbol x);
JANET_API Janet janet_wrap_keyword(JanetKeyword x);
JANET_API Janet janet_wrap_string(const uint8_t *x);
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
JANET_API Janet janet_wrap_array(JanetArray *x);
JANET_API Janet janet_wrap_tuple(JanetTuple x);
JANET_API Janet janet_wrap_struct(JanetStruct x);
JANET_API Janet janet_wrap_tuple(const Janet *x);
JANET_API Janet janet_wrap_struct(const JanetKV *x);
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
JANET_API Janet janet_wrap_function(JanetFunction *x);
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
JANET_API Janet janet_wrap_table(JanetTable *x);
JANET_API Janet janet_wrap_abstract(JanetAbstract x);
JANET_API Janet janet_wrap_abstract(void *x);
JANET_API Janet janet_wrap_pointer(void *x);
JANET_API Janet janet_wrap_integer(int32_t x);
@@ -767,7 +730,6 @@ JANET_API Janet janet_wrap_integer(int32_t x);
? janet_nanbox_isnumber(x) \
: janet_nanbox_checkauxtype((x), (t)))
/* Use JANET_API so that modules will use a local version of these functions if possible */
JANET_API void *janet_nanbox_to_pointer(Janet x);
JANET_API Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask);
JANET_API Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask);
@@ -814,14 +776,14 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
#define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER)
/* Unwrap the pointer types */
#define janet_unwrap_struct(x) ((JanetStruct)janet_nanbox_to_pointer(x))
#define janet_unwrap_tuple(x) ((JanetTuple)janet_nanbox_to_pointer(x))
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
#define janet_unwrap_tuple(x) ((const Janet *)janet_nanbox_to_pointer(x))
#define janet_unwrap_fiber(x) ((JanetFiber *)janet_nanbox_to_pointer(x))
#define janet_unwrap_array(x) ((JanetArray *)janet_nanbox_to_pointer(x))
#define janet_unwrap_table(x) ((JanetTable *)janet_nanbox_to_pointer(x))
#define janet_unwrap_buffer(x) ((JanetBuffer *)janet_nanbox_to_pointer(x))
#define janet_unwrap_string(x) ((JanetString)janet_nanbox_to_pointer(x))
#define janet_unwrap_symbol(x) ((JanetSymbol)janet_nanbox_to_pointer(x))
#define janet_unwrap_string(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_symbol(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_keyword(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_abstract(x) (janet_nanbox_to_pointer(x))
#define janet_unwrap_pointer(x) (janet_nanbox_to_pointer(x))
@@ -863,15 +825,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
#define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s))
#define janet_unwrap_struct(x) ((JanetStruct)(x).tagged.payload.pointer)
#define janet_unwrap_tuple(x) ((JanetTuple)(x).tagged.payload.pointer)
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).tagged.payload.pointer)
#define janet_unwrap_array(x) ((JanetArray *)(x).tagged.payload.pointer)
#define janet_unwrap_table(x) ((JanetTable *)(x).tagged.payload.pointer)
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).tagged.payload.pointer)
#define janet_unwrap_string(x) ((JanetString)(x).tagged.payload.pointer)
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).tagged.payload.pointer)
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).tagged.payload.pointer)
#define janet_unwrap_string(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_abstract(x) ((x).tagged.payload.pointer)
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
@@ -886,15 +848,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_truthy(x) \
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
#define janet_unwrap_struct(x) ((JanetStruct)(x).as.pointer)
#define janet_unwrap_tuple(x) ((JanetTuple)(x).as.pointer)
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).as.pointer)
#define janet_unwrap_array(x) ((JanetArray *)(x).as.pointer)
#define janet_unwrap_table(x) ((JanetTable *)(x).as.pointer)
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).as.pointer)
#define janet_unwrap_string(x) ((JanetString)(x).as.pointer)
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).as.pointer)
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).as.pointer)
#define janet_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_abstract(x) ((x).as.pointer)
#define janet_unwrap_pointer(x) ((x).as.pointer)
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
@@ -905,16 +867,12 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
/* End of tagged union implementation */
#endif
JANET_API int janet_checkint16(Janet x);
JANET_API int janet_checkuint16(Janet x);
JANET_API int janet_checkint(Janet x);
JANET_API int janet_checkuint(Janet x);
JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checkuint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkint16range(x) ((x) >= INT16_MIN && (x) <= INT16_MAX && (x) == (int16_t)(x))
#define janet_checkuint16range(x) ((x) >= 0 && (x) <= UINT16_MAX && (x) == (uint16_t)(x))
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
#define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x))
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
@@ -931,7 +889,7 @@ struct JanetGCObject {
int32_t flags;
union {
JanetGCObject *next;
volatile JanetAtomicInt refcount; /* For threaded abstract types */
int32_t refcount; /* For threaded abstract types */
} data;
};
@@ -954,10 +912,8 @@ struct JanetFiber {
* that is, fibers that are scheduled on the event loop and behave much like threads
* in a multi-tasking system. It would be possible to move these fields to a new
* type, say "JanetTask", that as separate from fibers to save a bit of space. */
JanetListenerState *waiting;
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
JanetEVCallback ev_callback; /* Call this before starting scheduled fibers */
JanetStream *ev_stream; /* which stream we are waiting on */
void *ev_state; /* Extra data for ev callback state. On windows, first element must be OVERLAPPED. */
void *supervisor_channel; /* Channel to push self to when complete */
#endif
};
@@ -1306,13 +1262,11 @@ enum JanetOpCode {
JOP_RETURN_NIL,
JOP_ADD_IMMEDIATE,
JOP_ADD,
JOP_SUBTRACT_IMMEDIATE,
JOP_SUBTRACT,
JOP_MULTIPLY_IMMEDIATE,
JOP_MULTIPLY,
JOP_DIVIDE_IMMEDIATE,
JOP_DIVIDE,
JOP_DIVIDE_FLOOR,
JOP_MODULO,
JOP_REMAINDER,
JOP_BAND,
@@ -1421,7 +1375,6 @@ JANET_API void janet_loop1_interrupt(JanetVM *vm);
/* Wrapper around streams */
JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods);
JANET_API JanetStream *janet_stream_ext(JanetHandle handle, uint32_t flags, const JanetMethod *methods, size_t size); /* Allow for type punning streams */
JANET_API void janet_stream_close(JanetStream *stream);
JANET_API Janet janet_cfun_stream_close(int32_t argc, Janet *argv);
JANET_API Janet janet_cfun_stream_read(int32_t argc, Janet *argv);
@@ -1433,7 +1386,9 @@ JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags);
JANET_API void janet_schedule(JanetFiber *fiber, Janet value);
JANET_API void janet_cancel(JanetFiber *fiber, Janet value);
JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig);
JANET_API void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig);
/* Start a state machine listening for events from a stream */
JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user);
/* Shorthand for yielding to event loop in C */
JANET_NO_RETURN JANET_API void janet_await(void);
@@ -1452,14 +1407,6 @@ JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t s
JANET_API int32_t janet_abstract_incref(void *abst);
JANET_API int32_t janet_abstract_decref(void *abst);
/* Expose channel utilities */
JanetChannel *janet_channel_make(uint32_t limit);
JanetChannel *janet_channel_make_threaded(uint32_t limit);
JanetChannel *janet_getchannel(const Janet *argv, int32_t n);
JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt);
JANET_API int janet_channel_give(JanetChannel *channel, Janet x);
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
/* Expose some OS sync primitives */
JANET_API size_t janet_os_mutex_size(void);
JANET_API size_t janet_os_rwlock_size(void);
@@ -1529,22 +1476,23 @@ JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGeneric
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
/* 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);
JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
#ifdef JANET_NET
JANET_NO_RETURN JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_NO_RETURN JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_NO_RETURN JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_connect(JanetStream *stream, int flags);
#endif
/* 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);
JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
#ifdef JANET_NET
JANET_NO_RETURN JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
JANET_NO_RETURN JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
JANET_NO_RETURN JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
JANET_NO_RETURN JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
#endif
#endif
@@ -1615,9 +1563,6 @@ JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
JANET_API int janet_scan_number_base(const uint8_t *str, int32_t len, int32_t base, double *out);
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
#ifdef JANET_INT_TYPES
JANET_API int janet_scan_numeric(const uint8_t *str, int32_t len, Janet *out);
#endif
/* Debugging */
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
@@ -1636,7 +1581,6 @@ JANET_API double janet_rng_double(JanetRNG *rng);
/* Array functions */
JANET_API JanetArray *janet_array(int32_t capacity);
JANET_API JanetArray *janet_array_weak(int32_t capacity);
JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n);
JANET_API void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth);
JANET_API void janet_array_setcount(JanetArray *array, int32_t count);
@@ -1666,7 +1610,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((JanetTuple)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
@@ -1712,7 +1656,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
/* Structs */
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((JanetStruct)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_length(t) (janet_struct_head(t)->length)
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
@@ -1742,9 +1686,6 @@ JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
JANET_API JanetTable *janet_table_clone(JanetTable *table);
JANET_API void janet_table_clear(JanetTable *table);
JANET_API JanetTable *janet_table_weakk(int32_t capacity);
JANET_API JanetTable *janet_table_weakv(int32_t capacity);
JANET_API JanetTable *janet_table_weakkv(int32_t capacity);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
@@ -1808,7 +1749,6 @@ JANET_API void janet_gcpressure(size_t s);
/* Functions */
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
JANET_API JanetFunction *janet_thunk_delay(Janet x);
JANET_API int janet_verify(JanetFuncDef *def);
/* Pretty printing */
@@ -1857,7 +1797,6 @@ JANET_API void janet_vm_free(JanetVM *vm);
JANET_API void janet_vm_save(JanetVM *into);
JANET_API void janet_vm_load(JanetVM *from);
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
JANET_API 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);
@@ -1881,7 +1820,6 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
#define JANET_SANDBOX_FS_TEMP 1024
#define JANET_SANDBOX_FFI_USE 2048
#define JANET_SANDBOX_FFI_JIT 4096
#define JANET_SANDBOX_SIGNAL 8192
#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)
@@ -2005,10 +1943,10 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
#endif
#ifndef JANET_ENTRY_NAME
#define JANET_MODULE_ENTRY \
JANET_MODULE_PREFIX JANET_EXPORT JanetBuildConfig _janet_mod_config(void) { \
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
return janet_config_current(); \
} \
JANET_MODULE_PREFIX JANET_EXPORT void _janet_init
JANET_MODULE_PREFIX JANET_API void _janet_init
#else
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
#endif
@@ -2048,10 +1986,7 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
JANET_API int16_t janet_getinteger16(const Janet *argv, int32_t n);
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
JANET_API uint32_t janet_getuinteger(const Janet *argv, int32_t n);
JANET_API uint16_t janet_getuinteger16(const Janet *argv, int32_t n);
JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
@@ -2060,8 +1995,6 @@ JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
JANET_API int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
@@ -2135,7 +2068,6 @@ JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
JANET_API JanetAbstract janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size);
JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
@@ -2174,15 +2106,11 @@ typedef enum {
RULE_TO, /* [rule] */
RULE_THRU, /* [rule] */
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
RULE_READINT, /* [(signedness << 4) | (endianness << 5) | bytewidth, tag] */
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
RULE_LINE, /* [tag] */
RULE_COLUMN, /* [tag] */
RULE_UNREF, /* [rule, tag] */
RULE_CAPTURE_NUM, /* [rule, tag] */
RULE_SUB, /* [rule, rule] */
RULE_SPLIT, /* [rule, rule] */
RULE_NTH, /* [nth, rule, tag] */
RULE_ONLY_TAGS, /* [rule] */
RULE_CAPTURE_NUM /* [rule, tag] */
} JanetPegOpcod;
typedef struct {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2023 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
@@ -502,10 +502,10 @@ static void kright(void) {
}
static void krightw(void) {
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
gbl_pos++;
}
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
gbl_pos++;
}
refresh();
@@ -867,7 +867,7 @@ static int line() {
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
for (;;) {
char c;
char seq[5];
char seq[3];
int rc;
do {
@@ -991,20 +991,6 @@ static int line() {
default:
break;
}
} else if (seq[2] == ';') {
if (read_console(seq + 3, 2) == -1) break;
if (seq[3] == '5') {
switch (seq[4]) {
case 'C': /* ctrl-right */
krightw();
break;
case 'D': /* ctrl-left */
kleftw();
break;
default:
break;
}
}
}
} else if (seq[0] == 'O') {
if (read_console(seq + 1, 1) == -1) break;
@@ -1177,7 +1163,6 @@ int main(int argc, char **argv) {
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
Janet mainargs[1] = { janet_wrap_array(args) };
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
janet_gcroot(janet_wrap_fiber(fiber));
fiber->env = env;
/* Run the fiber in an event loop */

View File

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

View File

@@ -4,47 +4,24 @@
(var num-tests-run 0)
(var suite-name 0)
(var start-time 0)
(var skip-count 0)
(var skip-n 0)
(def is-verbose (os/getenv "VERBOSE"))
(defn- assert-no-tail
(defn assert
"Override's the default assert with some nice error handling."
[x &opt e]
(++ num-tests-run)
(when (pos? skip-n)
(-- skip-n)
(++ skip-count)
(break x))
(default e "assert error")
(++ num-tests-run)
(when x (++ num-tests-passed))
(def str (string e))
(def stack (debug/stack (fiber/current)))
(def frame (last stack))
(def frame (last (debug/stack (fiber/current))))
(def line-info (string/format "%s:%d"
(frame :source) (frame :source-line)))
(if x
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
(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 (describe e) x))
x)
(defn skip-asserts
"Skip some asserts"
[n]
(+= skip-n n)
nil)
(defmacro assert
[x &opt e]
(def xx (gensym))
(default e ~',x)
~(do
(def ,xx ,x)
(,assert-no-tail ,xx ,e)
,xx))
(defmacro assert-error
[msg & forms]
(def errsym (keyword (gensym)))
@@ -57,17 +34,17 @@
(defmacro assert-no-error
[msg & forms]
(def e (gensym))
(def f (gensym))
(if is-verbose
~(try (do ,;forms (,assert true ,msg)) ([,e ,f] (,assert false ,msg) (,debug/stacktrace ,f ,e "\e[31m✘\e[0m ")))
~(try (do ,;forms (,assert true ,msg)) ([_] (,assert false ,msg)))))
(def errsym (keyword (gensym)))
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defn start-suite [&opt x]
(default x (dyn :current-file))
(set suite-name
(cond
(number? x) (string x)
(string? x) (string/slice x
(length "test/suite-")
(- (inc (length ".janet"))))
(string x)))
(set start-time (os/clock))
(eprint "Starting suite " suite-name "..."))
@@ -75,22 +52,5 @@
(defn end-suite []
(def delta (- (os/clock) start-time))
(eprinf "Finished suite %s in %.3f seconds - " suite-name delta)
(eprint num-tests-passed " of " num-tests-run " tests passed (" skip-count " skipped).")
(if (not= (+ skip-count num-tests-passed) num-tests-run) (os/exit 1)))
(defn rmrf
"rm -rf in janet"
[x]
(case (os/lstat x :mode)
nil nil
:directory (do
(each y (os/dir x)
(rmrf (string x "/" y)))
(os/rmdir x))
(os/rm x))
nil)
(defn randdir
"Get a random directory name"
[]
(string "tmp_dir_" (slice (string (math/random) ".tmp") 2)))
(eprint num-tests-passed " of " num-tests-run " tests passed.")
(if (not= num-tests-passed num-tests-run) (os/exit 1)))

View File

@@ -44,7 +44,8 @@
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
(assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
(assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4")
(assert (deep= (array/remove @[1 2 3 4 5] -3 200) @[1 2 3]) "array/remove 4")
# array/peek
(assert (nil? (array/peek @[])) "array/peek empty")
@@ -75,16 +76,6 @@
(array/trim a)
(array/ensure @[1 1] 6 2)
# array/join
(assert (deep= @[1 2 3] (array/join @[] [1] [2] [3])) "array/join 1")
(assert (deep= @[] (array/join @[])) "array/join 2")
(assert (deep= @[1 :a :b :c] (array/join @[1] @[:a :b] [] [:c])) "array/join 3")
(assert (deep= @[:x :y :z "abc123" "def456"] (array/join @[:x :y :z] ["abc123" "def456"])) "array/join 4")
(assert-error "array/join error 1" (array/join))
(assert-error "array/join error 2" (array/join []))
(assert-error "array/join error 3" (array/join [] "abc123"))
(assert-error "array/join error 4" (array/join @[] "abc123"))
(assert-error "array/join error 5" (array/join @[] "abc123"))
(end-suite)

View File

@@ -51,13 +51,5 @@
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
(assert (= ((f 10) 37) 47) "asm environment tables")
# issue #1424
(assert-no-error "arity > used slots (issue #1424)"
(asm
(disasm
(fn []
(def foo (fn [one two] one))
(foo 100 200)))))
(end-suite)

View File

@@ -113,22 +113,13 @@
# 7478ad11
(assert (= nil (any? [])) "any? 1")
(assert (= nil (any? [false nil])) "any? 2")
(assert (= false (any? [nil false])) "any? 3")
(assert (= nil (any? [nil false])) "any? 3")
(assert (= 1 (any? [1])) "any? 4")
(assert (nan? (any? [nil math/nan nil])) "any? 5")
(assert (= true
(any? [nil nil false nil nil true nil nil nil nil false :a nil]))
"any? 6")
(assert (= true (every? [])) "every? 1")
(assert (= true (every? [1 true])) "every? 2")
(assert (= 1 (every? [true 1])) "every? 3")
(assert (= nil (every? [nil])) "every? 4")
(assert (= 2 (every? [1 math/nan 2])) "every? 5")
(assert (= false
(every? [1 1 true 1 1 false 1 1 1 1 true :a nil]))
"every? 6")
# Some higher order functions and macros
# 5e2de33
(def my-array @[1 2 3 4 5 6])
@@ -186,11 +177,6 @@
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]])
"nested seq")
# :unless modifier
(assert (deep= (seq [i :range [0 10] :unless (odd? i)] i)
@[0 2 4 6 8])
":unless modifier")
# 515891b03
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
@{0 0 1 3 2 6}))
@@ -209,12 +195,6 @@
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x))
"loop :down-to")
# one-term :range forms
(assert (deep= (seq [x :range [10]] x) (seq [x :range [0 10]] x))
"one-term :range")
(assert (deep= (seq [x :down [10]] x) (seq [x :down [10 0]] x))
"one-term :down")
# 7880d7320
(def res @{})
(loop [[k v] :pairs @{1 2 3 4 5 6}]
@@ -241,16 +221,6 @@
(assert (pos? (% x 4)) "generate in loop"))
(assert (= gencount 75) "generate loop count")
# more loop checks
(assert (deep= (seq [i :range [0 10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 1")
(assert (deep= (seq [i :range [0 10 2]] i) @[0 2 4 6 8]) "seq 2")
(assert (deep= (seq [i :range [10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 3")
(assert (deep= (seq [i :range-to [10]] i) @[0 1 2 3 4 5 6 7 8 9 10]) "seq 4")
(def gen (generate [x :range-to [0 nil 2]] x))
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit")
(def gen (generate [x :range [0 nil 2]] x))
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit 2")
# Even and odd
# ff163a5ae
(assert (odd? 9) "odd? 1")
@@ -364,13 +334,6 @@
"sort 5")
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
# #1283
(assert (deep=
(partition 2 (generate [ i :in [:a :b :c :d :e]] i))
'@[(:a :b) (:c :d) (:e)]))
(assert (= (mean (generate [i :in [2 3 5 7 11]] i))
5.6))
# And and or
# c16a9d846
(assert (= (and true true) true) "and true true")
@@ -399,7 +362,14 @@
(assert (= false (and false false)) "and 1")
(assert (= false (or false false)) "or 1")
# Range
# a982f351d
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument")
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
# 11cd1279d
(assert (= (length (range 10)) 10) "(range 10)")
(assert (= (length (range 1 10)) 9) "(range 1 10)")
(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
# bc8be266f
@@ -754,7 +724,7 @@
(default name (string "has-key? " (++ test-has-key-auto)))
(assert (= expected (has-key? col key)) name)
(if
# guaranteed by `has-key?` to never fail
# guarenteed by `has-key?` to never fail
expected (in col key)
# if `has-key?` is false, then `in` should fail (for indexed types)
#
@@ -934,66 +904,4 @@
[:strict 3 4 "bar-oops"]])
"maclintf 2")
# Bad bytecode wrt. using result from break expression
(defn bytecode-roundtrip
[f]
(assert-no-error "bytecode round-trip" (unmarshal (marshal f make-image-dict))))
(defn case-1 [&] (def x (break 1)))
(bytecode-roundtrip case-1)
(defn foo [&])
(defn case-2 [&]
(foo (break (foo)))
(foo))
(bytecode-roundtrip case-2)
(defn case-3 [&]
(def x (break (do (foo)))))
(bytecode-roundtrip case-3)
(defn case-4 [&]
(def x (break (break (foo)))))
(bytecode-roundtrip case-4)
(defn case-4 [&]
(def x (break (break (break)))))
(bytecode-roundtrip case-4)
(defn case-5 []
(def foo (fn [one two] one))
(foo 100 200))
(bytecode-roundtrip case-5)
# Debug bytecode of these functions
# (pp (disasm case-1))
# (pp (disasm case-2))
# (pp (disasm case-3))
# Regression #1330
(defn regress-1330 [&]
(def a [1 2 3])
(def b [;a])
(identity a))
(assert (= [1 2 3] (regress-1330)) "regression 1330")
# Issue 1341
(assert (= () '() (macex '())) "macex ()")
(assert (= '[] (macex '[])) "macex []")
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
(setdyn *debug* true)
(def source '(defn a [x] (+ x x)))
(eval source)
(assert (= 20 (a 10)))
(assert (deep= (get (dyn 'a) :source-form) source))
(setdyn *debug* nil)
# issue #1516
(assert (assertf true) "assertf 1 argument")
(assert (assertf true "fun message") "assertf 2 arguments")
(assert (assertf true "%s message" "mystery") "assertf 3 arguments")
(assert (assertf (not nil) "%s message" "ordinary") "assertf not nil")
(assert-error "assertf error 1" (assertf false))
(assert-error "assertf error 2" (assertf false "fun message"))
(assert-error "assertf error 3" (assertf false "%s message" "mystery"))
(assert-error "assertf error 4" (assertf nil "%s %s" "alice" "bob"))
(end-suite)

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