mirror of
https://github.com/janet-lang/janet
synced 2025-10-28 06:07:43 +00:00
Compare commits
223 Commits
bundle-too
...
v1.38.0
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
73334f3485 | ||
|
|
a5b8da8d67 | ||
|
|
e8cccfced5 | ||
|
|
88984f7ffb | ||
|
|
182170b3be | ||
|
|
f92412841b | ||
|
|
18c00e89da | ||
|
|
7c38a55a9a | ||
|
|
a15916ec9c | ||
|
|
3583d4c92f | ||
|
|
a456c67a7b | ||
|
|
6e226e4073 | ||
|
|
d23e6614b1 | ||
|
|
ab6afa72fd | ||
|
|
9538b8a77c | ||
|
|
36d3804dd2 | ||
|
|
a34b8ea68f | ||
|
|
55c10f98bb | ||
|
|
4b5a2a14c0 | ||
|
|
665705d06d | ||
|
|
cc8cd4bace | ||
|
|
8f8b6ed001 | ||
|
|
aa9efee868 | ||
|
|
e0a0e2ed42 | ||
|
|
39f5c539d7 | ||
|
|
1b6437a4f8 | ||
|
|
c62c1a58f0 | ||
|
|
3441bcbd69 | ||
|
|
2e6001316a | ||
|
|
53bcc15207 | ||
|
|
dd609bb1bb | ||
|
|
5c56c7fa91 | ||
|
|
9a892363a3 | ||
|
|
5f550ea5d4 | ||
|
|
1b6cc023a5 | ||
|
|
410f8d69bc | ||
|
|
6da44bdb6a | ||
|
|
d30fd27575 | ||
|
|
1b278fc657 | ||
|
|
eecffe01a5 | ||
|
|
f63a33884f | ||
|
|
fa75a395cb | ||
|
|
1f34ec9902 | ||
|
|
f75c08a78e | ||
|
|
5e93f0e34b | ||
|
|
49f151e265 | ||
|
|
2b73a15ad8 | ||
|
|
06d581dde3 | ||
|
|
2b49903c82 | ||
|
|
a17ae977a5 | ||
|
|
8a6b44cb4e | ||
|
|
60d9f97750 | ||
|
|
f252933f62 | ||
|
|
6dbd7b476c | ||
|
|
a47eb847fb | ||
|
|
ba5990ef21 | ||
|
|
753911fe2d | ||
|
|
746ced5501 | ||
|
|
1b49934e4f | ||
|
|
682f0f584f | ||
|
|
611b2a6c3a | ||
|
|
8043caf581 | ||
|
|
b2d2690eb9 | ||
|
|
7f745a34c3 | ||
|
|
b16cf17246 | ||
|
|
67e8518ba6 | ||
|
|
e94e8dc484 | ||
|
|
1a24d4fc86 | ||
|
|
6ee05785d1 | ||
|
|
268ff666d2 | ||
|
|
91bb34c3bf | ||
|
|
17d5fb3210 | ||
|
|
687b987f7e | ||
|
|
4daecc9a41 | ||
|
|
a85eacadda | ||
|
|
ed63987fd1 | ||
|
|
ff173047f4 | ||
|
|
83e8aab289 | ||
|
|
85cb35e68f | ||
|
|
952906279c | ||
|
|
5b79b48ae0 | ||
|
|
7c44127bcb | ||
|
|
9338312103 | ||
|
|
a0eeb630e7 | ||
|
|
6535d72bd4 | ||
|
|
a7d424bc81 | ||
|
|
2bceba4a7a | ||
|
|
e3159bb0f5 | ||
|
|
5d1bd8a932 | ||
|
|
bafa6bfff0 | ||
|
|
e2eb7ab4b2 | ||
|
|
9f4497a5ae | ||
|
|
70de8bf092 | ||
|
|
e52575e23a | ||
|
|
10994cbc6a | ||
|
|
abad9d7db9 | ||
|
|
5e443cd29d | ||
|
|
7bf3a9d24c | ||
|
|
d80a7094ae | ||
|
|
ad77bc391c | ||
|
|
2b84fb14b4 | ||
|
|
07155ce657 | ||
|
|
046d28662d | ||
|
|
84dd3db620 | ||
|
|
282f2671ea | ||
|
|
3fc2be3e6e | ||
|
|
d10c1fe759 | ||
|
|
d18472b07d | ||
|
|
43a68dcd2a | ||
|
|
3d93028088 | ||
|
|
99f0af92bd | ||
|
|
71d81b14a2 | ||
|
|
3894f4021a | ||
|
|
72c659d1ee | ||
|
|
8f879b4adc | ||
|
|
18f2847dc1 | ||
|
|
89b7ff9daf | ||
|
|
26c263d6be | ||
|
|
2570e0f7a0 | ||
|
|
8084e4c728 | ||
|
|
ee90f9df62 | ||
|
|
906a982ace | ||
|
|
88e60c309c | ||
|
|
9694aee819 | ||
|
|
2697b0e425 | ||
|
|
c0d7a49b19 | ||
|
|
f9a6f52d9c | ||
|
|
c02c2e3f02 | ||
|
|
1fcd47dd7b | ||
|
|
384ee4f6a9 | ||
|
|
e9deec8231 | ||
|
|
2fc77a1b63 | ||
|
|
442fe8209d | ||
|
|
968a0dc4ac | ||
|
|
40c93d0786 | ||
|
|
83b0bc688c | ||
|
|
6185b253be | ||
|
|
17da53d0d9 | ||
|
|
9ffec43d2b | ||
|
|
e4f4a42751 | ||
|
|
4f65c2707e | ||
|
|
75bdea5155 | ||
|
|
f553c5da47 | ||
|
|
5f70a85f7e | ||
|
|
c82fd106a7 | ||
|
|
0e9b866b98 | ||
|
|
67a8c6df09 | ||
|
|
86cf8127b6 | ||
|
|
828e0a07cd | ||
|
|
90018b35c0 | ||
|
|
5a199716cb | ||
|
|
43ecd4f2d8 | ||
|
|
c5a9602be9 | ||
|
|
e88aab6d68 | ||
|
|
ce528251d5 | ||
|
|
9e334da2d6 | ||
|
|
c0e508e334 | ||
|
|
b63b3bef74 | ||
|
|
05d0b5ac05 | ||
|
|
c56d6e8fc1 | ||
|
|
33d2f9a522 | ||
|
|
e53d22fad2 | ||
|
|
33f55dc32f | ||
|
|
7e6aad2221 | ||
|
|
3c0c22259c | ||
|
|
42f6af4bf1 | ||
|
|
f274b02653 | ||
|
|
70c29b4e5d | ||
|
|
84d43d1039 | ||
|
|
5c67c1165d | ||
|
|
85028967d8 | ||
|
|
6ceff6ecc9 | ||
|
|
06eec06ff0 | ||
|
|
2dcc0adc0e | ||
|
|
8ca1e44af1 | ||
|
|
2aedc6beff | ||
|
|
af2eb06298 | ||
|
|
7ff545bd2e | ||
|
|
a59b5765b6 | ||
|
|
6bd58dd4c0 | ||
|
|
e3406cd922 | ||
|
|
ab70524d85 | ||
|
|
ce36c4c0d6 | ||
|
|
2b01b780da | ||
|
|
f3048a3d6b | ||
|
|
accac6c662 | ||
|
|
631622aa48 | ||
|
|
aaeaa3a944 | ||
|
|
d1104b5a65 | ||
|
|
1f074671ce | ||
|
|
872b39cc32 | ||
|
|
9eab57d194 | ||
|
|
8edd873c3e | ||
|
|
771956b5b6 | ||
|
|
ecc4da5113 | ||
|
|
f5555d21b9 | ||
|
|
342a29c7be | ||
|
|
368b891499 | ||
|
|
f62539ad55 | ||
|
|
4835ecb950 | ||
|
|
31f0ff0d84 | ||
|
|
b7b594205c | ||
|
|
190056b863 | ||
|
|
ae6b359109 | ||
|
|
3078686f8f | ||
|
|
0f4ecd93ab | ||
|
|
4af187d0ca | ||
|
|
a5d6b22838 | ||
|
|
fda0a081f5 | ||
|
|
94b7a69741 | ||
|
|
6518257129 | ||
|
|
dc325188d0 | ||
|
|
0b51ab157d | ||
|
|
f95de25b15 | ||
|
|
f424f2936b | ||
|
|
2d6c2ee7c0 | ||
|
|
7cd106a10c | ||
|
|
0d9e999113 | ||
|
|
75710ccabd | ||
|
|
0f60115f27 | ||
|
|
16a3c85baa | ||
|
|
92ff1d3be4 | ||
|
|
58441dc49f |
@@ -19,3 +19,8 @@ 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
|
||||
|
||||
7
.github/workflows/codeql.yml
vendored
7
.github/workflows/codeql.yml
vendored
@@ -27,15 +27,16 @@ jobs:
|
||||
uses: actions/checkout@v3
|
||||
|
||||
- name: Initialize CodeQL
|
||||
uses: github/codeql-action/init@v2
|
||||
uses: github/codeql-action/init@v3
|
||||
with:
|
||||
languages: ${{ matrix.language }}
|
||||
queries: +security-and-quality
|
||||
tools: linked
|
||||
|
||||
- name: Autobuild
|
||||
uses: github/codeql-action/autobuild@v2
|
||||
uses: github/codeql-action/autobuild@v3
|
||||
|
||||
- name: Perform CodeQL Analysis
|
||||
uses: github/codeql-action/analyze@v2
|
||||
uses: github/codeql-action/analyze@v3
|
||||
with:
|
||||
category: "/language:${{ matrix.language }}"
|
||||
|
||||
31
.github/workflows/release.yml
vendored
31
.github/workflows/release.yml
vendored
@@ -17,7 +17,7 @@ jobs:
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ ubuntu-latest, macos-latest ]
|
||||
os: [ ubuntu-latest, macos-13 ]
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
@@ -39,6 +39,35 @@ 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
|
||||
|
||||
61
.github/workflows/test.yml
vendored
61
.github/workflows/test.yml
vendored
@@ -12,7 +12,7 @@ jobs:
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ ubuntu-latest, macos-latest ]
|
||||
os: [ ubuntu-latest, macos-latest, macos-13 ]
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
@@ -23,7 +23,10 @@ jobs:
|
||||
|
||||
test-windows:
|
||||
name: Build and test on Windows
|
||||
runs-on: windows-latest
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ windows-latest, windows-2019 ]
|
||||
runs-on: ${{ matrix.os }}
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
@@ -35,28 +38,61 @@ jobs:
|
||||
- name: Test the project
|
||||
shell: cmd
|
||||
run: build_win test
|
||||
- name: Test installer build
|
||||
shell: cmd
|
||||
run: build_win dist
|
||||
|
||||
test-windows-min:
|
||||
name: Build and test on Windows Minimal build
|
||||
strategy:
|
||||
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 (no test yet)
|
||||
name: Build on Windows with Mingw
|
||||
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: UCRT64
|
||||
msystem: ${{ matrix.msystem }}
|
||||
update: true
|
||||
install: >-
|
||||
base-devel
|
||||
git
|
||||
gcc
|
||||
- name: Build the project
|
||||
- name: Build
|
||||
shell: cmd
|
||||
run: make -j4 CC=gcc JANET_NO_AMALG=1
|
||||
run: make -j4 CC=gcc
|
||||
- name: Test
|
||||
shell: cmd
|
||||
run: make -j4 CC=gcc test
|
||||
|
||||
test-mingw-linux:
|
||||
name: Build and test with Mingw on Linux + Wine
|
||||
@@ -86,6 +122,17 @@ jobs:
|
||||
sudo apt-get update
|
||||
sudo apt-get install gcc-arm-linux-gnueabi qemu-user
|
||||
- name: Compile the project
|
||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
|
||||
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-latest
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Enable qemu
|
||||
run: docker run --privileged --rm tonistiigi/binfmt --install s390x
|
||||
- name: Build and run on emulated architecture
|
||||
run: docker run --rm -v .:/janet --platform linux/s390x alpine sh -c "apk update && apk add --no-interactive git build-base && cd /janet && make -j3 && make test"
|
||||
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -49,6 +49,7 @@ janet.wasm
|
||||
*.gen.h
|
||||
*.gen.c
|
||||
*.tmp
|
||||
temp.*
|
||||
|
||||
# Generate test files
|
||||
*.out
|
||||
|
||||
63
CHANGELOG.md
63
CHANGELOG.md
@@ -1,7 +1,58 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
## 1.38.0 - 2025-03-18
|
||||
- Add `bundle/replace`
|
||||
- Add CLI flags for the `bundle/` module to install and manage bundles.
|
||||
- Improve `?` peg special termination behavior
|
||||
- Add IEEE hex floats to grammar.
|
||||
- Add buffer peg literal support
|
||||
- Improve `split` peg special edge case behavior
|
||||
- Add Arm64 .msi support
|
||||
- Add `no-reuse` argument to `net/listen` to disable reusing server sockets
|
||||
- Add `struct/rawget`
|
||||
- Fix `deep=` and `deep-not=` to better handle degenerate cases with mutable table keys
|
||||
- Long strings will now dedent on `\r\n` instead of just `\n`.
|
||||
- Add `ev/to-file` for synchronous resource operations
|
||||
- Improve `file/open` error message by including path
|
||||
|
||||
## 1.37.1 - 2024-12-05
|
||||
- Fix meson cross compilation
|
||||
- Update timeout documentation for networking APIs: timeouts raise errors and do not return nil.
|
||||
- Add `janet_addtimeout_nil(double sec);` to the C API.
|
||||
- Change string hashing.
|
||||
- Fix string equality bug.
|
||||
- Add `assertf`
|
||||
- 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.
|
||||
@@ -113,7 +164,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` sigals to `:interrupt` and `:await`
|
||||
- Change the names of `:user8` and `:user9` signals 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.
|
||||
@@ -284,7 +335,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_interupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
|
||||
- Add `janet_interpreter_interrupt` 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
|
||||
@@ -338,7 +389,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 occured in deeply nested fibers
|
||||
- Fix a fiber bug that occurred in deeply nested fibers
|
||||
- Add `unref` combinator to pegs.
|
||||
- Small docstring changes.
|
||||
|
||||
@@ -488,13 +539,13 @@ saving and restoring the entire VM state.
|
||||
- Add `symbol/slice`
|
||||
- Add `keyword/slice`
|
||||
- Allow cross compilation with Makefile.
|
||||
- Change `compare-primitve` to `cmp` and make it more efficient.
|
||||
- Change `compare-primitive` 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 hexidecimal digits.
|
||||
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexadecimal digits.
|
||||
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
|
||||
|
||||
## 1.10.1 - 2020-06-18
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
||||
Copyright (c) 2023 Calvin Rose and contributors
|
||||
Copyright (c) 2025 Calvin Rose and contributors
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||||
this software and associated documentation files (the "Software"), to deal in
|
||||
|
||||
26
Makefile
26
Makefile
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -43,6 +43,7 @@ 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,
|
||||
@@ -56,6 +57,7 @@ LDFLAGS?=-rdynamic
|
||||
LIBJANET_LDFLAGS?=$(LD_FLAGS)
|
||||
RUN:=$(RUN)
|
||||
|
||||
|
||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
|
||||
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||
@@ -93,12 +95,18 @@ endif
|
||||
endif
|
||||
|
||||
# Mingw
|
||||
MINGW_COMPILER=
|
||||
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
||||
MINGW_COMPILER=gcc
|
||||
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
|
||||
COMPILER_VERSION:=$(shell $(CC) --version)
|
||||
ifeq ($(findstring clang,$(COMPILER_VERSION)), clang)
|
||||
MINGW_COMPILER=clang
|
||||
endif
|
||||
endif
|
||||
|
||||
|
||||
@@ -139,6 +147,7 @@ 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 \
|
||||
@@ -204,9 +213,14 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
||||
########################
|
||||
|
||||
ifeq ($(UNAME), Darwin)
|
||||
SONAME=libjanet.1.34.dylib
|
||||
SONAME=libjanet.1.38.dylib
|
||||
else
|
||||
SONAME=libjanet.so.1.34
|
||||
SONAME=libjanet.so.1.38
|
||||
endif
|
||||
|
||||
ifeq ($(MINGW_COMPILER), clang)
|
||||
SONAME=
|
||||
SONAME_SETTER=
|
||||
endif
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
@@ -358,6 +372,12 @@ 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'
|
||||
|
||||
13
README.md
13
README.md
@@ -1,4 +1,4 @@
|
||||
[](https://gitter.im/janet-language/community)
|
||||
[](https://janet.zulipchat.com)
|
||||
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
|
||||
@@ -18,9 +18,6 @@ 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
|
||||
@@ -210,7 +207,7 @@ Alternatively, install the package directly with `pkgin install janet`.
|
||||
|
||||
To build an `.msi` installer executable, in addition to the above steps, you will have to:
|
||||
|
||||
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
|
||||
5. Install, or otherwise add to your PATH the [WiX 3.14 Toolset](https://github.com/wixtoolset/wix3/releases).
|
||||
6. Run `build_win dist`.
|
||||
|
||||
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
|
||||
@@ -253,8 +250,10 @@ Emacs, and Atom each have syntax packages for the Janet language, though.
|
||||
|
||||
## Installation
|
||||
|
||||
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.
|
||||
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.
|
||||
|
||||
## Usage
|
||||
|
||||
|
||||
@@ -50,6 +50,7 @@ for %%f in (src\boot\*.c) do (
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if not errorlevel 0 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
|
||||
@@ -59,6 +60,7 @@ build\janet_boot . > build\c\janet.c
|
||||
|
||||
@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
|
||||
@@ -89,7 +91,7 @@ exit /b 0
|
||||
|
||||
@rem Clean build artifacts
|
||||
:CLEAN
|
||||
del *.exe *.lib *.exp
|
||||
del *.exe *.lib *.exp *.msi *.wixpdb
|
||||
rd /s /q build
|
||||
if exist dist (
|
||||
rd /s /q dist
|
||||
@@ -119,7 +121,6 @@ copy README.md dist\README.md
|
||||
|
||||
copy janet.lib dist\janet.lib
|
||||
copy janet.exp dist\janet.exp
|
||||
copy janet.def dist\janet.def
|
||||
|
||||
janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h
|
||||
copy build\janet.h dist\janet.h
|
||||
@@ -137,11 +138,18 @@ if defined APPVEYOR_REPO_TAG_NAME (
|
||||
set RELEASE_VERSION=%JANET_VERSION%
|
||||
)
|
||||
if defined CI (
|
||||
set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\"
|
||||
set WIXBIN="%WIX%bin\"
|
||||
echo WIXBIN = %WIXBIN%
|
||||
) else (
|
||||
set WIXBIN=
|
||||
)
|
||||
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\
|
||||
|
||||
set WIXARCH=%BUILDARCH%
|
||||
if "%WIXARCH%"=="aarch64" (
|
||||
set WIXARCH=arm64
|
||||
)
|
||||
|
||||
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %WIXARCH% -out build\
|
||||
%WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi
|
||||
exit /b 0
|
||||
|
||||
|
||||
35
examples/chatserver.janet
Normal file
35
examples/chatserver.janet
Normal file
@@ -0,0 +1,35 @@
|
||||
(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)))
|
||||
@@ -35,6 +35,11 @@ typedef struct {
|
||||
int c;
|
||||
} intintint;
|
||||
|
||||
typedef struct {
|
||||
uint64_t a;
|
||||
uint64_t b;
|
||||
} uint64pair;
|
||||
|
||||
typedef struct {
|
||||
int64_t a;
|
||||
int64_t b;
|
||||
@@ -203,3 +208,20 @@ 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;
|
||||
}
|
||||
|
||||
@@ -8,11 +8,13 @@
|
||||
|
||||
(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 "-shared" "-o" ffi/loc] :px))
|
||||
(os/execute ["cc" ffi/source-loc "-g" "-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))
|
||||
@@ -55,6 +57,13 @@
|
||||
(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])
|
||||
|
||||
#
|
||||
@@ -132,5 +141,10 @@
|
||||
(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.")
|
||||
|
||||
1
examples/sample-bad-bundle/badmod.janet
Normal file
1
examples/sample-bad-bundle/badmod.janet
Normal file
@@ -0,0 +1 @@
|
||||
(def abc 123)
|
||||
7
examples/sample-bad-bundle/bundle.janet
Normal file
7
examples/sample-bad-bundle/bundle.janet
Normal file
@@ -0,0 +1,7 @@
|
||||
(defn install
|
||||
[manifest &]
|
||||
(bundle/add-file manifest "badmod.janet"))
|
||||
|
||||
(defn check
|
||||
[&]
|
||||
(error "Check failed!"))
|
||||
1
examples/sample-bundle-aliases/aliases-mod.janet
Normal file
1
examples/sample-bundle-aliases/aliases-mod.janet
Normal file
@@ -0,0 +1 @@
|
||||
(defn fun [x] (range x))
|
||||
3
examples/sample-bundle-aliases/bundle.janet
Normal file
3
examples/sample-bundle-aliases/bundle.janet
Normal file
@@ -0,0 +1,3 @@
|
||||
(defn install
|
||||
[manifest &]
|
||||
(bundle/add-file manifest "aliases-mod.janet"))
|
||||
4
examples/sample-bundle-aliases/info.jdn
Normal file
4
examples/sample-bundle-aliases/info.jdn
Normal file
@@ -0,0 +1,4 @@
|
||||
@{
|
||||
:name "sample-bundle-aliases"
|
||||
:dependencies ["sample-dep1" "sample-dep2"]
|
||||
}
|
||||
3
janet.1
3
janet.1
@@ -255,7 +255,8 @@ 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.
|
||||
the default location set at compile time. This should be a list of as well as a colon
|
||||
separate list of such directories.
|
||||
.RE
|
||||
|
||||
.B JANET_PROFILE
|
||||
|
||||
44
meson.build
44
meson.build
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose and contributors
|
||||
# Copyright (c) 2025 Calvin Rose and contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,16 +20,34 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.34.0')
|
||||
version : '1.38.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet')
|
||||
|
||||
# Link math library on all systems
|
||||
# Compilers
|
||||
cc = meson.get_compiler('c')
|
||||
native_cc = meson.get_compiler('c', native : true)
|
||||
|
||||
# Native deps
|
||||
native_m_dep = native_cc.find_library('m', required : false)
|
||||
native_dl_dep = native_cc.find_library('dl', required : false)
|
||||
native_android_spawn_dep = native_cc.find_library('android-spawn', required : false)
|
||||
native_thread_dep = dependency('threads', native : true)
|
||||
|
||||
# Deps
|
||||
m_dep = cc.find_library('m', required : false)
|
||||
dl_dep = cc.find_library('dl', required : false)
|
||||
|
||||
# for MINGW/MSYS2
|
||||
native_ws2_dep = native_cc.find_library('ws2_32', required: false)
|
||||
native_psapi_dep = native_cc.find_library('psapi', required: false)
|
||||
native_wsock_dep = native_cc.find_library('wsock32', required: false)
|
||||
ws2_dep = cc.find_library('ws2_32', required: false)
|
||||
psapi_dep = cc.find_library('psapi', required: false)
|
||||
wsock_dep = cc.find_library('wsock32', required: false)
|
||||
|
||||
android_spawn_dep = cc.find_library('android-spawn', required : false)
|
||||
thread_dep = dependency('threads')
|
||||
|
||||
@@ -79,6 +97,7 @@ 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'))
|
||||
@@ -122,6 +141,7 @@ 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',
|
||||
@@ -162,11 +182,18 @@ mainclient_src = [
|
||||
'src/mainclient/shell.c'
|
||||
]
|
||||
|
||||
janet_dependencies = [m_dep, dl_dep, android_spawn_dep, ws2_dep, psapi_dep, wsock_dep]
|
||||
janet_native_dependencies = [native_m_dep, native_dl_dep, native_android_spawn_dep, native_ws2_dep, native_psapi_dep, native_wsock_dep]
|
||||
if not get_option('single_threaded')
|
||||
janet_dependencies += thread_dep
|
||||
janet_native_dependencies += native_thread_dep
|
||||
endif
|
||||
|
||||
# Build boot binary
|
||||
janet_boot = executable('janet-boot', core_src, boot_src,
|
||||
include_directories : incdir,
|
||||
c_args : '-DJANET_BOOTSTRAP',
|
||||
dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep],
|
||||
dependencies : janet_native_dependencies,
|
||||
native : true)
|
||||
|
||||
# Build janet.c
|
||||
@@ -179,11 +206,6 @@ janetc = custom_target('janetc',
|
||||
'JANET_PATH', janet_path
|
||||
])
|
||||
|
||||
janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
|
||||
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']
|
||||
@@ -229,7 +251,7 @@ if meson.is_cross_build()
|
||||
endif
|
||||
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
dependencies : janet_native_dependencies,
|
||||
c_args : extra_native_cflags,
|
||||
native : true)
|
||||
else
|
||||
@@ -257,6 +279,7 @@ 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',
|
||||
@@ -271,6 +294,7 @@ 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'
|
||||
|
||||
@@ -22,6 +22,7 @@ option('kqueue', type : 'boolean', value : true)
|
||||
option('interpreter_interrupt', type : 'boolean', value : true)
|
||||
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)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2024 © Calvin Rose
|
||||
# Copyright 2025 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@@ -39,6 +39,7 @@
|
||||
(buffer/format buf "%j" (in args index))
|
||||
(set index (+ index 1)))
|
||||
(array/push modifiers (string buf ")\n\n" docstr))
|
||||
(if (dyn :debug) (array/push modifiers {:source-form (dyn :macro-form)}))
|
||||
# Build return value
|
||||
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
|
||||
|
||||
@@ -116,7 +117,7 @@
|
||||
(defn nil? "Check if x is nil." [x] (= x nil))
|
||||
(defn empty? "Check if xs is empty." [xs] (= nil (next xs nil)))
|
||||
|
||||
# For macros, we define an imcomplete odd? function that will be overriden.
|
||||
# For macros, we define an incomplete odd? function that will be overridden.
|
||||
(defn odd? [x] (= 1 (mod x 2)))
|
||||
|
||||
(def- non-atomic-types
|
||||
@@ -153,11 +154,66 @@
|
||||
,v
|
||||
(,error ,(if err err (string/format "assert failure in %j" x))))))
|
||||
|
||||
(defmacro defdyn
|
||||
``Define an alias for a keyword that is used as a dynamic binding. The
|
||||
alias is a normal, lexically scoped binding that can be used instead of
|
||||
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
|
||||
replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
|
||||
called "earmuffs".``
|
||||
[alias & more]
|
||||
(assert (symbol? alias) "alias must be a symbol")
|
||||
(assert (> (length alias) 2) "name must have leading and trailing '*' characters")
|
||||
(assert (= 42 (get alias 0) (get alias (- (length alias) 1))) "name must have leading and trailing '*' characters")
|
||||
(def prefix (dyn :defdyn-prefix))
|
||||
(def kw (keyword prefix (slice alias 1 -2)))
|
||||
~(def ,alias :dyn ,;more ,kw))
|
||||
|
||||
(defdyn *macro-form*
|
||||
"Inside a macro, is bound to the source form that invoked the macro")
|
||||
|
||||
(defdyn *lint-error*
|
||||
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
|
||||
|
||||
(defdyn *lint-warn*
|
||||
"The current lint warning level. The warning level is the lint level at which and error will be printed but compilation will continue as normal.")
|
||||
|
||||
(defdyn *lint-levels*
|
||||
"A table of keyword alias to numbers denoting a lint level. Can be used to provided custom aliases for numeric lint levels.")
|
||||
|
||||
(defdyn *macro-lints*
|
||||
``Bound to an array of lint messages that will be reported by the compiler inside a macro.
|
||||
To indicate an error or warning, a macro author should use `maclintf`.``)
|
||||
|
||||
(defn maclintf
|
||||
``When inside a macro, call this function to add a linter warning. Takes
|
||||
a `fmt` argument like `string/format`, which is used to format the message.``
|
||||
[level fmt & args]
|
||||
(def lints (dyn *macro-lints*))
|
||||
(if lints
|
||||
(do
|
||||
(def form (dyn *macro-form*))
|
||||
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
|
||||
(def l (if (not= -1 l) l))
|
||||
(def c (if (not= -1 c) c))
|
||||
(def msg (string/format fmt ;args))
|
||||
(array/push lints [level l c msg])))
|
||||
nil)
|
||||
|
||||
(defn errorf
|
||||
"A combination of `error` and `string/format`. Equivalent to `(error (string/format fmt ;args))`."
|
||||
[fmt & args]
|
||||
(error (string/format fmt ;args)))
|
||||
|
||||
(defmacro assertf
|
||||
"Convenience macro that combines `assert` and `string/format`."
|
||||
[x fmt & args]
|
||||
(def v (gensym))
|
||||
~(do
|
||||
(def ,v ,x)
|
||||
(if ,v
|
||||
,v
|
||||
(,errorf ,fmt ,;args))))
|
||||
|
||||
(defmacro default
|
||||
``Define a default value for an optional argument.
|
||||
Expands to `(def sym (if (= nil sym) val sym))`.``
|
||||
@@ -531,6 +587,11 @@
|
||||
[x ds & body]
|
||||
(each-template x ds :each body))
|
||||
|
||||
(defn- check-empty-body
|
||||
[body]
|
||||
(if (= (length body) 0)
|
||||
(maclintf :normal "empty loop body")))
|
||||
|
||||
(defmacro loop
|
||||
```
|
||||
A general purpose loop macro. This macro is similar to the Common Lisp loop
|
||||
@@ -609,6 +670,7 @@
|
||||
See `loop` for details.``
|
||||
[head & body]
|
||||
(def $accum (gensym))
|
||||
(check-empty-body body)
|
||||
~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
|
||||
|
||||
(defmacro catseq
|
||||
@@ -616,6 +678,7 @@
|
||||
See `loop` for details.``
|
||||
[head & body]
|
||||
(def $accum (gensym))
|
||||
(check-empty-body body)
|
||||
~(do (def ,$accum @[]) (loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
|
||||
|
||||
(defmacro tabseq
|
||||
@@ -629,6 +692,7 @@
|
||||
``Create a generator expression using the `loop` syntax. Returns a fiber
|
||||
that yields all values inside the loop in order. See `loop` for details.``
|
||||
[head & body]
|
||||
(check-empty-body body)
|
||||
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
|
||||
|
||||
(defmacro coro
|
||||
@@ -658,6 +722,19 @@
|
||||
(each x xs (+= accum x) (++ total))
|
||||
(/ accum total))))
|
||||
|
||||
(defn geomean
|
||||
"Returns the geometric mean of xs. If empty, returns NaN."
|
||||
[xs]
|
||||
(if (lengthable? xs)
|
||||
(do
|
||||
(var accum 0)
|
||||
(each x xs (+= accum (math/log x)))
|
||||
(math/exp (/ accum (length xs))))
|
||||
(do
|
||||
(var [accum total] [0 0])
|
||||
(each x xs (+= accum (math/log x)) (++ total))
|
||||
(math/exp (/ accum total)))))
|
||||
|
||||
(defn product
|
||||
"Returns the product of xs. If xs is empty, returns 1."
|
||||
[xs]
|
||||
@@ -766,11 +843,21 @@
|
||||
|
||||
(defmacro- do-compare
|
||||
[x y]
|
||||
~(if (def f (get ,x :compare))
|
||||
(f ,x ,y)
|
||||
(if (def f (get ,y :compare))
|
||||
(- (f ,y ,x))
|
||||
(cmp ,x ,y))))
|
||||
(def f (gensym))
|
||||
(def f-res (gensym))
|
||||
(def g (gensym))
|
||||
(def g-res (gensym))
|
||||
~(do
|
||||
(def ,f (,get ,x :compare))
|
||||
(def ,f-res (if ,f (,f ,x ,y)))
|
||||
(if ,f-res
|
||||
,f-res
|
||||
(do
|
||||
(def ,g (,get ,y :compare))
|
||||
(def ,g-res (if ,g (,- (,g ,y ,x))))
|
||||
(if ,g-res
|
||||
,g-res
|
||||
(,cmp ,x ,y))))))
|
||||
|
||||
(defn compare
|
||||
``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
|
||||
@@ -909,7 +996,7 @@
|
||||
|
||||
(defn reduce2
|
||||
``The 2-argument version of `reduce` that does not take an initialization value.
|
||||
Instead, the first element of the array is used for initialization.``
|
||||
Instead, the first element of the array is used for initialization. If `ind` is empty, will evaluate to nil.``
|
||||
[f ind]
|
||||
(var k (next ind))
|
||||
(if (= nil k) (break nil))
|
||||
@@ -1207,19 +1294,6 @@
|
||||
(array/push parts (tuple apply f $args)))
|
||||
(tuple 'fn :juxt (tuple '& $args) (tuple/slice parts 0)))
|
||||
|
||||
(defmacro defdyn
|
||||
``Define an alias for a keyword that is used as a dynamic binding. The
|
||||
alias is a normal, lexically scoped binding that can be used instead of
|
||||
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
|
||||
replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
|
||||
called "earmuffs".``
|
||||
[alias & more]
|
||||
(assert (symbol? alias) "alias must be a symbol")
|
||||
(assert (and (> (length alias) 2) (= 42 (first alias) (last alias))) "name must have leading and trailing '*' characters")
|
||||
(def prefix (dyn :defdyn-prefix))
|
||||
(def kw (keyword prefix (slice alias 1 -2)))
|
||||
~(def ,alias :dyn ,;more ,kw))
|
||||
|
||||
(defn has-key?
|
||||
"Check if a data structure `ds` contains the key `key`."
|
||||
[ds key]
|
||||
@@ -1237,21 +1311,9 @@
|
||||
(defdyn *redef* "When set, allow dynamically rebinding top level defs. Will slow generated code and is intended to be used for development.")
|
||||
(defdyn *debug* "Enables a built in debugger on errors and other useful features for debugging in a repl.")
|
||||
(defdyn *exit* "When set, will cause the current context to complete. Can be set to exit from repl (or file), for example.")
|
||||
(defdyn *exit-value* "Set the return value from `run-context` upon an exit. By default, `run-context` will return nil.")
|
||||
(defdyn *exit-value* "Set the return value from `run-context` upon an exit.")
|
||||
(defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrency control.")
|
||||
|
||||
(defdyn *macro-form*
|
||||
"Inside a macro, is bound to the source form that invoked the macro")
|
||||
|
||||
(defdyn *lint-error*
|
||||
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
|
||||
|
||||
(defdyn *lint-warn*
|
||||
"The current lint warning level. The warning level is the lint level at which and error will be printed but compilation will continue as normal.")
|
||||
|
||||
(defdyn *lint-levels*
|
||||
"A table of keyword alias to numbers denoting a lint level. Can be used to provided custom aliases for numeric lint levels.")
|
||||
|
||||
(defdyn *current-file*
|
||||
"Bound to the name of the currently compiling file.")
|
||||
|
||||
@@ -1801,6 +1863,9 @@
|
||||
(defdyn *pretty-format*
|
||||
"Format specifier for the `pp` function")
|
||||
|
||||
(defdyn *repl-prompt*
|
||||
"Allow setting a custom prompt at the default REPL. Not all REPLs will respect this binding.")
|
||||
|
||||
(defn pp
|
||||
``Pretty-print to stdout or `(dyn *out*)`. The format string used is `(dyn *pretty-format* "%q")`.``
|
||||
[x]
|
||||
@@ -2035,24 +2100,6 @@
|
||||
###
|
||||
###
|
||||
|
||||
(defdyn *macro-lints*
|
||||
``Bound to an array of lint messages that will be reported by the compiler inside a macro.
|
||||
To indicate an error or warning, a macro author should use `maclintf`.``)
|
||||
|
||||
(defn maclintf
|
||||
``When inside a macro, call this function to add a linter warning. Takes
|
||||
a `fmt` argument like `string/format`, which is used to format the message.``
|
||||
[level fmt & args]
|
||||
(def lints (dyn *macro-lints*))
|
||||
(when lints
|
||||
(def form (dyn *macro-form*))
|
||||
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
|
||||
(def l (if-not (= -1 l) l))
|
||||
(def c (if-not (= -1 c) c))
|
||||
(def msg (string/format fmt ;args))
|
||||
(array/push lints [level l c msg]))
|
||||
nil)
|
||||
|
||||
(defn macex1
|
||||
``Expand macros in a form, but do not recursively expand macros.
|
||||
See `macex` docs for info on `on-binding`.``
|
||||
@@ -2172,56 +2219,31 @@
|
||||
(map-template :some res pred ind inds)
|
||||
res)
|
||||
|
||||
(defn deep-not=
|
||||
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
|
||||
equal if they have identical structure. Much slower than `not=`.``
|
||||
[x y]
|
||||
(def tx (type x))
|
||||
(or
|
||||
(not= tx (type y))
|
||||
(case tx
|
||||
:tuple (or (not= (length x) (length y))
|
||||
(do
|
||||
(var ret false)
|
||||
(forv i 0 (length x)
|
||||
(def xx (in x i))
|
||||
(def yy (in y i))
|
||||
(if (deep-not= xx yy)
|
||||
(break (set ret true))))
|
||||
ret))
|
||||
:array (or (not= (length x) (length y))
|
||||
(do
|
||||
(var ret false)
|
||||
(forv i 0 (length x)
|
||||
(def xx (in x i))
|
||||
(def yy (in y i))
|
||||
(if (deep-not= xx yy)
|
||||
(break (set ret true))))
|
||||
ret))
|
||||
:struct (deep-not= (kvs x) (kvs y))
|
||||
:table (deep-not= (table/to-struct x) (table/to-struct y))
|
||||
:buffer (not= (string x) (string y))
|
||||
(not= x y))))
|
||||
|
||||
(defn deep=
|
||||
``Like `=`, but mutable types (arrays, tables, buffers) are considered
|
||||
equal if they have identical structure. Much slower than `=`.``
|
||||
[x y]
|
||||
(not (deep-not= x y)))
|
||||
|
||||
(defn freeze
|
||||
`Freeze an object (make it immutable) and do a deep copy, making
|
||||
child values also immutable. Closures, fibers, and abstract types
|
||||
will not be recursively frozen, but all other types will.`
|
||||
[x]
|
||||
(case (type x)
|
||||
:array (tuple/slice (map freeze x))
|
||||
:tuple (tuple/slice (map freeze x))
|
||||
:table (if-let [p (table/getproto x)]
|
||||
(freeze (merge (table/clone p) x))
|
||||
(struct ;(map freeze (kvs x))))
|
||||
:struct (struct ;(map freeze (kvs x)))
|
||||
:buffer (string x)
|
||||
(def tx (type x))
|
||||
(cond
|
||||
(or (= tx :array) (= tx :tuple))
|
||||
(tuple/slice (map freeze x))
|
||||
|
||||
(or (= tx :table) (= tx :struct))
|
||||
(let [temp-tab @{}]
|
||||
# Handle multiple unique keys that freeze. Result should
|
||||
# be independent of iteration order.
|
||||
(eachp [k v] x
|
||||
(def kk (freeze k))
|
||||
(def vv (freeze v))
|
||||
(def old (get temp-tab kk))
|
||||
(def new (if (= nil old) vv (max vv old)))
|
||||
(put temp-tab kk new))
|
||||
(table/to-struct temp-tab (freeze (getproto x))))
|
||||
|
||||
(= tx :buffer)
|
||||
(string x)
|
||||
|
||||
x))
|
||||
|
||||
(defn thaw
|
||||
@@ -2237,6 +2259,41 @@
|
||||
:string (buffer ds)
|
||||
ds))
|
||||
|
||||
(defn deep-not=
|
||||
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
|
||||
equal if they have identical structure. Much slower than `not=`.``
|
||||
[x y]
|
||||
(def tx (type x))
|
||||
(or
|
||||
(not= tx (type y))
|
||||
(cond
|
||||
(or (= tx :tuple) (= tx :array))
|
||||
(or (not= (length x) (length y))
|
||||
(do
|
||||
(var ret false)
|
||||
(forv i 0 (length x)
|
||||
(def xx (in x i))
|
||||
(def yy (in y i))
|
||||
(if (deep-not= xx yy)
|
||||
(break (set ret true))))
|
||||
ret))
|
||||
(or (= tx :struct) (= tx :table))
|
||||
(or (not= (length x) (length y))
|
||||
(do
|
||||
(def rawget (if (= tx :struct) struct/rawget table/rawget))
|
||||
(var ret false)
|
||||
(eachp [k v] x
|
||||
(if (deep-not= (rawget y k) v) (break (set ret true))))
|
||||
ret))
|
||||
(= tx :buffer) (not= 0 (- (length x) (length y)) (memcmp x y))
|
||||
(not= x y))))
|
||||
|
||||
(defn deep=
|
||||
``Like `=`, but mutable types (arrays, tables, buffers) are considered
|
||||
equal if they have identical structure. Much slower than `=`.``
|
||||
[x y]
|
||||
(not (deep-not= x y)))
|
||||
|
||||
(defn macex
|
||||
``Expand macros completely.
|
||||
`on-binding` is an optional callback for whenever a normal symbolic binding
|
||||
@@ -2288,17 +2345,11 @@
|
||||
|
||||
(defmacro short-fn
|
||||
```
|
||||
Shorthand for `fn`. Arguments are given as `$n`, where `n` is the 0-indexed
|
||||
argument of the function. `$` is also an alias for the first (index 0) argument.
|
||||
The `$&` symbol will make the anonymous function variadic if it appears in the
|
||||
body of the function, and can be combined with positional arguments.
|
||||
|
||||
Example usage:
|
||||
|
||||
(short-fn (+ $ $)) # A function that doubles its arguments.
|
||||
(short-fn (string $0 $1)) # accepting multiple args.
|
||||
|(+ $ $) # use pipe reader macro for terse function literals.
|
||||
|(+ $&) # variadic functions
|
||||
Shorthand for `fn`. Arguments are given as `$n`, where `n` is the
|
||||
0-indexed argument of the function. `$` is also an alias for the
|
||||
first (index 0) argument. The `$&` symbol will make the anonymous
|
||||
function variadic if it appears in the body of the function, and
|
||||
can be combined with positional arguments.
|
||||
```
|
||||
[arg &opt name]
|
||||
(var max-param-seen -1)
|
||||
@@ -2618,7 +2669,6 @@
|
||||
|
||||
(do
|
||||
(var pindex 0)
|
||||
(var pstatus nil)
|
||||
(def len (length buf))
|
||||
(when (= len 0)
|
||||
(:eof p)
|
||||
@@ -2654,7 +2704,7 @@
|
||||
|
||||
(defn eval
|
||||
``Evaluates a form in the current environment. If more control over the
|
||||
environment is needed, use `run-context`.``
|
||||
environment is needed, use `run-context`. Optionally pass in an `env` table with available bindings.``
|
||||
[form &opt env]
|
||||
(def res (compile form env :eval))
|
||||
(if (= (type res) :function)
|
||||
@@ -2694,7 +2744,7 @@
|
||||
|
||||
(defn eval-string
|
||||
``Evaluates a string in the current environment. If more control over the
|
||||
environment is needed, use `run-context`.``
|
||||
environment is needed, use `run-context`. Optionally pass in an `env` table with available bindings.``
|
||||
[str &opt env]
|
||||
(var ret nil)
|
||||
(each x (parse-all str) (set ret (eval x env)))
|
||||
@@ -2746,8 +2796,8 @@
|
||||
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
||||
|
||||
(defdyn *module-cache* "Dynamic binding for overriding `module/cache`")
|
||||
(defdyn *module-paths* "Dynamic binding for overriding `module/cache`")
|
||||
(defdyn *module-loading* "Dynamic binding for overriding `module/cache`")
|
||||
(defdyn *module-paths* "Dynamic binding for overriding `module/paths`")
|
||||
(defdyn *module-loading* "Dynamic binding for overriding `module/loading`")
|
||||
(defdyn *module-loaders* "Dynamic binding for overriding `module/loaders`")
|
||||
(defdyn *module-make-env* "Dynamic binding for creating new environments for `import`, `require`, and `dofile`. Overrides `make-env`.")
|
||||
|
||||
@@ -2793,6 +2843,24 @@
|
||||
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
|
||||
mp)
|
||||
|
||||
# Don't expose this externally yet - could break if custom module/paths is setup.
|
||||
(defn- module/add-syspath
|
||||
```
|
||||
Add a custom syspath to `module/paths` by duplicating all entries that being with `:sys:` and
|
||||
adding duplicates with a specific path prefix instead.
|
||||
```
|
||||
[path]
|
||||
(def copies @[])
|
||||
(var last-index 0)
|
||||
(def mp (dyn *module-paths* module/paths))
|
||||
(eachp [index entry] mp
|
||||
(def pattern (first entry))
|
||||
(when (and (string? pattern) (string/has-prefix? ":sys:/" pattern))
|
||||
(set last-index index)
|
||||
(array/push copies [(string/replace ":sys:" path pattern) ;(drop 1 entry)])))
|
||||
(array/insert mp (+ 1 last-index) ;copies)
|
||||
mp)
|
||||
|
||||
(module/add-paths ":native:" :native)
|
||||
(module/add-paths "/init.janet" :source)
|
||||
(module/add-paths ".janet" :source)
|
||||
@@ -3040,9 +3108,10 @@
|
||||
``Merge a module source into the `target` environment with a `prefix`, as with the `import` macro.
|
||||
This lets users emulate the behavior of `import` with a custom module table.
|
||||
If `export` is truthy, then merged functions are not marked as private. Returns
|
||||
the modified target environment.``
|
||||
[target source &opt prefix export]
|
||||
(loop [[k v] :pairs source :when (symbol? k) :when (not (v :private))]
|
||||
the modified target environment. If a tuple or array `only` is passed, only merge keys in `only`.``
|
||||
[target source &opt prefix export only]
|
||||
(def only-set (if only (invert only)))
|
||||
(loop [[k v] :pairs source :when (symbol? k) :when (not (v :private)) :when (or (not only) (in only-set k))]
|
||||
(def newv (table/setproto @{:private (not export)} v))
|
||||
(put target (symbol prefix k) newv))
|
||||
target)
|
||||
@@ -3055,13 +3124,14 @@
|
||||
(def kargs (table ;args))
|
||||
(def {:as as
|
||||
:prefix prefix
|
||||
:export ep} kargs)
|
||||
:export ep
|
||||
:only only} kargs)
|
||||
(def newenv (require-1 path args kargs))
|
||||
(def prefix (or
|
||||
(and as (string as "/"))
|
||||
prefix
|
||||
(string (last (string/split "/" path)) "/")))
|
||||
(merge-module env newenv prefix ep))
|
||||
(merge-module env newenv prefix ep only))
|
||||
|
||||
(defmacro import
|
||||
``Import a module. First requires the module, and then merges its
|
||||
@@ -3071,10 +3141,11 @@
|
||||
to re-export the imported symbols. If "`:exit true`" is given as an argument,
|
||||
any errors encountered at the top level in the module will cause `(os/exit 1)`
|
||||
to be called. Dynamic bindings will NOT be imported. Use :fresh to bypass the
|
||||
module cache.``
|
||||
module cache. Use `:only [foo bar baz]` to only import select bindings into the
|
||||
current environment.``
|
||||
[path & args]
|
||||
(def ps (partition 2 args))
|
||||
(def argm (mapcat (fn [[k v]] [k (if (= k :as) (string v) v)]) ps))
|
||||
(def argm (mapcat (fn [[k v]] [k (case k :as (string v) :only ~(quote ,v) v)]) ps))
|
||||
(tuple import* (string path) ;argm))
|
||||
|
||||
(defmacro use
|
||||
@@ -3742,7 +3813,7 @@
|
||||
(acquire-release ev/acquire-rlock ev/release-rlock lock body))
|
||||
|
||||
(defmacro ev/with-wlock
|
||||
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
|
||||
``Run a body of code after acquiring write access to an rwlock. Will automatically release the lock when done.``
|
||||
[lock & body]
|
||||
(acquire-release ev/acquire-wlock ev/release-wlock lock body))
|
||||
|
||||
@@ -3806,8 +3877,8 @@
|
||||
(compwhen (dyn 'net/listen)
|
||||
(defn net/server
|
||||
"Start a server asynchronously with `net/listen` and `net/accept-loop`. Returns the new server stream."
|
||||
[host port &opt handler type]
|
||||
(def s (net/listen host port type))
|
||||
[host port &opt handler type no-reuse]
|
||||
(def s (net/listen host port type no-reuse))
|
||||
(if handler
|
||||
(ev/go (fn [] (net/accept-loop s handler))))
|
||||
s))
|
||||
@@ -3844,7 +3915,7 @@
|
||||
(string/replace-all "-" "_" name))
|
||||
|
||||
(defn ffi/context
|
||||
"Set the path of the dynamic library to implictly bind, as well
|
||||
"Set the path of the dynamic library to implicitly bind, as well
|
||||
as other global state for ease of creating native bindings."
|
||||
[&opt native-path &named map-symbols lazy]
|
||||
(default map-symbols default-mangle)
|
||||
@@ -3876,7 +3947,7 @@
|
||||
(defn make-sig []
|
||||
(ffi/signature :default real-ret-type ;computed-type-args))
|
||||
(defn make-ptr []
|
||||
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
|
||||
(assertf (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find ffi symbol %v" raw-symbol))
|
||||
(if lazy
|
||||
~(defn ,alias ,;meta [,;formal-args]
|
||||
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
|
||||
@@ -3913,7 +3984,7 @@
|
||||
|
||||
(def- safe-forms {'defn true 'varfn true 'defn- true 'defmacro true 'defmacro- true
|
||||
'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
|
||||
'defglobal is-safe-def 'varglobal is-safe-def})
|
||||
'defglobal is-safe-def 'varglobal is-safe-def 'defdyn true})
|
||||
|
||||
(def- importers {'import true 'import* true 'dofile true 'require true})
|
||||
(defn- use-2 [evaluator args]
|
||||
@@ -4019,15 +4090,18 @@
|
||||
|
||||
(defn- copyfile
|
||||
[from to]
|
||||
(def mode (os/stat from :permissions))
|
||||
(def b (buffer/new 0x10000))
|
||||
(with [ffrom (file/open from :rb)]
|
||||
(with [fto (file/open to :wb)]
|
||||
(forever
|
||||
(file/read ffrom 0x10000 b)
|
||||
(when (empty? b) (buffer/trim b) (os/chmod to mode) (break))
|
||||
(file/write fto b)
|
||||
(buffer/clear b)))))
|
||||
(if-with [ffrom (file/open from :rb)]
|
||||
(if-with [fto (file/open to :wb)]
|
||||
(do
|
||||
(def perm (os/stat from :permissions))
|
||||
(def b (buffer/new 0x10000))
|
||||
(forever
|
||||
(file/read ffrom 0x10000 b)
|
||||
(when (empty? b) (buffer/trim b) (os/chmod to perm) (break))
|
||||
(file/write fto b)
|
||||
(buffer/clear b)))
|
||||
(errorf "destination file %s cannot be opened for writing" to))
|
||||
(errorf "source file %s cannot be opened for reading" from)))
|
||||
|
||||
(defn- copyrf
|
||||
[from to]
|
||||
@@ -4044,13 +4118,17 @@
|
||||
[manifest]
|
||||
(def bn (get manifest :name))
|
||||
(def manifest-name (get-manifest-filename bn))
|
||||
(spit manifest-name (string/format "%j\n" manifest)))
|
||||
(def b @"")
|
||||
(buffer/format b "%j" manifest) # make sure it is valid jdn
|
||||
(buffer/clear b)
|
||||
(buffer/format b "%.99m\n" manifest)
|
||||
(spit manifest-name b))
|
||||
|
||||
(defn bundle/manifest
|
||||
"Get the manifest for a give installed bundle"
|
||||
[bundle-name]
|
||||
(def name (get-manifest-filename bundle-name))
|
||||
(assert (fexists name) (string "no bundle " bundle-name " found"))
|
||||
(assertf (fexists name) "no bundle %v found" bundle-name)
|
||||
(parse (slurp name)))
|
||||
|
||||
(defn- get-bundle-module
|
||||
@@ -4063,7 +4141,7 @@
|
||||
(os/cd workdir)
|
||||
([_] (print "cannot enter source directory " workdir " for bundle " bundle-name)))
|
||||
(defer (os/cd dir)
|
||||
(def new-env (make-env (curenv)))
|
||||
(def new-env (make-env))
|
||||
(put new-env *module-cache* @{})
|
||||
(put new-env *module-loading* @{})
|
||||
(put new-env *module-make-env* (fn make-bundle-env [&] (make-env new-env)))
|
||||
@@ -4078,7 +4156,6 @@
|
||||
[module bundle-name hook & args]
|
||||
(def hookf (module/value module (symbol hook)))
|
||||
(unless hookf (break))
|
||||
(def manifest (bundle/manifest bundle-name))
|
||||
(def dir (os/cwd))
|
||||
(os/cd (get module :workdir "."))
|
||||
(defer (os/cd dir)
|
||||
@@ -4176,14 +4253,15 @@
|
||||
(not (not (os/stat (bundle-dir bundle-name) :mode))))
|
||||
|
||||
(defn bundle/install
|
||||
"Install a bundle from the local filesystem with a name `bundle-name`."
|
||||
"Install a bundle from the local filesystem. The name of the bundle will be inferred from the bundle, or passed as a parameter :name in `config`."
|
||||
[path &keys config]
|
||||
(def path (bundle-rpath path))
|
||||
(def clean (get config :clean))
|
||||
(def check (get config :check))
|
||||
(def s (sep))
|
||||
# Check meta file for dependencies and default name
|
||||
(def infofile-pre (string path s "bundle" s "info.jdn"))
|
||||
(def infofile-pre-1 (string path s "bundle" s "info.jdn"))
|
||||
(def infofile-pre (if (fexists infofile-pre-1) infofile-pre-1 (string path s "info.jdn"))) # allow for alias
|
||||
(var default-bundle-name nil)
|
||||
(when (os/stat infofile-pre :mode)
|
||||
(def info (-> infofile-pre slurp parse))
|
||||
@@ -4192,17 +4270,19 @@
|
||||
(def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d)))
|
||||
(when (next missing) (errorf "missing dependencies %s" (string/join missing ", "))))
|
||||
(def bundle-name (get config :name default-bundle-name))
|
||||
(assert bundle-name (errorf "unable to infer bundle name for %v, use :name argument" path))
|
||||
(assert (not (string/check-set "\\/" bundle-name))
|
||||
(string "bundle name "
|
||||
bundle-name
|
||||
" cannot contain path separators"))
|
||||
(assertf bundle-name "unable to infer bundle name for %v, use :name argument" path)
|
||||
(assertf (not (string/check-set "\\/" bundle-name))
|
||||
"bundle name %v cannot contain path separators" bundle-name)
|
||||
(assert (next bundle-name) "cannot use empty bundle-name")
|
||||
(assert (not (fexists (get-manifest-filename bundle-name)))
|
||||
"bundle is already installed")
|
||||
(assertf (not (fexists (get-manifest-filename bundle-name)))
|
||||
"bundle %v is already installed" bundle-name)
|
||||
# Setup installed paths
|
||||
(prime-bundle-paths)
|
||||
(os/mkdir (bundle-dir bundle-name))
|
||||
# Aliases for common bundle/ files
|
||||
(def bundle.janet (string path s "bundle.janet"))
|
||||
(when (fexists bundle.janet) (copyfile bundle.janet (bundle-file bundle-name "init.janet")))
|
||||
(when (fexists infofile-pre) (copyfile infofile-pre (bundle-file bundle-name "info.jdn")))
|
||||
# Copy some files into the new location unconditionally
|
||||
(def implicit-sources (string path s "bundle"))
|
||||
(when (= :directory (os/stat implicit-sources :mode))
|
||||
@@ -4229,10 +4309,10 @@
|
||||
(do-hook module bundle-name :clean man))
|
||||
(do-hook module bundle-name :build man)
|
||||
(do-hook module bundle-name :install man)
|
||||
(when check
|
||||
(do-hook module bundle-name :check man))
|
||||
(if (empty? (get man :files)) (print "no files installed, is this a valid bundle?"))
|
||||
(sync-manifest man))
|
||||
(sync-manifest man)
|
||||
(when check
|
||||
(do-hook module bundle-name :check man)))
|
||||
(print "installed " bundle-name)
|
||||
bundle-name)
|
||||
|
||||
@@ -4244,7 +4324,7 @@
|
||||
(var i 0)
|
||||
(def man (bundle/manifest bundle-name))
|
||||
(def files (get man :files @[]))
|
||||
(assert (os/mkdir dest-dir) (string "could not create directory " dest-dir " (or it already exists)"))
|
||||
(assertf (os/mkdir dest-dir) "could not create directory %v (or it already exists)" dest-dir)
|
||||
(def s (sep))
|
||||
(os/mkdir (string dest-dir s "bundle"))
|
||||
(def install-hook (string dest-dir s "bundle" s "init.janet"))
|
||||
@@ -4268,14 +4348,15 @@
|
||||
(spit install-hook b))
|
||||
dest-dir)
|
||||
|
||||
(defn bundle/reinstall
|
||||
"Reinstall an existing bundle from the local source code."
|
||||
[bundle-name &keys new-config]
|
||||
(defn bundle/replace
|
||||
"Reinstall an existing bundle from a new directory. Similar to bundle/reinstall,
|
||||
but installs the replacement bundle from any directory. This is necesarry to replace a package without
|
||||
breaking any dependencies."
|
||||
[bundle-name path &keys new-config]
|
||||
(def manifest (bundle/manifest bundle-name))
|
||||
(def path (get manifest :local-source))
|
||||
(def config (get manifest :config @{}))
|
||||
(def s (sep))
|
||||
(assert (= :directory (os/stat path :mode)) "local source not available")
|
||||
(assertf (= :directory (os/stat path :mode)) "local source %v not available" path)
|
||||
(def backup-dir (string (dyn *syspath*) s bundle-name ".backup"))
|
||||
(rmrf backup-dir)
|
||||
(def backup-bundle-source (bundle/pack bundle-name backup-dir true))
|
||||
@@ -4288,6 +4369,14 @@
|
||||
(rmrf backup-bundle-source)
|
||||
bundle-name)
|
||||
|
||||
(defn bundle/reinstall
|
||||
"Reinstall an existing bundle from the local source code."
|
||||
[bundle-name &keys new-config]
|
||||
(def manifest (bundle/manifest bundle-name))
|
||||
(def path (get manifest :local-source))
|
||||
(bundle/replace bundle-name path ;(kvs new-config))
|
||||
bundle-name)
|
||||
|
||||
(defn bundle/add-directory
|
||||
"Add a directory during the install process relative to `(dyn *syspath*)`"
|
||||
[manifest dest &opt chmod-mode]
|
||||
@@ -4303,6 +4392,19 @@
|
||||
(print "add " absdest)
|
||||
absdest)
|
||||
|
||||
(defn bundle/whois
|
||||
"Given a file path, figure out which bundle installed it."
|
||||
[path]
|
||||
(var ret nil)
|
||||
(def rpath (bundle-rpath path))
|
||||
(each bundle-name (bundle/list)
|
||||
(def files (get (bundle/manifest bundle-name) :files []))
|
||||
(def has-file (index-of rpath files))
|
||||
(when has-file
|
||||
(set ret bundle-name)
|
||||
(break)))
|
||||
ret)
|
||||
|
||||
(defn bundle/add-file
|
||||
"Add files during an install relative to `(dyn *syspath*)`"
|
||||
[manifest src &opt dest chmod-mode]
|
||||
@@ -4327,12 +4429,25 @@
|
||||
[manifest src &opt dest chmod-mode]
|
||||
(default dest src)
|
||||
(def s (sep))
|
||||
(case (os/stat src :mode)
|
||||
(def mode (os/stat src :mode))
|
||||
(if-not mode (errorf "file %s does not exist" src))
|
||||
(case mode
|
||||
:directory
|
||||
(let [absdest (bundle/add-directory manifest dest chmod-mode)]
|
||||
(each d (os/dir src) (bundle/add manifest (string src s d) (string dest s d) chmod-mode))
|
||||
absdest)
|
||||
:file (bundle/add-file manifest src dest chmod-mode)))
|
||||
:file (bundle/add-file manifest src dest chmod-mode)
|
||||
(errorf "bad path %s - file is a %s" src mode)))
|
||||
|
||||
(defn bundle/add-bin
|
||||
`Shorthand for adding scripts during an install. Scripts will be installed to
|
||||
(string (dyn *syspath*) "/bin") by default and will be set to be executable.`
|
||||
[manifest src &opt dest chmod-mode]
|
||||
(def s (sep))
|
||||
(default dest (last (string/split s src)))
|
||||
(default chmod-mode 8r755)
|
||||
(os/mkdir (string (dyn *syspath*) s "bin"))
|
||||
(bundle/add-file manifest src (string "bin" s dest) chmod-mode))
|
||||
|
||||
(defn bundle/update-all
|
||||
"Reinstall all bundles"
|
||||
@@ -4395,6 +4510,12 @@
|
||||
"-nocolor" "n"
|
||||
"-color" "N"
|
||||
"-library" "l"
|
||||
"-install" "b"
|
||||
"-reinstall" "B"
|
||||
"-uninstall" "u"
|
||||
"-update-all" "U"
|
||||
"-list" "L"
|
||||
"-prune" "P"
|
||||
"-lint-warn" "w"
|
||||
"-lint-error" "x"})
|
||||
|
||||
@@ -4405,7 +4526,7 @@
|
||||
|
||||
(setdyn *args* args)
|
||||
|
||||
(var should-repl false)
|
||||
(var should-repl nil)
|
||||
(var no-file true)
|
||||
(var quiet false)
|
||||
(var raw-stdin false)
|
||||
@@ -4418,7 +4539,12 @@
|
||||
(var error-level nil)
|
||||
(var expect-image false)
|
||||
|
||||
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn *syspath* jp))
|
||||
(when-let [jp (getenv-alias "JANET_PATH")]
|
||||
(def path-sep (if (index-of (os/which) [:windows :mingw]) ";" ":"))
|
||||
(def paths (reverse! (string/split path-sep jp)))
|
||||
(for i 1 (length paths)
|
||||
(module/add-syspath (get paths i)))
|
||||
(setdyn *syspath* (first paths)))
|
||||
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
|
||||
(set colorize (and
|
||||
(not (getenv-alias "NO_COLOR"))
|
||||
@@ -4455,6 +4581,12 @@
|
||||
--library (-l) lib : Use a module before processing more arguments
|
||||
--lint-warn (-w) level : Set the lint warning level - default is "normal"
|
||||
--lint-error (-x) level : Set the lint error level - default is "none"
|
||||
--install (-b) dirpath : Install a bundle from a directory
|
||||
--reinstall (-B) name : Reinstall a bundle by bundle name
|
||||
--uninstall (-u) name : Uninstall a bundle by bundle name
|
||||
--update-all (-U) : Reinstall all installed bundles
|
||||
--prune (-P) : Uninstalled all bundles that are orphaned
|
||||
--list (-L) : List all installed bundles
|
||||
-- : Stop handling options
|
||||
```)
|
||||
(os/exit 0)
|
||||
@@ -4472,7 +4604,13 @@
|
||||
"c" (fn c-switch [i &]
|
||||
(def path (in args (+ i 1)))
|
||||
(def e (dofile path))
|
||||
(spit (in args (+ i 2)) (make-image e))
|
||||
(def output-path
|
||||
(if (< (+ i 2) (length args))
|
||||
(in args (+ i 2))
|
||||
(string
|
||||
(if (string/has-suffix? ".janet" path) (string/slice path 0 -7) path)
|
||||
".jimage")))
|
||||
(spit output-path (make-image e))
|
||||
(set no-file false)
|
||||
3)
|
||||
"-" (fn [&] (set handleopts false) 1)
|
||||
@@ -4493,6 +4631,30 @@
|
||||
((thunk) ;subargs)
|
||||
(error (get thunk :error)))
|
||||
math/inf)
|
||||
"b"
|
||||
(compif (dyn 'bundle/install)
|
||||
(fn [i &] (bundle/install (in args (+ i 1))) (set no-file false) (if (= nil should-repl) (set should-repl false)) 2)
|
||||
(fn [i &] (eprint "--install not supported with reduced os") 2))
|
||||
"B"
|
||||
(compif (dyn 'bundle/reinstall)
|
||||
(fn [i &] (bundle/reinstall (in args (+ i 1))) (set no-file false) (if (= nil should-repl) (set should-repl false)) 2)
|
||||
(fn [i &] (eprint "--reinstall not supported with reduced os") 2))
|
||||
"u"
|
||||
(compif (dyn 'bundle/uninstall)
|
||||
(fn [i &] (bundle/uninstall (in args (+ i 1))) (set no-file false) (if (= nil should-repl) (set should-repl false)) 2)
|
||||
(fn [i &] (eprint "--uninstall not supported with reduced os") 2))
|
||||
"P"
|
||||
(compif (dyn 'bundle/prune)
|
||||
(fn [i &] (bundle/prune) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
|
||||
(fn [i &] (eprint "--prune not supported with reduced os") 1))
|
||||
"U"
|
||||
(compif (dyn 'bundle/update-all)
|
||||
(fn [i &] (bundle/update-all) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
|
||||
(fn [i &] (eprint "--update-all not supported with reduced os") 1))
|
||||
"L"
|
||||
(compif (dyn 'bundle/list)
|
||||
(fn [i &] (each l (bundle/list) (print l)) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
|
||||
(fn [i &] (eprint "--list not supported with reduced os") 1))
|
||||
"d" (fn [&] (set debug-flag true) 1)
|
||||
"w" (fn [i &] (set warn-level (get-lint-level i)) 2)
|
||||
"x" (fn [i &] (set error-level (get-lint-level i)) 2)
|
||||
@@ -4544,17 +4706,15 @@
|
||||
(if-not quiet
|
||||
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) "/" (os/compiler) " - '(doc)' for help"))
|
||||
(flush)
|
||||
(def env (make-env))
|
||||
(defn getprompt [p]
|
||||
(when-let [custom-prompt (get env *repl-prompt*)] (break (custom-prompt p)))
|
||||
(def [line] (parser/where p))
|
||||
(string "repl:" line ":" (parser/state p :delimiters) "> "))
|
||||
(defn getstdin [prompt buf _]
|
||||
(file/write stdout prompt)
|
||||
(file/flush stdout)
|
||||
(file/read stdin :line buf))
|
||||
(def env (make-env))
|
||||
(when-let [profile.janet (dyn *profilepath*)]
|
||||
(def new-env (dofile profile.janet :exit true))
|
||||
(merge-module env new-env "" false))
|
||||
(when debug-flag
|
||||
(put env *debug* true)
|
||||
(put env *redef* true))
|
||||
@@ -4566,6 +4726,9 @@
|
||||
(setdyn *doc-color* (if colorize true))
|
||||
(setdyn *lint-error* error-level)
|
||||
(setdyn *lint-warn* error-level)
|
||||
(when-let [profile.janet (dyn *profilepath*)]
|
||||
(dofile profile.janet :exit true :env env)
|
||||
(put env *current-file* nil))
|
||||
(repl getchunk nil env)))))
|
||||
|
||||
###
|
||||
@@ -4585,6 +4748,10 @@
|
||||
(put flat :doc nil))
|
||||
(when (boot/config :no-sourcemaps)
|
||||
(put flat :source-map nil))
|
||||
(unless (boot/config :no-docstrings)
|
||||
(unless (v :private)
|
||||
(unless (v :doc)
|
||||
(errorf "no docs: %v %p" k v)))) # make sure we have docs
|
||||
# Fix directory separators on windows to make image identical between windows and non-windows
|
||||
(when-let [sm (get flat :source-map)]
|
||||
(put flat :source-map [(string/replace-all "\\" "/" (sm 0)) (sm 1) (sm 2)]))
|
||||
@@ -4642,6 +4809,7 @@
|
||||
"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"
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -22,7 +22,7 @@
|
||||
|
||||
#include <janet.h>
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <math.h>
|
||||
|
||||
#include "tests.h"
|
||||
@@ -35,6 +35,11 @@ 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()));
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 34
|
||||
#define JANET_VERSION_MINOR 38
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.34.0"
|
||||
#define JANET_VERSION "1.38.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -29,6 +29,7 @@
|
||||
/* #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 */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -275,6 +275,31 @@ 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 "
|
||||
@@ -385,6 +410,7 @@ 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);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -371,17 +371,15 @@ JANET_CORE_FN(cfun_buffer_push_uint16,
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
uint16_t data;
|
||||
uint8_t bytes[2];
|
||||
} u;
|
||||
u.data = (uint16_t) janet_getinteger(argv, 2);
|
||||
uint16_t data = janet_getuinteger16(argv, 2);
|
||||
uint8_t bytes[sizeof(data)];
|
||||
memcpy(bytes, &data, sizeof(bytes));
|
||||
if (reverse) {
|
||||
uint8_t temp = u.bytes[1];
|
||||
u.bytes[1] = u.bytes[0];
|
||||
u.bytes[0] = temp;
|
||||
uint8_t temp = bytes[1];
|
||||
bytes[1] = bytes[0];
|
||||
bytes[0] = temp;
|
||||
}
|
||||
janet_buffer_push_u16(buffer, *(uint16_t *) u.bytes);
|
||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -392,14 +390,12 @@ JANET_CORE_FN(cfun_buffer_push_uint32,
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
uint32_t data;
|
||||
uint8_t bytes[4];
|
||||
} u;
|
||||
u.data = (uint32_t) janet_getinteger(argv, 2);
|
||||
uint32_t data = janet_getuinteger(argv, 2);
|
||||
uint8_t bytes[sizeof(data)];
|
||||
memcpy(bytes, &data, sizeof(bytes));
|
||||
if (reverse)
|
||||
reverse_u32(u.bytes);
|
||||
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
|
||||
reverse_u32(bytes);
|
||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -410,14 +406,12 @@ JANET_CORE_FN(cfun_buffer_push_uint64,
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
uint64_t data;
|
||||
uint8_t bytes[8];
|
||||
} u;
|
||||
u.data = (uint64_t) janet_getuinteger64(argv, 2);
|
||||
uint64_t data = janet_getuinteger64(argv, 2);
|
||||
uint8_t bytes[sizeof(data)];
|
||||
memcpy(bytes, &data, sizeof(bytes));
|
||||
if (reverse)
|
||||
reverse_u64(u.bytes);
|
||||
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
|
||||
reverse_u64(bytes);
|
||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -428,14 +422,12 @@ JANET_CORE_FN(cfun_buffer_push_float32,
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
float data;
|
||||
uint8_t bytes[4];
|
||||
} u;
|
||||
u.data = (float) janet_getnumber(argv, 2);
|
||||
float data = (float) janet_getnumber(argv, 2);
|
||||
uint8_t bytes[sizeof(data)];
|
||||
memcpy(bytes, &data, sizeof(bytes));
|
||||
if (reverse)
|
||||
reverse_u32(u.bytes);
|
||||
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
|
||||
reverse_u32(bytes);
|
||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -446,14 +438,12 @@ JANET_CORE_FN(cfun_buffer_push_float64,
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
double data;
|
||||
uint8_t bytes[8];
|
||||
} u;
|
||||
u.data = janet_getnumber(argv, 2);
|
||||
double data = janet_getnumber(argv, 2);
|
||||
uint8_t bytes[sizeof(data)];
|
||||
memcpy(bytes, &data, sizeof(bytes));
|
||||
if (reverse)
|
||||
reverse_u64(u.bytes);
|
||||
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
|
||||
reverse_u64(bytes);
|
||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -140,7 +140,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 += (new_jump_target - old_jump_target + (i - j)) << 8;
|
||||
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 8;
|
||||
break;
|
||||
case JOP_JUMP_IF:
|
||||
case JOP_JUMP_IF_NIL:
|
||||
@@ -149,7 +149,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 += (new_jump_target - old_jump_target + (i - j)) << 16;
|
||||
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 16;
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -25,16 +25,19 @@
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "fiber.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <pthread.h>
|
||||
#else
|
||||
#include <windows.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#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.
|
||||
@@ -59,6 +62,18 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
|
||||
void janet_signalv(JanetSignal sig, Janet message) {
|
||||
if (janet_vm.return_reg != NULL) {
|
||||
/* Should match logic in janet_call for coercing everything not ok to an error (no awaits, yields, etc.) */
|
||||
if (janet_vm.coerce_error && sig != JANET_SIGNAL_OK) {
|
||||
#ifdef JANET_EV
|
||||
if (NULL != janet_vm.root_fiber && sig == JANET_SIGNAL_EVENT) {
|
||||
janet_vm.root_fiber->sched_id++;
|
||||
}
|
||||
#endif
|
||||
if (sig != JANET_SIGNAL_ERROR) {
|
||||
message = janet_wrap_string(janet_formatc("%v coerced from %s to error", message, janet_signal_names[sig]));
|
||||
}
|
||||
sig = JANET_SIGNAL_ERROR;
|
||||
}
|
||||
*janet_vm.return_reg = message;
|
||||
if (NULL != janet_vm.fiber) {
|
||||
janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP;
|
||||
@@ -303,11 +318,28 @@ 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 signed integer, got %v", n, x);
|
||||
janet_panicf("bad slot #%d, expected 32 bit unsigned integer, got %v", n, x);
|
||||
}
|
||||
return janet_unwrap_integer(x);
|
||||
return (uint32_t) janet_unwrap_number(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]);
|
||||
@@ -446,6 +478,33 @@ 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);
|
||||
@@ -501,8 +560,8 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
|
||||
/* Atomic refcounts */
|
||||
|
||||
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
|
||||
#ifdef JANET_WINDOWS
|
||||
return InterlockedIncrement(x);
|
||||
#ifdef _MSC_VER
|
||||
return _InterlockedIncrement(x);
|
||||
#elif defined(JANET_USE_STDATOMIC)
|
||||
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
|
||||
#else
|
||||
@@ -511,8 +570,8 @@ JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
|
||||
}
|
||||
|
||||
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
|
||||
#ifdef JANET_WINDOWS
|
||||
return InterlockedDecrement(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
|
||||
@@ -521,8 +580,8 @@ JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
|
||||
}
|
||||
|
||||
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
|
||||
#ifdef JANET_WINDOWS
|
||||
return InterlockedOr(x, 0);
|
||||
#ifdef _MSC_VER
|
||||
return _InterlockedOr(x, 0);
|
||||
#elif defined(JANET_USE_STDATOMIC)
|
||||
return atomic_load_explicit(x, memory_order_acquire);
|
||||
#else
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -262,7 +262,7 @@ void janetc_popscope(JanetCompiler *c);
|
||||
void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot);
|
||||
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
|
||||
|
||||
/* Create a destory slots */
|
||||
/* Create a destroy slot */
|
||||
JanetSlot janetc_cslot(Janet x);
|
||||
|
||||
/* Search for a symbol */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -432,27 +432,39 @@ JANET_CORE_FN(janet_core_range,
|
||||
"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);
|
||||
int32_t start = 0, stop = 0, step = 1, count = 0;
|
||||
double start = 0, stop = 0, step = 1, count = 0;
|
||||
if (argc == 3) {
|
||||
start = janet_getinteger(argv, 0);
|
||||
stop = janet_getinteger(argv, 1);
|
||||
step = janet_getinteger(argv, 2);
|
||||
count = (step > 0) ? (stop - start - 1) / step + 1 :
|
||||
((step < 0) ? (stop - start + 1) / step + 1 : 0);
|
||||
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_getinteger(argv, 0);
|
||||
stop = janet_getinteger(argv, 1);
|
||||
start = janet_getnumber(argv, 0);
|
||||
stop = janet_getnumber(argv, 1);
|
||||
count = stop - start;
|
||||
} else {
|
||||
stop = janet_getinteger(argv, 0);
|
||||
stop = janet_getnumber(argv, 0);
|
||||
count = stop;
|
||||
}
|
||||
count = (count > 0) ? count : 0;
|
||||
JanetArray *array = janet_array(count);
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
array->data[i] = janet_wrap_number(start + i * step);
|
||||
int32_t int_count;
|
||||
janet_assert(count >= 0, "bad range code");
|
||||
if (count > (double) INT32_MAX) {
|
||||
janet_panicf("range is too large, %f elements", count);
|
||||
} else {
|
||||
int_count = (int32_t) ceil(count);
|
||||
}
|
||||
array->count = 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);
|
||||
}
|
||||
|
||||
@@ -689,7 +701,15 @@ JANET_CORE_FN(janet_core_is_lengthable,
|
||||
|
||||
JANET_CORE_FN(janet_core_signal,
|
||||
"(signal what x)",
|
||||
"Raise a signal with payload 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") {
|
||||
janet_arity(argc, 1, 2);
|
||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
if (janet_checkint(argv[0])) {
|
||||
@@ -976,18 +996,17 @@ static void make_apply(JanetTable *env) {
|
||||
/* Push the array */
|
||||
S(JOP_PUSH_ARRAY, 5),
|
||||
|
||||
/* Call the funciton */
|
||||
/* Call the function */
|
||||
S(JOP_TAILCALL, 0)
|
||||
};
|
||||
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
|
||||
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
|
||||
JDOC("(apply f & args)\n\n"
|
||||
"Applies a function to a variable number of arguments. Each element in args "
|
||||
"is used as an argument to f, except the last element in args, which is expected to "
|
||||
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
||||
"f. For example:\n\n"
|
||||
"\t(apply + 1000 (range 10))\n\n"
|
||||
"sums the first 10 integers and 1000."));
|
||||
"Applies a function f to a variable number of arguments. Each "
|
||||
"element in args is used as an argument to f, except the last "
|
||||
"element in args, which is expected to be an array or a tuple. "
|
||||
"Each element in this last argument is then also pushed as an "
|
||||
"argument to f."));
|
||||
}
|
||||
|
||||
static const uint32_t error_asm[] = {
|
||||
@@ -1121,6 +1140,9 @@ 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);
|
||||
@@ -1137,82 +1159,82 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
janet_quick_asm(env, JANET_FUN_CMP,
|
||||
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
|
||||
JDOC("(cmp x y)\n\n"
|
||||
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
|
||||
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
|
||||
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
|
||||
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
|
||||
janet_quick_asm(env, JANET_FUN_NEXT,
|
||||
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
|
||||
JDOC("(next ds &opt key)\n\n"
|
||||
"Gets the next key in a data structure. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if the data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through."));
|
||||
"Gets the next key in a data structure. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if the data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through."));
|
||||
janet_quick_asm(env, JANET_FUN_PROP,
|
||||
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
||||
JDOC("(propagate x fiber)\n\n"
|
||||
"Propagate a signal from a fiber to the current fiber and "
|
||||
"set the last value of the current fiber to `x`. The signal "
|
||||
"value is then available as the status of the current fiber. "
|
||||
"The resulting stack trace from the current fiber will include "
|
||||
"frames from fiber. If fiber is in a state that can be resumed, "
|
||||
"resuming the current fiber will first resume `fiber`. "
|
||||
"This function can be used to re-raise an error without losing "
|
||||
"the original stack trace."));
|
||||
"Propagate a signal from a fiber to the current fiber and "
|
||||
"set the last value of the current fiber to `x`. The signal "
|
||||
"value is then available as the status of the current fiber. "
|
||||
"The resulting stack trace from the current fiber will include "
|
||||
"frames from fiber. If fiber is in a state that can be resumed, "
|
||||
"resuming the current fiber will first resume `fiber`. "
|
||||
"This function can be used to re-raise an error without losing "
|
||||
"the original stack trace."));
|
||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
||||
JDOC("(debug &opt x)\n\n"
|
||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||
"the running state of the current fiber. Returns the value passed in by resume."));
|
||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||
"the running state of the current fiber. Returns the value passed in by resume."));
|
||||
janet_quick_asm(env, JANET_FUN_ERROR,
|
||||
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
|
||||
JDOC("(error e)\n\n"
|
||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_YIELD,
|
||||
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
|
||||
JDOC("(yield &opt x)\n\n"
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
janet_quick_asm(env, JANET_FUN_CANCEL,
|
||||
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
|
||||
JDOC("(cancel fiber err)\n\n"
|
||||
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
|
||||
"Returns the same result as resume."));
|
||||
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
|
||||
"Returns the same result as resume."));
|
||||
janet_quick_asm(env, JANET_FUN_RESUME,
|
||||
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
|
||||
JDOC("(resume fiber &opt x)\n\n"
|
||||
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_IN,
|
||||
"in", 3, 2, 3, 4, in_asm, sizeof(in_asm),
|
||||
JDOC("(in ds key &opt dflt)\n\n"
|
||||
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
|
||||
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
|
||||
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
|
||||
"take any value as a key except nil and will return nil or dflt if not found."));
|
||||
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
|
||||
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
|
||||
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
|
||||
"take any value as a key except nil and will return nil or dflt if not found."));
|
||||
janet_quick_asm(env, JANET_FUN_GET,
|
||||
"get", 3, 2, 3, 4, get_asm, sizeof(in_asm),
|
||||
JDOC("(get ds key &opt dflt)\n\n"
|
||||
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
|
||||
"Similar to in, but will not throw an error if the key is invalid for the data structure "
|
||||
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
|
||||
"an error."));
|
||||
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
|
||||
"Similar to in, but will not throw an error if the key is invalid for the data structure "
|
||||
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
|
||||
"an error."));
|
||||
janet_quick_asm(env, JANET_FUN_PUT,
|
||||
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
|
||||
JDOC("(put ds key value)\n\n"
|
||||
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
||||
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
||||
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
|
||||
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
||||
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
||||
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
||||
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
||||
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
||||
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
|
||||
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
||||
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
||||
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
||||
janet_quick_asm(env, JANET_FUN_LENGTH,
|
||||
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
|
||||
JDOC("(length ds)\n\n"
|
||||
"Returns the length or count of a data structure in constant time as an integer. For "
|
||||
"structs and tables, returns the number of key-value pairs in the data structure."));
|
||||
"Returns the length or count of a data structure in constant time as an integer. For "
|
||||
"structs and tables, returns the number of key-value pairs in the data structure."));
|
||||
janet_quick_asm(env, JANET_FUN_BNOT,
|
||||
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
|
||||
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
|
||||
@@ -1221,74 +1243,74 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Variadic ops */
|
||||
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
|
||||
JDOC("(+ & xs)\n\n"
|
||||
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
|
||||
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
|
||||
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
|
||||
JDOC("(- & xs)\n\n"
|
||||
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
|
||||
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
|
||||
"the rest of the elements."));
|
||||
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
|
||||
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
|
||||
"the rest of the elements."));
|
||||
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
|
||||
JDOC("(* & xs)\n\n"
|
||||
"Returns the product of all elements in xs. If xs is empty, returns 1."));
|
||||
"Returns the product of all elements in xs. If xs is empty, returns 1."));
|
||||
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
|
||||
JDOC("(/ & xs)\n\n"
|
||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
|
||||
JDOC("(div & xs)\n\n"
|
||||
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
|
||||
JDOC("(mod & xs)\n\n"
|
||||
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
|
||||
"`(mod x 0)` is defined to be `x`."));
|
||||
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
|
||||
"`(mod x 0)` is defined to be `x`."));
|
||||
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
|
||||
JDOC("(% & xs)\n\n"
|
||||
"Returns the remainder of dividing the first value of xs by each remaining value."));
|
||||
"Returns the remainder of dividing the first value of xs by each remaining value."));
|
||||
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
||||
JDOC("(band & xs)\n\n"
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
|
||||
JDOC("(bor & xs)\n\n"
|
||||
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
|
||||
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
|
||||
JDOC("(bxor & xs)\n\n"
|
||||
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
|
||||
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
|
||||
JDOC("(blshift x & shifts)\n\n"
|
||||
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer."));
|
||||
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
|
||||
JDOC("(brshift x & shifts)\n\n"
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer."));
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
|
||||
JDOC("(brushift x & shifts)\n\n"
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer. The sign of x is not preserved, so "
|
||||
"for positive shifts the return value will always be positive."));
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer. The sign of x is not preserved, so "
|
||||
"for positive shifts the return value will always be positive."));
|
||||
|
||||
/* Variadic comparators */
|
||||
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
|
||||
JDOC("(> & xs)\n\n"
|
||||
"Check if xs is in descending order. Returns a boolean."));
|
||||
"Check if xs is in descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
|
||||
JDOC("(< & xs)\n\n"
|
||||
"Check if xs is in ascending order. Returns a boolean."));
|
||||
"Check if xs is in ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
|
||||
JDOC("(>= & xs)\n\n"
|
||||
"Check if xs is in non-ascending order. Returns a boolean."));
|
||||
"Check if xs is in non-ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
|
||||
JDOC("(<= & xs)\n\n"
|
||||
"Check if xs is in non-descending order. Returns a boolean."));
|
||||
"Check if xs is in non-descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
|
||||
JDOC("(= & xs)\n\n"
|
||||
"Check if all values in xs are equal. Returns a boolean."));
|
||||
"Check if all values in xs are equal. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
|
||||
JDOC("(not= & xs)\n\n"
|
||||
"Check if any values in xs are not equal. Returns a boolean."));
|
||||
"Check if any values in xs are not equal. Returns a boolean."));
|
||||
|
||||
/* Platform detection */
|
||||
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
|
||||
@@ -1297,7 +1319,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JDOC("The build identifier of the running janet program."));
|
||||
janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS),
|
||||
JDOC("The flag set of config options from janetconf.h which is used to check "
|
||||
"if native modules are compatible with the host program."));
|
||||
"if native modules are compatible with the host program."));
|
||||
|
||||
/* Allow references to the environment */
|
||||
janet_def(env, "root-env", janet_wrap_table(env),
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -102,7 +102,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
}
|
||||
|
||||
/* Error reporting. This can be emulated from within Janet, but for
|
||||
* consitency with the top level code it is defined once. */
|
||||
* consistency with the top level code it is defined once. */
|
||||
void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||
|
||||
int32_t fi;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
185
src/core/ev.c
185
src/core/ev.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -32,9 +32,11 @@
|
||||
#ifdef JANET_EV
|
||||
|
||||
#include <math.h>
|
||||
#include <fcntl.h>
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <winsock2.h>
|
||||
#include <windows.h>
|
||||
#include <io.h>
|
||||
#else
|
||||
#include <pthread.h>
|
||||
#include <limits.h>
|
||||
@@ -43,7 +45,6 @@
|
||||
#include <signal.h>
|
||||
#include <sys/ioctl.h>
|
||||
#include <sys/types.h>
|
||||
#include <fcntl.h>
|
||||
#include <netinet/in.h>
|
||||
#include <netinet/tcp.h>
|
||||
#include <netdb.h>
|
||||
@@ -74,7 +75,7 @@ typedef struct {
|
||||
} mode;
|
||||
} JanetChannelPending;
|
||||
|
||||
typedef struct {
|
||||
struct JanetChannel {
|
||||
JanetQueue items;
|
||||
JanetQueue read_pending;
|
||||
JanetQueue write_pending;
|
||||
@@ -86,7 +87,7 @@ typedef struct {
|
||||
#else
|
||||
pthread_mutex_t lock;
|
||||
#endif
|
||||
} JanetChannel;
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
JanetFiber *fiber;
|
||||
@@ -255,6 +256,12 @@ static void add_timeout(JanetTimeout to) {
|
||||
|
||||
void janet_async_end(JanetFiber *fiber) {
|
||||
if (fiber->ev_callback) {
|
||||
if (fiber->ev_stream->read_fiber == fiber) {
|
||||
fiber->ev_stream->read_fiber = NULL;
|
||||
}
|
||||
if (fiber->ev_stream->write_fiber == fiber) {
|
||||
fiber->ev_stream->write_fiber = NULL;
|
||||
}
|
||||
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_DEINIT);
|
||||
janet_gcunroot(janet_wrap_abstract(fiber->ev_stream));
|
||||
fiber->ev_callback = NULL;
|
||||
@@ -276,8 +283,7 @@ void janet_async_in_flight(JanetFiber *fiber) {
|
||||
#endif
|
||||
}
|
||||
|
||||
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
|
||||
JanetFiber *fiber = janet_vm.root_fiber;
|
||||
void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
|
||||
janet_assert(!fiber->ev_callback, "double async on fiber");
|
||||
if (mode & JANET_ASYNC_LISTEN_READ) {
|
||||
stream->read_fiber = fiber;
|
||||
@@ -291,6 +297,10 @@ void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback
|
||||
janet_gcroot(janet_wrap_abstract(stream));
|
||||
fiber->ev_state = state;
|
||||
callback(fiber, JANET_ASYNC_EVENT_INIT);
|
||||
}
|
||||
|
||||
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
|
||||
janet_async_start_fiber(janet_vm.root_fiber, stream, mode, callback, state);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
@@ -316,8 +326,9 @@ static const JanetMethod ev_default_stream_methods[] = {
|
||||
};
|
||||
|
||||
/* Create a stream*/
|
||||
JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods) {
|
||||
JanetStream *stream = janet_abstract(&janet_stream_type, sizeof(JanetStream));
|
||||
JanetStream *janet_stream_ext(JanetHandle handle, uint32_t flags, const JanetMethod *methods, size_t size) {
|
||||
janet_assert(size >= sizeof(JanetStream), "bad size");
|
||||
JanetStream *stream = janet_abstract(&janet_stream_type, size);
|
||||
stream->handle = handle;
|
||||
stream->flags = flags;
|
||||
stream->read_fiber = NULL;
|
||||
@@ -329,6 +340,10 @@ JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod
|
||||
return stream;
|
||||
}
|
||||
|
||||
JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods) {
|
||||
return janet_stream_ext(handle, flags, methods, sizeof(JanetStream));
|
||||
}
|
||||
|
||||
static void janet_stream_close_impl(JanetStream *stream) {
|
||||
stream->flags |= JANET_STREAM_CLOSED;
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -433,7 +448,7 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
}
|
||||
janet_marshal_int64(ctx, (int64_t)(duph));
|
||||
#else
|
||||
/* Marshal after dup becuse it is easier than maintaining our own ref counting. */
|
||||
/* Marshal after dup because it is easier than maintaining our own ref counting. */
|
||||
int duph = dup(s->handle);
|
||||
if (duph < 0) janet_panicf("failed to duplicate stream handle: %V", janet_ev_lasterr());
|
||||
janet_marshal_int(ctx, (int32_t)(duph));
|
||||
@@ -469,7 +484,7 @@ static Janet janet_stream_next(void *p, Janet key) {
|
||||
static void janet_stream_tostring(void *p, JanetBuffer *buffer) {
|
||||
JanetStream *stream = p;
|
||||
/* Let user print the file descriptor for debugging */
|
||||
janet_formatb(buffer, "<core/stream handle=%d>", stream->handle);
|
||||
janet_formatb(buffer, "[fd=%d]", stream->handle);
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_stream_type = {
|
||||
@@ -595,7 +610,7 @@ void janet_ev_deinit_common(void) {
|
||||
|
||||
/* Shorthand to yield to event loop */
|
||||
void janet_await(void) {
|
||||
/* Store the fiber in a gobal table */
|
||||
/* Store the fiber in a global table */
|
||||
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
|
||||
}
|
||||
|
||||
@@ -611,6 +626,18 @@ void janet_addtimeout(double sec) {
|
||||
add_timeout(to);
|
||||
}
|
||||
|
||||
/* Set timeout for the current root fiber but resume with nil instead of raising an error */
|
||||
void janet_addtimeout_nil(double sec) {
|
||||
JanetFiber *fiber = janet_vm.root_fiber;
|
||||
JanetTimeout to;
|
||||
to.when = ts_delta(ts_now(), sec);
|
||||
to.fiber = fiber;
|
||||
to.curr_fiber = NULL;
|
||||
to.sched_id = fiber->sched_id;
|
||||
to.is_error = 0;
|
||||
add_timeout(to);
|
||||
}
|
||||
|
||||
void janet_ev_inc_refcount(void) {
|
||||
janet_atomic_inc(&janet_vm.listener_count);
|
||||
}
|
||||
@@ -866,7 +893,7 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
|
||||
/* No root fiber, we are in completion on a root fiber. Don't block. */
|
||||
if (mode == 2) {
|
||||
janet_chan_unlock(channel);
|
||||
return 0;
|
||||
return 1;
|
||||
}
|
||||
/* Pushed successfully, but should block. */
|
||||
JanetChannelPending pending;
|
||||
@@ -922,6 +949,7 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i
|
||||
int is_threaded = janet_chan_is_threaded(channel);
|
||||
if (janet_q_pop(&channel->items, item, sizeof(Janet))) {
|
||||
/* Queue empty */
|
||||
if (is_choice == 2) return 0; // Skip pending read
|
||||
JanetChannelPending pending;
|
||||
pending.thread = &janet_vm;
|
||||
pending.fiber = janet_vm.root_fiber,
|
||||
@@ -979,6 +1007,28 @@ JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, Janet
|
||||
}
|
||||
}
|
||||
|
||||
int janet_channel_give(JanetChannel *channel, Janet x) {
|
||||
return janet_channel_push(channel, x, 2);
|
||||
}
|
||||
|
||||
int janet_channel_take(JanetChannel *channel, Janet *out) {
|
||||
return janet_channel_pop(channel, out, 2);
|
||||
}
|
||||
|
||||
JanetChannel *janet_channel_make(uint32_t limit) {
|
||||
janet_assert(limit <= INT32_MAX, "bad limit");
|
||||
JanetChannel *channel = janet_abstract(&janet_channel_type, sizeof(JanetChannel));
|
||||
janet_chan_init(channel, (int32_t) limit, 0);
|
||||
return channel;
|
||||
}
|
||||
|
||||
JanetChannel *janet_channel_make_threaded(uint32_t limit) {
|
||||
janet_assert(limit <= INT32_MAX, "bad limit");
|
||||
JanetChannel *channel = janet_abstract_threaded(&janet_channel_type, sizeof(JanetChannel));
|
||||
janet_chan_init(channel, (int32_t) limit, 0);
|
||||
return channel;
|
||||
}
|
||||
|
||||
/* Channel Methods */
|
||||
|
||||
JANET_CORE_FN(cfun_channel_push,
|
||||
@@ -987,6 +1037,9 @@ JANET_CORE_FN(cfun_channel_push,
|
||||
"Returns the channel if the write succeeded, nil otherwise.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetChannel *channel = janet_getchannel(argv, 0);
|
||||
if (janet_vm.coerce_error) {
|
||||
janet_panic("cannot give to channel inside janet_call");
|
||||
}
|
||||
if (janet_channel_push(channel, argv[1], 0)) {
|
||||
janet_await();
|
||||
}
|
||||
@@ -999,6 +1052,9 @@ JANET_CORE_FN(cfun_channel_pop,
|
||||
janet_fixarity(argc, 1);
|
||||
JanetChannel *channel = janet_getchannel(argv, 0);
|
||||
Janet item;
|
||||
if (janet_vm.coerce_error) {
|
||||
janet_panic("cannot take from channel inside janet_call");
|
||||
}
|
||||
if (janet_channel_pop(channel, &item, 0)) {
|
||||
janet_schedule(janet_vm.root_fiber, item);
|
||||
}
|
||||
@@ -1035,6 +1091,10 @@ JANET_CORE_FN(cfun_channel_choice,
|
||||
int32_t len;
|
||||
const Janet *data;
|
||||
|
||||
if (janet_vm.coerce_error) {
|
||||
janet_panic("cannot select from channel inside janet_call");
|
||||
}
|
||||
|
||||
/* Check channels for immediate reads and writes */
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
|
||||
@@ -1471,13 +1531,16 @@ void janet_ev_deinit(void) {
|
||||
|
||||
static void janet_register_stream(JanetStream *stream) {
|
||||
if (NULL == CreateIoCompletionPort(stream->handle, janet_vm.iocp, (ULONG_PTR) stream, 0)) {
|
||||
janet_panicf("failed to listen for events: %V", janet_ev_lasterr());
|
||||
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | JANET_STREAM_ACCEPTABLE)) {
|
||||
janet_panicf("failed to listen for events: %V", janet_ev_lasterr());
|
||||
}
|
||||
stream->flags |= JANET_STREAM_UNREGISTERED;
|
||||
}
|
||||
}
|
||||
|
||||
void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
|
||||
ULONG_PTR completionKey = 0;
|
||||
DWORD num_bytes_transfered = 0;
|
||||
DWORD num_bytes_transferred = 0;
|
||||
LPOVERLAPPED overlapped = NULL;
|
||||
|
||||
/* Calculate how long to wait before timeout */
|
||||
@@ -1492,7 +1555,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
|
||||
} else {
|
||||
waittime = INFINITE;
|
||||
}
|
||||
BOOL result = GetQueuedCompletionStatus(janet_vm.iocp, &num_bytes_transfered, &completionKey, &overlapped, (DWORD) waittime);
|
||||
BOOL result = GetQueuedCompletionStatus(janet_vm.iocp, &num_bytes_transferred, &completionKey, &overlapped, (DWORD) waittime);
|
||||
|
||||
if (result || overlapped) {
|
||||
if (0 == completionKey) {
|
||||
@@ -1515,7 +1578,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
|
||||
if (fiber != NULL) {
|
||||
fiber->flags &= ~JANET_FIBER_EV_FLAG_IN_FLIGHT;
|
||||
/* System is done with this, we can reused this data */
|
||||
overlapped->InternalHigh = (ULONG_PTR) num_bytes_transfered;
|
||||
overlapped->InternalHigh = (ULONG_PTR) num_bytes_transferred;
|
||||
fiber->ev_callback(fiber, result ? JANET_ASYNC_EVENT_COMPLETE : JANET_ASYNC_EVENT_FAILED);
|
||||
} else {
|
||||
janet_free((void *) overlapped);
|
||||
@@ -1736,6 +1799,22 @@ void janet_stream_edge_triggered(JanetStream *stream) {
|
||||
}
|
||||
|
||||
void janet_stream_level_triggered(JanetStream *stream) {
|
||||
/* On macos, we seem to need to delete any registered events before re-registering without
|
||||
* EV_CLEAR, otherwise the new event will still have EV_CLEAR set erroneously. This could be a
|
||||
* kernel bug, but unfortunately the specification is vague here, esp. in regards to where and when
|
||||
* EV_CLEAR is set automatically. */
|
||||
struct kevent kevs[2];
|
||||
int length = 0;
|
||||
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
|
||||
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_DELETE, 0, 0, stream);
|
||||
}
|
||||
if (stream->flags & JANET_STREAM_WRITABLE) {
|
||||
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_DELETE, 0, 0, stream);
|
||||
}
|
||||
int status;
|
||||
do {
|
||||
status = kevent(janet_vm.kq, kevs, length, NULL, 0, NULL);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
janet_register_stream_impl(stream, 0);
|
||||
}
|
||||
|
||||
@@ -2327,6 +2406,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
} else {
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
}
|
||||
stream->read_fiber = NULL;
|
||||
janet_async_end(fiber);
|
||||
break;
|
||||
}
|
||||
@@ -2699,6 +2779,7 @@ static volatile long PipeSerialNumber;
|
||||
* mode = 0: both sides non-blocking.
|
||||
* mode = 1: only read side non-blocking: write side sent to subprocess
|
||||
* mode = 2: only write side non-blocking: read side sent to subprocess
|
||||
* mode = 3: both sides blocking - for use in two subprocesses (making pipeline from external processes)
|
||||
*/
|
||||
int janet_make_pipe(JanetHandle handles[2], int mode) {
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -2712,6 +2793,11 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
|
||||
memset(&saAttr, 0, sizeof(saAttr));
|
||||
saAttr.nLength = sizeof(saAttr);
|
||||
saAttr.bInheritHandle = TRUE;
|
||||
if (mode == 3) {
|
||||
/* No overlapped IO involved, just call CreatePipe */
|
||||
if (!CreatePipe(handles, handles + 1, &saAttr, 0)) return -1;
|
||||
return 0;
|
||||
}
|
||||
sprintf(PipeNameBuffer,
|
||||
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
|
||||
(unsigned int) GetCurrentProcessId(),
|
||||
@@ -2757,8 +2843,8 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
|
||||
if (pipe(handles)) return -1;
|
||||
if (mode != 2 && fcntl(handles[0], F_SETFD, FD_CLOEXEC)) goto error;
|
||||
if (mode != 1 && fcntl(handles[1], F_SETFD, FD_CLOEXEC)) goto error;
|
||||
if (mode != 2 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
|
||||
if (mode != 1 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
|
||||
if (mode != 2 && mode != 3 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
|
||||
if (mode != 1 && mode != 3 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
|
||||
return 0;
|
||||
error:
|
||||
close(handles[0]);
|
||||
@@ -2832,7 +2918,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
|
||||
}
|
||||
|
||||
/* Get supervsior */
|
||||
/* Get supervisor */
|
||||
if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
|
||||
Janet sup =
|
||||
janet_unmarshal(nextbytes, endbytes - nextbytes,
|
||||
@@ -3216,6 +3302,64 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static JanetFile *get_file_for_stream(JanetStream *stream) {
|
||||
int32_t flags = 0;
|
||||
char fmt[4] = {0};
|
||||
int index = 0;
|
||||
if (stream->flags & JANET_STREAM_READABLE) {
|
||||
flags |= JANET_FILE_READ;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
fmt[index++] = 'r';
|
||||
}
|
||||
if (stream->flags & JANET_STREAM_WRITABLE) {
|
||||
flags |= JANET_FILE_WRITE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
int currindex = index;
|
||||
fmt[index++] = (currindex == 0) ? 'w' : '+';
|
||||
}
|
||||
if (index == 0) return NULL;
|
||||
/* duplicate handle when converting stream to file */
|
||||
#ifdef JANET_WINDOWS
|
||||
int htype = 0;
|
||||
if (fmt[0] == 'r' && fmt[1] == '+') {
|
||||
htype = _O_RDWR;
|
||||
} else if (fmt[0] == 'r') {
|
||||
htype = _O_RDONLY;
|
||||
} else if (fmt[0] == 'w') {
|
||||
htype = _O_WRONLY;
|
||||
}
|
||||
int fd = _open_osfhandle((intptr_t) stream->handle, htype);
|
||||
if (fd < 0) return NULL;
|
||||
int fd_dup = _dup(fd);
|
||||
if (fd_dup < 0) return NULL;
|
||||
FILE *f = _fdopen(fd_dup, fmt);
|
||||
if (NULL == f) {
|
||||
_close(fd_dup);
|
||||
return NULL;
|
||||
}
|
||||
#else
|
||||
int fd_dup = dup(stream->handle);
|
||||
if (fd_dup < 0) return NULL;
|
||||
FILE *f = fdopen(fd_dup, fmt);
|
||||
if (NULL == f) {
|
||||
close(fd_dup);
|
||||
return NULL;
|
||||
}
|
||||
#endif
|
||||
return janet_makejfile(f, flags);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_to_file,
|
||||
"(ev/to-file)",
|
||||
"Create core/file copy of the stream. This value can be used "
|
||||
"when blocking IO behavior is needed.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
JanetFile *iof = get_file_for_stream(stream);
|
||||
if (iof == NULL) janet_panic("cannot make file from stream");
|
||||
return janet_wrap_abstract(iof);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_ev_all_tasks,
|
||||
"(ev/all-tasks)",
|
||||
"Get an array of all active fibers that are being used by the scheduler.") {
|
||||
@@ -3260,6 +3404,7 @@ void janet_lib_ev(JanetTable *env) {
|
||||
JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock),
|
||||
JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release),
|
||||
JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release),
|
||||
JANET_CORE_REG("ev/to-file", janet_cfun_to_file),
|
||||
JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks),
|
||||
JANET_REG_END
|
||||
};
|
||||
@@ -3269,6 +3414,8 @@ void janet_lib_ev(JanetTable *env) {
|
||||
janet_register_abstract_type(&janet_channel_type);
|
||||
janet_register_abstract_type(&janet_mutex_type);
|
||||
janet_register_abstract_type(&janet_rwlock_type);
|
||||
|
||||
janet_lib_filewatch(env);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
316
src/core/ffi.c
316
src/core/ffi.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -56,6 +56,9 @@
|
||||
#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;
|
||||
@@ -140,7 +143,13 @@ typedef enum {
|
||||
JANET_WIN64_REGISTER,
|
||||
JANET_WIN64_STACK,
|
||||
JANET_WIN64_REGISTER_REF,
|
||||
JANET_WIN64_STACK_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
|
||||
} JanetFFIWordSpec;
|
||||
|
||||
/* Describe how each Janet argument is interpreted in terms of machine words
|
||||
@@ -155,13 +164,16 @@ typedef struct {
|
||||
typedef enum {
|
||||
JANET_FFI_CC_NONE,
|
||||
JANET_FFI_CC_SYSV_64,
|
||||
JANET_FFI_CC_WIN_64
|
||||
JANET_FFI_CC_WIN_64,
|
||||
JANET_FFI_CC_AAPCS64
|
||||
} 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
|
||||
@@ -301,6 +313,9 @@ 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);
|
||||
@@ -385,7 +400,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 = member_count;
|
||||
st->field_count = 0;
|
||||
st->size = 0;
|
||||
st->align = 1;
|
||||
if (argc == 0) {
|
||||
@@ -403,6 +418,7 @@ 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;
|
||||
@@ -418,6 +434,7 @@ 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;
|
||||
}
|
||||
|
||||
@@ -475,7 +492,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 convertable type, got %v", n, argv[n]);
|
||||
janet_panicf("bad slot #%d, expected ffi pointer convertible type, got %v", n, argv[n]);
|
||||
case JANET_POINTER:
|
||||
case JANET_STRING:
|
||||
case JANET_KEYWORD:
|
||||
@@ -763,6 +780,101 @@ 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 "
|
||||
@@ -960,6 +1072,96 @@ 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 */
|
||||
@@ -1294,6 +1496,99 @@ 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. */
|
||||
@@ -1373,6 +1668,10 @@ 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
|
||||
}
|
||||
}
|
||||
@@ -1442,6 +1741,10 @@ 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
|
||||
}
|
||||
}
|
||||
@@ -1561,6 +1864,9 @@ 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);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
688
src/core/filewatch.c
Normal file
688
src/core/filewatch.c
Normal file
@@ -0,0 +1,688 @@
|
||||
/*
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* 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
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -321,9 +321,13 @@ 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: {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -64,7 +64,7 @@ enum JanetMemoryType {
|
||||
};
|
||||
|
||||
/* To allocate collectable memory, one must call janet_alloc, initialize the memory,
|
||||
* and then call when janet_enablegc when it is initailize and reachable by the gc (on the JANET stack) */
|
||||
* and then call when janet_enablegc when it is initialized and reachable by the gc (on the JANET stack) */
|
||||
void *janet_gcalloc(enum JanetMemoryType type, size_t size);
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose & contributors
|
||||
* Copyright (c) 2025 Calvin Rose & contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -191,21 +191,21 @@ Janet janet_wrap_u64(uint64_t x) {
|
||||
|
||||
JANET_CORE_FN(cfun_it_s64_new,
|
||||
"(int/s64 value)",
|
||||
"Create a boxed signed 64 bit integer from a string value.") {
|
||||
"Create a boxed signed 64 bit integer from a string value or a number.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_it_u64_new,
|
||||
"(int/u64 value)",
|
||||
"Create a boxed unsigned 64 bit integer from a string value.") {
|
||||
"Create a boxed unsigned 64 bit integer from a string value or a number.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_to_number,
|
||||
"(int/to-number value)",
|
||||
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
|
||||
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int64.") {
|
||||
janet_fixarity(argc, 1);
|
||||
if (janet_type(argv[0]) == JANET_ABSTRACT) {
|
||||
void *abst = janet_unwrap_abstract(argv[0]);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -31,6 +31,7 @@
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <fcntl.h>
|
||||
#include <sys/stat.h>
|
||||
#include <sys/wait.h>
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
@@ -164,6 +165,14 @@ JANET_CORE_FN(cfun_io_fopen,
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
if (f != NULL) {
|
||||
#ifndef JANET_WINDOWS
|
||||
struct stat st;
|
||||
fstat(fileno(f), &st);
|
||||
if (S_ISDIR(st.st_mode)) {
|
||||
fclose(f);
|
||||
janet_panicf("cannot open directory: %s", fname);
|
||||
}
|
||||
#endif
|
||||
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
|
||||
if (bufsize != BUFSIZ) {
|
||||
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
|
||||
@@ -294,7 +303,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 derefence is easier to debug then other problems */
|
||||
file->file = NULL; /* NULL dereference is easier to debug then other problems */
|
||||
return ret;
|
||||
}
|
||||
return 0;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -68,8 +68,15 @@ enum {
|
||||
LB_STRUCT_PROTO, /* 223 */
|
||||
#ifdef JANET_EV
|
||||
LB_THREADED_ABSTRACT, /* 224 */
|
||||
LB_POINTER_BUFFER, /* 224 */
|
||||
LB_POINTER_BUFFER, /* 225 */
|
||||
#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 */
|
||||
@@ -569,7 +576,8 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
int32_t i;
|
||||
JanetArray *a = janet_unwrap_array(x);
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_ARRAY);
|
||||
enum JanetMemoryType memtype = janet_gc_type(a);
|
||||
pushbyte(st, memtype == JANET_MEMORY_ARRAY_WEAK ? LB_ARRAY_WEAK : LB_ARRAY);
|
||||
pushint(st, a->count);
|
||||
for (i = 0; i < a->count; i++)
|
||||
marshal_one(st, a->data[i], flags + 1);
|
||||
@@ -592,7 +600,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
case JANET_TABLE: {
|
||||
JanetTable *t = janet_unwrap_table(x);
|
||||
MARK_SEEN();
|
||||
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
|
||||
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);
|
||||
}
|
||||
pushint(st, t->count);
|
||||
if (t->proto)
|
||||
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
|
||||
@@ -1417,11 +1434,18 @@ 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++;
|
||||
@@ -1430,9 +1454,9 @@ static const uint8_t *unmarshal_one(
|
||||
if (lead != LB_REFERENCE) {
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
}
|
||||
if (lead == LB_ARRAY) {
|
||||
if (lead == LB_ARRAY || lead == LB_ARRAY_WEAK) {
|
||||
/* Array */
|
||||
JanetArray *array = janet_array(len);
|
||||
JanetArray *array = (lead == LB_ARRAY_WEAK) ? janet_array_weak(len) : janet_array(len);
|
||||
array->count = len;
|
||||
*out = janet_wrap_array(array);
|
||||
janet_v_push(st->lookup, *out);
|
||||
@@ -1472,10 +1496,19 @@ static const uint8_t *unmarshal_one(
|
||||
*out = st->lookup[len];
|
||||
} else {
|
||||
/* Table */
|
||||
JanetTable *t = janet_table(len);
|
||||
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);
|
||||
}
|
||||
*out = janet_wrap_table(t);
|
||||
janet_v_push(st->lookup, *out);
|
||||
if (lead == LB_TABLE_PROTO) {
|
||||
if (lead == LB_TABLE_PROTO || lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKKV_PROTO) {
|
||||
Janet proto;
|
||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||
janet_asserttype(proto, JANET_TABLE, st);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -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] + (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->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->counter = 0u;
|
||||
/* a, b, c, d can't all be 0 */
|
||||
if (rng->a == 0) rng->a = 1u;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose and contributors.
|
||||
* Copyright (c) 2025 Calvin Rose and contributors.
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -325,7 +325,7 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio
|
||||
|
||||
#endif
|
||||
|
||||
/* Adress info */
|
||||
/* Address info */
|
||||
|
||||
static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
|
||||
JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL);
|
||||
@@ -554,7 +554,10 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
int err = WSAGetLastError();
|
||||
freeaddrinfo(ai);
|
||||
#else
|
||||
int status = connect(sock, addr, addrlen);
|
||||
int status;
|
||||
do {
|
||||
status = connect(sock, addr, addrlen);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
int err = errno;
|
||||
if (is_unix) {
|
||||
janet_free(ai);
|
||||
@@ -578,17 +581,23 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
net_sched_connect(stream);
|
||||
}
|
||||
|
||||
static const char *serverify_socket(JSock sfd) {
|
||||
static const char *serverify_socket(JSock sfd, int reuse_addr, int reuse_port) {
|
||||
/* Set various socket options */
|
||||
int enable = 1;
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEADDR) failed";
|
||||
if (reuse_addr) {
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEADDR) failed";
|
||||
}
|
||||
}
|
||||
if (reuse_port) {
|
||||
#ifdef SO_REUSEPORT
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEPORT) failed";
|
||||
}
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEPORT) failed";
|
||||
}
|
||||
#else
|
||||
(void) reuse_port;
|
||||
#endif
|
||||
}
|
||||
janet_net_socknoblock(sfd);
|
||||
return NULL;
|
||||
}
|
||||
@@ -642,19 +651,21 @@ JANET_CORE_FN(cfun_net_shutdown,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_listen,
|
||||
"(net/listen host port &opt type)",
|
||||
"(net/listen host port &opt type no-reuse)",
|
||||
"Creates a server. Returns a new stream that is neither readable nor "
|
||||
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
|
||||
"The type parameter specifies the type of network connection, either "
|
||||
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
|
||||
":stream. The host and port arguments are the same as in net/address.") {
|
||||
":stream. The host and port arguments are the same as in net/address. The last boolean parameter `no-reuse` will "
|
||||
"disable the use of SO_REUSEADDR and SO_REUSEPORT when creating a server on some operating systems.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
|
||||
janet_arity(argc, 2, 3);
|
||||
janet_arity(argc, 2, 4);
|
||||
|
||||
/* Get host, port, and handler*/
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix);
|
||||
int reuse = !(argc >= 4 && janet_truthy(argv[3]));
|
||||
|
||||
JSock sfd = JSOCKDEFAULT;
|
||||
#ifndef JANET_WINDOWS
|
||||
@@ -664,7 +675,7 @@ JANET_CORE_FN(cfun_net_listen,
|
||||
janet_free(ai);
|
||||
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
const char *err = serverify_socket(sfd);
|
||||
const char *err = serverify_socket(sfd, reuse, 0);
|
||||
if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_free(ai);
|
||||
@@ -687,7 +698,7 @@ JANET_CORE_FN(cfun_net_listen,
|
||||
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||
#endif
|
||||
if (!JSOCKVALID(sfd)) continue;
|
||||
const char *err = serverify_socket(sfd);
|
||||
const char *err = serverify_socket(sfd, reuse, reuse);
|
||||
if (NULL != err) {
|
||||
JSOCKCLOSE(sfd);
|
||||
continue;
|
||||
@@ -829,7 +840,7 @@ JANET_CORE_FN(cfun_stream_accept_loop,
|
||||
JANET_CORE_FN(cfun_stream_accept,
|
||||
"(net/accept stream &opt timeout)",
|
||||
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
|
||||
"Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Takes an optional timeout in seconds, after which will raise an error. "
|
||||
"Returns a new duplex stream which represents a connection to the client.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
@@ -844,7 +855,7 @@ JANET_CORE_FN(cfun_stream_read,
|
||||
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
|
||||
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
|
||||
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
|
||||
"Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Takes an optional timeout in seconds, after which will raise an error. "
|
||||
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") {
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
@@ -864,7 +875,7 @@ JANET_CORE_FN(cfun_stream_read,
|
||||
JANET_CORE_FN(cfun_stream_chunk,
|
||||
"(net/chunk stream nbytes &opt buf timeout)",
|
||||
"Same a net/read, but will wait for all n bytes to arrive rather than return early. "
|
||||
"Takes an optional timeout in seconds, after which will return nil.") {
|
||||
"Takes an optional timeout in seconds, after which will raise an error.") {
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
||||
@@ -878,7 +889,7 @@ JANET_CORE_FN(cfun_stream_chunk,
|
||||
JANET_CORE_FN(cfun_stream_recv_from,
|
||||
"(net/recv-from stream nbytes buf &opt timeout)",
|
||||
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
|
||||
"packet came from. Takes an optional timeout in seconds, after which will return nil.") {
|
||||
"packet came from. Takes an optional timeout in seconds, after which will raise an error.") {
|
||||
janet_arity(argc, 3, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
|
||||
@@ -892,7 +903,7 @@ JANET_CORE_FN(cfun_stream_recv_from,
|
||||
JANET_CORE_FN(cfun_stream_write,
|
||||
"(net/write stream data &opt timeout)",
|
||||
"Write data to a stream, suspending the current fiber until the write "
|
||||
"completes. Takes an optional timeout in seconds, after which will return nil. "
|
||||
"completes. Takes an optional timeout in seconds, after which will raise an error. "
|
||||
"Returns nil, or raises an error if the write failed.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
@@ -911,7 +922,7 @@ JANET_CORE_FN(cfun_stream_write,
|
||||
JANET_CORE_FN(cfun_stream_send_to,
|
||||
"(net/send-to stream dest data &opt timeout)",
|
||||
"Writes a datagram to a server stream. dest is a the destination address of the packet. "
|
||||
"Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Takes an optional timeout in seconds, after which will raise an error. "
|
||||
"Returns stream.") {
|
||||
janet_arity(argc, 3, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
|
||||
165
src/core/os.c
165
src/core/os.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose and contributors.
|
||||
* Copyright (c) 2025 Calvin Rose and contributors.
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -27,9 +27,10 @@
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <time.h>
|
||||
#include <fcntl.h>
|
||||
#include <errno.h>
|
||||
@@ -174,6 +175,8 @@ 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;
|
||||
@@ -200,6 +203,10 @@ 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
|
||||
@@ -245,7 +252,7 @@ JANET_CORE_FN(os_exit,
|
||||
}
|
||||
janet_deinit();
|
||||
if (argc >= 2 && janet_truthy(argv[1])) {
|
||||
_exit(status);
|
||||
_Exit(status);
|
||||
} else {
|
||||
exit(status);
|
||||
}
|
||||
@@ -534,11 +541,12 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||
proc->flags &= ~JANET_PROC_WAITING;
|
||||
janet_gcunroot(janet_wrap_abstract(proc));
|
||||
janet_gcunroot(janet_wrap_fiber(args.fiber));
|
||||
if ((status != 0) && (proc->flags & JANET_PROC_ERROR_NONZERO)) {
|
||||
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)) {
|
||||
uint32_t sched_id = (uint32_t) args.argi;
|
||||
if (janet_fiber_can_resume(args.fiber) && args.fiber->sched_id == sched_id) {
|
||||
if ((status != 0) && (proc->flags & JANET_PROC_ERROR_NONZERO)) {
|
||||
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
|
||||
janet_cancel(args.fiber, janet_wrap_string(s));
|
||||
} else {
|
||||
janet_schedule(args.fiber, janet_wrap_integer(status));
|
||||
}
|
||||
}
|
||||
@@ -596,6 +604,7 @@ os_proc_wait_impl(JanetProc *proc) {
|
||||
memset(&targs, 0, sizeof(targs));
|
||||
targs.argp = proc;
|
||||
targs.fiber = janet_root_fiber();
|
||||
targs.argi = (uint32_t) targs.fiber->sched_id;
|
||||
janet_gcroot(janet_wrap_abstract(proc));
|
||||
janet_gcroot(janet_wrap_fiber(targs.fiber));
|
||||
janet_ev_threaded_call(janet_proc_wait_subr, targs, janet_proc_wait_cb);
|
||||
@@ -622,16 +631,15 @@ 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.") {
|
||||
"Suspend the current fiber until the subprocess `proc` completes. Once `proc` "
|
||||
"completes, return the exit code of `proc`. If called more than once on the same "
|
||||
"core/process value, will raise an error. When creating subprocesses using "
|
||||
"`os/spawn`, this function should be called on the returned value to avoid zombie "
|
||||
"processes.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
@@ -736,12 +744,13 @@ static int get_signal_kw(const Janet *argv, int32_t n) {
|
||||
|
||||
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.") {
|
||||
"Kill the subprocess `proc` by sending SIGKILL to it on POSIX systems, or by closing "
|
||||
"the process handle on Windows. If `proc` has already completed, raise an error. If "
|
||||
"`wait` is truthy, will wait for `proc` to complete and return the exit code (this "
|
||||
"will raise an error if `proc` is being waited for). Otherwise, return `proc`. If "
|
||||
"`signal` is provided, send it instead of SIGKILL. Signal keywords are named after "
|
||||
"their C counterparts but in lowercase with the leading SIG stripped. `signal` is "
|
||||
"ignored on Windows.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
if (proc->flags & JANET_PROC_WAITED) {
|
||||
@@ -769,7 +778,6 @@ JANET_CORE_FN(os_proc_kill,
|
||||
if (argc > 1 && janet_truthy(argv[1])) {
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
@@ -780,9 +788,9 @@ 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.") {
|
||||
"Close pipes created for subprocess `proc` by `os/spawn` if they have not been "
|
||||
"closed. Then, if `proc` is not being waited for, wait. If this function waits, when "
|
||||
"`proc` completes, return the exit code of `proc`. Otherwise, return nil.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
@@ -800,7 +808,6 @@ JANET_CORE_FN(os_proc_close,
|
||||
}
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
@@ -1261,9 +1268,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
|
||||
/* exec mode */
|
||||
if (mode == JANET_EXECUTE_EXEC) {
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_panic("not supported on windows");
|
||||
#else
|
||||
int status;
|
||||
if (!use_environ) {
|
||||
environ = envp;
|
||||
@@ -1276,7 +1280,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
}
|
||||
} while (status == -1 && errno == EINTR);
|
||||
janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
@@ -1377,45 +1380,56 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
|
||||
JANET_CORE_FN(os_execute,
|
||||
"(os/execute args &opt flags env)",
|
||||
"Execute a program on the system and pass it string arguments. `flags` "
|
||||
"is a keyword that modifies how the program will execute.\n"
|
||||
"* :e - enables passing an environment to the program. Without :e, the "
|
||||
"Execute a program on the system and return the exit code. `args` is an array/tuple "
|
||||
"of strings. The first string is the name of the program and the remainder are "
|
||||
"arguments passed to the program. `flags` is a keyword made from the following "
|
||||
"characters that modifies how the program executes:\n"
|
||||
"* :e - enables passing an environment to the program. Without 'e', the "
|
||||
"current environment is inherited.\n"
|
||||
"* :p - allows searching the current PATH for the binary to execute. "
|
||||
"Without this flag, binaries must use absolute paths.\n"
|
||||
"* :x - raise error if exit code is non-zero.\n"
|
||||
"* :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.") {
|
||||
"* :p - allows searching the current PATH for the program to execute. "
|
||||
"Without this flag, the first element of `args` must be an absolute path.\n"
|
||||
"* :x - raises error if exit code is non-zero.\n"
|
||||
"* :d - prevents the garbage collector terminating the program (if still running) "
|
||||
"and calling the equivalent of `os/proc-wait` (allows zombie processes).\n"
|
||||
"`env` is a table/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 or core/stream values. "
|
||||
"If core/stream values are used, the caller is responsible for ensuring pipes do not "
|
||||
"cause the program to block and deadlock.") {
|
||||
return os_execute_impl(argc, argv, JANET_EXECUTE_EXECUTE);
|
||||
}
|
||||
|
||||
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.") {
|
||||
"Execute a program on the system and return a core/process value representing the "
|
||||
"spawned subprocess. Takes the same arguments as `os/execute` but does not wait for "
|
||||
"the subprocess to complete. Unlike `os/execute`, the value `:pipe` can be used for "
|
||||
":in, :out and :err keys in `env`. If used, the returned core/process will have a "
|
||||
"writable stream in the :in field and readable streams in the :out and :err fields. "
|
||||
"On non-Windows systems, the subprocess PID will be in the :pid field. The caller is "
|
||||
"responsible for waiting on the process (e.g. by calling `os/proc-wait` on the "
|
||||
"returned core/process value) to avoid creating zombie process. After the subprocess "
|
||||
"completes, the exit value is in the :return-code field. If `flags` includes 'x', a "
|
||||
"non-zero exit code will cause a waiting fiber to raise an error. The use of "
|
||||
"`:pipe` may fail if there are too many active file descriptors. The caller is "
|
||||
"responsible for closing pipes created by `:pipe` (either individually or using "
|
||||
"`os/proc-close`). Similar to `os/execute`, the caller is responsible for ensuring "
|
||||
"pipes do not cause the program to block and deadlock.") {
|
||||
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. "
|
||||
"Hoever, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and "
|
||||
"However, instead of creating a subprocess, the current process is replaced. Is not supported on Windows, and "
|
||||
"does not allow redirection of stdio.") {
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not supported on Windows");
|
||||
#else
|
||||
return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC);
|
||||
#endif
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_posix_fork,
|
||||
@@ -1426,7 +1440,7 @@ JANET_CORE_FN(os_posix_fork,
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_panic("not supported");
|
||||
janet_panic("not supported on Windows");
|
||||
#else
|
||||
pid_t result;
|
||||
do {
|
||||
@@ -1582,8 +1596,8 @@ JANET_CORE_FN(os_clock,
|
||||
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
|
||||
janet_arity(argc, 0, 2);
|
||||
|
||||
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime");
|
||||
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
|
||||
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;
|
||||
@@ -1596,8 +1610,8 @@ JANET_CORE_FN(os_clock,
|
||||
struct timespec tv;
|
||||
if (janet_gettime(&tv, source)) janet_panic("could not get time");
|
||||
|
||||
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
|
||||
if (janet_cstrcmp(formatstr, "double") == 0) {
|
||||
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) {
|
||||
@@ -1873,7 +1887,6 @@ JANET_CORE_FN(os_mktime,
|
||||
/* utc time */
|
||||
#ifdef JANET_NO_UTC_MKTIME
|
||||
janet_panic("os/mktime UTC not supported on this platform");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
t = timegm(&t_info);
|
||||
#endif
|
||||
@@ -1940,8 +1953,7 @@ JANET_CORE_FN(os_link,
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("os/link not supported on Windows");
|
||||
return janet_wrap_nil();
|
||||
janet_panic("not supported on Windows");
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
@@ -1959,8 +1971,7 @@ JANET_CORE_FN(os_symlink,
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("os/symlink not supported on Windows");
|
||||
return janet_wrap_nil();
|
||||
janet_panic("not supported on Windows");
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
@@ -2062,8 +2073,7 @@ JANET_CORE_FN(os_readlink,
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("os/readlink not supported on Windows");
|
||||
return janet_wrap_nil();
|
||||
janet_panic("not supported on Windows");
|
||||
#else
|
||||
static char buffer[PATH_MAX];
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
@@ -2319,7 +2329,6 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
return sg->fn(&st);
|
||||
}
|
||||
janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2668,7 +2677,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 {
|
||||
@@ -2680,16 +2689,24 @@ JANET_CORE_FN(os_open,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_pipe,
|
||||
"(os/pipe)",
|
||||
"(os/pipe &opt flags)",
|
||||
"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.") {
|
||||
"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.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
janet_arity(argc, 0, 1);
|
||||
JanetHandle fds[2];
|
||||
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);
|
||||
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);
|
||||
Janet tup[2] = {janet_wrap_abstract(reader), janet_wrap_abstract(writer)};
|
||||
return janet_wrap_tuple(janet_tuple_n(tup, 2));
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -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", s->line, s->column);
|
||||
janet_formatb(buffer, " opened at line %d, column %d", (int32_t) s->line, (int32_t) s->column);
|
||||
}
|
||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||
@@ -363,8 +363,7 @@ static int stringend(JanetParser *p, JanetParseState *state) {
|
||||
JanetParseState top = p->states[p->statecount - 1];
|
||||
int32_t indent_col = (int32_t) top.column - 1;
|
||||
uint8_t *r = bufstart, *end = r + buflen;
|
||||
/* Check if there are any characters before the start column -
|
||||
* if so, do not reindent. */
|
||||
/* Unless there are only spaces before EOLs, disable reindenting */
|
||||
int reindent = 1;
|
||||
while (reindent && (r < end)) {
|
||||
if (*r++ == '\n') {
|
||||
@@ -374,34 +373,36 @@ static int stringend(JanetParser *p, JanetParseState *state) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') reindent = 1;
|
||||
}
|
||||
}
|
||||
/* Now reindent if able to, otherwise just drop leading newline. */
|
||||
if (!reindent) {
|
||||
if (buflen > 0 && bufstart[0] == '\n') {
|
||||
buflen--;
|
||||
bufstart++;
|
||||
}
|
||||
} else {
|
||||
/* Now reindent if able */
|
||||
if (reindent) {
|
||||
uint8_t *w = bufstart;
|
||||
r = bufstart;
|
||||
while (r < end) {
|
||||
if (*r == '\n') {
|
||||
if (r == bufstart) {
|
||||
/* Skip leading newline */
|
||||
r++;
|
||||
} else {
|
||||
*w++ = *r++;
|
||||
}
|
||||
*w++ = *r++;
|
||||
for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++);
|
||||
if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') *w++ = *r++;
|
||||
} else {
|
||||
*w++ = *r++;
|
||||
}
|
||||
}
|
||||
buflen = (int32_t)(w - bufstart);
|
||||
}
|
||||
/* Check for trailing newline character so we can remove it */
|
||||
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
|
||||
/* Check for leading EOL so we can remove it */
|
||||
if (buflen > 1 && bufstart[0] == '\r' && bufstart[1] == '\n') { /* Windows EOL */
|
||||
buflen = buflen - 2;
|
||||
bufstart = bufstart + 2;
|
||||
} else if (buflen > 0 && bufstart[0] == '\n') { /* Unix EOL */
|
||||
buflen--;
|
||||
bufstart++;
|
||||
}
|
||||
/* Check for trailing EOL so we can remove it */
|
||||
if (buflen > 1 && bufstart[buflen - 2] == '\r' && bufstart[buflen - 1] == '\n') { /* Windows EOL */
|
||||
buflen = buflen - 2;
|
||||
} else if (buflen > 0 && bufstart[buflen - 1] == '\n') { /* Unix EOL */
|
||||
buflen--;
|
||||
}
|
||||
}
|
||||
@@ -467,8 +468,13 @@ 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)) {
|
||||
|
||||
155
src/core/peg.c
155
src/core/peg.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -134,7 +134,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 calcuate the line and column.
|
||||
* is before position. we use that to calculate 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 */
|
||||
@@ -342,7 +342,7 @@ tail:
|
||||
while (captured < hi) {
|
||||
CapState cs2 = cap_save(s);
|
||||
next_text = peg_rule(s, rule_a, text);
|
||||
if (!next_text || next_text == text) {
|
||||
if (!next_text || ((next_text == text) && (hi == UINT32_MAX))) {
|
||||
cap_load(s, cs2);
|
||||
break;
|
||||
}
|
||||
@@ -465,6 +465,16 @@ 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;
|
||||
@@ -486,6 +496,30 @@ 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];
|
||||
@@ -510,41 +544,80 @@ tail:
|
||||
return window_end;
|
||||
}
|
||||
|
||||
case RULE_TIL: {
|
||||
const uint32_t *rule_terminus = s->bytecode + rule[1];
|
||||
const uint32_t *rule_subpattern = s->bytecode + rule[2];
|
||||
|
||||
const uint8_t *terminus_start = text;
|
||||
const uint8_t *terminus_end = NULL;
|
||||
down1(s);
|
||||
while (terminus_start <= s->text_end) {
|
||||
CapState cs2 = cap_save(s);
|
||||
terminus_end = peg_rule(s, rule_terminus, terminus_start);
|
||||
cap_load(s, cs2);
|
||||
if (terminus_end) {
|
||||
break;
|
||||
}
|
||||
terminus_start++;
|
||||
}
|
||||
up1(s);
|
||||
|
||||
if (!terminus_end) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
const uint8_t *saved_end = s->text_end;
|
||||
s->text_end = terminus_start;
|
||||
down1(s);
|
||||
const uint8_t *matched = peg_rule(s, rule_subpattern, text);
|
||||
up1(s);
|
||||
s->text_end = saved_end;
|
||||
|
||||
if (!matched) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
return terminus_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;
|
||||
const uint8_t *chunk_start = text;
|
||||
const uint8_t *chunk_end = NULL;
|
||||
|
||||
while (text <= saved_end) {
|
||||
/* Find next split (or end of text) */
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text <= s->text_end) {
|
||||
separator_end = peg_rule(s, rule_separator, text);
|
||||
while (text <= saved_end) {
|
||||
chunk_end = text;
|
||||
const uint8_t *check = peg_rule(s, rule_separator, text);
|
||||
cap_load(s, cs);
|
||||
if (separator_end) {
|
||||
if (check) {
|
||||
text = check;
|
||||
break;
|
||||
}
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
|
||||
if (separator_end) {
|
||||
s->text_end = text;
|
||||
text = separator_end;
|
||||
}
|
||||
|
||||
/* Match between splits */
|
||||
s->text_end = chunk_end;
|
||||
down1(s);
|
||||
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
|
||||
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, chunk_start);
|
||||
up1(s);
|
||||
s->text_end = saved_end;
|
||||
if (!subpattern_end) return NULL; /* Don't match anything */
|
||||
|
||||
if (!subpattern_end) {
|
||||
return NULL;
|
||||
}
|
||||
} while (separator_end);
|
||||
/* Ensure forward progress */
|
||||
if (text == chunk_start) return NULL;
|
||||
chunk_start = text;
|
||||
}
|
||||
|
||||
s->text_end = saved_end;
|
||||
return s->text_end;
|
||||
}
|
||||
|
||||
@@ -667,11 +740,11 @@ tail:
|
||||
case RULE_READINT: {
|
||||
uint32_t tag = rule[2];
|
||||
uint32_t signedness = rule[1] & 0x10;
|
||||
uint32_t endianess = rule[1] & 0x20;
|
||||
uint32_t endianness = rule[1] & 0x20;
|
||||
int width = (int)(rule[1] & 0xF);
|
||||
if (text + width > s->text_end) return NULL;
|
||||
uint64_t accum = 0;
|
||||
if (endianess) {
|
||||
if (endianness) {
|
||||
/* BE */
|
||||
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
|
||||
} else {
|
||||
@@ -1061,6 +1134,9 @@ 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) {
|
||||
@@ -1084,6 +1160,15 @@ 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);
|
||||
@@ -1181,6 +1266,14 @@ static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_2(r, RULE_SUB, subrule1, subrule2);
|
||||
}
|
||||
|
||||
static void spec_til(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_TIL, subrule1, subrule2);
|
||||
}
|
||||
|
||||
static void spec_split(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
@@ -1262,7 +1355,9 @@ 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},
|
||||
@@ -1275,6 +1370,7 @@ static const SpecialPair peg_specials[] = {
|
||||
{"split", spec_split},
|
||||
{"sub", spec_sub},
|
||||
{"thru", spec_thru},
|
||||
{"til", spec_til},
|
||||
{"to", spec_to},
|
||||
{"uint", spec_uint_le},
|
||||
{"uint-be", spec_uint_be},
|
||||
@@ -1368,6 +1464,11 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
emit_bytes(b, RULE_LITERAL, len, str);
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER: {
|
||||
const JanetBuffer *buf = janet_unwrap_buffer(peg);
|
||||
emit_bytes(b, RULE_LITERAL, buf->count, buf->data);
|
||||
break;
|
||||
}
|
||||
case JANET_TABLE: {
|
||||
/* Build grammar table */
|
||||
JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));
|
||||
@@ -1609,6 +1710,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
i += 4;
|
||||
break;
|
||||
case RULE_SUB:
|
||||
case RULE_TIL:
|
||||
case RULE_SPLIT:
|
||||
/* [rule, rule] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
@@ -1619,6 +1721,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
break;
|
||||
case RULE_ERROR:
|
||||
case RULE_DROP:
|
||||
case RULE_ONLY_TAGS:
|
||||
case RULE_NOT:
|
||||
case RULE_TO:
|
||||
case RULE_THRU:
|
||||
@@ -1628,10 +1731,16 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
i += 2;
|
||||
break;
|
||||
case RULE_READINT:
|
||||
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
|
||||
/* [ width | (endianness << 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;
|
||||
}
|
||||
@@ -1725,7 +1834,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 suppliment "
|
||||
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement "
|
||||
"the grammar of the peg for otherwise undefined peg keywords.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetPeg *peg = compile_peg(argv[0]);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -28,7 +28,7 @@
|
||||
|
||||
/* Run a string */
|
||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
||||
JanetParser parser;
|
||||
JanetParser *parser;
|
||||
int errflags = 0, done = 0;
|
||||
int32_t index = 0;
|
||||
Janet ret = janet_wrap_nil();
|
||||
@@ -37,14 +37,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
|
||||
if (where) janet_gcroot(janet_wrap_string(where));
|
||||
if (NULL == sourcePath) sourcePath = "<unknown>";
|
||||
janet_parser_init(&parser);
|
||||
parser = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
janet_parser_init(parser);
|
||||
janet_gcroot(janet_wrap_abstract(parser));
|
||||
|
||||
/* While we haven't seen an error */
|
||||
while (!done) {
|
||||
|
||||
/* Evaluate parsed values */
|
||||
while (janet_parser_has_more(&parser)) {
|
||||
Janet form = janet_parser_produce(&parser);
|
||||
while (janet_parser_has_more(parser)) {
|
||||
Janet form = janet_parser_produce(parser);
|
||||
JanetCompileResult cres = janet_compile(form, env, where);
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
@@ -58,8 +60,8 @@ 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;
|
||||
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;
|
||||
@@ -81,16 +83,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
if (done) break;
|
||||
|
||||
/* Dispatch based on parse state */
|
||||
switch (janet_parser_status(&parser)) {
|
||||
switch (janet_parser_status(parser)) {
|
||||
case JANET_PARSE_DEAD:
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_ERROR: {
|
||||
const char *e = janet_parser_error(&parser);
|
||||
const char *e = janet_parser_error(parser);
|
||||
errflags |= 0x04;
|
||||
ret = janet_cstringv(e);
|
||||
int32_t line = (int32_t) parser.line;
|
||||
int32_t col = (int32_t) parser.column;
|
||||
int32_t line = (int32_t) parser->line;
|
||||
int32_t col = (int32_t) parser->column;
|
||||
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
|
||||
done = 1;
|
||||
break;
|
||||
@@ -98,9 +100,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
case JANET_PARSE_ROOT:
|
||||
case JANET_PARSE_PENDING:
|
||||
if (index >= len) {
|
||||
janet_parser_eof(&parser);
|
||||
janet_parser_eof(parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, bytes[index++]);
|
||||
janet_parser_consume(parser, bytes[index++]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -108,7 +110,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
}
|
||||
|
||||
/* Clean up and return errors */
|
||||
janet_parser_deinit(&parser);
|
||||
janet_gcunroot(janet_wrap_abstract(parser));
|
||||
if (where) janet_gcunroot(janet_wrap_string(where));
|
||||
#ifdef JANET_EV
|
||||
/* Enter the event loop if we are not already in it */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -58,7 +58,7 @@ void janet_vm_load(JanetVM *from) {
|
||||
}
|
||||
|
||||
/* Trigger suspension of the Janet vm by trying to
|
||||
* exit the interpeter loop when convenient. You can optionally
|
||||
* exit the interpreter 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;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -100,6 +100,7 @@ struct JanetVM {
|
||||
* return point for panics. */
|
||||
jmp_buf *signal_buf;
|
||||
Janet *return_reg;
|
||||
int coerce_error;
|
||||
|
||||
/* The global registry for c functions. Used to store meta-data
|
||||
* along with otherwise bare c function pointers. */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -71,10 +71,10 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
|
||||
int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash) {
|
||||
int32_t lhash = janet_string_hash(lhs);
|
||||
int32_t llen = janet_string_length(lhs);
|
||||
if (lhs == rhs)
|
||||
return 1;
|
||||
if (lhash != rhash || llen != rlen)
|
||||
return 0;
|
||||
if (lhs == rhs)
|
||||
return 1;
|
||||
return !memcmp(lhs, rhs, rlen);
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -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 hexidecimal number could be written
|
||||
* is always in base 10. For example, a hexadecimal number could be written
|
||||
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
|
||||
* hexidecimal literals. The previous number could also be written
|
||||
* hexadecimal literals. The previous number could also be written
|
||||
* '0xdeadbeef'.
|
||||
*/
|
||||
|
||||
@@ -301,6 +301,7 @@ int janet_scan_number_base(
|
||||
if (base == 0) {
|
||||
base = 10;
|
||||
}
|
||||
int exp_base = base;
|
||||
|
||||
/* Skip leading zeros */
|
||||
while (str < end && (*str == '0' || *str == '.')) {
|
||||
@@ -322,6 +323,12 @@ int janet_scan_number_base(
|
||||
} else if (*str == '&') {
|
||||
foundexp = 1;
|
||||
break;
|
||||
} else if (base == 16 && (*str == 'P' || *str == 'p')) { /* IEEE hex float */
|
||||
foundexp = 1;
|
||||
exp_base = 10;
|
||||
base = 2;
|
||||
ex *= 4; /* We need to correct the current exponent after we change the base */
|
||||
break;
|
||||
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
|
||||
foundexp = 1;
|
||||
break;
|
||||
@@ -360,9 +367,9 @@ int janet_scan_number_base(
|
||||
}
|
||||
while (str < end) {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str > 127 || digit >= base) goto error;
|
||||
if (*str > 127 || digit >= exp_base) goto error;
|
||||
if (ee < (INT32_MAX / 40)) {
|
||||
ee = base * ee + digit;
|
||||
ee = exp_base * ee + digit;
|
||||
}
|
||||
str++;
|
||||
seenadigit = 1;
|
||||
@@ -489,6 +496,40 @@ 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) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -294,6 +294,16 @@ JANET_CORE_FN(cfun_struct_to_table,
|
||||
return janet_wrap_table(tab);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_struct_rawget,
|
||||
"(struct/rawget st key)",
|
||||
"Gets a value from a struct `st` without looking at the prototype struct. "
|
||||
"If `st` does not contain the key directly, the function will return "
|
||||
"nil without checking the prototype. Returns the value in the struct.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetStruct st = janet_getstruct(argv, 0);
|
||||
return janet_struct_rawget(st, argv[1]);
|
||||
}
|
||||
|
||||
/* Load the struct module */
|
||||
void janet_lib_struct(JanetTable *env) {
|
||||
JanetRegExt struct_cfuns[] = {
|
||||
@@ -301,6 +311,7 @@ void janet_lib_struct(JanetTable *env) {
|
||||
JANET_CORE_REG("struct/getproto", cfun_struct_getproto),
|
||||
JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten),
|
||||
JANET_CORE_REG("struct/to-table", cfun_struct_to_table),
|
||||
JANET_CORE_REG("struct/rawget", cfun_struct_rawget),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, struct_cfuns);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -67,7 +67,7 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in
|
||||
return table;
|
||||
}
|
||||
|
||||
/* Initialize a table (for use withs scratch memory) */
|
||||
/* Initialize a table (for use with scratch memory) */
|
||||
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||
return janet_table_init_impl(table, capacity, 1);
|
||||
}
|
||||
@@ -372,12 +372,14 @@ JANET_CORE_FN(cfun_table_setproto,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_tostruct,
|
||||
"(table/to-struct tab)",
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables.") {
|
||||
janet_fixarity(argc, 1);
|
||||
"(table/to-struct tab &opt proto)",
|
||||
"Convert a table to a struct. Returns a new struct.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
return janet_wrap_struct(janet_table_to_struct(t));
|
||||
JanetStruct proto = janet_optstruct(argv, argc, 1, NULL);
|
||||
JanetStruct st = janet_table_to_struct(t);
|
||||
janet_struct_proto(st) = proto;
|
||||
return janet_wrap_struct(st);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_rawget,
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -116,6 +116,34 @@ 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[] = {
|
||||
@@ -124,6 +152,7 @@ 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);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -79,6 +79,7 @@ const char *const janet_type_names[16] = {
|
||||
"pointer"
|
||||
};
|
||||
|
||||
/* Docstring for signal lists these */
|
||||
const char *const janet_signal_names[14] = {
|
||||
"ok",
|
||||
"error",
|
||||
@@ -96,6 +97,7 @@ const char *const janet_signal_names[14] = {
|
||||
"await"
|
||||
};
|
||||
|
||||
/* Docstring for fiber/status lists these */
|
||||
const char *const janet_status_names[16] = {
|
||||
"dead",
|
||||
"error",
|
||||
@@ -115,14 +117,20 @@ const char *const janet_status_names[16] = {
|
||||
"alive"
|
||||
};
|
||||
|
||||
uint32_t janet_hash_mix(uint32_t input, uint32_t more) {
|
||||
uint32_t mix1 = (more + 0x9e3779b9 + (input << 6) + (input >> 2));
|
||||
return input ^ (0x9e3779b9 + (mix1 << 6) + (mix1 >> 2));
|
||||
}
|
||||
|
||||
#ifndef JANET_PRF
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
if (NULL == str) return 5381;
|
||||
if (NULL == str || len == 0) return 5381;
|
||||
const uint8_t *end = str + len;
|
||||
uint32_t hash = 5381;
|
||||
while (str < end)
|
||||
hash = (hash << 5) + hash + *str++;
|
||||
hash = janet_hash_mix(hash, (uint32_t) len);
|
||||
return (int32_t) hash;
|
||||
}
|
||||
|
||||
@@ -238,11 +246,6 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
|
||||
#endif
|
||||
|
||||
uint32_t janet_hash_mix(uint32_t input, uint32_t more) {
|
||||
uint32_t mix1 = (more + 0x9e3779b9 + (input << 6) + (input >> 2));
|
||||
return input ^ (0x9e3779b9 + (mix1 << 6) + (mix1 >> 2));
|
||||
}
|
||||
|
||||
/* Computes hash of an array of values */
|
||||
int32_t janet_array_calchash(const Janet *array, int32_t len) {
|
||||
const Janet *end = array + len;
|
||||
@@ -826,6 +829,20 @@ 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;
|
||||
@@ -958,7 +975,7 @@ 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(_GNU_SOURCE)
|
||||
#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
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -33,6 +33,7 @@
|
||||
#include <errno.h>
|
||||
#include <stddef.h>
|
||||
#include <stdbool.h>
|
||||
#include <math.h>
|
||||
|
||||
#ifdef JANET_EV
|
||||
#ifndef JANET_WINDOWS
|
||||
@@ -141,7 +142,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 libaries
|
||||
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libraries
|
||||
* with native code. */
|
||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||
typedef int Clib;
|
||||
@@ -189,9 +190,6 @@ 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
|
||||
@@ -202,7 +200,11 @@ 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
|
||||
#endif
|
||||
#ifdef JANET_FFI
|
||||
void janet_lib_ffi(JanetTable *env);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -798,14 +798,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_JUMP)
|
||||
pc += DS;
|
||||
vm_maybe_auto_suspend(DS <= 0);
|
||||
pc += DS;
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF)
|
||||
if (janet_truthy(stack[A])) {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
pc += ES;
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
@@ -815,15 +815,15 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_truthy(stack[A])) {
|
||||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
pc += ES;
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
pc += ES;
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
@@ -833,8 +833,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
pc += ES;
|
||||
}
|
||||
vm_next();
|
||||
|
||||
@@ -1268,7 +1268,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
|
||||
* reseting breakpoints to how they were prior. Yes, it's a bit hacky.
|
||||
* resetting 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. */
|
||||
@@ -1373,7 +1373,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
|
||||
/* Run vm */
|
||||
janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
int old_coerce_error = janet_vm.coerce_error;
|
||||
janet_vm.coerce_error = 1;
|
||||
JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil());
|
||||
janet_vm.coerce_error = old_coerce_error;
|
||||
|
||||
/* Teardown */
|
||||
janet_vm.stackn = oldn;
|
||||
@@ -1384,6 +1387,15 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
}
|
||||
|
||||
if (signal != JANET_SIGNAL_OK) {
|
||||
/* Should match logic in janet_signalv */
|
||||
#ifdef JANET_EV
|
||||
if (janet_vm.root_fiber != NULL && signal == JANET_SIGNAL_EVENT) {
|
||||
janet_vm.root_fiber->sched_id++;
|
||||
}
|
||||
#endif
|
||||
if (signal != JANET_SIGNAL_ERROR) {
|
||||
*janet_vm.return_reg = janet_wrap_string(janet_formatc("%v coerced from %s to error", *janet_vm.return_reg, janet_signal_names[signal]));
|
||||
}
|
||||
janet_panicv(*janet_vm.return_reg);
|
||||
}
|
||||
|
||||
@@ -1430,8 +1442,10 @@ void janet_try_init(JanetTryState *state) {
|
||||
state->vm_fiber = janet_vm.fiber;
|
||||
state->vm_jmp_buf = janet_vm.signal_buf;
|
||||
state->vm_return_reg = janet_vm.return_reg;
|
||||
state->coerce_error = janet_vm.coerce_error;
|
||||
janet_vm.return_reg = &(state->payload);
|
||||
janet_vm.signal_buf = &(state->buf);
|
||||
janet_vm.coerce_error = 0;
|
||||
}
|
||||
|
||||
void janet_restore(JanetTryState *state) {
|
||||
@@ -1440,6 +1454,7 @@ void janet_restore(JanetTryState *state) {
|
||||
janet_vm.fiber = state->vm_fiber;
|
||||
janet_vm.signal_buf = state->vm_jmp_buf;
|
||||
janet_vm.return_reg = state->vm_return_reg;
|
||||
janet_vm.coerce_error = state->coerce_error;
|
||||
}
|
||||
|
||||
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
@@ -1613,7 +1628,7 @@ int janet_init(void) {
|
||||
janet_vm.registry_count = 0;
|
||||
janet_vm.registry_dirty = 0;
|
||||
|
||||
/* Intialize abstract registry */
|
||||
/* Initialize abstract registry */
|
||||
janet_vm.abstract_registry = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -46,7 +46,7 @@ extern "C" {
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Detect OS and endianess.
|
||||
* Detect OS and endianness.
|
||||
* From webkit source. There is likely some extreneous
|
||||
* detection for unsupported platforms
|
||||
*/
|
||||
@@ -210,6 +210,11 @@ 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
|
||||
@@ -262,7 +267,7 @@ extern "C" {
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Tell complier some functions don't return */
|
||||
/* Tell compiler some functions don't return */
|
||||
#ifndef JANET_NO_RETURN
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JANET_NO_RETURN __declspec(noreturn)
|
||||
@@ -272,7 +277,7 @@ extern "C" {
|
||||
#endif
|
||||
|
||||
/* Prevent some recursive functions from recursing too deeply
|
||||
* ands crashing (the parser). Instead, error out. */
|
||||
* and crashing (the parser). Instead, error out. */
|
||||
#define JANET_RECURSION_GUARD 1024
|
||||
|
||||
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
||||
@@ -354,6 +359,7 @@ typedef struct {
|
||||
#ifdef JANET_EV
|
||||
typedef struct JanetOSMutex JanetOSMutex;
|
||||
typedef struct JanetOSRWLock JanetOSRWLock;
|
||||
typedef struct JanetChannel JanetChannel;
|
||||
#endif
|
||||
|
||||
/***** END SECTION CONFIG *****/
|
||||
@@ -627,7 +633,9 @@ typedef void (*JanetEVCallback)(JanetFiber *fiber, JanetAsyncEvent event);
|
||||
* 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. */
|
||||
* 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
|
||||
@@ -897,12 +905,16 @@ 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))
|
||||
@@ -1249,6 +1261,7 @@ typedef struct {
|
||||
/* new state */
|
||||
jmp_buf buf;
|
||||
Janet payload;
|
||||
int coerce_error;
|
||||
} JanetTryState;
|
||||
|
||||
/***** END SECTION TYPES *****/
|
||||
@@ -1409,6 +1422,7 @@ 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);
|
||||
@@ -1429,6 +1443,7 @@ JANET_NO_RETURN JANET_API void janet_sleep_await(double sec);
|
||||
/* For use inside listeners - adds a timeout to the current fiber, such that
|
||||
* it will be resumed after sec seconds if no other event schedules the current fiber. */
|
||||
JANET_API void janet_addtimeout(double sec);
|
||||
JANET_API void janet_addtimeout_nil(double sec);
|
||||
JANET_API void janet_ev_inc_refcount(void);
|
||||
JANET_API void janet_ev_dec_refcount(void);
|
||||
|
||||
@@ -1439,6 +1454,14 @@ 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);
|
||||
@@ -1594,6 +1617,9 @@ 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);
|
||||
@@ -1718,6 +1744,9 @@ 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);
|
||||
@@ -1781,6 +1810,7 @@ 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 */
|
||||
@@ -2020,7 +2050,10 @@ 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);
|
||||
@@ -2143,13 +2176,16 @@ typedef enum {
|
||||
RULE_TO, /* [rule] */
|
||||
RULE_THRU, /* [rule] */
|
||||
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
|
||||
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
|
||||
RULE_READINT, /* [(signedness << 4) | (endianness << 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_TIL, /* [rule, rule] */
|
||||
RULE_SPLIT, /* [rule, rule] */
|
||||
RULE_NTH, /* [nth, rule, tag] */
|
||||
RULE_ONLY_TAGS, /* [rule] */
|
||||
} JanetPegOpcod;
|
||||
|
||||
typedef struct {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -867,7 +867,7 @@ static int line() {
|
||||
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
|
||||
for (;;) {
|
||||
char c;
|
||||
char seq[3];
|
||||
char seq[5];
|
||||
|
||||
int rc;
|
||||
do {
|
||||
@@ -991,6 +991,20 @@ 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;
|
||||
@@ -1163,6 +1177,7 @@ 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 */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2023 Calvin Rose
|
||||
* Copyright (c) 2025 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -4,24 +4,47 @@
|
||||
(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
|
||||
(defn- assert-no-tail
|
||||
"Override's the default assert with some nice error handling."
|
||||
[x &opt e]
|
||||
(default e "assert error")
|
||||
(++ num-tests-run)
|
||||
(when (pos? skip-n)
|
||||
(-- skip-n)
|
||||
(++ skip-count)
|
||||
(break x))
|
||||
(default e "assert error")
|
||||
(when x (++ num-tests-passed))
|
||||
(def str (string e))
|
||||
(def frame (last (debug/stack (fiber/current))))
|
||||
(def stack (debug/stack (fiber/current)))
|
||||
(def frame (last stack))
|
||||
(def line-info (string/format "%s:%d"
|
||||
(frame :source) (frame :source-line)))
|
||||
(if x
|
||||
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
|
||||
(do (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
|
||||
(do
|
||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
|
||||
x)
|
||||
|
||||
(defn skip-asserts
|
||||
"Skip some asserts"
|
||||
[n]
|
||||
(+= skip-n n)
|
||||
nil)
|
||||
|
||||
(defmacro assert
|
||||
[x &opt e]
|
||||
(def xx (gensym))
|
||||
(default e (string/format "%j" x))
|
||||
~(do
|
||||
(def ,xx ,x)
|
||||
(,assert-no-tail ,xx ,e)
|
||||
,xx))
|
||||
|
||||
(defmacro assert-error
|
||||
[msg & forms]
|
||||
(def errsym (keyword (gensym)))
|
||||
@@ -52,5 +75,22 @@
|
||||
(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.")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
(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)))
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -46,7 +46,6 @@
|
||||
(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")
|
||||
|
||||
|
||||
# array/peek
|
||||
(assert (nil? (array/peek @[])) "array/peek empty")
|
||||
|
||||
@@ -76,6 +75,16 @@
|
||||
(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)
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -754,7 +754,7 @@
|
||||
(default name (string "has-key? " (++ test-has-key-auto)))
|
||||
(assert (= expected (has-key? col key)) name)
|
||||
(if
|
||||
# guarenteed by `has-key?` to never fail
|
||||
# guaranteed by `has-key?` to never fail
|
||||
expected (in col key)
|
||||
# if `has-key?` is false, then `in` should fail (for indexed types)
|
||||
#
|
||||
@@ -896,11 +896,18 @@
|
||||
(struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2"))
|
||||
(table/setproto table-to-freeze @{:a @[1 2 3]})
|
||||
|
||||
(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"}
|
||||
(freeze table-to-freeze)))
|
||||
(assert (deep= struct-to-thaw (freeze table-to-freeze)))
|
||||
(assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
|
||||
(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
|
||||
|
||||
# Check that freezing mutable keys is deterministic
|
||||
# for issue #1535
|
||||
(def hashes @{})
|
||||
(repeat 200
|
||||
(def x (freeze {@"" 1 @"" 2 @"" 3 @"" 4 @"" 5}))
|
||||
(put hashes (hash x) true))
|
||||
(assert (= 1 (length hashes)) "freeze mutable keys is deterministic")
|
||||
|
||||
# Make sure Carriage Returns don't end up in doc strings
|
||||
# e528b86
|
||||
(assert (not (string/find "\r"
|
||||
@@ -979,4 +986,34 @@
|
||||
(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-error "assertf 1 argument" (macex '(assertf true)))
|
||||
(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 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"))
|
||||
|
||||
# issue #1535
|
||||
(loop [i :range [1 1000]]
|
||||
(assert (deep-not= @{:key1 "value1" @"key" "value2"}
|
||||
@{:key1 "value1" @"key" "value2"}) "deep= mutable keys"))
|
||||
(assert (deep-not= {"abc" 123} {@"abc" 123}) "deep= mutable keys vs immutable key")
|
||||
(assert (deep-not= {@"" 1 @"" 2 @"" 3} {@"" 1 @"" 2 @"" 3}) "deep= duplicate mutable keys")
|
||||
(assert (deep-not= {@"" @"" @"" @"" @"" 3} {@"" @"" @"" @"" @"" 3}) "deep= duplicate mutable keys 2")
|
||||
(assert (deep-not= {@[] @"" @[] @"" @[] 3} {@[] @"" @[] @"" @[] 3}) "deep= duplicate mutable keys 3")
|
||||
(assert (deep-not= {@{} @"" @{} @"" @{} 3} {@{} @"" @{} @"" @{} 3}) "deep= duplicate mutable keys 4")
|
||||
(assert (deep-not= @{:key1 "value1" @"key2" @"value2"}
|
||||
@{:key1 "value1" @"key2" "value2"}) "deep= mutable keys")
|
||||
(assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"}
|
||||
@{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2024 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -85,9 +85,11 @@
|
||||
(buffer/push-uint16 buffer-uint16-le :le 0x0102)
|
||||
(assert (= "\x02\x01" (string buffer-uint16-le)) "buffer/push-uint16 little endian")
|
||||
|
||||
(def buffer-uint16-negative @"")
|
||||
(buffer/push-uint16 buffer-uint16-negative :be -1)
|
||||
(assert (= "\xff\xff" (string buffer-uint16-negative)) "buffer/push-uint16 negative")
|
||||
(def buffer-uint16-max @"")
|
||||
(buffer/push-uint16 buffer-uint16-max :be 0xFFFF)
|
||||
(assert (= "\xff\xff" (string buffer-uint16-max)) "buffer/push-uint16 max")
|
||||
(assert-error "too large" (buffer/push-uint16 @"" 0x1FFFF))
|
||||
(assert-error "too small" (buffer/push-uint16 @"" -0x1))
|
||||
|
||||
(def buffer-uint32-be @"")
|
||||
(buffer/push-uint32 buffer-uint32-be :be 0x01020304)
|
||||
@@ -97,9 +99,9 @@
|
||||
(buffer/push-uint32 buffer-uint32-le :le 0x01020304)
|
||||
(assert (= "\x04\x03\x02\x01" (string buffer-uint32-le)) "buffer/push-uint32 little endian")
|
||||
|
||||
(def buffer-uint32-negative @"")
|
||||
(buffer/push-uint32 buffer-uint32-negative :be -1)
|
||||
(assert (= "\xff\xff\xff\xff" (string buffer-uint32-negative)) "buffer/push-uint32 negative")
|
||||
(def buffer-uint32-max @"")
|
||||
(buffer/push-uint32 buffer-uint32-max :be 0xFFFFFFFF)
|
||||
(assert (= "\xff\xff\xff\xff" (string buffer-uint32-max)) "buffer/push-uint32 max")
|
||||
|
||||
(def buffer-float32-be @"")
|
||||
(buffer/push-float32 buffer-float32-be :be 1.234)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2024 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,30 +23,20 @@
|
||||
|
||||
(assert true) # smoke test
|
||||
|
||||
# Testing here is stateful since we are manipulating the filesystem.
|
||||
|
||||
# Copy since not exposed in boot.janet
|
||||
(defn- bundle-rpath
|
||||
[path]
|
||||
(string/replace-all "\\" "/" (os/realpath path)))
|
||||
|
||||
(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)
|
||||
|
||||
# Test mkdir -> rmdir
|
||||
(assert (os/mkdir "tempdir123"))
|
||||
(rmrf "tempdir123")
|
||||
|
||||
# Setup a temporary syspath for manipultation
|
||||
(math/seedrandom (os/cryptorand 16))
|
||||
(def syspath (string (math/random) "_jpm_tree.tmp"))
|
||||
(def syspath (randdir))
|
||||
(rmrf syspath)
|
||||
(assert (os/mkdir syspath))
|
||||
(put root-env *syspath* (bundle-rpath syspath))
|
||||
@@ -100,6 +90,13 @@
|
||||
(assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]"
|
||||
(bundle/uninstall "sample-dep1"))
|
||||
|
||||
# Check bundle file aliases
|
||||
(assert-no-error "sample-bundle-aliases install" (bundle/install "./examples/sample-bundle-aliases"))
|
||||
(assert (= 4 (length (bundle/list))) "bundles are listed correctly 5")
|
||||
(assert-no-error "import aliases" (import aliases-mod))
|
||||
(assert (deep= (range 12) (aliases-mod/fun 12)) "using sample-bundle-aliases")
|
||||
(assert-no-error "aliases uninstall" (bundle/uninstall "sample-bundle-aliases"))
|
||||
|
||||
# Now re-install sample-bundle as auto-remove
|
||||
(assert-no-error "sample-bundle install" (bundle/reinstall "sample-bundle" :auto-remove true))
|
||||
|
||||
@@ -120,6 +117,11 @@
|
||||
(assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
|
||||
(assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8")
|
||||
|
||||
# Try installing a bundle that fails check
|
||||
(assert-error "bad test" (bundle/install "./examples/sample-bad-bundle" :check true))
|
||||
(assert (= 0 (length (bundle/list))) "check failure 0")
|
||||
(assert (= 0 (length (bundle/topolist))) "check failure 1")
|
||||
|
||||
(rmrf syspath)
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -69,6 +69,13 @@
|
||||
(seq [n :range [0 10]] (% n 5 3))
|
||||
[0 1 2 0 1 0 1 2 0 1]) "variadic mod")
|
||||
|
||||
# linspace range
|
||||
(assert (deep= @[0 1 2 3] (range 4)) "range 1")
|
||||
(assert (deep= @[0 1 2 3] (range 3.01)) "range 2")
|
||||
(assert (deep= @[0 1 2 3] (range 3.999)) "range 3")
|
||||
(assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 4")
|
||||
(assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 5")
|
||||
|
||||
(assert (< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
@@ -167,6 +174,7 @@
|
||||
(assert (deep= (range 0 17 4) @[0 4 8 12 16]) "(range 0 17 4)")
|
||||
(assert (deep= (range 16 0 -4) @[16 12 8 4]) "(range 16 0 -4)")
|
||||
(assert (deep= (range 17 0 -4) @[17 13 9 5 1]) "(range 17 0 -4)")
|
||||
(assert-error "large range" (range 0xFFFFFFFFFF))
|
||||
|
||||
(assert (= (length (range 10)) 10) "(range 10)")
|
||||
(assert (= (length (range -10)) 0) "(range -10)")
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
# Copyright (c) 2025 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -199,7 +199,7 @@
|
||||
(assert s "made server 1")
|
||||
|
||||
(defn test-echo [msg]
|
||||
(with [conn (net/connect test-host test-port)]
|
||||
(with [conn (assert (net/connect test-host test-port))]
|
||||
(net/write conn msg)
|
||||
(def res (net/read conn 1024))
|
||||
(assert (= (string res) msg) (string "echo " msg))))
|
||||
@@ -213,6 +213,7 @@
|
||||
|
||||
# Test on both server and client
|
||||
# 504411e
|
||||
(var iterations 0)
|
||||
(defn names-handler
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
@@ -220,21 +221,26 @@
|
||||
(ev/read stream 1)
|
||||
(def [host port] (net/localname stream))
|
||||
(assert (= host test-host) "localname host server")
|
||||
(assert (= port (scan-number test-port)) "localname port server")))
|
||||
(assert (= port (scan-number test-port)) "localname port server")
|
||||
(++ iterations)
|
||||
(ev/write stream " ")))
|
||||
|
||||
# Test localname and peername
|
||||
# 077bf5eba
|
||||
(repeat 10
|
||||
(with [s (net/server test-host test-port names-handler)]
|
||||
(repeat 10
|
||||
(with [conn (net/connect test-host test-port)]
|
||||
(with [conn (assert (net/connect test-host test-port))]
|
||||
(def [host port] (net/peername conn))
|
||||
(assert (= host test-host) "peername host client ")
|
||||
(assert (= port (scan-number test-port)) "peername port client")
|
||||
# let server close
|
||||
(ev/write conn " "))))
|
||||
(++ iterations)
|
||||
(ev/write conn " ")
|
||||
(ev/read conn 1))))
|
||||
(gccollect))
|
||||
|
||||
(assert (= iterations 200) "localname and peername not enough checks")
|
||||
|
||||
# Create pipe
|
||||
# 12f09ad2d
|
||||
(var pipe-counter 0)
|
||||
@@ -375,4 +381,173 @@
|
||||
(ev/cancel f (gensym))
|
||||
(ev/take superv)
|
||||
|
||||
# Chat server test
|
||||
(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]
|
||||
(net/write connection "Whats your name?\n")
|
||||
(def name (string/trim (string (ev/read connection 100))))
|
||||
(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)))))))
|
||||
|
||||
# Now launch the chat server
|
||||
(def chat-server (net/listen test-host test-port))
|
||||
(ev/spawn
|
||||
(forever
|
||||
(def [ok connection] (protect (net/accept chat-server)))
|
||||
(if (and ok connection)
|
||||
(ev/call handler connection)
|
||||
(break))))
|
||||
|
||||
# Make sure we can't bind again with no-reuse
|
||||
(assert-error "no-reuse"
|
||||
(net/listen test-host test-port :stream true))
|
||||
|
||||
# Read from socket
|
||||
|
||||
(defn expect-read
|
||||
[stream text]
|
||||
(def result (string (net/read stream 100)))
|
||||
(assert (= result text) (string/format "expected %v, got %v" text result)))
|
||||
|
||||
# Now do our telnet chat
|
||||
(def bob (assert (net/connect test-host test-port :stream)))
|
||||
(expect-read bob "Whats your name?\n")
|
||||
(if (= :mingw (os/which))
|
||||
(net/write bob "bob")
|
||||
(do
|
||||
(def fbob (ev/to-file bob))
|
||||
(file/write fbob "bob")
|
||||
(file/flush fbob)
|
||||
(:close fbob)))
|
||||
(expect-read bob "Welcome bob\n")
|
||||
(def alice (assert (net/connect test-host test-port)))
|
||||
(expect-read alice "Whats your name?\n")
|
||||
(net/write alice "alice")
|
||||
(expect-read alice "Welcome alice\n")
|
||||
|
||||
# Bob says hello, alice gets the message
|
||||
(net/write bob "hello\n")
|
||||
(expect-read alice "[bob]:hello\n")
|
||||
|
||||
# Alice says hello, bob gets the message
|
||||
(net/write alice "hi\n")
|
||||
(expect-read bob "[alice]:hi\n")
|
||||
|
||||
# Ted joins the chat server
|
||||
(def ted (assert (net/connect test-host test-port)))
|
||||
(expect-read ted "Whats your name?\n")
|
||||
(net/write ted "ted")
|
||||
(expect-read ted "Welcome ted\n")
|
||||
|
||||
# Ted says hi, alice and bob get message
|
||||
(net/write ted "hi\n")
|
||||
(expect-read alice "[ted]:hi\n")
|
||||
(expect-read bob "[ted]:hi\n")
|
||||
|
||||
# Bob leaves for work. Now it's just ted and alice
|
||||
(:close bob)
|
||||
|
||||
# Alice messages ted, ted gets message
|
||||
(net/write alice "wuzzup\n")
|
||||
(expect-read ted "[alice]:wuzzup\n")
|
||||
(net/write ted "not much\n")
|
||||
(expect-read alice "[ted]:not much\n")
|
||||
|
||||
# Alice bounces
|
||||
(:close alice)
|
||||
|
||||
# Ted can send messages, nobody gets them :(
|
||||
(net/write ted "hello?\n")
|
||||
(:close ted)
|
||||
|
||||
# Close chat server
|
||||
(:close chat-server)
|
||||
|
||||
# Issue #1531
|
||||
(defn sleep-print [x] (ev/sleep 0) (print x))
|
||||
(protect (with-dyns [*out* sleep-print] (prin :foo)))
|
||||
(defn level-trigger-handling [conn &] (:close conn))
|
||||
(def s (assert (net/server test-host test-port level-trigger-handling)))
|
||||
(def c (assert (net/connect test-host test-port)))
|
||||
(:close s)
|
||||
|
||||
# Issue #1531 no. 2
|
||||
(def c (ev/chan 0))
|
||||
(ev/spawn (while (def x (ev/take c))))
|
||||
(defn print-to-chan [x] (ev/give c x))
|
||||
(assert-error "coerce await inside janet_call to error"
|
||||
(with-dyns [*out* print-to-chan]
|
||||
(pp :foo)))
|
||||
(ev/chan-close c)
|
||||
|
||||
# soreuseport on unix domain sockets
|
||||
(compwhen (or (= :macos (os/which)) (= :linux (os/which)))
|
||||
(assert-no-error "unix-domain socket reuseaddr"
|
||||
(let [s (net/listen :unix "./unix-domain-socket" :stream)]
|
||||
(:close s))))
|
||||
|
||||
# net/accept-loop level triggering
|
||||
(gccollect)
|
||||
(def maxconn 50)
|
||||
(var connect-count 0)
|
||||
(defn level-trigger-handling
|
||||
[conn &]
|
||||
(with [conn conn]
|
||||
(ev/write conn (ev/read conn 4096))
|
||||
(++ connect-count)))
|
||||
(def s (assert (net/server test-host test-port level-trigger-handling)))
|
||||
(def cons @[])
|
||||
(repeat maxconn (array/push cons (assert (net/connect test-host test-port))))
|
||||
(assert (= maxconn (length cons)))
|
||||
(defn do-connect [i]
|
||||
(with [c (get cons i)]
|
||||
(ev/write c "abc123")
|
||||
(ev/read c 4096)))
|
||||
(for i 0 maxconn (ev/spawn (do-connect i)))
|
||||
(ev/sleep 0.1)
|
||||
(assert (= maxconn connect-count))
|
||||
(:close s)
|
||||
|
||||
# Cancel os/proc-wait with ev/deadline
|
||||
(let [p (os/spawn [;run janet "-e" "(os/sleep 4)"] :p)]
|
||||
(var terminated-normally false)
|
||||
(assert-error "deadline expired"
|
||||
(ev/with-deadline 0.01
|
||||
(os/proc-wait p)
|
||||
(print "uhoh")
|
||||
(set terminated-normally true)))
|
||||
(assert (not terminated-normally) "early termination failure")
|
||||
# Without this kill, janet will wait the full 4 seconds for the subprocess to complete before exiting.
|
||||
(assert-no-error "kill proc after wait failed" (os/proc-kill p)))
|
||||
|
||||
# Cancel os/proc-wait with ev/deadline 2
|
||||
(let [p (os/spawn [;run janet "-e" "(os/sleep 0.1)"] :p)]
|
||||
(var terminated-normally false)
|
||||
(assert-error "deadline expired"
|
||||
(ev/with-deadline 0.05
|
||||
(os/proc-wait p)
|
||||
(print "uhoh")
|
||||
(set terminated-normally true)))
|
||||
(assert (not terminated-normally) "early termination failure 2")
|
||||
(ev/sleep 0.15)
|
||||
(assert (not terminated-normally) "early termination failure 3"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
# Copyright (c) 2025 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,7 +21,6 @@
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# We should get ARM support...
|
||||
(def has-ffi (dyn 'ffi/native))
|
||||
(def has-full-ffi
|
||||
(and has-ffi
|
||||
@@ -53,5 +52,7 @@
|
||||
(assert (= 26 (ffi/size [:char :pack :int @[:char 21]]))
|
||||
"array struct size"))
|
||||
|
||||
(end-suite)
|
||||
(compwhen has-ffi
|
||||
(assert-error "bad struct issue #1512" (ffi/struct :void)))
|
||||
|
||||
(end-suite)
|
||||
|
||||
204
test/suite-filewatch.janet
Normal file
204
test/suite-filewatch.janet
Normal file
@@ -0,0 +1,204 @@
|
||||
# Copyright (c) 2025 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
(assert true)
|
||||
|
||||
(def chan (ev/chan 1000))
|
||||
(def is-win (or (= :mingw (os/which)) (= :windows (os/which))))
|
||||
(def is-linux (= :linux (os/which)))
|
||||
|
||||
# If not supported, exit early
|
||||
(def [supported msg] (protect (filewatch/new chan)))
|
||||
(when (and (not supported) (string/find "filewatch not supported" msg))
|
||||
(end-suite)
|
||||
(quit))
|
||||
|
||||
# Test GC
|
||||
(assert-no-error "filewatch/new" (filewatch/new chan))
|
||||
(gccollect)
|
||||
|
||||
(defn- expect
|
||||
[key value & more-kvs]
|
||||
(ev/with-deadline
|
||||
1
|
||||
(def event (ev/take chan))
|
||||
(when is-verbose (pp event))
|
||||
(assert event "check event")
|
||||
(assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value))
|
||||
(when (next more-kvs)
|
||||
(each [k v] (partition 2 more-kvs)
|
||||
(assert (= v (get event k)) (string/format "got %p, expected %p" (get event k) v))))))
|
||||
|
||||
(defn- expect-empty
|
||||
[]
|
||||
(assert (zero? (ev/count chan)) "channel check empty")
|
||||
(ev/sleep 0) # turn the event loop
|
||||
(assert (zero? (ev/count chan)) "channel check empty")
|
||||
# Drain if not empty, help with failures after this
|
||||
(while (pos? (ev/count chan)) (printf "extra: %p" (ev/take chan))))
|
||||
|
||||
(defn- expect-maybe
|
||||
"On wine + mingw, we get an extra event. This is a wine peculiarity."
|
||||
[key value]
|
||||
(ev/with-deadline
|
||||
1
|
||||
(ev/sleep 0)
|
||||
(when (pos? (ev/count chan))
|
||||
(def event (ev/take chan))
|
||||
(when is-verbose (pp event))
|
||||
(assert event "check event")
|
||||
(assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value)))))
|
||||
|
||||
(defn spit-file
|
||||
[dir name]
|
||||
(def path (string dir "/" name))
|
||||
(spit path "test text"))
|
||||
|
||||
# Different operating systems report events differently. While it would be nice to
|
||||
# normalize this, each system has very large limitations in what can be reported when
|
||||
# compared with other systems. As such, the maximum subset of common functionality here
|
||||
# is quite small. Instead, test the capabilities of each system.
|
||||
|
||||
# Create a file watcher on two test directories
|
||||
(def fw (filewatch/new chan))
|
||||
(def td1 (randdir))
|
||||
(def td2 (randdir))
|
||||
(def td3 (randdir))
|
||||
(rmrf td1)
|
||||
(rmrf td2)
|
||||
(os/mkdir td1)
|
||||
(os/mkdir td2)
|
||||
(os/mkdir td3)
|
||||
(spit-file td3 "file3.txt")
|
||||
(when is-win
|
||||
(filewatch/add fw td1 :last-write :last-access :file-name :dir-name :size :attributes :recursive)
|
||||
(filewatch/add fw td2 :last-write :last-access :file-name :dir-name :size :attributes))
|
||||
(when is-linux
|
||||
(filewatch/add fw (string td3 "/file3.txt") :close-write :create :delete)
|
||||
(filewatch/add fw td1 :close-write :create :delete)
|
||||
(filewatch/add fw td2 :close-write :create :delete :ignored))
|
||||
(assert-no-error "filewatch/listen no error" (filewatch/listen fw))
|
||||
|
||||
#
|
||||
# Windows file writing
|
||||
#
|
||||
|
||||
(when is-win
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :added :file-name "file1.txt" :dir-name td1)
|
||||
(expect :type :modified)
|
||||
(expect-maybe :type :modified) # for mingw + wine
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :modified)
|
||||
(expect :type :modified)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
|
||||
# Check td2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect :type :added)
|
||||
(expect :type :modified)
|
||||
(expect-maybe :type :modified)
|
||||
|
||||
# Remove a file, then wait for remove event
|
||||
(rmrf (string td1 "/file1.txt"))
|
||||
(expect :type :removed)
|
||||
(expect-empty)
|
||||
|
||||
# Unlisten to some events
|
||||
(filewatch/remove fw td2)
|
||||
|
||||
# Check that we don't get anymore events from test directory 2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect-empty)
|
||||
|
||||
# Repeat and things should still work with test directory 1
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :added)
|
||||
(expect :type :modified)
|
||||
(expect-maybe :type :modified)
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :modified)
|
||||
(expect :type :modified)
|
||||
(expect-maybe :type :modified)
|
||||
(gccollect))
|
||||
|
||||
#
|
||||
# Linux file writing
|
||||
#
|
||||
|
||||
(when is-linux
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :create :file-name "file1.txt" :dir-name td1)
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
|
||||
# Check file3.txt
|
||||
(spit-file td3 "file3.txt")
|
||||
(expect :type :close-write :file-name "file3.txt" :dir-name td3)
|
||||
(expect-empty)
|
||||
|
||||
# Check td2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect :type :create)
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
|
||||
# Remove a file, then wait for remove event
|
||||
(rmrf (string td1 "/file1.txt"))
|
||||
(expect :type :delete)
|
||||
(expect-empty)
|
||||
|
||||
# Unlisten to some events
|
||||
(filewatch/remove fw td2)
|
||||
(expect :type :ignored)
|
||||
(expect-empty)
|
||||
|
||||
# Check that we don't get anymore events from test directory 2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect-empty)
|
||||
|
||||
# Repeat and things should still work with test directory 1
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :create)
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :type :close-write)
|
||||
(expect-empty)
|
||||
(gccollect))
|
||||
|
||||
(assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw))
|
||||
(assert-no-error "cleanup 1" (rmrf td1))
|
||||
(assert-no-error "cleanup 2" (rmrf td2))
|
||||
(assert-no-error "cleanup 3" (rmrf td3))
|
||||
|
||||
(end-suite)
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
# Copyright (c) 2025 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -47,6 +47,14 @@
|
||||
(assert (= (int/to-number (i64 9007199254740991)) 9007199254740991))
|
||||
(assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991))
|
||||
|
||||
# New parser
|
||||
(assert (= (u64 "123") 123:u) "u64 parsing")
|
||||
(assert (= (u64 "0") 0:u) "u64 parsing")
|
||||
(assert (= (u64 "0xFFFF_FFFF_FFFF_FFFF") 0xFFFF_FFFF_FFFF_FFFF:u) "u64 parsing")
|
||||
(assert (= (i64 "123") 123:s) "s64 parsing")
|
||||
(assert (= (i64 "-123") -123:s) "s64 parsing")
|
||||
(assert (= (i64 "0") 0:s) "s64 parsing")
|
||||
|
||||
(assert-error
|
||||
"u64 out of bounds for safe integer"
|
||||
(int/to-number (u64 "9007199254740993"))
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
# Copyright (c) 2025 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -146,5 +146,80 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(def item (ev/take newchan))
|
||||
(assert (= item newchan) "ev/chan marshalling"))
|
||||
|
||||
(end-suite)
|
||||
# Issue #1488 - marshalling weak values
|
||||
(testmarsh (array/weak 10) "marsh array/weak")
|
||||
(testmarsh (table/weak-keys 10) "marsh table/weak-keys")
|
||||
(testmarsh (table/weak-values 10) "marsh table/weak-values")
|
||||
(testmarsh (table/weak 10) "marsh table/weak")
|
||||
|
||||
# Now check that gc works with weak containers after marshalling
|
||||
|
||||
# Turn off automatic GC for testing weak references
|
||||
(gcsetinterval 0x7FFFFFFF)
|
||||
|
||||
# array
|
||||
(def a (array/weak 1))
|
||||
(array/push a @"")
|
||||
(assert (= 1 (length a)) "array/weak marsh 1")
|
||||
(def aclone (-> a marshal unmarshal))
|
||||
(assert (= 1 (length aclone)) "array/weak marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length aclone)) "array/weak marsh 3")
|
||||
(assert (= 1 (length a)) "array/weak marsh 4")
|
||||
(assert (= nil (get a 0)) "array/weak marsh 5")
|
||||
(assert (= nil (get aclone 0)) "array/weak marsh 6")
|
||||
(assert (deep= a aclone) "array/weak marsh 7")
|
||||
|
||||
# table weak keys and values
|
||||
(def t (table/weak 1))
|
||||
(def keep-key :key)
|
||||
(def keep-value :value)
|
||||
(put t :abc @"")
|
||||
(put t :key :value)
|
||||
(assert (= 2 (length t)) "table/weak marsh 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "table/weak marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length tclone)) "table/weak marsh 3")
|
||||
(assert (= 1 (length t)) "table/weak marsh 4")
|
||||
(assert (= keep-value (get t keep-key)) "table/weak marsh 5")
|
||||
(assert (= keep-value (get tclone keep-key)) "table/weak marsh 6")
|
||||
(assert (deep= t tclone) "table/weak marsh 7")
|
||||
|
||||
# table weak keys
|
||||
(def t (table/weak-keys 1))
|
||||
(put t @"" keep-value)
|
||||
(put t :key @"")
|
||||
(assert (= 2 (length t)) "table/weak-keys marsh 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "table/weak-keys marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length tclone)) "table/weak-keys marsh 3")
|
||||
(assert (= 1 (length t)) "table/weak-keys marsh 4")
|
||||
(assert (deep= t tclone) "table/weak-keys marsh 5")
|
||||
|
||||
# table weak values
|
||||
(def t (table/weak-values 1))
|
||||
(put t @"" keep-value)
|
||||
(put t :key @"")
|
||||
(assert (= 2 (length t)) "table/weak-values marsh 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length t)) "table/weak-value marsh 3")
|
||||
(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4")
|
||||
|
||||
# tables with prototypes
|
||||
(def t (table/weak-values 1))
|
||||
(table/setproto t @{:abc 123})
|
||||
(put t @"" keep-value)
|
||||
(put t :key @"")
|
||||
(assert (= 2 (length t)) "marsh weak tables with prototypes 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")
|
||||
(assert (deep= (freeze t) (freeze tclone)) "marsh weak tables with prototypes 4")
|
||||
(assert (deep= (getproto t) (getproto tclone)) "marsh weak tables with prototypes 5")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose
|
||||
# Copyright (c) 2025 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user