mirror of https://github.com/janet-lang/janet
Compare commits
345 Commits
Author | SHA1 | Date |
---|---|---|
Calvin Rose | ace60e1898 | |
Calvin Rose | 91a583db27 | |
znley | c1647a74c5 | |
Calvin Rose | 721f280966 | |
Calvin Rose | e914eaf055 | |
Calvin Rose | fe54013679 | |
Calvin Rose | fdaf2e1594 | |
Calvin Rose | 9946f3bdf4 | |
Calvin Rose | c747e8d16c | |
Calvin Rose | 3e402d397e | |
Calvin Rose | 0350834cd3 | |
Calvin Rose | 60e22d9703 | |
John W Higgins | ee7362e847 | |
Calvin Rose | 369f96b80e | |
Calvin Rose | 7c5ed04ab1 | |
Calvin Rose | 4779a445e0 | |
Calvin Rose | f0f1b7ce9e | |
Calvin Rose | 7c9157a0ed | |
Calvin Rose | 522a6cb435 | |
Gautham | d0d551d739 | |
Gautham | 71a123fef7 | |
Gautham | 3f40c8d7fb | |
Gautham | 983c2e5499 | |
Gautham | eebb4c3ade | |
Gautham | 50425eac72 | |
Gautham | 382ff77bbe | |
Gautham | bf680fb5d3 | |
Gautham | 4ed7db4f91 | |
Calvin Rose | bf19920d65 | |
Gautham | 174b5f6686 | |
Gautham | 4173645b81 | |
Gautham | af511f1f55 | |
Gautham | 83c6080380 | |
Calvin Rose | 2f0c789ea1 | |
Calvin Rose | a9b8f8e8a9 | |
Calvin Rose | f92f3eb6fa | |
Calvin Rose | 89e74dca3e | |
Calvin Rose | f2e86d2f8d | |
John W Higgins | 623da131e5 | |
John W Higgins | e89ec31ae5 | |
Calvin Rose | 68a6ed208e | |
Calvin Rose | c01b32c4f3 | |
Josef Pospíšil | ee11ff9da9 | |
Josef Pospíšil | ed56d5d6ff | |
Josef Pospíšil | b317ab755c | |
Josef Pospíšil | 9819994999 | |
Josef Pospíšil | e9dbaa81d2 | |
Josef Pospíšil | 9f9146ffae | |
Josef Pospíšil | 9d9732af97 | |
Calvin Rose | ebb8fa9787 | |
Calvin Rose | 9e6abbf4d4 | |
Calvin Rose | 6032a6d658 | |
Max Schillinger | c29ab22e6d | |
sogaiu | 592ac4904c | |
Calvin Rose | 03ae2ec153 | |
Calvin Rose | 3bc42d0d37 | |
Calvin Rose | 12630d3e54 | |
Calvin Rose | c9897f99c3 | |
Calvin Rose | e66dc14b3a | |
Calvin Rose | 7a2868c147 | |
Calvin Rose | 9e0daaee09 | |
Calvin Rose | c293c7de93 | |
Calvin Rose | 49eb5f8563 | |
amano.kenji | 674b375b2c | |
llmII | 7e94c091eb | |
sogaiu | 5885ccba61 | |
Calvin Rose | 431ecd3d1a | |
Calvin Rose | f6df8ff935 | |
Calvin Rose | 3fd70f0951 | |
Calvin Rose | bebb635d4f | |
sogaiu | 354896bc4b | |
Calvin Rose | 5ddefff27e | |
sogaiu | 91827eef4f | |
Calvin Rose | 9c14c09962 | |
Calvin Rose | e85a84171f | |
Calvin Rose | 3a4f86c3d7 | |
Calvin Rose | 5e75963312 | |
Calvin Rose | 184d9289b5 | |
Calvin Rose | b7ff9577c0 | |
sogaiu | 942a1aaac6 | |
Josef Pospíšil | 69f0fe004d | |
sogaiu | 2a04347a42 | |
Calvin Rose | 1394f1a5c0 | |
sogaiu | cf4d19a8ea | |
Calvin Rose | 23b0fe9f8e | |
Josef Pospíšil | 1ba718b15e | |
Calvin Rose | df5f79ff35 | |
Calvin Rose | 6d7e8528ea | |
Philip Nelson | 197bb73a62 | |
Calvin Rose | f91e599451 | |
Josef Pospíšil | 5b9aa9237c | |
Ian Henry | 61f38fab37 | |
Calvin Rose | 9142f38cbc | |
Calvin Rose | e8ed961572 | |
Calvin Rose | be11a2a1ad | |
Ian Henry | ea75086300 | |
Calvin Rose | 9eeefbd79a | |
sogaiu | c573a98363 | |
Calvin Rose | 11d7af3f95 | |
Calvin Rose | a10b4f61d8 | |
Calvin Rose | a0cb7514f1 | |
Calvin Rose | b066edc116 | |
Josef Pospíšil | 938f5a689e | |
Calvin Rose | 772f4c26e8 | |
Locria Cyber | 6b5d151beb | |
Calvin Rose | a9176a77e6 | |
Calvin Rose | 16f409c6a9 | |
Calvin Rose | 9593c930de | |
Calvin Rose | 56f33f514b | |
Calvin Rose | 1ccd544b94 | |
Calvin Rose | 93c83a2ee2 | |
Calvin Rose | f459e32ada | |
Ico Doornekamp | 9b640c8e9c | |
Calvin Rose | a3228f4997 | |
Calvin Rose | 715eb69d92 | |
Calvin Rose | df2d5cb3d3 | |
Calvin Rose | 3b189eab64 | |
Calvin Rose | 609b629c22 | |
Calvin Rose | e74365fe38 | |
Calvin Rose | 46b34833c2 | |
Vincent Lee | 045c80869d | |
Calvin Rose | 2ea2e72ddd | |
sogaiu | 1b17e12fd6 | |
Calvin Rose | cc5beda0d2 | |
Calvin Rose | a363fd926d | |
Calvin Rose | 21ebede529 | |
Calvin Rose | 15d67e9191 | |
Calvin Rose | b5996f5f02 | |
Andriamanitra | 83204dc293 | |
Calvin Rose | e3f4142d2a | |
Calvin Rose | f18ad36b1b | |
Calvin Rose | cb25a2ecd6 | |
Calvin Rose | 741a5036e8 | |
Calvin Rose | 549ee95f3d | |
Calvin Rose | 6ae81058aa | |
Calvin Rose | 267c603824 | |
Calvin Rose | a8f583a372 | |
Calvin Rose | 2b5d90f73a | |
Calvin Rose | 4139e426fe | |
Calvin Rose | a775a89e01 | |
Calvin Rose | 990f6352e0 | |
Calvin Rose | b344702304 | |
Calvin Rose | d497612bce | |
Calvin Rose | 2a3b101bd8 | |
Calvin Rose | 63e93af421 | |
Calvin Rose | ab055b3ebe | |
Calvin Rose | a9a013473f | |
Calvin Rose | 87de1e5766 | |
Calvin Rose | 894aaef267 | |
Calvin Rose | e209e54ffe | |
Calvin Rose | 7511eadaa7 | |
Calvin Rose | 6c4906605a | |
Calvin Rose | 8a9be9d837 | |
Calvin Rose | b72098cc71 | |
Calvin Rose | defe60e08b | |
Calvin Rose | 7f852b8af4 | |
Calvin Rose | d71c100ca7 | |
Calvin Rose | 5442c8e86d | |
Calvin Rose | cf4901e713 | |
Calvin Rose | 4b8c1ac2d2 | |
Calvin Rose | 555e0c0b85 | |
Calvin Rose | dc301305de | |
Calvin Rose | f1111c135b | |
Calvin Rose | 3905e92965 | |
Calvin Rose | 1418ada38f | |
Calvin Rose | 9256a66b76 | |
Calvin Rose | e8c013a778 | |
Calvin Rose | fea8242ea7 | |
Calvin Rose | 7bfb17c209 | |
Calvin Rose | e7e4341e70 | |
Calvin Rose | 6186be4443 | |
Calvin Rose | d07f01d7cb | |
Calvin Rose | 73291a30a0 | |
Calvin Rose | a3b129845b | |
Calvin Rose | 0ff8f58be8 | |
Calvin Rose | 66292beec9 | |
Calvin Rose | bf2af1051f | |
Calvin Rose | b6e3020d4c | |
Calvin Rose | 8f516a1e28 | |
Calvin Rose | 5f2e287efd | |
Calvin Rose | 8c0d65cf9f | |
Ian Henry | fa609a5079 | |
Calvin Rose | c708ff9708 | |
Calvin Rose | 2ea90334a3 | |
Calvin Rose | eea8aa555f | |
Calvin Rose | 51a75e1872 | |
Calvin Rose | af7ed4322e | |
Calvin Rose | 7cdd7cf6eb | |
Calvin Rose | 26aa622afc | |
Calvin Rose | 84ad161f1e | |
Calvin Rose | 6efb965dab | |
Calvin Rose | 8c90a12e0f | |
Calvin Rose | 2d54e88e74 | |
Calvin Rose | 16ea5323e0 | |
Calvin Rose | 7a23ce2367 | |
Calvin Rose | e05bc7eb54 | |
Calvin Rose | b3a6e25ce0 | |
Calvin Rose | b63d41102e | |
Calvin Rose | 964295b59d | |
Calvin Rose | d19db30f3d | |
Calvin Rose | d12464fc0e | |
Calvin Rose | a96971c8a7 | |
Calvin Rose | f6f769503a | |
Calvin Rose | 82917ac6e3 | |
Calvin Rose | a6ffafb1a2 | |
Calvin Rose | fb8c529f2e | |
Calvin Rose | 1ee98e1e66 | |
Calvin Rose | 81f35f5dd1 | |
Calvin Rose | 1b402347cd | |
Calvin Rose | 7599656784 | |
Calvin Rose | dccb60ba35 | |
Calvin Rose | ae642ceca0 | |
Calvin Rose | 471b6f9966 | |
Calvin Rose | 5dd18bac2c | |
Calvin Rose | 018f4e0891 | |
Calvin Rose | e85809a98a | |
Calvin Rose | e6e9bd8147 | |
Calvin Rose | 221645d2ce | |
Calvin Rose | 2f4a6214a2 | |
Calvin Rose | e00a461c26 | |
Calvin Rose | c31314be38 | |
Andriamanitra | ee142c4be0 | |
Andriamanitra | aeacc0b31b | |
Calvin Rose | 7b4c3bdbcc | |
Calvin Rose | 910b9cf1fd | |
Calvin Rose | b10aaceab0 | |
Calvin Rose | 169bd812c9 | |
Calvin Rose | 34767f1e13 | |
sogaiu | 4f642c0843 | |
Calvin Rose | 4e5889ed59 | |
Calvin Rose | a1b848ad76 | |
Calvin Rose | dbcc1fad3e | |
primo-ppcg | db366558e7 | |
sogaiu | a23c03fbd0 | |
Calvin Rose | ff18b92eb0 | |
Josef Pospíšil | 7f148522ab | |
Calvin Rose | 159c612924 | |
Calvin Rose | b95dfd4bdf | |
Calvin Rose | e69954af2f | |
primo-ppcg | a5ff26f602 | |
primo-ppcg | a7536268e1 | |
primo-ppcg | 541469371a | |
Calvin Rose | a13aeaf955 | |
primo-ppcg | 9cf674cdcb | |
Calvin Rose | 51c0cf97bc | |
primo-ppcg | 4cb1f616c5 | |
primo-ppcg | 645109048b | |
primo-ppcg | f969fb69e1 | |
Calvin Rose | bfb60fdb84 | |
primo-ppcg | 2f43cb843e | |
Calvin Rose | 874fd2aba7 | |
Calvin Rose | 33d1371186 | |
Calvin Rose | d2dd241e6b | |
Calvin Rose | 4ecadfabf4 | |
Calvin Rose | ffd79c6097 | |
primo-ppcg | 35a8d2a519 | |
Calvin Rose | 21eab7e9cc | |
Calvin Rose | d9605c2856 | |
Calvin Rose | 70a467d469 | |
primo-ppcg | 6e8979336d | |
Calvin Rose | ee01045db5 | |
Calvin Rose | b7f8224588 | |
Calvin Rose | ca4c1e4259 | |
Calvin Rose | 91712add3d | |
Calvin Rose | 7198dcb416 | |
Calvin Rose | 08e20e912d | |
Calvin Rose | f45571033c | |
Calvin Rose | 2ac36a0572 | |
Calvin Rose | 3df1d54847 | |
Calvin Rose | f3969b6066 | |
primo-ppcg | 6222f35bc8 | |
primo-ppcg | 2f178963c0 | |
primo-ppcg | 15760b0950 | |
Calvin Rose | 43a6a70e1e | |
Calvin Rose | cd36f1ef5f | |
primo-ppcg | cdd7083c86 | |
Calvin Rose | 8df7364319 | |
Calvin Rose | 63023722d1 | |
Calvin Rose | 79c12e5116 | |
primo-ppcg | 53e16944a1 | |
Calvin Rose | 7475362c85 | |
primo-ppcg | 9238b82cde | |
Calvin Rose | 7049f658ec | |
wooosh | 701913fb19 | |
primo-ppcg | 831f41a62b | |
Calvin Rose | 0ea1da80e7 | |
Calvin Rose | 06eea74b98 | |
primo-ppcg | c8c0e112bc | |
primo-ppcg | 7417e82c51 | |
Calvin Rose | ecc4d80a5a | |
Calvin Rose | 3df24c52f4 | |
primo-ppcg | 8a70fb95b5 | |
primo-ppcg | d8b45ecd61 | |
primo-ppcg | 61712bae9c | |
Calvin Rose | 4ff81a5a25 | |
Calvin Rose | 08f0e55d8f | |
Calvin Rose | 080b37cb31 | |
Calvin Rose | bbdcd035ba | |
sogaiu | f9233ef90b | |
Calvin Rose | cd3573a4d2 | |
Calvin Rose | 738fe24e6d | |
primo-ppcg | c2e55b5486 | |
Calvin Rose | 989f0726e3 | |
primo-ppcg | bdefd3ba1e | |
Calvin Rose | 4efcff33bd | |
Calvin Rose | 8183cc5a8d | |
Calvin Rose | f3bda1536d | |
Calvin Rose | 3b6371e03d | |
Calvin Rose | b5d3c87253 | |
Calvin Rose | f73b8c550a | |
Calvin Rose | 5437744126 | |
sogaiu | 5a5e70b001 | |
sogaiu | 348a5bc0a9 | |
Calvin Rose | 026c64fa01 | |
Calvin Rose | e38663c457 | |
Calvin Rose | 117c741c29 | |
Calvin Rose | 9bc5bec9f1 | |
Calvin Rose | a5f4e4d328 | |
Calvin Rose | db0abfde72 | |
Calvin Rose | edf263bcb5 | |
Calvin Rose | 60fba585e3 | |
Calvin Rose | ebb6fe5be3 | |
Calvin Rose | d91c95bf92 | |
primo-ppcg | 2007438424 | |
primo-ppcg | 81423635ad | |
Calvin Rose | 58d297364a | |
Calvin Rose | db902c90c4 | |
Calvin Rose | 42ccd0f790 | |
Michael Camilleri | 20ec6f574e | |
primo-ppcg | b3db367ae7 | |
primo-ppcg | 8a62c742e6 | |
Calvin Rose | b125cbeac9 | |
Calvin Rose | 3f7a2c2197 | |
Calvin Rose | f6248369fe | |
primo-ppcg | c83f3ec097 | |
Calvin Rose | 0cd00da354 | |
bakpakin | 4b7b285aa9 | |
Dmitry | d63379e777 | |
Calvin Rose | b219b146fa | |
Calvin Rose | ff90b81ec3 | |
Calvin Rose | 9120eaef79 | |
Michael Camilleri | 1ccd879916 | |
Michael Camilleri | f977ace7f8 | |
Calvin Rose | c3f4dc0c15 | |
sogaiu | 78eed9b11c |
|
@ -1,4 +1,4 @@
|
|||
image: freebsd/12.x
|
||||
image: freebsd/14.x
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
|
@ -9,3 +9,4 @@ tasks:
|
|||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
sudo gmake uninstall
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
image: openbsd/latest
|
||||
image: openbsd/7.4
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
|
@ -11,6 +11,7 @@ tasks:
|
|||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
doas gmake uninstall
|
||||
- meson_min: |
|
||||
cd janet
|
||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
|
||||
|
@ -29,4 +30,3 @@ tasks:
|
|||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
|
||||
|
|
|
@ -0,0 +1,38 @@
|
|||
#!/bin/sh
|
||||
set -eux
|
||||
|
||||
COSMO_DIR="/sc/cosmocc"
|
||||
|
||||
# build x86_64
|
||||
X86_64_CC="/sc/cosmocc/bin/x86_64-unknown-cosmo-cc"
|
||||
X86_64_AR="/sc/cosmocc/bin/x86_64-unknown-cosmo-ar"
|
||||
mkdir -p /sc/cosmocc/x86_64
|
||||
make -j CC="$X86_64_CC" AR="$X86_64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
|
||||
cp build/janet /sc/cosmocc/x86_64/janet
|
||||
make clean
|
||||
|
||||
# build aarch64
|
||||
AARCH64_CC="/sc/cosmocc/bin/aarch64-unknown-cosmo-cc"
|
||||
AARCH64_AR="/sc/cosmocc/bin/aarch64-unknown-cosmo-ar"
|
||||
mkdir -p /sc/cosmocc/aarch64
|
||||
make -j CC="$AARCH64_CC" AR="$AARCH64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
|
||||
cp build/janet /sc/cosmocc/aarch64/janet
|
||||
make clean
|
||||
|
||||
# fat binary
|
||||
apefat () {
|
||||
OUTPUT="$1"
|
||||
OLDNAME_X86_64="$(basename -- "$2")"
|
||||
OLDNAME_AARCH64="$(basename -- "$3")"
|
||||
TARG_FOLD="$(dirname "$OUTPUT")"
|
||||
"$COSMO_DIR/bin/apelink" -l "$COSMO_DIR/bin/ape-x86_64.elf" \
|
||||
-l "$COSMO_DIR/bin/ape-aarch64.elf" \
|
||||
-M "$COSMO_DIR/bin/ape-m1.c" \
|
||||
-o "$OUTPUT" \
|
||||
"$2" \
|
||||
"$3"
|
||||
cp "$2" "$TARG_FOLD/$OLDNAME_X86_64.x86_64"
|
||||
cp "$3" "$TARG_FOLD/$OLDNAME_AARCH64.aarch64"
|
||||
}
|
||||
|
||||
apefat /sc/cosmocc/janet.com /sc/cosmocc/x86_64/janet /sc/cosmocc/aarch64/janet
|
|
@ -0,0 +1,21 @@
|
|||
#!/bin/sh
|
||||
set -e
|
||||
|
||||
sudo apt update
|
||||
sudo apt-get install -y ca-certificates libssl-dev\
|
||||
qemu qemu-utils qemu-user-static\
|
||||
texinfo groff\
|
||||
cmake ninja-build bison zip\
|
||||
pkg-config build-essential autoconf re2c
|
||||
|
||||
# download cosmocc
|
||||
cd /sc
|
||||
wget https://github.com/jart/cosmopolitan/releases/download/3.3.3/cosmocc-3.3.3.zip
|
||||
mkdir -p cosmocc
|
||||
cd cosmocc
|
||||
unzip ../cosmocc-3.3.3.zip
|
||||
|
||||
# register
|
||||
cd /sc/cosmocc
|
||||
sudo cp ./bin/ape-x86_64.elf /usr/bin/ape
|
||||
sudo sh -c "echo ':APE:M::MZqFpD::/usr/bin/ape:' >/proc/sys/fs/binfmt_misc/register"
|
|
@ -60,3 +60,30 @@ jobs:
|
|||
./dist/*.zip
|
||||
./*.zip
|
||||
./*.msi
|
||||
|
||||
release-cosmo:
|
||||
permissions:
|
||||
contents: write # for softprops/action-gh-release to create GitHub release
|
||||
name: Build release binaries for Cosmo
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: create build folder
|
||||
run: |
|
||||
sudo mkdir -p /sc
|
||||
sudo chmod -R 0777 /sc
|
||||
- name: setup Cosmopolitan Libc
|
||||
run: bash ./.github/cosmo/setup
|
||||
- name: Set the version
|
||||
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
|
||||
- name: Set the platform
|
||||
run: echo "platform=cosmo" >> $GITHUB_ENV
|
||||
- name: build Janet APE binary
|
||||
run: bash ./.github/cosmo/build
|
||||
- name: push binary to github
|
||||
uses: softprops/action-gh-release@v1
|
||||
with:
|
||||
draft: true
|
||||
files: |
|
||||
/sc/cosmocc/janet.com
|
||||
|
|
|
@ -56,7 +56,7 @@ jobs:
|
|||
gcc
|
||||
- name: Build the project
|
||||
shell: cmd
|
||||
run: make -j CC=gcc
|
||||
run: make -j4 CC=gcc JANET_NO_AMALG=1
|
||||
|
||||
test-mingw-linux:
|
||||
name: Build and test with Mingw on Linux + Wine
|
||||
|
@ -74,3 +74,18 @@ jobs:
|
|||
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
|
||||
- name: Test the project
|
||||
run: make test UNAME=MINGW RUN=wine
|
||||
|
||||
test-arm-linux:
|
||||
name: Build and test ARM32 cross compilation
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Setup qemu and cross compiler
|
||||
run: |
|
||||
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
|
||||
- name: Test the project
|
||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test
|
||||
|
|
|
@ -34,8 +34,11 @@ local
|
|||
|
||||
# Common test files I use.
|
||||
temp.janet
|
||||
temp*.janet
|
||||
temp.c
|
||||
temp*janet
|
||||
temp*.c
|
||||
scratch.janet
|
||||
scratch.c
|
||||
|
||||
# Emscripten
|
||||
*.bc
|
||||
|
@ -57,6 +60,7 @@ xxd.exe
|
|||
# VSCode
|
||||
.vs
|
||||
.clangd
|
||||
.cache
|
||||
|
||||
# Swap files
|
||||
*.swp
|
||||
|
@ -130,6 +134,9 @@ Module.symvers
|
|||
Mkfile.old
|
||||
dkms.conf
|
||||
|
||||
# Coverage files
|
||||
*.cov
|
||||
|
||||
# End of https://www.gitignore.io/api/c
|
||||
|
||||
# Created by https://www.gitignore.io/api/cmake
|
||||
|
|
77
CHANGELOG.md
77
CHANGELOG.md
|
@ -1,6 +1,83 @@
|
|||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks.
|
||||
- Add `with-env`
|
||||
- Add *module-make-env* dynamic binding
|
||||
- Add buffer/format-at
|
||||
- Add long form command line options for readable CLI usage
|
||||
- Fix bug with `net/accept-loop` that would sometimes miss connections.
|
||||
|
||||
## 1.34.0 - 2024-03-22
|
||||
- Add a new (split) PEG special by @ianthehenry
|
||||
- Add buffer/push-* sized int and float by @pnelson
|
||||
- Documentation improvements: @amano-kenji, @llmII, @MaxGyver83, @pepe, @sogaiu.
|
||||
- Expose _exit to skip certain cleanup with os/exit.
|
||||
- Swap set / body order for each by @sogaiu.
|
||||
- Abort on assert failure instead of exit.
|
||||
- Fix: os/proc-wait by @llmII.
|
||||
- Fix macex1 to keep syntax location for all tuples.
|
||||
- Restore if-let tail calls.
|
||||
- Don't try and resume fibers that can't be resumed.
|
||||
- Register stream on unmarshal.
|
||||
- Fix asm roundtrip issue.
|
||||
|
||||
## 1.33.0 - 2024-01-07
|
||||
- Add more + and * keywords to default-peg-grammar by @sogaiu.
|
||||
- Use libc strlen in janet_buffer_push_cstring by @williewillus.
|
||||
- Be a bit safer with reference counting.
|
||||
- Add support for atomic loads in Janet's atomic abstraction.
|
||||
- Fix poll event loop CPU usage issue.
|
||||
- Add ipv6, shared, and cryptorand options to meson.
|
||||
- Add more ipv6 feature detection.
|
||||
- Fix loop for forever loop.
|
||||
- Cleaned up unused NetStateConnect, fixed janet_async_end() ev refcount by @zevv.
|
||||
- Fix warnings w/ MSVC and format.
|
||||
- Fix marshal_one_env w/ JANET_MARSHAL_UNSAFE.
|
||||
- Fix `(default)`.
|
||||
- Fix cannot marshal fiber with c stackframe, in a dynamic way that is fairly conservative.
|
||||
- Fix typo for SIGALARM in os/proc-kill.
|
||||
- Prevent bytecode optimization from remove mk* instructions.
|
||||
- Fix arity typo in peg.c by @pepe.
|
||||
- Update Makefile for MinGW.
|
||||
- Fix canceling waiting fiber.
|
||||
- Add a new (sub) PEG special by @ianthehenry.
|
||||
- Fix if net/server's handler has incorrect arity.
|
||||
- Fix macex raising on ().
|
||||
|
||||
## 1.32.1 - 2023-10-15
|
||||
- Fix return value from C function `janet_dobytes` when called on Janet functions that yield to event loop.
|
||||
- Change C API for event loop interaction - get rid of JanetListener and instead use `janet_async_start` and `janet_async_end`.
|
||||
- Rework event loop to make fewer system calls on kqueue and epoll.
|
||||
- Expose atomic refcount abstraction in janet.h
|
||||
- Add `array/weak` for weak references in arrays
|
||||
- Add support for weak tables via `table/weak`, `table/weak-keys`, and `table/weak-values`.
|
||||
- Fix compiler bug with using the result of `(break x)` expression in some contexts.
|
||||
- Rework internal event loop code to be better behaved on Windows
|
||||
- Update meson build to work better on windows
|
||||
|
||||
## 1.31.0 - 2023-09-17
|
||||
- Report line and column when using `janet_dobytes`
|
||||
- Add `:unless` loop modifier
|
||||
- Allow calling `reverse` on generators.
|
||||
- Improve performance of a number of core functions including `partition`, `mean`, `keys`, `values`, `pairs`, `interleave`.
|
||||
- Add `lengthable?`
|
||||
- Add `os/sigaction`
|
||||
- Change `every?` and `any?` to behave like the functional versions of the `and` and `or` macros.
|
||||
- Fix bug with garbage collecting threaded abstract types.
|
||||
- Add `:signal` to the `sandbox` function to allow intercepting signals.
|
||||
|
||||
## 1.30.0 - 2023-08-05
|
||||
- Change indexing of `array/remove` to start from -1 at the end instead of -2.
|
||||
- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
|
||||
- Fix bug with marshalling channels
|
||||
- Add `div` for floored division
|
||||
- Make `div` and `mod` variadic
|
||||
- Support `bnot` for integer types.
|
||||
- Define `(mod x 0)` as `x`
|
||||
- Add `ffi/pointer-cfunction` to convert pointers to cfunctions
|
||||
|
||||
## 1.29.1 - 2023-06-19
|
||||
- Add support for passing booleans to PEGs for "always" and "never" matching.
|
||||
- Allow dictionary types for `take` and `drop`
|
||||
|
|
33
Makefile
33
Makefile
|
@ -33,6 +33,7 @@ CLIBS=-lm -lpthread
|
|||
JANET_TARGET=build/janet
|
||||
JANET_BOOT=build/janet_boot
|
||||
JANET_IMPORT_LIB=build/janet.lib
|
||||
JANET_LIBRARY_IMPORT_LIB=build/libjanet.lib
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(LIBDIR)/janet
|
||||
|
@ -42,14 +43,17 @@ JANET_DIST_DIR?=janet-dist
|
|||
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
|
||||
JANET_TARGET_OBJECTS=build/janet.o build/shell.o
|
||||
JPM_TAG?=master
|
||||
HAS_SHARED?=1
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
|
||||
# For cross compilation
|
||||
HOSTCC?=$(CC)
|
||||
HOSTAR?=$(AR)
|
||||
# Symbols are (optionally) removed later, keep -g as default!
|
||||
CFLAGS?=-O2 -g
|
||||
LDFLAGS?=-rdynamic
|
||||
LIBJANET_LDFLAGS?=$(LD_FLAGS)
|
||||
RUN:=$(RUN)
|
||||
|
||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||
|
@ -92,12 +96,17 @@ endif
|
|||
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
||||
CLIBS:=-lws2_32 -lpsapi -lwsock32
|
||||
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
|
||||
LIBJANET_LDFLAGS:=-Wl,--out-implib,$(JANET_LIBRARY_IMPORT_LIB)
|
||||
JANET_TARGET:=$(JANET_TARGET).exe
|
||||
JANET_BOOT:=$(JANET_BOOT).exe
|
||||
endif
|
||||
|
||||
|
||||
$(shell mkdir -p build/core build/c build/boot build/mainclient)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
all: $(JANET_TARGET) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
ifeq ($(HAS_SHARED), 1)
|
||||
all: $(JANET_LIBRARY)
|
||||
endif
|
||||
|
||||
######################
|
||||
##### Name Files #####
|
||||
|
@ -195,9 +204,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
|||
########################
|
||||
|
||||
ifeq ($(UNAME), Darwin)
|
||||
SONAME=libjanet.1.29.dylib
|
||||
SONAME=libjanet.1.34.dylib
|
||||
else
|
||||
SONAME=libjanet.so.1.29
|
||||
SONAME=libjanet.so.1.34
|
||||
endif
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
|
@ -219,7 +228,7 @@ $(JANET_TARGET): $(JANET_TARGET_OBJECTS)
|
|||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
$(HOSTCC) $(LIBJANET_LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
|
||||
$(HOSTAR) rcs $@ $^
|
||||
|
@ -262,20 +271,25 @@ dist: build/janet-dist.tar.gz
|
|||
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
build/janet.h \
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_STATIC_LIBRARY) \
|
||||
README.md build/c/janet.c build/c/shell.c
|
||||
mkdir -p build/$(JANET_DIST_DIR)/bin
|
||||
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
|
||||
strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
|
||||
mkdir -p build/$(JANET_DIST_DIR)/include
|
||||
cp build/janet.h build/$(JANET_DIST_DIR)/include/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/lib/
|
||||
cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
|
||||
cp $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
|
||||
cp $(JANET_LIBRARY) build/$(JANET_DIST_DIR)/lib/ || true
|
||||
mkdir -p build/$(JANET_DIST_DIR)/man/man1/
|
||||
cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1
|
||||
mkdir -p build/$(JANET_DIST_DIR)/src/
|
||||
cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
|
||||
cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
|
||||
cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
|
||||
ifeq ($(HAS_SHARED), 1)
|
||||
build/janet-%.tar.gz: $(JANET_LIBRARY)
|
||||
endif
|
||||
|
||||
#########################
|
||||
##### Documentation #####
|
||||
|
@ -308,7 +322,7 @@ build/janet.pc: $(JANET_TARGET)
|
|||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
strip '$(DESTDIR)$(BINDIR)/janet'
|
||||
strip -x -S '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||
|
@ -329,6 +343,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
|||
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
|
||||
cp '$(JANET_LIBRARY_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
|
||||
|
||||
install-jpm-git: $(JANET_TARGET)
|
||||
|
@ -357,14 +372,14 @@ uninstall:
|
|||
#################
|
||||
|
||||
format:
|
||||
tools/format.sh
|
||||
sh tools/format.sh
|
||||
|
||||
grammar: build/janet.tmLanguage
|
||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
$(RUN) $(JANET_TARGET) $< > $@
|
||||
|
||||
compile-commands:
|
||||
# Requires pip install copmiledb
|
||||
# Requires pip install compiledb
|
||||
compiledb make
|
||||
|
||||
clean:
|
||||
|
|
|
@ -315,8 +315,7 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w
|
|||
|
||||
## Discussion
|
||||
|
||||
Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
|
||||
Gitter provides Matrix and IRC bridges as well.
|
||||
Feel free to ask questions and join the discussion on the [Janet Zulip Instance](https://janet.zulipchat.com/)
|
||||
|
||||
## FAQ
|
||||
|
||||
|
@ -383,7 +382,7 @@ Usually, one of a few reasons:
|
|||
### Can I bind to Rust/Zig/Go/Java/Nim/C++/D/Pascal/Fortran/Odin/Jai/(Some new "Systems" Programming Language)?
|
||||
|
||||
Probably, if that language has a good interface with C. But the programmer may need to do
|
||||
some extra work to map Janet's internal memory model may need some to that of the bound language. Janet
|
||||
some extra work to map Janet's internal memory model to that of the bound language. Janet
|
||||
also uses `setjmp`/`longjmp` for non-local returns internally. This
|
||||
approach is out of favor with many programmers now and doesn't always play well with other languages
|
||||
that have exceptions or stack-unwinding.
|
||||
|
|
|
@ -41,32 +41,32 @@ if not exist build\boot mkdir build\boot
|
|||
@rem Build the bootstrap interpreter
|
||||
for %%f in (src\core\*.c) do (
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
)
|
||||
for %%f in (src\boot\*.c) do (
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
build\janet_boot . > build\c\janet.c
|
||||
|
||||
@rem Build the sources
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
@rem Build the resources
|
||||
rc /nologo /fobuild\janet_win.res janet_win.rc
|
||||
|
||||
@rem Link everything to main client
|
||||
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
@rem Build static library (libjanet.a)
|
||||
@rem Build static library (libjanet.lib)
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
echo === Run 'build_win test' to run tests. ==
|
||||
|
@ -91,14 +91,16 @@ exit /b 0
|
|||
:CLEAN
|
||||
del *.exe *.lib *.exp
|
||||
rd /s /q build
|
||||
rd /s /q dist
|
||||
if exist dist (
|
||||
rd /s /q dist
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
@rem Run tests
|
||||
:TEST
|
||||
for %%f in (test/suite*.janet) do (
|
||||
janet.exe test\%%f
|
||||
@if errorlevel 1 goto TESTFAIL
|
||||
@if not errorlevel 0 goto TESTFAIL
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
|
@ -117,6 +119,7 @@ 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
|
||||
|
|
|
@ -55,6 +55,7 @@
|
|||
(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-alias int-fn int-fn-aliased :int [a :int b :int])
|
||||
|
||||
#
|
||||
# Struct reading and writing
|
||||
|
@ -119,6 +120,7 @@
|
|||
(tracev (return-struct 42))
|
||||
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
|
||||
(tracev (struct-big 11 99.5))
|
||||
(tracev (int-fn-aliased 10 20))
|
||||
|
||||
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
|
||||
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
|
||||
|
|
|
@ -0,0 +1,5 @@
|
|||
# Switch to python
|
||||
|
||||
(print "running in Janet")
|
||||
(os/posix-exec ["python"] :p)
|
||||
(print "will not print")
|
|
@ -0,0 +1,41 @@
|
|||
###
|
||||
### Usage: janet examples/sigaction.janet 1|2|3|4 &
|
||||
###
|
||||
### Then at shell: kill -s SIGTERM $!
|
||||
###
|
||||
|
||||
(defn action
|
||||
[]
|
||||
(print "Handled SIGTERM!")
|
||||
(flush)
|
||||
(os/exit 1))
|
||||
|
||||
(defn main1
|
||||
[]
|
||||
(os/sigaction :term action true)
|
||||
(forever))
|
||||
|
||||
(defn main2
|
||||
[]
|
||||
(os/sigaction :term action)
|
||||
(forever))
|
||||
|
||||
(defn main3
|
||||
[]
|
||||
(os/sigaction :term action true)
|
||||
(forever (ev/sleep math/inf)))
|
||||
|
||||
(defn main4
|
||||
[]
|
||||
(os/sigaction :term action)
|
||||
(forever (ev/sleep math/inf)))
|
||||
|
||||
(defn main
|
||||
[& args]
|
||||
(def which (scan-number (get args 1 "1")))
|
||||
(case which
|
||||
1 (main1) # should work
|
||||
2 (main2) # will not work
|
||||
3 (main3) # should work
|
||||
4 (main4) # should work
|
||||
(error "bad main")))
|
|
@ -0,0 +1,20 @@
|
|||
(def weak-k (table/weak-keys 10))
|
||||
(def weak-v (table/weak-values 10))
|
||||
(def weak-kv (table/weak 10))
|
||||
|
||||
(put weak-kv (gensym) 10)
|
||||
(put weak-kv :hello :world)
|
||||
(put weak-k :abc123zz77asda :stuff)
|
||||
(put weak-k true :abc123zz77asda)
|
||||
(put weak-k :zyzzyz false)
|
||||
(put weak-v (gensym) 10)
|
||||
(put weak-v 20 (gensym))
|
||||
(print "before gc")
|
||||
(tracev weak-k)
|
||||
(tracev weak-v)
|
||||
(tracev weak-kv)
|
||||
(gccollect)
|
||||
(print "after gc")
|
||||
(tracev weak-k)
|
||||
(tracev weak-v)
|
||||
(tracev weak-kv)
|
72
meson.build
72
meson.build
|
@ -20,7 +20,7 @@
|
|||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.29.1')
|
||||
version : '1.34.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
|
@ -61,6 +61,7 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
|||
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_NO_NET', not get_option('net'))
|
||||
conf.set('JANET_NO_IPV6', not get_option('ipv6'))
|
||||
conf.set('JANET_NO_EV', not get_option('ev') or get_option('single_threaded'))
|
||||
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||
|
@ -78,6 +79,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_CRYPTORAND', not get_option('cryptorand'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
|
@ -169,7 +171,7 @@ janet_boot = executable('janet-boot', core_src, boot_src,
|
|||
|
||||
# Build janet.c
|
||||
janetc = custom_target('janetc',
|
||||
input : [janet_boot],
|
||||
input : [janet_boot, 'src/boot/boot.janet'],
|
||||
output : 'janet.c',
|
||||
capture : true,
|
||||
command : [
|
||||
|
@ -182,25 +184,41 @@ if not get_option('single_threaded')
|
|||
janet_dependencies += thread_dep
|
||||
endif
|
||||
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
install : true)
|
||||
|
||||
# Allow building with no shared library
|
||||
if cc.has_argument('-fvisibility=hidden')
|
||||
lib_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
lib_cflags = []
|
||||
endif
|
||||
if get_option('shared')
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
c_args : lib_cflags,
|
||||
install : true)
|
||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||
# shaves off about 10k on linux x64, likely similar on other platforms.
|
||||
if cc.has_argument('-fvisibility=hidden')
|
||||
extra_cflags = ['-fvisibility=hidden']
|
||||
if cc.has_argument('-fvisibility=hidden')
|
||||
extra_cflags = ['-fvisibility=hidden', '-DJANET_DLL_IMPORT']
|
||||
else
|
||||
extra_cflags = ['-DJANET_DLL_IMPORT']
|
||||
endif
|
||||
janet_mainclient = executable('janet', mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
link_with: [libjanet],
|
||||
c_args : extra_cflags,
|
||||
install : true)
|
||||
else
|
||||
extra_cflags = []
|
||||
# No shared library
|
||||
janet_mainclient = executable('janet', mainclient_src, janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
c_args : lib_cflags,
|
||||
install : true)
|
||||
endif
|
||||
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
c_args : extra_cflags,
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
native_cc = meson.get_compiler('c', native: true)
|
||||
|
@ -264,14 +282,15 @@ endforeach
|
|||
run_target('repl', command : [janet_nativeclient])
|
||||
|
||||
# For use as meson subproject (wrap)
|
||||
janet_dep = declare_dependency(include_directories : incdir,
|
||||
link_with : libjanet)
|
||||
|
||||
if get_option('shared')
|
||||
janet_dep = declare_dependency(include_directories : incdir,
|
||||
link_with : libjanet)
|
||||
# pkgconfig
|
||||
pkg = import('pkgconfig')
|
||||
pkg.generate(libjanet,
|
||||
subdirs: 'janet',
|
||||
description: 'Library for the Janet programming language.')
|
||||
pkg = import('pkgconfig')
|
||||
pkg.generate(libjanet,
|
||||
subdirs: 'janet',
|
||||
description: 'Library for the Janet programming language.')
|
||||
endif
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
|
@ -281,11 +300,12 @@ patched_janet = custom_target('patched-janeth',
|
|||
install : true,
|
||||
install_dir : join_paths(get_option('includedir'), 'janet'),
|
||||
build_by_default : true,
|
||||
output : ['janet.h'],
|
||||
output : ['janet_' + meson.project_version() + '.h'],
|
||||
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
|
||||
|
||||
# Create a version of the janet.h header that matches what jpm often expects
|
||||
if meson.version().version_compare('>=0.61')
|
||||
install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir'))
|
||||
install_symlink('janet.h', pointing_to: 'janet/janet_' + meson.project_version() + '.h', install_dir: get_option('includedir'))
|
||||
install_symlink('janet.h', pointing_to: 'janet_' + meson.project_version() + '.h', install_dir: join_paths(get_option('includedir'), 'janet'))
|
||||
endif
|
||||
|
||||
|
|
|
@ -11,14 +11,15 @@ option('peg', type : 'boolean', value : true)
|
|||
option('int_types', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : false)
|
||||
option('net', type : 'boolean', value : true)
|
||||
option('ipv6', type : 'boolean', value : true)
|
||||
option('ev', type : 'boolean', value : true)
|
||||
option('processes', type : 'boolean', value : true)
|
||||
option('umask', type : 'boolean', value : true)
|
||||
option('realpath', type : 'boolean', value : true)
|
||||
option('simple_getline', type : 'boolean', value : false)
|
||||
option('epoll', type : 'boolean', value : false)
|
||||
option('kqueue', type : 'boolean', value : false)
|
||||
option('interpreter_interrupt', type : 'boolean', value : false)
|
||||
option('epoll', type : 'boolean', value : true)
|
||||
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)
|
||||
|
||||
|
@ -29,3 +30,5 @@ option('stack_max', type : 'integer', min : 8096, max : 0x7fffffff, value : 0x7f
|
|||
|
||||
option('arch_name', type : 'string', value: '')
|
||||
option('os_name', type : 'string', value: '')
|
||||
option('shared', type : 'boolean', value: true)
|
||||
option('cryptorand', type : 'boolean', value: true)
|
||||
|
|
|
@ -103,23 +103,13 @@
|
|||
(defn symbol? "Check if x is a symbol." [x] (= (type x) :symbol))
|
||||
(defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword))
|
||||
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
|
||||
(defn function? "Check if x is a function (not a cfunction)." [x]
|
||||
(= (type x) :function))
|
||||
(defn function? "Check if x is a function (not a cfunction)." [x] (= (type x) :function))
|
||||
(defn cfunction? "Check if x a cfunction." [x] (= (type x) :cfunction))
|
||||
(defn table? "Check if x a table." [x] (= (type x) :table))
|
||||
(defn struct? "Check if x a struct." [x] (= (type x) :struct))
|
||||
(defn array? "Check if x is an array." [x] (= (type x) :array))
|
||||
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
|
||||
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
|
||||
(defn bytes? "Check if x is a string, symbol, keyword, or buffer." [x]
|
||||
(def t (type x))
|
||||
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
|
||||
(defn dictionary? "Check if x is a table or struct." [x]
|
||||
(def t (type x))
|
||||
(if (= t :table) true (= t :struct)))
|
||||
(defn indexed? "Check if x is an array or tuple." [x]
|
||||
(def t (type x))
|
||||
(if (= t :array) true (= t :tuple)))
|
||||
(defn truthy? "Check if x is truthy." [x] (if x true false))
|
||||
(defn true? "Check if x is true." [x] (= x true))
|
||||
(defn false? "Check if x is false." [x] (= x false))
|
||||
|
@ -151,7 +141,7 @@
|
|||
(defmacro -= "Decrements the var x by n." [x & ns] ~(set ,x (,- ,x ,;ns)))
|
||||
(defmacro *= "Shorthand for (set x (\\* x n))." [x & ns] ~(set ,x (,* ,x ,;ns)))
|
||||
(defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
|
||||
(defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n)))
|
||||
(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
|
||||
|
||||
(defmacro assert
|
||||
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
|
||||
|
@ -172,7 +162,7 @@
|
|||
``Define a default value for an optional argument.
|
||||
Expands to `(def sym (if (= nil sym) val sym))`.``
|
||||
[sym val]
|
||||
~(def ,sym (if (= nil ,sym) ,val ,sym)))
|
||||
~(def ,sym (if (,= nil ,sym) ,val ,sym)))
|
||||
|
||||
(defmacro comment
|
||||
"Ignores the body of the comment."
|
||||
|
@ -429,9 +419,15 @@
|
|||
(error (string "expected tuple for range, got " x))))
|
||||
|
||||
(defn- range-template
|
||||
[binding object rest op comparison]
|
||||
(let [[start stop step] (check-indexed object)]
|
||||
(for-template binding start stop (or step 1) comparison op [rest])))
|
||||
[binding object kind rest op comparison]
|
||||
(check-indexed object)
|
||||
(def [a b c] object)
|
||||
(def [start stop step]
|
||||
(case (length object)
|
||||
1 (case kind :range [0 a 1] :down [a 0 1])
|
||||
2 [a b 1]
|
||||
[a b c]))
|
||||
(for-template binding start stop step comparison op [rest]))
|
||||
|
||||
(defn- each-template
|
||||
[binding inx kind body]
|
||||
|
@ -481,16 +477,17 @@
|
|||
:repeat (with-syms [iter]
|
||||
~(do (var ,iter ,verb) (while (> ,iter 0) ,rest (-- ,iter))))
|
||||
:when ~(when ,verb ,rest)
|
||||
:unless ~(unless ,verb ,rest)
|
||||
(error (string "unexpected loop modifier " binding))))))
|
||||
|
||||
# 3 term expression
|
||||
(def {(+ i 2) object} head)
|
||||
(let [rest (loop1 body head (+ i 3))]
|
||||
(case verb
|
||||
:range (range-template binding object rest + <)
|
||||
:range-to (range-template binding object rest + <=)
|
||||
:down (range-template binding object rest - >)
|
||||
:down-to (range-template binding object rest - >=)
|
||||
:range (range-template binding object :range rest + <)
|
||||
:range-to (range-template binding object :range rest + <=)
|
||||
:down (range-template binding object :down rest - >)
|
||||
:down-to (range-template binding object :down rest - >=)
|
||||
:keys (each-template binding object :keys [rest])
|
||||
:pairs (each-template binding object :pairs [rest])
|
||||
:in (each-template binding object :each [rest])
|
||||
|
@ -597,7 +594,10 @@
|
|||
* `:repeat n` -- repeats the next inner loop `n` times.
|
||||
|
||||
* `:when condition` -- only evaluates the current loop body when `condition`
|
||||
is true.
|
||||
is truthy.
|
||||
|
||||
* `:unless condition` -- only evaluates the current loop body when `condition`
|
||||
is falsey.
|
||||
|
||||
The `loop` macro always evaluates to nil.
|
||||
```
|
||||
|
@ -651,7 +651,12 @@
|
|||
(defn mean
|
||||
"Returns the mean of xs. If empty, returns NaN."
|
||||
[xs]
|
||||
(/ (sum xs) (length xs)))
|
||||
(if (lengthable? xs)
|
||||
(/ (sum xs) (length xs))
|
||||
(do
|
||||
(var [accum total] [0 0])
|
||||
(each x xs (+= accum x) (++ total))
|
||||
(/ accum total))))
|
||||
|
||||
(defn product
|
||||
"Returns the product of xs. If xs is empty, returns 1."
|
||||
|
@ -660,6 +665,9 @@
|
|||
(each x xs (*= accum x))
|
||||
accum)
|
||||
|
||||
# declare ahead of time
|
||||
(var- macexvar nil)
|
||||
|
||||
(defmacro if-let
|
||||
``Make multiple bindings, and if all are truthy,
|
||||
evaluate the `tru` form. If any are false or nil, evaluate
|
||||
|
@ -668,20 +676,19 @@
|
|||
(def len (length bindings))
|
||||
(if (= 0 len) (error "expected at least 1 binding"))
|
||||
(if (odd? len) (error "expected an even number of bindings"))
|
||||
(def res (gensym))
|
||||
(def fal2 (if macexvar (macexvar fal) fal))
|
||||
(defn aux [i]
|
||||
(if (>= i len)
|
||||
~(do (set ,res ,tru) true)
|
||||
tru
|
||||
(do
|
||||
(def bl (in bindings i))
|
||||
(def br (in bindings (+ 1 i)))
|
||||
(if (symbol? bl)
|
||||
~(if (def ,bl ,br) ,(aux (+ 2 i)))
|
||||
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
|
||||
~(if (def ,(def sym (gensym)) ,br)
|
||||
(do (def ,bl ,sym) ,(aux (+ 2 i))))))))
|
||||
~(do
|
||||
(var ,res nil)
|
||||
(if ,(aux 0) ,res ,fal)))
|
||||
(do (def ,bl ,sym) ,(aux (+ 2 i)))
|
||||
,fal2)))))
|
||||
(aux 0))
|
||||
|
||||
(defmacro when-let
|
||||
"Same as `(if-let bindings (do ;body))`."
|
||||
|
@ -712,30 +719,38 @@
|
|||
[f]
|
||||
(fn [x] (not (f x))))
|
||||
|
||||
(defmacro- do-extreme
|
||||
[order args]
|
||||
~(do
|
||||
(def ds ,args)
|
||||
(var k (next ds nil))
|
||||
(var ret (get ds k))
|
||||
(while (,not= nil (set k (next ds k)))
|
||||
(def x (in ds k))
|
||||
(if (,order x ret) (set ret x)))
|
||||
ret))
|
||||
|
||||
(defn extreme
|
||||
``Returns the most extreme value in `args` based on the function `order`.
|
||||
`order` should take two values and return true or false (a comparison).
|
||||
Returns nil if `args` is empty.``
|
||||
[order args]
|
||||
(var [ret] args)
|
||||
(each x args (if (order x ret) (set ret x)))
|
||||
ret)
|
||||
[order args] (do-extreme order args))
|
||||
|
||||
(defn max
|
||||
"Returns the numeric maximum of the arguments."
|
||||
[& args] (extreme > args))
|
||||
[& args] (do-extreme > args))
|
||||
|
||||
(defn min
|
||||
"Returns the numeric minimum of the arguments."
|
||||
[& args] (extreme < args))
|
||||
[& args] (do-extreme < args))
|
||||
|
||||
(defn max-of
|
||||
"Returns the numeric maximum of the argument sequence."
|
||||
[args] (extreme > args))
|
||||
[args] (do-extreme > args))
|
||||
|
||||
(defn min-of
|
||||
"Returns the numeric minimum of the argument sequence."
|
||||
[args] (extreme < args))
|
||||
[args] (do-extreme < args))
|
||||
|
||||
(defn first
|
||||
"Get the first element from an indexed data structure."
|
||||
|
@ -749,6 +764,14 @@
|
|||
|
||||
## Polymorphic comparisons
|
||||
|
||||
(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))))
|
||||
|
||||
(defn compare
|
||||
``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
|
||||
Differs from the primitive comparators in that it first checks to
|
||||
|
@ -756,20 +779,18 @@
|
|||
compare x and y. If so, it uses that method. If not, it
|
||||
delegates to the primitive comparators.``
|
||||
[x y]
|
||||
(or
|
||||
(when-let [f (get x :compare)] (f x y))
|
||||
(when-let [f (get y :compare)] (- (f y x)))
|
||||
(cmp x y)))
|
||||
(do-compare x y))
|
||||
|
||||
(defn- compare-reduce [op xs]
|
||||
(var r true)
|
||||
(loop [i :range [0 (- (length xs) 1)]
|
||||
:let [c (compare (xs i) (xs (+ i 1)))
|
||||
ok (op c 0)]
|
||||
:when (not ok)]
|
||||
(set r false)
|
||||
(break))
|
||||
r)
|
||||
(defmacro- compare-reduce [op xs]
|
||||
~(do
|
||||
(var res true)
|
||||
(var x (get ,xs 0))
|
||||
(forv i 1 (length ,xs)
|
||||
(let [y (in ,xs i)]
|
||||
(if (,op (do-compare x y) 0)
|
||||
(set x y)
|
||||
(do (set res false) (break)))))
|
||||
res))
|
||||
|
||||
(defn compare=
|
||||
``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.``
|
||||
|
@ -809,21 +830,31 @@
|
|||
###
|
||||
###
|
||||
|
||||
(defn- median-of-three [a b c]
|
||||
(if (not= (> a b) (> a c))
|
||||
a
|
||||
(if (not= (> b a) (> b c)) b c)))
|
||||
(defmacro- median-of-three
|
||||
[x y z]
|
||||
~(if (<= ,x ,y)
|
||||
(if (<= ,y ,z) ,y (if (<= ,z ,x) ,x ,z))
|
||||
(if (<= ,z ,y) ,y (if (<= ,x ,z) ,x ,z))))
|
||||
|
||||
(defmacro- sort-partition-template
|
||||
[ind before? left right pivot]
|
||||
~(do
|
||||
(while (,before? (in ,ind ,left) ,pivot) (++ ,left))
|
||||
(while (,before? ,pivot (in ,ind ,right)) (-- ,right))))
|
||||
|
||||
(defn- sort-help [a lo hi before?]
|
||||
(when (< lo hi)
|
||||
(def pivot
|
||||
(median-of-three (in a hi) (in a lo)
|
||||
(in a (math/floor (/ (+ lo hi) 2)))))
|
||||
(def [x y z] [(in a lo)
|
||||
(in a (div (+ lo hi) 2))
|
||||
(in a hi)])
|
||||
(def pivot (median-of-three x y z))
|
||||
(var left lo)
|
||||
(var right hi)
|
||||
(while true
|
||||
(while (before? (in a left) pivot) (++ left))
|
||||
(while (before? pivot (in a right)) (-- right))
|
||||
(case before?
|
||||
< (sort-partition-template a < left right pivot)
|
||||
> (sort-partition-template a > left right pivot)
|
||||
(sort-partition-template a before? left right pivot))
|
||||
(when (<= left right)
|
||||
(def tmp (in a left))
|
||||
(set (a left) (in a right))
|
||||
|
@ -831,8 +862,10 @@
|
|||
(++ left)
|
||||
(-- right))
|
||||
(if (>= left right) (break)))
|
||||
(sort-help a lo right before?)
|
||||
(sort-help a left hi before?))
|
||||
(if (< lo right)
|
||||
(sort-help a lo right before?))
|
||||
(if (< left hi)
|
||||
(sort-help a left hi before?)))
|
||||
a)
|
||||
|
||||
(defn sort
|
||||
|
@ -840,7 +873,8 @@
|
|||
If a `before?` comparator function is provided, sorts elements using that,
|
||||
otherwise uses `<`.``
|
||||
[ind &opt before?]
|
||||
(sort-help ind 0 (- (length ind) 1) (or before? <)))
|
||||
(default before? <)
|
||||
(sort-help ind 0 (- (length ind) 1) before?))
|
||||
|
||||
(defn sort-by
|
||||
``Sorts `ind` in-place by calling a function `f` on each element and
|
||||
|
@ -947,7 +981,6 @@
|
|||
1 (map-n 1 ,maptype ,res ,f ,ind ,inds)
|
||||
2 (map-n 2 ,maptype ,res ,f ,ind ,inds)
|
||||
3 (map-n 3 ,maptype ,res ,f ,ind ,inds)
|
||||
4 (map-n 4 ,maptype ,res ,f ,ind ,inds)
|
||||
(do
|
||||
(def iter-keys (array/new-filled ninds))
|
||||
(def call-buffer (array/new-filled ninds))
|
||||
|
@ -1007,30 +1040,6 @@
|
|||
(map-template :keep res pred ind inds)
|
||||
res)
|
||||
|
||||
(defn range
|
||||
`Create an array of values [start, end) with a given step.
|
||||
With one argument, returns a range [0, end). With two arguments, returns
|
||||
a range [start, end). With three, returns a range with optional step size.`
|
||||
[& args]
|
||||
(case (length args)
|
||||
1 (do
|
||||
(def [n] args)
|
||||
(def arr (array/new n))
|
||||
(forv i 0 n (put arr i i))
|
||||
arr)
|
||||
2 (do
|
||||
(def [n m] args)
|
||||
(def arr (array/new (- m n)))
|
||||
(forv i n m (put arr (- i n) i))
|
||||
arr)
|
||||
3 (do
|
||||
(def [n m s] args)
|
||||
(cond
|
||||
(zero? s) @[]
|
||||
(neg? s) (seq [i :down [n m (- s)]] i)
|
||||
(seq [i :range [n m s]] i)))
|
||||
(error "expected 1 to 3 arguments to range")))
|
||||
|
||||
(defn find-index
|
||||
``Find the index of indexed type for which `pred` is true. Returns `dflt` if not found.``
|
||||
[pred ind &opt dflt]
|
||||
|
@ -1229,7 +1238,7 @@
|
|||
(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 *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrecny control.")
|
||||
(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")
|
||||
|
@ -1264,7 +1273,7 @@
|
|||
|
||||
(defn keep-syntax
|
||||
``Creates a tuple with the tuple type and sourcemap of `before` but the
|
||||
elements of `after`. If either one of its argements is not a tuple, returns
|
||||
elements of `after`. If either one of its arguments is not a tuple, returns
|
||||
`after` unmodified. Useful to preserve syntactic information when transforming
|
||||
an ast in macros.``
|
||||
[before after]
|
||||
|
@ -1414,6 +1423,11 @@
|
|||
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
|
||||
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
|
||||
|
||||
(defmacro with-env
|
||||
`Run a block of code with a given environment table`
|
||||
[env & body]
|
||||
~(,resume (,fiber/new (fn [] ,;body) : ,env)))
|
||||
|
||||
(defmacro with-vars
|
||||
``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
|
||||
`let`, but each binding must be a var.``
|
||||
|
@ -1439,48 +1453,50 @@
|
|||
(fn [& r] (f ;more ;r))))
|
||||
|
||||
(defn every?
|
||||
``Returns true if each value in `ind` is truthy, otherwise returns the first
|
||||
falsey value.``
|
||||
``Evaluates to the last element of `ind` if all preceding elements are truthy,
|
||||
otherwise evaluates to the first falsey element.``
|
||||
[ind]
|
||||
(var res true)
|
||||
(loop [x :in ind :while res]
|
||||
(if x nil (set res x)))
|
||||
(set res x))
|
||||
res)
|
||||
|
||||
(defn any?
|
||||
``Returns the first truthy value in `ind`, otherwise nil.``
|
||||
``Evaluates to the last element of `ind` if all preceding elements are falsey,
|
||||
otherwise evaluates to the first truthy element.``
|
||||
[ind]
|
||||
(var res nil)
|
||||
(loop [x :in ind :until res]
|
||||
(if x (set res x)))
|
||||
(set res x))
|
||||
res)
|
||||
|
||||
(defn reverse!
|
||||
`Reverses the order of the elements in a given array or buffer and returns it
|
||||
mutated.`
|
||||
[t]
|
||||
(def len-1 (- (length t) 1))
|
||||
(def half (/ len-1 2))
|
||||
(forv i 0 half
|
||||
(def j (- len-1 i))
|
||||
(def l (in t i))
|
||||
(def r (in t j))
|
||||
(put t i r)
|
||||
(put t j l))
|
||||
(var i 0)
|
||||
(var j (length t))
|
||||
(while (< i (-- j))
|
||||
(def ti (in t i))
|
||||
(put t i (in t j))
|
||||
(put t j ti)
|
||||
(++ i))
|
||||
t)
|
||||
|
||||
(defn reverse
|
||||
`Reverses the order of the elements in a given array or tuple and returns
|
||||
a new array. If a string or buffer is provided, returns an array of its
|
||||
byte values, reversed.`
|
||||
a new array. If a string or buffer is provided, returns a buffer instead.`
|
||||
[t]
|
||||
(def len (length t))
|
||||
(var n (- len 1))
|
||||
(def ret (array/new len))
|
||||
(while (>= n 0)
|
||||
(array/push ret (in t n))
|
||||
(-- n))
|
||||
ret)
|
||||
(if (lengthable? t)
|
||||
(do
|
||||
(var n (length t))
|
||||
(def ret (if (bytes? t)
|
||||
(buffer/new-filled n)
|
||||
(array/new-filled n)))
|
||||
(each v t
|
||||
(put ret (-- n) v))
|
||||
ret)
|
||||
(reverse! (seq [v :in t] v))))
|
||||
|
||||
(defn invert
|
||||
``Given an associative data structure `ds`, returns a new table where the
|
||||
|
@ -1590,32 +1606,41 @@
|
|||
(defn keys
|
||||
"Get the keys of an associative data structure."
|
||||
[x]
|
||||
(def arr @[])
|
||||
(var k (next x nil))
|
||||
(while (not= nil k)
|
||||
(array/push arr k)
|
||||
(set k (next x k)))
|
||||
arr)
|
||||
(if (lengthable? x)
|
||||
(do
|
||||
(def arr (array/new-filled (length x)))
|
||||
(var i 0)
|
||||
(eachk k x
|
||||
(put arr i k)
|
||||
(++ i))
|
||||
arr)
|
||||
(seq [k :keys x] k)))
|
||||
|
||||
(defn values
|
||||
"Get the values of an associative data structure."
|
||||
[x]
|
||||
(def arr @[])
|
||||
(var k (next x nil))
|
||||
(while (not= nil k)
|
||||
(array/push arr (in x k))
|
||||
(set k (next x k)))
|
||||
arr)
|
||||
(if (lengthable? x)
|
||||
(do
|
||||
(def arr (array/new-filled (length x)))
|
||||
(var i 0)
|
||||
(each v x
|
||||
(put arr i v)
|
||||
(++ i))
|
||||
arr)
|
||||
(seq [v :in x] v)))
|
||||
|
||||
(defn pairs
|
||||
"Get the key-value pairs of an associative data structure."
|
||||
[x]
|
||||
(def arr @[])
|
||||
(var k (next x nil))
|
||||
(while (not= nil k)
|
||||
(array/push arr (tuple k (in x k)))
|
||||
(set k (next x k)))
|
||||
arr)
|
||||
(if (lengthable? x)
|
||||
(do
|
||||
(def arr (array/new-filled (length x)))
|
||||
(var i 0)
|
||||
(eachp p x
|
||||
(put arr i p)
|
||||
(++ i))
|
||||
arr)
|
||||
(seq [p :pairs x] p)))
|
||||
|
||||
(defn frequencies
|
||||
"Get the number of occurrences of each value in an indexed data structure."
|
||||
|
@ -1660,14 +1685,7 @@
|
|||
(defn interleave
|
||||
"Returns an array of the first elements of each col, then the second elements, etc."
|
||||
[& cols]
|
||||
(def res @[])
|
||||
(def ncol (length cols))
|
||||
(when (> ncol 0)
|
||||
(def len (min ;(map length cols)))
|
||||
(loop [i :range [0 len]
|
||||
ci :range [0 ncol]]
|
||||
(array/push res (in (in cols ci) i))))
|
||||
res)
|
||||
(mapcat tuple ;cols))
|
||||
|
||||
(defn distinct
|
||||
"Returns an array of the deduplicated values in `xs`."
|
||||
|
@ -1714,29 +1732,46 @@
|
|||
``Returns a sequence of the elements of `ind` separated by
|
||||
`sep`. Returns a new array.``
|
||||
[sep ind]
|
||||
(var k (next ind nil))
|
||||
(if (not= nil k)
|
||||
(if (lengthable? ind)
|
||||
(do
|
||||
(def ret (array/new-filled (- (* 2 (length ind)) 1) sep))
|
||||
(var i 0)
|
||||
(while (not= nil k)
|
||||
(put ret i (in ind k))
|
||||
(set k (next ind k))
|
||||
(+= i 2))
|
||||
ret)
|
||||
(do
|
||||
(def ret @[(in ind k)])
|
||||
(while (not= nil (set k (next ind k)))
|
||||
(array/push ret sep (in ind k)))
|
||||
ret))
|
||||
@[]))
|
||||
|
||||
(defn- partition-slice
|
||||
[f n ind]
|
||||
(var [start end] [0 n])
|
||||
(def len (length ind))
|
||||
(def ret (array/new (- (* 2 len) 1)))
|
||||
(if (> len 0) (put ret 0 (in ind 0)))
|
||||
(var i 1)
|
||||
(while (< i len)
|
||||
(array/push ret sep (in ind i))
|
||||
(++ i))
|
||||
(def parts (div len n))
|
||||
(def ret (array/new-filled parts))
|
||||
(forv k 0 parts
|
||||
(put ret k (f ind start end))
|
||||
(set start end)
|
||||
(+= end n))
|
||||
(if (< start len)
|
||||
(array/push ret (f ind start)))
|
||||
ret)
|
||||
|
||||
(defn partition
|
||||
``Partition an indexed data structure `ind` into tuples
|
||||
of size `n`. Returns a new array.``
|
||||
[n ind]
|
||||
(var i 0) (var nextn n)
|
||||
(def len (length ind))
|
||||
(def ret (array/new (math/ceil (/ len n))))
|
||||
(def slicer (if (bytes? ind) string/slice tuple/slice))
|
||||
(while (<= nextn len)
|
||||
(array/push ret (slicer ind i nextn))
|
||||
(set i nextn)
|
||||
(+= nextn n))
|
||||
(if (not= i len) (array/push ret (slicer ind i)))
|
||||
ret)
|
||||
(cond
|
||||
(indexed? ind) (partition-slice tuple/slice n ind)
|
||||
(bytes? ind) (partition-slice string/slice n ind)
|
||||
(partition-slice tuple/slice n (values ind))))
|
||||
|
||||
###
|
||||
###
|
||||
|
@ -2099,21 +2134,22 @@
|
|||
'upscope expandall})
|
||||
|
||||
(defn dotup [t]
|
||||
(if (= nil (next t)) (break ()))
|
||||
(def h (in t 0))
|
||||
(def s (in specs h))
|
||||
(def entry (or (dyn h) {}))
|
||||
(def m (do (def r (get entry :ref)) (if r (in r 0) (get entry :value))))
|
||||
(def m? (in entry :macro))
|
||||
(cond
|
||||
s (s t)
|
||||
s (keep-syntax t (s t))
|
||||
m? (do (setdyn *macro-form* t) (m ;(tuple/slice t 1)))
|
||||
(tuple/slice (map recur t))))
|
||||
(keep-syntax! t (map recur t))))
|
||||
|
||||
(def ret
|
||||
(case (type x)
|
||||
:tuple (if (= (tuple/type x) :brackets)
|
||||
(tuple/brackets ;(map recur x))
|
||||
(dotup x))
|
||||
(tuple/brackets ;(map recur x))
|
||||
(dotup x))
|
||||
:array (map recur x)
|
||||
:struct (table/to-struct (dotable x recur))
|
||||
:table (dotable x recur)
|
||||
|
@ -2219,6 +2255,8 @@
|
|||
(set current (macex1 current on-binding)))
|
||||
current)
|
||||
|
||||
(set macexvar macex)
|
||||
|
||||
(defmacro varfn
|
||||
``Create a function that can be rebound. `varfn` has the same signature
|
||||
as `defn`, but defines functions in the environment as vars. If a var `name`
|
||||
|
@ -2309,26 +2347,36 @@
|
|||
(def default-peg-grammar
|
||||
`The default grammar used for pegs. This grammar defines several common patterns
|
||||
that should make it easier to write more complex patterns.`
|
||||
~@{:d (range "09")
|
||||
:a (range "az" "AZ")
|
||||
~@{:a (range "az" "AZ")
|
||||
:d (range "09")
|
||||
:h (range "09" "af" "AF")
|
||||
:s (set " \t\r\n\0\f\v")
|
||||
:w (range "az" "AZ" "09")
|
||||
:h (range "09" "af" "AF")
|
||||
:S (if-not :s 1)
|
||||
:W (if-not :w 1)
|
||||
:A (if-not :a 1)
|
||||
:D (if-not :d 1)
|
||||
:H (if-not :h 1)
|
||||
:d+ (some :d)
|
||||
:S (if-not :s 1)
|
||||
:W (if-not :w 1)
|
||||
:a+ (some :a)
|
||||
:d+ (some :d)
|
||||
:h+ (some :h)
|
||||
:s+ (some :s)
|
||||
:w+ (some :w)
|
||||
:h+ (some :h)
|
||||
:d* (any :d)
|
||||
:A+ (some :A)
|
||||
:D+ (some :D)
|
||||
:H+ (some :H)
|
||||
:S+ (some :S)
|
||||
:W+ (some :W)
|
||||
:a* (any :a)
|
||||
:w* (any :w)
|
||||
:d* (any :d)
|
||||
:h* (any :h)
|
||||
:s* (any :s)
|
||||
:h* (any :h)})
|
||||
:w* (any :w)
|
||||
:A* (any :A)
|
||||
:D* (any :D)
|
||||
:H* (any :H)
|
||||
:S* (any :S)
|
||||
:W* (any :W)})
|
||||
|
||||
(setdyn *peg-grammar* default-peg-grammar)
|
||||
|
||||
|
@ -2724,6 +2772,12 @@
|
|||
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
|
||||
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
||||
|
||||
(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-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`.")
|
||||
|
||||
(def module/cache
|
||||
"A table, mapping loaded module identifiers to their environments."
|
||||
@{})
|
||||
|
@ -2752,24 +2806,25 @@
|
|||
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
|
||||
```
|
||||
[ext loader]
|
||||
(def mp (dyn *module-paths* module/paths))
|
||||
(defn- find-prefix
|
||||
[pre]
|
||||
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
|
||||
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) mp) 0))
|
||||
(def dyn-index (find-prefix ":@all:"))
|
||||
(array/insert module/paths dyn-index [(string ":@all:" ext) loader check-dyn-relative])
|
||||
(array/insert mp dyn-index [(string ":@all:" ext) loader check-dyn-relative])
|
||||
(def all-index (find-prefix ".:all:"))
|
||||
(array/insert module/paths all-index [(string ".:all:" ext) loader check-project-relative])
|
||||
(array/insert mp all-index [(string ".:all:" ext) loader check-project-relative])
|
||||
(def sys-index (find-prefix ":sys:"))
|
||||
(array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
|
||||
(array/insert mp sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
|
||||
(def curall-index (find-prefix ":cur:/:all:"))
|
||||
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
|
||||
module/paths)
|
||||
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
|
||||
mp)
|
||||
|
||||
(module/add-paths ":native:" :native)
|
||||
(module/add-paths "/init.janet" :source)
|
||||
(module/add-paths ".janet" :source)
|
||||
(module/add-paths ".jimage" :image)
|
||||
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-not-relative])
|
||||
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path)) :preload check-not-relative])
|
||||
|
||||
# Version of fexists that works even with a reduced OS
|
||||
(defn- fexists
|
||||
|
@ -2799,7 +2854,8 @@
|
|||
```
|
||||
[path]
|
||||
(var ret nil)
|
||||
(each [p mod-kind checker] module/paths
|
||||
(def mp (dyn *module-paths* module/paths))
|
||||
(each [p mod-kind checker] mp
|
||||
(when (mod-filter checker path)
|
||||
(if (function? p)
|
||||
(when-let [res (p path)]
|
||||
|
@ -2815,7 +2871,7 @@
|
|||
(when (string? t)
|
||||
(when (mod-filter chk path)
|
||||
(module/expand-path path t))))
|
||||
paths (filter identity (map expander module/paths))
|
||||
paths (filter identity (map expander mp))
|
||||
str-parts (interpose "\n " paths)]
|
||||
[nil (string "could not find module " path ":\n " ;str-parts)])))
|
||||
|
||||
|
@ -2883,7 +2939,12 @@
|
|||
(if (= :dead fs)
|
||||
(when is-repl
|
||||
(put env '_ @{:value x})
|
||||
(printf (get env *pretty-format* "%q") x)
|
||||
(def pf (get env *pretty-format* "%q"))
|
||||
(try
|
||||
(printf pf x)
|
||||
([e]
|
||||
(eprintf "bad pretty format %v: %v" pf e)
|
||||
(eflush)))
|
||||
(flush))
|
||||
(do
|
||||
(debug/stacktrace f x "")
|
||||
|
@ -2903,7 +2964,7 @@
|
|||
:core/stream path
|
||||
(file/open path :rb)))
|
||||
(def path-is-file (= f path))
|
||||
(default env (make-env))
|
||||
(default env ((dyn *module-make-env* make-env)))
|
||||
(def spath (string path))
|
||||
(put env :source (or source (if-not path-is-file spath path)))
|
||||
(var exit-error nil)
|
||||
|
@ -2965,13 +3026,15 @@
|
|||
of files as modules.``
|
||||
@{:native (fn native-loader [path &] (native path (make-env)))
|
||||
:source (fn source-loader [path args]
|
||||
(put module/loading path true)
|
||||
(defer (put module/loading path nil)
|
||||
(def ml (dyn *module-loading* module/loading))
|
||||
(put ml path true)
|
||||
(defer (put ml path nil)
|
||||
(dofile path ;args)))
|
||||
:preload (fn preload-loader [path & args]
|
||||
(when-let [m (in module/cache path)]
|
||||
(def mc (dyn *module-cache* module/cache))
|
||||
(when-let [m (in mc path)]
|
||||
(if (function? m)
|
||||
(set (module/cache path) (m path ;args))
|
||||
(set (mc path) (m path ;args))
|
||||
m)))
|
||||
:image (fn image-loader [path &] (load-image (slurp path)))})
|
||||
|
||||
|
@ -2979,15 +3042,18 @@
|
|||
[path args kargs]
|
||||
(def [fullpath mod-kind] (module/find path))
|
||||
(unless fullpath (error mod-kind))
|
||||
(if-let [check (if-not (kargs :fresh) (in module/cache fullpath))]
|
||||
(def mc (dyn *module-cache* module/cache))
|
||||
(def ml (dyn *module-loading* module/loading))
|
||||
(def mls (dyn *module-loaders* module/loaders))
|
||||
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
|
||||
check
|
||||
(if (module/loading fullpath)
|
||||
(if (ml fullpath)
|
||||
(error (string "circular dependency " fullpath " detected"))
|
||||
(do
|
||||
(def loader (if (keyword? mod-kind) (module/loaders mod-kind) mod-kind))
|
||||
(def loader (if (keyword? mod-kind) (mls mod-kind) mod-kind))
|
||||
(unless loader (error (string "module type " mod-kind " unknown")))
|
||||
(def env (loader fullpath args))
|
||||
(put module/cache fullpath env)
|
||||
(put mc fullpath env)
|
||||
env))))
|
||||
|
||||
(defn require
|
||||
|
@ -3384,9 +3450,9 @@
|
|||
(defn- print-special-form-entry
|
||||
[x]
|
||||
(print "\n\n"
|
||||
(string " special form\n\n")
|
||||
(string " (" x " ...)\n\n")
|
||||
(string " See https://janet-lang.org/docs/specials.html\n\n")))
|
||||
" special form\n\n"
|
||||
" (" x " ...)\n\n"
|
||||
" See https://janet-lang.org/docs/specials.html\n\n"))
|
||||
|
||||
(defn doc*
|
||||
"Get the documentation for a symbol in a given environment. Function form of `doc`."
|
||||
|
@ -3520,6 +3586,24 @@
|
|||
(when-let [constants (dasm :constants)]
|
||||
(eprintf " constants: %.4q" constants))
|
||||
(eprintf " slots: %.4q\n" (frame :slots))
|
||||
(when-let [src-path (in dasm :source)]
|
||||
(when (and (fexists src-path)
|
||||
sourcemap)
|
||||
(defn dump
|
||||
[src cur]
|
||||
(def offset 5)
|
||||
(def beg (max 1 (- cur offset)))
|
||||
(def lines (array/concat @[""] (string/split "\n" src)))
|
||||
(def end (min (+ cur offset) (length lines)))
|
||||
(def digits (inc (math/floor (math/log10 end))))
|
||||
(def fmt-str (string "%" digits "d: %s"))
|
||||
(for i beg end
|
||||
(eprin " ") # breakpoint someday?
|
||||
(eprin (if (= i cur) "> " " "))
|
||||
(eprintf fmt-str i (get lines i))))
|
||||
(let [[sl _] (sourcemap pc)]
|
||||
(dump (slurp src-path) sl)
|
||||
(eprint))))
|
||||
(def padding (string/repeat " " 20))
|
||||
(loop [i :range [0 (length bytecode)]
|
||||
:let [instr (bytecode i)]]
|
||||
|
@ -3664,18 +3748,50 @@
|
|||
[& body]
|
||||
~(,ev/thread (fn _do-thread [&] ,;body)))
|
||||
|
||||
(defn- acquire-release
|
||||
[acq rel lock body]
|
||||
(def l (gensym))
|
||||
~(do
|
||||
(def ,l ,lock)
|
||||
(,acq ,l)
|
||||
(defer (,rel ,l)
|
||||
,;body)))
|
||||
|
||||
(defmacro ev/with-lock
|
||||
``Run a body of code after acquiring a lock. Will automatically release the lock when done.``
|
||||
[lock & body]
|
||||
(acquire-release ev/acquire-lock ev/release-lock lock body))
|
||||
|
||||
(defmacro ev/with-rlock
|
||||
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
|
||||
[lock & body]
|
||||
(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.``
|
||||
[lock & body]
|
||||
(acquire-release ev/acquire-wlock ev/release-wlock lock body))
|
||||
|
||||
(defmacro ev/spawn-thread
|
||||
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
|
||||
[& body]
|
||||
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
|
||||
|
||||
(defmacro ev/with-deadline
|
||||
`Run a body of code with a deadline, such that if the code does not complete before
|
||||
the deadline is up, it will be canceled.`
|
||||
[deadline & body]
|
||||
``
|
||||
Create a fiber to execute `body`, schedule the event loop to cancel
|
||||
the task (root fiber) associated with `body`'s fiber, and start
|
||||
`body`'s fiber by resuming it.
|
||||
|
||||
The event loop will try to cancel the root fiber if `body`'s fiber
|
||||
has not completed after at least `sec` seconds.
|
||||
|
||||
`sec` is a number that can have a fractional part.
|
||||
``
|
||||
[sec & body]
|
||||
(with-syms [f]
|
||||
~(let [,f (coro ,;body)]
|
||||
(,ev/deadline ,deadline nil ,f)
|
||||
(,ev/deadline ,sec nil ,f)
|
||||
(,resume ,f))))
|
||||
|
||||
(defn- cancel-all [chan fibers reason]
|
||||
|
@ -3719,7 +3835,7 @@
|
|||
[host port &opt handler type]
|
||||
(def s (net/listen host port type))
|
||||
(if handler
|
||||
(ev/call (fn [] (net/accept-loop s handler))))
|
||||
(ev/go (fn [] (net/accept-loop s handler))))
|
||||
s))
|
||||
|
||||
###
|
||||
|
@ -3767,9 +3883,11 @@
|
|||
:lazy lazy
|
||||
:map-symbols map-symbols}))
|
||||
|
||||
(defmacro ffi/defbind
|
||||
"Generate bindings for native functions in a convenient manner."
|
||||
[name ret-type & body]
|
||||
(defmacro ffi/defbind-alias
|
||||
"Generate bindings for native functions in a convenient manner.
|
||||
Similar to defbind but allows for the janet function name to be
|
||||
different than the FFI function."
|
||||
[name alias ret-type & body]
|
||||
(def real-ret-type (eval ret-type))
|
||||
(def meta (slice body 0 -2))
|
||||
(def arg-pairs (partition 2 (last body)))
|
||||
|
@ -3786,11 +3904,16 @@
|
|||
(defn make-ptr []
|
||||
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
|
||||
(if lazy
|
||||
~(defn ,name ,;meta [,;formal-args]
|
||||
~(defn ,alias ,;meta [,;formal-args]
|
||||
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
|
||||
~(defn ,name ,;meta [,;formal-args]
|
||||
~(defn ,alias ,;meta [,;formal-args]
|
||||
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
|
||||
|
||||
(defmacro ffi/defbind
|
||||
"Generate bindings for native functions in a convenient manner."
|
||||
[name ret-type & body]
|
||||
~(ffi/defbind-alias ,name ,name ,ret-type ,;body))
|
||||
|
||||
###
|
||||
###
|
||||
### Flychecking
|
||||
|
@ -3934,6 +4057,28 @@
|
|||
(def x (in args (+ i 1)))
|
||||
(or (scan-number x) (keyword x)))
|
||||
|
||||
(def- long-to-short
|
||||
"map long options to short options"
|
||||
{"-help" "h"
|
||||
"-version" "v"
|
||||
"-stdin" "s"
|
||||
"-eval" "e"
|
||||
"-expression" "E"
|
||||
"-debug" "d"
|
||||
"-repl" "r"
|
||||
"-noprofile" "R"
|
||||
"-persistent" "p"
|
||||
"-quiet" "q"
|
||||
"-flycheck" "k"
|
||||
"-syspath" "m"
|
||||
"-compile" "c"
|
||||
"-image" "i"
|
||||
"-nocolor" "n"
|
||||
"-color" "N"
|
||||
"-library" "l"
|
||||
"-lint-warn" "w"
|
||||
"-lint-error" "x"})
|
||||
|
||||
# Flag handlers
|
||||
(def handlers
|
||||
{"h" (fn [&]
|
||||
|
@ -3941,26 +4086,26 @@
|
|||
(print
|
||||
```
|
||||
Options are:
|
||||
-h : Show this help
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-E code arguments... : Evaluate an expression as a short-fn with arguments
|
||||
-d : Set the debug flag in the REPL
|
||||
-r : Enter the REPL after running all scripts
|
||||
-R : Disables loading profile.janet when JANET_PROFILE is present
|
||||
-p : Keep on executing if there is a top-level error (persistent)
|
||||
-q : Hide logo (quiet)
|
||||
-k : Compile scripts but do not execute (flycheck)
|
||||
-m syspath : Set system path for loading global modules
|
||||
-c source output : Compile janet source code into an image
|
||||
-i : Load the script argument as an image file instead of source code
|
||||
-n : Disable ANSI color output in the REPL
|
||||
-N : Enable ANSI color output in the REPL
|
||||
-l lib : Use a module before processing more arguments
|
||||
-w level : Set the lint warning level - default is "normal"
|
||||
-x level : Set the lint error level - default is "none"
|
||||
-- : Stop handling options
|
||||
--help (-h) : Show this help
|
||||
--version (-v) : Print the version string
|
||||
--stdin (-s) : Use raw stdin instead of getline like functionality
|
||||
--eval (-e) code : Execute a string of janet
|
||||
--expression (-E) code arguments... : Evaluate an expression as a short-fn with arguments
|
||||
--debug (-d) : Set the debug flag in the REPL
|
||||
--repl (-r) : Enter the REPL after running all scripts
|
||||
--noprofile (-R) : Disables loading profile.janet when JANET_PROFILE is present
|
||||
--persistent (-p) : Keep on executing if there is a top-level error (persistent)
|
||||
--quiet (-q) : Hide logo (quiet)
|
||||
--flycheck (-k) : Compile scripts but do not execute (flycheck)
|
||||
--syspath (-m) syspath : Set system path for loading global modules
|
||||
--compile (-c) source output : Compile janet source code into an image
|
||||
--image (-i) : Load the script argument as an image file instead of source code
|
||||
--nocolor (-n) : Disable ANSI color output in the REPL
|
||||
--color (-N) : Enable ANSI color output in the REPL
|
||||
--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"
|
||||
-- : Stop handling options
|
||||
```)
|
||||
(os/exit 0)
|
||||
1)
|
||||
|
@ -4004,8 +4149,8 @@
|
|||
"R" (fn [&] (setdyn *profilepath* nil) 1)})
|
||||
|
||||
(defn- dohandler [n i &]
|
||||
(def h (in handlers n))
|
||||
(if h (h i) (do (print "unknown flag -" n) ((in handlers "h")))))
|
||||
(def h (in handlers (get long-to-short n n)))
|
||||
(if h (h i handlers) (do (print "unknown flag -" n) ((in handlers "h")))))
|
||||
|
||||
# Process arguments
|
||||
(var i 0)
|
||||
|
|
|
@ -4,10 +4,10 @@
|
|||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 29
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_MINOR 34
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.29.1"
|
||||
#define JANET_VERSION "1.34.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
@ -52,6 +52,9 @@
|
|||
/* #define JANET_EV_NO_EPOLL */
|
||||
/* #define JANET_EV_NO_KQUEUE */
|
||||
/* #define JANET_NO_INTERPRETER_INTERRUPT */
|
||||
/* #define JANET_NO_IPV6 */
|
||||
/* #define JANET_NO_CRYPTORAND */
|
||||
/* #define JANET_USE_STDATOMIC */
|
||||
|
||||
/* Custom vm allocator support */
|
||||
/* #include <mimalloc.h> */
|
||||
|
|
|
@ -31,8 +31,6 @@
|
|||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <stdatomic.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
|
@ -97,14 +95,6 @@ size_t janet_os_rwlock_size(void) {
|
|||
return sizeof(void *);
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
InitializeCriticalSection((CRITICAL_SECTION *) mutex);
|
||||
}
|
||||
|
@ -157,14 +147,6 @@ size_t janet_os_rwlock_size(void) {
|
|||
return sizeof(pthread_rwlock_t);
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
pthread_mutexattr_t attr;
|
||||
pthread_mutexattr_init(&attr);
|
||||
|
@ -212,11 +194,11 @@ void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
|||
#endif
|
||||
|
||||
int32_t janet_abstract_incref(void *abst) {
|
||||
return janet_incref(janet_abstract_head(abst));
|
||||
return janet_atomic_inc(&janet_abstract_head(abst)->gc.data.refcount);
|
||||
}
|
||||
|
||||
int32_t janet_abstract_decref(void *abst) {
|
||||
return janet_decref(janet_abstract_head(abst));
|
||||
return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
|
@ -30,9 +30,7 @@
|
|||
|
||||
#include <string.h>
|
||||
|
||||
/* Creates a new array */
|
||||
JanetArray *janet_array(int32_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
static void janet_array_impl(JanetArray *array, int32_t capacity) {
|
||||
Janet *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm.next_collection += capacity * sizeof(Janet);
|
||||
|
@ -44,6 +42,19 @@ JanetArray *janet_array(int32_t capacity) {
|
|||
array->count = 0;
|
||||
array->capacity = capacity;
|
||||
array->data = data;
|
||||
}
|
||||
|
||||
/* Creates a new array */
|
||||
JanetArray *janet_array(int32_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
janet_array_impl(array, capacity);
|
||||
return array;
|
||||
}
|
||||
|
||||
/* Creates a new array with weak references */
|
||||
JanetArray *janet_array_weak(int32_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY_WEAK, sizeof(JanetArray));
|
||||
janet_array_impl(array, capacity);
|
||||
return array;
|
||||
}
|
||||
|
||||
|
@ -132,6 +143,15 @@ JANET_CORE_FN(cfun_array_new,
|
|||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_weak,
|
||||
"(array/weak capacity)",
|
||||
"Creates a new empty array with a pre-allocated capacity and support for weak references. Similar to `array/new`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetArray *array = janet_array_weak(cap);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_new_filled,
|
||||
"(array/new-filled count &opt value)",
|
||||
"Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") {
|
||||
|
@ -177,8 +197,8 @@ JANET_CORE_FN(cfun_array_peek,
|
|||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_push,
|
||||
"(array/push arr x)",
|
||||
"Insert an element in the end of an array. Modifies the input array and returns it.") {
|
||||
"(array/push arr & xs)",
|
||||
"Push all the elements of xs to the end of an array. Modifies the input array and returns it.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (INT32_MAX - argc + 1 <= array->count) {
|
||||
|
@ -211,7 +231,7 @@ JANET_CORE_FN(cfun_array_slice,
|
|||
"Takes a slice of array or tuple from `start` to `end`. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the "
|
||||
"end of the array. By default, `start` is 0 and `end` is the length of the array. "
|
||||
"Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
|
||||
"Note that if the range is negative, it is taken as (start, end] to allow a full "
|
||||
"negative slice range. Returns a new array.") {
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
|
@ -259,8 +279,8 @@ JANET_CORE_FN(cfun_array_insert,
|
|||
"(array/insert arr at & xs)",
|
||||
"Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
|
||||
"0 and the length of the array. A negative value for `at` will index backwards from "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.") {
|
||||
"the end of the array, inserting after the index such that inserting at -1 appends to "
|
||||
"the array. Returns the array.") {
|
||||
size_t chunksize, restsize;
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
|
@ -297,7 +317,7 @@ JANET_CORE_FN(cfun_array_remove,
|
|||
int32_t at = janet_getinteger(argv, 1);
|
||||
int32_t n = 1;
|
||||
if (at < 0) {
|
||||
at = array->count + at + 1;
|
||||
at = array->count + at;
|
||||
}
|
||||
if (at < 0 || at > array->count)
|
||||
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
|
||||
|
@ -352,6 +372,7 @@ JANET_CORE_FN(cfun_array_clear,
|
|||
void janet_lib_array(JanetTable *env) {
|
||||
JanetRegExt array_cfuns[] = {
|
||||
JANET_CORE_REG("array/new", cfun_array_new),
|
||||
JANET_CORE_REG("array/weak", cfun_array_weak),
|
||||
JANET_CORE_REG("array/new-filled", cfun_array_new_filled),
|
||||
JANET_CORE_REG("array/fill", cfun_array_fill),
|
||||
JANET_CORE_REG("array/pop", cfun_array_pop),
|
||||
|
|
|
@ -75,6 +75,7 @@ static const JanetInstructionDef janet_ops[] = {
|
|||
{"cmp", JOP_COMPARE},
|
||||
{"cncl", JOP_CANCEL},
|
||||
{"div", JOP_DIVIDE},
|
||||
{"divf", JOP_DIVIDE_FLOOR},
|
||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||
{"eq", JOP_EQUALS},
|
||||
{"eqim", JOP_EQUALS_IMMEDIATE},
|
||||
|
@ -137,6 +138,7 @@ static const JanetInstructionDef janet_ops[] = {
|
|||
{"sru", JOP_SHIFT_RIGHT_UNSIGNED},
|
||||
{"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
|
||||
{"sub", JOP_SUBTRACT},
|
||||
{"subim", JOP_SUBTRACT_IMMEDIATE},
|
||||
{"tcall", JOP_TAILCALL},
|
||||
{"tchck", JOP_TYPECHECK}
|
||||
};
|
||||
|
@ -558,6 +560,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||
x = janet_get1(s, janet_ckeywordv("vararg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
/* Initialize slotcount */
|
||||
def->slotcount = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG) + def->arity;
|
||||
|
||||
/* Check structarg */
|
||||
x = janet_get1(s, janet_ckeywordv("structarg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
|
@ -782,8 +787,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||
}
|
||||
|
||||
/* Verify the func def */
|
||||
if (janet_verify(def)) {
|
||||
janet_asm_error(&a, "invalid assembly");
|
||||
int verify_status = janet_verify(def);
|
||||
if (verify_status) {
|
||||
janet_asm_errorv(&a, janet_formatc("invalid assembly (%d)", verify_status));
|
||||
}
|
||||
|
||||
/* Add final flags */
|
||||
|
|
|
@ -135,8 +135,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
|||
|
||||
/* Push a cstring to buffer */
|
||||
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||
int32_t len = 0;
|
||||
while (cstring[len]) ++len;
|
||||
int32_t len = (int32_t) strlen(cstring);
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
||||
}
|
||||
|
||||
|
@ -221,6 +220,20 @@ JANET_CORE_FN(cfun_buffer_new_filled,
|
|||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_frombytes,
|
||||
"(buffer/from-bytes & byte-vals)",
|
||||
"Creates a buffer from integer parameters with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.") {
|
||||
int32_t i;
|
||||
JanetBuffer *buffer = janet_buffer(argc);
|
||||
for (i = 0; i < argc; i++) {
|
||||
int32_t c = janet_getinteger(argv, i);
|
||||
buffer->data[i] = c & 0xFF;
|
||||
}
|
||||
buffer->count = argc;
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_fill,
|
||||
"(buffer/fill buffer &opt byte)",
|
||||
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
|
||||
|
@ -307,6 +320,143 @@ JANET_CORE_FN(cfun_buffer_chars,
|
|||
return argv[0];
|
||||
}
|
||||
|
||||
static int should_reverse_bytes(const Janet *argv, int32_t argc) {
|
||||
JanetKeyword order_kw = janet_getkeyword(argv, argc);
|
||||
if (!janet_cstrcmp(order_kw, "le")) {
|
||||
#if JANET_BIG_ENDIAN
|
||||
return 1;
|
||||
#endif
|
||||
} else if (!janet_cstrcmp(order_kw, "be")) {
|
||||
#if JANET_LITTLE_ENDIAN
|
||||
return 1;
|
||||
#endif
|
||||
} else if (!janet_cstrcmp(order_kw, "native")) {
|
||||
return 0;
|
||||
} else {
|
||||
janet_panicf("expected endianness :le, :be or :native, got %v", argv[1]);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void reverse_u32(uint8_t bytes[4]) {
|
||||
uint8_t temp;
|
||||
temp = bytes[3];
|
||||
bytes[3] = bytes[0];
|
||||
bytes[0] = temp;
|
||||
temp = bytes[2];
|
||||
bytes[2] = bytes[1];
|
||||
bytes[1] = temp;
|
||||
}
|
||||
|
||||
static void reverse_u64(uint8_t bytes[8]) {
|
||||
uint8_t temp;
|
||||
temp = bytes[7];
|
||||
bytes[7] = bytes[0];
|
||||
bytes[0] = temp;
|
||||
temp = bytes[6];
|
||||
bytes[6] = bytes[1];
|
||||
bytes[1] = temp;
|
||||
temp = bytes[5];
|
||||
bytes[5] = bytes[2];
|
||||
bytes[2] = temp;
|
||||
temp = bytes[4];
|
||||
bytes[4] = bytes[3];
|
||||
bytes[3] = temp;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_uint16,
|
||||
"(buffer/push-uint16 buffer order data)",
|
||||
"Push a 16 bit unsigned integer data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
uint16_t data;
|
||||
uint8_t bytes[2];
|
||||
} u;
|
||||
u.data = (uint16_t) janet_getinteger(argv, 2);
|
||||
if (reverse) {
|
||||
uint8_t temp = u.bytes[1];
|
||||
u.bytes[1] = u.bytes[0];
|
||||
u.bytes[0] = temp;
|
||||
}
|
||||
janet_buffer_push_u16(buffer, *(uint16_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_uint32,
|
||||
"(buffer/push-uint32 buffer order data)",
|
||||
"Push a 32 bit unsigned integer data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
uint32_t data;
|
||||
uint8_t bytes[4];
|
||||
} u;
|
||||
u.data = (uint32_t) janet_getinteger(argv, 2);
|
||||
if (reverse)
|
||||
reverse_u32(u.bytes);
|
||||
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_uint64,
|
||||
"(buffer/push-uint64 buffer order data)",
|
||||
"Push a 64 bit unsigned integer data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
uint64_t data;
|
||||
uint8_t bytes[8];
|
||||
} u;
|
||||
u.data = (uint64_t) janet_getuinteger64(argv, 2);
|
||||
if (reverse)
|
||||
reverse_u64(u.bytes);
|
||||
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_float32,
|
||||
"(buffer/push-float32 buffer order data)",
|
||||
"Push the underlying bytes of a 32 bit float data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
float data;
|
||||
uint8_t bytes[4];
|
||||
} u;
|
||||
u.data = (float) janet_getnumber(argv, 2);
|
||||
if (reverse)
|
||||
reverse_u32(u.bytes);
|
||||
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_float64,
|
||||
"(buffer/push-float64 buffer order data)",
|
||||
"Push the underlying bytes of a 64 bit float data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int reverse = should_reverse_bytes(argv, 1);
|
||||
union {
|
||||
double data;
|
||||
uint8_t bytes[8];
|
||||
} u;
|
||||
u.data = janet_getnumber(argv, 2);
|
||||
if (reverse)
|
||||
reverse_u64(u.bytes);
|
||||
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) {
|
||||
for (int32_t i = argc_offset; i < argc; i++) {
|
||||
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
||||
|
@ -462,13 +612,15 @@ JANET_CORE_FN(cfun_buffer_blit,
|
|||
int same_buf = src.bytes == dest->data;
|
||||
int32_t offset_dest = 0;
|
||||
int32_t offset_src = 0;
|
||||
if (argc > 2)
|
||||
if (argc > 2 && !janet_checktype(argv[2], JANET_NIL))
|
||||
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
|
||||
if (argc > 3)
|
||||
if (argc > 3 && !janet_checktype(argv[3], JANET_NIL))
|
||||
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
|
||||
int32_t length_src;
|
||||
if (argc > 4) {
|
||||
int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
|
||||
int32_t src_end = src.len;
|
||||
if (!janet_checktype(argv[4], JANET_NIL))
|
||||
src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
|
||||
length_src = src_end - offset_src;
|
||||
if (length_src < 0) length_src = 0;
|
||||
} else {
|
||||
|
@ -503,15 +655,42 @@ JANET_CORE_FN(cfun_buffer_format,
|
|||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_format_at,
|
||||
"(buffer/format-at buffer at format & args)",
|
||||
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||
"the modified buffer.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t at = janet_getinteger(argv, 1);
|
||||
if (at < 0) {
|
||||
at += buffer->count + 1;
|
||||
}
|
||||
if (at > buffer->count || at < 0) janet_panicf("expected index at to be in range [0, %d), got %d", buffer->count, at);
|
||||
int32_t oldcount = buffer->count;
|
||||
buffer->count = at;
|
||||
const char *strfrmt = (const char *) janet_getstring(argv, 2);
|
||||
janet_buffer_format(buffer, strfrmt, 2, argc, argv);
|
||||
if (buffer->count < oldcount) {
|
||||
buffer->count = oldcount;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
void janet_lib_buffer(JanetTable *env) {
|
||||
JanetRegExt buffer_cfuns[] = {
|
||||
JANET_CORE_REG("buffer/new", cfun_buffer_new),
|
||||
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
|
||||
JANET_CORE_REG("buffer/from-bytes", cfun_buffer_frombytes),
|
||||
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
|
||||
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
|
||||
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
|
||||
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
|
||||
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
|
||||
JANET_CORE_REG("buffer/push-uint16", cfun_buffer_push_uint16),
|
||||
JANET_CORE_REG("buffer/push-uint32", cfun_buffer_push_uint32),
|
||||
JANET_CORE_REG("buffer/push-uint64", cfun_buffer_push_uint64),
|
||||
JANET_CORE_REG("buffer/push-float32", cfun_buffer_push_float32),
|
||||
JANET_CORE_REG("buffer/push-float64", cfun_buffer_push_float64),
|
||||
JANET_CORE_REG("buffer/push", cfun_buffer_push),
|
||||
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
|
||||
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
|
||||
|
@ -523,6 +702,7 @@ void janet_lib_buffer(JanetTable *env) {
|
|||
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
|
||||
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
|
||||
JANET_CORE_REG("buffer/format", cfun_buffer_format),
|
||||
JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, buffer_cfuns);
|
||||
|
|
|
@ -37,11 +37,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||
JINT_0, /* JOP_RETURN_NIL, */
|
||||
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_ADD, */
|
||||
JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_SUBTRACT, */
|
||||
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_MULTIPLY, */
|
||||
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_DIVIDE, */
|
||||
JINT_SSS, /* JOP_DIVIDE_FLOOR */
|
||||
JINT_SSS, /* JOP_MODULO, */
|
||||
JINT_SSS, /* JOP_REMAINDER, */
|
||||
JINT_SSS, /* JOP_BAND, */
|
||||
|
@ -224,6 +226,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
|||
case JOP_LOAD_TRUE:
|
||||
case JOP_LOAD_FALSE:
|
||||
case JOP_LOAD_SELF:
|
||||
break;
|
||||
case JOP_MAKE_ARRAY:
|
||||
case JOP_MAKE_BUFFER:
|
||||
case JOP_MAKE_STRING:
|
||||
|
@ -231,6 +234,8 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
|||
case JOP_MAKE_TABLE:
|
||||
case JOP_MAKE_TUPLE:
|
||||
case JOP_MAKE_BRACKET_TUPLE:
|
||||
/* Reads from the stack, don't remove */
|
||||
janetc_regalloc_touch(&ra, DD);
|
||||
break;
|
||||
|
||||
/* Read A */
|
||||
|
@ -250,6 +255,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
|||
case JOP_SIGNAL:
|
||||
/* Write A, Read B */
|
||||
case JOP_ADD_IMMEDIATE:
|
||||
case JOP_SUBTRACT_IMMEDIATE:
|
||||
case JOP_MULTIPLY_IMMEDIATE:
|
||||
case JOP_DIVIDE_IMMEDIATE:
|
||||
case JOP_SHIFT_LEFT_IMMEDIATE:
|
||||
|
@ -301,6 +307,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
|||
case JOP_SUBTRACT:
|
||||
case JOP_MULTIPLY:
|
||||
case JOP_DIVIDE:
|
||||
case JOP_DIVIDE_FLOOR:
|
||||
case JOP_MODULO:
|
||||
case JOP_REMAINDER:
|
||||
case JOP_SHIFT_LEFT:
|
||||
|
|
121
src/core/capi.c
121
src/core/capi.c
|
@ -35,6 +35,13 @@
|
|||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef JANET_USE_STDATOMIC
|
||||
#include <stdatomic.h>
|
||||
/* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations.
|
||||
* Some (TCC), explicitly require using stdatomic.h and don't have any exposed builtins (that I know of).
|
||||
* For TCC and similar compilers, one would need -std=c11 or similar then to get access. */
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
#ifdef JANET_TOP_LEVEL_SIGNAL
|
||||
JANET_TOP_LEVEL_SIGNAL(msg);
|
||||
|
@ -216,12 +223,32 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
|
|||
}
|
||||
|
||||
const char *janet_getcbytes(const Janet *argv, int32_t n) {
|
||||
/* Ensure buffer 0-padded */
|
||||
if (janet_checktype(argv[n], JANET_BUFFER)) {
|
||||
JanetBuffer *b = janet_unwrap_buffer(argv[n]);
|
||||
if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) {
|
||||
/* Make a copy with janet_smalloc in the rare case we have a buffer that
|
||||
* cannot be realloced and pushing a 0 byte would panic. */
|
||||
char *new_string = janet_smalloc(b->count + 1);
|
||||
memcpy(new_string, b->data, b->count);
|
||||
new_string[b->count] = 0;
|
||||
if (strlen(new_string) != (size_t) b->count) goto badzeros;
|
||||
return new_string;
|
||||
} else {
|
||||
/* Ensure trailing 0 */
|
||||
janet_buffer_push_u8(b, 0);
|
||||
b->count--;
|
||||
if (strlen((char *)b->data) != (size_t) b->count) goto badzeros;
|
||||
return (const char *) b->data;
|
||||
}
|
||||
}
|
||||
JanetByteView view = janet_getbytes(argv, n);
|
||||
const char *cstr = (const char *)view.bytes;
|
||||
if (strlen(cstr) != (size_t) view.len) {
|
||||
janet_panic("bytes contain embedded 0s");
|
||||
}
|
||||
if (strlen(cstr) != (size_t) view.len) goto badzeros;
|
||||
return cstr;
|
||||
|
||||
badzeros:
|
||||
janet_panic("bytes contain embedded 0s");
|
||||
}
|
||||
|
||||
const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
|
||||
|
@ -273,6 +300,14 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
|||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||
#ifdef JANET_INT_TYPES
|
||||
return janet_unwrap_s64(argv[n]);
|
||||
|
@ -290,7 +325,7 @@ uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
|
|||
return janet_unwrap_u64(argv[n]);
|
||||
#else
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint64(x)) {
|
||||
if (!janet_checkuint64(x)) {
|
||||
janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
|
||||
}
|
||||
return (uint64_t) janet_unwrap_number(x);
|
||||
|
@ -310,16 +345,30 @@ int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const c
|
|||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length + 1;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
|
||||
janet_panicf("%s index %d out of range [%d,%d]", which, (int64_t) raw, -(int64_t)length - 1, (int64_t) length);
|
||||
return not_raw;
|
||||
}
|
||||
|
||||
int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
|
||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
|
||||
return 0;
|
||||
}
|
||||
return janet_gethalfrange(argv, n, length, "start");
|
||||
}
|
||||
|
||||
int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
|
||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
|
||||
return length;
|
||||
}
|
||||
return janet_gethalfrange(argv, n, length, "end");
|
||||
}
|
||||
|
||||
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
|
||||
janet_panicf("%s index %d out of range [%d,%d)", which, (int64_t)raw, -(int64_t)length, (int64_t)length);
|
||||
return not_raw;
|
||||
}
|
||||
|
||||
|
@ -366,24 +415,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
|||
janet_arity(argc, 1, 3);
|
||||
JanetRange range;
|
||||
int32_t length = janet_length(argv[0]);
|
||||
if (argc == 1) {
|
||||
range.start = 0;
|
||||
range.end = length;
|
||||
} else if (argc == 2) {
|
||||
range.start = janet_checktype(argv[1], JANET_NIL)
|
||||
? 0
|
||||
: janet_gethalfrange(argv, 1, length, "start");
|
||||
range.end = length;
|
||||
} else {
|
||||
range.start = janet_checktype(argv[1], JANET_NIL)
|
||||
? 0
|
||||
: janet_gethalfrange(argv, 1, length, "start");
|
||||
range.end = janet_checktype(argv[2], JANET_NIL)
|
||||
? length
|
||||
: janet_gethalfrange(argv, 2, length, "end");
|
||||
if (range.end < range.start)
|
||||
range.end = range.start;
|
||||
}
|
||||
range.start = janet_getstartrange(argv, argc, 1, length);
|
||||
range.end = janet_getendrange(argv, argc, 2, length);
|
||||
if (range.end < range.start)
|
||||
range.end = range.start;
|
||||
return range;
|
||||
}
|
||||
|
||||
|
@ -463,9 +498,41 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
|
|||
return janet_getabstract(argv, n, at);
|
||||
}
|
||||
|
||||
/* Atomic refcounts */
|
||||
|
||||
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
|
||||
#ifdef JANET_WINDOWS
|
||||
return InterlockedIncrement(x);
|
||||
#elif defined(JANET_USE_STDATOMIC)
|
||||
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
|
||||
#else
|
||||
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
|
||||
#endif
|
||||
}
|
||||
|
||||
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
|
||||
#ifdef JANET_WINDOWS
|
||||
return InterlockedDecrement(x);
|
||||
#elif defined(JANET_USE_STDATOMIC)
|
||||
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
|
||||
#else
|
||||
return __atomic_add_fetch(x, -1, __ATOMIC_ACQ_REL);
|
||||
#endif
|
||||
}
|
||||
|
||||
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
|
||||
#ifdef JANET_WINDOWS
|
||||
return InterlockedOr(x, 0);
|
||||
#elif defined(JANET_USE_STDATOMIC)
|
||||
return atomic_load_explicit(x, memory_order_acquire);
|
||||
#else
|
||||
return __atomic_load_n(x, __ATOMIC_ACQUIRE);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Some definitions for function-like macros */
|
||||
|
||||
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
||||
JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {
|
||||
return janet_struct_head(st);
|
||||
}
|
||||
|
||||
|
@ -473,10 +540,10 @@ JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
|
|||
return janet_abstract_head(abstract);
|
||||
}
|
||||
|
||||
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
|
||||
JANET_API JanetStringHead *(janet_string_head)(JanetString s) {
|
||||
return janet_string_head(s);
|
||||
}
|
||||
|
||||
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
|
||||
JANET_API JanetTupleHead *(janet_tuple_head)(JanetTuple tuple) {
|
||||
return janet_tuple_head(tuple);
|
||||
}
|
||||
|
|
|
@ -99,7 +99,7 @@ static JanetSlot opfunction(
|
|||
static int can_be_imm(Janet x, int8_t *out) {
|
||||
if (!janet_checkint(x)) return 0;
|
||||
int32_t integer = janet_unwrap_integer(x);
|
||||
if (integer > 127 || integer < -127) return 0;
|
||||
if (integer > INT8_MAX || integer < INT8_MIN) return 0;
|
||||
*out = (int8_t) integer;
|
||||
return 1;
|
||||
}
|
||||
|
@ -116,12 +116,11 @@ static JanetSlot opreduce(
|
|||
JanetSlot *args,
|
||||
int op,
|
||||
int opim,
|
||||
Janet nullary) {
|
||||
Janet nullary,
|
||||
Janet unary) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
int8_t imm = 0;
|
||||
int neg = opim < 0;
|
||||
if (opim < 0) opim = -opim;
|
||||
len = janet_v_count(args);
|
||||
JanetSlot t;
|
||||
if (len == 0) {
|
||||
|
@ -132,19 +131,19 @@ static JanetSlot opreduce(
|
|||
if (op == JOP_SUBTRACT) {
|
||||
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
t = janetc_gettarget(opts);
|
||||
if (opim && can_slot_be_imm(args[1], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
|
||||
janetc_emit_ssi(c, opim, t, args[0], imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
}
|
||||
for (i = 2; i < len; i++) {
|
||||
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
|
||||
janetc_emit_ssi(c, opim, t, t, imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||
}
|
||||
|
@ -155,7 +154,7 @@ static JanetSlot opreduce(
|
|||
/* Function optimizers */
|
||||
|
||||
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||
|
@ -172,7 +171,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
|||
return t;
|
||||
}
|
||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
if (janet_v_count(args) == 3) {
|
||||
|
@ -192,20 +191,14 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
|||
c->buffer[label] |= (current - label) << 16;
|
||||
return t;
|
||||
} else {
|
||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
}
|
||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
if (opts.flags & JANET_FOPTS_DROP) {
|
||||
|
@ -262,34 +255,43 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
|||
/* Variadic operators specialization */
|
||||
|
||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_SUBTRACT, JOP_SUBTRACT_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
|
||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1));
|
||||
}
|
||||
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
||||
return genericSS(opts, JOP_BNOT, args[0]);
|
||||
|
@ -383,10 +385,11 @@ static const JanetFunOptimizer optimizers[] = {
|
|||
{fixarity2, do_propagate},
|
||||
{arity2or3, do_get},
|
||||
{arity1or2, do_next},
|
||||
{fixarity2, do_modulo},
|
||||
{fixarity2, do_remainder},
|
||||
{NULL, do_modulo},
|
||||
{NULL, do_remainder},
|
||||
{fixarity2, do_cmp},
|
||||
{fixarity2, do_cancel},
|
||||
{NULL, do_divf}
|
||||
};
|
||||
|
||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||
|
|
|
@ -69,6 +69,7 @@ typedef enum {
|
|||
#define JANET_FUN_REMAINDER 30
|
||||
#define JANET_FUN_CMP 31
|
||||
#define JANET_FUN_CANCEL 32
|
||||
#define JANET_FUN_DIVIDE_FLOOR 33
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct JanetCompiler JanetCompiler;
|
||||
|
|
|
@ -69,15 +69,15 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
|
|||
host.minor < modconf.minor ||
|
||||
host.bits != modconf.bits) {
|
||||
char errbuf[128];
|
||||
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
|
||||
host.major,
|
||||
host.minor,
|
||||
host.patch,
|
||||
host.bits,
|
||||
modconf.major,
|
||||
modconf.minor,
|
||||
modconf.patch,
|
||||
modconf.bits);
|
||||
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
|
||||
host.major,
|
||||
host.minor,
|
||||
host.patch,
|
||||
host.bits,
|
||||
modconf.major,
|
||||
modconf.minor,
|
||||
modconf.patch,
|
||||
modconf.bits);
|
||||
*error = janet_cstring(errbuf);
|
||||
return NULL;
|
||||
}
|
||||
|
@ -110,14 +110,14 @@ JANET_CORE_FN(janet_core_expand_path,
|
|||
"(module/expand-path path template)",
|
||||
"Expands a path template as found in `module/paths` for `module/find`. "
|
||||
"This takes in a path (the argument to require) and a template string, "
|
||||
"to expand the path to a path that can be "
|
||||
"used for importing files. The replacements are as follows:\n\n"
|
||||
"to expand the path to a path that can be used for importing files. "
|
||||
"The replacements are as follows:\n\n"
|
||||
"* :all: -- the value of path verbatim.\n\n"
|
||||
"* :@all: -- Same as :all:, but if `path` starts with the @ character,\n"
|
||||
" the first path segment is replaced with a dynamic binding\n"
|
||||
" `(dyn <first path segment as keyword>)`.\n\n"
|
||||
"* :cur: -- the current file, or (dyn :current-file)\n\n"
|
||||
"* :dir: -- the directory containing the current file\n\n"
|
||||
"* :@all: -- Same as :all:, but if `path` starts with the @ character, "
|
||||
"the first path segment is replaced with a dynamic binding "
|
||||
"`(dyn <first path segment as keyword>)`.\n\n"
|
||||
"* :cur: -- the directory portion, if any, of (dyn :current-file)\n\n"
|
||||
"* :dir: -- the directory portion, if any, of the path argument\n\n"
|
||||
"* :name: -- the name component of path, with extension if given\n\n"
|
||||
"* :native: -- the extension used to load natives, .so or .dll\n\n"
|
||||
"* :sys: -- the system path, or (dyn :syspath)") {
|
||||
|
@ -426,6 +426,36 @@ JANET_CORE_FN(janet_core_slice,
|
|||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_range,
|
||||
"(range & args)",
|
||||
"Create an array of values [start, end) with a given step. "
|
||||
"With one argument, returns a range [0, end). With two arguments, returns "
|
||||
"a range [start, end). With three, returns a range with optional step size.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
int32_t 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);
|
||||
} else if (argc == 2) {
|
||||
start = janet_getinteger(argv, 0);
|
||||
stop = janet_getinteger(argv, 1);
|
||||
count = stop - start;
|
||||
} else {
|
||||
stop = janet_getinteger(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);
|
||||
}
|
||||
array->count = count;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_table,
|
||||
"(table & kvs)",
|
||||
"Creates a new table from a variadic number of keys and values. "
|
||||
|
@ -629,6 +659,34 @@ ret_false:
|
|||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_bytes,
|
||||
"(bytes? x)",
|
||||
"Check if x is a string, symbol, keyword, or buffer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_BYTES));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_indexed,
|
||||
"(indexed? x)",
|
||||
"Check if x is an array or tuple.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_INDEXED));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_dictionary,
|
||||
"(dictionary? x)",
|
||||
"Check if x is a table or struct.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_DICTIONARY));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_lengthable,
|
||||
"(lengthable? x)",
|
||||
"Check if x is a bytes, indexed, or dictionary.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_LENGTHABLE));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_signal,
|
||||
"(signal what x)",
|
||||
"Raise a signal with payload x. ") {
|
||||
|
@ -690,6 +748,7 @@ static const SandboxOption sandbox_options[] = {
|
|||
{"net-connect", JANET_SANDBOX_NET_CONNECT},
|
||||
{"net-listen", JANET_SANDBOX_NET_LISTEN},
|
||||
{"sandbox", JANET_SANDBOX_SANDBOX},
|
||||
{"signal", JANET_SANDBOX_SIGNAL},
|
||||
{"subprocess", JANET_SANDBOX_SUBPROCESS},
|
||||
{NULL, 0}
|
||||
};
|
||||
|
@ -714,6 +773,7 @@ JANET_CORE_FN(janet_core_sandbox,
|
|||
"* :net-connect - disallow making outbound network connections\n"
|
||||
"* :net-listen - disallow accepting inbound network connections\n"
|
||||
"* :sandbox - disallow calling this function\n"
|
||||
"* :signal - disallow adding or removing signal handlers\n"
|
||||
"* :subprocess - disallow running subprocesses") {
|
||||
uint32_t flags = 0;
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
|
@ -985,14 +1045,6 @@ static const uint32_t next_asm[] = {
|
|||
JOP_NEXT | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t modulo_asm[] = {
|
||||
JOP_MODULO | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t remainder_asm[] = {
|
||||
JOP_REMAINDER | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t cmp_asm[] = {
|
||||
JOP_COMPARE | (1 << 24),
|
||||
JOP_RETURN
|
||||
|
@ -1031,7 +1083,12 @@ static void janet_load_libs(JanetTable *env) {
|
|||
JANET_CORE_REG("module/expand-path", janet_core_expand_path),
|
||||
JANET_CORE_REG("int?", janet_core_check_int),
|
||||
JANET_CORE_REG("nat?", janet_core_check_nat),
|
||||
JANET_CORE_REG("bytes?", janet_core_is_bytes),
|
||||
JANET_CORE_REG("indexed?", janet_core_is_indexed),
|
||||
JANET_CORE_REG("dictionary?", janet_core_is_dictionary),
|
||||
JANET_CORE_REG("lengthable?", janet_core_is_lengthable),
|
||||
JANET_CORE_REG("slice", janet_core_slice),
|
||||
JANET_CORE_REG("range", janet_core_range),
|
||||
JANET_CORE_REG("signal", janet_core_signal),
|
||||
JANET_CORE_REG("memcmp", janet_core_memcmp),
|
||||
JANET_CORE_REG("getproto", janet_core_getproto),
|
||||
|
@ -1077,14 +1134,6 @@ static void janet_load_libs(JanetTable *env) {
|
|||
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||
janet_quick_asm(env, JANET_FUN_MODULO,
|
||||
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
|
||||
JDOC("(mod dividend divisor)\n\n"
|
||||
"Returns the modulo of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_REMAINDER,
|
||||
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_CMP,
|
||||
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
|
||||
JDOC("(cmp x y)\n\n"
|
||||
|
@ -1095,17 +1144,20 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
|||
JDOC("(next ds &opt key)\n\n"
|
||||
"Gets the next key in a data structure. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"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. 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"
|
||||
|
@ -1183,6 +1235,18 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
|||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
|
||||
JDOC("(div & xs)\n\n"
|
||||
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
|
||||
JDOC("(mod & xs)\n\n"
|
||||
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
|
||||
"`(mod x 0)` is defined to be `x`."));
|
||||
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
|
||||
JDOC("(% & xs)\n\n"
|
||||
"Returns the remainder of dividing the first value of xs by each remaining value."));
|
||||
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
||||
JDOC("(band & xs)\n\n"
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
|
|
|
@ -388,8 +388,8 @@ JANET_CORE_FN(cfun_debug_stack,
|
|||
JANET_CORE_FN(cfun_debug_stacktrace,
|
||||
"(debug/stacktrace fiber &opt err prefix)",
|
||||
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
|
||||
"an error value to print the stack trace with. If `err` is nil or not "
|
||||
"provided, and no prefix is given, will skip the error line. Returns the fiber.") {
|
||||
"an error value to print the stack trace with. If `prefix` is nil or not "
|
||||
"provided, will skip the error line. Returns the fiber.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
|
||||
|
|
|
@ -26,6 +26,7 @@
|
|||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
#include "regalloc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Get a register */
|
||||
|
@ -128,7 +129,8 @@ static void janetc_movenear(JanetCompiler *c,
|
|||
((uint32_t)(src.envindex) << 16) |
|
||||
((uint32_t)(dest) << 8) |
|
||||
JOP_LOAD_UPVALUE);
|
||||
} else if (src.index > 0xFF || src.index != dest) {
|
||||
} else if (src.index != dest) {
|
||||
janet_assert(src.index >= 0, "bad slot");
|
||||
janetc_emit(c,
|
||||
((uint32_t)(src.index) << 16) |
|
||||
((uint32_t)(dest) << 8) |
|
||||
|
@ -155,6 +157,7 @@ static void janetc_moveback(JanetCompiler *c,
|
|||
((uint32_t)(src) << 8) |
|
||||
JOP_SET_UPVALUE);
|
||||
} else if (dest.index != src) {
|
||||
janet_assert(dest.index >= 0, "bad slot");
|
||||
janetc_emit(c,
|
||||
((uint32_t)(dest.index) << 16) |
|
||||
((uint32_t)(src) << 8) |
|
||||
|
|
1162
src/core/ev.c
1162
src/core/ev.c
File diff suppressed because it is too large
Load Diff
|
@ -1381,7 +1381,7 @@ JANET_CORE_FN(cfun_ffi_buffer_write,
|
|||
"(ffi/write ffi-type data &opt buffer index)",
|
||||
"Append a native type to a buffer such as it would appear in memory. This can be used "
|
||||
"to pass pointers to structs in the ffi, or send C/C++/native structs over the network "
|
||||
"or to files. Returns a modifed buffer or a new buffer if one is not supplied.") {
|
||||
"or to files. Returns a modified buffer or a new buffer if one is not supplied.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetFFIType type = decode_ffi_type(argv[0]);
|
||||
|
@ -1530,9 +1530,25 @@ JANET_CORE_FN(cfun_ffi_pointer_buffer,
|
|||
return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_pointer_cfunction,
|
||||
"(ffi/pointer-cfunction pointer &opt name source-file source-line)",
|
||||
"Create a C Function from a raw pointer. Optionally give the cfunction a name and "
|
||||
"source location for stack traces and debugging.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_arity(argc, 1, 4);
|
||||
void *pointer = janet_getpointer(argv, 0);
|
||||
const char *name = janet_optcstring(argv, argc, 1, NULL);
|
||||
const char *source = janet_optcstring(argv, argc, 2, NULL);
|
||||
int32_t line = janet_optinteger(argv, argc, 3, -1);
|
||||
if ((name != NULL) || (source != NULL) || (line != -1)) {
|
||||
janet_registry_put((JanetCFunction) pointer, name, NULL, source, line);
|
||||
}
|
||||
return janet_wrap_cfunction((JanetCFunction) pointer);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
|
||||
"(ffi/calling-conventions)",
|
||||
"Get an array of all supported calling conventions on the current arhcitecture. Some architectures may have some FFI "
|
||||
"Get an array of all supported calling conventions on the current architecture. Some architectures may have some FFI "
|
||||
"functionality (ffi/malloc, ffi/free, ffi/read, ffi/write, etc.) but not support "
|
||||
"any calling conventions. This function can be used to get all supported calling conventions "
|
||||
"that can be used on this architecture. All architectures support the :none calling "
|
||||
|
@ -1567,6 +1583,7 @@ void janet_lib_ffi(JanetTable *env) {
|
|||
JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
|
||||
JANET_CORE_REG("ffi/free", cfun_ffi_free),
|
||||
JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
|
||||
JANET_CORE_REG("ffi/pointer-cfunction", cfun_ffi_pointer_cfunction),
|
||||
JANET_CORE_REG("ffi/calling-conventions", cfun_ffi_supported_calling_conventions),
|
||||
JANET_REG_END
|
||||
};
|
||||
|
|
|
@ -39,8 +39,10 @@ static void fiber_reset(JanetFiber *fiber) {
|
|||
fiber->env = NULL;
|
||||
fiber->last_value = janet_wrap_nil();
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
fiber->ev_callback = NULL;
|
||||
fiber->ev_state = NULL;
|
||||
fiber->ev_stream = NULL;
|
||||
fiber->supervisor_channel = NULL;
|
||||
#endif
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
|
@ -85,7 +87,6 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
|||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->supervisor_channel = NULL;
|
||||
#endif
|
||||
return fiber;
|
||||
|
@ -238,8 +239,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
|||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead)
|
||||
: janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead));
|
||||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead));
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -369,8 +370,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
|||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead)
|
||||
: janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead));
|
||||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead));
|
||||
}
|
||||
stacksize = tuplehead - fiber->stackstart + 1;
|
||||
} else {
|
||||
|
@ -661,7 +662,7 @@ JANET_CORE_FN(cfun_fiber_can_resume,
|
|||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_last_value,
|
||||
"(fiber/last-value)",
|
||||
"(fiber/last-value fiber)",
|
||||
"Get the last value returned or signaled from the fiber.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
|
|
|
@ -59,6 +59,9 @@
|
|||
#define JANET_FIBER_EV_FLAG_CANCELED 0x10000
|
||||
#define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
|
||||
#define JANET_FIBER_FLAG_ROOT 0x40000
|
||||
#define JANET_FIBER_EV_FLAG_IN_FLIGHT 0x1
|
||||
|
||||
/* used only on windows, should otherwise be unset */
|
||||
|
||||
#define janet_fiber_set_status(f, s) do {\
|
||||
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\
|
||||
|
|
171
src/core/gc.c
171
src/core/gc.c
|
@ -132,6 +132,24 @@ static void janet_mark_many(const Janet *values, int32_t n) {
|
|||
}
|
||||
}
|
||||
|
||||
/* Mark a bunch of key values items in memory */
|
||||
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
while (kvs < end) {
|
||||
janet_mark(kvs->key);
|
||||
kvs++;
|
||||
}
|
||||
}
|
||||
|
||||
/* Mark a bunch of key values items in memory */
|
||||
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
while (kvs < end) {
|
||||
janet_mark(kvs->value);
|
||||
kvs++;
|
||||
}
|
||||
}
|
||||
|
||||
/* Mark a bunch of key values items in memory */
|
||||
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
|
@ -146,7 +164,9 @@ static void janet_mark_array(JanetArray *array) {
|
|||
if (janet_gc_reachable(array))
|
||||
return;
|
||||
janet_gc_mark(array);
|
||||
janet_mark_many(array->data, array->count);
|
||||
if (janet_gc_type((JanetGCObject *) array) == JANET_MEMORY_ARRAY) {
|
||||
janet_mark_many(array->data, array->count);
|
||||
}
|
||||
}
|
||||
|
||||
static void janet_mark_table(JanetTable *table) {
|
||||
|
@ -154,7 +174,15 @@ recur: /* Manual tail recursion */
|
|||
if (janet_gc_reachable(table))
|
||||
return;
|
||||
janet_gc_mark(table);
|
||||
janet_mark_kvs(table->data, table->capacity);
|
||||
enum JanetMemoryType memtype = janet_gc_type(table);
|
||||
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
|
||||
janet_mark_values(table->data, table->capacity);
|
||||
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
|
||||
janet_mark_keys(table->data, table->capacity);
|
||||
} else if (memtype == JANET_MEMORY_TABLE) {
|
||||
janet_mark_kvs(table->data, table->capacity);
|
||||
}
|
||||
/* do nothing for JANET_MEMORY_TABLE_WEAKKV */
|
||||
if (table->proto) {
|
||||
table = table->proto;
|
||||
goto recur;
|
||||
|
@ -268,6 +296,12 @@ recur:
|
|||
if (fiber->supervisor_channel) {
|
||||
janet_mark_abstract(fiber->supervisor_channel);
|
||||
}
|
||||
if (fiber->ev_stream) {
|
||||
janet_mark_abstract(fiber->ev_stream);
|
||||
}
|
||||
if (fiber->ev_callback) {
|
||||
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_MARK);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Explicit tail recursion */
|
||||
|
@ -292,9 +326,17 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
|||
case JANET_MEMORY_TABLE:
|
||||
janet_free(((JanetTable *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_FIBER:
|
||||
janet_free(((JanetFiber *)mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_FIBER: {
|
||||
JanetFiber *f = (JanetFiber *)mem;
|
||||
#ifdef JANET_EV
|
||||
if (f->ev_state && !(f->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
|
||||
janet_ev_dec_refcount();
|
||||
janet_free(f->ev_state);
|
||||
}
|
||||
#endif
|
||||
janet_free(f->data);
|
||||
}
|
||||
break;
|
||||
case JANET_MEMORY_BUFFER:
|
||||
janet_buffer_deinit((JanetBuffer *) mem);
|
||||
break;
|
||||
|
@ -326,12 +368,98 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
|||
}
|
||||
}
|
||||
|
||||
/* Check that a value x has been visited in the mark phase */
|
||||
static int janet_check_liveref(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
return 1;
|
||||
case JANET_ARRAY:
|
||||
case JANET_TABLE:
|
||||
case JANET_FUNCTION:
|
||||
case JANET_BUFFER:
|
||||
case JANET_FIBER:
|
||||
return janet_gc_reachable(janet_unwrap_pointer(x));
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_gc_reachable(janet_string_head(janet_unwrap_string(x)));
|
||||
case JANET_ABSTRACT:
|
||||
return janet_gc_reachable(janet_abstract_head(janet_unwrap_abstract(x)));
|
||||
case JANET_TUPLE:
|
||||
return janet_gc_reachable(janet_tuple_head(janet_unwrap_tuple(x)));
|
||||
case JANET_STRUCT:
|
||||
return janet_gc_reachable(janet_struct_head(janet_unwrap_struct(x)));
|
||||
}
|
||||
}
|
||||
|
||||
/* Iterate over all allocated memory, and free memory that is not
|
||||
* marked as reachable. Flip the gc color flag for next sweep. */
|
||||
void janet_sweep() {
|
||||
JanetGCObject *previous = NULL;
|
||||
JanetGCObject *current = janet_vm.blocks;
|
||||
JanetGCObject *current = janet_vm.weak_blocks;
|
||||
JanetGCObject *next;
|
||||
|
||||
/* Sweep weak heap to drop weak refs */
|
||||
while (NULL != current) {
|
||||
next = current->data.next;
|
||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||
/* Check for dead references */
|
||||
enum JanetMemoryType type = janet_gc_type(current);
|
||||
if (type == JANET_MEMORY_ARRAY_WEAK) {
|
||||
JanetArray *array = (JanetArray *) current;
|
||||
for (uint32_t i = 0; i < (uint32_t) array->count; i++) {
|
||||
if (!janet_check_liveref(array->data[i])) {
|
||||
array->data[i] = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
} else {
|
||||
JanetTable *table = (JanetTable *) current;
|
||||
int check_values = (type == JANET_MEMORY_TABLE_WEAKV) || (type == JANET_MEMORY_TABLE_WEAKKV);
|
||||
int check_keys = (type == JANET_MEMORY_TABLE_WEAKK) || (type == JANET_MEMORY_TABLE_WEAKKV);
|
||||
JanetKV *end = table->data + table->capacity;
|
||||
JanetKV *kvs = table->data;
|
||||
while (kvs < end) {
|
||||
int drop = 0;
|
||||
if (check_keys && !janet_check_liveref(kvs->key)) drop = 1;
|
||||
if (check_values && !janet_check_liveref(kvs->value)) drop = 1;
|
||||
if (drop) {
|
||||
/* Inlined from janet_table_remove without search */
|
||||
table->count--;
|
||||
table->deleted++;
|
||||
kvs->key = janet_wrap_nil();
|
||||
kvs->value = janet_wrap_false();
|
||||
}
|
||||
kvs++;
|
||||
}
|
||||
}
|
||||
}
|
||||
current = next;
|
||||
}
|
||||
|
||||
/* Sweep weak heap to free blocks */
|
||||
previous = NULL;
|
||||
current = janet_vm.weak_blocks;
|
||||
while (NULL != current) {
|
||||
next = current->data.next;
|
||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||
previous = current;
|
||||
current->flags &= ~JANET_MEM_REACHABLE;
|
||||
} else {
|
||||
janet_vm.block_count--;
|
||||
janet_deinit_block(current);
|
||||
if (NULL != previous) {
|
||||
previous->data.next = next;
|
||||
} else {
|
||||
janet_vm.weak_blocks = next;
|
||||
}
|
||||
janet_free(current);
|
||||
}
|
||||
current = next;
|
||||
}
|
||||
|
||||
/* Sweep main heap to free blocks */
|
||||
previous = NULL;
|
||||
current = janet_vm.blocks;
|
||||
while (NULL != current) {
|
||||
next = current->data.next;
|
||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||
|
@ -349,6 +477,7 @@ void janet_sweep() {
|
|||
}
|
||||
current = next;
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
/* Sweep threaded abstract types for references to decrement */
|
||||
JanetKV *items = janet_vm.threaded_abstracts.data;
|
||||
|
@ -370,14 +499,15 @@ void janet_sweep() {
|
|||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
/* Mark as tombstone in place */
|
||||
items[i].key = janet_wrap_nil();
|
||||
items[i].value = janet_wrap_false();
|
||||
janet_vm.threaded_abstracts.deleted++;
|
||||
janet_vm.threaded_abstracts.count--;
|
||||
/* Free memory */
|
||||
janet_free(janet_abstract_head(abst));
|
||||
}
|
||||
|
||||
/* Mark as tombstone in place */
|
||||
items[i].key = janet_wrap_nil();
|
||||
items[i].value = janet_wrap_false();
|
||||
janet_vm.threaded_abstracts.deleted++;
|
||||
janet_vm.threaded_abstracts.count--;
|
||||
}
|
||||
|
||||
/* Reset for next sweep */
|
||||
|
@ -405,8 +535,15 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
|||
|
||||
/* Prepend block to heap list */
|
||||
janet_vm.next_collection += size;
|
||||
mem->data.next = janet_vm.blocks;
|
||||
janet_vm.blocks = mem;
|
||||
if (type < JANET_MEMORY_TABLE_WEAKK) {
|
||||
/* normal heap */
|
||||
mem->data.next = janet_vm.blocks;
|
||||
janet_vm.blocks = mem;
|
||||
} else {
|
||||
/* weak heap */
|
||||
mem->data.next = janet_vm.weak_blocks;
|
||||
janet_vm.weak_blocks = mem;
|
||||
}
|
||||
janet_vm.block_count++;
|
||||
|
||||
return (void *)mem;
|
||||
|
@ -437,7 +574,8 @@ void janet_collect(void) {
|
|||
uint32_t i;
|
||||
if (janet_vm.gc_suspend) return;
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
/* Try and prevent many major collections back to back.
|
||||
janet_vm.gc_mark_phase = 1;
|
||||
/* Try to prevent many major collections back to back.
|
||||
* A full collection will take O(janet_vm.block_count) time.
|
||||
* If we have a large heap, make sure our interval is not too
|
||||
* small so we won't make many collections over it. This is just a
|
||||
|
@ -456,6 +594,7 @@ void janet_collect(void) {
|
|||
Janet x = janet_vm.roots[--janet_vm.root_count];
|
||||
janet_mark(x);
|
||||
}
|
||||
janet_vm.gc_mark_phase = 0;
|
||||
janet_sweep();
|
||||
janet_vm.next_collection = 0;
|
||||
janet_free_all_scratch();
|
||||
|
@ -559,7 +698,9 @@ void janet_gcunlock(int handle) {
|
|||
janet_vm.gc_suspend = handle;
|
||||
}
|
||||
|
||||
/* Scratch memory API */
|
||||
/* Scratch memory API
|
||||
* Scratch memory allocations do not need to be free (but optionally can be), and will be automatically cleaned
|
||||
* up in the next call to janet_collect. */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);
|
||||
|
|
|
@ -57,6 +57,10 @@ enum JanetMemoryType {
|
|||
JANET_MEMORY_FUNCENV,
|
||||
JANET_MEMORY_FUNCDEF,
|
||||
JANET_MEMORY_THREADED_ABSTRACT,
|
||||
JANET_MEMORY_TABLE_WEAKK,
|
||||
JANET_MEMORY_TABLE_WEAKV,
|
||||
JANET_MEMORY_TABLE_WEAKKV,
|
||||
JANET_MEMORY_ARRAY_WEAK
|
||||
};
|
||||
|
||||
/* To allocate collectable memory, one must call janet_alloc, initialize the memory,
|
||||
|
|
|
@ -73,13 +73,13 @@ static void *int64_unmarshal(JanetMarshalContext *ctx) {
|
|||
|
||||
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
|
||||
char str[32];
|
||||
sprintf(str, "%" PRId64, *((int64_t *)p));
|
||||
snprintf(str, sizeof(str), "%" PRId64, *((int64_t *)p));
|
||||
janet_buffer_push_cstring(buffer, str);
|
||||
}
|
||||
|
||||
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
||||
char str[32];
|
||||
sprintf(str, "%" PRIu64, *((uint64_t *)p));
|
||||
snprintf(str, sizeof(str), "%" PRIu64, *((uint64_t *)p));
|
||||
janet_buffer_push_cstring(buffer, str);
|
||||
}
|
||||
|
||||
|
@ -118,10 +118,9 @@ int64_t janet_unwrap_s64(Janet x) {
|
|||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||
return (int64_t)dbl;
|
||||
break;
|
||||
double d = janet_unwrap_number(x);
|
||||
if (!janet_checkint64range(d)) break;
|
||||
return (int64_t) d;
|
||||
}
|
||||
case JANET_STRING: {
|
||||
int64_t value;
|
||||
|
@ -147,12 +146,9 @@ uint64_t janet_unwrap_u64(Janet x) {
|
|||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
/* Allow negative values to be cast to "wrap around".
|
||||
* This let's addition and subtraction work as expected. */
|
||||
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||
return (uint64_t)dbl;
|
||||
break;
|
||||
double d = janet_unwrap_number(x);
|
||||
if (!janet_checkuint64range(d)) break;
|
||||
return (uint64_t) d;
|
||||
}
|
||||
case JANET_STRING: {
|
||||
uint64_t value;
|
||||
|
@ -243,7 +239,7 @@ JANET_CORE_FN(cfun_to_bytes,
|
|||
"Write the bytes of an `int/s64` or `int/u64` into a buffer.\n"
|
||||
"The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created.\n"
|
||||
"Returns the modified buffer.\n"
|
||||
"The `endianness` paramater indicates the byte order:\n"
|
||||
"The `endianness` parameter indicates the byte order:\n"
|
||||
"- `nil` (unset): system byte order\n"
|
||||
"- `:le`: little-endian, least significant byte first\n"
|
||||
"- `:be`: big-endian, most significant byte first\n") {
|
||||
|
@ -307,8 +303,8 @@ static int compare_double_double(double x, double y) {
|
|||
|
||||
static int compare_int64_double(int64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
return 0;
|
||||
} else if ((y > JANET_INTMIN_DOUBLE) && (y < JANET_INTMAX_DOUBLE)) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) INT64_MAX)) {
|
||||
|
@ -323,10 +319,10 @@ static int compare_int64_double(int64_t x, double y) {
|
|||
|
||||
static int compare_uint64_double(uint64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
return 0;
|
||||
} else if (y < 0) {
|
||||
return 1;
|
||||
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
} else if ((y >= 0) && (y < JANET_INTMAX_DOUBLE)) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) UINT64_MAX)) {
|
||||
|
@ -339,8 +335,9 @@ static int compare_uint64_double(uint64_t x, double y) {
|
|||
|
||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64)
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64) {
|
||||
janet_panic("compare method requires int/s64 as first argument");
|
||||
}
|
||||
int64_t x = janet_unwrap_s64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
|
@ -355,7 +352,6 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
|||
int64_t y = *(int64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
// comparing signed to unsigned -- be careful!
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
if (x < 0) {
|
||||
return janet_wrap_number(-1);
|
||||
|
@ -374,8 +370,9 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
|||
|
||||
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) {
|
||||
janet_panic("compare method requires int/u64 as first argument");
|
||||
}
|
||||
uint64_t x = janet_unwrap_u64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
|
@ -390,7 +387,6 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
|||
uint64_t y = *(uint64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
// comparing unsigned to signed -- be careful!
|
||||
int64_t y = *(int64_t *)abst;
|
||||
if (y < 0) {
|
||||
return janet_wrap_number(1);
|
||||
|
@ -431,7 +427,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||
} \
|
||||
|
||||
#define OPMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
|
@ -440,6 +436,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define UNARYMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = oper(janet_unwrap_##type(argv[0])); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define DIVZERO(name) DIVZERO_##name
|
||||
#define DIVZERO_div janet_panic("division by zero")
|
||||
#define DIVZERO_rem janet_panic("division by zero")
|
||||
#define DIVZERO_mod return janet_wrap_abstract(box)
|
||||
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
|
@ -447,19 +456,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
@ -471,7 +480,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
|
@ -479,26 +488,50 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||
} \
|
||||
|
||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
if (op2 == 0) janet_panic("division by zero");
|
||||
int64_t x = op1 / op2;
|
||||
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op1 = janet_unwrap_s64(argv[1]);
|
||||
if (op2 == 0) janet_panic("division by zero");
|
||||
int64_t x = op1 / op2;
|
||||
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
*box = (op1 > 0)
|
||||
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||
if (op2 == 0) {
|
||||
*box = op1;
|
||||
} else {
|
||||
int64_t x = op1 % op2;
|
||||
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
|
@ -507,37 +540,43 @@ static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
|||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op1 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
*box = (op1 > 0)
|
||||
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||
if (op2 == 0) {
|
||||
*box = op1;
|
||||
} else {
|
||||
int64_t x = op1 % op2;
|
||||
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
OPMETHOD(int64_t, s64, add, +)
|
||||
OPMETHOD(int64_t, s64, sub, -)
|
||||
OPMETHODINVERT(int64_t, s64, subi, -)
|
||||
OPMETHODINVERT(int64_t, s64, sub, -)
|
||||
OPMETHOD(int64_t, s64, mul, *)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
UNARYMETHOD(int64_t, s64, not, ~)
|
||||
OPMETHOD(int64_t, s64, lshift, <<)
|
||||
OPMETHOD(int64_t, s64, rshift, >>)
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
OPMETHODINVERT(uint64_t, u64, sub, -)
|
||||
OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, rem, %)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, modi, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, div, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, rem, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, mod, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
UNARYMETHOD(uint64_t, u64, not, ~)
|
||||
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
|
||||
|
@ -555,6 +594,8 @@ static JanetMethod it_s64_methods[] = {
|
|||
{"r*", cfun_it_s64_mul},
|
||||
{"/", cfun_it_s64_div},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"div", cfun_it_s64_divf},
|
||||
{"rdiv", cfun_it_s64_divfi},
|
||||
{"mod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"%", cfun_it_s64_rem},
|
||||
|
@ -565,6 +606,7 @@ static JanetMethod it_s64_methods[] = {
|
|||
{"r|", cfun_it_s64_or},
|
||||
{"^", cfun_it_s64_xor},
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"~", cfun_it_s64_not},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
{"compare", cfun_it_s64_compare},
|
||||
|
@ -580,16 +622,19 @@ static JanetMethod it_u64_methods[] = {
|
|||
{"r*", cfun_it_u64_mul},
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"div", cfun_it_u64_div},
|
||||
{"rdiv", cfun_it_u64_divi},
|
||||
{"mod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_rem},
|
||||
{"r%", cfun_it_u64_remi},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
{"r|", cfun_it_u64_or},
|
||||
{"^", cfun_it_u64_xor},
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"~", cfun_it_u64_not},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
{"compare", cfun_it_u64_compare},
|
||||
|
|
|
@ -131,7 +131,7 @@ JANET_CORE_FN(cfun_io_temp,
|
|||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_fopen,
|
||||
"(file/open path &opt mode)",
|
||||
"(file/open path &opt mode buffer-size)",
|
||||
"Open a file. `path` is an absolute or relative path, and "
|
||||
"`mode` is a set of flags indicating the mode to open the file in. "
|
||||
"`mode` is a keyword where each character represents a flag. If the file "
|
||||
|
@ -143,8 +143,9 @@ JANET_CORE_FN(cfun_io_fopen,
|
|||
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
|
||||
"* b - open the file in binary mode (rather than text mode)\n\n"
|
||||
"* + - append to the file instead of overwriting it\n\n"
|
||||
"* n - error if the file cannot be opened instead of returning nil") {
|
||||
janet_arity(argc, 1, 2);
|
||||
"* n - error if the file cannot be opened instead of returning nil\n\n"
|
||||
"See fopen (<stdio.h>, C99) for further details.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int32_t flags;
|
||||
|
@ -157,6 +158,15 @@ JANET_CORE_FN(cfun_io_fopen,
|
|||
flags = JANET_FILE_READ;
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
if (f != NULL) {
|
||||
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
|
||||
if (bufsize != BUFSIZ) {
|
||||
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
|
||||
if (result) {
|
||||
janet_panic("failed to set buffer size for file");
|
||||
}
|
||||
}
|
||||
}
|
||||
return f ? janet_makefile(f, flags)
|
||||
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
|
||||
: janet_wrap_nil();
|
||||
|
|
135
src/core/marsh.c
135
src/core/marsh.c
|
@ -154,7 +154,7 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
|
|||
janet_buffer_push_bytes(st->buf, bytes, len);
|
||||
}
|
||||
|
||||
static void pushpointer(MarshalState *st, void *ptr) {
|
||||
static void pushpointer(MarshalState *st, const void *ptr) {
|
||||
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
|
||||
}
|
||||
|
||||
|
@ -185,6 +185,19 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags);
|
|||
/* Prevent stack overflows */
|
||||
#define MARSH_STACKCHECK if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) janet_panic("stack overflow")
|
||||
|
||||
/* Quick check if a fiber cannot be marshalled. This is will
|
||||
* have no false positives, but may have false negatives. */
|
||||
static int fiber_cannot_be_marshalled(JanetFiber *fiber) {
|
||||
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE) return 1;
|
||||
int32_t i = fiber->frame;
|
||||
while (i > 0) {
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
if (!frame->func) return 1; /* has cfunction on stack */
|
||||
i = frame->prevframe;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Marshal a function env */
|
||||
static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
MARSH_STACKCHECK;
|
||||
|
@ -197,7 +210,9 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
|||
}
|
||||
janet_env_valid(env);
|
||||
janet_v_push(st->seen_envs, env);
|
||||
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
|
||||
|
||||
/* Special case for early detachment */
|
||||
if (env->offset > 0 && fiber_cannot_be_marshalled(env->as.fiber)) {
|
||||
pushint(st, 0);
|
||||
pushint(st, env->length);
|
||||
Janet *values = env->as.fiber->data + env->offset;
|
||||
|
@ -246,6 +261,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
|||
}
|
||||
/* Add to lookup */
|
||||
janet_v_push(st->seen_defs, def);
|
||||
|
||||
pushint(st, def->flags);
|
||||
pushint(st, def->slotcount);
|
||||
pushint(st, def->arity);
|
||||
|
@ -266,14 +282,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
|||
|
||||
/* marshal constants */
|
||||
for (int32_t i = 0; i < def->constants_length; i++)
|
||||
marshal_one(st, def->constants[i], flags);
|
||||
marshal_one(st, def->constants[i], flags + 1);
|
||||
|
||||
/* Marshal symbol map, if needed */
|
||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
||||
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].death_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].slot_index);
|
||||
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
|
||||
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags + 1);
|
||||
}
|
||||
|
||||
/* marshal the bytecode */
|
||||
|
@ -327,7 +343,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
|||
while (i > 0) {
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
if (frame->env) frame->flags |= JANET_STACKFRAME_HASENV;
|
||||
if (!frame->func) janet_panic("cannot marshal fiber with c stackframe");
|
||||
if (!frame->func) janet_panicf("cannot marshal fiber with c stackframe (%v)", janet_wrap_cfunction((JanetCFunction) frame->pc));
|
||||
pushint(st, frame->flags);
|
||||
pushint(st, frame->prevframe);
|
||||
int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode);
|
||||
|
@ -362,6 +378,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
|
|||
pushint(st, value);
|
||||
}
|
||||
|
||||
/* Only use in unsafe - don't marshal pointers otherwise */
|
||||
void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
|
||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panic("can only marshal pointers in unsafe mode");
|
||||
}
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushpointer(st, ptr);
|
||||
}
|
||||
|
||||
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushbyte(st, value);
|
||||
|
@ -378,18 +403,27 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
|
|||
marshal_one(st, x, ctx->flags + 1);
|
||||
}
|
||||
|
||||
#ifdef JANET_MARSHAL_DEBUG
|
||||
#define MARK_SEEN() \
|
||||
do { if (st->maybe_cycles) { \
|
||||
Janet _check = janet_table_get(&st->seen, x); \
|
||||
if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \
|
||||
janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \
|
||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
|
||||
} } while (0)
|
||||
#else
|
||||
#define MARK_SEEN() \
|
||||
do { if (st->maybe_cycles) { \
|
||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
|
||||
} } while (0)
|
||||
#endif
|
||||
|
||||
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
if (st->maybe_cycles) {
|
||||
janet_table_put(&st->seen,
|
||||
janet_wrap_abstract(abstract),
|
||||
janet_wrap_integer(st->nextid++));
|
||||
}
|
||||
Janet x = janet_wrap_abstract(abstract);
|
||||
MARK_SEEN();
|
||||
}
|
||||
|
||||
#define MARK_SEEN() \
|
||||
do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
|
||||
|
||||
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
#ifdef JANET_EV
|
||||
|
@ -411,7 +445,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
|||
if (at->marshal) {
|
||||
pushbyte(st, LB_ABSTRACT);
|
||||
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
||||
JanetMarshalContext context = {st, NULL, flags, NULL, at};
|
||||
JanetMarshalContext context = {st, NULL, flags + 1, NULL, at};
|
||||
at->marshal(abstract, &context);
|
||||
} else {
|
||||
janet_panicf("cannot marshal %p", x);
|
||||
|
@ -728,9 +762,22 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
|
|||
return ret;
|
||||
}
|
||||
|
||||
#ifdef JANET_MARSHAL_DEBUG
|
||||
static void dump_reference_table(UnmarshalState *st) {
|
||||
for (int32_t i = 0; i < janet_v_count(st->lookup); i++) {
|
||||
janet_eprintf(" reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Assert a janet type */
|
||||
static void janet_asserttype(Janet x, JanetType t) {
|
||||
static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) {
|
||||
if (!janet_checktype(x, t)) {
|
||||
#ifdef JANET_MARSHAL_DEBUG
|
||||
dump_reference_table(st);
|
||||
#else
|
||||
(void) st;
|
||||
#endif
|
||||
janet_panicf("expected type %T, got %v", 1 << t, x);
|
||||
}
|
||||
}
|
||||
|
@ -782,7 +829,7 @@ static const uint8_t *unmarshal_one_env(
|
|||
Janet fiberv;
|
||||
/* On stack variant */
|
||||
data = unmarshal_one(st, data, &fiberv, flags);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
janet_asserttype(fiberv, JANET_FIBER, st);
|
||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||
/* Negative offset indicates untrusted input */
|
||||
env->offset = -offset;
|
||||
|
@ -880,13 +927,13 @@ static const uint8_t *unmarshal_one_def(
|
|||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||
Janet x;
|
||||
data = unmarshal_one(st, data, &x, flags + 1);
|
||||
janet_asserttype(x, JANET_STRING);
|
||||
janet_asserttype(x, JANET_STRING, st);
|
||||
def->name = janet_unwrap_string(x);
|
||||
}
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
|
||||
Janet x;
|
||||
data = unmarshal_one(st, data, &x, flags + 1);
|
||||
janet_asserttype(x, JANET_STRING);
|
||||
janet_asserttype(x, JANET_STRING, st);
|
||||
def->source = janet_unwrap_string(x);
|
||||
}
|
||||
|
||||
|
@ -916,8 +963,9 @@ static const uint8_t *unmarshal_one_def(
|
|||
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
|
||||
Janet value;
|
||||
data = unmarshal_one(st, data, &value, flags + 1);
|
||||
if (!janet_checktype(value, JANET_SYMBOL))
|
||||
janet_panic("expected symbol in symbol map");
|
||||
if (!janet_checktype(value, JANET_SYMBOL)) {
|
||||
janet_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value);
|
||||
}
|
||||
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
|
||||
}
|
||||
def->symbolmap_length = (uint32_t) symbolmap_length;
|
||||
|
@ -1015,9 +1063,11 @@ static const uint8_t *unmarshal_one_fiber(
|
|||
fiber->env = NULL;
|
||||
fiber->last_value = janet_wrap_nil();
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
fiber->supervisor_channel = NULL;
|
||||
fiber->ev_state = NULL;
|
||||
fiber->ev_callback = NULL;
|
||||
fiber->ev_stream = NULL;
|
||||
#endif
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
|
@ -1066,7 +1116,7 @@ static const uint8_t *unmarshal_one_fiber(
|
|||
/* Get function */
|
||||
Janet funcv;
|
||||
data = unmarshal_one(st, data, &funcv, flags + 1);
|
||||
janet_asserttype(funcv, JANET_FUNCTION);
|
||||
janet_asserttype(funcv, JANET_FUNCTION, st);
|
||||
func = janet_unwrap_function(funcv);
|
||||
def = func->def;
|
||||
|
||||
|
@ -1112,7 +1162,7 @@ static const uint8_t *unmarshal_one_fiber(
|
|||
Janet envv;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
janet_asserttype(envv, JANET_TABLE, st);
|
||||
fiber_env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
|
@ -1121,7 +1171,7 @@ static const uint8_t *unmarshal_one_fiber(
|
|||
Janet fiberv;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
data = unmarshal_one(st, data, &fiberv, flags + 1);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
janet_asserttype(fiberv, JANET_FIBER, st);
|
||||
fiber->child = janet_unwrap_fiber(fiberv);
|
||||
}
|
||||
|
||||
|
@ -1165,6 +1215,18 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
|
|||
return read64(st, &(ctx->data));
|
||||
}
|
||||
|
||||
void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
|
||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panic("can only unmarshal pointers in unsafe mode");
|
||||
}
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
void *ptr;
|
||||
MARSH_EOS(st, ctx->data + sizeof(void *) - 1);
|
||||
memcpy((char *) &ptr, ctx->data, sizeof(void *));
|
||||
ctx->data += sizeof(void *);
|
||||
return ptr;
|
||||
}
|
||||
|
||||
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
MARSH_EOS(st, ctx->data);
|
||||
|
@ -1200,6 +1262,18 @@ void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
|
|||
return p;
|
||||
}
|
||||
|
||||
void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
|
||||
#ifdef JANET_THREADS
|
||||
void *p = janet_abstract_threaded(ctx->at, size);
|
||||
janet_unmarshal_abstract_reuse(ctx, p);
|
||||
return p;
|
||||
#else
|
||||
(void) ctx;
|
||||
(void) size;
|
||||
janet_panic("threaded abstracts not supported");
|
||||
#endif
|
||||
}
|
||||
|
||||
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
|
||||
Janet key;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
|
@ -1207,7 +1281,9 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
|||
if (at == NULL) janet_panic("unknown abstract type");
|
||||
if (at->unmarshal) {
|
||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||
void *abst = at->unmarshal(&context);
|
||||
janet_assert(abst != NULL, "null pointer abstract");
|
||||
*out = janet_wrap_abstract(abst);
|
||||
if (context.at != NULL) {
|
||||
janet_panic("janet_unmarshal_abstract not called");
|
||||
}
|
||||
|
@ -1308,7 +1384,7 @@ static const uint8_t *unmarshal_one(
|
|||
}
|
||||
case LB_FIBER: {
|
||||
JanetFiber *fiber;
|
||||
data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
|
||||
data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1);
|
||||
*out = janet_wrap_fiber(fiber);
|
||||
return data;
|
||||
}
|
||||
|
@ -1323,6 +1399,9 @@ static const uint8_t *unmarshal_one(
|
|||
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
|
||||
len * sizeof(JanetFuncEnv));
|
||||
func->def = NULL;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
func->envs[i] = NULL;
|
||||
}
|
||||
*out = janet_wrap_function(func);
|
||||
janet_v_push(st->lookup, *out);
|
||||
data = unmarshal_one_def(st, data, &def, flags + 1);
|
||||
|
@ -1376,7 +1455,7 @@ static const uint8_t *unmarshal_one(
|
|||
if (lead == LB_STRUCT_PROTO) {
|
||||
Janet proto;
|
||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||
janet_asserttype(proto, JANET_STRUCT);
|
||||
janet_asserttype(proto, JANET_STRUCT, st);
|
||||
janet_struct_proto(struct_) = janet_unwrap_struct(proto);
|
||||
}
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
|
@ -1399,7 +1478,7 @@ static const uint8_t *unmarshal_one(
|
|||
if (lead == LB_TABLE_PROTO) {
|
||||
Janet proto;
|
||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||
janet_asserttype(proto, JANET_TABLE);
|
||||
janet_asserttype(proto, JANET_TABLE, st);
|
||||
t->proto = janet_unwrap_table(proto);
|
||||
}
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
|
|
|
@ -119,7 +119,7 @@ double janet_rng_double(JanetRNG *rng) {
|
|||
|
||||
JANET_CORE_FN(cfun_rng_make,
|
||||
"(math/rng &opt seed)",
|
||||
"Creates a Psuedo-Random number generator, with an optional seed. "
|
||||
"Creates a Pseudo-Random number generator, with an optional seed. "
|
||||
"The seed should be an unsigned 32 bit integer or a buffer. "
|
||||
"Do not use this for cryptography. Returns a core/rng abstract type."
|
||||
) {
|
||||
|
@ -411,11 +411,11 @@ void janet_lib_math(JanetTable *env) {
|
|||
JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN),
|
||||
"The minimum contiguous integer representable by a 32 bit signed integer");
|
||||
JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
|
||||
"The maximum contiguous integer represtenable by a 32 bit signed integer");
|
||||
"The maximum contiguous integer representable by a 32 bit signed integer");
|
||||
JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
|
||||
"The minimum contiguous integer representable by a double (2^53)");
|
||||
JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
|
||||
"The maximum contiguous integer represtenable by a double (-(2^53))");
|
||||
"The maximum contiguous integer representable by a double (-(2^53))");
|
||||
#ifdef NAN
|
||||
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
|
||||
#else
|
||||
|
|
170
src/core/net.c
170
src/core/net.c
|
@ -24,6 +24,7 @@
|
|||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NET
|
||||
|
@ -78,12 +79,20 @@ const JanetAbstractType janet_address_type = {
|
|||
|
||||
/* maximum number of bytes in a socket address host (post name resolution) */
|
||||
#ifdef JANET_WINDOWS
|
||||
#ifdef JANET_NO_IPV6
|
||||
#define SA_ADDRSTRLEN (INET_ADDRSTRLEN + 1)
|
||||
#else
|
||||
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
|
||||
#endif
|
||||
typedef unsigned short in_port_t;
|
||||
#else
|
||||
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
|
||||
#ifdef JANET_NO_IPV6
|
||||
#define SA_ADDRSTRLEN JANET_SA_MAX(INET_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
|
||||
#else
|
||||
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
|
||||
#endif
|
||||
#endif
|
||||
|
||||
static JanetStream *make_stream(JSock handle, uint32_t flags);
|
||||
|
||||
|
@ -111,12 +120,57 @@ static void janet_net_socknoblock(JSock s) {
|
|||
#endif
|
||||
}
|
||||
|
||||
/* State machine for async connect */
|
||||
|
||||
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
JanetStream *stream = fiber->ev_stream;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
#ifndef JANET_WINDOWS
|
||||
/* Wait until we have an actual event before checking.
|
||||
* Windows doesn't support async connect with this, just try immediately.*/
|
||||
case JANET_ASYNC_EVENT_INIT:
|
||||
#endif
|
||||
case JANET_ASYNC_EVENT_DEINIT:
|
||||
return;
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_cancel(fiber, janet_cstringv("stream closed"));
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
int res = 0;
|
||||
int size = sizeof(res);
|
||||
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
|
||||
#else
|
||||
int res = 0;
|
||||
socklen_t size = sizeof res;
|
||||
int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
|
||||
#endif
|
||||
if (r == 0) {
|
||||
if (res == 0) {
|
||||
janet_schedule(fiber, janet_wrap_abstract(stream));
|
||||
} else {
|
||||
janet_cancel(fiber, janet_cstringv(strerror(res)));
|
||||
stream->flags |= JANET_STREAM_TOCLOSE;
|
||||
}
|
||||
} else {
|
||||
janet_cancel(fiber, janet_ev_lasterr());
|
||||
stream->flags |= JANET_STREAM_TOCLOSE;
|
||||
}
|
||||
janet_async_end(fiber);
|
||||
}
|
||||
|
||||
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
|
||||
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL);
|
||||
}
|
||||
|
||||
/* State machine for accepting connections. */
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
WSAOVERLAPPED overlapped;
|
||||
JanetFunction *function;
|
||||
JanetStream *lstream;
|
||||
|
@ -124,10 +178,10 @@ typedef struct {
|
|||
char buf[1024];
|
||||
} NetStateAccept;
|
||||
|
||||
static int net_sched_accept_impl(NetStateAccept *state, Janet *err);
|
||||
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err);
|
||||
|
||||
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
|
@ -138,55 +192,60 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
|||
break;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
if (state->astream->flags & JANET_STREAM_CLOSED) {
|
||||
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
SOCKET lsock = (SOCKET) state->lstream->handle;
|
||||
if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
|
||||
(char *) &lsock, sizeof(lsock))) {
|
||||
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
|
||||
Janet streamv = janet_wrap_abstract(state->astream);
|
||||
if (state->function) {
|
||||
/* Schedule worker */
|
||||
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
fiber->supervisor_channel = s->fiber->supervisor_channel;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
sub_fiber->supervisor_channel = fiber->supervisor_channel;
|
||||
janet_schedule(sub_fiber, janet_wrap_nil());
|
||||
/* Now listen again for next connection */
|
||||
Janet err;
|
||||
if (net_sched_accept_impl(state, &err)) {
|
||||
janet_cancel(s->fiber, err);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
if (net_sched_accept_impl(state, fiber, &err)) {
|
||||
janet_cancel(fiber, err);
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
} else {
|
||||
janet_schedule(s->fiber, streamv);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_schedule(fiber, streamv);
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||
Janet err;
|
||||
JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
|
||||
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
|
||||
memset(&state->buf, 0, 1024);
|
||||
state->function = fun;
|
||||
state->lstream = stream;
|
||||
s->tag = &state->overlapped;
|
||||
if (net_sched_accept_impl(state, &err)) janet_panicv(err);
|
||||
janet_await();
|
||||
if (net_sched_accept_impl(state, janet_root_fiber(), &err)) {
|
||||
janet_free(state);
|
||||
janet_panicv(err);
|
||||
}
|
||||
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
|
||||
}
|
||||
|
||||
static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
|
||||
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err) {
|
||||
SOCKET lsock = (SOCKET) state->lstream->handle;
|
||||
SOCKET asock = WSASocketW(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED);
|
||||
if (asock == INVALID_SOCKET) {
|
||||
|
@ -198,7 +257,11 @@ static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
|
|||
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
|
||||
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
|
||||
int code = WSAGetLastError();
|
||||
if (code == WSA_IO_PENDING) return 0; /* indicates io is happening async */
|
||||
if (code == WSA_IO_PENDING) {
|
||||
/* indicates io is happening async */
|
||||
janet_async_in_flight(fiber);
|
||||
return 0;
|
||||
}
|
||||
*err = janet_ev_lasterr();
|
||||
return 1;
|
||||
}
|
||||
|
@ -208,12 +271,12 @@ static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
|
|||
#else
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
JanetFunction *function;
|
||||
} NetStateAccept;
|
||||
|
||||
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
JanetStream *stream = fiber->ev_stream;
|
||||
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
|
@ -222,38 +285,42 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
|||
break;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
case JANET_ASYNC_EVENT_INIT:
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
#if defined(JANET_LINUX)
|
||||
JSock connfd = accept4(s->stream->handle, NULL, NULL, SOCK_CLOEXEC);
|
||||
JSock connfd = accept4(stream->handle, NULL, NULL, SOCK_CLOEXEC);
|
||||
#else
|
||||
/* On BSDs, CLOEXEC should be inherited from server socket */
|
||||
JSock connfd = accept(s->stream->handle, NULL, NULL);
|
||||
JSock connfd = accept(stream->handle, NULL, NULL);
|
||||
#endif
|
||||
if (JSOCKVALID(connfd)) {
|
||||
janet_net_socknoblock(connfd);
|
||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
Janet streamv = janet_wrap_abstract(stream);
|
||||
if (state->function) {
|
||||
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
fiber->supervisor_channel = s->fiber->supervisor_channel;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
sub_fiber->supervisor_channel = fiber->supervisor_channel;
|
||||
janet_schedule(sub_fiber, janet_wrap_nil());
|
||||
} else {
|
||||
janet_schedule(s->fiber, streamv);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_schedule(fiber, streamv);
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||
NetStateAccept *state = (NetStateAccept *) janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
|
||||
memset(state, 0, sizeof(NetStateAccept));
|
||||
state->function = fun;
|
||||
janet_await();
|
||||
if (fun) janet_stream_level_triggered(stream);
|
||||
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
@ -496,7 +563,7 @@ JANET_CORE_FN(cfun_net_connect,
|
|||
}
|
||||
#endif
|
||||
|
||||
if (status != 0) {
|
||||
if (status) {
|
||||
#ifdef JANET_WINDOWS
|
||||
if (err != WSAEWOULDBLOCK) {
|
||||
#else
|
||||
|
@ -508,10 +575,7 @@ JANET_CORE_FN(cfun_net_connect,
|
|||
}
|
||||
}
|
||||
|
||||
/* Handle the connect() result in the event loop*/
|
||||
janet_ev_connect(stream, MSG_NOSIGNAL);
|
||||
|
||||
janet_await();
|
||||
net_sched_connect(stream);
|
||||
}
|
||||
|
||||
static const char *serverify_socket(JSock sfd) {
|
||||
|
@ -682,6 +746,7 @@ static Janet janet_so_getname(const void *sa_any) {
|
|||
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
|
||||
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
||||
}
|
||||
#ifndef JANET_NO_IPV6
|
||||
case AF_INET6: {
|
||||
const struct sockaddr_in6 *sai6 = sa_any;
|
||||
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
|
||||
|
@ -690,6 +755,7 @@ static Janet janet_so_getname(const void *sa_any) {
|
|||
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
|
||||
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
||||
}
|
||||
#endif
|
||||
#ifndef JANET_WINDOWS
|
||||
case AF_UNIX: {
|
||||
const struct sockaddr_un *sun = sa_any;
|
||||
|
@ -756,6 +822,7 @@ JANET_CORE_FN(cfun_stream_accept_loop,
|
|||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
|
||||
JanetFunction *fun = janet_getfunction(argv, 1);
|
||||
if (fun->def->min_arity < 1) janet_panic("handler function must take at least 1 argument");
|
||||
janet_sched_accept(stream, fun);
|
||||
}
|
||||
|
||||
|
@ -792,7 +859,6 @@ JANET_CORE_FN(cfun_stream_read,
|
|||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_chunk,
|
||||
|
@ -807,7 +873,6 @@ JANET_CORE_FN(cfun_stream_chunk,
|
|||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_recv_from,
|
||||
|
@ -822,7 +887,6 @@ JANET_CORE_FN(cfun_stream_recv_from,
|
|||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_write,
|
||||
|
@ -842,7 +906,6 @@ JANET_CORE_FN(cfun_stream_write,
|
|||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_send_to,
|
||||
|
@ -863,7 +926,6 @@ JANET_CORE_FN(cfun_stream_send_to,
|
|||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_flush,
|
||||
|
@ -897,8 +959,10 @@ static const struct sockopt_type sockopt_type_list[] = {
|
|||
{ "ip-multicast-ttl", IPPROTO_IP, IP_MULTICAST_TTL, JANET_NUMBER },
|
||||
{ "ip-add-membership", IPPROTO_IP, IP_ADD_MEMBERSHIP, JANET_POINTER },
|
||||
{ "ip-drop-membership", IPPROTO_IP, IP_DROP_MEMBERSHIP, JANET_POINTER },
|
||||
#ifndef JANET_NO_IPV6
|
||||
{ "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
|
||||
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
|
||||
#endif
|
||||
{ NULL, 0, 0, JANET_POINTER }
|
||||
};
|
||||
|
||||
|
@ -935,7 +999,9 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
|||
union {
|
||||
int v_int;
|
||||
struct ip_mreq v_mreq;
|
||||
#ifndef JANET_NO_IPV6
|
||||
struct ipv6_mreq v_mreq6;
|
||||
#endif
|
||||
} val;
|
||||
|
||||
void *optval = (void *)&val;
|
||||
|
@ -953,12 +1019,14 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
|||
val.v_mreq.imr_interface.s_addr = htonl(INADDR_ANY);
|
||||
inet_pton(AF_INET, addr, &val.v_mreq.imr_multiaddr.s_addr);
|
||||
optlen = sizeof(val.v_mreq);
|
||||
#ifndef JANET_NO_IPV6
|
||||
} else if (st->optname == IPV6_JOIN_GROUP || st->optname == IPV6_LEAVE_GROUP) {
|
||||
const char *addr = janet_getcstring(argv, 2);
|
||||
memset(&val.v_mreq6, 0, sizeof val.v_mreq6);
|
||||
val.v_mreq6.ipv6mr_interface = 0;
|
||||
inet_pton(AF_INET6, addr, &val.v_mreq6.ipv6mr_multiaddr);
|
||||
optlen = sizeof(val.v_mreq6);
|
||||
#endif
|
||||
} else {
|
||||
janet_panicf("invalid socket option type");
|
||||
}
|
||||
|
|
332
src/core/os.c
332
src/core/os.c
|
@ -229,10 +229,11 @@ JANET_CORE_FN(os_compiler,
|
|||
#undef janet_stringify
|
||||
|
||||
JANET_CORE_FN(os_exit,
|
||||
"(os/exit &opt x)",
|
||||
"(os/exit &opt x force)",
|
||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||
"the exit with status equal the hash of x.") {
|
||||
janet_arity(argc, 0, 1);
|
||||
"the exit with status equal the hash of x. If `force` is truthy will exit immediately and "
|
||||
"skip cleanup code.") {
|
||||
janet_arity(argc, 0, 2);
|
||||
int status;
|
||||
if (argc == 0) {
|
||||
status = EXIT_SUCCESS;
|
||||
|
@ -242,7 +243,11 @@ JANET_CORE_FN(os_exit,
|
|||
status = EXIT_FAILURE;
|
||||
}
|
||||
janet_deinit();
|
||||
exit(status);
|
||||
if (argc >= 2 && janet_truthy(argv[1])) {
|
||||
_exit(status);
|
||||
} else {
|
||||
exit(status);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
|
@ -500,8 +505,11 @@ static int proc_get_status(JanetProc *proc) {
|
|||
status = WEXITSTATUS(status);
|
||||
} else if (WIFSTOPPED(status)) {
|
||||
status = WSTOPSIG(status) + 128;
|
||||
} else {
|
||||
} else if (WIFSIGNALED(status)) {
|
||||
status = WTERMSIG(status) + 128;
|
||||
} else {
|
||||
/* Could possibly return -1 but for now, just panic */
|
||||
janet_panicf("Undefined status code for process termination, %d.", status);
|
||||
}
|
||||
return status;
|
||||
}
|
||||
|
@ -517,7 +525,6 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
|||
|
||||
/* Callback that is called in main thread when subroutine completes. */
|
||||
static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||
janet_ev_dec_refcount();
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
if (NULL != proc) {
|
||||
int status = args.tag;
|
||||
|
@ -530,7 +537,9 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
|||
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
|
||||
janet_cancel(args.fiber, janet_wrap_string(s));
|
||||
} else {
|
||||
janet_schedule(args.fiber, janet_wrap_integer(status));
|
||||
if (janet_fiber_can_resume(args.fiber)) {
|
||||
janet_schedule(args.fiber, janet_wrap_integer(status));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -612,7 +621,11 @@ os_proc_wait_impl(JanetProc *proc) {
|
|||
|
||||
JANET_CORE_FN(os_proc_wait,
|
||||
"(os/proc-wait proc)",
|
||||
"Block until the subprocess completes. Returns the subprocess return code.") {
|
||||
"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.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
|
@ -641,7 +654,7 @@ static const struct keyword_signal signal_keywords[] = {
|
|||
#ifdef SIGTERM
|
||||
{"term", SIGTERM},
|
||||
#endif
|
||||
#ifdef SIGARLM
|
||||
#ifdef SIGALRM
|
||||
{"alrm", SIGALRM},
|
||||
#endif
|
||||
#ifdef SIGHUP
|
||||
|
@ -706,15 +719,28 @@ static const struct keyword_signal signal_keywords[] = {
|
|||
#endif
|
||||
{NULL, 0},
|
||||
};
|
||||
|
||||
static int get_signal_kw(const Janet *argv, int32_t n) {
|
||||
JanetKeyword signal_kw = janet_getkeyword(argv, n);
|
||||
const struct keyword_signal *ptr = signal_keywords;
|
||||
while (ptr->keyword) {
|
||||
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
|
||||
return ptr->signal;
|
||||
}
|
||||
ptr++;
|
||||
}
|
||||
janet_panicf("undefined signal %v", argv[n]);
|
||||
}
|
||||
#endif
|
||||
|
||||
JANET_CORE_FN(os_proc_kill,
|
||||
"(os/proc-kill proc &opt wait signal)",
|
||||
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
|
||||
"handle on windows. If `wait` is truthy, will wait for the process to finish and "
|
||||
"returns the exit code. Otherwise, returns `proc`. If signal is specified send it instead."
|
||||
"Signal keywords are named after their C counterparts but in lowercase with the leading "
|
||||
"`SIG` stripped. Signals are ignored on windows.") {
|
||||
"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.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
if (proc->flags & JANET_PROC_WAITED) {
|
||||
|
@ -731,18 +757,7 @@ JANET_CORE_FN(os_proc_kill,
|
|||
#else
|
||||
int signal = -1;
|
||||
if (argc == 3) {
|
||||
JanetKeyword signal_kw = janet_getkeyword(argv, 2);
|
||||
const struct keyword_signal *ptr = signal_keywords;
|
||||
while (ptr->keyword) {
|
||||
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
|
||||
signal = ptr->signal;
|
||||
break;
|
||||
}
|
||||
ptr++;
|
||||
}
|
||||
if (signal == -1) {
|
||||
janet_panic("undefined signal");
|
||||
}
|
||||
signal = get_signal_kw(argv, 2);
|
||||
}
|
||||
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
|
||||
if (status) {
|
||||
|
@ -764,8 +779,9 @@ JANET_CORE_FN(os_proc_kill,
|
|||
|
||||
JANET_CORE_FN(os_proc_close,
|
||||
"(os/proc-close proc)",
|
||||
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
|
||||
"if they have not been closed. Returns nil.") {
|
||||
"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.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
|
@ -803,6 +819,106 @@ static void close_handle(JanetHandle handle) {
|
|||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
static void janet_signal_callback(JanetEVGenericMessage msg) {
|
||||
int sig = msg.tag;
|
||||
if (msg.argi) janet_interpreter_interrupt_handled(NULL);
|
||||
Janet handlerv = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
|
||||
if (!janet_checktype(handlerv, JANET_FUNCTION)) {
|
||||
/* Let another thread/process try to handle this */
|
||||
sigset_t set;
|
||||
sigemptyset(&set);
|
||||
sigaddset(&set, sig);
|
||||
#ifdef JANET_THREADS
|
||||
pthread_sigmask(SIG_BLOCK, &set, NULL);
|
||||
#else
|
||||
sigprocmask(SIG_BLOCK, &set, NULL);
|
||||
#endif
|
||||
raise(sig);
|
||||
return;
|
||||
}
|
||||
JanetFunction *handler = janet_unwrap_function(handlerv);
|
||||
JanetFiber *fiber = janet_fiber(handler, 64, 0, NULL);
|
||||
janet_schedule_soon(fiber, janet_wrap_nil(), JANET_SIGNAL_OK);
|
||||
}
|
||||
|
||||
static void janet_signal_trampoline_no_interrupt(int sig) {
|
||||
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
|
||||
JanetEVGenericMessage msg;
|
||||
memset(&msg, 0, sizeof(msg));
|
||||
msg.tag = sig;
|
||||
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
|
||||
}
|
||||
|
||||
static void janet_signal_trampoline(int sig) {
|
||||
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
|
||||
JanetEVGenericMessage msg;
|
||||
memset(&msg, 0, sizeof(msg));
|
||||
msg.tag = sig;
|
||||
msg.argi = 1;
|
||||
janet_interpreter_interrupt(NULL);
|
||||
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
|
||||
}
|
||||
#endif
|
||||
|
||||
JANET_CORE_FN(os_sigaction,
|
||||
"(os/sigaction which &opt handler interrupt-interpreter)",
|
||||
"Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler. "
|
||||
"All signal handlers are the same as supported by `os/proc-kill`.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SIGNAL);
|
||||
janet_arity(argc, 1, 3);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argv;
|
||||
janet_panic("unsupported on this platform");
|
||||
#else
|
||||
/* TODO - per thread signal masks */
|
||||
int rc;
|
||||
int sig = get_signal_kw(argv, 0);
|
||||
JanetFunction *handler = janet_optfunction(argv, argc, 1, NULL);
|
||||
int can_interrupt = janet_optboolean(argv, argc, 2, 0);
|
||||
Janet oldhandler = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
|
||||
if (!janet_checktype(oldhandler, JANET_NIL)) {
|
||||
janet_gcunroot(oldhandler);
|
||||
}
|
||||
if (NULL != handler) {
|
||||
Janet handlerv = janet_wrap_function(handler);
|
||||
janet_gcroot(handlerv);
|
||||
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), handlerv);
|
||||
} else {
|
||||
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), janet_wrap_nil());
|
||||
}
|
||||
struct sigaction action;
|
||||
sigset_t mask;
|
||||
sigaddset(&mask, sig);
|
||||
memset(&action, 0, sizeof(action));
|
||||
action.sa_flags |= SA_RESTART;
|
||||
if (can_interrupt) {
|
||||
#ifdef JANET_NO_INTERPRETER_INTERRUPT
|
||||
janet_panic("interpreter interrupt not enabled");
|
||||
#else
|
||||
action.sa_handler = janet_signal_trampoline;
|
||||
#endif
|
||||
} else {
|
||||
action.sa_handler = janet_signal_trampoline_no_interrupt;
|
||||
}
|
||||
action.sa_mask = mask;
|
||||
RETRY_EINTR(rc, sigaction(sig, &action, NULL));
|
||||
sigset_t set;
|
||||
sigemptyset(&set);
|
||||
sigaddset(&set, sig);
|
||||
#ifdef JANET_THREADS
|
||||
pthread_sigmask(SIG_UNBLOCK, &set, NULL);
|
||||
#else
|
||||
sigprocmask(SIG_UNBLOCK, &set, NULL);
|
||||
#endif
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
|
||||
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
|
||||
up by the calling function. If everything goes well, *handle is owned by the calling function,
|
||||
|
@ -982,11 +1098,18 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri
|
|||
}
|
||||
#endif
|
||||
|
||||
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
typedef enum {
|
||||
JANET_EXECUTE_EXECUTE,
|
||||
JANET_EXECUTE_SPAWN,
|
||||
JANET_EXECUTE_EXEC
|
||||
} JanetExecuteMode;
|
||||
|
||||
static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
|
||||
janet_arity(argc, 1, 3);
|
||||
|
||||
/* Get flags */
|
||||
int is_spawn = mode == JANET_EXECUTE_SPAWN;
|
||||
uint64_t flags = 0;
|
||||
if (argc > 1) {
|
||||
flags = janet_getflags(argv, 1, "epxd");
|
||||
|
@ -1010,7 +1133,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
|||
int pipe_owner_flags = (is_spawn && (flags & 0x8)) ? JANET_PROC_ALLOW_ZOMBIE : 0;
|
||||
|
||||
/* Get optional redirections */
|
||||
if (argc > 2) {
|
||||
if (argc > 2 && (mode != JANET_EXECUTE_EXEC)) {
|
||||
JanetDictView tab = janet_getdictionary(argv, 2);
|
||||
Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
|
||||
Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
|
||||
|
@ -1131,12 +1254,32 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
|||
* of posix_spawn would modify the argv array passed in. */
|
||||
char *const *cargv = (char *const *)child_argv;
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
|
||||
if (use_environ) {
|
||||
janet_lock_environ();
|
||||
}
|
||||
|
||||
/* exec mode */
|
||||
if (mode == JANET_EXECUTE_EXEC) {
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_panic("not supported on windows");
|
||||
#else
|
||||
int status;
|
||||
if (!use_environ) {
|
||||
environ = envp;
|
||||
}
|
||||
do {
|
||||
if (janet_flag_at(flags, 1)) {
|
||||
status = execvp(cargv[0], cargv);
|
||||
} else {
|
||||
status = execv(cargv[0], cargv);
|
||||
}
|
||||
} while (status == -1 && errno == EINTR);
|
||||
janet_panicf("%p: %s", cargv[0], strerror(errno ? errno : ENOENT));
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
|
||||
/* Posix spawn setup */
|
||||
posix_spawn_file_actions_t actions;
|
||||
posix_spawn_file_actions_init(&actions);
|
||||
|
@ -1145,14 +1288,16 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
|||
posix_spawn_file_actions_addclose(&actions, pipe_in);
|
||||
} else if (new_in != JANET_HANDLE_NONE && new_in != 0) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_in, 0);
|
||||
posix_spawn_file_actions_addclose(&actions, new_in);
|
||||
if (new_in != new_out && new_in != new_err)
|
||||
posix_spawn_file_actions_addclose(&actions, new_in);
|
||||
}
|
||||
if (pipe_out != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
|
||||
posix_spawn_file_actions_addclose(&actions, pipe_out);
|
||||
} else if (new_out != JANET_HANDLE_NONE && new_out != 1) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_out, 1);
|
||||
posix_spawn_file_actions_addclose(&actions, new_out);
|
||||
if (new_out != new_err)
|
||||
posix_spawn_file_actions_addclose(&actions, new_out);
|
||||
}
|
||||
if (pipe_err != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
|
||||
|
@ -1241,22 +1386,63 @@ JANET_CORE_FN(os_execute,
|
|||
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
|
||||
"`env` is a table or struct mapping environment variables to values. It can also "
|
||||
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
|
||||
"These arguments should be core/file values. "
|
||||
"Returns the exit status of the program.") {
|
||||
return os_execute_impl(argc, argv, 0);
|
||||
":in, :out, and :err should be core/file values or core/stream values. core/file values and core/stream "
|
||||
"values passed to :in, :out, and :err should be closed manually because os/execute doesn't close them. "
|
||||
"Returns the exit code of the program.") {
|
||||
return os_execute_impl(argc, argv, JANET_EXECUTE_EXECUTE);
|
||||
}
|
||||
|
||||
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 to the `env` argument, one "
|
||||
"can also pass in the keyword `:pipe` "
|
||||
"to get streams for standard IO of the subprocess that can be read from and written to. "
|
||||
"The returned value `proc` has the fields :in, :out, :err, :return-code, and "
|
||||
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
|
||||
"subprocess or `(os/proc-kill proc)`.") {
|
||||
return os_execute_impl(argc, argv, 1);
|
||||
"same arguments as `os/execute`. Does not wait for the process. For each of the :in, :out, and :err keys "
|
||||
"of the `env` argument, one can also pass in the keyword `:pipe` to get streams for standard IO of the "
|
||||
"subprocess that can be read from and written to. The returned value `proc` has the fields :in, :out, "
|
||||
":err, and the additional field :pid on unix-like platforms. `(os/proc-wait proc)` must be called to "
|
||||
"rejoin the subprocess. After `(os/proc-wait proc)` finishes, proc gains a new field, :return-code. "
|
||||
"If :x flag is passed to os/spawn, non-zero exit code will cause os/proc-wait to raise an error. "
|
||||
"If pipe streams created with :pipe keyword are not closed in time, janet can run out of file "
|
||||
"descriptors. They can be closed individually, or `os/proc-close` can close all pipe streams on proc. "
|
||||
"If pipe streams aren't read before `os/proc-wait` finishes, then pipe buffers become full, and the "
|
||||
"process cannot finish because the process cannot print more on pipe buffers which are already full. "
|
||||
"If the process cannot finish, os/proc-wait cannot finish, either.") {
|
||||
return os_execute_impl(argc, argv, JANET_EXECUTE_SPAWN);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_posix_exec,
|
||||
"(os/posix-exec args &opt flags env)",
|
||||
"Use the execvpe or execve system calls to replace the current process with an interface similar to os/execute. "
|
||||
"Hoever, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and "
|
||||
"does not allow redirection of stdio.") {
|
||||
return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_posix_fork,
|
||||
"(os/posix-fork)",
|
||||
"Make a `fork` system call and create a new process. Return nil if in the new process, otherwise a core/process object (as returned by os/spawn). "
|
||||
"Not supported on all systems (POSIX only).") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_panic("not supported");
|
||||
#else
|
||||
pid_t result;
|
||||
do {
|
||||
result = fork();
|
||||
} while (result == -1 && errno == EINTR);
|
||||
if (result == -1) {
|
||||
janet_panic(strerror(errno));
|
||||
}
|
||||
if (result) {
|
||||
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
|
||||
memset(proc, 0, sizeof(JanetProc));
|
||||
proc->pid = result;
|
||||
proc->flags = JANET_PROC_ALLOW_ZOMBIE;
|
||||
return janet_wrap_abstract(proc);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
|
@ -1332,8 +1518,8 @@ JANET_CORE_FN(os_getenv,
|
|||
janet_sandbox_assert(JANET_SANDBOX_ENV);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *cstr = janet_getcstring(argv, 0);
|
||||
const char *res = getenv(cstr);
|
||||
janet_lock_environ();
|
||||
const char *res = getenv(cstr);
|
||||
Janet ret = res
|
||||
? janet_cstringv(res)
|
||||
: argc == 2
|
||||
|
@ -1378,34 +1564,51 @@ JANET_CORE_FN(os_time,
|
|||
}
|
||||
|
||||
JANET_CORE_FN(os_clock,
|
||||
"(os/clock &opt source)",
|
||||
"Return the number of whole + fractional seconds of the requested clock source.\n\n"
|
||||
"(os/clock &opt source format)",
|
||||
"Return the current time of the requested clock source.\n\n"
|
||||
"The `source` argument selects the clock source to use, when not specified the default "
|
||||
"is `:realtime`:\n"
|
||||
"- :realtime: Return the real (i.e., wall-clock) time. This clock is affected by discontinuous "
|
||||
" jumps in the system time\n"
|
||||
"- :monotonic: Return the number of whole + fractional seconds since some fixed point in "
|
||||
" time. The clock is guaranteed to be non-decreasing in real time.\n"
|
||||
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n") {
|
||||
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n"
|
||||
"The `format` argument selects the type of output, when not specified the default is `:double`:\n"
|
||||
"- :double: Return the number of seconds + fractional seconds as a double\n"
|
||||
"- :int: Return the number of seconds as an integer\n"
|
||||
"- :tuple: Return a 2 integer tuple [seconds, nanoseconds]\n") {
|
||||
enum JanetTimeSource source;
|
||||
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
|
||||
janet_arity(argc, 0, 1);
|
||||
enum JanetTimeSource source = JANET_TIME_REALTIME;
|
||||
if (argc == 1) {
|
||||
JanetKeyword sourcestr = janet_getkeyword(argv, 0);
|
||||
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
|
||||
source = JANET_TIME_REALTIME;
|
||||
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
|
||||
source = JANET_TIME_MONOTONIC;
|
||||
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
|
||||
source = JANET_TIME_CPUTIME;
|
||||
} else {
|
||||
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
|
||||
}
|
||||
janet_arity(argc, 0, 2);
|
||||
|
||||
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime");
|
||||
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
|
||||
source = JANET_TIME_REALTIME;
|
||||
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
|
||||
source = JANET_TIME_MONOTONIC;
|
||||
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
|
||||
source = JANET_TIME_CPUTIME;
|
||||
} else {
|
||||
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
|
||||
}
|
||||
|
||||
struct timespec tv;
|
||||
if (janet_gettime(&tv, source)) janet_panic("could not get time");
|
||||
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
||||
return janet_wrap_number(dtime);
|
||||
|
||||
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
|
||||
if (janet_cstrcmp(formatstr, "double") == 0) {
|
||||
double dtime = (double)(tv.tv_sec + (tv.tv_nsec / 1E9));
|
||||
return janet_wrap_number(dtime);
|
||||
} else if (janet_cstrcmp(formatstr, "int") == 0) {
|
||||
return janet_wrap_number((double)(tv.tv_sec));
|
||||
} else if (janet_cstrcmp(formatstr, "tuple") == 0) {
|
||||
Janet tup[2] = {janet_wrap_number((double)tv.tv_sec),
|
||||
janet_wrap_number((double)tv.tv_nsec)
|
||||
};
|
||||
return janet_wrap_tuple(janet_tuple_n(tup, 2));
|
||||
} else {
|
||||
janet_panicf("expected :double, :int, or :tuple, got %v", argv[1]);
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_sleep,
|
||||
|
@ -2521,6 +2724,8 @@ void janet_lib_os(JanetTable *env) {
|
|||
JANET_CORE_REG("os/execute", os_execute),
|
||||
JANET_CORE_REG("os/spawn", os_spawn),
|
||||
JANET_CORE_REG("os/shell", os_shell),
|
||||
JANET_CORE_REG("os/posix-fork", os_posix_fork),
|
||||
JANET_CORE_REG("os/posix-exec", os_posix_exec),
|
||||
/* no need to sandbox process management if you can't create processes
|
||||
* (allows for limited functionality if use exposes C-functions to create specific processes) */
|
||||
JANET_CORE_REG("os/proc-wait", os_proc_wait),
|
||||
|
@ -2534,6 +2739,7 @@ void janet_lib_os(JanetTable *env) {
|
|||
#ifdef JANET_EV
|
||||
JANET_CORE_REG("os/open", os_open), /* fs read and write */
|
||||
JANET_CORE_REG("os/pipe", os_pipe),
|
||||
JANET_CORE_REG("os/sigaction", os_sigaction),
|
||||
#endif
|
||||
#endif
|
||||
JANET_REG_END
|
||||
|
|
|
@ -259,6 +259,14 @@ static int checkescape(uint8_t c) {
|
|||
return '\f';
|
||||
case 'v':
|
||||
return '\v';
|
||||
case 'a':
|
||||
return '\a';
|
||||
case 'b':
|
||||
return '\b';
|
||||
case '\'':
|
||||
return '\'';
|
||||
case '?':
|
||||
return '?';
|
||||
case 'e':
|
||||
return 27;
|
||||
case '"':
|
||||
|
|
106
src/core/peg.c
106
src/core/peg.c
|
@ -39,6 +39,10 @@
|
|||
typedef struct {
|
||||
const uint8_t *text_start;
|
||||
const uint8_t *text_end;
|
||||
/* text_end can be restricted by some rules, but
|
||||
outer_text_end will always contain the real end of
|
||||
input, which we need to generate a line mapping */
|
||||
const uint8_t *outer_text_end;
|
||||
const uint32_t *bytecode;
|
||||
const Janet *constants;
|
||||
JanetArray *captures;
|
||||
|
@ -114,12 +118,12 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
|
|||
/* Generate if not made yet */
|
||||
if (s->linemaplen < 0) {
|
||||
int32_t newline_count = 0;
|
||||
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
|
||||
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
|
||||
if (*c == '\n') newline_count++;
|
||||
}
|
||||
int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count);
|
||||
size_t index = 0;
|
||||
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
|
||||
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
|
||||
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
|
||||
}
|
||||
s->linemaplen = newline_count;
|
||||
|
@ -179,7 +183,7 @@ static const uint8_t *peg_rule(
|
|||
const uint32_t *rule,
|
||||
const uint8_t *text) {
|
||||
tail:
|
||||
switch (*rule & 0x1F) {
|
||||
switch (*rule) {
|
||||
default:
|
||||
janet_panic("unexpected opcode");
|
||||
return NULL;
|
||||
|
@ -482,6 +486,68 @@ tail:
|
|||
return result;
|
||||
}
|
||||
|
||||
case RULE_SUB: {
|
||||
const uint8_t *text_start = text;
|
||||
const uint32_t *rule_window = s->bytecode + rule[1];
|
||||
const uint32_t *rule_subpattern = s->bytecode + rule[2];
|
||||
down1(s);
|
||||
const uint8_t *window_end = peg_rule(s, rule_window, text);
|
||||
up1(s);
|
||||
if (!window_end) {
|
||||
return NULL;
|
||||
}
|
||||
const uint8_t *saved_end = s->text_end;
|
||||
s->text_end = window_end;
|
||||
down1(s);
|
||||
const uint8_t *next_text = peg_rule(s, rule_subpattern, text_start);
|
||||
up1(s);
|
||||
s->text_end = saved_end;
|
||||
|
||||
if (!next_text) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
return window_end;
|
||||
}
|
||||
|
||||
case RULE_SPLIT: {
|
||||
const uint8_t *saved_end = s->text_end;
|
||||
const uint32_t *rule_separator = s->bytecode + rule[1];
|
||||
const uint32_t *rule_subpattern = s->bytecode + rule[2];
|
||||
|
||||
const uint8_t *separator_end = NULL;
|
||||
do {
|
||||
const uint8_t *text_start = text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text <= s->text_end) {
|
||||
separator_end = peg_rule(s, rule_separator, text);
|
||||
cap_load(s, cs);
|
||||
if (separator_end) {
|
||||
break;
|
||||
}
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
|
||||
if (separator_end) {
|
||||
s->text_end = text;
|
||||
text = separator_end;
|
||||
}
|
||||
|
||||
down1(s);
|
||||
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
|
||||
up1(s);
|
||||
s->text_end = saved_end;
|
||||
|
||||
if (!subpattern_end) {
|
||||
return NULL;
|
||||
}
|
||||
} while (separator_end);
|
||||
|
||||
return s->text_end;
|
||||
}
|
||||
|
||||
case RULE_REPLACE:
|
||||
case RULE_MATCHTIME: {
|
||||
uint32_t tag = rule[3];
|
||||
|
@ -1107,6 +1173,22 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
|||
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
|
||||
}
|
||||
|
||||
static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
uint32_t subrule1 = peg_compile1(b, argv[0]);
|
||||
uint32_t subrule2 = peg_compile1(b, argv[1]);
|
||||
emit_2(r, RULE_SUB, subrule1, subrule2);
|
||||
}
|
||||
|
||||
static void spec_split(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
uint32_t subrule1 = peg_compile1(b, argv[0]);
|
||||
uint32_t subrule2 = peg_compile1(b, argv[1]);
|
||||
emit_2(r, RULE_SPLIT, subrule1, subrule2);
|
||||
}
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
#define JANET_MAX_READINT_WIDTH 8
|
||||
#else
|
||||
|
@ -1190,6 +1272,8 @@ static const SpecialPair peg_specials[] = {
|
|||
{"sequence", spec_sequence},
|
||||
{"set", spec_set},
|
||||
{"some", spec_some},
|
||||
{"split", spec_split},
|
||||
{"sub", spec_sub},
|
||||
{"thru", spec_thru},
|
||||
{"to", spec_to},
|
||||
{"uint", spec_uint_le},
|
||||
|
@ -1431,7 +1515,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
|||
uint32_t instr = bytecode[i];
|
||||
uint32_t *rule = bytecode + i;
|
||||
op_flags[i] |= 0x02;
|
||||
switch (instr & 0x1F) {
|
||||
switch (instr) {
|
||||
case RULE_LITERAL:
|
||||
i += 2 + ((rule[1] + 3) >> 2);
|
||||
break;
|
||||
|
@ -1524,6 +1608,15 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
|||
op_flags[rule[1]] |= 0x01;
|
||||
i += 4;
|
||||
break;
|
||||
case RULE_SUB:
|
||||
case RULE_SPLIT:
|
||||
/* [rule, rule] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
if (rule[2] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
op_flags[rule[2]] |= 0x01;
|
||||
i += 3;
|
||||
break;
|
||||
case RULE_ERROR:
|
||||
case RULE_DROP:
|
||||
case RULE_NOT:
|
||||
|
@ -1652,7 +1745,7 @@ typedef struct {
|
|||
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
PegCall ret;
|
||||
int32_t min = get_replace ? 3 : 2;
|
||||
janet_arity(argc, get_replace, -1);
|
||||
janet_arity(argc, min, -1);
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
||||
ret.peg = janet_unwrap_abstract(argv[0]);
|
||||
|
@ -1677,6 +1770,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
|||
ret.s.mode = PEG_MODE_NORMAL;
|
||||
ret.s.text_start = ret.bytes.bytes;
|
||||
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
|
||||
ret.s.outer_text_end = ret.s.text_end;
|
||||
ret.s.depth = JANET_RECURSION_GUARD;
|
||||
ret.s.captures = janet_array(0);
|
||||
ret.s.tagged_captures = janet_array(0);
|
||||
|
@ -1771,7 +1865,7 @@ JANET_CORE_FN(cfun_peg_replace_all,
|
|||
}
|
||||
|
||||
JANET_CORE_FN(cfun_peg_replace,
|
||||
"(peg/replace peg repl text &opt start & args)",
|
||||
"(peg/replace peg subst text &opt start & args)",
|
||||
"Replace first match of `peg` in `text` with `subst`, returning a new buffer. "
|
||||
"The peg does not need to make captures to do replacement. "
|
||||
"If `subst` is a function, it will be called with the "
|
||||
|
|
|
@ -31,6 +31,7 @@
|
|||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
#include <inttypes.h>
|
||||
#include <float.h>
|
||||
|
||||
/* Implements a pretty printer for Janet. The pretty printer
|
||||
* is simple and not that flexible, but fast. */
|
||||
|
@ -38,11 +39,15 @@
|
|||
/* Temporary buffer size */
|
||||
#define BUFSIZE 64
|
||||
|
||||
/* Preprocessor hacks */
|
||||
#define STR_HELPER(x) #x
|
||||
#define STR(x) STR_HELPER(x)
|
||||
|
||||
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||
const char *fmt = (x == floor(x) &&
|
||||
x <= JANET_INTMAX_DOUBLE &&
|
||||
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
|
||||
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : ("%." STR(DBL_DIG) "g");
|
||||
int count;
|
||||
if (x == 0.0) {
|
||||
/* Prevent printing of '-0' */
|
||||
|
@ -152,6 +157,12 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
|||
case '\v':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
|
||||
break;
|
||||
case '\a':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
|
||||
break;
|
||||
case '\b':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
|
||||
break;
|
||||
case 27:
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
|
||||
break;
|
||||
|
@ -244,6 +255,10 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
|||
case JANET_FUNCTION: {
|
||||
JanetFunction *fun = janet_unwrap_function(x);
|
||||
JanetFuncDef *def = fun->def;
|
||||
if (def == NULL) {
|
||||
janet_buffer_push_cstring(buffer, "<incomplete function>");
|
||||
break;
|
||||
}
|
||||
if (def->name) {
|
||||
const uint8_t *n = def->name;
|
||||
janet_buffer_push_cstring(buffer, "<function ");
|
||||
|
@ -762,6 +777,8 @@ struct FmtMapping {
|
|||
/* Janet uses fixed width integer types for most things, so map
|
||||
* format specifiers to these fixed sizes */
|
||||
static const struct FmtMapping format_mappings[] = {
|
||||
{'D', PRId64},
|
||||
{'I', PRIi64},
|
||||
{'d', PRId64},
|
||||
{'i', PRIi64},
|
||||
{'o', PRIo64},
|
||||
|
@ -813,7 +830,7 @@ static const char *scanformat(
|
|||
if (loc != NULL && *loc != '\0') {
|
||||
const char *mapping = get_fmt_mapping(*p2++);
|
||||
size_t len = strlen(mapping);
|
||||
strcpy(form, mapping);
|
||||
memcpy(form, mapping, len);
|
||||
form += len;
|
||||
} else {
|
||||
*(form++) = *(p2++);
|
||||
|
@ -840,13 +857,19 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
|||
c = scanformat(c, form, width, precision);
|
||||
switch (*c++) {
|
||||
case 'c': {
|
||||
int n = va_arg(args, long);
|
||||
int n = va_arg(args, int);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i': {
|
||||
int64_t n = va_arg(args, int);
|
||||
int64_t n = (int64_t) va_arg(args, int32_t);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'D':
|
||||
case 'I': {
|
||||
int64_t n = va_arg(args, int64_t);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
|
@ -854,7 +877,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
|||
case 'X':
|
||||
case 'o':
|
||||
case 'u': {
|
||||
uint64_t n = va_arg(args, unsigned int);
|
||||
uint64_t n = va_arg(args, uint64_t);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
|
@ -898,7 +921,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
|||
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
|
||||
break;
|
||||
case 'T': {
|
||||
int types = va_arg(args, long);
|
||||
int types = va_arg(args, int);
|
||||
pushtypes(b, types);
|
||||
break;
|
||||
}
|
||||
|
@ -1007,6 +1030,8 @@ void janet_buffer_format(
|
|||
janet_getinteger(argv, arg));
|
||||
break;
|
||||
}
|
||||
case 'D':
|
||||
case 'I':
|
||||
case 'd':
|
||||
case 'i': {
|
||||
int64_t n = janet_getinteger64(argv, arg);
|
||||
|
|
|
@ -32,6 +32,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||
int errflags = 0, done = 0;
|
||||
int32_t index = 0;
|
||||
Janet ret = janet_wrap_nil();
|
||||
JanetFiber *fiber = NULL;
|
||||
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
||||
|
||||
if (where) janet_gcroot(janet_wrap_string(where));
|
||||
|
@ -47,7 +48,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||
JanetCompileResult cres = janet_compile(form, env, where);
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber->env = env;
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
|
@ -57,12 +58,20 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||
}
|
||||
} else {
|
||||
ret = janet_wrap_string(cres.error);
|
||||
int32_t line = (int32_t) parser.line;
|
||||
int32_t col = (int32_t) parser.column;
|
||||
if ((cres.error_mapping.line > 0) &&
|
||||
(cres.error_mapping.column > 0)) {
|
||||
line = cres.error_mapping.line;
|
||||
col = cres.error_mapping.column;
|
||||
}
|
||||
if (cres.macrofiber) {
|
||||
janet_eprintf("compile error in %s: ", sourcePath);
|
||||
janet_eprintf("%s:%d:%d: compile error", sourcePath,
|
||||
line, col);
|
||||
janet_stacktrace_ext(cres.macrofiber, ret, "");
|
||||
} else {
|
||||
janet_eprintf("compile error in %s: %s\n", sourcePath,
|
||||
(const char *)cres.error);
|
||||
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
|
||||
line, col, (const char *)cres.error);
|
||||
}
|
||||
errflags |= 0x02;
|
||||
done = 1;
|
||||
|
@ -104,9 +113,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||
#ifdef JANET_EV
|
||||
/* Enter the event loop if we are not already in it */
|
||||
if (janet_vm.stackn == 0) {
|
||||
janet_gcroot(ret);
|
||||
if (fiber) {
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
}
|
||||
janet_loop();
|
||||
janet_gcunroot(ret);
|
||||
if (fiber) {
|
||||
janet_gcunroot(janet_wrap_fiber(fiber));
|
||||
ret = fiber->last_value;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
if (out) *out = ret;
|
||||
|
|
|
@ -149,7 +149,7 @@ static int destructure(JanetCompiler *c,
|
|||
JanetTable *attr) {
|
||||
switch (janet_type(left)) {
|
||||
default:
|
||||
janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left));
|
||||
janetc_error(c, janet_formatc("unexpected type in destructuring, got %v", left));
|
||||
return 1;
|
||||
case JANET_SYMBOL:
|
||||
/* Leaf, assign right to left */
|
||||
|
@ -357,7 +357,8 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
|
|||
|
||||
if (has_drop && can_destructure_lhs && rhs_is_indexed) {
|
||||
/* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */
|
||||
JanetView view_lhs, view_rhs;
|
||||
JanetView view_lhs = {0};
|
||||
JanetView view_rhs = {0};
|
||||
janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
|
||||
janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
|
||||
int found_amp = 0;
|
||||
|
@ -529,6 +530,26 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||
return ret;
|
||||
}
|
||||
|
||||
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
|
||||
static int janetc_check_nil_form(Janet x, Janet *capture, uint32_t fun_tag) {
|
||||
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
||||
JanetTuple tup = janet_unwrap_tuple(x);
|
||||
if (3 != janet_tuple_length(tup)) return 0;
|
||||
Janet op1 = tup[0];
|
||||
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
|
||||
JanetFunction *fun = janet_unwrap_function(op1);
|
||||
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
||||
if (tag != fun_tag) return 0;
|
||||
if (janet_checktype(tup[1], JANET_NIL)) {
|
||||
*capture = tup[2];
|
||||
return 1;
|
||||
} else if (janet_checktype(tup[2], JANET_NIL)) {
|
||||
*capture = tup[1];
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* :condition
|
||||
* ...
|
||||
|
@ -549,6 +570,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||
JanetScope condscope, tempscope;
|
||||
const int tail = opts.flags & JANET_FOPTS_TAIL;
|
||||
const int drop = opts.flags & JANET_FOPTS_DROP;
|
||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
||||
|
||||
if (argn < 2 || argn > 3) {
|
||||
janetc_cerror(c, "expected 2 or 3 arguments to if");
|
||||
|
@ -571,12 +593,24 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||
|
||||
/* Compile condition */
|
||||
janetc_scope(&condscope, c, 0, "if");
|
||||
cond = janetc_value(condopts, argv[0]);
|
||||
|
||||
Janet condform = argv[0];
|
||||
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
|
||||
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
||||
} else if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
|
||||
ifnjmp = JOP_JUMP_IF_NIL;
|
||||
}
|
||||
|
||||
cond = janetc_value(condopts, condform);
|
||||
|
||||
/* Check constant condition. */
|
||||
/* TODO: Use type info for more short circuits */
|
||||
if (cond.flags & JANET_SLOT_CONSTANT) {
|
||||
if (!janet_truthy(cond.constant)) {
|
||||
int swap_condition = 0;
|
||||
if (ifnjmp == JOP_JUMP_IF_NOT && !janet_truthy(cond.constant)) swap_condition = 1;
|
||||
if (ifnjmp == JOP_JUMP_IF_NIL && janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
|
||||
if (ifnjmp == JOP_JUMP_IF_NOT_NIL && !janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
|
||||
if (swap_condition) {
|
||||
/* Swap the true and false bodies */
|
||||
Janet temp = falsebody;
|
||||
falsebody = truebody;
|
||||
|
@ -594,7 +628,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||
}
|
||||
|
||||
/* Compile jump to right */
|
||||
labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
|
||||
labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0);
|
||||
|
||||
/* Condition left body */
|
||||
janetc_scope(&tempscope, c, 0, "if-true");
|
||||
|
@ -604,7 +638,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||
|
||||
/* Compile jump to done */
|
||||
labeljd = janet_v_count(c->buffer);
|
||||
if (!tail) janetc_emit(c, JOP_JUMP);
|
||||
if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP);
|
||||
|
||||
/* Compile right body */
|
||||
labelr = janet_v_count(c->buffer);
|
||||
|
@ -715,9 +749,8 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
|
||||
/* Closure body with return argument */
|
||||
subopts.flags |= JANET_FOPTS_TAIL;
|
||||
JanetSlot ret = janetc_value(subopts, argv[0]);
|
||||
ret.flags |= JANET_SLOT_RETURNED;
|
||||
return ret;
|
||||
janetc_value(subopts, argv[0]);
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
} else {
|
||||
/* while loop IIFE or no argument */
|
||||
if (argn) {
|
||||
|
@ -725,9 +758,7 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||
janetc_value(subopts, argv[0]);
|
||||
}
|
||||
janetc_emit(c, JOP_RETURN_NIL);
|
||||
JanetSlot s = janetc_cslot(janet_wrap_nil());
|
||||
s.flags |= JANET_SLOT_RETURNED;
|
||||
return s;
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
} else {
|
||||
if (argn) {
|
||||
|
@ -740,20 +771,6 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||
}
|
||||
}
|
||||
|
||||
/* Check if a form matches the pattern (not= nil _) */
|
||||
static int janetc_check_notnil_form(Janet x, Janet *capture) {
|
||||
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
||||
JanetTuple tup = janet_unwrap_tuple(x);
|
||||
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
|
||||
if (3 != janet_tuple_length(tup)) return 0;
|
||||
JanetFunction *fun = janet_unwrap_function(tup[0]);
|
||||
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
||||
if (tag != JANET_FUN_NEQ) return 0;
|
||||
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
|
||||
*capture = tup[2];
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* :whiletop
|
||||
* ...
|
||||
|
@ -770,6 +787,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||
JanetScope tempscope;
|
||||
int32_t labelwt, labeld, labeljt, labelc, i;
|
||||
int infinite = 0;
|
||||
int is_nil_form = 0;
|
||||
int is_notnil_form = 0;
|
||||
uint8_t ifjmp = JOP_JUMP_IF;
|
||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
||||
|
@ -783,11 +801,16 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||
|
||||
/* Check for `(not= nil _)` in condition, and if so, use the
|
||||
/* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the
|
||||
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
|
||||
* more efficiently. */
|
||||
Janet condform = argv[0];
|
||||
if (janetc_check_notnil_form(condform, &condform)) {
|
||||
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
|
||||
is_nil_form = 1;
|
||||
ifjmp = JOP_JUMP_IF_NIL;
|
||||
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
||||
}
|
||||
if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
|
||||
is_notnil_form = 1;
|
||||
ifjmp = JOP_JUMP_IF_NOT_NIL;
|
||||
ifnjmp = JOP_JUMP_IF_NIL;
|
||||
|
@ -799,7 +822,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||
/* Check for constant condition */
|
||||
if (cond.flags & JANET_SLOT_CONSTANT) {
|
||||
/* Loop never executes */
|
||||
int never_executes = is_notnil_form
|
||||
int never_executes = is_nil_form
|
||||
? !janet_checktype(cond.constant, JANET_NIL)
|
||||
: is_notnil_form
|
||||
? janet_checktype(cond.constant, JANET_NIL)
|
||||
: !janet_truthy(cond.constant);
|
||||
if (never_executes) {
|
||||
|
|
|
@ -24,6 +24,11 @@
|
|||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#endif
|
||||
|
||||
JANET_THREAD_LOCAL JanetVM janet_vm;
|
||||
|
@ -57,5 +62,10 @@ void janet_vm_load(JanetVM *from) {
|
|||
* use NULL to interrupt the current VM when convenient */
|
||||
void janet_interpreter_interrupt(JanetVM *vm) {
|
||||
vm = vm ? vm : &janet_vm;
|
||||
vm->auto_suspend = 1;
|
||||
janet_atomic_inc(&vm->auto_suspend);
|
||||
}
|
||||
|
||||
void janet_interpreter_interrupt_handled(JanetVM *vm) {
|
||||
vm = vm ? vm : &janet_vm;
|
||||
janet_atomic_dec(&vm->auto_suspend);
|
||||
}
|
||||
|
|
|
@ -89,7 +89,7 @@ struct JanetVM {
|
|||
|
||||
/* If this flag is true, suspend on function calls and backwards jumps.
|
||||
* When this occurs, this flag will be reset to 0. */
|
||||
int auto_suspend;
|
||||
volatile JanetAtomicInt auto_suspend;
|
||||
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by functions in vm.c */
|
||||
|
@ -121,10 +121,12 @@ struct JanetVM {
|
|||
|
||||
/* Garbage collection */
|
||||
void *blocks;
|
||||
void *weak_blocks;
|
||||
size_t gc_interval;
|
||||
size_t next_collection;
|
||||
size_t block_count;
|
||||
int gc_suspend;
|
||||
int gc_mark_phase;
|
||||
|
||||
/* GC roots */
|
||||
Janet *roots;
|
||||
|
@ -154,12 +156,10 @@ struct JanetVM {
|
|||
JanetQueue spawn;
|
||||
JanetTimeout *tq;
|
||||
JanetRNG ev_rng;
|
||||
JanetListenerState **listeners;
|
||||
size_t listener_count;
|
||||
size_t listener_cap;
|
||||
size_t extra_listeners;
|
||||
volatile JanetAtomicInt listener_count; /* used in signal handler, must be volatile */
|
||||
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
|
||||
JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
|
||||
JanetTable signal_handlers;
|
||||
#ifdef JANET_WINDOWS
|
||||
void **iocp;
|
||||
#elif defined(JANET_EV_EPOLL)
|
||||
|
@ -175,6 +175,9 @@ struct JanetVM {
|
|||
int timer;
|
||||
int timer_enabled;
|
||||
#else
|
||||
JanetStream **streams;
|
||||
size_t stream_count;
|
||||
size_t stream_capacity;
|
||||
pthread_attr_t new_thread_attr;
|
||||
JanetHandle selfpipe[2];
|
||||
struct pollfd *fds;
|
||||
|
|
|
@ -175,8 +175,9 @@ JANET_CORE_FN(cfun_string_slice,
|
|||
"Returns a substring from a byte sequence. The substring is from "
|
||||
"index `start` inclusive to index `end`, exclusive. All indexing "
|
||||
"is from 0. `start` and `end` can also be negative to indicate indexing "
|
||||
"from the end of the string. Note that index -1 is synonymous with "
|
||||
"index `(length bytes)` to allow a full negative slice range. ") {
|
||||
"from the end of the string. Note that if `start` is negative it is "
|
||||
"exclusive, and if `end` is negative it is inclusive, to allow a full "
|
||||
"negative slice range.") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
||||
|
@ -548,12 +549,12 @@ JANET_CORE_FN(cfun_string_format,
|
|||
"- `a`, `A`: floating point number, formatted as a hexadecimal number.\n"
|
||||
"- `s`: formatted as a string, precision indicates padding and maximum length.\n"
|
||||
"- `t`: emit the type of the given value.\n"
|
||||
"- `v`: format with (describe x)"
|
||||
"- `V`: format with (string x)"
|
||||
"- `v`: format with (describe x)\n"
|
||||
"- `V`: format with (string x)\n"
|
||||
"- `j`: format to jdn (Janet data notation).\n"
|
||||
"\n"
|
||||
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
|
||||
"variants generate colored output. These speficiers can take a precision "
|
||||
"variants generate colored output. These specifiers can take a precision "
|
||||
"argument to specify the maximum nesting depth to print.\n"
|
||||
"- `p`, `P`: pretty format, truncating if necessary\n"
|
||||
"- `m`, `M`: pretty format without truncating.\n"
|
||||
|
|
|
@ -234,6 +234,7 @@ const uint8_t *janet_symbol_gen(void) {
|
|||
head->hash = hash;
|
||||
sym = (uint8_t *)(head->data);
|
||||
memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
|
||||
sym[head->length] = 0;
|
||||
janet_symcache_put((const uint8_t *)sym, bucket);
|
||||
return (const uint8_t *)sym;
|
||||
}
|
||||
|
|
|
@ -87,11 +87,27 @@ void janet_table_deinit(JanetTable *table) {
|
|||
}
|
||||
|
||||
/* Create a new table */
|
||||
|
||||
JanetTable *janet_table(int32_t capacity) {
|
||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
JanetTable *janet_table_weakk(int32_t capacity) {
|
||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKK, sizeof(JanetTable));
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
JanetTable *janet_table_weakv(int32_t capacity) {
|
||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKV, sizeof(JanetTable));
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
JanetTable *janet_table_weakkv(int32_t capacity) {
|
||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKKV, sizeof(JanetTable));
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
/* Find the bucket that contains the given key. Will also return
|
||||
* bucket where key should go if not in the table. */
|
||||
JanetKV *janet_table_find(JanetTable *t, Janet key) {
|
||||
|
@ -111,12 +127,11 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
|
|||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
int32_t i, oldcapacity;
|
||||
oldcapacity = t->capacity;
|
||||
int32_t oldcapacity = t->capacity;
|
||||
t->data = newdata;
|
||||
t->capacity = size;
|
||||
t->deleted = 0;
|
||||
for (i = 0; i < oldcapacity; i++) {
|
||||
for (int32_t i = 0; i < oldcapacity; i++) {
|
||||
JanetKV *kv = olddata + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
JanetKV *newkv = janet_table_find(t, kv->key);
|
||||
|
@ -298,11 +313,46 @@ JANET_CORE_FN(cfun_table_new,
|
|||
"Creates a new empty table with pre-allocated memory "
|
||||
"for `capacity` entries. This means that if one knows the number of "
|
||||
"entries going into a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table.") {
|
||||
"can be avoided. "
|
||||
"Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getnat(argv, 0);
|
||||
return janet_wrap_table(janet_table(cap));
|
||||
}
|
||||
/*
|
||||
uint32_t flags = janet_getflags(argv, 1, "kv");
|
||||
if (flags == 0) return janet_wrap_table(janet_table(cap));
|
||||
if (flags == 1) return janet_wrap_table(janet_table_weakk(cap));
|
||||
if (flags == 2) return janet_wrap_table(janet_table_weakv(cap));
|
||||
return janet_wrap_table(janet_table_weakkv(cap));
|
||||
*/
|
||||
|
||||
JANET_CORE_FN(cfun_table_weak,
|
||||
"(table/weak capacity)",
|
||||
"Creates a new empty table with weak references to keys and values. Similar to `table/new`. "
|
||||
"Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getnat(argv, 0);
|
||||
return janet_wrap_table(janet_table_weakkv(cap));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_weak_keys,
|
||||
"(table/weak-keys capacity)",
|
||||
"Creates a new empty table with weak references to keys and normal references to values. Similar to `table/new`. "
|
||||
"Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getnat(argv, 0);
|
||||
return janet_wrap_table(janet_table_weakk(cap));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_weak_values,
|
||||
"(table/weak-values capacity)",
|
||||
"Creates a new empty table with normal references to keys and weak references to values. Similar to `table/new`. "
|
||||
"Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getnat(argv, 0);
|
||||
return janet_wrap_table(janet_table_weakv(cap));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_getproto,
|
||||
"(table/getproto tab)",
|
||||
|
@ -377,6 +427,9 @@ JANET_CORE_FN(cfun_table_proto_flatten,
|
|||
void janet_lib_table(JanetTable *env) {
|
||||
JanetRegExt table_cfuns[] = {
|
||||
JANET_CORE_REG("table/new", cfun_table_new),
|
||||
JANET_CORE_REG("table/weak", cfun_table_weak),
|
||||
JANET_CORE_REG("table/weak-keys", cfun_table_weak_keys),
|
||||
JANET_CORE_REG("table/weak-values", cfun_table_weak_values),
|
||||
JANET_CORE_REG("table/to-struct", cfun_table_tostruct),
|
||||
JANET_CORE_REG("table/getproto", cfun_table_getproto),
|
||||
JANET_CORE_REG("table/setproto", cfun_table_setproto),
|
||||
|
|
|
@ -69,9 +69,9 @@ JANET_CORE_FN(cfun_tuple_slice,
|
|||
"inclusive to index `end` exclusive. If `start` or `end` are not provided, "
|
||||
"they default to 0 and the length of `arrtup`, respectively. "
|
||||
"`start` and `end` can also be negative to indicate indexing "
|
||||
"from the end of the input. Note that index -1 is synonymous with "
|
||||
"index `(length arrtup)` to allow a full negative slice range. "
|
||||
"Returns the new tuple.") {
|
||||
"from the end of the input. Note that if `start` is negative it is "
|
||||
"exclusive, and if `end` is negative it is inclusive, to allow a full "
|
||||
"negative slice range. Returns the new tuple.") {
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||
|
|
|
@ -805,6 +805,13 @@ int janet_checkint(Janet x) {
|
|||
return janet_checkintrange(dval);
|
||||
}
|
||||
|
||||
int janet_checkuint(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return janet_checkuintrange(dval);
|
||||
}
|
||||
|
||||
int janet_checkint64(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
|
@ -816,7 +823,7 @@ int janet_checkuint64(Janet x) {
|
|||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
|
||||
return janet_checkuint64range(dval);
|
||||
}
|
||||
|
||||
int janet_checksize(Janet x) {
|
||||
|
@ -953,6 +960,7 @@ void arc4random_buf(void *buf, size_t nbytes);
|
|||
#endif
|
||||
|
||||
int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
#ifndef JANET_NO_CRYPTORAND
|
||||
#ifdef JANET_WINDOWS
|
||||
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
|
||||
unsigned int v;
|
||||
|
@ -964,7 +972,10 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
|||
}
|
||||
}
|
||||
return 0;
|
||||
#elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
arc4random_buf(out, n);
|
||||
return 0;
|
||||
#else
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros.
|
||||
On Mac, arc4random_buf wasn't available on until 10.7.
|
||||
|
@ -986,12 +997,10 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
|||
}
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
return 0;
|
||||
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
arc4random_buf(out, n);
|
||||
return 0;
|
||||
#endif
|
||||
#else
|
||||
(void) n;
|
||||
(void) out;
|
||||
(void) n;
|
||||
return -1;
|
||||
#endif
|
||||
}
|
||||
|
|
|
@ -49,11 +49,11 @@
|
|||
#ifndef JANET_EXIT
|
||||
#include <stdio.h>
|
||||
#define JANET_EXIT(m) do { \
|
||||
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
|
||||
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
exit(1);\
|
||||
abort();\
|
||||
} while (0)
|
||||
#endif
|
||||
|
||||
|
|
|
@ -698,11 +698,16 @@ Janet janet_lengthv(Janet x) {
|
|||
const JanetAbstractType *type = janet_abstract_type(abst);
|
||||
if (type->length != NULL) {
|
||||
size_t len = type->length(abst, janet_abstract_size(abst));
|
||||
if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) {
|
||||
/* If len is always less then double, we can never overflow */
|
||||
#ifdef JANET_32
|
||||
return janet_wrap_number(len);
|
||||
#else
|
||||
if (len < (size_t) JANET_INTMAX_INT64) {
|
||||
return janet_wrap_number((double) len);
|
||||
} else {
|
||||
janet_panicf("integer length %u too large", len);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
Janet argv[1] = { x };
|
||||
return janet_mcall("length", 1, argv);
|
||||
|
|
|
@ -116,7 +116,6 @@
|
|||
#else
|
||||
#define vm_maybe_auto_suspend(COND) do { \
|
||||
if ((COND) && janet_vm.auto_suspend) { \
|
||||
janet_vm.auto_suspend = 0; \
|
||||
fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
|
||||
vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
|
||||
} \
|
||||
|
@ -138,7 +137,7 @@
|
|||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define _vm_bitop_immediate(op, type1)\
|
||||
#define _vm_bitop_immediate(op, type1, rangecheck, msg)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
|
@ -147,13 +146,15 @@
|
|||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
double y1 = janet_unwrap_number(op1);\
|
||||
if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
|
||||
type1 x1 = (type1) y1;\
|
||||
stack[A] = janet_wrap_number((type1) (x1 op CS));\
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t, janet_checkintrange, "32-bit signed integers");
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers");
|
||||
#define _vm_binop(op, wrap)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
|
@ -170,14 +171,18 @@
|
|||
}\
|
||||
}
|
||||
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
||||
#define _vm_bitop(op, type1)\
|
||||
#define _vm_bitop(op, type1, rangecheck, msg)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
double y1 = janet_unwrap_number(op1);\
|
||||
double y2 = janet_unwrap_number(op2);\
|
||||
if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
|
||||
if (!janet_checkintrange(y2)) { vm_commit(); janet_panicf("rhs must be valid 32-bit signed integer, got %f", op2); }\
|
||||
type1 x1 = (type1) y1;\
|
||||
int32_t x2 = (int32_t) y2;\
|
||||
stack[A] = janet_wrap_number((type1) (x1 op x2));\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
|
@ -185,8 +190,8 @@
|
|||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t, janet_checkintrange, "32-bit signed integers")
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers")
|
||||
#define vm_compop(op) \
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
|
@ -295,6 +300,16 @@ static Janet janet_method_lookup(Janet x, const char *name) {
|
|||
return method_to_fun(janet_ckeywordv(name), x);
|
||||
}
|
||||
|
||||
static Janet janet_unary_call(const char *method, Janet arg) {
|
||||
Janet m = janet_method_lookup(arg, method);
|
||||
if (janet_checktype(m, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v", method, arg);
|
||||
} else {
|
||||
Janet argv[1] = { arg };
|
||||
return janet_method_invoke(m, 1, argv);
|
||||
}
|
||||
}
|
||||
|
||||
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
|
||||
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
|
||||
Janet lm = janet_method_lookup(lhs, lmethod);
|
||||
|
@ -331,11 +346,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
&&label_JOP_RETURN_NIL,
|
||||
&&label_JOP_ADD_IMMEDIATE,
|
||||
&&label_JOP_ADD,
|
||||
&&label_JOP_SUBTRACT_IMMEDIATE,
|
||||
&&label_JOP_SUBTRACT,
|
||||
&&label_JOP_MULTIPLY_IMMEDIATE,
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_DIVIDE_FLOOR,
|
||||
&&label_JOP_MODULO,
|
||||
&&label_JOP_REMAINDER,
|
||||
&&label_JOP_BAND,
|
||||
|
@ -576,8 +593,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#endif
|
||||
|
@ -667,6 +682,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
VM_OP(JOP_ADD)
|
||||
vm_binop(+);
|
||||
|
||||
VM_OP(JOP_SUBTRACT_IMMEDIATE)
|
||||
vm_binop_immediate(-);
|
||||
|
||||
VM_OP(JOP_SUBTRACT)
|
||||
vm_binop(-);
|
||||
|
||||
|
@ -682,14 +700,33 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
VM_OP(JOP_DIVIDE)
|
||||
vm_binop( /);
|
||||
|
||||
VM_OP(JOP_DIVIDE_FLOOR) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
stack[A] = janet_wrap_number(floor(x1 / x2));
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_binop_call("div", "rdiv", op1, op2);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_MODULO) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
double intres = x2 * floor(x1 / x2);
|
||||
stack[A] = janet_wrap_number(x1 - intres);
|
||||
if (x2 == 0) {
|
||||
stack[A] = janet_wrap_number(x1);
|
||||
} else {
|
||||
double intres = x2 * floor(x1 / x2);
|
||||
stack[A] = janet_wrap_number(x1 - intres);
|
||||
}
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
|
@ -724,9 +761,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
|
||||
VM_OP(JOP_BNOT) {
|
||||
Janet op = stack[E];
|
||||
vm_assert_type(op, JANET_NUMBER);
|
||||
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
||||
vm_pcnext();
|
||||
if (janet_checktype(op, JANET_NUMBER)) {
|
||||
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_unary_call("~", op);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
|
||||
|
@ -757,13 +799,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
|
||||
VM_OP(JOP_JUMP)
|
||||
pc += DS;
|
||||
vm_maybe_auto_suspend(DS < 0);
|
||||
vm_maybe_auto_suspend(DS <= 0);
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF)
|
||||
if (janet_truthy(stack[A])) {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
|
@ -774,14 +816,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
|
@ -792,7 +834,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
}
|
||||
vm_next();
|
||||
|
||||
|
@ -819,7 +861,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
|
||||
stack[A] = janet_wrap_boolean(janet_checktype(stack[B], JANET_NUMBER) && (janet_unwrap_number(stack[B]) == (double) CS));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS)
|
||||
|
@ -827,7 +869,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
|
||||
stack[A] = janet_wrap_boolean(!janet_checktype(stack[B], JANET_NUMBER) || (janet_unwrap_number(stack[B]) != (double) CS));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_COMPARE)
|
||||
|
@ -980,7 +1022,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
|
||||
}
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
vm_commit();
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
janet_panicf("%v called with %d argument%s, expected %d",
|
||||
|
@ -1543,9 +1585,11 @@ int janet_init(void) {
|
|||
|
||||
/* Garbage collection */
|
||||
janet_vm.blocks = NULL;
|
||||
janet_vm.weak_blocks = NULL;
|
||||
janet_vm.next_collection = 0;
|
||||
janet_vm.gc_interval = 0x400000;
|
||||
janet_vm.block_count = 0;
|
||||
janet_vm.gc_mark_phase = 0;
|
||||
|
||||
janet_symcache_init();
|
||||
|
||||
|
|
|
@ -43,10 +43,10 @@ int (janet_truthy)(Janet x) {
|
|||
return janet_truthy(x);
|
||||
}
|
||||
|
||||
const JanetKV *(janet_unwrap_struct)(Janet x) {
|
||||
JanetStruct(janet_unwrap_struct)(Janet x) {
|
||||
return janet_unwrap_struct(x);
|
||||
}
|
||||
const Janet *(janet_unwrap_tuple)(Janet x) {
|
||||
JanetTuple(janet_unwrap_tuple)(Janet x) {
|
||||
return janet_unwrap_tuple(x);
|
||||
}
|
||||
JanetFiber *(janet_unwrap_fiber)(Janet x) {
|
||||
|
@ -61,16 +61,16 @@ JanetTable *(janet_unwrap_table)(Janet x) {
|
|||
JanetBuffer *(janet_unwrap_buffer)(Janet x) {
|
||||
return janet_unwrap_buffer(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_string)(Janet x) {
|
||||
JanetString(janet_unwrap_string)(Janet x) {
|
||||
return janet_unwrap_string(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_symbol)(Janet x) {
|
||||
JanetSymbol(janet_unwrap_symbol)(Janet x) {
|
||||
return janet_unwrap_symbol(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_keyword)(Janet x) {
|
||||
JanetKeyword(janet_unwrap_keyword)(Janet x) {
|
||||
return janet_unwrap_keyword(x);
|
||||
}
|
||||
void *(janet_unwrap_abstract)(Janet x) {
|
||||
JanetAbstract(janet_unwrap_abstract)(Janet x) {
|
||||
return janet_unwrap_abstract(x);
|
||||
}
|
||||
void *(janet_unwrap_pointer)(Janet x) {
|
||||
|
@ -102,22 +102,22 @@ Janet(janet_wrap_false)(void) {
|
|||
Janet(janet_wrap_boolean)(int x) {
|
||||
return janet_wrap_boolean(x);
|
||||
}
|
||||
Janet(janet_wrap_string)(const uint8_t *x) {
|
||||
Janet(janet_wrap_string)(JanetString x) {
|
||||
return janet_wrap_string(x);
|
||||
}
|
||||
Janet(janet_wrap_symbol)(const uint8_t *x) {
|
||||
Janet(janet_wrap_symbol)(JanetSymbol x) {
|
||||
return janet_wrap_symbol(x);
|
||||
}
|
||||
Janet(janet_wrap_keyword)(const uint8_t *x) {
|
||||
Janet(janet_wrap_keyword)(JanetKeyword x) {
|
||||
return janet_wrap_keyword(x);
|
||||
}
|
||||
Janet(janet_wrap_array)(JanetArray *x) {
|
||||
return janet_wrap_array(x);
|
||||
}
|
||||
Janet(janet_wrap_tuple)(const Janet *x) {
|
||||
Janet(janet_wrap_tuple)(JanetTuple x) {
|
||||
return janet_wrap_tuple(x);
|
||||
}
|
||||
Janet(janet_wrap_struct)(const JanetKV *x) {
|
||||
Janet(janet_wrap_struct)(JanetStruct x) {
|
||||
return janet_wrap_struct(x);
|
||||
}
|
||||
Janet(janet_wrap_fiber)(JanetFiber *x) {
|
||||
|
@ -135,7 +135,7 @@ Janet(janet_wrap_cfunction)(JanetCFunction x) {
|
|||
Janet(janet_wrap_table)(JanetTable *x) {
|
||||
return janet_wrap_table(x);
|
||||
}
|
||||
Janet(janet_wrap_abstract)(void *x) {
|
||||
Janet(janet_wrap_abstract)(JanetAbstract x) {
|
||||
return janet_wrap_abstract(x);
|
||||
}
|
||||
Janet(janet_wrap_pointer)(void *x) {
|
||||
|
@ -317,4 +317,3 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
|
|||
#undef JANET_WRAP_DEFINE
|
||||
|
||||
#endif
|
||||
|
||||
|
|
|
@ -112,7 +112,8 @@ extern "C" {
|
|||
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|
||||
|| (defined(__ppc64__) || defined(__PPC64__)) \
|
||||
|| defined(__aarch64__) /* ARM 64-bit */ \
|
||||
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
|
||||
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */ \
|
||||
|| defined(__loongarch64) /* LoongArch64 64-bit */
|
||||
#define JANET_64 1
|
||||
#else
|
||||
#define JANET_32 1
|
||||
|
@ -234,10 +235,28 @@ extern "C" {
|
|||
#define JANET_EV_KQUEUE
|
||||
#endif
|
||||
|
||||
/* Use poll as last resort */
|
||||
#if !defined(JANET_WINDOWS) && !defined(JANET_EV_EPOLL) && !defined(JANET_EV_KQUEUE)
|
||||
#define JANET_EV_POLL
|
||||
#endif
|
||||
|
||||
/* How to export symbols */
|
||||
#ifndef JANET_EXPORT
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JANET_EXPORT __declspec(dllexport)
|
||||
#else
|
||||
#define JANET_EXPORT __attribute__((visibility ("default")))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* How declare API functions */
|
||||
#ifndef JANET_API
|
||||
#ifdef JANET_WINDOWS
|
||||
#ifdef JANET_DLL_IMPORT
|
||||
#define JANET_API __declspec(dllimport)
|
||||
#else
|
||||
#define JANET_API __declspec(dllexport)
|
||||
#endif
|
||||
#else
|
||||
#define JANET_API __attribute__((visibility ("default")))
|
||||
#endif
|
||||
|
@ -393,12 +412,11 @@ typedef enum {
|
|||
JANET_SIGNAL_USER6,
|
||||
JANET_SIGNAL_USER7,
|
||||
JANET_SIGNAL_USER8,
|
||||
JANET_SIGNAL_USER9
|
||||
JANET_SIGNAL_USER9,
|
||||
JANET_SIGNAL_INTERRUPT = JANET_SIGNAL_USER8,
|
||||
JANET_SIGNAL_EVENT = JANET_SIGNAL_USER9,
|
||||
} JanetSignal;
|
||||
|
||||
#define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
|
||||
#define JANET_SIGNAL_INTERRUPT JANET_SIGNAL_USER8
|
||||
|
||||
/* Fiber statuses - mostly corresponds to signals. */
|
||||
typedef enum {
|
||||
JANET_STATUS_DEAD,
|
||||
|
@ -562,7 +580,7 @@ typedef void *JanetAbstract;
|
|||
|
||||
#define JANET_STREAM_CLOSED 0x1
|
||||
#define JANET_STREAM_SOCKET 0x2
|
||||
#define JANET_STREAM_IOCP 0x4
|
||||
#define JANET_STREAM_UNREGISTERED 0x4
|
||||
#define JANET_STREAM_READABLE 0x200
|
||||
#define JANET_STREAM_WRITABLE 0x400
|
||||
#define JANET_STREAM_ACCEPTABLE 0x800
|
||||
|
@ -570,62 +588,73 @@ typedef void *JanetAbstract;
|
|||
#define JANET_STREAM_TOCLOSE 0x10000
|
||||
|
||||
typedef enum {
|
||||
JANET_ASYNC_EVENT_INIT,
|
||||
JANET_ASYNC_EVENT_MARK,
|
||||
JANET_ASYNC_EVENT_DEINIT,
|
||||
JANET_ASYNC_EVENT_CLOSE,
|
||||
JANET_ASYNC_EVENT_ERR,
|
||||
JANET_ASYNC_EVENT_HUP,
|
||||
JANET_ASYNC_EVENT_READ,
|
||||
JANET_ASYNC_EVENT_WRITE,
|
||||
JANET_ASYNC_EVENT_CANCEL,
|
||||
JANET_ASYNC_EVENT_COMPLETE, /* Used on windows for IOCP */
|
||||
JANET_ASYNC_EVENT_USER
|
||||
JANET_ASYNC_EVENT_INIT = 0,
|
||||
JANET_ASYNC_EVENT_MARK = 1,
|
||||
JANET_ASYNC_EVENT_DEINIT = 2,
|
||||
JANET_ASYNC_EVENT_CLOSE = 3,
|
||||
JANET_ASYNC_EVENT_ERR = 4,
|
||||
JANET_ASYNC_EVENT_HUP = 5,
|
||||
JANET_ASYNC_EVENT_READ = 6,
|
||||
JANET_ASYNC_EVENT_WRITE = 7,
|
||||
JANET_ASYNC_EVENT_COMPLETE = 8, /* Used on windows for IOCP */
|
||||
JANET_ASYNC_EVENT_FAILED = 9 /* Used on windows for IOCP */
|
||||
} JanetAsyncEvent;
|
||||
|
||||
#define JANET_ASYNC_LISTEN_READ (1 << JANET_ASYNC_EVENT_READ)
|
||||
#define JANET_ASYNC_LISTEN_WRITE (1 << JANET_ASYNC_EVENT_WRITE)
|
||||
|
||||
typedef enum {
|
||||
JANET_ASYNC_STATUS_NOT_DONE,
|
||||
JANET_ASYNC_STATUS_DONE
|
||||
} JanetAsyncStatus;
|
||||
JANET_ASYNC_LISTEN_READ = 1,
|
||||
JANET_ASYNC_LISTEN_WRITE,
|
||||
JANET_ASYNC_LISTEN_BOTH
|
||||
} JanetAsyncMode;
|
||||
|
||||
/* Typedefs */
|
||||
typedef struct JanetListenerState JanetListenerState;
|
||||
typedef struct JanetStream JanetStream;
|
||||
typedef JanetAsyncStatus(*JanetListener)(JanetListenerState *state, JanetAsyncEvent event);
|
||||
|
||||
/* Wrapper around file descriptors and HANDLEs that can be polled. */
|
||||
struct JanetStream {
|
||||
JanetHandle handle;
|
||||
uint32_t flags;
|
||||
/* Linked list of all in-flight IO routines for this stream */
|
||||
JanetListenerState *state;
|
||||
uint32_t index;
|
||||
JanetFiber *read_fiber;
|
||||
JanetFiber *write_fiber;
|
||||
const void *methods; /* Methods for this stream */
|
||||
/* internal - used to disallow multiple concurrent reads / writes on the same stream.
|
||||
* this constraint may be lifted later but allowing such would require more internal book keeping
|
||||
* for some implementations. You can read and write at the same time on the same stream, though. */
|
||||
int _mask;
|
||||
};
|
||||
|
||||
/* Interface for state machine based event loop */
|
||||
struct JanetListenerState {
|
||||
JanetListener machine;
|
||||
JanetFiber *fiber;
|
||||
JanetStream *stream;
|
||||
void *event; /* Used to pass data from asynchronous IO event. Contents depend on both
|
||||
implementation of the event loop and the particular event. */
|
||||
typedef void (*JanetEVCallback)(JanetFiber *fiber, JanetAsyncEvent event);
|
||||
|
||||
/* Start listening for events from a stream on the current root fiber. After
|
||||
* calling this, users should call janet_await() before returning from the
|
||||
* current C Function. This also will call janet_await.
|
||||
* mode is which events to listen for, and callback is the function pointer to
|
||||
* call when ever an event is sent from the event loop. state is an optional (can be NULL)
|
||||
* pointer to data allocated with janet_malloc. This pointer will be passed to callback as
|
||||
* fiber->ev_state. It will also be freed for you by the runtime when the event loop determines
|
||||
* it can no longer be referenced. On windows, the contents of state MUST contained an OVERLAPPED struct. */
|
||||
JANET_API JANET_NO_RETURN void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
|
||||
|
||||
/* Do not send any more events to the given callback. Call this after scheduling fiber to be resume
|
||||
* or canceled. */
|
||||
JANET_API void janet_async_end(JanetFiber *fiber);
|
||||
|
||||
/* Needed for windows to mark a fiber as waiting for an IOCP completion event. Noop on other platforms. */
|
||||
JANET_API void janet_async_in_flight(JanetFiber *fiber);
|
||||
|
||||
/* On some platforms, it is important to be able to control if a stream is edge-trigger or level triggered.
|
||||
* For example, a server that is accepting connections might want to be level triggered or edge-triggered
|
||||
* depending on expected service. */
|
||||
JANET_API void janet_stream_edge_triggered(JanetStream *stream);
|
||||
JANET_API void janet_stream_level_triggered(JanetStream *stream);
|
||||
|
||||
#endif
|
||||
|
||||
/* Janet uses atomic integers in several places for synchronization between threads and
|
||||
* signals. Define them here */
|
||||
#ifdef JANET_WINDOWS
|
||||
void *tag; /* Used to associate listeners with an overlapped structure */
|
||||
int bytes; /* Used to track how many bytes were transfered. */
|
||||
#endif
|
||||
/* internal */
|
||||
size_t _index;
|
||||
int _mask;
|
||||
JanetListenerState *_next;
|
||||
};
|
||||
typedef long JanetAtomicInt;
|
||||
#else
|
||||
typedef int32_t JanetAtomicInt;
|
||||
#endif
|
||||
JANET_API JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x);
|
||||
JANET_API JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x);
|
||||
JANET_API JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x);
|
||||
|
||||
/* We provide three possible implementations of Janets. The preferred
|
||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||
|
@ -653,10 +682,10 @@ struct JanetListenerState {
|
|||
* external bindings, we should prefer using the Head structs directly, and
|
||||
* use the host language to add sugar around the manipulation of the Janet types. */
|
||||
|
||||
JANET_API JanetStructHead *janet_struct_head(const JanetKV *st);
|
||||
JANET_API JanetStructHead *janet_struct_head(JanetStruct st);
|
||||
JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract);
|
||||
JANET_API JanetStringHead *janet_string_head(const uint8_t *s);
|
||||
JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple);
|
||||
JANET_API JanetStringHead *janet_string_head(JanetString s);
|
||||
JANET_API JanetTupleHead *janet_tuple_head(JanetTuple tuple);
|
||||
|
||||
/* Some language bindings won't have access to the macro versions. */
|
||||
|
||||
|
@ -665,16 +694,16 @@ JANET_API int janet_checktype(Janet x, JanetType type);
|
|||
JANET_API int janet_checktypes(Janet x, int typeflags);
|
||||
JANET_API int janet_truthy(Janet x);
|
||||
|
||||
JANET_API const JanetKV *janet_unwrap_struct(Janet x);
|
||||
JANET_API const Janet *janet_unwrap_tuple(Janet x);
|
||||
JANET_API JanetStruct janet_unwrap_struct(Janet x);
|
||||
JANET_API JanetTuple janet_unwrap_tuple(Janet x);
|
||||
JANET_API JanetFiber *janet_unwrap_fiber(Janet x);
|
||||
JANET_API JanetArray *janet_unwrap_array(Janet x);
|
||||
JANET_API JanetTable *janet_unwrap_table(Janet x);
|
||||
JANET_API JanetBuffer *janet_unwrap_buffer(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_string(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_symbol(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_keyword(Janet x);
|
||||
JANET_API void *janet_unwrap_abstract(Janet x);
|
||||
JANET_API JanetString janet_unwrap_string(Janet x);
|
||||
JANET_API JanetSymbol janet_unwrap_symbol(Janet x);
|
||||
JANET_API JanetKeyword janet_unwrap_keyword(Janet x);
|
||||
JANET_API JanetAbstract janet_unwrap_abstract(Janet x);
|
||||
JANET_API void *janet_unwrap_pointer(Janet x);
|
||||
JANET_API JanetFunction *janet_unwrap_function(Janet x);
|
||||
JANET_API JanetCFunction janet_unwrap_cfunction(Janet x);
|
||||
|
@ -687,18 +716,18 @@ JANET_API Janet janet_wrap_number(double x);
|
|||
JANET_API Janet janet_wrap_true(void);
|
||||
JANET_API Janet janet_wrap_false(void);
|
||||
JANET_API Janet janet_wrap_boolean(int x);
|
||||
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_string(JanetString x);
|
||||
JANET_API Janet janet_wrap_symbol(JanetSymbol x);
|
||||
JANET_API Janet janet_wrap_keyword(JanetKeyword x);
|
||||
JANET_API Janet janet_wrap_array(JanetArray *x);
|
||||
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
||||
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
||||
JANET_API Janet janet_wrap_tuple(JanetTuple x);
|
||||
JANET_API Janet janet_wrap_struct(JanetStruct x);
|
||||
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
|
||||
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
|
||||
JANET_API Janet janet_wrap_function(JanetFunction *x);
|
||||
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
||||
JANET_API Janet janet_wrap_table(JanetTable *x);
|
||||
JANET_API Janet janet_wrap_abstract(void *x);
|
||||
JANET_API Janet janet_wrap_abstract(JanetAbstract x);
|
||||
JANET_API Janet janet_wrap_pointer(void *x);
|
||||
JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
|
||||
|
@ -730,6 +759,7 @@ JANET_API Janet janet_wrap_integer(int32_t x);
|
|||
? janet_nanbox_isnumber(x) \
|
||||
: janet_nanbox_checkauxtype((x), (t)))
|
||||
|
||||
/* Use JANET_API so that modules will use a local version of these functions if possible */
|
||||
JANET_API void *janet_nanbox_to_pointer(Janet x);
|
||||
JANET_API Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask);
|
||||
JANET_API Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask);
|
||||
|
@ -776,14 +806,14 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
|||
#define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER)
|
||||
|
||||
/* Unwrap the pointer types */
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_struct(x) ((JanetStruct)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_tuple(x) ((JanetTuple)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_fiber(x) ((JanetFiber *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_array(x) ((JanetArray *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_table(x) ((JanetTable *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_string(x) ((JanetString)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_symbol(x) ((JanetSymbol)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_abstract(x) (janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_pointer(x) (janet_nanbox_to_pointer(x))
|
||||
|
@ -825,15 +855,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
|||
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
|
||||
#define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s))
|
||||
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_struct(x) ((JanetStruct)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_tuple(x) ((JanetTuple)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_array(x) ((JanetArray *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_table(x) ((JanetTable *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_string(x) ((JanetString)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_abstract(x) ((x).tagged.payload.pointer)
|
||||
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
||||
|
@ -848,15 +878,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
|||
#define janet_truthy(x) \
|
||||
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
|
||||
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
|
||||
#define janet_unwrap_struct(x) ((JanetStruct)(x).as.pointer)
|
||||
#define janet_unwrap_tuple(x) ((JanetTuple)(x).as.pointer)
|
||||
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).as.pointer)
|
||||
#define janet_unwrap_array(x) ((JanetArray *)(x).as.pointer)
|
||||
#define janet_unwrap_table(x) ((JanetTable *)(x).as.pointer)
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).as.pointer)
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_string(x) ((JanetString)(x).as.pointer)
|
||||
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).as.pointer)
|
||||
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).as.pointer)
|
||||
#define janet_unwrap_abstract(x) ((x).as.pointer)
|
||||
#define janet_unwrap_pointer(x) ((x).as.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
|
||||
|
@ -868,12 +898,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
|||
#endif
|
||||
|
||||
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_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))
|
||||
#define janet_checkuint64range(x) ((x) >= 0 && (x) <= JANET_INTMAX_DOUBLE && (x) == (uint64_t)(x))
|
||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
||||
|
||||
|
@ -886,7 +919,7 @@ struct JanetGCObject {
|
|||
int32_t flags;
|
||||
union {
|
||||
JanetGCObject *next;
|
||||
int32_t refcount; /* For threaded abstract types */
|
||||
volatile JanetAtomicInt refcount; /* For threaded abstract types */
|
||||
} data;
|
||||
};
|
||||
|
||||
|
@ -909,8 +942,10 @@ struct JanetFiber {
|
|||
* that is, fibers that are scheduled on the event loop and behave much like threads
|
||||
* in a multi-tasking system. It would be possible to move these fields to a new
|
||||
* type, say "JanetTask", that as separate from fibers to save a bit of space. */
|
||||
JanetListenerState *waiting;
|
||||
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
|
||||
JanetEVCallback ev_callback; /* Call this before starting scheduled fibers */
|
||||
JanetStream *ev_stream; /* which stream we are waiting on */
|
||||
void *ev_state; /* Extra data for ev callback state. On windows, first element must be OVERLAPPED. */
|
||||
void *supervisor_channel; /* Channel to push self to when complete */
|
||||
#endif
|
||||
};
|
||||
|
@ -1259,11 +1294,13 @@ enum JanetOpCode {
|
|||
JOP_RETURN_NIL,
|
||||
JOP_ADD_IMMEDIATE,
|
||||
JOP_ADD,
|
||||
JOP_SUBTRACT_IMMEDIATE,
|
||||
JOP_SUBTRACT,
|
||||
JOP_MULTIPLY_IMMEDIATE,
|
||||
JOP_MULTIPLY,
|
||||
JOP_DIVIDE_IMMEDIATE,
|
||||
JOP_DIVIDE,
|
||||
JOP_DIVIDE_FLOOR,
|
||||
JOP_MODULO,
|
||||
JOP_REMAINDER,
|
||||
JOP_BAND,
|
||||
|
@ -1383,9 +1420,7 @@ JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags);
|
|||
JANET_API void janet_schedule(JanetFiber *fiber, Janet value);
|
||||
JANET_API void janet_cancel(JanetFiber *fiber, Janet value);
|
||||
JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig);
|
||||
|
||||
/* Start a state machine listening for events from a stream */
|
||||
JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user);
|
||||
JANET_API void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig);
|
||||
|
||||
/* Shorthand for yielding to event loop in C */
|
||||
JANET_NO_RETURN JANET_API void janet_await(void);
|
||||
|
@ -1473,23 +1508,22 @@ JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGeneric
|
|||
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
|
||||
|
||||
/* Read async from a stream */
|
||||
JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
#ifdef JANET_NET
|
||||
JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_API void janet_ev_connect(JanetStream *stream, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
#endif
|
||||
|
||||
/* Write async to a stream */
|
||||
JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
|
||||
JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
|
||||
#ifdef JANET_NET
|
||||
JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
|
||||
JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
|
||||
JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
|
||||
JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
@ -1578,6 +1612,7 @@ JANET_API double janet_rng_double(JanetRNG *rng);
|
|||
|
||||
/* Array functions */
|
||||
JANET_API JanetArray *janet_array(int32_t capacity);
|
||||
JANET_API JanetArray *janet_array_weak(int32_t capacity);
|
||||
JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n);
|
||||
JANET_API void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth);
|
||||
JANET_API void janet_array_setcount(JanetArray *array, int32_t count);
|
||||
|
@ -1607,7 +1642,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
|||
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
|
||||
|
||||
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_from_head(gcobject) ((JanetTuple)((char *)gcobject + offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
|
||||
|
@ -1653,7 +1688,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
|
|||
|
||||
/* Structs */
|
||||
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_from_head(t) ((JanetStruct)((char *)gcobject + offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_length(t) (janet_struct_head(t)->length)
|
||||
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
|
||||
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
|
||||
|
@ -1794,6 +1829,7 @@ JANET_API void janet_vm_free(JanetVM *vm);
|
|||
JANET_API void janet_vm_save(JanetVM *into);
|
||||
JANET_API void janet_vm_load(JanetVM *from);
|
||||
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
|
||||
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
|
||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
|
||||
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||
|
@ -1817,6 +1853,7 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
|
|||
#define JANET_SANDBOX_FS_TEMP 1024
|
||||
#define JANET_SANDBOX_FFI_USE 2048
|
||||
#define JANET_SANDBOX_FFI_JIT 4096
|
||||
#define JANET_SANDBOX_SIGNAL 8192
|
||||
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
|
||||
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
|
||||
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
|
||||
|
@ -1940,10 +1977,10 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
|||
#endif
|
||||
#ifndef JANET_ENTRY_NAME
|
||||
#define JANET_MODULE_ENTRY \
|
||||
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||
JANET_MODULE_PREFIX JANET_EXPORT JanetBuildConfig _janet_mod_config(void) { \
|
||||
return janet_config_current(); \
|
||||
} \
|
||||
JANET_MODULE_PREFIX JANET_API void _janet_init
|
||||
JANET_MODULE_PREFIX JANET_EXPORT void _janet_init
|
||||
#else
|
||||
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
|
||||
#endif
|
||||
|
@ -1992,6 +2029,8 @@ JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
|
|||
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
|
||||
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
|
||||
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
JANET_API int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
|
||||
JANET_API int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
|
||||
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
|
||||
|
||||
|
@ -2050,6 +2089,7 @@ JANET_API int janet_cryptorand(uint8_t *out, size_t n);
|
|||
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
|
||||
JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
|
||||
JANET_API void janet_marshal_ptr(JanetMarshalContext *ctx, const void *value);
|
||||
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
|
||||
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
|
||||
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
|
||||
|
@ -2059,10 +2099,12 @@ JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size);
|
|||
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
|
||||
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
|
||||
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
|
||||
JANET_API void *janet_unmarshal_ptr(JanetMarshalContext *ctx);
|
||||
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
|
||||
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
|
||||
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
|
||||
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
|
||||
JANET_API JanetAbstract janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size);
|
||||
JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
|
||||
|
||||
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
|
||||
|
@ -2105,7 +2147,9 @@ typedef enum {
|
|||
RULE_LINE, /* [tag] */
|
||||
RULE_COLUMN, /* [tag] */
|
||||
RULE_UNREF, /* [rule, tag] */
|
||||
RULE_CAPTURE_NUM /* [rule, tag] */
|
||||
RULE_CAPTURE_NUM, /* [rule, tag] */
|
||||
RULE_SUB, /* [rule, rule] */
|
||||
RULE_SPLIT /* [rule, rule] */
|
||||
} JanetPegOpcod;
|
||||
|
||||
typedef struct {
|
||||
|
|
|
@ -502,10 +502,10 @@ static void kright(void) {
|
|||
}
|
||||
|
||||
static void krightw(void) {
|
||||
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
refresh();
|
||||
|
|
|
@ -19,7 +19,7 @@
|
|||
(frame :source) (frame :source-line)))
|
||||
(if x
|
||||
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
|
||||
(eprintf "\e[31m✘\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)))
|
||||
x)
|
||||
|
||||
(defmacro assert-error
|
||||
|
@ -34,17 +34,17 @@
|
|||
|
||||
(defmacro assert-no-error
|
||||
[msg & forms]
|
||||
(def errsym (keyword (gensym)))
|
||||
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
(def e (gensym))
|
||||
(def f (gensym))
|
||||
(if is-verbose
|
||||
~(try (do ,;forms (,assert true ,msg)) ([,e ,f] (,assert false ,msg) (,debug/stacktrace ,f ,e "\e[31m✘\e[0m ")))
|
||||
~(try (do ,;forms (,assert true ,msg)) ([_] (,assert false ,msg)))))
|
||||
|
||||
(defn start-suite [&opt x]
|
||||
(default x (dyn :current-file))
|
||||
(set suite-name
|
||||
(cond
|
||||
(number? x) (string x)
|
||||
(string? x) (string/slice x
|
||||
(length "test/suite-")
|
||||
(- (inc (length ".janet"))))
|
||||
(string x)))
|
||||
(set start-time (os/clock))
|
||||
(eprint "Starting suite " suite-name "..."))
|
||||
|
|
|
@ -44,7 +44,7 @@
|
|||
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] -3 200) @[1 2 3]) "array/remove 4")
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4")
|
||||
|
||||
|
||||
# array/peek
|
||||
|
|
|
@ -51,5 +51,13 @@
|
|||
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
|
||||
(assert (= ((f 10) 37) 47) "asm environment tables")
|
||||
|
||||
# issue #1424
|
||||
(assert-no-error "arity > used slots (issue #1424)"
|
||||
(asm
|
||||
(disasm
|
||||
(fn []
|
||||
(def foo (fn [one two] one))
|
||||
(foo 100 200)))))
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
|
|
@ -113,13 +113,22 @@
|
|||
# 7478ad11
|
||||
(assert (= nil (any? [])) "any? 1")
|
||||
(assert (= nil (any? [false nil])) "any? 2")
|
||||
(assert (= nil (any? [nil false])) "any? 3")
|
||||
(assert (= false (any? [nil false])) "any? 3")
|
||||
(assert (= 1 (any? [1])) "any? 4")
|
||||
(assert (nan? (any? [nil math/nan nil])) "any? 5")
|
||||
(assert (= true
|
||||
(any? [nil nil false nil nil true nil nil nil nil false :a nil]))
|
||||
"any? 6")
|
||||
|
||||
(assert (= true (every? [])) "every? 1")
|
||||
(assert (= true (every? [1 true])) "every? 2")
|
||||
(assert (= 1 (every? [true 1])) "every? 3")
|
||||
(assert (= nil (every? [nil])) "every? 4")
|
||||
(assert (= 2 (every? [1 math/nan 2])) "every? 5")
|
||||
(assert (= false
|
||||
(every? [1 1 true 1 1 false 1 1 1 1 true :a nil]))
|
||||
"every? 6")
|
||||
|
||||
# Some higher order functions and macros
|
||||
# 5e2de33
|
||||
(def my-array @[1 2 3 4 5 6])
|
||||
|
@ -177,6 +186,11 @@
|
|||
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]])
|
||||
"nested seq")
|
||||
|
||||
# :unless modifier
|
||||
(assert (deep= (seq [i :range [0 10] :unless (odd? i)] i)
|
||||
@[0 2 4 6 8])
|
||||
":unless modifier")
|
||||
|
||||
# 515891b03
|
||||
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
|
||||
@{0 0 1 3 2 6}))
|
||||
|
@ -195,6 +209,12 @@
|
|||
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x))
|
||||
"loop :down-to")
|
||||
|
||||
# one-term :range forms
|
||||
(assert (deep= (seq [x :range [10]] x) (seq [x :range [0 10]] x))
|
||||
"one-term :range")
|
||||
(assert (deep= (seq [x :down [10]] x) (seq [x :down [10 0]] x))
|
||||
"one-term :down")
|
||||
|
||||
# 7880d7320
|
||||
(def res @{})
|
||||
(loop [[k v] :pairs @{1 2 3 4 5 6}]
|
||||
|
@ -221,6 +241,16 @@
|
|||
(assert (pos? (% x 4)) "generate in loop"))
|
||||
(assert (= gencount 75) "generate loop count")
|
||||
|
||||
# more loop checks
|
||||
(assert (deep= (seq [i :range [0 10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 1")
|
||||
(assert (deep= (seq [i :range [0 10 2]] i) @[0 2 4 6 8]) "seq 2")
|
||||
(assert (deep= (seq [i :range [10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 3")
|
||||
(assert (deep= (seq [i :range-to [10]] i) @[0 1 2 3 4 5 6 7 8 9 10]) "seq 4")
|
||||
(def gen (generate [x :range-to [0 nil 2]] x))
|
||||
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit")
|
||||
(def gen (generate [x :range [0 nil 2]] x))
|
||||
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit 2")
|
||||
|
||||
# Even and odd
|
||||
# ff163a5ae
|
||||
(assert (odd? 9) "odd? 1")
|
||||
|
@ -334,6 +364,13 @@
|
|||
"sort 5")
|
||||
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
|
||||
|
||||
# #1283
|
||||
(assert (deep=
|
||||
(partition 2 (generate [ i :in [:a :b :c :d :e]] i))
|
||||
'@[(:a :b) (:c :d) (:e)]))
|
||||
(assert (= (mean (generate [i :in [2 3 5 7 11]] i))
|
||||
5.6))
|
||||
|
||||
# And and or
|
||||
# c16a9d846
|
||||
(assert (= (and true true) true) "and true true")
|
||||
|
@ -362,14 +399,7 @@
|
|||
(assert (= false (and false false)) "and 1")
|
||||
(assert (= false (or false false)) "or 1")
|
||||
|
||||
# Range
|
||||
# a982f351d
|
||||
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument")
|
||||
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
|
||||
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
|
||||
# 11cd1279d
|
||||
(assert (= (length (range 10)) 10) "(range 10)")
|
||||
(assert (= (length (range 1 10)) 9) "(range 1 10)")
|
||||
(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
|
||||
|
||||
# bc8be266f
|
||||
|
@ -904,4 +934,49 @@
|
|||
[:strict 3 4 "bar-oops"]])
|
||||
"maclintf 2")
|
||||
|
||||
# Bad bytecode wrt. using result from break expression
|
||||
(defn bytecode-roundtrip
|
||||
[f]
|
||||
(assert-no-error "bytecode round-trip" (unmarshal (marshal f make-image-dict))))
|
||||
|
||||
(defn case-1 [&] (def x (break 1)))
|
||||
(bytecode-roundtrip case-1)
|
||||
(defn foo [&])
|
||||
(defn case-2 [&]
|
||||
(foo (break (foo)))
|
||||
(foo))
|
||||
(bytecode-roundtrip case-2)
|
||||
(defn case-3 [&]
|
||||
(def x (break (do (foo)))))
|
||||
(bytecode-roundtrip case-3)
|
||||
(defn case-4 [&]
|
||||
(def x (break (break (foo)))))
|
||||
(bytecode-roundtrip case-4)
|
||||
(defn case-4 [&]
|
||||
(def x (break (break (break)))))
|
||||
(bytecode-roundtrip case-4)
|
||||
(defn case-5 []
|
||||
(def foo (fn [one two] one))
|
||||
(foo 100 200))
|
||||
(bytecode-roundtrip case-5)
|
||||
|
||||
# Debug bytecode of these functions
|
||||
# (pp (disasm case-1))
|
||||
# (pp (disasm case-2))
|
||||
# (pp (disasm case-3))
|
||||
|
||||
# Regression #1330
|
||||
(defn regress-1330 [&]
|
||||
(def a [1 2 3])
|
||||
(def b [;a])
|
||||
(identity a))
|
||||
(assert (= [1 2 3] (regress-1330)) "regression 1330")
|
||||
|
||||
# Issue 1341
|
||||
(assert (= () '() (macex '())) "macex ()")
|
||||
(assert (= '[] (macex '[])) "macex []")
|
||||
|
||||
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
|
||||
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
|
||||
|
||||
(end-suite)
|
||||
|
|
|
@ -77,6 +77,54 @@
|
|||
(buffer/push-string b5 "456" @"789")
|
||||
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
|
||||
|
||||
(def buffer-uint16-be @"")
|
||||
(buffer/push-uint16 buffer-uint16-be :be 0x0102)
|
||||
(assert (= "\x01\x02" (string buffer-uint16-be)) "buffer/push-uint16 big endian")
|
||||
|
||||
(def buffer-uint16-le @"")
|
||||
(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-uint32-be @"")
|
||||
(buffer/push-uint32 buffer-uint32-be :be 0x01020304)
|
||||
(assert (= "\x01\x02\x03\x04" (string buffer-uint32-be)) "buffer/push-uint32 big endian")
|
||||
|
||||
(def buffer-uint32-le @"")
|
||||
(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-float32-be @"")
|
||||
(buffer/push-float32 buffer-float32-be :be 1.234)
|
||||
(assert (= "\x3f\x9d\xf3\xb6" (string buffer-float32-be)) "buffer/push-float32 big endian")
|
||||
|
||||
(def buffer-float32-le @"")
|
||||
(buffer/push-float32 buffer-float32-le :le 1.234)
|
||||
(assert (= "\xb6\xf3\x9d\x3f" (string buffer-float32-le)) "buffer/push-float32 little endian")
|
||||
|
||||
(def buffer-float64-be @"")
|
||||
(buffer/push-float64 buffer-float64-be :be 1.234)
|
||||
(assert (= "\x3f\xf3\xbe\x76\xc8\xb4\x39\x58" (string buffer-float64-be)) "buffer/push-float64 big endian")
|
||||
|
||||
(def buffer-float64-le @"")
|
||||
(buffer/push-float64 buffer-float64-le :le 1.234)
|
||||
(assert (= "\x58\x39\xb4\xc8\x76\xbe\xf3\x3f" (string buffer-float64-le)) "buffer/push-float64 little endian")
|
||||
|
||||
# Buffer from bytes
|
||||
(assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1")
|
||||
(assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2")
|
||||
(assert (deep= @"0123456789" (buffer/from-bytes ;(range 48 58))) "buffer/from-bytes 3")
|
||||
(assert (= 0 (length (buffer/from-bytes))) "buffer/from-bytes 4")
|
||||
(assert (= 5 (length (buffer/from-bytes ;(range 5)))) "buffer/from-bytes 5")
|
||||
(assert-error "bad slot #1, expected 32 bit signed integer" (buffer/from-bytes :abc))
|
||||
|
||||
# some tests for buffer/format
|
||||
# 029394d
|
||||
(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi = 3.142")
|
||||
|
@ -103,6 +151,7 @@
|
|||
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
|
||||
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
|
||||
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
|
||||
(assert (deep= @"de" (buffer/blit @"" a nil 3 5)) "buffer/blit 6")
|
||||
|
||||
# buffer/push-at
|
||||
# c55d93512
|
||||
|
@ -113,8 +162,20 @@
|
|||
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
|
||||
"buffer/push-at 3")
|
||||
|
||||
# 4782a76
|
||||
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
|
||||
# buffer/format-at
|
||||
(def start-buf (buffer/new-filled 100 (chr "x")))
|
||||
(buffer/format-at start-buf 50 "aa%dbb" 32)
|
||||
(assert (= (string start-buf) (string (string/repeat "x" 50) "aa32bb" (string/repeat "x" 44)))
|
||||
"buffer/format-at 1")
|
||||
(assert
|
||||
(deep=
|
||||
(buffer/format @"" "%j" [1 2 3 :a :b :c])
|
||||
(buffer/format-at @"" 0 "%j" [1 2 3 :a :b :c]))
|
||||
"buffer/format-at empty buffer")
|
||||
(def buf @"xxxyyy")
|
||||
(buffer/format-at buf -4 "xxx")
|
||||
(assert (= (string buf) "xxxxxx") "buffer/format-at negative index")
|
||||
(assert-error "expected index at to be in range [0, 0), got 1" (buffer/format-at @"" 1 "abc"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
|
|
@ -30,10 +30,12 @@
|
|||
(assert (= 1 (brshift 4 2)) "right shift")
|
||||
# unsigned shift
|
||||
(assert (= 32768 (brushift 0x80000000 16)) "right shift unsigned 1")
|
||||
(assert (= -32768 (brshift 0x80000000 16)) "right shift unsigned 2")
|
||||
(assert-error "right shift unsigned 2" (= -32768 (brshift 0x80000000 16)))
|
||||
(assert (= -1 (brshift -1 16)) "right shift unsigned 3")
|
||||
# non-immediate forms
|
||||
(assert (= 32768 (brushift 0x80000000 (+ 0 16))) "right shift unsigned non-immediate")
|
||||
(assert (= -32768 (brshift 0x80000000 (+ 0 16))) "right shift non-immediate")
|
||||
(assert-error "right shift non-immediate" (= -32768 (brshift 0x80000000 (+ 0 16))))
|
||||
(assert (= -1 (brshift -1 (+ 0 16))) "right shift non-immediate 2")
|
||||
(assert (= 32768 (blshift 1 (+ 0 15))) "left shift non-immediate")
|
||||
# 7e46ead
|
||||
(assert (< 1 2 3 4 5 6) "less than integers")
|
||||
|
@ -44,8 +46,28 @@
|
|||
(assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals")
|
||||
(assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers")
|
||||
(assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals")
|
||||
(assert (= 7 (% 20 13)) "modulo 1")
|
||||
(assert (= -7 (% -20 13)) "modulo 2")
|
||||
|
||||
(assert (= 7 (% 20 13)) "rem 1")
|
||||
(assert (= -7 (% -20 13)) "rem 2")
|
||||
(assert (= 7 (% 20 -13)) "rem 3")
|
||||
(assert (= -7 (% -20 -13)) "rem 4")
|
||||
(assert (nan? (% 20 0)) "rem 5")
|
||||
|
||||
(assert (= 7 (mod 20 13)) "mod 1")
|
||||
(assert (= 6 (mod -20 13)) "mod 2")
|
||||
(assert (= -6 (mod 20 -13)) "mod 3")
|
||||
(assert (= -7 (mod -20 -13)) "mod 4")
|
||||
(assert (= 20 (mod 20 0)) "mod 5")
|
||||
|
||||
(assert (= 1 (div 20 13)) "div 1")
|
||||
(assert (= -2 (div -20 13)) "div 2")
|
||||
(assert (= -2 (div 20 -13)) "div 3")
|
||||
(assert (= 1 (div -20 -13)) "div 4")
|
||||
(assert (= math/inf (div 20 0)) "div 5")
|
||||
|
||||
(assert (all = (seq [n :range [0 10]] (mod n 5 3))
|
||||
(seq [n :range [0 10]] (% n 5 3))
|
||||
[0 1 2 0 1 0 1 2 0 1]) "variadic mod")
|
||||
|
||||
(assert (< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
|
@ -137,5 +159,23 @@
|
|||
(assert-error "invalid offset-a: 1" (memcmp "a" "b" 1 1 0))
|
||||
(assert-error "invalid offset-b: 1" (memcmp "a" "b" 1 0 1))
|
||||
|
||||
# Range
|
||||
# a982f351d
|
||||
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "(range 10)")
|
||||
(assert (deep= (range 5 10) @[5 6 7 8 9]) "(range 5 10)")
|
||||
(assert (deep= (range 0 16 4) @[0 4 8 12]) "(range 0 16 4)")
|
||||
(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 (= (length (range 10)) 10) "(range 10)")
|
||||
(assert (= (length (range -10)) 0) "(range -10)")
|
||||
(assert (= (length (range 1 10)) 9) "(range 1 10)")
|
||||
|
||||
# iterating over generator
|
||||
(assert-no-error "iterate over coro 1" (values (generate [x :range [0 10]] x)))
|
||||
(assert-no-error "iterate over coro 2" (keys (generate [x :range [0 10]] x)))
|
||||
(assert-no-error "iterate over coro 3" (pairs (generate [x :range [0 10]] x)))
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
|
|
@ -21,42 +21,48 @@
|
|||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
(def test-port (os/getenv "JANET_TEST_PORT" "8761"))
|
||||
(def test-host (os/getenv "JANET_TEST_HOST" "127.0.0.1"))
|
||||
|
||||
# Subprocess
|
||||
# 5e1a8c86f
|
||||
(def janet (dyn :executable))
|
||||
(def janet (dyn *executable*))
|
||||
|
||||
# Subprocess should inherit the "RUN" parameter for fancy testing
|
||||
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
|
||||
|
||||
(repeat 10
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(os/proc-wait p)
|
||||
(def x (:read (p :out) :all))
|
||||
(assert (deep= "hello" (string/trim x))
|
||||
"capture stdout from os/spawn pre close."))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(def x (:read (p :out) 1024))
|
||||
(os/proc-wait p)
|
||||
(assert (deep= "hello" (string/trim x))
|
||||
"capture stdout from os/spawn post close."))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px
|
||||
(let [p (os/spawn [;run janet "-e" `(file/read stdin :line)`] :px
|
||||
{:in :pipe})]
|
||||
(:write (p :in) "hello!\n")
|
||||
(assert-no-error "pipe stdin to process" (os/proc-wait p))))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px
|
||||
(let [p (os/spawn [;run janet "-e" `(print (file/read stdin :line))`] :px
|
||||
{:in :pipe :out :pipe})]
|
||||
(:write (p :in) "hello!\n")
|
||||
(def x (:read (p :out) 1024))
|
||||
(assert-no-error "pipe stdin to process 2" (os/proc-wait p))
|
||||
(assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(os/proc-kill p)
|
||||
(def retval (os/proc-wait p))
|
||||
(assert (not= retval 24) "Process was *not* terminated by parent"))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(os/proc-kill p false :term)
|
||||
(def retval (os/proc-wait p))
|
||||
(assert (not= retval 24) "Process was *not* terminated by parent"))
|
||||
|
@ -66,7 +72,7 @@
|
|||
(defn calc-1
|
||||
"Run subprocess, read from stdout, then wait on subprocess."
|
||||
[code]
|
||||
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
{:out :pipe})]
|
||||
(os/proc-wait p)
|
||||
(def output (:read (p :out) :all))
|
||||
|
@ -86,7 +92,7 @@
|
|||
to 10 bytes instead of :all
|
||||
``
|
||||
[code]
|
||||
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
{:out :pipe})]
|
||||
(def output (:read (p :out) 10))
|
||||
(os/proc-wait p)
|
||||
|
@ -104,18 +110,18 @@
|
|||
# a1cc5ca04
|
||||
(assert-no-error "file writing 1"
|
||||
(with [f (file/temp)]
|
||||
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
|
||||
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
|
||||
|
||||
(assert-no-error "file writing 2"
|
||||
(with [f (file/open "unique.txt" :w)]
|
||||
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
|
||||
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
|
||||
(file/flush f)))
|
||||
|
||||
# Issue #593
|
||||
# a1cc5ca04
|
||||
(assert-no-error "file writing 3"
|
||||
(def outfile (file/open "unique.txt" :w))
|
||||
(os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
|
||||
(os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
|
||||
{:out outfile})
|
||||
(file/flush outfile)
|
||||
(file/close outfile)
|
||||
|
@ -189,11 +195,11 @@
|
|||
(net/write stream b)
|
||||
(buffer/clear b)))
|
||||
|
||||
(def s (net/server "127.0.0.1" "8000" handler))
|
||||
(def s (net/server test-host test-port handler))
|
||||
(assert s "made server 1")
|
||||
|
||||
(defn test-echo [msg]
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(with [conn (net/connect test-host test-port)]
|
||||
(net/write conn msg)
|
||||
(def res (net/read conn 1024))
|
||||
(assert (= (string res) msg) (string "echo " msg))))
|
||||
|
@ -202,7 +208,8 @@
|
|||
(test-echo "world")
|
||||
(test-echo (string/repeat "abcd" 200))
|
||||
|
||||
(:close s))
|
||||
(:close s)
|
||||
(gccollect))
|
||||
|
||||
# Test on both server and client
|
||||
# 504411e
|
||||
|
@ -212,18 +219,18 @@
|
|||
# prevent immediate close
|
||||
(ev/read stream 1)
|
||||
(def [host port] (net/localname stream))
|
||||
(assert (= host "127.0.0.1") "localname host server")
|
||||
(assert (= port 8000) "localname port server")))
|
||||
(assert (= host test-host) "localname host server")
|
||||
(assert (= port (scan-number test-port)) "localname port server")))
|
||||
|
||||
# Test localname and peername
|
||||
# 077bf5eba
|
||||
(repeat 10
|
||||
(with [s (net/server "127.0.0.1" "8000" names-handler)]
|
||||
(with [s (net/server test-host test-port names-handler)]
|
||||
(repeat 10
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(with [conn (net/connect test-host test-port)]
|
||||
(def [host port] (net/peername conn))
|
||||
(assert (= host "127.0.0.1") "peername host client ")
|
||||
(assert (= port 8000) "peername port client")
|
||||
(assert (= host test-host) "peername host client ")
|
||||
(assert (= port (scan-number test-port)) "peername port client")
|
||||
# let server close
|
||||
(ev/write conn " "))))
|
||||
(gccollect))
|
||||
|
@ -256,7 +263,7 @@
|
|||
(ev/cancel fiber "boop")
|
||||
|
||||
# f0dbc2e
|
||||
(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
|
||||
(assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
|
||||
|
||||
# Test some channel
|
||||
# e76b8da26
|
||||
|
@ -341,5 +348,31 @@
|
|||
(ev/go |(ev/chan-close ch))
|
||||
(assert (= (ev/select [ch 1]) [:close ch]))
|
||||
|
||||
(end-suite)
|
||||
# ev/gather check
|
||||
(defn exec-slurp
|
||||
"Read stdout of subprocess and return it trimmed in a string."
|
||||
[& args]
|
||||
(def env (os/environ))
|
||||
(put env :out :pipe)
|
||||
(def proc (os/spawn args :epx env))
|
||||
(def out (get proc :out))
|
||||
(def buf @"")
|
||||
(ev/gather
|
||||
(:read out :all buf)
|
||||
(:wait proc))
|
||||
(string/trimr buf))
|
||||
(assert-no-error
|
||||
"ev/with-deadline 1"
|
||||
(assert (= "hi"
|
||||
(ev/with-deadline
|
||||
10
|
||||
(exec-slurp ;run janet "-e" "(print :hi)")))
|
||||
"exec-slurp 1"))
|
||||
|
||||
# valgrind-able check for #1337
|
||||
(def superv (ev/chan 10))
|
||||
(def f (ev/go |(ev/sleep 1e9) nil superv))
|
||||
(ev/cancel f (gensym))
|
||||
(ev/take superv)
|
||||
|
||||
(end-suite)
|
||||
|
|
|
@ -126,7 +126,7 @@
|
|||
(assert (deep= (int/to-bytes (u64 300) :be buf2)
|
||||
@"abcd\x00\x00\x00\x00\x00\x00\x01\x2C")))
|
||||
|
||||
# int/s64 and int/u64 paramater type checking
|
||||
# int/s64 and int/u64 parameter type checking
|
||||
# 6aea7c7f7
|
||||
(assert-error
|
||||
"bad value passed to int/to-bytes"
|
||||
|
@ -171,22 +171,44 @@
|
|||
(assert (not (even? (int/s64 "-1001"))) "even? 6")
|
||||
|
||||
# integer type operations
|
||||
(defn modcheck [x y]
|
||||
(assert (= (string (mod x y)) (string (mod (int/s64 x) y)))
|
||||
(string "int/s64 (mod " x " " y ") expected " (mod x y) ", got "
|
||||
(mod (int/s64 x) y)))
|
||||
(assert (= (string (% x y)) (string (% (int/s64 x) y)))
|
||||
(string "int/s64 (% " x " " y ") expected " (% x y) ", got "
|
||||
(% (int/s64 x) y))))
|
||||
(defn opcheck [int x y]
|
||||
(each op [mod % div]
|
||||
(assert (compare= (op x y) (op (int x) y))
|
||||
(string int " (" op " " x " " y ") expected " (op x y)
|
||||
", got " (op (int x) y)))
|
||||
(assert (compare= (op x y) (op x (int y)))
|
||||
(string int " (" op " " x " " y ") expected " (op x y)
|
||||
", got " (op x (int y))))
|
||||
(assert (compare= (op x y) (op (int x) (int y)))
|
||||
(string int " (" op " " x " " y ") expected " (op x y)
|
||||
", got " (op (int x) (int y))))))
|
||||
|
||||
(modcheck 1 2)
|
||||
(modcheck 1 3)
|
||||
(modcheck 4 2)
|
||||
(modcheck 4 1)
|
||||
(modcheck 10 3)
|
||||
(modcheck 10 -3)
|
||||
(modcheck -10 3)
|
||||
(modcheck -10 -3)
|
||||
(loop [x :in [-5 -3 0 3 5]
|
||||
y :in [-4 -3 3 4]]
|
||||
(opcheck int/s64 x y)
|
||||
(if (and (>= x 0) (>= y 0))
|
||||
(opcheck int/u64 x y)))
|
||||
|
||||
(each int [int/s64 int/u64]
|
||||
(each op [% / div]
|
||||
(assert-error "division by zero" (op (int 7) 0))
|
||||
(assert-error "division by zero" (op 7 (int 0)))
|
||||
(assert-error "division by zero" (op (int 7) (int 0)))))
|
||||
|
||||
(each int [int/s64 int/u64]
|
||||
(loop [x :in [-5 -3 0 3 5] :when (or (pos? x) (= int int/s64))]
|
||||
# skip check when comparing negative values with unsigned integers.
|
||||
(assert (= (int x) (mod (int x) 0)) (string int " mod 0"))
|
||||
(assert (= (int x) (mod x (int 0))) (string int " mod 0"))
|
||||
(assert (= (int x) (mod (int x) (int 0))) (string int " mod 0"))))
|
||||
|
||||
(loop [x :in [-5 -3 0 3 5]]
|
||||
(assert (compare= (bnot x) (bnot (int/s64 x))) "int/s64 bnot"))
|
||||
|
||||
(loop [x :range [0 10]]
|
||||
(assert (= (int/u64 "0xFFFF_FFFF_FFFF_FFFF")
|
||||
(bxor (int/u64 x) (bnot (int/u64 x))))
|
||||
"int/u64 bnot"))
|
||||
|
||||
# Check for issue #1130
|
||||
# 7e65c2bda
|
||||
|
@ -246,13 +268,21 @@
|
|||
# compare u64/i64
|
||||
(assert (= (compare (u64 1) (i64 2)) -1) "compare 7")
|
||||
(assert (= (compare (u64 1) (i64 -1)) +1) "compare 8")
|
||||
(assert (= (compare (u64 -1) (i64 -1)) +1) "compare 9")
|
||||
(assert (= (compare (u64 0) (i64 -1)) +1) "compare 9")
|
||||
|
||||
# compare i64/u64
|
||||
(assert (= (compare (i64 1) (u64 2)) -1) "compare 10")
|
||||
(assert (= (compare (i64 -1) (u64 1)) -1) "compare 11")
|
||||
(assert (= (compare (i64 -1) (u64 -1)) -1) "compare 12")
|
||||
(assert (= (compare (i64 -1) (u64 0)) -1) "compare 12")
|
||||
|
||||
# off by 1 error in inttypes
|
||||
# a3e812b86
|
||||
(assert (= (int/s64 "-0x8000_0000_0000_0000")
|
||||
(+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
|
||||
(assert (= (int/s64 "0x7FFF_FFFF_FFFF_FFFF")
|
||||
(- (int/s64 "-0x8000_0000_0000_0000") 1)) "int types wrap around")
|
||||
|
||||
# Issue #1217
|
||||
(assert (= (- (int/u64 "0xFFFFFFFF") 1) (int/u64 "0xFFFFFFFE")) "u64 subtract")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
|
|
@ -138,5 +138,13 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
|||
# XXX: still needed? see 72beeeea
|
||||
(gccollect)
|
||||
|
||||
# ev/chan marshalling
|
||||
(compwhen (dyn 'ev/chan)
|
||||
(def chan (ev/chan 10))
|
||||
(ev/give chan chan)
|
||||
(def newchan (unmarshal (marshal chan)))
|
||||
(def item (ev/take newchan))
|
||||
(assert (= item newchan) "ev/chan marshalling"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
|
|
@ -21,6 +21,9 @@
|
|||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
(def janet (dyn :executable))
|
||||
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
|
||||
|
||||
# OS Date test
|
||||
# 719f7ba0c
|
||||
(assert (deep= {:year-day 0
|
||||
|
@ -93,10 +96,22 @@
|
|||
(assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
|
||||
(assert (= (length buf) 2) "cryptorand appends to buffer"))
|
||||
|
||||
(assert-no-error "realtime clock" (os/clock))
|
||||
(assert-no-error "realtime clock" (os/clock nil))
|
||||
(assert-no-error "realtime clock" (os/clock nil nil))
|
||||
|
||||
# 80db68210
|
||||
(assert-no-error (os/clock :realtime) "realtime clock")
|
||||
(assert-no-error (os/clock :cputime) "cputime clock")
|
||||
(assert-no-error (os/clock :monotonic) "monotonic clock")
|
||||
(assert-no-error "realtime clock" (os/clock :realtime))
|
||||
(assert-no-error "cputime clock" (os/clock :cputime))
|
||||
(assert-no-error "monotonic clock" (os/clock :monotonic))
|
||||
|
||||
(assert-no-error "realtime clock double output" (os/clock nil :double))
|
||||
(assert-no-error "realtime clock int output" (os/clock nil :int))
|
||||
(assert-no-error "realtime clock tuple output" (os/clock nil :tuple))
|
||||
|
||||
(assert-error "invalid clock" (os/clock :a))
|
||||
(assert-error "invalid output" (os/clock :realtime :b))
|
||||
(assert-error "invalid clock and output" (os/clock :a :b))
|
||||
|
||||
(def before (os/clock :monotonic))
|
||||
(def after (os/clock :monotonic))
|
||||
|
@ -118,16 +133,30 @@
|
|||
|
||||
# os/execute with environment variables
|
||||
# issue #636 - 7e2c433ab
|
||||
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe
|
||||
(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe
|
||||
(merge (os/environ) {"HELLO" "WORLD"})))
|
||||
"os/execute with env")
|
||||
|
||||
# os/execute regressions
|
||||
# 427f7c362
|
||||
(for i 0 10
|
||||
(assert (= i (os/execute [(dyn :executable) "-e"
|
||||
(assert (= i (os/execute [;run janet "-e"
|
||||
(string/format "(os/exit %d)" i)] :p))
|
||||
(string "os/execute " i)))
|
||||
|
||||
(end-suite)
|
||||
# os/execute IO redirection
|
||||
(assert-no-error "IO redirection"
|
||||
(defn devnull []
|
||||
(def os (os/which))
|
||||
(def path (if (or (= os :mingw) (= os :windows))
|
||||
"NUL"
|
||||
"/dev/null"))
|
||||
(os/open path :w))
|
||||
(with [dn (devnull)]
|
||||
(os/execute [;run janet
|
||||
"-e"
|
||||
"(print :foo) (eprint :bar)"]
|
||||
:px
|
||||
{:out dn :err dn})))
|
||||
|
||||
(end-suite)
|
||||
|
|
|
@ -263,6 +263,9 @@
|
|||
(marshpeg '(if-not "abcdf" 123))
|
||||
(marshpeg ~(cmt "abcdf" ,identity))
|
||||
(marshpeg '(group "abc"))
|
||||
(marshpeg '(sub "abcdf" "abc"))
|
||||
(marshpeg '(* (sub 1 1)))
|
||||
(marshpeg '(split "," (+ "a" "b" "c")))
|
||||
|
||||
# Peg swallowing errors
|
||||
# 159651117
|
||||
|
@ -307,12 +310,12 @@
|
|||
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00"
|
||||
@[(int/u64 0x7fff)])
|
||||
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00"
|
||||
@[(int/s64 0x7fff)])
|
||||
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
|
||||
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
|
||||
(when-let [u64 int/u64
|
||||
i64 int/s64]
|
||||
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
|
||||
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(i64 0x7fff)])
|
||||
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
|
||||
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(i64 0x7fff)]))
|
||||
|
||||
(check-deep '(* (int 2) -1) "123" nil)
|
||||
|
||||
|
@ -367,7 +370,7 @@
|
|||
(set "!$%&*+-./:<?=>@^_|"))
|
||||
:token (some :symchars)
|
||||
:hex (range "09" "af" "AF")
|
||||
:escape (* "\\" (+ (set "ntrvzf0e\"\\")
|
||||
:escape (* "\\" (+ (set `"'0?\abefnrtvz`)
|
||||
(* "x" :hex :hex)
|
||||
(error (constant "bad hex escape"))))
|
||||
:comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment))
|
||||
|
@ -660,5 +663,98 @@
|
|||
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if not")
|
||||
|
||||
(defn test [name peg input expected]
|
||||
(assert (deep= (peg/match peg input) expected) name))
|
||||
|
||||
(test "sub: matches the same input twice"
|
||||
~(sub "abcd" "abc")
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "sub: second pattern cannot match more than the first pattern"
|
||||
~(sub "abcd" "abcde")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "sub: fails if first pattern fails"
|
||||
~(sub "x" "abc")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "sub: fails if second pattern fails"
|
||||
~(sub "abc" "x")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "sub: keeps captures from both patterns"
|
||||
~(sub '"abcd" '"abc")
|
||||
"abcdef"
|
||||
@["abcd" "abc"])
|
||||
|
||||
(test "sub: second pattern can reference captures from first"
|
||||
~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag)))
|
||||
"abcdef"
|
||||
@[5 "abc" "abc"])
|
||||
|
||||
(test "sub: second pattern can't see past what the first pattern matches"
|
||||
~(sub "abc" (* "abc" -1))
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "sub: positions inside second match are still relative to the entire input"
|
||||
~(* "one\ntw" (sub "o" (* ($) (line) (column))))
|
||||
"one\ntwo\nthree\n"
|
||||
@[6 2 3])
|
||||
|
||||
(test "sub: advances to the end of the first pattern's match"
|
||||
~(* (sub "abc" "ab") "d")
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "split: basic functionality"
|
||||
~(split "," '1)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "split: drops captures from separator pattern"
|
||||
~(split '"," '1)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "split: can match empty subpatterns"
|
||||
~(split "," ':w*)
|
||||
",a,,bar,,,c,,"
|
||||
@["" "a" "" "bar" "" "" "c" "" ""])
|
||||
|
||||
(test "split: subpattern is limited to only text before the separator"
|
||||
~(split "," '(to -1))
|
||||
"a,,bar,c"
|
||||
@["a" "" "bar" "c"])
|
||||
|
||||
(test "split: fails if any subpattern fails"
|
||||
~(split "," '"a")
|
||||
"a,a,b"
|
||||
nil)
|
||||
|
||||
(test "split: separator does not have to match anything"
|
||||
~(split "x" '(to -1))
|
||||
"a,a,b"
|
||||
@["a,a,b"])
|
||||
|
||||
(test "split: always consumes entire input"
|
||||
~(split 1 '"")
|
||||
"abc"
|
||||
@["" "" "" ""])
|
||||
|
||||
(test "split: separator can be an arbitrary PEG"
|
||||
~(split :s+ '(to -1))
|
||||
"a b c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "split: does not advance past the end of the input"
|
||||
~(* (split "," ':w+) 0)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
|
|
@ -198,5 +198,9 @@
|
|||
|
||||
(assert (= (test) '(1 ())) "issue #919")
|
||||
|
||||
(end-suite)
|
||||
# Regression #1327
|
||||
(def x "A")
|
||||
(def x (if (= nil x) "B" x))
|
||||
(assert (= x "A"))
|
||||
|
||||
(end-suite)
|
||||
|
|
|
@ -35,10 +35,5 @@
|
|||
# c876e63
|
||||
0xf&1fffFFFF
|
||||
|
||||
# off by 1 error in inttypes
|
||||
# a3e812b86
|
||||
(assert (= (int/s64 "-0x8000_0000_0000_0000")
|
||||
(+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
|
|
@ -292,5 +292,8 @@
|
|||
[2 6 4 'z]])
|
||||
"arg & inner symbolmap")
|
||||
|
||||
# 4782a76
|
||||
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/env bash
|
||||
#!/usr/bin/env sh
|
||||
|
||||
# Format all code with astyle
|
||||
|
||||
|
|
Loading…
Reference in New Issue