mirror of https://github.com/janet-lang/janet
Compare commits
139 Commits
Author | SHA1 | Date |
---|---|---|
Calvin Rose | 7bae7d9efd | |
Calvin Rose | ae2c5820a1 | |
Calvin Rose | 60e0c8ea92 | |
Calvin Rose | 7d3acc0ed6 | |
Calvin Rose | 2637b33957 | |
Calvin Rose | 58ccb66659 | |
Calvin Rose | 634429cf61 | |
Calvin Rose | 03166a745a | |
Calvin Rose | ace60e1898 | |
Calvin Rose | 876b7f106f | |
Calvin Rose | 809b6589a1 | |
Calvin Rose | 02f53ca014 | |
Calvin Rose | 0b03ddb21b | |
Calvin Rose | ea5d4fd3af | |
Calvin Rose | e6b73f8cd1 | |
Calvin Rose | af232ef729 | |
Calvin Rose | 2e2f8abfc0 | |
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 |
|
@ -1,4 +1,4 @@
|
||||||
image: freebsd/12.x
|
image: freebsd/14.x
|
||||||
sources:
|
sources:
|
||||||
- https://git.sr.ht/~bakpakin/janet
|
- https://git.sr.ht/~bakpakin/janet
|
||||||
packages:
|
packages:
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
image: openbsd/latest
|
image: openbsd/7.4
|
||||||
sources:
|
sources:
|
||||||
- https://git.sr.ht/~bakpakin/janet
|
- https://git.sr.ht/~bakpakin/janet
|
||||||
packages:
|
packages:
|
||||||
|
|
|
@ -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
|
./dist/*.zip
|
||||||
./*.zip
|
./*.zip
|
||||||
./*.msi
|
./*.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
|
||||||
|
|
|
@ -73,7 +73,7 @@ jobs:
|
||||||
- name: Compile the project
|
- name: Compile the project
|
||||||
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
|
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
|
||||||
- name: Test the project
|
- name: Test the project
|
||||||
run: make test UNAME=MINGW RUN=wine
|
run: make test UNAME=MINGW RUN=wine VERBOSE=1
|
||||||
|
|
||||||
test-arm-linux:
|
test-arm-linux:
|
||||||
name: Build and test ARM32 cross compilation
|
name: Build and test ARM32 cross compilation
|
||||||
|
@ -88,4 +88,4 @@ jobs:
|
||||||
- name: Compile the project
|
- name: Compile the project
|
||||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
|
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
|
||||||
- name: Test the project
|
- name: Test the project
|
||||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test
|
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1
|
||||||
|
|
|
@ -48,6 +48,7 @@ janet.wasm
|
||||||
# Generated files
|
# Generated files
|
||||||
*.gen.h
|
*.gen.h
|
||||||
*.gen.c
|
*.gen.c
|
||||||
|
*.tmp
|
||||||
|
|
||||||
# Generate test files
|
# Generate test files
|
||||||
*.out
|
*.out
|
||||||
|
@ -126,6 +127,9 @@ vgcore.*
|
||||||
*.idb
|
*.idb
|
||||||
*.pdb
|
*.pdb
|
||||||
|
|
||||||
|
# GGov
|
||||||
|
*.gcov
|
||||||
|
|
||||||
# Kernel Module Compile Results
|
# Kernel Module Compile Results
|
||||||
*.mod*
|
*.mod*
|
||||||
*.cmd
|
*.cmd
|
||||||
|
@ -134,6 +138,9 @@ Module.symvers
|
||||||
Mkfile.old
|
Mkfile.old
|
||||||
dkms.conf
|
dkms.conf
|
||||||
|
|
||||||
|
# Coverage files
|
||||||
|
*.cov
|
||||||
|
|
||||||
# End of https://www.gitignore.io/api/c
|
# End of https://www.gitignore.io/api/c
|
||||||
|
|
||||||
# Created by https://www.gitignore.io/api/cmake
|
# Created by https://www.gitignore.io/api/cmake
|
||||||
|
|
48
CHANGELOG.md
48
CHANGELOG.md
|
@ -1,6 +1,54 @@
|
||||||
# Changelog
|
# Changelog
|
||||||
All notable changes to this project will be documented in this file.
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
|
## Unreleased - ???
|
||||||
|
- Add extra optional `env` argument to `eval` and `eval-string`.
|
||||||
|
- Allow naming function literals with a keyword. This allows better stacktraces for macros without
|
||||||
|
accidentally adding new bindings.
|
||||||
|
- Add 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
|
## 1.32.1 - 2023-10-15
|
||||||
- Fix return value from C function `janet_dobytes` when called on Janet functions that yield to event loop.
|
- 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`.
|
- Change C API for event loop interaction - get rid of JanetListener and instead use `janet_async_start` and `janet_async_end`.
|
||||||
|
|
25
Makefile
25
Makefile
|
@ -33,6 +33,7 @@ CLIBS=-lm -lpthread
|
||||||
JANET_TARGET=build/janet
|
JANET_TARGET=build/janet
|
||||||
JANET_BOOT=build/janet_boot
|
JANET_BOOT=build/janet_boot
|
||||||
JANET_IMPORT_LIB=build/janet.lib
|
JANET_IMPORT_LIB=build/janet.lib
|
||||||
|
JANET_LIBRARY_IMPORT_LIB=build/libjanet.lib
|
||||||
JANET_LIBRARY=build/libjanet.so
|
JANET_LIBRARY=build/libjanet.so
|
||||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||||
JANET_PATH?=$(LIBDIR)/janet
|
JANET_PATH?=$(LIBDIR)/janet
|
||||||
|
@ -42,6 +43,7 @@ JANET_DIST_DIR?=janet-dist
|
||||||
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
|
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
|
||||||
JANET_TARGET_OBJECTS=build/janet.o build/shell.o
|
JANET_TARGET_OBJECTS=build/janet.o build/shell.o
|
||||||
JPM_TAG?=master
|
JPM_TAG?=master
|
||||||
|
HAS_SHARED?=1
|
||||||
DEBUGGER=gdb
|
DEBUGGER=gdb
|
||||||
SONAME_SETTER=-Wl,-soname,
|
SONAME_SETTER=-Wl,-soname,
|
||||||
|
|
||||||
|
@ -51,6 +53,7 @@ HOSTAR?=$(AR)
|
||||||
# Symbols are (optionally) removed later, keep -g as default!
|
# Symbols are (optionally) removed later, keep -g as default!
|
||||||
CFLAGS?=-O2 -g
|
CFLAGS?=-O2 -g
|
||||||
LDFLAGS?=-rdynamic
|
LDFLAGS?=-rdynamic
|
||||||
|
LIBJANET_LDFLAGS?=$(LD_FLAGS)
|
||||||
RUN:=$(RUN)
|
RUN:=$(RUN)
|
||||||
|
|
||||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||||
|
@ -93,12 +96,17 @@ endif
|
||||||
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
||||||
CLIBS:=-lws2_32 -lpsapi -lwsock32
|
CLIBS:=-lws2_32 -lpsapi -lwsock32
|
||||||
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
|
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
|
||||||
|
LIBJANET_LDFLAGS:=-Wl,--out-implib,$(JANET_LIBRARY_IMPORT_LIB)
|
||||||
JANET_TARGET:=$(JANET_TARGET).exe
|
JANET_TARGET:=$(JANET_TARGET).exe
|
||||||
JANET_BOOT:=$(JANET_BOOT).exe
|
JANET_BOOT:=$(JANET_BOOT).exe
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|
||||||
$(shell mkdir -p build/core build/c build/boot build/mainclient)
|
$(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 #####
|
##### Name Files #####
|
||||||
|
@ -196,9 +204,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
||||||
########################
|
########################
|
||||||
|
|
||||||
ifeq ($(UNAME), Darwin)
|
ifeq ($(UNAME), Darwin)
|
||||||
SONAME=libjanet.1.32.dylib
|
SONAME=libjanet.1.34.dylib
|
||||||
else
|
else
|
||||||
SONAME=libjanet.so.1.32
|
SONAME=libjanet.so.1.34
|
||||||
endif
|
endif
|
||||||
|
|
||||||
build/c/shell.c: src/mainclient/shell.c
|
build/c/shell.c: src/mainclient/shell.c
|
||||||
|
@ -220,7 +228,7 @@ $(JANET_TARGET): $(JANET_TARGET_OBJECTS)
|
||||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
|
$(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)
|
$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
|
||||||
$(HOSTAR) rcs $@ $^
|
$(HOSTAR) rcs $@ $^
|
||||||
|
@ -263,7 +271,7 @@ dist: build/janet-dist.tar.gz
|
||||||
|
|
||||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||||
build/janet.h \
|
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
|
README.md build/c/janet.c build/c/shell.c
|
||||||
mkdir -p build/$(JANET_DIST_DIR)/bin
|
mkdir -p build/$(JANET_DIST_DIR)/bin
|
||||||
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
|
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
|
||||||
|
@ -271,13 +279,17 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||||
mkdir -p build/$(JANET_DIST_DIR)/include
|
mkdir -p build/$(JANET_DIST_DIR)/include
|
||||||
cp build/janet.h build/$(JANET_DIST_DIR)/include/
|
cp build/janet.h build/$(JANET_DIST_DIR)/include/
|
||||||
mkdir -p build/$(JANET_DIST_DIR)/lib/
|
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/
|
mkdir -p build/$(JANET_DIST_DIR)/man/man1/
|
||||||
cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1
|
cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1
|
||||||
mkdir -p build/$(JANET_DIST_DIR)/src/
|
mkdir -p build/$(JANET_DIST_DIR)/src/
|
||||||
cp build/c/janet.c build/c/shell.c 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)/
|
cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
|
||||||
cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
|
cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
|
||||||
|
ifeq ($(HAS_SHARED), 1)
|
||||||
|
build/janet-%.tar.gz: $(JANET_LIBRARY)
|
||||||
|
endif
|
||||||
|
|
||||||
#########################
|
#########################
|
||||||
##### Documentation #####
|
##### Documentation #####
|
||||||
|
@ -331,6 +343,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
||||||
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
||||||
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
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_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"
|
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
|
||||||
|
|
||||||
install-jpm-git: $(JANET_TARGET)
|
install-jpm-git: $(JANET_TARGET)
|
||||||
|
|
|
@ -315,8 +315,7 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w
|
||||||
|
|
||||||
## Discussion
|
## Discussion
|
||||||
|
|
||||||
Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
|
Feel free to ask questions and join the discussion on the [Janet Zulip Instance](https://janet.zulipchat.com/)
|
||||||
Gitter provides Matrix and IRC bridges as well.
|
|
||||||
|
|
||||||
## FAQ
|
## FAQ
|
||||||
|
|
||||||
|
|
|
@ -91,7 +91,9 @@ exit /b 0
|
||||||
:CLEAN
|
:CLEAN
|
||||||
del *.exe *.lib *.exp
|
del *.exe *.lib *.exp
|
||||||
rd /s /q build
|
rd /s /q build
|
||||||
rd /s /q dist
|
if exist dist (
|
||||||
|
rd /s /q dist
|
||||||
|
)
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
@rem Run tests
|
@rem Run tests
|
||||||
|
|
|
@ -55,6 +55,7 @@
|
||||||
(ffi/defbind sixints-fn six-ints [])
|
(ffi/defbind sixints-fn six-ints [])
|
||||||
(ffi/defbind sixints-fn-2 :int [x :int s 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 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
|
# Struct reading and writing
|
||||||
|
@ -119,6 +120,7 @@
|
||||||
(tracev (return-struct 42))
|
(tracev (return-struct 42))
|
||||||
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
|
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
|
||||||
(tracev (struct-big 11 99.5))
|
(tracev (struct-big 11 99.5))
|
||||||
|
(tracev (int-fn-aliased 10 20))
|
||||||
|
|
||||||
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
|
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
|
||||||
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
|
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
|
||||||
|
|
62
meson.build
62
meson.build
|
@ -20,7 +20,7 @@
|
||||||
|
|
||||||
project('janet', 'c',
|
project('janet', 'c',
|
||||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||||
version : '1.32.1')
|
version : '1.34.0')
|
||||||
|
|
||||||
# Global settings
|
# Global settings
|
||||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
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_ASSEMBLER', not get_option('assembler'))
|
||||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||||
conf.set('JANET_NO_NET', not get_option('net'))
|
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_NO_EV', not get_option('ev') or get_option('single_threaded'))
|
||||||
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
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_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
|
||||||
conf.set('JANET_NO_FFI', not get_option('ffi'))
|
conf.set('JANET_NO_FFI', not get_option('ffi'))
|
||||||
conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit'))
|
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') != ''
|
if get_option('os_name') != ''
|
||||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||||
endif
|
endif
|
||||||
|
@ -182,32 +184,41 @@ if not get_option('single_threaded')
|
||||||
janet_dependencies += thread_dep
|
janet_dependencies += thread_dep
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
# Allow building with no shared library
|
||||||
if cc.has_argument('-fvisibility=hidden')
|
if cc.has_argument('-fvisibility=hidden')
|
||||||
lib_cflags = ['-fvisibility=hidden']
|
lib_cflags = ['-fvisibility=hidden']
|
||||||
else
|
else
|
||||||
lib_cflags = []
|
lib_cflags = []
|
||||||
endif
|
endif
|
||||||
libjanet = library('janet', janetc,
|
if get_option('shared')
|
||||||
include_directories : incdir,
|
libjanet = library('janet', janetc,
|
||||||
dependencies : janet_dependencies,
|
include_directories : incdir,
|
||||||
version: meson.project_version(),
|
dependencies : janet_dependencies,
|
||||||
soversion: version_parts[0] + '.' + version_parts[1],
|
version: meson.project_version(),
|
||||||
c_args : lib_cflags,
|
soversion: version_parts[0] + '.' + version_parts[1],
|
||||||
install : true)
|
c_args : lib_cflags,
|
||||||
|
install : true)
|
||||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||||
# shaves off about 10k on linux x64, likely similar on other platforms.
|
# shaves off about 10k on linux x64, likely similar on other platforms.
|
||||||
if cc.has_argument('-fvisibility=hidden')
|
if cc.has_argument('-fvisibility=hidden')
|
||||||
extra_cflags = ['-fvisibility=hidden', '-DJANET_DLL_IMPORT']
|
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
|
else
|
||||||
extra_cflags = ['-DJANET_DLL_IMPORT']
|
# No shared library
|
||||||
|
janet_mainclient = executable('janet', mainclient_src, janetc,
|
||||||
|
include_directories : incdir,
|
||||||
|
dependencies : janet_dependencies,
|
||||||
|
c_args : lib_cflags,
|
||||||
|
install : true)
|
||||||
endif
|
endif
|
||||||
janet_mainclient = executable('janet', mainclient_src,
|
|
||||||
include_directories : incdir,
|
|
||||||
dependencies : janet_dependencies,
|
|
||||||
link_with: [libjanet],
|
|
||||||
c_args : extra_cflags,
|
|
||||||
install : true)
|
|
||||||
|
|
||||||
if meson.is_cross_build()
|
if meson.is_cross_build()
|
||||||
native_cc = meson.get_compiler('c', native: true)
|
native_cc = meson.get_compiler('c', native: true)
|
||||||
|
@ -271,14 +282,15 @@ endforeach
|
||||||
run_target('repl', command : [janet_nativeclient])
|
run_target('repl', command : [janet_nativeclient])
|
||||||
|
|
||||||
# For use as meson subproject (wrap)
|
# For use as meson subproject (wrap)
|
||||||
janet_dep = declare_dependency(include_directories : incdir,
|
if get_option('shared')
|
||||||
link_with : libjanet)
|
janet_dep = declare_dependency(include_directories : incdir,
|
||||||
|
link_with : libjanet)
|
||||||
# pkgconfig
|
# pkgconfig
|
||||||
pkg = import('pkgconfig')
|
pkg = import('pkgconfig')
|
||||||
pkg.generate(libjanet,
|
pkg.generate(libjanet,
|
||||||
subdirs: 'janet',
|
subdirs: 'janet',
|
||||||
description: 'Library for the Janet programming language.')
|
description: 'Library for the Janet programming language.')
|
||||||
|
endif
|
||||||
|
|
||||||
# Installation
|
# Installation
|
||||||
install_man('janet.1')
|
install_man('janet.1')
|
||||||
|
|
|
@ -11,13 +11,14 @@ option('peg', type : 'boolean', value : true)
|
||||||
option('int_types', type : 'boolean', value : true)
|
option('int_types', type : 'boolean', value : true)
|
||||||
option('prf', type : 'boolean', value : false)
|
option('prf', type : 'boolean', value : false)
|
||||||
option('net', type : 'boolean', value : true)
|
option('net', type : 'boolean', value : true)
|
||||||
|
option('ipv6', type : 'boolean', value : true)
|
||||||
option('ev', type : 'boolean', value : true)
|
option('ev', type : 'boolean', value : true)
|
||||||
option('processes', type : 'boolean', value : true)
|
option('processes', type : 'boolean', value : true)
|
||||||
option('umask', type : 'boolean', value : true)
|
option('umask', type : 'boolean', value : true)
|
||||||
option('realpath', type : 'boolean', value : true)
|
option('realpath', type : 'boolean', value : true)
|
||||||
option('simple_getline', type : 'boolean', value : false)
|
option('simple_getline', type : 'boolean', value : false)
|
||||||
option('epoll', type : 'boolean', value : false)
|
option('epoll', type : 'boolean', value : true)
|
||||||
option('kqueue', type : 'boolean', value : false)
|
option('kqueue', type : 'boolean', value : true)
|
||||||
option('interpreter_interrupt', type : 'boolean', value : true)
|
option('interpreter_interrupt', type : 'boolean', value : true)
|
||||||
option('ffi', type : 'boolean', value : true)
|
option('ffi', type : 'boolean', value : true)
|
||||||
option('ffi_jit', 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('arch_name', type : 'string', value: '')
|
||||||
option('os_name', type : 'string', value: '')
|
option('os_name', type : 'string', value: '')
|
||||||
|
option('shared', type : 'boolean', value: true)
|
||||||
|
option('cryptorand', type : 'boolean', value: true)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
# The core janet library
|
# The core janet library
|
||||||
# Copyright 2023 © Calvin Rose
|
# Copyright 2024 © Calvin Rose
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
|
@ -162,7 +162,7 @@
|
||||||
``Define a default value for an optional argument.
|
``Define a default value for an optional argument.
|
||||||
Expands to `(def sym (if (= nil sym) val sym))`.``
|
Expands to `(def sym (if (= nil sym) val sym))`.``
|
||||||
[sym val]
|
[sym val]
|
||||||
~(def ,sym (if (= nil ,sym) ,val ,sym)))
|
~(def ,sym (if (,= nil ,sym) ,val ,sym)))
|
||||||
|
|
||||||
(defmacro comment
|
(defmacro comment
|
||||||
"Ignores the body of the comment."
|
"Ignores the body of the comment."
|
||||||
|
@ -244,7 +244,7 @@
|
||||||
(let [[[err fib]] catch
|
(let [[[err fib]] catch
|
||||||
f (gensym)
|
f (gensym)
|
||||||
r (gensym)]
|
r (gensym)]
|
||||||
~(let [,f (,fiber/new (fn [] ,body) :ie)
|
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
|
||||||
,r (,resume ,f)]
|
,r (,resume ,f)]
|
||||||
(if (,= (,fiber/status ,f) :error)
|
(if (,= (,fiber/status ,f) :error)
|
||||||
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
|
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
|
||||||
|
@ -256,7 +256,7 @@
|
||||||
error, and the second is the return value or error.`
|
error, and the second is the return value or error.`
|
||||||
[& body]
|
[& body]
|
||||||
(let [f (gensym) r (gensym)]
|
(let [f (gensym) r (gensym)]
|
||||||
~(let [,f (,fiber/new (fn [] ,;body) :ie)
|
~(let [,f (,fiber/new (fn :protect [] ,;body) :ie)
|
||||||
,r (,resume ,f)]
|
,r (,resume ,f)]
|
||||||
[(,not= :error (,fiber/status ,f)) ,r])))
|
[(,not= :error (,fiber/status ,f)) ,r])))
|
||||||
|
|
||||||
|
@ -313,7 +313,7 @@
|
||||||
[form & body]
|
[form & body]
|
||||||
(with-syms [f r]
|
(with-syms [f r]
|
||||||
~(do
|
~(do
|
||||||
(def ,f (,fiber/new (fn [] ,;body) :ti))
|
(def ,f (,fiber/new (fn :defer [] ,;body) :ti))
|
||||||
(def ,r (,resume ,f))
|
(def ,r (,resume ,f))
|
||||||
,form
|
,form
|
||||||
(if (= (,fiber/status ,f) :dead)
|
(if (= (,fiber/status ,f) :dead)
|
||||||
|
@ -326,7 +326,7 @@
|
||||||
[form & body]
|
[form & body]
|
||||||
(with-syms [f r]
|
(with-syms [f r]
|
||||||
~(do
|
~(do
|
||||||
(def ,f (,fiber/new (fn [] ,;body) :ti))
|
(def ,f (,fiber/new (fn :edefer [] ,;body) :ti))
|
||||||
(def ,r (,resume ,f))
|
(def ,r (,resume ,f))
|
||||||
(if (= (,fiber/status ,f) :dead)
|
(if (= (,fiber/status ,f) :dead)
|
||||||
,r
|
,r
|
||||||
|
@ -338,7 +338,7 @@
|
||||||
[tag & body]
|
[tag & body]
|
||||||
(with-syms [res target payload fib]
|
(with-syms [res target payload fib]
|
||||||
~(do
|
~(do
|
||||||
(def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0))
|
(def ,fib (,fiber/new (fn :prompt [] [,tag (do ,;body)]) :i0))
|
||||||
(def ,res (,resume ,fib))
|
(def ,res (,resume ,fib))
|
||||||
(def [,target ,payload] ,res)
|
(def [,target ,payload] ,res)
|
||||||
(if (,= ,tag ,target)
|
(if (,= ,tag ,target)
|
||||||
|
@ -420,10 +420,14 @@
|
||||||
|
|
||||||
(defn- range-template
|
(defn- range-template
|
||||||
[binding object kind rest op comparison]
|
[binding object kind rest op comparison]
|
||||||
(let [[start stop step] (check-indexed object)]
|
(check-indexed object)
|
||||||
(case kind
|
(def [a b c] object)
|
||||||
:range (for-template binding (if stop start 0) (or stop start) (or step 1) comparison op [rest])
|
(def [start stop step]
|
||||||
:down (for-template binding start (or stop 0) (or step 1) comparison op [rest]))))
|
(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
|
(defn- each-template
|
||||||
[binding inx kind body]
|
[binding inx kind body]
|
||||||
|
@ -438,8 +442,8 @@
|
||||||
:each ~(,in ,ds ,k)
|
:each ~(,in ,ds ,k)
|
||||||
:keys k
|
:keys k
|
||||||
:pairs ~[,k (,in ,ds ,k)]))
|
:pairs ~[,k (,in ,ds ,k)]))
|
||||||
(set ,k (,next ,ds ,k))
|
,;body
|
||||||
,;body))))
|
(set ,k (,next ,ds ,k))))))
|
||||||
|
|
||||||
(defn- iterate-template
|
(defn- iterate-template
|
||||||
[binding expr body]
|
[binding expr body]
|
||||||
|
@ -625,17 +629,17 @@
|
||||||
``Create a generator expression using the `loop` syntax. Returns a fiber
|
``Create a generator expression using the `loop` syntax. Returns a fiber
|
||||||
that yields all values inside the loop in order. See `loop` for details.``
|
that yields all values inside the loop in order. See `loop` for details.``
|
||||||
[head & body]
|
[head & body]
|
||||||
~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
|
||||||
|
|
||||||
(defmacro coro
|
(defmacro coro
|
||||||
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
|
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
|
||||||
[& body]
|
[& body]
|
||||||
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
|
(tuple fiber/new (tuple 'fn :coro '[] ;body) :yi))
|
||||||
|
|
||||||
(defmacro fiber-fn
|
(defmacro fiber-fn
|
||||||
"A wrapper for making fibers. Same as `(fiber/new (fn [] ;body) flags)`."
|
"A wrapper for making fibers. Same as `(fiber/new (fn [] ;body) flags)`."
|
||||||
[flags & body]
|
[flags & body]
|
||||||
(tuple fiber/new (tuple 'fn '[] ;body) flags))
|
(tuple fiber/new (tuple 'fn :fiber-fn '[] ;body) flags))
|
||||||
|
|
||||||
(defn sum
|
(defn sum
|
||||||
"Returns the sum of xs. If xs is empty, returns 0."
|
"Returns the sum of xs. If xs is empty, returns 0."
|
||||||
|
@ -661,6 +665,9 @@
|
||||||
(each x xs (*= accum x))
|
(each x xs (*= accum x))
|
||||||
accum)
|
accum)
|
||||||
|
|
||||||
|
# declare ahead of time
|
||||||
|
(var- macexvar nil)
|
||||||
|
|
||||||
(defmacro if-let
|
(defmacro if-let
|
||||||
``Make multiple bindings, and if all are truthy,
|
``Make multiple bindings, and if all are truthy,
|
||||||
evaluate the `tru` form. If any are false or nil, evaluate
|
evaluate the `tru` form. If any are false or nil, evaluate
|
||||||
|
@ -669,20 +676,19 @@
|
||||||
(def len (length bindings))
|
(def len (length bindings))
|
||||||
(if (= 0 len) (error "expected at least 1 binding"))
|
(if (= 0 len) (error "expected at least 1 binding"))
|
||||||
(if (odd? len) (error "expected an even number of bindings"))
|
(if (odd? len) (error "expected an even number of bindings"))
|
||||||
(def res (gensym))
|
(def fal2 (if macexvar (macexvar fal) fal))
|
||||||
(defn aux [i]
|
(defn aux [i]
|
||||||
(if (>= i len)
|
(if (>= i len)
|
||||||
~(do (set ,res ,tru) true)
|
tru
|
||||||
(do
|
(do
|
||||||
(def bl (in bindings i))
|
(def bl (in bindings i))
|
||||||
(def br (in bindings (+ 1 i)))
|
(def br (in bindings (+ 1 i)))
|
||||||
(if (symbol? bl)
|
(if (symbol? bl)
|
||||||
~(if (def ,bl ,br) ,(aux (+ 2 i)))
|
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
|
||||||
~(if (def ,(def sym (gensym)) ,br)
|
~(if (def ,(def sym (gensym)) ,br)
|
||||||
(do (def ,bl ,sym) ,(aux (+ 2 i))))))))
|
(do (def ,bl ,sym) ,(aux (+ 2 i)))
|
||||||
~(do
|
,fal2)))))
|
||||||
(var ,res nil)
|
(aux 0))
|
||||||
(if ,(aux 0) ,res ,fal)))
|
|
||||||
|
|
||||||
(defmacro when-let
|
(defmacro when-let
|
||||||
"Same as `(if-let bindings (do ;body))`."
|
"Same as `(if-let bindings (do ;body))`."
|
||||||
|
@ -696,11 +702,11 @@
|
||||||
(case (length functions)
|
(case (length functions)
|
||||||
0 nil
|
0 nil
|
||||||
1 (in functions 0)
|
1 (in functions 0)
|
||||||
2 (let [[f g] functions] (fn [& x] (f (g ;x))))
|
2 (let [[f g] functions] (fn :comp [& x] (f (g ;x))))
|
||||||
3 (let [[f g h] functions] (fn [& x] (f (g (h ;x)))))
|
3 (let [[f g h] functions] (fn :comp [& x] (f (g (h ;x)))))
|
||||||
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
|
4 (let [[f g h i] functions] (fn :comp [& x] (f (g (h (i ;x))))))
|
||||||
(let [[f g h i] functions]
|
(let [[f g h i] functions]
|
||||||
(comp (fn [x] (f (g (h (i x)))))
|
(comp (fn :comp [x] (f (g (h (i x)))))
|
||||||
;(tuple/slice functions 4 -1)))))
|
;(tuple/slice functions 4 -1)))))
|
||||||
|
|
||||||
(defn identity
|
(defn identity
|
||||||
|
@ -711,7 +717,7 @@
|
||||||
(defn complement
|
(defn complement
|
||||||
"Returns a function that is the complement to the argument."
|
"Returns a function that is the complement to the argument."
|
||||||
[f]
|
[f]
|
||||||
(fn [x] (not (f x))))
|
(fn :complement [x] (not (f x))))
|
||||||
|
|
||||||
(defmacro- do-extreme
|
(defmacro- do-extreme
|
||||||
[order args]
|
[order args]
|
||||||
|
@ -874,7 +880,7 @@
|
||||||
``Sorts `ind` in-place by calling a function `f` on each element and
|
``Sorts `ind` in-place by calling a function `f` on each element and
|
||||||
comparing the result with `<`.``
|
comparing the result with `<`.``
|
||||||
[f ind]
|
[f ind]
|
||||||
(sort ind (fn [x y] (< (f x) (f y)))))
|
(sort ind (fn :sort-by-comp [x y] (< (f x) (f y)))))
|
||||||
|
|
||||||
(defn sorted
|
(defn sorted
|
||||||
``Returns a new sorted array without modifying the old one.
|
``Returns a new sorted array without modifying the old one.
|
||||||
|
@ -887,7 +893,7 @@
|
||||||
``Returns a new sorted array that compares elements by invoking
|
``Returns a new sorted array that compares elements by invoking
|
||||||
a function `f` on each element and comparing the result with `<`.``
|
a function `f` on each element and comparing the result with `<`.``
|
||||||
[f ind]
|
[f ind]
|
||||||
(sorted ind (fn [x y] (< (f x) (f y)))))
|
(sorted ind (fn :sorted-by-comp [x y] (< (f x) (f y)))))
|
||||||
|
|
||||||
(defn reduce
|
(defn reduce
|
||||||
``Reduce, also know as fold-left in many languages, transforms
|
``Reduce, also know as fold-left in many languages, transforms
|
||||||
|
@ -1186,7 +1192,7 @@
|
||||||
``Returns the juxtaposition of functions. In other words,
|
``Returns the juxtaposition of functions. In other words,
|
||||||
`((juxt* a b c) x)` evaluates to `[(a x) (b x) (c x)]`.``
|
`((juxt* a b c) x)` evaluates to `[(a x) (b x) (c x)]`.``
|
||||||
[& funs]
|
[& funs]
|
||||||
(fn [& args]
|
(fn :juxt* [& args]
|
||||||
(def ret @[])
|
(def ret @[])
|
||||||
(each f funs
|
(each f funs
|
||||||
(array/push ret (f ;args)))
|
(array/push ret (f ;args)))
|
||||||
|
@ -1199,7 +1205,7 @@
|
||||||
(def $args (gensym))
|
(def $args (gensym))
|
||||||
(each f funs
|
(each f funs
|
||||||
(array/push parts (tuple apply f $args)))
|
(array/push parts (tuple apply f $args)))
|
||||||
(tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
|
(tuple 'fn :juxt (tuple '& $args) (tuple/slice parts 0)))
|
||||||
|
|
||||||
(defmacro defdyn
|
(defmacro defdyn
|
||||||
``Define an alias for a keyword that is used as a dynamic binding. The
|
``Define an alias for a keyword that is used as a dynamic binding. The
|
||||||
|
@ -1415,7 +1421,12 @@
|
||||||
(def dyn-forms
|
(def dyn-forms
|
||||||
(seq [i :range [0 (length bindings) 2]]
|
(seq [i :range [0 (length bindings) 2]]
|
||||||
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
|
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
|
||||||
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
|
~(,resume (,fiber/new (fn :with-dyns [] ,;dyn-forms ,;body) :p)))
|
||||||
|
|
||||||
|
(defmacro with-env
|
||||||
|
`Run a block of code with a given environment table`
|
||||||
|
[env & body]
|
||||||
|
~(,resume (,fiber/new (fn :with-env [] ,;body) : ,env)))
|
||||||
|
|
||||||
(defmacro with-vars
|
(defmacro with-vars
|
||||||
``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
|
``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
|
||||||
|
@ -1430,7 +1441,7 @@
|
||||||
(with-syms [ret f s]
|
(with-syms [ret f s]
|
||||||
~(do
|
~(do
|
||||||
,;saveold
|
,;saveold
|
||||||
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
|
(def ,f (,fiber/new (fn :with-vars [] ,;setnew ,;body) :ti))
|
||||||
(def ,ret (,resume ,f))
|
(def ,ret (,resume ,f))
|
||||||
,;restoreold
|
,;restoreold
|
||||||
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
|
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
|
||||||
|
@ -1439,7 +1450,7 @@
|
||||||
"Partial function application."
|
"Partial function application."
|
||||||
[f & more]
|
[f & more]
|
||||||
(if (zero? (length more)) f
|
(if (zero? (length more)) f
|
||||||
(fn [& r] (f ;more ;r))))
|
(fn :partial [& r] (f ;more ;r))))
|
||||||
|
|
||||||
(defn every?
|
(defn every?
|
||||||
``Evaluates to the last element of `ind` if all preceding elements are truthy,
|
``Evaluates to the last element of `ind` if all preceding elements are truthy,
|
||||||
|
@ -1796,7 +1807,6 @@
|
||||||
(printf (dyn *pretty-format* "%q") x)
|
(printf (dyn *pretty-format* "%q") x)
|
||||||
(flush))
|
(flush))
|
||||||
|
|
||||||
|
|
||||||
(defn file/lines
|
(defn file/lines
|
||||||
"Return an iterator over the lines of a file."
|
"Return an iterator over the lines of a file."
|
||||||
[file]
|
[file]
|
||||||
|
@ -2123,15 +2133,16 @@
|
||||||
'upscope expandall})
|
'upscope expandall})
|
||||||
|
|
||||||
(defn dotup [t]
|
(defn dotup [t]
|
||||||
|
(if (= nil (next t)) (break ()))
|
||||||
(def h (in t 0))
|
(def h (in t 0))
|
||||||
(def s (in specs h))
|
(def s (in specs h))
|
||||||
(def entry (or (dyn h) {}))
|
(def entry (or (dyn h) {}))
|
||||||
(def m (do (def r (get entry :ref)) (if r (in r 0) (get entry :value))))
|
(def m (do (def r (get entry :ref)) (if r (in r 0) (get entry :value))))
|
||||||
(def m? (in entry :macro))
|
(def m? (in entry :macro))
|
||||||
(cond
|
(cond
|
||||||
s (s t)
|
s (keep-syntax t (s t))
|
||||||
m? (do (setdyn *macro-form* t) (m ;(tuple/slice t 1)))
|
m? (do (setdyn *macro-form* t) (m ;(tuple/slice t 1)))
|
||||||
(tuple/slice (map recur t))))
|
(keep-syntax! t (map recur t))))
|
||||||
|
|
||||||
(def ret
|
(def ret
|
||||||
(case (type x)
|
(case (type x)
|
||||||
|
@ -2243,6 +2254,8 @@
|
||||||
(set current (macex1 current on-binding)))
|
(set current (macex1 current on-binding)))
|
||||||
current)
|
current)
|
||||||
|
|
||||||
|
(set macexvar macex)
|
||||||
|
|
||||||
(defmacro varfn
|
(defmacro varfn
|
||||||
``Create a function that can be rebound. `varfn` has the same signature
|
``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`
|
as `defn`, but defines functions in the environment as vars. If a var `name`
|
||||||
|
@ -2316,7 +2329,7 @@
|
||||||
x)))
|
x)))
|
||||||
x))
|
x))
|
||||||
(def expanded (macex arg on-binding))
|
(def expanded (macex arg on-binding))
|
||||||
(def name-splice (if name [name] []))
|
(def name-splice (if name [name] [:short-fn]))
|
||||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i)))
|
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i)))
|
||||||
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
|
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
|
||||||
|
|
||||||
|
@ -2333,26 +2346,36 @@
|
||||||
(def default-peg-grammar
|
(def default-peg-grammar
|
||||||
`The default grammar used for pegs. This grammar defines several common patterns
|
`The default grammar used for pegs. This grammar defines several common patterns
|
||||||
that should make it easier to write more complex 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")
|
:s (set " \t\r\n\0\f\v")
|
||||||
:w (range "az" "AZ" "09")
|
: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)
|
:A (if-not :a 1)
|
||||||
:D (if-not :d 1)
|
:D (if-not :d 1)
|
||||||
:H (if-not :h 1)
|
:H (if-not :h 1)
|
||||||
:d+ (some :d)
|
:S (if-not :s 1)
|
||||||
|
:W (if-not :w 1)
|
||||||
:a+ (some :a)
|
:a+ (some :a)
|
||||||
|
:d+ (some :d)
|
||||||
|
:h+ (some :h)
|
||||||
:s+ (some :s)
|
:s+ (some :s)
|
||||||
:w+ (some :w)
|
:w+ (some :w)
|
||||||
:h+ (some :h)
|
:A+ (some :A)
|
||||||
:d* (any :d)
|
:D+ (some :D)
|
||||||
|
:H+ (some :H)
|
||||||
|
:S+ (some :S)
|
||||||
|
:W+ (some :W)
|
||||||
:a* (any :a)
|
:a* (any :a)
|
||||||
:w* (any :w)
|
:d* (any :d)
|
||||||
|
:h* (any :h)
|
||||||
:s* (any :s)
|
: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)
|
(setdyn *peg-grammar* default-peg-grammar)
|
||||||
|
|
||||||
|
@ -2396,29 +2419,9 @@
|
||||||
col
|
col
|
||||||
": parse error: "
|
": parse error: "
|
||||||
(:error p)
|
(:error p)
|
||||||
(if ec "\e[0m" ""))
|
(if ec "\e[0m"))
|
||||||
(eflush))
|
(eflush))
|
||||||
|
|
||||||
(defn- print-line-col
|
|
||||||
``Print the source code at a line, column in a source file. If unable to open
|
|
||||||
the file, prints nothing.``
|
|
||||||
[where line col]
|
|
||||||
(if-not line (break))
|
|
||||||
(unless (string? where) (break))
|
|
||||||
(when-with [f (file/open where :r)]
|
|
||||||
(def source-code (file/read f :all))
|
|
||||||
(var index 0)
|
|
||||||
(repeat (dec line)
|
|
||||||
(if-not index (break))
|
|
||||||
(set index (string/find "\n" source-code index))
|
|
||||||
(if index (++ index)))
|
|
||||||
(when index
|
|
||||||
(def line-end (string/find "\n" source-code index))
|
|
||||||
(eprint " " (string/slice source-code index line-end))
|
|
||||||
(when col
|
|
||||||
(+= index col)
|
|
||||||
(eprint (string/repeat " " (inc col)) "^")))))
|
|
||||||
|
|
||||||
(defn warn-compile
|
(defn warn-compile
|
||||||
"Default handler for a compile warning."
|
"Default handler for a compile warning."
|
||||||
[msg level where &opt line col]
|
[msg level where &opt line col]
|
||||||
|
@ -2431,10 +2434,7 @@
|
||||||
":"
|
":"
|
||||||
col
|
col
|
||||||
": compile warning (" level "): ")
|
": compile warning (" level "): ")
|
||||||
(eprint msg)
|
(eprint msg (if ec "\e[0m"))
|
||||||
(when ec
|
|
||||||
(print-line-col where line col)
|
|
||||||
(eprin "\e[0m"))
|
|
||||||
(eflush))
|
(eflush))
|
||||||
|
|
||||||
(defn bad-compile
|
(defn bad-compile
|
||||||
|
@ -2451,10 +2451,7 @@
|
||||||
": compile error: ")
|
": compile error: ")
|
||||||
(if macrof
|
(if macrof
|
||||||
(debug/stacktrace macrof msg "")
|
(debug/stacktrace macrof msg "")
|
||||||
(eprint msg))
|
(eprint msg (if ec "\e[0m")))
|
||||||
(when ec
|
|
||||||
(print-line-col where line col)
|
|
||||||
(eprin "\e[0m"))
|
|
||||||
(eflush))
|
(eflush))
|
||||||
|
|
||||||
(defn curenv
|
(defn curenv
|
||||||
|
@ -2523,7 +2520,7 @@
|
||||||
:read read
|
:read read
|
||||||
:expander expand} opts)
|
:expander expand} opts)
|
||||||
(default env (or (fiber/getenv (fiber/current)) @{}))
|
(default env (or (fiber/getenv (fiber/current)) @{}))
|
||||||
(default chunks (fn [buf p] (getline "" buf env)))
|
(default chunks (fn chunks [buf p] (getline "" buf env)))
|
||||||
(default onstatus debug/stacktrace)
|
(default onstatus debug/stacktrace)
|
||||||
(default on-compile-error bad-compile)
|
(default on-compile-error bad-compile)
|
||||||
(default on-compile-warning warn-compile)
|
(default on-compile-warning warn-compile)
|
||||||
|
@ -2658,8 +2655,8 @@
|
||||||
(defn eval
|
(defn eval
|
||||||
``Evaluates a form in the current environment. If more control over the
|
``Evaluates a form in the current environment. If more control over the
|
||||||
environment is needed, use `run-context`.``
|
environment is needed, use `run-context`.``
|
||||||
[form]
|
[form &opt env]
|
||||||
(def res (compile form nil :eval))
|
(def res (compile form env :eval))
|
||||||
(if (= (type res) :function)
|
(if (= (type res) :function)
|
||||||
(res)
|
(res)
|
||||||
(error (get res :error))))
|
(error (get res :error))))
|
||||||
|
@ -2698,9 +2695,9 @@
|
||||||
(defn eval-string
|
(defn eval-string
|
||||||
``Evaluates a string in the current environment. If more control over the
|
``Evaluates a string in the current environment. If more control over the
|
||||||
environment is needed, use `run-context`.``
|
environment is needed, use `run-context`.``
|
||||||
[str]
|
[str &opt env]
|
||||||
(var ret nil)
|
(var ret nil)
|
||||||
(each x (parse-all str) (set ret (eval x)))
|
(each x (parse-all str) (set ret (eval x env)))
|
||||||
ret)
|
ret)
|
||||||
|
|
||||||
(def load-image-dict
|
(def load-image-dict
|
||||||
|
@ -2748,6 +2745,12 @@
|
||||||
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
|
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
|
||||||
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
(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
|
(def module/cache
|
||||||
"A table, mapping loaded module identifiers to their environments."
|
"A table, mapping loaded module identifiers to their environments."
|
||||||
@{})
|
@{})
|
||||||
|
@ -2776,24 +2779,25 @@
|
||||||
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
|
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
|
||||||
```
|
```
|
||||||
[ext loader]
|
[ext loader]
|
||||||
|
(def mp (dyn *module-paths* module/paths))
|
||||||
(defn- find-prefix
|
(defn- find-prefix
|
||||||
[pre]
|
[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:"))
|
(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:"))
|
(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:"))
|
(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:"))
|
(def curall-index (find-prefix ":cur:/:all:"))
|
||||||
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
|
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
|
||||||
module/paths)
|
mp)
|
||||||
|
|
||||||
(module/add-paths ":native:" :native)
|
(module/add-paths ":native:" :native)
|
||||||
(module/add-paths "/init.janet" :source)
|
(module/add-paths "/init.janet" :source)
|
||||||
(module/add-paths ".janet" :source)
|
(module/add-paths ".janet" :source)
|
||||||
(module/add-paths ".jimage" :image)
|
(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
|
# Version of fexists that works even with a reduced OS
|
||||||
(defn- fexists
|
(defn- fexists
|
||||||
|
@ -2823,7 +2827,8 @@
|
||||||
```
|
```
|
||||||
[path]
|
[path]
|
||||||
(var ret nil)
|
(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)
|
(when (mod-filter checker path)
|
||||||
(if (function? p)
|
(if (function? p)
|
||||||
(when-let [res (p path)]
|
(when-let [res (p path)]
|
||||||
|
@ -2835,11 +2840,11 @@
|
||||||
(set ret [fullpath mod-kind])
|
(set ret [fullpath mod-kind])
|
||||||
(break))))))
|
(break))))))
|
||||||
(if ret ret
|
(if ret ret
|
||||||
(let [expander (fn [[t _ chk]]
|
(let [expander (fn :expander [[t _ chk]]
|
||||||
(when (string? t)
|
(when (string? t)
|
||||||
(when (mod-filter chk path)
|
(when (mod-filter chk path)
|
||||||
(module/expand-path path t))))
|
(module/expand-path path t))))
|
||||||
paths (filter identity (map expander module/paths))
|
paths (filter identity (map expander mp))
|
||||||
str-parts (interpose "\n " paths)]
|
str-parts (interpose "\n " paths)]
|
||||||
[nil (string "could not find module " path ":\n " ;str-parts)])))
|
[nil (string "could not find module " path ":\n " ;str-parts)])))
|
||||||
|
|
||||||
|
@ -2902,7 +2907,7 @@
|
||||||
set to a truthy value."
|
set to a truthy value."
|
||||||
[env &opt level is-repl]
|
[env &opt level is-repl]
|
||||||
(default level 1)
|
(default level 1)
|
||||||
(fn [f x]
|
(fn :debugger [f x]
|
||||||
(def fs (fiber/status f))
|
(def fs (fiber/status f))
|
||||||
(if (= :dead fs)
|
(if (= :dead fs)
|
||||||
(when is-repl
|
(when is-repl
|
||||||
|
@ -2932,7 +2937,7 @@
|
||||||
:core/stream path
|
:core/stream path
|
||||||
(file/open path :rb)))
|
(file/open path :rb)))
|
||||||
(def path-is-file (= f path))
|
(def path-is-file (= f path))
|
||||||
(default env (make-env))
|
(default env ((dyn *module-make-env* make-env)))
|
||||||
(def spath (string path))
|
(def spath (string path))
|
||||||
(put env :source (or source (if-not path-is-file spath path)))
|
(put env :source (or source (if-not path-is-file spath path)))
|
||||||
(var exit-error nil)
|
(var exit-error nil)
|
||||||
|
@ -2992,15 +2997,17 @@
|
||||||
``A table of loading method names to loading functions.
|
``A table of loading method names to loading functions.
|
||||||
This table lets `require` and `import` load many different kinds
|
This table lets `require` and `import` load many different kinds
|
||||||
of files as modules.``
|
of files as modules.``
|
||||||
@{:native (fn native-loader [path &] (native path (make-env)))
|
@{:native (fn native-loader [path &] (native path ((dyn *module-make-env* make-env))))
|
||||||
:source (fn source-loader [path args]
|
:source (fn source-loader [path args]
|
||||||
(put module/loading path true)
|
(def ml (dyn *module-loading* module/loading))
|
||||||
(defer (put module/loading path nil)
|
(put ml path true)
|
||||||
|
(defer (put ml path nil)
|
||||||
(dofile path ;args)))
|
(dofile path ;args)))
|
||||||
:preload (fn preload-loader [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)
|
(if (function? m)
|
||||||
(set (module/cache path) (m path ;args))
|
(set (mc path) (m path ;args))
|
||||||
m)))
|
m)))
|
||||||
:image (fn image-loader [path &] (load-image (slurp path)))})
|
:image (fn image-loader [path &] (load-image (slurp path)))})
|
||||||
|
|
||||||
|
@ -3008,15 +3015,18 @@
|
||||||
[path args kargs]
|
[path args kargs]
|
||||||
(def [fullpath mod-kind] (module/find path))
|
(def [fullpath mod-kind] (module/find path))
|
||||||
(unless fullpath (error mod-kind))
|
(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
|
check
|
||||||
(if (module/loading fullpath)
|
(if (ml fullpath)
|
||||||
(error (string "circular dependency " fullpath " detected"))
|
(error (string "circular dependency " fullpath " detected"))
|
||||||
(do
|
(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")))
|
(unless loader (error (string "module type " mod-kind " unknown")))
|
||||||
(def env (loader fullpath args))
|
(def env (loader fullpath args))
|
||||||
(put module/cache fullpath env)
|
(put mc fullpath env)
|
||||||
env))))
|
env))))
|
||||||
|
|
||||||
(defn require
|
(defn require
|
||||||
|
@ -3105,6 +3115,7 @@
|
||||||
[&opt env local]
|
[&opt env local]
|
||||||
(env-walk keyword? env local))
|
(env-walk keyword? env local))
|
||||||
|
|
||||||
|
|
||||||
(defdyn *doc-width*
|
(defdyn *doc-width*
|
||||||
"Width in columns to print documentation printed with `doc-format`.")
|
"Width in columns to print documentation printed with `doc-format`.")
|
||||||
|
|
||||||
|
@ -3413,9 +3424,9 @@
|
||||||
(defn- print-special-form-entry
|
(defn- print-special-form-entry
|
||||||
[x]
|
[x]
|
||||||
(print "\n\n"
|
(print "\n\n"
|
||||||
(string " special form\n\n")
|
" special form\n\n"
|
||||||
(string " (" x " ...)\n\n")
|
" (" x " ...)\n\n"
|
||||||
(string " See https://janet-lang.org/docs/specials.html\n\n")))
|
" See https://janet-lang.org/docs/specials.html\n\n"))
|
||||||
|
|
||||||
(defn doc*
|
(defn doc*
|
||||||
"Get the documentation for a symbol in a given environment. Function form of `doc`."
|
"Get the documentation for a symbol in a given environment. Function form of `doc`."
|
||||||
|
@ -3667,7 +3678,7 @@
|
||||||
[&opt chunks onsignal env parser read]
|
[&opt chunks onsignal env parser read]
|
||||||
(default env (make-env))
|
(default env (make-env))
|
||||||
(default chunks
|
(default chunks
|
||||||
(fn [buf p]
|
(fn :chunks [buf p]
|
||||||
(getline
|
(getline
|
||||||
(string
|
(string
|
||||||
"repl:"
|
"repl:"
|
||||||
|
@ -3698,31 +3709,63 @@
|
||||||
Returns a fiber that is scheduled to run the function.
|
Returns a fiber that is scheduled to run the function.
|
||||||
```
|
```
|
||||||
[f & args]
|
[f & args]
|
||||||
(ev/go (fn _call [&] (f ;args))))
|
(ev/go (fn :call [&] (f ;args))))
|
||||||
|
|
||||||
(defmacro ev/spawn
|
(defmacro ev/spawn
|
||||||
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
|
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
|
||||||
[& body]
|
[& body]
|
||||||
~(,ev/go (fn _spawn [&] ,;body)))
|
~(,ev/go (fn :spawn [&] ,;body)))
|
||||||
|
|
||||||
(defmacro ev/do-thread
|
(defmacro ev/do-thread
|
||||||
``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
|
``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
|
||||||
evaluates to nil.``
|
evaluates to nil.``
|
||||||
[& body]
|
[& body]
|
||||||
~(,ev/thread (fn _do-thread [&] ,;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
|
(defmacro ev/spawn-thread
|
||||||
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
|
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
|
||||||
[& body]
|
[& body]
|
||||||
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
|
~(,ev/thread (fn :spawn-thread [&] ,;body) nil :n))
|
||||||
|
|
||||||
(defmacro ev/with-deadline
|
(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.`
|
Create a fiber to execute `body`, schedule the event loop to cancel
|
||||||
[deadline & body]
|
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]
|
(with-syms [f]
|
||||||
~(let [,f (coro ,;body)]
|
~(let [,f (coro ,;body)]
|
||||||
(,ev/deadline ,deadline nil ,f)
|
(,ev/deadline ,sec nil ,f)
|
||||||
(,resume ,f))))
|
(,resume ,f))))
|
||||||
|
|
||||||
(defn- cancel-all [chan fibers reason]
|
(defn- cancel-all [chan fibers reason]
|
||||||
|
@ -3755,7 +3798,7 @@
|
||||||
(def ,res @[])
|
(def ,res @[])
|
||||||
,;(seq [[i body] :pairs bodies]
|
,;(seq [[i body] :pairs bodies]
|
||||||
~(do
|
~(do
|
||||||
(def ,ftemp (,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))
|
(def ,ftemp (,ev/go (fn :ev/gather [] (put ,res ,i ,body)) nil ,chan))
|
||||||
(,put ,fset ,ftemp ,ftemp)))
|
(,put ,fset ,ftemp ,ftemp)))
|
||||||
(,wait-for-fibers ,chan ,fset)
|
(,wait-for-fibers ,chan ,fset)
|
||||||
,res))))
|
,res))))
|
||||||
|
@ -3814,9 +3857,11 @@
|
||||||
:lazy lazy
|
:lazy lazy
|
||||||
:map-symbols map-symbols}))
|
:map-symbols map-symbols}))
|
||||||
|
|
||||||
(defmacro ffi/defbind
|
(defmacro ffi/defbind-alias
|
||||||
"Generate bindings for native functions in a convenient manner."
|
"Generate bindings for native functions in a convenient manner.
|
||||||
[name ret-type & body]
|
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 real-ret-type (eval ret-type))
|
||||||
(def meta (slice body 0 -2))
|
(def meta (slice body 0 -2))
|
||||||
(def arg-pairs (partition 2 (last body)))
|
(def arg-pairs (partition 2 (last body)))
|
||||||
|
@ -3833,10 +3878,15 @@
|
||||||
(defn make-ptr []
|
(defn make-ptr []
|
||||||
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
|
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
|
||||||
(if lazy
|
(if lazy
|
||||||
~(defn ,name ,;meta [,;formal-args]
|
~(defn ,alias ,;meta [,;formal-args]
|
||||||
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;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)))))
|
(,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)))
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
|
@ -3913,7 +3963,6 @@
|
||||||
(merge-into module/cache old-modcache)
|
(merge-into module/cache old-modcache)
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
### CLI Tool Main
|
### CLI Tool Main
|
||||||
|
@ -3950,6 +3999,28 @@
|
||||||
(compwhen (not (dyn 'os/isatty))
|
(compwhen (not (dyn 'os/isatty))
|
||||||
(defmacro os/isatty [&] true))
|
(defmacro os/isatty [&] true))
|
||||||
|
|
||||||
|
(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"})
|
||||||
|
|
||||||
(defn cli-main
|
(defn cli-main
|
||||||
`Entrance for the Janet CLI tool. Call this function with the command line
|
`Entrance for the Janet CLI tool. Call this function with the command line
|
||||||
arguments as an array or tuple of strings to invoke the CLI interface.`
|
arguments as an array or tuple of strings to invoke the CLI interface.`
|
||||||
|
@ -3988,26 +4059,26 @@
|
||||||
(print
|
(print
|
||||||
```
|
```
|
||||||
Options are:
|
Options are:
|
||||||
-h : Show this help
|
--help (-h) : Show this help
|
||||||
-v : Print the version string
|
--version (-v) : Print the version string
|
||||||
-s : Use raw stdin instead of getline like functionality
|
--stdin (-s) : Use raw stdin instead of getline like functionality
|
||||||
-e code : Execute a string of janet
|
--eval (-e) code : Execute a string of janet
|
||||||
-E code arguments... : Evaluate an expression as a short-fn with arguments
|
--expression (-E) code arguments... : Evaluate an expression as a short-fn with arguments
|
||||||
-d : Set the debug flag in the REPL
|
--debug (-d) : Set the debug flag in the REPL
|
||||||
-r : Enter the REPL after running all scripts
|
--repl (-r) : Enter the REPL after running all scripts
|
||||||
-R : Disables loading profile.janet when JANET_PROFILE is present
|
--noprofile (-R) : Disables loading profile.janet when JANET_PROFILE is present
|
||||||
-p : Keep on executing if there is a top-level error (persistent)
|
--persistent (-p) : Keep on executing if there is a top-level error (persistent)
|
||||||
-q : Hide logo (quiet)
|
--quiet (-q) : Hide logo (quiet)
|
||||||
-k : Compile scripts but do not execute (flycheck)
|
--flycheck (-k) : Compile scripts but do not execute (flycheck)
|
||||||
-m syspath : Set system path for loading global modules
|
--syspath (-m) syspath : Set system path for loading global modules
|
||||||
-c source output : Compile janet source code into an image
|
--compile (-c) source output : Compile janet source code into an image
|
||||||
-i : Load the script argument as an image file instead of source code
|
--image (-i) : Load the script argument as an image file instead of source code
|
||||||
-n : Disable ANSI color output in the REPL
|
--nocolor (-n) : Disable ANSI color output in the REPL
|
||||||
-N : Enable ANSI color output in the REPL
|
--color (-N) : Enable ANSI color output in the REPL
|
||||||
-l lib : Use a module before processing more arguments
|
--library (-l) lib : Use a module before processing more arguments
|
||||||
-w level : Set the lint warning level - default is "normal"
|
--lint-warn (-w) level : Set the lint warning level - default is "normal"
|
||||||
-x level : Set the lint error level - default is "none"
|
--lint-error (-x) level : Set the lint error level - default is "none"
|
||||||
-- : Stop handling options
|
-- : Stop handling options
|
||||||
```)
|
```)
|
||||||
(os/exit 0)
|
(os/exit 0)
|
||||||
1)
|
1)
|
||||||
|
@ -4051,8 +4122,8 @@
|
||||||
"R" (fn [&] (setdyn *profilepath* nil) 1)})
|
"R" (fn [&] (setdyn *profilepath* nil) 1)})
|
||||||
|
|
||||||
(defn- dohandler [n i &]
|
(defn- dohandler [n i &]
|
||||||
(def h (in handlers n))
|
(def h (in handlers (get long-to-short n n)))
|
||||||
(if h (h i) (do (print "unknown flag -" n) ((in handlers "h")))))
|
(if h (h i handlers) (do (print "unknown flag -" n) ((in handlers "h")))))
|
||||||
|
|
||||||
# Process arguments
|
# Process arguments
|
||||||
(var i 0)
|
(var i 0)
|
||||||
|
|
|
@ -4,10 +4,10 @@
|
||||||
#define JANETCONF_H
|
#define JANETCONF_H
|
||||||
|
|
||||||
#define JANET_VERSION_MAJOR 1
|
#define JANET_VERSION_MAJOR 1
|
||||||
#define JANET_VERSION_MINOR 32
|
#define JANET_VERSION_MINOR 34
|
||||||
#define JANET_VERSION_PATCH 1
|
#define JANET_VERSION_PATCH 0
|
||||||
#define JANET_VERSION_EXTRA ""
|
#define JANET_VERSION_EXTRA ""
|
||||||
#define JANET_VERSION "1.32.1"
|
#define JANET_VERSION "1.34.0"
|
||||||
|
|
||||||
/* #define JANET_BUILD "local" */
|
/* #define JANET_BUILD "local" */
|
||||||
|
|
||||||
|
@ -52,6 +52,9 @@
|
||||||
/* #define JANET_EV_NO_EPOLL */
|
/* #define JANET_EV_NO_EPOLL */
|
||||||
/* #define JANET_EV_NO_KQUEUE */
|
/* #define JANET_EV_NO_KQUEUE */
|
||||||
/* #define JANET_NO_INTERPRETER_INTERRUPT */
|
/* #define JANET_NO_INTERPRETER_INTERRUPT */
|
||||||
|
/* #define JANET_NO_IPV6 */
|
||||||
|
/* #define JANET_NO_CRYPTORAND */
|
||||||
|
/* #define JANET_USE_STDATOMIC */
|
||||||
|
|
||||||
/* Custom vm allocator support */
|
/* Custom vm allocator support */
|
||||||
/* #include <mimalloc.h> */
|
/* #include <mimalloc.h> */
|
||||||
|
|
|
@ -31,8 +31,6 @@
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#include <windows.h>
|
#include <windows.h>
|
||||||
#else
|
|
||||||
#include <stdatomic.h>
|
|
||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|
|
@ -560,6 +560,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||||
x = janet_get1(s, janet_ckeywordv("vararg"));
|
x = janet_get1(s, janet_ckeywordv("vararg"));
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_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 */
|
/* Check structarg */
|
||||||
x = janet_get1(s, janet_ckeywordv("structarg"));
|
x = janet_get1(s, janet_ckeywordv("structarg"));
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
|
@ -784,8 +787,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Verify the func def */
|
/* Verify the func def */
|
||||||
if (janet_verify(def)) {
|
int verify_status = janet_verify(def);
|
||||||
janet_asm_error(&a, "invalid assembly");
|
if (verify_status) {
|
||||||
|
janet_asm_errorv(&a, janet_formatc("invalid assembly (%d)", verify_status));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Add final flags */
|
/* Add final flags */
|
||||||
|
|
|
@ -135,8 +135,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||||
|
|
||||||
/* Push a cstring to buffer */
|
/* Push a cstring to buffer */
|
||||||
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||||
int32_t len = 0;
|
int32_t len = (int32_t) strlen(cstring);
|
||||||
while (cstring[len]) ++len;
|
|
||||||
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -321,6 +320,143 @@ JANET_CORE_FN(cfun_buffer_chars,
|
||||||
return argv[0];
|
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) {
|
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++) {
|
for (int32_t i = argc_offset; i < argc; i++) {
|
||||||
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
||||||
|
@ -519,6 +655,27 @@ JANET_CORE_FN(cfun_buffer_format,
|
||||||
return argv[0];
|
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) {
|
void janet_lib_buffer(JanetTable *env) {
|
||||||
JanetRegExt buffer_cfuns[] = {
|
JanetRegExt buffer_cfuns[] = {
|
||||||
JANET_CORE_REG("buffer/new", cfun_buffer_new),
|
JANET_CORE_REG("buffer/new", cfun_buffer_new),
|
||||||
|
@ -529,6 +686,11 @@ void janet_lib_buffer(JanetTable *env) {
|
||||||
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
|
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
|
||||||
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
|
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
|
||||||
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
|
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", cfun_buffer_push),
|
||||||
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
|
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
|
||||||
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
|
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
|
||||||
|
@ -540,6 +702,7 @@ void janet_lib_buffer(JanetTable *env) {
|
||||||
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
|
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
|
||||||
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
|
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
|
||||||
JANET_CORE_REG("buffer/format", cfun_buffer_format),
|
JANET_CORE_REG("buffer/format", cfun_buffer_format),
|
||||||
|
JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at),
|
||||||
JANET_REG_END
|
JANET_REG_END
|
||||||
};
|
};
|
||||||
janet_core_cfuns_ext(env, NULL, buffer_cfuns);
|
janet_core_cfuns_ext(env, NULL, buffer_cfuns);
|
||||||
|
|
|
@ -226,6 +226,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
||||||
case JOP_LOAD_TRUE:
|
case JOP_LOAD_TRUE:
|
||||||
case JOP_LOAD_FALSE:
|
case JOP_LOAD_FALSE:
|
||||||
case JOP_LOAD_SELF:
|
case JOP_LOAD_SELF:
|
||||||
|
break;
|
||||||
case JOP_MAKE_ARRAY:
|
case JOP_MAKE_ARRAY:
|
||||||
case JOP_MAKE_BUFFER:
|
case JOP_MAKE_BUFFER:
|
||||||
case JOP_MAKE_STRING:
|
case JOP_MAKE_STRING:
|
||||||
|
@ -233,6 +234,8 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
||||||
case JOP_MAKE_TABLE:
|
case JOP_MAKE_TABLE:
|
||||||
case JOP_MAKE_TUPLE:
|
case JOP_MAKE_TUPLE:
|
||||||
case JOP_MAKE_BRACKET_TUPLE:
|
case JOP_MAKE_BRACKET_TUPLE:
|
||||||
|
/* Reads from the stack, don't remove */
|
||||||
|
janetc_regalloc_touch(&ra, DD);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
/* Read A */
|
/* Read A */
|
||||||
|
|
|
@ -35,6 +35,13 @@
|
||||||
#endif
|
#endif
|
||||||
#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) {
|
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||||
#ifdef JANET_TOP_LEVEL_SIGNAL
|
#ifdef JANET_TOP_LEVEL_SIGNAL
|
||||||
JANET_TOP_LEVEL_SIGNAL(msg);
|
JANET_TOP_LEVEL_SIGNAL(msg);
|
||||||
|
@ -496,6 +503,8 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
|
||||||
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
|
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
return InterlockedIncrement(x);
|
return InterlockedIncrement(x);
|
||||||
|
#elif defined(JANET_USE_STDATOMIC)
|
||||||
|
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
|
||||||
#else
|
#else
|
||||||
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
|
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
|
||||||
#endif
|
#endif
|
||||||
|
@ -504,8 +513,20 @@ JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
|
||||||
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
|
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
return InterlockedDecrement(x);
|
return InterlockedDecrement(x);
|
||||||
|
#elif defined(JANET_USE_STDATOMIC)
|
||||||
|
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
|
||||||
#else
|
#else
|
||||||
return __atomic_add_fetch(x, -1, __ATOMIC_RELAXED);
|
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
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -934,7 +934,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||||
int32_t slotchunks = (def->slotcount + 31) >> 5;
|
int32_t slotchunks = (def->slotcount + 31) >> 5;
|
||||||
/* numchunks is min of slotchunks and scope->ua.count */
|
/* numchunks is min of slotchunks and scope->ua.count */
|
||||||
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
|
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
|
||||||
uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
|
uint32_t *chunks = janet_calloc(slotchunks, sizeof(uint32_t));
|
||||||
if (NULL == chunks) {
|
if (NULL == chunks) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
|
@ -1056,7 +1056,7 @@ JanetCompileResult janet_compile_lint(Janet source,
|
||||||
|
|
||||||
if (c.result.status == JANET_COMPILE_OK) {
|
if (c.result.status == JANET_COMPILE_OK) {
|
||||||
JanetFuncDef *def = janetc_pop_funcdef(&c);
|
JanetFuncDef *def = janetc_pop_funcdef(&c);
|
||||||
def->name = janet_cstring("_thunk");
|
def->name = janet_cstring("thunk");
|
||||||
janet_def_addflags(def);
|
janet_def_addflags(def);
|
||||||
c.result.funcdef = def;
|
c.result.funcdef = def;
|
||||||
} else {
|
} else {
|
||||||
|
|
|
@ -69,15 +69,15 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||||
host.minor < modconf.minor ||
|
host.minor < modconf.minor ||
|
||||||
host.bits != modconf.bits) {
|
host.bits != modconf.bits) {
|
||||||
char errbuf[128];
|
char errbuf[128];
|
||||||
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
|
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
|
||||||
host.major,
|
host.major,
|
||||||
host.minor,
|
host.minor,
|
||||||
host.patch,
|
host.patch,
|
||||||
host.bits,
|
host.bits,
|
||||||
modconf.major,
|
modconf.major,
|
||||||
modconf.minor,
|
modconf.minor,
|
||||||
modconf.patch,
|
modconf.patch,
|
||||||
modconf.bits);
|
modconf.bits);
|
||||||
*error = janet_cstring(errbuf);
|
*error = janet_cstring(errbuf);
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
@ -110,14 +110,14 @@ JANET_CORE_FN(janet_core_expand_path,
|
||||||
"(module/expand-path path template)",
|
"(module/expand-path path template)",
|
||||||
"Expands a path template as found in `module/paths` for `module/find`. "
|
"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, "
|
"This takes in a path (the argument to require) and a template string, "
|
||||||
"to expand the path to a path that can be "
|
"to expand the path to a path that can be used for importing files. "
|
||||||
"used for importing files. The replacements are as follows:\n\n"
|
"The replacements are as follows:\n\n"
|
||||||
"* :all: -- the value of path verbatim.\n\n"
|
"* :all: -- the value of path verbatim.\n\n"
|
||||||
"* :@all: -- Same as :all:, but if `path` starts with the @ character,\n"
|
"* :@all: -- Same as :all:, but if `path` starts with the @ character, "
|
||||||
" the first path segment is replaced with a dynamic binding\n"
|
"the first path segment is replaced with a dynamic binding "
|
||||||
" `(dyn <first path segment as keyword>)`.\n\n"
|
"`(dyn <first path segment as keyword>)`.\n\n"
|
||||||
"* :cur: -- the current file, or (dyn :current-file)\n\n"
|
"* :cur: -- the directory portion, if any, of (dyn :current-file)\n\n"
|
||||||
"* :dir: -- the directory containing the 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"
|
"* :name: -- the name component of path, with extension if given\n\n"
|
||||||
"* :native: -- the extension used to load natives, .so or .dll\n\n"
|
"* :native: -- the extension used to load natives, .so or .dll\n\n"
|
||||||
"* :sys: -- the system path, or (dyn :syspath)") {
|
"* :sys: -- the system path, or (dyn :syspath)") {
|
||||||
|
@ -1144,17 +1144,20 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||||
JDOC("(next ds &opt key)\n\n"
|
JDOC("(next ds &opt key)\n\n"
|
||||||
"Gets the next key in a data structure. Can be used to iterate through "
|
"Gets the next key in a data structure. Can be used to iterate through "
|
||||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
"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 "
|
"during iteration. If key is nil, next returns the first key. If next "
|
||||||
"returns nil, there are no more keys to iterate through."));
|
"returns nil, there are no more keys to iterate through."));
|
||||||
janet_quick_asm(env, JANET_FUN_PROP,
|
janet_quick_asm(env, JANET_FUN_PROP,
|
||||||
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
||||||
JDOC("(propagate x fiber)\n\n"
|
JDOC("(propagate x fiber)\n\n"
|
||||||
"Propagate a signal from a fiber to the current fiber. The resulting "
|
"Propagate a signal from a fiber to the current fiber and "
|
||||||
"stack trace from the current fiber will include frames from fiber. If "
|
"set the last value of the current fiber to `x`. The signal "
|
||||||
"fiber is in a state that can be resumed, resuming the current fiber will "
|
"value is then available as the status of the current fiber. "
|
||||||
"first resume fiber. This function can be used to re-raise an error without "
|
"The resulting stack trace from the current fiber will include "
|
||||||
"losing the original stack trace."));
|
"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,
|
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||||
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
||||||
JDOC("(debug &opt x)\n\n"
|
JDOC("(debug &opt x)\n\n"
|
||||||
|
|
|
@ -164,7 +164,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||||
janet_eprintf(" (tailcall)");
|
janet_eprintf(" (tail call)");
|
||||||
if (frame->func && frame->pc) {
|
if (frame->func && frame->pc) {
|
||||||
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||||
if (def->sourcemap) {
|
if (def->sourcemap) {
|
||||||
|
@ -180,6 +180,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
janet_eprintf("\n");
|
janet_eprintf("\n");
|
||||||
|
/* Print fiber points optionally. Clutters traces but provides info
|
||||||
|
if (i <= 0 && fi > 0) {
|
||||||
|
janet_eprintf(" in parent fiber\n");
|
||||||
|
}
|
||||||
|
*/
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -388,8 +393,8 @@ JANET_CORE_FN(cfun_debug_stack,
|
||||||
JANET_CORE_FN(cfun_debug_stacktrace,
|
JANET_CORE_FN(cfun_debug_stacktrace,
|
||||||
"(debug/stacktrace fiber &opt err prefix)",
|
"(debug/stacktrace fiber &opt err prefix)",
|
||||||
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
|
"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 "
|
"an error value to print the stack trace with. If `prefix` is nil or not "
|
||||||
"provided, and no prefix is given, will skip the error line. Returns the fiber.") {
|
"provided, will skip the error line. Returns the fiber.") {
|
||||||
janet_arity(argc, 1, 3);
|
janet_arity(argc, 1, 3);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
|
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
|
||||||
|
|
208
src/core/ev.c
208
src/core/ev.c
|
@ -258,12 +258,12 @@ void janet_async_end(JanetFiber *fiber) {
|
||||||
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_DEINIT);
|
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_DEINIT);
|
||||||
janet_gcunroot(janet_wrap_abstract(fiber->ev_stream));
|
janet_gcunroot(janet_wrap_abstract(fiber->ev_stream));
|
||||||
fiber->ev_callback = NULL;
|
fiber->ev_callback = NULL;
|
||||||
if (fiber->ev_state) {
|
if (!(fiber->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
|
||||||
if (!(fiber->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
|
if (fiber->ev_state) {
|
||||||
janet_free(fiber->ev_state);
|
janet_free(fiber->ev_state);
|
||||||
janet_ev_dec_refcount();
|
fiber->ev_state = NULL;
|
||||||
}
|
}
|
||||||
fiber->ev_state = NULL;
|
janet_ev_dec_refcount();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -279,8 +279,16 @@ void janet_async_in_flight(JanetFiber *fiber) {
|
||||||
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
|
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
|
||||||
JanetFiber *fiber = janet_vm.root_fiber;
|
JanetFiber *fiber = janet_vm.root_fiber;
|
||||||
janet_assert(!fiber->ev_callback, "double async on fiber");
|
janet_assert(!fiber->ev_callback, "double async on fiber");
|
||||||
if (mode & JANET_ASYNC_LISTEN_READ) stream->read_fiber = fiber;
|
if (mode & JANET_ASYNC_LISTEN_READ) {
|
||||||
if (mode & JANET_ASYNC_LISTEN_WRITE) stream->write_fiber = fiber;
|
stream->read_fiber = fiber;
|
||||||
|
} else {
|
||||||
|
stream->read_fiber = NULL;
|
||||||
|
}
|
||||||
|
if (mode & JANET_ASYNC_LISTEN_WRITE) {
|
||||||
|
stream->write_fiber = fiber;
|
||||||
|
} else {
|
||||||
|
stream->write_fiber = NULL;
|
||||||
|
}
|
||||||
fiber->ev_callback = callback;
|
fiber->ev_callback = callback;
|
||||||
fiber->ev_stream = stream;
|
fiber->ev_stream = stream;
|
||||||
janet_ev_inc_refcount();
|
janet_ev_inc_refcount();
|
||||||
|
@ -450,6 +458,9 @@ static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
|
||||||
p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
|
p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
|
||||||
#else
|
#else
|
||||||
p->handle = (JanetHandle) janet_unmarshal_int(ctx);
|
p->handle = (JanetHandle) janet_unmarshal_int(ctx);
|
||||||
|
#endif
|
||||||
|
#ifdef JANET_EV_POLL
|
||||||
|
janet_register_stream(p);
|
||||||
#endif
|
#endif
|
||||||
return p;
|
return p;
|
||||||
}
|
}
|
||||||
|
@ -459,6 +470,12 @@ static Janet janet_stream_next(void *p, Janet key) {
|
||||||
return janet_nextmethod(stream->methods, key);
|
return janet_nextmethod(stream->methods, key);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void janet_stream_tostring(void *p, JanetBuffer *buffer) {
|
||||||
|
JanetStream *stream = p;
|
||||||
|
/* Let user print the file descriptor for debugging */
|
||||||
|
janet_formatb(buffer, "<core/stream handle=%d>", stream->handle);
|
||||||
|
}
|
||||||
|
|
||||||
const JanetAbstractType janet_stream_type = {
|
const JanetAbstractType janet_stream_type = {
|
||||||
"core/stream",
|
"core/stream",
|
||||||
janet_stream_gc,
|
janet_stream_gc,
|
||||||
|
@ -467,7 +484,7 @@ const JanetAbstractType janet_stream_type = {
|
||||||
NULL,
|
NULL,
|
||||||
janet_stream_marshal,
|
janet_stream_marshal,
|
||||||
janet_stream_unmarshal,
|
janet_stream_unmarshal,
|
||||||
NULL,
|
janet_stream_tostring,
|
||||||
NULL,
|
NULL,
|
||||||
NULL,
|
NULL,
|
||||||
janet_stream_next,
|
janet_stream_next,
|
||||||
|
@ -1166,10 +1183,12 @@ JANET_CORE_FN(cfun_channel_close,
|
||||||
msg.argj = janet_wrap_nil();
|
msg.argj = janet_wrap_nil();
|
||||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||||
} else {
|
} else {
|
||||||
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
|
if (janet_fiber_can_resume(writer.fiber)) {
|
||||||
janet_schedule(writer.fiber, make_close_result(channel));
|
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
|
||||||
} else {
|
janet_schedule(writer.fiber, make_close_result(channel));
|
||||||
janet_schedule(writer.fiber, janet_wrap_nil());
|
} else {
|
||||||
|
janet_schedule(writer.fiber, janet_wrap_nil());
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -1185,10 +1204,12 @@ JANET_CORE_FN(cfun_channel_close,
|
||||||
msg.argj = janet_wrap_nil();
|
msg.argj = janet_wrap_nil();
|
||||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||||
} else {
|
} else {
|
||||||
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
|
if (janet_fiber_can_resume(reader.fiber)) {
|
||||||
janet_schedule(reader.fiber, make_close_result(channel));
|
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
|
||||||
} else {
|
janet_schedule(reader.fiber, make_close_result(channel));
|
||||||
janet_schedule(reader.fiber, janet_wrap_nil());
|
} else {
|
||||||
|
janet_schedule(reader.fiber, janet_wrap_nil());
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -1284,7 +1305,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout);
|
||||||
int janet_loop_done(void) {
|
int janet_loop_done(void) {
|
||||||
return !((janet_vm.spawn.head != janet_vm.spawn.tail) ||
|
return !((janet_vm.spawn.head != janet_vm.spawn.tail) ||
|
||||||
janet_vm.tq_count ||
|
janet_vm.tq_count ||
|
||||||
janet_vm.listener_count);
|
janet_atomic_load(&janet_vm.listener_count));
|
||||||
}
|
}
|
||||||
|
|
||||||
JanetFiber *janet_loop1(void) {
|
JanetFiber *janet_loop1(void) {
|
||||||
|
@ -1346,7 +1367,7 @@ JanetFiber *janet_loop1(void) {
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Poll for events */
|
/* Poll for events */
|
||||||
if (janet_vm.tq_count || janet_vm.listener_count) {
|
if (janet_vm.tq_count || janet_atomic_load(&janet_vm.listener_count)) {
|
||||||
JanetTimeout to;
|
JanetTimeout to;
|
||||||
memset(&to, 0, sizeof(to));
|
memset(&to, 0, sizeof(to));
|
||||||
int has_timeout;
|
int has_timeout;
|
||||||
|
@ -1365,7 +1386,7 @@ JanetFiber *janet_loop1(void) {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
/* Run polling implementation only if pending timeouts or pending events */
|
/* Run polling implementation only if pending timeouts or pending events */
|
||||||
if (janet_vm.tq_count || janet_vm.listener_count) {
|
if (janet_vm.tq_count || janet_atomic_load(&janet_vm.listener_count)) {
|
||||||
janet_loop1_impl(has_timeout, to.when);
|
janet_loop1_impl(has_timeout, to.when);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -1452,7 +1473,7 @@ void janet_ev_deinit(void) {
|
||||||
CloseHandle(janet_vm.iocp);
|
CloseHandle(janet_vm.iocp);
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_register_stream(JanetStream *stream) {
|
static void janet_register_stream(JanetStream *stream) {
|
||||||
if (NULL == CreateIoCompletionPort(stream->handle, janet_vm.iocp, (ULONG_PTR) stream, 0)) {
|
if (NULL == CreateIoCompletionPort(stream->handle, janet_vm.iocp, (ULONG_PTR) stream, 0)) {
|
||||||
janet_panicf("failed to listen for events: %V", janet_ev_lasterr());
|
janet_panicf("failed to listen for events: %V", janet_ev_lasterr());
|
||||||
}
|
}
|
||||||
|
@ -1509,6 +1530,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void janet_stream_edge_triggered(JanetStream *stream) {
|
||||||
|
(void) stream;
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_stream_level_triggered(JanetStream *stream) {
|
||||||
|
(void) stream;
|
||||||
|
}
|
||||||
|
|
||||||
#elif defined(JANET_EV_EPOLL)
|
#elif defined(JANET_EV_EPOLL)
|
||||||
|
|
||||||
static JanetTimestamp ts_now(void) {
|
static JanetTimestamp ts_now(void) {
|
||||||
|
@ -1520,15 +1549,15 @@ static JanetTimestamp ts_now(void) {
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Wait for the next event */
|
/* Wait for the next event */
|
||||||
static void janet_register_stream(JanetStream *stream) {
|
static void janet_register_stream_impl(JanetStream *stream, int mod, int edge_trigger) {
|
||||||
struct epoll_event ev;
|
struct epoll_event ev;
|
||||||
ev.events = EPOLLET;
|
ev.events = edge_trigger ? EPOLLET : 0;
|
||||||
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) ev.events |= EPOLLIN;
|
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) ev.events |= EPOLLIN;
|
||||||
if (stream->flags & JANET_STREAM_WRITABLE) ev.events |= EPOLLOUT;
|
if (stream->flags & JANET_STREAM_WRITABLE) ev.events |= EPOLLOUT;
|
||||||
ev.data.ptr = stream;
|
ev.data.ptr = stream;
|
||||||
int status;
|
int status;
|
||||||
do {
|
do {
|
||||||
status = epoll_ctl(janet_vm.epoll, EPOLL_CTL_ADD, stream->handle, &ev);
|
status = epoll_ctl(janet_vm.epoll, mod ? EPOLL_CTL_MOD : EPOLL_CTL_ADD, stream->handle, &ev);
|
||||||
} while (status == -1 && errno == EINTR);
|
} while (status == -1 && errno == EINTR);
|
||||||
if (status == -1) {
|
if (status == -1) {
|
||||||
if (errno == EPERM) {
|
if (errno == EPERM) {
|
||||||
|
@ -1542,6 +1571,18 @@ static void janet_register_stream(JanetStream *stream) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void janet_register_stream(JanetStream *stream) {
|
||||||
|
janet_register_stream_impl(stream, 0, 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_stream_edge_triggered(JanetStream *stream) {
|
||||||
|
janet_register_stream_impl(stream, 1, 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_stream_level_triggered(JanetStream *stream) {
|
||||||
|
janet_register_stream_impl(stream, 1, 0);
|
||||||
|
}
|
||||||
|
|
||||||
#define JANET_EPOLL_MAX_EVENTS 64
|
#define JANET_EPOLL_MAX_EVENTS 64
|
||||||
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||||
struct itimerspec its;
|
struct itimerspec its;
|
||||||
|
@ -1671,14 +1712,15 @@ static void timestamp2timespec(struct timespec *t, JanetTimestamp ts) {
|
||||||
t->tv_nsec = ts == 0 ? 0 : (ts % 1000) * 1000000;
|
t->tv_nsec = ts == 0 ? 0 : (ts % 1000) * 1000000;
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_register_stream(JanetStream *stream) {
|
void janet_register_stream_impl(JanetStream *stream, int edge_trigger) {
|
||||||
struct kevent kevs[2];
|
struct kevent kevs[2];
|
||||||
int length = 0;
|
int length = 0;
|
||||||
|
int clear = edge_trigger ? EV_CLEAR : 0;
|
||||||
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
|
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
|
||||||
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_ADD | EV_ENABLE | EV_CLEAR, 0, 0, stream);
|
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_ADD | EV_ENABLE | clear, 0, 0, stream);
|
||||||
}
|
}
|
||||||
if (stream->flags & JANET_STREAM_WRITABLE) {
|
if (stream->flags & JANET_STREAM_WRITABLE) {
|
||||||
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_ADD | EV_ENABLE | EV_CLEAR, 0, 0, stream);
|
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_ADD | EV_ENABLE | clear, 0, 0, stream);
|
||||||
}
|
}
|
||||||
int status;
|
int status;
|
||||||
do {
|
do {
|
||||||
|
@ -1689,6 +1731,18 @@ void janet_register_stream(JanetStream *stream) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void janet_register_stream(JanetStream *stream) {
|
||||||
|
janet_register_stream_impl(stream, 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_stream_edge_triggered(JanetStream *stream) {
|
||||||
|
janet_register_stream_impl(stream, 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_stream_level_triggered(JanetStream *stream) {
|
||||||
|
janet_register_stream_impl(stream, 0);
|
||||||
|
}
|
||||||
|
|
||||||
#define JANET_KQUEUE_MAX_EVENTS 64
|
#define JANET_KQUEUE_MAX_EVENTS 64
|
||||||
|
|
||||||
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||||
|
@ -1811,15 +1865,30 @@ void janet_register_stream(JanetStream *stream) {
|
||||||
janet_vm.stream_count = new_count;
|
janet_vm.stream_count = new_count;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void janet_stream_edge_triggered(JanetStream *stream) {
|
||||||
|
(void) stream;
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_stream_level_triggered(JanetStream *stream) {
|
||||||
|
(void) stream;
|
||||||
|
}
|
||||||
|
|
||||||
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||||
|
|
||||||
/* set event flags */
|
/* set event flags */
|
||||||
for (size_t i = 0; i < janet_vm.stream_count; i++) {
|
for (size_t i = 0; i < janet_vm.stream_count; i++) {
|
||||||
JanetStream *stream = janet_vm.streams[i];
|
JanetStream *stream = janet_vm.streams[i];
|
||||||
janet_vm.fds[i + 1].events = 0;
|
struct pollfd *pfd = janet_vm.fds + i + 1;
|
||||||
janet_vm.fds[i + 1].revents = 0;
|
pfd->events = 0;
|
||||||
if (stream->read_fiber) janet_vm.fds[i + 1].events |= POLLIN;
|
pfd->revents = 0;
|
||||||
if (stream->write_fiber) janet_vm.fds[i + 1].events |= POLLOUT;
|
JanetFiber *rf = stream->read_fiber;
|
||||||
|
JanetFiber *wf = stream->write_fiber;
|
||||||
|
if (rf && rf->ev_callback) pfd->events |= POLLIN;
|
||||||
|
if (wf && wf->ev_callback) pfd->events |= POLLOUT;
|
||||||
|
/* Hack to ignore a file descriptor - make file descriptor negative if we want to ignore */
|
||||||
|
if (!pfd->events) {
|
||||||
|
pfd->fd = -pfd->fd;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Poll for events */
|
/* Poll for events */
|
||||||
|
@ -1836,6 +1905,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||||
JANET_EXIT("failed to poll events");
|
JANET_EXIT("failed to poll events");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Undo negative hack */
|
||||||
|
for (size_t i = 0; i < janet_vm.stream_count; i++) {
|
||||||
|
struct pollfd *pfd = janet_vm.fds + i + 1;
|
||||||
|
if (pfd->fd < 0) {
|
||||||
|
pfd->fd = -pfd->fd;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Check selfpipe */
|
/* Check selfpipe */
|
||||||
if (janet_vm.fds[0].revents & POLLIN) {
|
if (janet_vm.fds[0].revents & POLLIN) {
|
||||||
janet_vm.fds[0].revents = 0;
|
janet_vm.fds[0].revents = 0;
|
||||||
|
@ -2018,7 +2095,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
|
||||||
int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
|
int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
|
||||||
if (err) {
|
if (err) {
|
||||||
janet_free(init);
|
janet_free(init);
|
||||||
janet_panicf("%s", strerror(err));
|
janet_panicf("%s", janet_strerror(err));
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
@ -2031,33 +2108,35 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
|
||||||
if (return_value.fiber == NULL) {
|
if (return_value.fiber == NULL) {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
switch (return_value.tag) {
|
if (janet_fiber_can_resume(return_value.fiber)) {
|
||||||
default:
|
switch (return_value.tag) {
|
||||||
case JANET_EV_TCTAG_NIL:
|
default:
|
||||||
janet_schedule(return_value.fiber, janet_wrap_nil());
|
case JANET_EV_TCTAG_NIL:
|
||||||
break;
|
janet_schedule(return_value.fiber, janet_wrap_nil());
|
||||||
case JANET_EV_TCTAG_INTEGER:
|
break;
|
||||||
janet_schedule(return_value.fiber, janet_wrap_integer(return_value.argi));
|
case JANET_EV_TCTAG_INTEGER:
|
||||||
break;
|
janet_schedule(return_value.fiber, janet_wrap_integer(return_value.argi));
|
||||||
case JANET_EV_TCTAG_STRING:
|
break;
|
||||||
case JANET_EV_TCTAG_STRINGF:
|
case JANET_EV_TCTAG_STRING:
|
||||||
janet_schedule(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
case JANET_EV_TCTAG_STRINGF:
|
||||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
|
janet_schedule(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
||||||
break;
|
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
|
||||||
case JANET_EV_TCTAG_KEYWORD:
|
break;
|
||||||
janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
case JANET_EV_TCTAG_KEYWORD:
|
||||||
break;
|
janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
||||||
case JANET_EV_TCTAG_ERR_STRING:
|
break;
|
||||||
case JANET_EV_TCTAG_ERR_STRINGF:
|
case JANET_EV_TCTAG_ERR_STRING:
|
||||||
janet_cancel(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
case JANET_EV_TCTAG_ERR_STRINGF:
|
||||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
|
janet_cancel(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
||||||
break;
|
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
|
||||||
case JANET_EV_TCTAG_ERR_KEYWORD:
|
break;
|
||||||
janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
case JANET_EV_TCTAG_ERR_KEYWORD:
|
||||||
break;
|
janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
||||||
case JANET_EV_TCTAG_BOOLEAN:
|
break;
|
||||||
janet_schedule(return_value.fiber, janet_wrap_boolean(return_value.argi));
|
case JANET_EV_TCTAG_BOOLEAN:
|
||||||
break;
|
janet_schedule(return_value.fiber, janet_wrap_boolean(return_value.argi));
|
||||||
|
break;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
janet_gcunroot(janet_wrap_fiber(return_value.fiber));
|
janet_gcunroot(janet_wrap_fiber(return_value.fiber));
|
||||||
}
|
}
|
||||||
|
@ -2125,7 +2204,7 @@ Janet janet_ev_lasterr(void) {
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
Janet janet_ev_lasterr(void) {
|
Janet janet_ev_lasterr(void) {
|
||||||
return janet_cstringv(strerror(errno));
|
return janet_cstringv(janet_strerror(errno));
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
@ -2943,10 +3022,15 @@ JANET_CORE_FN(cfun_ev_sleep,
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_ev_deadline,
|
JANET_CORE_FN(cfun_ev_deadline,
|
||||||
"(ev/deadline sec &opt tocancel tocheck)",
|
"(ev/deadline sec &opt tocancel tocheck)",
|
||||||
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
|
"Schedules the event loop to try to cancel the `tocancel` "
|
||||||
"`tocancel` will be canceled as with `ev/cancel`. "
|
"task as with `ev/cancel`. After `sec` seconds, the event "
|
||||||
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
|
"loop will attempt cancellation of `tocancel` if the "
|
||||||
"`(fiber/current)` respectively. Returns `tocancel`.") {
|
"`tocheck` fiber is resumable. `sec` is a number that can "
|
||||||
|
"have a fractional part. `tocancel` defaults to "
|
||||||
|
"`(fiber/root)`, but if specified, must be a task (root "
|
||||||
|
"fiber). `tocheck` defaults to `(fiber/current)`, but if "
|
||||||
|
"specified, should be a fiber. Returns `tocancel` "
|
||||||
|
"immediately.") {
|
||||||
janet_arity(argc, 1, 3);
|
janet_arity(argc, 1, 3);
|
||||||
double sec = janet_getnumber(argv, 0);
|
double sec = janet_getnumber(argv, 0);
|
||||||
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm.root_fiber);
|
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm.root_fiber);
|
||||||
|
|
|
@ -76,4 +76,6 @@
|
||||||
#define __BSD_VISIBLE 1
|
#define __BSD_VISIBLE 1
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#define _FILE_OFFSET_BITS 64
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -999,13 +999,13 @@ typedef struct {
|
||||||
uint64_t x;
|
uint64_t x;
|
||||||
} sysv64_sseint_return;
|
} sysv64_sseint_return;
|
||||||
typedef sysv64_int_return janet_sysv64_variant_1(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
typedef sysv64_int_return janet_sysv64_variant_1(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
||||||
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
||||||
typedef sysv64_sse_return janet_sysv64_variant_2(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
typedef sysv64_sse_return janet_sysv64_variant_2(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
||||||
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
||||||
typedef sysv64_intsse_return janet_sysv64_variant_3(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
typedef sysv64_intsse_return janet_sysv64_variant_3(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
||||||
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
||||||
typedef sysv64_sseint_return janet_sysv64_variant_4(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
typedef sysv64_sseint_return janet_sysv64_variant_4(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
|
||||||
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
|
||||||
|
|
||||||
static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) {
|
static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) {
|
||||||
union {
|
union {
|
||||||
|
|
|
@ -662,7 +662,7 @@ JANET_CORE_FN(cfun_fiber_can_resume,
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_last_value,
|
JANET_CORE_FN(cfun_fiber_last_value,
|
||||||
"(fiber/last-value)",
|
"(fiber/last-value fiber)",
|
||||||
"Get the last value returned or signaled from the fiber.") {
|
"Get the last value returned or signaled from the fiber.") {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
|
|
@ -73,13 +73,13 @@ static void *int64_unmarshal(JanetMarshalContext *ctx) {
|
||||||
|
|
||||||
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
|
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
|
||||||
char str[32];
|
char str[32];
|
||||||
sprintf(str, "%" PRId64, *((int64_t *)p));
|
snprintf(str, sizeof(str), "%" PRId64, *((int64_t *)p));
|
||||||
janet_buffer_push_cstring(buffer, str);
|
janet_buffer_push_cstring(buffer, str);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
||||||
char str[32];
|
char str[32];
|
||||||
sprintf(str, "%" PRIu64, *((uint64_t *)p));
|
snprintf(str, sizeof(str), "%" PRIu64, *((uint64_t *)p));
|
||||||
janet_buffer_push_cstring(buffer, str);
|
janet_buffer_push_cstring(buffer, str);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -41,6 +41,11 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx);
|
||||||
static void *io_file_unmarshal(JanetMarshalContext *ctx);
|
static void *io_file_unmarshal(JanetMarshalContext *ctx);
|
||||||
static Janet io_file_next(void *p, Janet key);
|
static Janet io_file_next(void *p, Janet key);
|
||||||
|
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
#define ftell _ftelli64
|
||||||
|
#define fseek _fseeki64
|
||||||
|
#endif
|
||||||
|
|
||||||
const JanetAbstractType janet_file_type = {
|
const JanetAbstractType janet_file_type = {
|
||||||
"core/file",
|
"core/file",
|
||||||
cfun_io_gc,
|
cfun_io_gc,
|
||||||
|
@ -126,7 +131,7 @@ JANET_CORE_FN(cfun_io_temp,
|
||||||
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
||||||
FILE *tmp = tmpfile();
|
FILE *tmp = tmpfile();
|
||||||
if (!tmp)
|
if (!tmp)
|
||||||
janet_panicf("unable to create temporary file - %s", strerror(errno));
|
janet_panicf("unable to create temporary file - %s", janet_strerror(errno));
|
||||||
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
|
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -168,7 +173,7 @@ JANET_CORE_FN(cfun_io_fopen,
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return f ? janet_makefile(f, flags)
|
return f ? janet_makefile(f, flags)
|
||||||
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
|
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil())
|
||||||
: janet_wrap_nil();
|
: janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -337,7 +342,7 @@ JANET_CORE_FN(cfun_io_fseek,
|
||||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||||
if (iof->flags & JANET_FILE_CLOSED)
|
if (iof->flags & JANET_FILE_CLOSED)
|
||||||
janet_panic("file is closed");
|
janet_panic("file is closed");
|
||||||
long int offset = 0;
|
int64_t offset = 0;
|
||||||
int whence = SEEK_CUR;
|
int whence = SEEK_CUR;
|
||||||
if (argc >= 2) {
|
if (argc >= 2) {
|
||||||
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
|
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
|
||||||
|
@ -351,7 +356,7 @@ JANET_CORE_FN(cfun_io_fseek,
|
||||||
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
|
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
|
||||||
}
|
}
|
||||||
if (argc == 3) {
|
if (argc == 3) {
|
||||||
offset = (long) janet_getinteger64(argv, 2);
|
offset = (int64_t) janet_getinteger64(argv, 2);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
|
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
|
||||||
|
@ -365,7 +370,7 @@ JANET_CORE_FN(cfun_io_ftell,
|
||||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||||
if (iof->flags & JANET_FILE_CLOSED)
|
if (iof->flags & JANET_FILE_CLOSED)
|
||||||
janet_panic("file is closed");
|
janet_panic("file is closed");
|
||||||
long pos = ftell(iof->file);
|
int64_t pos = ftell(iof->file);
|
||||||
if (pos == -1) janet_panic("error getting position in file");
|
if (pos == -1) janet_panic("error getting position in file");
|
||||||
return janet_wrap_number((double)pos);
|
return janet_wrap_number((double)pos);
|
||||||
}
|
}
|
||||||
|
|
|
@ -185,6 +185,19 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags);
|
||||||
/* Prevent stack overflows */
|
/* Prevent stack overflows */
|
||||||
#define MARSH_STACKCHECK if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) janet_panic("stack overflow")
|
#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 */
|
/* Marshal a function env */
|
||||||
static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||||
MARSH_STACKCHECK;
|
MARSH_STACKCHECK;
|
||||||
|
@ -197,7 +210,9 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||||
}
|
}
|
||||||
janet_env_valid(env);
|
janet_env_valid(env);
|
||||||
janet_v_push(st->seen_envs, 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, 0);
|
||||||
pushint(st, env->length);
|
pushint(st, env->length);
|
||||||
Janet *values = env->as.fiber->data + env->offset;
|
Janet *values = env->as.fiber->data + env->offset;
|
||||||
|
@ -328,7 +343,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||||
while (i > 0) {
|
while (i > 0) {
|
||||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||||
if (frame->env) frame->flags |= JANET_STACKFRAME_HASENV;
|
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->flags);
|
||||||
pushint(st, frame->prevframe);
|
pushint(st, frame->prevframe);
|
||||||
int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode);
|
int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode);
|
||||||
|
|
|
@ -349,6 +349,26 @@ JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
|
||||||
return janet_wrap_number(janet_lcm(x, y));
|
return janet_wrap_number(janet_lcm(x, y));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
JANET_CORE_FN(janet_cfun_frexp, "(math/frexp x)",
|
||||||
|
"Returns a tuple of (mantissa, exponent) from number.") {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
double x = janet_getnumber(argv, 0);
|
||||||
|
int exp;
|
||||||
|
x = frexp(x, &exp);
|
||||||
|
Janet *result = janet_tuple_begin(2);
|
||||||
|
result[0] = janet_wrap_number(x);
|
||||||
|
result[1] = janet_wrap_number((double) exp);
|
||||||
|
return janet_wrap_tuple(janet_tuple_end(result));
|
||||||
|
}
|
||||||
|
|
||||||
|
JANET_CORE_FN(janet_cfun_ldexp, "(math/ldexp m e)",
|
||||||
|
"Creates a new number from a mantissa and an exponent.") {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
double x = janet_getnumber(argv, 0);
|
||||||
|
int32_t y = janet_getinteger(argv, 1);
|
||||||
|
return janet_wrap_number(ldexp(x, y));
|
||||||
|
}
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_math(JanetTable *env) {
|
void janet_lib_math(JanetTable *env) {
|
||||||
JanetRegExt math_cfuns[] = {
|
JanetRegExt math_cfuns[] = {
|
||||||
|
@ -395,6 +415,8 @@ void janet_lib_math(JanetTable *env) {
|
||||||
JANET_CORE_REG("math/next", janet_nextafter),
|
JANET_CORE_REG("math/next", janet_nextafter),
|
||||||
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
|
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
|
||||||
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
|
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
|
||||||
|
JANET_CORE_REG("math/frexp", janet_cfun_frexp),
|
||||||
|
JANET_CORE_REG("math/ldexp", janet_cfun_ldexp),
|
||||||
JANET_REG_END
|
JANET_REG_END
|
||||||
};
|
};
|
||||||
janet_core_cfuns_ext(env, NULL, math_cfuns);
|
janet_core_cfuns_ext(env, NULL, math_cfuns);
|
||||||
|
|
|
@ -79,12 +79,20 @@ const JanetAbstractType janet_address_type = {
|
||||||
|
|
||||||
/* maximum number of bytes in a socket address host (post name resolution) */
|
/* maximum number of bytes in a socket address host (post name resolution) */
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
|
#ifdef JANET_NO_IPV6
|
||||||
|
#define SA_ADDRSTRLEN (INET_ADDRSTRLEN + 1)
|
||||||
|
#else
|
||||||
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
|
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
|
||||||
|
#endif
|
||||||
typedef unsigned short in_port_t;
|
typedef unsigned short in_port_t;
|
||||||
#else
|
#else
|
||||||
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
|
#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)
|
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
|
||||||
#endif
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
static JanetStream *make_stream(JSock handle, uint32_t flags);
|
static JanetStream *make_stream(JSock handle, uint32_t flags);
|
||||||
|
|
||||||
|
@ -114,18 +122,13 @@ static void janet_net_socknoblock(JSock s) {
|
||||||
|
|
||||||
/* State machine for async connect */
|
/* State machine for async connect */
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
int did_connect;
|
|
||||||
} NetStateConnect;
|
|
||||||
|
|
||||||
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||||
JanetStream *stream = fiber->ev_stream;
|
JanetStream *stream = fiber->ev_stream;
|
||||||
NetStateConnect *state = (NetStateConnect *)fiber->ev_state;
|
|
||||||
switch (event) {
|
switch (event) {
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
#ifndef JANET_WINDOWS
|
#ifndef JANET_WINDOWS
|
||||||
/* Wait until we have an actually event before checking.
|
/* Wait until we have an actual event before checking.
|
||||||
* Windows doesn't support async connect with this, just try immediately.*/
|
* Windows doesn't support async connect with this, just try immediately.*/
|
||||||
case JANET_ASYNC_EVENT_INIT:
|
case JANET_ASYNC_EVENT_INIT:
|
||||||
#endif
|
#endif
|
||||||
|
@ -147,10 +150,9 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||||
#endif
|
#endif
|
||||||
if (r == 0) {
|
if (r == 0) {
|
||||||
if (res == 0) {
|
if (res == 0) {
|
||||||
state->did_connect = 1;
|
|
||||||
janet_schedule(fiber, janet_wrap_abstract(stream));
|
janet_schedule(fiber, janet_wrap_abstract(stream));
|
||||||
} else {
|
} else {
|
||||||
janet_cancel(fiber, janet_cstringv(strerror(res)));
|
janet_cancel(fiber, janet_cstringv(janet_strerror(res)));
|
||||||
stream->flags |= JANET_STREAM_TOCLOSE;
|
stream->flags |= JANET_STREAM_TOCLOSE;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
|
@ -160,10 +162,8 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||||
janet_async_end(fiber);
|
janet_async_end(fiber);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void net_sched_connect(JanetStream *stream) {
|
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
|
||||||
NetStateConnect *state = janet_malloc(sizeof(NetStateConnect));
|
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL);
|
||||||
state->did_connect = 0;
|
|
||||||
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, state);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* State machine for accepting connections. */
|
/* State machine for accepting connections. */
|
||||||
|
@ -319,6 +319,7 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio
|
||||||
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
|
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
|
||||||
memset(state, 0, sizeof(NetStateAccept));
|
memset(state, 0, sizeof(NetStateAccept));
|
||||||
state->function = fun;
|
state->function = fun;
|
||||||
|
if (fun) janet_stream_level_triggered(stream);
|
||||||
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
|
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -575,7 +576,6 @@ JANET_CORE_FN(cfun_net_connect,
|
||||||
}
|
}
|
||||||
|
|
||||||
net_sched_connect(stream);
|
net_sched_connect(stream);
|
||||||
janet_await();
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static const char *serverify_socket(JSock sfd) {
|
static const char *serverify_socket(JSock sfd) {
|
||||||
|
@ -746,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))};
|
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
|
||||||
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
||||||
}
|
}
|
||||||
|
#ifndef JANET_NO_IPV6
|
||||||
case AF_INET6: {
|
case AF_INET6: {
|
||||||
const struct sockaddr_in6 *sai6 = sa_any;
|
const struct sockaddr_in6 *sai6 = sa_any;
|
||||||
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
|
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
|
||||||
|
@ -754,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))};
|
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
|
||||||
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
||||||
}
|
}
|
||||||
|
#endif
|
||||||
#ifndef JANET_WINDOWS
|
#ifndef JANET_WINDOWS
|
||||||
case AF_UNIX: {
|
case AF_UNIX: {
|
||||||
const struct sockaddr_un *sun = sa_any;
|
const struct sockaddr_un *sun = sa_any;
|
||||||
|
@ -820,6 +822,7 @@ JANET_CORE_FN(cfun_stream_accept_loop,
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||||
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
|
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
|
||||||
JanetFunction *fun = janet_getfunction(argv, 1);
|
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);
|
janet_sched_accept(stream, fun);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -956,8 +959,10 @@ static const struct sockopt_type sockopt_type_list[] = {
|
||||||
{ "ip-multicast-ttl", IPPROTO_IP, IP_MULTICAST_TTL, JANET_NUMBER },
|
{ "ip-multicast-ttl", IPPROTO_IP, IP_MULTICAST_TTL, JANET_NUMBER },
|
||||||
{ "ip-add-membership", IPPROTO_IP, IP_ADD_MEMBERSHIP, JANET_POINTER },
|
{ "ip-add-membership", IPPROTO_IP, IP_ADD_MEMBERSHIP, JANET_POINTER },
|
||||||
{ "ip-drop-membership", IPPROTO_IP, IP_DROP_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-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
|
||||||
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
|
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
|
||||||
|
#endif
|
||||||
{ NULL, 0, 0, JANET_POINTER }
|
{ NULL, 0, 0, JANET_POINTER }
|
||||||
};
|
};
|
||||||
|
|
||||||
|
@ -994,7 +999,9 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
||||||
union {
|
union {
|
||||||
int v_int;
|
int v_int;
|
||||||
struct ip_mreq v_mreq;
|
struct ip_mreq v_mreq;
|
||||||
|
#ifndef JANET_NO_IPV6
|
||||||
struct ipv6_mreq v_mreq6;
|
struct ipv6_mreq v_mreq6;
|
||||||
|
#endif
|
||||||
} val;
|
} val;
|
||||||
|
|
||||||
void *optval = (void *)&val;
|
void *optval = (void *)&val;
|
||||||
|
@ -1012,12 +1019,14 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
||||||
val.v_mreq.imr_interface.s_addr = htonl(INADDR_ANY);
|
val.v_mreq.imr_interface.s_addr = htonl(INADDR_ANY);
|
||||||
inet_pton(AF_INET, addr, &val.v_mreq.imr_multiaddr.s_addr);
|
inet_pton(AF_INET, addr, &val.v_mreq.imr_multiaddr.s_addr);
|
||||||
optlen = sizeof(val.v_mreq);
|
optlen = sizeof(val.v_mreq);
|
||||||
|
#ifndef JANET_NO_IPV6
|
||||||
} else if (st->optname == IPV6_JOIN_GROUP || st->optname == IPV6_LEAVE_GROUP) {
|
} else if (st->optname == IPV6_JOIN_GROUP || st->optname == IPV6_LEAVE_GROUP) {
|
||||||
const char *addr = janet_getcstring(argv, 2);
|
const char *addr = janet_getcstring(argv, 2);
|
||||||
memset(&val.v_mreq6, 0, sizeof val.v_mreq6);
|
memset(&val.v_mreq6, 0, sizeof val.v_mreq6);
|
||||||
val.v_mreq6.ipv6mr_interface = 0;
|
val.v_mreq6.ipv6mr_interface = 0;
|
||||||
inet_pton(AF_INET6, addr, &val.v_mreq6.ipv6mr_multiaddr);
|
inet_pton(AF_INET6, addr, &val.v_mreq6.ipv6mr_multiaddr);
|
||||||
optlen = sizeof(val.v_mreq6);
|
optlen = sizeof(val.v_mreq6);
|
||||||
|
#endif
|
||||||
} else {
|
} else {
|
||||||
janet_panicf("invalid socket option type");
|
janet_panicf("invalid socket option type");
|
||||||
}
|
}
|
||||||
|
@ -1026,7 +1035,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
||||||
|
|
||||||
int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
|
int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
|
||||||
if (r == -1) {
|
if (r == -1) {
|
||||||
janet_panicf("setsockopt(%q): %s", argv[1], strerror(errno));
|
janet_panicf("setsockopt(%q): %s", argv[1], janet_strerror(errno));
|
||||||
}
|
}
|
||||||
|
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
|
|
212
src/core/os.c
212
src/core/os.c
|
@ -38,6 +38,7 @@
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
#include <sys/stat.h>
|
#include <sys/stat.h>
|
||||||
#include <signal.h>
|
#include <signal.h>
|
||||||
|
#include <locale.h>
|
||||||
|
|
||||||
#ifdef JANET_BSD
|
#ifdef JANET_BSD
|
||||||
#include <sys/sysctl.h>
|
#include <sys/sysctl.h>
|
||||||
|
@ -229,10 +230,11 @@ JANET_CORE_FN(os_compiler,
|
||||||
#undef janet_stringify
|
#undef janet_stringify
|
||||||
|
|
||||||
JANET_CORE_FN(os_exit,
|
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, "
|
"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.") {
|
"the exit with status equal the hash of x. If `force` is truthy will exit immediately and "
|
||||||
janet_arity(argc, 0, 1);
|
"skip cleanup code.") {
|
||||||
|
janet_arity(argc, 0, 2);
|
||||||
int status;
|
int status;
|
||||||
if (argc == 0) {
|
if (argc == 0) {
|
||||||
status = EXIT_SUCCESS;
|
status = EXIT_SUCCESS;
|
||||||
|
@ -242,7 +244,11 @@ JANET_CORE_FN(os_exit,
|
||||||
status = EXIT_FAILURE;
|
status = EXIT_FAILURE;
|
||||||
}
|
}
|
||||||
janet_deinit();
|
janet_deinit();
|
||||||
exit(status);
|
if (argc >= 2 && janet_truthy(argv[1])) {
|
||||||
|
_exit(status);
|
||||||
|
} else {
|
||||||
|
exit(status);
|
||||||
|
}
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -500,8 +506,11 @@ static int proc_get_status(JanetProc *proc) {
|
||||||
status = WEXITSTATUS(status);
|
status = WEXITSTATUS(status);
|
||||||
} else if (WIFSTOPPED(status)) {
|
} else if (WIFSTOPPED(status)) {
|
||||||
status = WSTOPSIG(status) + 128;
|
status = WSTOPSIG(status) + 128;
|
||||||
} else {
|
} else if (WIFSIGNALED(status)) {
|
||||||
status = WTERMSIG(status) + 128;
|
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;
|
return status;
|
||||||
}
|
}
|
||||||
|
@ -529,7 +538,9 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||||
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
|
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
|
||||||
janet_cancel(args.fiber, janet_wrap_string(s));
|
janet_cancel(args.fiber, janet_wrap_string(s));
|
||||||
} else {
|
} else {
|
||||||
janet_schedule(args.fiber, janet_wrap_integer(status));
|
if (janet_fiber_can_resume(args.fiber)) {
|
||||||
|
janet_schedule(args.fiber, janet_wrap_integer(status));
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -611,7 +622,11 @@ os_proc_wait_impl(JanetProc *proc) {
|
||||||
|
|
||||||
JANET_CORE_FN(os_proc_wait,
|
JANET_CORE_FN(os_proc_wait,
|
||||||
"(os/proc-wait proc)",
|
"(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);
|
janet_fixarity(argc, 1);
|
||||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
|
@ -640,7 +655,7 @@ static const struct keyword_signal signal_keywords[] = {
|
||||||
#ifdef SIGTERM
|
#ifdef SIGTERM
|
||||||
{"term", SIGTERM},
|
{"term", SIGTERM},
|
||||||
#endif
|
#endif
|
||||||
#ifdef SIGARLM
|
#ifdef SIGALRM
|
||||||
{"alrm", SIGALRM},
|
{"alrm", SIGALRM},
|
||||||
#endif
|
#endif
|
||||||
#ifdef SIGHUP
|
#ifdef SIGHUP
|
||||||
|
@ -722,10 +737,11 @@ static int get_signal_kw(const Janet *argv, int32_t n) {
|
||||||
JANET_CORE_FN(os_proc_kill,
|
JANET_CORE_FN(os_proc_kill,
|
||||||
"(os/proc-kill proc &opt wait signal)",
|
"(os/proc-kill proc &opt wait signal)",
|
||||||
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
|
"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 "
|
"handle on windows. If os/proc-wait already finished for proc, os/proc-kill raises an error. After "
|
||||||
"returns the exit code. Otherwise, returns `proc`. If signal is specified send it instead."
|
"sending signal to proc, if `wait` is truthy, will wait for the process to finish and return the exit "
|
||||||
"Signal keywords are named after their C counterparts but in lowercase with the leading "
|
"code by calling os/proc-wait. Otherwise, returns `proc`. If signal is specified, send it instead. "
|
||||||
"`SIG` stripped. Signals are ignored on windows.") {
|
"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);
|
janet_arity(argc, 1, 3);
|
||||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||||
if (proc->flags & JANET_PROC_WAITED) {
|
if (proc->flags & JANET_PROC_WAITED) {
|
||||||
|
@ -746,7 +762,7 @@ JANET_CORE_FN(os_proc_kill,
|
||||||
}
|
}
|
||||||
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
|
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
|
||||||
if (status) {
|
if (status) {
|
||||||
janet_panic(strerror(errno));
|
janet_panic(janet_strerror(errno));
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
/* After killing process we wait on it. */
|
/* After killing process we wait on it. */
|
||||||
|
@ -764,8 +780,9 @@ JANET_CORE_FN(os_proc_kill,
|
||||||
|
|
||||||
JANET_CORE_FN(os_proc_close,
|
JANET_CORE_FN(os_proc_close,
|
||||||
"(os/proc-close proc)",
|
"(os/proc-close proc)",
|
||||||
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
|
"Close pipes created by `os/spawn` if they have not been closed. Then, if os/proc-wait was not already "
|
||||||
"if they have not been closed. Returns nil.") {
|
"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);
|
janet_fixarity(argc, 1);
|
||||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
|
@ -875,8 +892,9 @@ JANET_CORE_FN(os_sigaction,
|
||||||
}
|
}
|
||||||
struct sigaction action;
|
struct sigaction action;
|
||||||
sigset_t mask;
|
sigset_t mask;
|
||||||
sigfillset(&mask);
|
sigaddset(&mask, sig);
|
||||||
memset(&action, 0, sizeof(action));
|
memset(&action, 0, sizeof(action));
|
||||||
|
action.sa_flags |= SA_RESTART;
|
||||||
if (can_interrupt) {
|
if (can_interrupt) {
|
||||||
#ifdef JANET_NO_INTERPRETER_INTERRUPT
|
#ifdef JANET_NO_INTERPRETER_INTERRUPT
|
||||||
janet_panic("interpreter interrupt not enabled");
|
janet_panic("interpreter interrupt not enabled");
|
||||||
|
@ -1257,7 +1275,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||||
status = execv(cargv[0], cargv);
|
status = execv(cargv[0], cargv);
|
||||||
}
|
}
|
||||||
} while (status == -1 && errno == EINTR);
|
} while (status == -1 && errno == EINTR);
|
||||||
janet_panicf("%p: %s", cargv[0], strerror(errno ? errno : ENOENT));
|
janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1314,7 +1332,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||||
os_execute_cleanup(envp, child_argv);
|
os_execute_cleanup(envp, child_argv);
|
||||||
if (status) {
|
if (status) {
|
||||||
/* correct for macos bug where errno is not set */
|
/* correct for macos bug where errno is not set */
|
||||||
janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT));
|
janet_panicf("%p: %s", argv[0], janet_strerror(errno ? errno : ENOENT));
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
@ -1369,21 +1387,26 @@ JANET_CORE_FN(os_execute,
|
||||||
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
|
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
|
||||||
"`env` is a table or struct mapping environment variables to values. It can also "
|
"`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. "
|
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
|
||||||
"These arguments should be core/file values. "
|
":in, :out, and :err should be core/file values or core/stream values. core/file values and core/stream "
|
||||||
"Returns the exit status of the program.") {
|
"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);
|
return os_execute_impl(argc, argv, JANET_EXECUTE_EXECUTE);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(os_spawn,
|
JANET_CORE_FN(os_spawn,
|
||||||
"(os/spawn args &opt flags env)",
|
"(os/spawn args &opt flags env)",
|
||||||
"Execute a program on the system and return a handle to the process. Otherwise, takes the "
|
"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. "
|
"same arguments as `os/execute`. Does not wait for the process. For each of the :in, :out, and :err keys "
|
||||||
"For each of the :in, :out, and :err keys to the `env` argument, one "
|
"of the `env` argument, one can also pass in the keyword `:pipe` to get streams for standard IO of the "
|
||||||
"can also pass in the keyword `:pipe` "
|
"subprocess that can be read from and written to. The returned value `proc` has the fields :in, :out, "
|
||||||
"to get streams for standard IO of the subprocess that can be read from and written to. "
|
":err, and the additional field :pid on unix-like platforms. `(os/proc-wait proc)` must be called to "
|
||||||
"The returned value `proc` has the fields :in, :out, :err, :return-code, and "
|
"rejoin the subprocess. After `(os/proc-wait proc)` finishes, proc gains a new field, :return-code. "
|
||||||
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
|
"If :x flag is passed to os/spawn, non-zero exit code will cause os/proc-wait to raise an error. "
|
||||||
"subprocess or `(os/proc-kill proc)`.") {
|
"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);
|
return os_execute_impl(argc, argv, JANET_EXECUTE_SPAWN);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1410,7 +1433,7 @@ JANET_CORE_FN(os_posix_fork,
|
||||||
result = fork();
|
result = fork();
|
||||||
} while (result == -1 && errno == EINTR);
|
} while (result == -1 && errno == EINTR);
|
||||||
if (result == -1) {
|
if (result == -1) {
|
||||||
janet_panic(strerror(errno));
|
janet_panic(janet_strerror(errno));
|
||||||
}
|
}
|
||||||
if (result) {
|
if (result) {
|
||||||
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
|
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
|
||||||
|
@ -1542,34 +1565,51 @@ JANET_CORE_FN(os_time,
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(os_clock,
|
JANET_CORE_FN(os_clock,
|
||||||
"(os/clock &opt source)",
|
"(os/clock &opt source format)",
|
||||||
"Return the number of whole + fractional seconds of the requested clock source.\n\n"
|
"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 "
|
"The `source` argument selects the clock source to use, when not specified the default "
|
||||||
"is `:realtime`:\n"
|
"is `:realtime`:\n"
|
||||||
"- :realtime: Return the real (i.e., wall-clock) time. This clock is affected by discontinuous "
|
"- :realtime: Return the real (i.e., wall-clock) time. This clock is affected by discontinuous "
|
||||||
" jumps in the system time\n"
|
" jumps in the system time\n"
|
||||||
"- :monotonic: Return the number of whole + fractional seconds since some fixed point in "
|
"- :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"
|
" 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_sandbox_assert(JANET_SANDBOX_HRTIME);
|
||||||
janet_arity(argc, 0, 1);
|
janet_arity(argc, 0, 2);
|
||||||
enum JanetTimeSource source = JANET_TIME_REALTIME;
|
|
||||||
if (argc == 1) {
|
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime");
|
||||||
JanetKeyword sourcestr = janet_getkeyword(argv, 0);
|
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
|
||||||
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
|
source = JANET_TIME_REALTIME;
|
||||||
source = JANET_TIME_REALTIME;
|
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
|
||||||
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
|
source = JANET_TIME_MONOTONIC;
|
||||||
source = JANET_TIME_MONOTONIC;
|
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
|
||||||
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
|
source = JANET_TIME_CPUTIME;
|
||||||
source = JANET_TIME_CPUTIME;
|
} else {
|
||||||
} else {
|
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
|
||||||
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
struct timespec tv;
|
struct timespec tv;
|
||||||
if (janet_gettime(&tv, source)) janet_panic("could not get time");
|
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,
|
JANET_CORE_FN(os_sleep,
|
||||||
|
@ -1605,7 +1645,7 @@ JANET_CORE_FN(os_isatty,
|
||||||
return janet_wrap_boolean(_isatty(fd));
|
return janet_wrap_boolean(_isatty(fd));
|
||||||
#else
|
#else
|
||||||
int fd = fileno(f);
|
int fd = fileno(f);
|
||||||
if (fd == -1) janet_panic(strerror(errno));
|
if (fd == -1) janet_panic(janet_strerror(errno));
|
||||||
return janet_wrap_boolean(isatty(fd));
|
return janet_wrap_boolean(isatty(fd));
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
@ -1840,7 +1880,7 @@ JANET_CORE_FN(os_mktime,
|
||||||
}
|
}
|
||||||
|
|
||||||
if (t == (time_t) -1) {
|
if (t == (time_t) -1) {
|
||||||
janet_panicf("%s", strerror(errno));
|
janet_panicf("%s", janet_strerror(errno));
|
||||||
}
|
}
|
||||||
|
|
||||||
return janet_wrap_number((double)t);
|
return janet_wrap_number((double)t);
|
||||||
|
@ -1852,6 +1892,43 @@ JANET_CORE_FN(os_mktime,
|
||||||
#define j_symlink symlink
|
#define j_symlink symlink
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
JANET_CORE_FN(os_setlocale,
|
||||||
|
"(os/setlocale &opt locale category)",
|
||||||
|
"Set the system locale, which affects how dates and numbers are formatted. "
|
||||||
|
"Passing nil to locale will return the current locale. Category can be one of:\n\n"
|
||||||
|
" * :all (default)\n"
|
||||||
|
" * :collate\n"
|
||||||
|
" * :ctype\n"
|
||||||
|
" * :monetary\n"
|
||||||
|
" * :numeric\n"
|
||||||
|
" * :time\n\n"
|
||||||
|
"Returns the new locale if set successfully, otherwise nil. Note that this will affect "
|
||||||
|
"other functions such as `os/strftime` and even `printf`.") {
|
||||||
|
janet_arity(argc, 0, 2);
|
||||||
|
const char *locale_name = janet_optcstring(argv, argc, 0, NULL);
|
||||||
|
int category_int = LC_ALL;
|
||||||
|
if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
|
||||||
|
if (janet_keyeq(argv[1], "all")) {
|
||||||
|
category_int = LC_ALL;
|
||||||
|
} else if (janet_keyeq(argv[1], "collate")) {
|
||||||
|
category_int = LC_COLLATE;
|
||||||
|
} else if (janet_keyeq(argv[1], "ctype")) {
|
||||||
|
category_int = LC_CTYPE;
|
||||||
|
} else if (janet_keyeq(argv[1], "monetary")) {
|
||||||
|
category_int = LC_MONETARY;
|
||||||
|
} else if (janet_keyeq(argv[1], "numeric")) {
|
||||||
|
category_int = LC_NUMERIC;
|
||||||
|
} else if (janet_keyeq(argv[1], "time")) {
|
||||||
|
category_int = LC_TIME;
|
||||||
|
} else {
|
||||||
|
janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[1]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
const char *old = setlocale(category_int, locale_name);
|
||||||
|
if (old == NULL) return janet_wrap_nil();
|
||||||
|
return janet_cstringv(old);
|
||||||
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(os_link,
|
JANET_CORE_FN(os_link,
|
||||||
"(os/link oldpath newpath &opt symlink)",
|
"(os/link oldpath newpath &opt symlink)",
|
||||||
"Create a link at newpath that points to oldpath and returns nil. "
|
"Create a link at newpath that points to oldpath and returns nil. "
|
||||||
|
@ -1869,7 +1946,7 @@ JANET_CORE_FN(os_link,
|
||||||
const char *oldpath = janet_getcstring(argv, 0);
|
const char *oldpath = janet_getcstring(argv, 0);
|
||||||
const char *newpath = janet_getcstring(argv, 1);
|
const char *newpath = janet_getcstring(argv, 1);
|
||||||
int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
|
int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
|
||||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
@ -1888,7 +1965,7 @@ JANET_CORE_FN(os_symlink,
|
||||||
const char *oldpath = janet_getcstring(argv, 0);
|
const char *oldpath = janet_getcstring(argv, 0);
|
||||||
const char *newpath = janet_getcstring(argv, 1);
|
const char *newpath = janet_getcstring(argv, 1);
|
||||||
int res = j_symlink(oldpath, newpath);
|
int res = j_symlink(oldpath, newpath);
|
||||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
@ -1910,7 +1987,7 @@ JANET_CORE_FN(os_mkdir,
|
||||||
#endif
|
#endif
|
||||||
if (res == 0) return janet_wrap_true();
|
if (res == 0) return janet_wrap_true();
|
||||||
if (errno == EEXIST) return janet_wrap_false();
|
if (errno == EEXIST) return janet_wrap_false();
|
||||||
janet_panicf("%s: %s", strerror(errno), path);
|
janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(os_rmdir,
|
JANET_CORE_FN(os_rmdir,
|
||||||
|
@ -1924,7 +2001,7 @@ JANET_CORE_FN(os_rmdir,
|
||||||
#else
|
#else
|
||||||
int res = rmdir(path);
|
int res = rmdir(path);
|
||||||
#endif
|
#endif
|
||||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1939,7 +2016,7 @@ JANET_CORE_FN(os_cd,
|
||||||
#else
|
#else
|
||||||
int res = chdir(path);
|
int res = chdir(path);
|
||||||
#endif
|
#endif
|
||||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1963,7 +2040,7 @@ JANET_CORE_FN(os_touch,
|
||||||
bufp = NULL;
|
bufp = NULL;
|
||||||
}
|
}
|
||||||
int res = utime(path, bufp);
|
int res = utime(path, bufp);
|
||||||
if (-1 == res) janet_panic(strerror(errno));
|
if (-1 == res) janet_panic(janet_strerror(errno));
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1973,7 +2050,7 @@ JANET_CORE_FN(os_remove,
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
const char *path = janet_getcstring(argv, 0);
|
const char *path = janet_getcstring(argv, 0);
|
||||||
int status = remove(path);
|
int status = remove(path);
|
||||||
if (-1 == status) janet_panicf("%s: %s", strerror(errno), path);
|
if (-1 == status) janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1992,7 +2069,7 @@ JANET_CORE_FN(os_readlink,
|
||||||
const char *path = janet_getcstring(argv, 0);
|
const char *path = janet_getcstring(argv, 0);
|
||||||
ssize_t len = readlink(path, buffer, sizeof buffer);
|
ssize_t len = readlink(path, buffer, sizeof buffer);
|
||||||
if (len < 0 || (size_t)len >= sizeof buffer)
|
if (len < 0 || (size_t)len >= sizeof buffer)
|
||||||
janet_panicf("%s: %s", strerror(errno), path);
|
janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_stringv((const uint8_t *)buffer, len);
|
return janet_stringv((const uint8_t *)buffer, len);
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
@ -2287,7 +2364,7 @@ JANET_CORE_FN(os_chmod,
|
||||||
#else
|
#else
|
||||||
int res = chmod(path, os_getmode(argv, 1));
|
int res = chmod(path, os_getmode(argv, 1));
|
||||||
#endif
|
#endif
|
||||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -2323,7 +2400,7 @@ JANET_CORE_FN(os_dir,
|
||||||
janet_panicf("path too long: %s", dir);
|
janet_panicf("path too long: %s", dir);
|
||||||
sprintf(pattern, "%s/*", dir);
|
sprintf(pattern, "%s/*", dir);
|
||||||
intptr_t res = _findfirst(pattern, &afile);
|
intptr_t res = _findfirst(pattern, &afile);
|
||||||
if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
|
if (-1 == res) janet_panicv(janet_cstringv(janet_strerror(errno)));
|
||||||
do {
|
do {
|
||||||
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
|
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
|
||||||
janet_array_push(paths, janet_cstringv(afile.name));
|
janet_array_push(paths, janet_cstringv(afile.name));
|
||||||
|
@ -2334,8 +2411,18 @@ JANET_CORE_FN(os_dir,
|
||||||
/* Read directory items with opendir / readdir / closedir */
|
/* Read directory items with opendir / readdir / closedir */
|
||||||
struct dirent *dp;
|
struct dirent *dp;
|
||||||
DIR *dfd = opendir(dir);
|
DIR *dfd = opendir(dir);
|
||||||
if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
|
if (dfd == NULL) janet_panicf("cannot open directory %s: %s", dir, janet_strerror(errno));
|
||||||
while ((dp = readdir(dfd)) != NULL) {
|
for (;;) {
|
||||||
|
errno = 0;
|
||||||
|
dp = readdir(dfd);
|
||||||
|
if (dp == NULL) {
|
||||||
|
if (errno) {
|
||||||
|
int olderr = errno;
|
||||||
|
closedir(dfd);
|
||||||
|
janet_panicf("failed to read directory %s: %s", dir, janet_strerror(olderr));
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
|
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
|
@ -2355,7 +2442,7 @@ JANET_CORE_FN(os_rename,
|
||||||
const char *dest = janet_getcstring(argv, 1);
|
const char *dest = janet_getcstring(argv, 1);
|
||||||
int status = rename(src, dest);
|
int status = rename(src, dest);
|
||||||
if (status) {
|
if (status) {
|
||||||
janet_panic(strerror(errno));
|
janet_panic(janet_strerror(errno));
|
||||||
}
|
}
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
@ -2375,7 +2462,7 @@ JANET_CORE_FN(os_realpath,
|
||||||
#else
|
#else
|
||||||
char *dest = realpath(src, NULL);
|
char *dest = realpath(src, NULL);
|
||||||
#endif
|
#endif
|
||||||
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
|
if (NULL == dest) janet_panicf("%s: %s", janet_strerror(errno), src);
|
||||||
Janet ret = janet_cstringv(dest);
|
Janet ret = janet_cstringv(dest);
|
||||||
janet_free(dest);
|
janet_free(dest);
|
||||||
return ret;
|
return ret;
|
||||||
|
@ -2649,6 +2736,7 @@ void janet_lib_os(JanetTable *env) {
|
||||||
JANET_CORE_REG("os/strftime", os_strftime),
|
JANET_CORE_REG("os/strftime", os_strftime),
|
||||||
JANET_CORE_REG("os/sleep", os_sleep),
|
JANET_CORE_REG("os/sleep", os_sleep),
|
||||||
JANET_CORE_REG("os/isatty", os_isatty),
|
JANET_CORE_REG("os/isatty", os_isatty),
|
||||||
|
JANET_CORE_REG("os/setlocale", os_setlocale),
|
||||||
|
|
||||||
/* env functions */
|
/* env functions */
|
||||||
JANET_CORE_REG("os/environ", os_environ),
|
JANET_CORE_REG("os/environ", os_environ),
|
||||||
|
|
106
src/core/peg.c
106
src/core/peg.c
|
@ -39,6 +39,10 @@
|
||||||
typedef struct {
|
typedef struct {
|
||||||
const uint8_t *text_start;
|
const uint8_t *text_start;
|
||||||
const uint8_t *text_end;
|
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 uint32_t *bytecode;
|
||||||
const Janet *constants;
|
const Janet *constants;
|
||||||
JanetArray *captures;
|
JanetArray *captures;
|
||||||
|
@ -114,12 +118,12 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
|
||||||
/* Generate if not made yet */
|
/* Generate if not made yet */
|
||||||
if (s->linemaplen < 0) {
|
if (s->linemaplen < 0) {
|
||||||
int32_t newline_count = 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++;
|
if (*c == '\n') newline_count++;
|
||||||
}
|
}
|
||||||
int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count);
|
int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count);
|
||||||
size_t index = 0;
|
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);
|
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
|
||||||
}
|
}
|
||||||
s->linemaplen = newline_count;
|
s->linemaplen = newline_count;
|
||||||
|
@ -179,7 +183,7 @@ static const uint8_t *peg_rule(
|
||||||
const uint32_t *rule,
|
const uint32_t *rule,
|
||||||
const uint8_t *text) {
|
const uint8_t *text) {
|
||||||
tail:
|
tail:
|
||||||
switch (*rule & 0x1F) {
|
switch (*rule) {
|
||||||
default:
|
default:
|
||||||
janet_panic("unexpected opcode");
|
janet_panic("unexpected opcode");
|
||||||
return NULL;
|
return NULL;
|
||||||
|
@ -482,6 +486,68 @@ tail:
|
||||||
return result;
|
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_REPLACE:
|
||||||
case RULE_MATCHTIME: {
|
case RULE_MATCHTIME: {
|
||||||
uint32_t tag = rule[3];
|
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);
|
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
|
#ifdef JANET_INT_TYPES
|
||||||
#define JANET_MAX_READINT_WIDTH 8
|
#define JANET_MAX_READINT_WIDTH 8
|
||||||
#else
|
#else
|
||||||
|
@ -1190,6 +1272,8 @@ static const SpecialPair peg_specials[] = {
|
||||||
{"sequence", spec_sequence},
|
{"sequence", spec_sequence},
|
||||||
{"set", spec_set},
|
{"set", spec_set},
|
||||||
{"some", spec_some},
|
{"some", spec_some},
|
||||||
|
{"split", spec_split},
|
||||||
|
{"sub", spec_sub},
|
||||||
{"thru", spec_thru},
|
{"thru", spec_thru},
|
||||||
{"to", spec_to},
|
{"to", spec_to},
|
||||||
{"uint", spec_uint_le},
|
{"uint", spec_uint_le},
|
||||||
|
@ -1431,7 +1515,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||||
uint32_t instr = bytecode[i];
|
uint32_t instr = bytecode[i];
|
||||||
uint32_t *rule = bytecode + i;
|
uint32_t *rule = bytecode + i;
|
||||||
op_flags[i] |= 0x02;
|
op_flags[i] |= 0x02;
|
||||||
switch (instr & 0x1F) {
|
switch (instr) {
|
||||||
case RULE_LITERAL:
|
case RULE_LITERAL:
|
||||||
i += 2 + ((rule[1] + 3) >> 2);
|
i += 2 + ((rule[1] + 3) >> 2);
|
||||||
break;
|
break;
|
||||||
|
@ -1524,6 +1608,15 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||||
op_flags[rule[1]] |= 0x01;
|
op_flags[rule[1]] |= 0x01;
|
||||||
i += 4;
|
i += 4;
|
||||||
break;
|
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_ERROR:
|
||||||
case RULE_DROP:
|
case RULE_DROP:
|
||||||
case RULE_NOT:
|
case RULE_NOT:
|
||||||
|
@ -1652,7 +1745,7 @@ typedef struct {
|
||||||
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||||
PegCall ret;
|
PegCall ret;
|
||||||
int32_t min = get_replace ? 3 : 2;
|
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) &&
|
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
||||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
||||||
ret.peg = janet_unwrap_abstract(argv[0]);
|
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.mode = PEG_MODE_NORMAL;
|
||||||
ret.s.text_start = ret.bytes.bytes;
|
ret.s.text_start = ret.bytes.bytes;
|
||||||
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
|
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.depth = JANET_RECURSION_GUARD;
|
||||||
ret.s.captures = janet_array(0);
|
ret.s.captures = janet_array(0);
|
||||||
ret.s.tagged_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,
|
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. "
|
"Replace first match of `peg` in `text` with `subst`, returning a new buffer. "
|
||||||
"The peg does not need to make captures to do replacement. "
|
"The peg does not need to make captures to do replacement. "
|
||||||
"If `subst` is a function, it will be called with the "
|
"If `subst` is a function, it will be called with the "
|
||||||
|
|
|
@ -379,8 +379,10 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||||
break;
|
break;
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER:
|
||||||
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
|
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
|
||||||
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
|
double num = janet_unwrap_number(x);
|
||||||
S->buffer->count += count;
|
if (isnan(num)) return 1;
|
||||||
|
if (isinf(num)) return 1;
|
||||||
|
janet_buffer_dtostr(S->buffer, num);
|
||||||
break;
|
break;
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD:
|
||||||
|
@ -830,7 +832,7 @@ static const char *scanformat(
|
||||||
if (loc != NULL && *loc != '\0') {
|
if (loc != NULL && *loc != '\0') {
|
||||||
const char *mapping = get_fmt_mapping(*p2++);
|
const char *mapping = get_fmt_mapping(*p2++);
|
||||||
size_t len = strlen(mapping);
|
size_t len = strlen(mapping);
|
||||||
strcpy(form, mapping);
|
memcpy(form, mapping, len);
|
||||||
form += len;
|
form += len;
|
||||||
} else {
|
} else {
|
||||||
*(form++) = *(p2++);
|
*(form++) = *(p2++);
|
||||||
|
|
|
@ -149,7 +149,7 @@ static int destructure(JanetCompiler *c,
|
||||||
JanetTable *attr) {
|
JanetTable *attr) {
|
||||||
switch (janet_type(left)) {
|
switch (janet_type(left)) {
|
||||||
default:
|
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;
|
return 1;
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
/* Leaf, assign right to left */
|
/* Leaf, assign right to left */
|
||||||
|
@ -531,17 +531,11 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
|
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
|
||||||
static int janetc_check_nil_form(JanetFopts opts, Janet x, Janet *capture, uint32_t fun_tag) {
|
static int janetc_check_nil_form(Janet x, Janet *capture, uint32_t fun_tag) {
|
||||||
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
||||||
JanetTuple tup = janet_unwrap_tuple(x);
|
JanetTuple tup = janet_unwrap_tuple(x);
|
||||||
if (3 != janet_tuple_length(tup)) return 0;
|
if (3 != janet_tuple_length(tup)) return 0;
|
||||||
Janet op1 = tup[0];
|
Janet op1 = tup[0];
|
||||||
if (janet_checktype(op1, JANET_SYMBOL)) {
|
|
||||||
Janet entry = janet_table_get(opts.compiler->env, op1);
|
|
||||||
if (janet_checktype(entry, JANET_TABLE)) {
|
|
||||||
op1 = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("value"));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
|
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
|
||||||
JanetFunction *fun = janet_unwrap_function(op1);
|
JanetFunction *fun = janet_unwrap_function(op1);
|
||||||
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
||||||
|
@ -601,10 +595,9 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
janetc_scope(&condscope, c, 0, "if");
|
janetc_scope(&condscope, c, 0, "if");
|
||||||
|
|
||||||
Janet condform = argv[0];
|
Janet condform = argv[0];
|
||||||
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
|
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
|
||||||
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
||||||
}
|
} else if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
|
||||||
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
|
|
||||||
ifnjmp = JOP_JUMP_IF_NIL;
|
ifnjmp = JOP_JUMP_IF_NIL;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -613,7 +606,11 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
/* Check constant condition. */
|
/* Check constant condition. */
|
||||||
/* TODO: Use type info for more short circuits */
|
/* TODO: Use type info for more short circuits */
|
||||||
if (cond.flags & JANET_SLOT_CONSTANT) {
|
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 */
|
/* Swap the true and false bodies */
|
||||||
Janet temp = falsebody;
|
Janet temp = falsebody;
|
||||||
falsebody = truebody;
|
falsebody = truebody;
|
||||||
|
@ -808,12 +805,12 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||||
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
|
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
|
||||||
* more efficiently. */
|
* more efficiently. */
|
||||||
Janet condform = argv[0];
|
Janet condform = argv[0];
|
||||||
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
|
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
|
||||||
is_nil_form = 1;
|
is_nil_form = 1;
|
||||||
ifjmp = JOP_JUMP_IF_NIL;
|
ifjmp = JOP_JUMP_IF_NIL;
|
||||||
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
||||||
}
|
}
|
||||||
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
|
if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
|
||||||
is_notnil_form = 1;
|
is_notnil_form = 1;
|
||||||
ifjmp = JOP_JUMP_IF_NOT_NIL;
|
ifjmp = JOP_JUMP_IF_NOT_NIL;
|
||||||
ifnjmp = JOP_JUMP_IF_NIL;
|
ifnjmp = JOP_JUMP_IF_NIL;
|
||||||
|
@ -928,6 +925,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
int structarg = 0;
|
int structarg = 0;
|
||||||
int allow_extra = 0;
|
int allow_extra = 0;
|
||||||
int selfref = 0;
|
int selfref = 0;
|
||||||
|
int hasname = 0;
|
||||||
int seenamp = 0;
|
int seenamp = 0;
|
||||||
int seenopt = 0;
|
int seenopt = 0;
|
||||||
int namedargs = 0;
|
int namedargs = 0;
|
||||||
|
@ -946,6 +944,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
head = argv[0];
|
head = argv[0];
|
||||||
if (janet_checktype(head, JANET_SYMBOL)) {
|
if (janet_checktype(head, JANET_SYMBOL)) {
|
||||||
selfref = 1;
|
selfref = 1;
|
||||||
|
hasname = 1;
|
||||||
|
parami = 1;
|
||||||
|
} else if (janet_checktype(head, JANET_KEYWORD)) {
|
||||||
|
hasname = 1;
|
||||||
parami = 1;
|
parami = 1;
|
||||||
}
|
}
|
||||||
if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
|
if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
|
||||||
|
@ -1106,7 +1108,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
|
|
||||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
|
||||||
janet_def_addflags(def);
|
janet_def_addflags(def);
|
||||||
defindex = janetc_addfuncdef(c, def);
|
defindex = janetc_addfuncdef(c, def);
|
||||||
|
|
||||||
|
|
|
@ -149,6 +149,11 @@ struct JanetVM {
|
||||||
JanetTraversalNode *traversal_top;
|
JanetTraversalNode *traversal_top;
|
||||||
JanetTraversalNode *traversal_base;
|
JanetTraversalNode *traversal_base;
|
||||||
|
|
||||||
|
/* Thread safe strerror error buffer - for janet_strerror */
|
||||||
|
#ifndef JANET_WINDOWS
|
||||||
|
char strerror_buf[256];
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Event loop and scheduler globals */
|
/* Event loop and scheduler globals */
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
size_t tq_count;
|
size_t tq_count;
|
||||||
|
|
|
@ -549,8 +549,8 @@ JANET_CORE_FN(cfun_string_format,
|
||||||
"- `a`, `A`: floating point number, formatted as a hexadecimal number.\n"
|
"- `a`, `A`: floating point number, formatted as a hexadecimal number.\n"
|
||||||
"- `s`: formatted as a string, precision indicates padding and maximum length.\n"
|
"- `s`: formatted as a string, precision indicates padding and maximum length.\n"
|
||||||
"- `t`: emit the type of the given value.\n"
|
"- `t`: emit the type of the given value.\n"
|
||||||
"- `v`: format with (describe x)"
|
"- `v`: format with (describe x)\n"
|
||||||
"- `V`: format with (string x)"
|
"- `V`: format with (string x)\n"
|
||||||
"- `j`: format to jdn (Janet data notation).\n"
|
"- `j`: format to jdn (Janet data notation).\n"
|
||||||
"\n"
|
"\n"
|
||||||
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
|
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
|
||||||
|
|
|
@ -490,3 +490,18 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
void janet_buffer_dtostr(JanetBuffer *buffer, double x) {
|
||||||
|
#define BUFSIZE 32
|
||||||
|
janet_buffer_extra(buffer, BUFSIZE);
|
||||||
|
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%.17g", x);
|
||||||
|
#undef BUFSIZE
|
||||||
|
/* fix locale issues with commas */
|
||||||
|
for (int i = 0; i < count; i++) {
|
||||||
|
char c = buffer->data[buffer->count + i];
|
||||||
|
if (c == ',') {
|
||||||
|
buffer->data[buffer->count + i] = '.';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
buffer->count += count;
|
||||||
|
}
|
||||||
|
|
|
@ -234,6 +234,7 @@ const uint8_t *janet_symbol_gen(void) {
|
||||||
head->hash = hash;
|
head->hash = hash;
|
||||||
sym = (uint8_t *)(head->data);
|
sym = (uint8_t *)(head->data);
|
||||||
memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
|
memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
|
||||||
|
sym[head->length] = 0;
|
||||||
janet_symcache_put((const uint8_t *)sym, bucket);
|
janet_symcache_put((const uint8_t *)sym, bucket);
|
||||||
return (const uint8_t *)sym;
|
return (const uint8_t *)sym;
|
||||||
}
|
}
|
||||||
|
|
|
@ -953,6 +953,20 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
|
||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* Better strerror (thread-safe if available) */
|
||||||
|
const char *janet_strerror(int e) {
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
/* Microsoft strerror seems sane here and is thread safe by default */
|
||||||
|
return strerror(e);
|
||||||
|
#elif defined(_GNU_SOURCE)
|
||||||
|
/* See https://linux.die.net/man/3/strerror_r */
|
||||||
|
return strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
|
||||||
|
#else
|
||||||
|
strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
|
||||||
|
return janet_vm.strerror_buf;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
/* Setting C99 standard makes this not available, but it should
|
/* Setting C99 standard makes this not available, but it should
|
||||||
* work/link properly if we detect a BSD */
|
* work/link properly if we detect a BSD */
|
||||||
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||||
|
@ -960,6 +974,7 @@ void arc4random_buf(void *buf, size_t nbytes);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
int janet_cryptorand(uint8_t *out, size_t n) {
|
int janet_cryptorand(uint8_t *out, size_t n) {
|
||||||
|
#ifndef JANET_NO_CRYPTORAND
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
|
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
|
||||||
unsigned int v;
|
unsigned int v;
|
||||||
|
@ -971,7 +986,10 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return 0;
|
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
|
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||||
to be uniformly supported on linux distros.
|
to be uniformly supported on linux distros.
|
||||||
On Mac, arc4random_buf wasn't available on until 10.7.
|
On Mac, arc4random_buf wasn't available on until 10.7.
|
||||||
|
@ -993,12 +1011,10 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
||||||
}
|
}
|
||||||
RETRY_EINTR(rc, close(randfd));
|
RETRY_EINTR(rc, close(randfd));
|
||||||
return 0;
|
return 0;
|
||||||
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
#endif
|
||||||
arc4random_buf(out, n);
|
|
||||||
return 0;
|
|
||||||
#else
|
#else
|
||||||
(void) n;
|
|
||||||
(void) out;
|
(void) out;
|
||||||
|
(void) n;
|
||||||
return -1;
|
return -1;
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
|
@ -49,11 +49,11 @@
|
||||||
#ifndef JANET_EXIT
|
#ifndef JANET_EXIT
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#define JANET_EXIT(m) do { \
|
#define JANET_EXIT(m) do { \
|
||||||
fprintf(stderr, "janet interpreter runtime error at line %d in file %s: %s\n",\
|
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\
|
||||||
__LINE__,\
|
__LINE__,\
|
||||||
__FILE__,\
|
__FILE__,\
|
||||||
(m));\
|
(m));\
|
||||||
exit(1);\
|
abort();\
|
||||||
} while (0)
|
} while (0)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
@ -80,6 +80,8 @@ void janet_memempty(JanetKV *mem, int32_t count);
|
||||||
void *janet_memalloc_empty(int32_t count);
|
void *janet_memalloc_empty(int32_t count);
|
||||||
JanetTable *janet_get_core_table(const char *name);
|
JanetTable *janet_get_core_table(const char *name);
|
||||||
void janet_def_addflags(JanetFuncDef *def);
|
void janet_def_addflags(JanetFuncDef *def);
|
||||||
|
void janet_buffer_dtostr(JanetBuffer *buffer, double x);
|
||||||
|
const char *janet_strerror(int e);
|
||||||
const void *janet_strbinsearch(
|
const void *janet_strbinsearch(
|
||||||
const void *tab,
|
const void *tab,
|
||||||
size_t tabcount,
|
size_t tabcount,
|
||||||
|
|
|
@ -318,7 +318,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
|
||||||
Janet lr = janet_method_lookup(rhs, rmethod);
|
Janet lr = janet_method_lookup(rhs, rmethod);
|
||||||
Janet argv[2] = { rhs, lhs };
|
Janet argv[2] = { rhs, lhs };
|
||||||
if (janet_checktype(lr, JANET_NIL)) {
|
if (janet_checktype(lr, JANET_NIL)) {
|
||||||
janet_panicf("could not find method :%s for %v, or :%s for %v",
|
janet_panicf("could not find method :%s for %v or :%s for %v",
|
||||||
lmethod, lhs,
|
lmethod, lhs,
|
||||||
rmethod, rhs);
|
rmethod, rhs);
|
||||||
}
|
}
|
||||||
|
|
|
@ -112,7 +112,8 @@ extern "C" {
|
||||||
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|
||||||
|| (defined(__ppc64__) || defined(__PPC64__)) \
|
|| (defined(__ppc64__) || defined(__PPC64__)) \
|
||||||
|| defined(__aarch64__) /* ARM 64-bit */ \
|
|| 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
|
#define JANET_64 1
|
||||||
#else
|
#else
|
||||||
#define JANET_32 1
|
#define JANET_32 1
|
||||||
|
@ -636,6 +637,12 @@ 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. */
|
/* 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);
|
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
|
#endif
|
||||||
|
|
||||||
/* Janet uses atomic integers in several places for synchronization between threads and
|
/* Janet uses atomic integers in several places for synchronization between threads and
|
||||||
|
@ -647,6 +654,7 @@ typedef int32_t JanetAtomicInt;
|
||||||
#endif
|
#endif
|
||||||
JANET_API JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x);
|
JANET_API JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x);
|
||||||
JANET_API JanetAtomicInt janet_atomic_dec(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
|
/* 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
|
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||||
|
@ -2139,7 +2147,9 @@ typedef enum {
|
||||||
RULE_LINE, /* [tag] */
|
RULE_LINE, /* [tag] */
|
||||||
RULE_COLUMN, /* [tag] */
|
RULE_COLUMN, /* [tag] */
|
||||||
RULE_UNREF, /* [rule, tag] */
|
RULE_UNREF, /* [rule, tag] */
|
||||||
RULE_CAPTURE_NUM /* [rule, tag] */
|
RULE_CAPTURE_NUM, /* [rule, tag] */
|
||||||
|
RULE_SUB, /* [rule, rule] */
|
||||||
|
RULE_SPLIT /* [rule, rule] */
|
||||||
} JanetPegOpcod;
|
} JanetPegOpcod;
|
||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
|
|
|
@ -51,5 +51,13 @@
|
||||||
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
|
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
|
||||||
(assert (= ((f 10) 37) 47) "asm environment tables")
|
(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)
|
(end-suite)
|
||||||
|
|
||||||
|
|
|
@ -241,6 +241,16 @@
|
||||||
(assert (pos? (% x 4)) "generate in loop"))
|
(assert (pos? (% x 4)) "generate in loop"))
|
||||||
(assert (= gencount 75) "generate loop count")
|
(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
|
# Even and odd
|
||||||
# ff163a5ae
|
# ff163a5ae
|
||||||
(assert (odd? 9) "odd? 1")
|
(assert (odd? 9) "odd? 1")
|
||||||
|
@ -354,7 +364,7 @@
|
||||||
"sort 5")
|
"sort 5")
|
||||||
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
|
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
|
||||||
|
|
||||||
# #1283
|
# #1283
|
||||||
(assert (deep=
|
(assert (deep=
|
||||||
(partition 2 (generate [ i :in [:a :b :c :d :e]] i))
|
(partition 2 (generate [ i :in [:a :b :c :d :e]] i))
|
||||||
'@[(:a :b) (:c :d) (:e)]))
|
'@[(:a :b) (:c :d) (:e)]))
|
||||||
|
@ -945,10 +955,28 @@
|
||||||
(defn case-4 [&]
|
(defn case-4 [&]
|
||||||
(def x (break (break (break)))))
|
(def x (break (break (break)))))
|
||||||
(bytecode-roundtrip case-4)
|
(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
|
# Debug bytecode of these functions
|
||||||
# (pp (disasm case-1))
|
# (pp (disasm case-1))
|
||||||
# (pp (disasm case-2))
|
# (pp (disasm case-2))
|
||||||
# (pp (disasm case-3))
|
# (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)
|
(end-suite)
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
# Copyright (c) 2023 Calvin Rose
|
# Copyright (c) 2024 Calvin Rose
|
||||||
#
|
#
|
||||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
# of this software and associated documentation files (the "Software"), to
|
# of this software and associated documentation files (the "Software"), to
|
||||||
|
@ -77,6 +77,46 @@
|
||||||
(buffer/push-string b5 "456" @"789")
|
(buffer/push-string b5 "456" @"789")
|
||||||
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
|
(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
|
# Buffer from bytes
|
||||||
(assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1")
|
(assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1")
|
||||||
(assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2")
|
(assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2")
|
||||||
|
@ -122,5 +162,20 @@
|
||||||
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
|
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
|
||||||
"buffer/push-at 3")
|
"buffer/push-at 3")
|
||||||
|
|
||||||
|
# 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)
|
(end-suite)
|
||||||
|
|
||||||
|
|
|
@ -21,6 +21,9 @@
|
||||||
(import ./helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite)
|
(start-suite)
|
||||||
|
|
||||||
|
(def test-port (os/getenv "JANET_TEST_PORT" "8761"))
|
||||||
|
(def test-host (os/getenv "JANET_TEST_HOST" "127.0.0.1"))
|
||||||
|
|
||||||
# Subprocess
|
# Subprocess
|
||||||
# 5e1a8c86f
|
# 5e1a8c86f
|
||||||
(def janet (dyn *executable*))
|
(def janet (dyn *executable*))
|
||||||
|
@ -192,11 +195,11 @@
|
||||||
(net/write stream b)
|
(net/write stream b)
|
||||||
(buffer/clear 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")
|
(assert s "made server 1")
|
||||||
|
|
||||||
(defn test-echo [msg]
|
(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)
|
(net/write conn msg)
|
||||||
(def res (net/read conn 1024))
|
(def res (net/read conn 1024))
|
||||||
(assert (= (string res) msg) (string "echo " msg))))
|
(assert (= (string res) msg) (string "echo " msg))))
|
||||||
|
@ -216,18 +219,18 @@
|
||||||
# prevent immediate close
|
# prevent immediate close
|
||||||
(ev/read stream 1)
|
(ev/read stream 1)
|
||||||
(def [host port] (net/localname stream))
|
(def [host port] (net/localname stream))
|
||||||
(assert (= host "127.0.0.1") "localname host server")
|
(assert (= host test-host) "localname host server")
|
||||||
(assert (= port 8000) "localname port server")))
|
(assert (= port (scan-number test-port)) "localname port server")))
|
||||||
|
|
||||||
# Test localname and peername
|
# Test localname and peername
|
||||||
# 077bf5eba
|
# 077bf5eba
|
||||||
(repeat 10
|
(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
|
(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))
|
(def [host port] (net/peername conn))
|
||||||
(assert (= host "127.0.0.1") "peername host client ")
|
(assert (= host test-host) "peername host client ")
|
||||||
(assert (= port 8000) "peername port client")
|
(assert (= port (scan-number test-port)) "peername port client")
|
||||||
# let server close
|
# let server close
|
||||||
(ev/write conn " "))))
|
(ev/write conn " "))))
|
||||||
(gccollect))
|
(gccollect))
|
||||||
|
@ -366,4 +369,10 @@
|
||||||
(exec-slurp ;run janet "-e" "(print :hi)")))
|
(exec-slurp ;run janet "-e" "(print :hi)")))
|
||||||
"exec-slurp 1"))
|
"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)
|
(end-suite)
|
||||||
|
|
|
@ -96,11 +96,23 @@
|
||||||
(assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
|
(assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
|
||||||
(assert (= (length buf) 2) "cryptorand appends to 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
|
# 80db68210
|
||||||
(assert-no-error "realtime clock" (os/clock :realtime))
|
(assert-no-error "realtime clock" (os/clock :realtime))
|
||||||
(assert-no-error "cputime clock" (os/clock :cputime))
|
(assert-no-error "cputime clock" (os/clock :cputime))
|
||||||
(assert-no-error "monotonic clock" (os/clock :monotonic))
|
(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 before (os/clock :monotonic))
|
||||||
(def after (os/clock :monotonic))
|
(def after (os/clock :monotonic))
|
||||||
(assert (>= after before) "monotonic clock is monotonic")
|
(assert (>= after before) "monotonic clock is monotonic")
|
||||||
|
@ -148,4 +160,3 @@
|
||||||
{:out dn :err dn})))
|
{:out dn :err dn})))
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|
||||||
|
|
|
@ -263,6 +263,9 @@
|
||||||
(marshpeg '(if-not "abcdf" 123))
|
(marshpeg '(if-not "abcdf" 123))
|
||||||
(marshpeg ~(cmt "abcdf" ,identity))
|
(marshpeg ~(cmt "abcdf" ,identity))
|
||||||
(marshpeg '(group "abc"))
|
(marshpeg '(group "abc"))
|
||||||
|
(marshpeg '(sub "abcdf" "abc"))
|
||||||
|
(marshpeg '(* (sub 1 1)))
|
||||||
|
(marshpeg '(split "," (+ "a" "b" "c")))
|
||||||
|
|
||||||
# Peg swallowing errors
|
# Peg swallowing errors
|
||||||
# 159651117
|
# 159651117
|
||||||
|
@ -660,5 +663,98 @@
|
||||||
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||||
@[]) "peg if not")
|
@[]) "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)
|
(end-suite)
|
||||||
|
|
||||||
|
|
|
@ -198,5 +198,9 @@
|
||||||
|
|
||||||
(assert (= (test) '(1 ())) "issue #919")
|
(assert (= (test) '(1 ())) "issue #919")
|
||||||
|
|
||||||
(end-suite)
|
# Regression #1327
|
||||||
|
(def x "A")
|
||||||
|
(def x (if (= nil x) "B" x))
|
||||||
|
(assert (= x "A"))
|
||||||
|
|
||||||
|
(end-suite)
|
||||||
|
|
|
@ -42,7 +42,7 @@
|
||||||
|
|
||||||
(defn buffer-factory
|
(defn buffer-factory
|
||||||
[]
|
[]
|
||||||
@"im am a buffer")
|
@"i am a buffer")
|
||||||
|
|
||||||
(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")
|
(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue