mirror of
https://github.com/janet-lang/janet
synced 2025-11-08 11:33:02 +00:00
Compare commits
2 Commits
mingw-vari
...
newjpm
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
baf7be1e52 | ||
|
|
f198071964 |
@@ -1,4 +1,4 @@
|
|||||||
image: freebsd/14.x
|
image: freebsd/12.x
|
||||||
sources:
|
sources:
|
||||||
- https://git.sr.ht/~bakpakin/janet
|
- https://git.sr.ht/~bakpakin/janet
|
||||||
packages:
|
packages:
|
||||||
@@ -9,4 +9,4 @@ tasks:
|
|||||||
gmake
|
gmake
|
||||||
gmake test
|
gmake test
|
||||||
sudo gmake install
|
sudo gmake install
|
||||||
sudo gmake uninstall
|
gmake test-install
|
||||||
|
|||||||
@@ -19,3 +19,5 @@ tasks:
|
|||||||
ninja
|
ninja
|
||||||
ninja test
|
ninja test
|
||||||
sudo ninja install
|
sudo ninja install
|
||||||
|
sudo jpm --verbose install circlet
|
||||||
|
sudo jpm --verbose install spork
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
image: openbsd/7.4
|
image: openbsd/latest
|
||||||
sources:
|
sources:
|
||||||
- https://git.sr.ht/~bakpakin/janet
|
- https://git.sr.ht/~bakpakin/janet
|
||||||
packages:
|
packages:
|
||||||
@@ -11,10 +11,9 @@ tasks:
|
|||||||
gmake test
|
gmake test
|
||||||
doas gmake install
|
doas gmake install
|
||||||
gmake test-install
|
gmake test-install
|
||||||
doas gmake uninstall
|
|
||||||
- meson_min: |
|
- meson_min: |
|
||||||
cd janet
|
cd janet
|
||||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
|
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true
|
||||||
cd build_meson_min
|
cd build_meson_min
|
||||||
ninja
|
ninja
|
||||||
- meson_prf: |
|
- meson_prf: |
|
||||||
@@ -30,3 +29,5 @@ tasks:
|
|||||||
ninja
|
ninja
|
||||||
ninja test
|
ninja test
|
||||||
doas ninja install
|
doas ninja install
|
||||||
|
doas jpm --verbose install circlet
|
||||||
|
|
||||||
|
|||||||
3
.gitattributes
vendored
3
.gitattributes
vendored
@@ -1,4 +1,5 @@
|
|||||||
*.janet linguist-language=Janet
|
*.janet linguist-language=Clojure
|
||||||
|
|
||||||
*.janet text eol=lf
|
*.janet text eol=lf
|
||||||
*.c text eol=lf
|
*.c text eol=lf
|
||||||
*.h text eol=lf
|
*.h text eol=lf
|
||||||
|
|||||||
38
.github/cosmo/build
vendored
38
.github/cosmo/build
vendored
@@ -1,38 +0,0 @@
|
|||||||
#!/bin/sh
|
|
||||||
set -eux
|
|
||||||
|
|
||||||
COSMO_DIR="/sc/cosmocc"
|
|
||||||
|
|
||||||
# build x86_64
|
|
||||||
X86_64_CC="/sc/cosmocc/bin/x86_64-unknown-cosmo-cc"
|
|
||||||
X86_64_AR="/sc/cosmocc/bin/x86_64-unknown-cosmo-ar"
|
|
||||||
mkdir -p /sc/cosmocc/x86_64
|
|
||||||
make -j CC="$X86_64_CC" AR="$X86_64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
|
|
||||||
cp build/janet /sc/cosmocc/x86_64/janet
|
|
||||||
make clean
|
|
||||||
|
|
||||||
# build aarch64
|
|
||||||
AARCH64_CC="/sc/cosmocc/bin/aarch64-unknown-cosmo-cc"
|
|
||||||
AARCH64_AR="/sc/cosmocc/bin/aarch64-unknown-cosmo-ar"
|
|
||||||
mkdir -p /sc/cosmocc/aarch64
|
|
||||||
make -j CC="$AARCH64_CC" AR="$AARCH64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
|
|
||||||
cp build/janet /sc/cosmocc/aarch64/janet
|
|
||||||
make clean
|
|
||||||
|
|
||||||
# fat binary
|
|
||||||
apefat () {
|
|
||||||
OUTPUT="$1"
|
|
||||||
OLDNAME_X86_64="$(basename -- "$2")"
|
|
||||||
OLDNAME_AARCH64="$(basename -- "$3")"
|
|
||||||
TARG_FOLD="$(dirname "$OUTPUT")"
|
|
||||||
"$COSMO_DIR/bin/apelink" -l "$COSMO_DIR/bin/ape-x86_64.elf" \
|
|
||||||
-l "$COSMO_DIR/bin/ape-aarch64.elf" \
|
|
||||||
-M "$COSMO_DIR/bin/ape-m1.c" \
|
|
||||||
-o "$OUTPUT" \
|
|
||||||
"$2" \
|
|
||||||
"$3"
|
|
||||||
cp "$2" "$TARG_FOLD/$OLDNAME_X86_64.x86_64"
|
|
||||||
cp "$3" "$TARG_FOLD/$OLDNAME_AARCH64.aarch64"
|
|
||||||
}
|
|
||||||
|
|
||||||
apefat /sc/cosmocc/janet.com /sc/cosmocc/x86_64/janet /sc/cosmocc/aarch64/janet
|
|
||||||
21
.github/cosmo/setup
vendored
21
.github/cosmo/setup
vendored
@@ -1,21 +0,0 @@
|
|||||||
#!/bin/sh
|
|
||||||
set -e
|
|
||||||
|
|
||||||
sudo apt update
|
|
||||||
sudo apt-get install -y ca-certificates libssl-dev\
|
|
||||||
qemu qemu-utils qemu-user-static\
|
|
||||||
texinfo groff\
|
|
||||||
cmake ninja-build bison zip\
|
|
||||||
pkg-config build-essential autoconf re2c
|
|
||||||
|
|
||||||
# download cosmocc
|
|
||||||
cd /sc
|
|
||||||
wget https://github.com/jart/cosmopolitan/releases/download/3.3.3/cosmocc-3.3.3.zip
|
|
||||||
mkdir -p cosmocc
|
|
||||||
cd cosmocc
|
|
||||||
unzip ../cosmocc-3.3.3.zip
|
|
||||||
|
|
||||||
# register
|
|
||||||
cd /sc/cosmocc
|
|
||||||
sudo cp ./bin/ape-x86_64.elf /usr/bin/ape
|
|
||||||
sudo sh -c "echo ':APE:M::MZqFpD::/usr/bin/ape:' >/proc/sys/fs/binfmt_misc/register"
|
|
||||||
41
.github/workflows/codeql.yml
vendored
41
.github/workflows/codeql.yml
vendored
@@ -1,41 +0,0 @@
|
|||||||
name: "CodeQL"
|
|
||||||
|
|
||||||
on:
|
|
||||||
push:
|
|
||||||
branches: [ "master" ]
|
|
||||||
pull_request:
|
|
||||||
branches: [ "master" ]
|
|
||||||
schedule:
|
|
||||||
- cron: "2 7 * * 4"
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
analyze:
|
|
||||||
name: Analyze
|
|
||||||
runs-on: ubuntu-latest
|
|
||||||
permissions:
|
|
||||||
actions: read
|
|
||||||
contents: read
|
|
||||||
security-events: write
|
|
||||||
|
|
||||||
strategy:
|
|
||||||
fail-fast: false
|
|
||||||
matrix:
|
|
||||||
language: [ cpp ]
|
|
||||||
|
|
||||||
steps:
|
|
||||||
- name: Checkout
|
|
||||||
uses: actions/checkout@v3
|
|
||||||
|
|
||||||
- name: Initialize CodeQL
|
|
||||||
uses: github/codeql-action/init@v2
|
|
||||||
with:
|
|
||||||
languages: ${{ matrix.language }}
|
|
||||||
queries: +security-and-quality
|
|
||||||
|
|
||||||
- name: Autobuild
|
|
||||||
uses: github/codeql-action/autobuild@v2
|
|
||||||
|
|
||||||
- name: Perform CodeQL Analysis
|
|
||||||
uses: github/codeql-action/analyze@v2
|
|
||||||
with:
|
|
||||||
category: "/language:${{ matrix.language }}"
|
|
||||||
118
.github/workflows/release.yml
vendored
118
.github/workflows/release.yml
vendored
@@ -1,118 +0,0 @@
|
|||||||
name: Release
|
|
||||||
|
|
||||||
on:
|
|
||||||
push:
|
|
||||||
tags:
|
|
||||||
- "v*.*.*"
|
|
||||||
|
|
||||||
permissions:
|
|
||||||
contents: read
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
|
|
||||||
release:
|
|
||||||
permissions:
|
|
||||||
contents: write # for softprops/action-gh-release to create GitHub release
|
|
||||||
name: Build release binaries
|
|
||||||
runs-on: ${{ matrix.os }}
|
|
||||||
strategy:
|
|
||||||
matrix:
|
|
||||||
os: [ ubuntu-latest, macos-13 ]
|
|
||||||
steps:
|
|
||||||
- name: Checkout the repository
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: Set the version
|
|
||||||
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
|
|
||||||
- name: Set the platform
|
|
||||||
run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV
|
|
||||||
- name: Compile the project
|
|
||||||
run: make clean && make
|
|
||||||
- name: Build the artifact
|
|
||||||
run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-x64.tar.gz
|
|
||||||
- name: Draft the release
|
|
||||||
uses: softprops/action-gh-release@v1
|
|
||||||
with:
|
|
||||||
draft: true
|
|
||||||
files: |
|
|
||||||
build/*.gz
|
|
||||||
build/janet.h
|
|
||||||
build/c/janet.c
|
|
||||||
build/c/shell.c
|
|
||||||
|
|
||||||
release-arm:
|
|
||||||
permissions:
|
|
||||||
contents: write # for softprops/action-gh-release to create GitHub release
|
|
||||||
name: Build release binaries
|
|
||||||
runs-on: ${{ matrix.os }}
|
|
||||||
strategy:
|
|
||||||
matrix:
|
|
||||||
os: [ macos-latest ]
|
|
||||||
steps:
|
|
||||||
- name: Checkout the repository
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: Set the version
|
|
||||||
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
|
|
||||||
- name: Set the platform
|
|
||||||
run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV
|
|
||||||
- name: Compile the project
|
|
||||||
run: make clean && make
|
|
||||||
- name: Build the artifact
|
|
||||||
run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-aarch64.tar.gz
|
|
||||||
- name: Draft the release
|
|
||||||
uses: softprops/action-gh-release@v1
|
|
||||||
with:
|
|
||||||
draft: true
|
|
||||||
files: |
|
|
||||||
build/*.gz
|
|
||||||
build/janet.h
|
|
||||||
build/c/janet.c
|
|
||||||
build/c/shell.c
|
|
||||||
|
|
||||||
release-windows:
|
|
||||||
permissions:
|
|
||||||
contents: write # for softprops/action-gh-release to create GitHub release
|
|
||||||
name: Build release binaries for windows
|
|
||||||
runs-on: windows-latest
|
|
||||||
steps:
|
|
||||||
- name: Checkout the repository
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: Setup MSVC
|
|
||||||
uses: ilammy/msvc-dev-cmd@v1
|
|
||||||
- name: Build the project
|
|
||||||
shell: cmd
|
|
||||||
run: build_win all
|
|
||||||
- name: Draft the release
|
|
||||||
uses: softprops/action-gh-release@v1
|
|
||||||
with:
|
|
||||||
draft: true
|
|
||||||
files: |
|
|
||||||
./dist/*.zip
|
|
||||||
./*.zip
|
|
||||||
./*.msi
|
|
||||||
|
|
||||||
release-cosmo:
|
|
||||||
permissions:
|
|
||||||
contents: write # for softprops/action-gh-release to create GitHub release
|
|
||||||
name: Build release binaries for Cosmo
|
|
||||||
runs-on: ubuntu-latest
|
|
||||||
steps:
|
|
||||||
- name: Checkout the repository
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: create build folder
|
|
||||||
run: |
|
|
||||||
sudo mkdir -p /sc
|
|
||||||
sudo chmod -R 0777 /sc
|
|
||||||
- name: setup Cosmopolitan Libc
|
|
||||||
run: bash ./.github/cosmo/setup
|
|
||||||
- name: Set the version
|
|
||||||
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
|
|
||||||
- name: Set the platform
|
|
||||||
run: echo "platform=cosmo" >> $GITHUB_ENV
|
|
||||||
- name: build Janet APE binary
|
|
||||||
run: bash ./.github/cosmo/build
|
|
||||||
- name: push binary to github
|
|
||||||
uses: softprops/action-gh-release@v1
|
|
||||||
with:
|
|
||||||
draft: true
|
|
||||||
files: |
|
|
||||||
/sc/cosmocc/janet.com
|
|
||||||
111
.github/workflows/test.yml
vendored
111
.github/workflows/test.yml
vendored
@@ -1,111 +0,0 @@
|
|||||||
name: Test
|
|
||||||
|
|
||||||
on: [push, pull_request]
|
|
||||||
|
|
||||||
permissions:
|
|
||||||
contents: read
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
|
|
||||||
test-posix:
|
|
||||||
name: Build and test on POSIX systems
|
|
||||||
runs-on: ${{ matrix.os }}
|
|
||||||
strategy:
|
|
||||||
matrix:
|
|
||||||
os: [ ubuntu-latest, macos-latest, macos-13 ]
|
|
||||||
steps:
|
|
||||||
- name: Checkout
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: Build
|
|
||||||
run: make clean && make
|
|
||||||
- name: Test
|
|
||||||
run: make test
|
|
||||||
|
|
||||||
test-windows:
|
|
||||||
name: Build and test on Windows
|
|
||||||
strategy:
|
|
||||||
matrix:
|
|
||||||
os: [ windows-latest, windows-2019 ]
|
|
||||||
runs-on: ${{ matrix.os }}
|
|
||||||
steps:
|
|
||||||
- name: Checkout the repository
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: Setup MSVC
|
|
||||||
uses: ilammy/msvc-dev-cmd@v1
|
|
||||||
- name: Build
|
|
||||||
shell: cmd
|
|
||||||
run: build_win
|
|
||||||
- name: Test
|
|
||||||
shell: cmd
|
|
||||||
run: build_win test
|
|
||||||
|
|
||||||
test-mingw:
|
|
||||||
name: Build on Windows with Mingw
|
|
||||||
runs-on: windows-2019
|
|
||||||
defaults:
|
|
||||||
run:
|
|
||||||
shell: msys2 {0}
|
|
||||||
strategy:
|
|
||||||
matrix:
|
|
||||||
msystem: [ UCRT64, MINGW64, MINGW32, CLANG64 ]
|
|
||||||
steps:
|
|
||||||
- name: Checkout
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: Setup Mingw
|
|
||||||
uses: msys2/setup-msys2@v2
|
|
||||||
with:
|
|
||||||
msystem: ${{ matrix.msystem }}
|
|
||||||
update: true
|
|
||||||
install: >-
|
|
||||||
base-devel
|
|
||||||
git
|
|
||||||
gcc
|
|
||||||
- name: Build
|
|
||||||
shell: cmd
|
|
||||||
run: make -j4 CC=gcc
|
|
||||||
- name: Test
|
|
||||||
shell: cmd
|
|
||||||
run: make test -j4 CC=gcc
|
|
||||||
|
|
||||||
test-mingw-linux:
|
|
||||||
name: Build and test with Mingw on Linux + Wine
|
|
||||||
runs-on: ubuntu-latest
|
|
||||||
steps:
|
|
||||||
- name: Checkout
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: Setup Mingw and wine
|
|
||||||
run: |
|
|
||||||
sudo dpkg --add-architecture i386
|
|
||||||
sudo apt-get update
|
|
||||||
sudo apt-get install libstdc++6:i386 libgcc-s1:i386
|
|
||||||
sudo apt-get install gcc-mingw-w64-x86-64-win32 wine wine32 wine64
|
|
||||||
- name: Build
|
|
||||||
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
|
|
||||||
- name: Test
|
|
||||||
run: make test UNAME=MINGW RUN=wine VERBOSE=1
|
|
||||||
|
|
||||||
test-arm-linux:
|
|
||||||
name: Build and test ARM32 cross compilation
|
|
||||||
runs-on: ubuntu-latest
|
|
||||||
steps:
|
|
||||||
- name: Checkout
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: Setup qemu and cross compiler
|
|
||||||
run: |
|
|
||||||
sudo apt-get update
|
|
||||||
sudo apt-get install gcc-arm-linux-gnueabi qemu-user
|
|
||||||
- name: Build
|
|
||||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
|
|
||||||
- name: Test
|
|
||||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1
|
|
||||||
|
|
||||||
test-s390x-linux:
|
|
||||||
name: Build and test s390x in qemu
|
|
||||||
runs-on: ubuntu-latest
|
|
||||||
steps:
|
|
||||||
- name: Checkout the repository
|
|
||||||
uses: actions/checkout@master
|
|
||||||
- name: Do Qemu build and test
|
|
||||||
run: |
|
|
||||||
docker run --rm --privileged multiarch/qemu-user-static --reset -p yes
|
|
||||||
docker run --rm -v .:/janet s390x/ubuntu bash -c "apt-get -y update && apt-get -y install git build-essential && cd /janet && make -j3 && make test"
|
|
||||||
18
.gitignore
vendored
18
.gitignore
vendored
@@ -34,11 +34,7 @@ local
|
|||||||
|
|
||||||
# Common test files I use.
|
# Common test files I use.
|
||||||
temp.janet
|
temp.janet
|
||||||
temp.c
|
|
||||||
temp*janet
|
|
||||||
temp*.c
|
|
||||||
scratch.janet
|
scratch.janet
|
||||||
scratch.c
|
|
||||||
|
|
||||||
# Emscripten
|
# Emscripten
|
||||||
*.bc
|
*.bc
|
||||||
@@ -48,8 +44,6 @@ janet.wasm
|
|||||||
# Generated files
|
# Generated files
|
||||||
*.gen.h
|
*.gen.h
|
||||||
*.gen.c
|
*.gen.c
|
||||||
*.tmp
|
|
||||||
temp.*
|
|
||||||
|
|
||||||
# Generate test files
|
# Generate test files
|
||||||
*.out
|
*.out
|
||||||
@@ -62,7 +56,6 @@ xxd.exe
|
|||||||
# VSCode
|
# VSCode
|
||||||
.vs
|
.vs
|
||||||
.clangd
|
.clangd
|
||||||
.cache
|
|
||||||
|
|
||||||
# Swap files
|
# Swap files
|
||||||
*.swp
|
*.swp
|
||||||
@@ -74,13 +67,10 @@ tags
|
|||||||
vgcore.*
|
vgcore.*
|
||||||
*.out.*
|
*.out.*
|
||||||
|
|
||||||
# WiX artifacts
|
# Wix artifacts
|
||||||
*.msi
|
*.msi
|
||||||
*.wixpdb
|
*.wixpdb
|
||||||
|
|
||||||
# Makefile config
|
|
||||||
/config.mk
|
|
||||||
|
|
||||||
# Created by https://www.gitignore.io/api/c
|
# Created by https://www.gitignore.io/api/c
|
||||||
|
|
||||||
### C ###
|
### C ###
|
||||||
@@ -128,9 +118,6 @@ vgcore.*
|
|||||||
*.idb
|
*.idb
|
||||||
*.pdb
|
*.pdb
|
||||||
|
|
||||||
# GGov
|
|
||||||
*.gcov
|
|
||||||
|
|
||||||
# Kernel Module Compile Results
|
# Kernel Module Compile Results
|
||||||
*.mod*
|
*.mod*
|
||||||
*.cmd
|
*.cmd
|
||||||
@@ -139,9 +126,6 @@ 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
|
||||||
|
|||||||
25
.travis.yml
Normal file
25
.travis.yml
Normal file
@@ -0,0 +1,25 @@
|
|||||||
|
language: c
|
||||||
|
script:
|
||||||
|
- make
|
||||||
|
- make test
|
||||||
|
- sudo make install
|
||||||
|
- make test-install
|
||||||
|
- JANET_DIST_DIR=janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME} make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||||
|
compiler:
|
||||||
|
- clang
|
||||||
|
- gcc
|
||||||
|
os:
|
||||||
|
- linux
|
||||||
|
- osx
|
||||||
|
before_deploy:
|
||||||
|
deploy:
|
||||||
|
provider: releases
|
||||||
|
api_key:
|
||||||
|
secure: JSqAOTH1jmfVlbOuPO3BbY1BhPq+ddiBNPCxuAyKHoVwfO4eNAmq9COI+UwCMWY3dg+YlspufRwkHj//B7QQ6hPbSsKu+Mapu6gr/CAE/jxbfO/E98LkIkUwbGjplwtzw2kiBkHN/Bu6J5X76cwo4D8nwQ1JIcV3nWtoG87t7H4W0R4AYQkbLGAPylgUFr11YMPx2cRBBqCdLAGIrny7kQ/0cRBfkN81R/gUJv/q3OjmUvY7sALXp7mFdZb75QPSilKIDuVUU5hLvPYTeRl6cWI/M+m5SmGZx1rjv5S9Qaw070XoNyt9JAADtbOUnADKvDguDZIP1FCuT1Gb+cnJPzrvk6+OBU9s8UjCTFtgV+LKlhmRZcwV5YQBE94PKRMJNC6VvIWM7UeQ8Zhm1jmQS6ONNWbuoUAlkZP57NtDQa2x0GT2wkubNSQKlaY+6/gwTD9KAJIzaZG7HYXH7b+4g7VbccCyhDAtDZtXgrOIS4WAkNc8rWezRO4H0qHMyON9aCEb0eTE8hWIufbx6ymG4gUxnYO+AkrEYMCwQvU6lS8BsevkaMTVtSShqlQtJ9FRlmJA3MA2ONyqzQXJENqRydyVbpFrKSv+0HbMyhEc5BoKbt0QcTh/slouNV4eASNar/GKN7aP8XKGUeMwIoCcRpP+3ehmwX9SUw7Ah5S42pA=
|
||||||
|
file: build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||||
|
draft: true
|
||||||
|
skip_cleanup: true
|
||||||
|
on:
|
||||||
|
tags: true
|
||||||
|
repo: janet-lang/janet
|
||||||
|
condition: "$CC = clang"
|
||||||
328
CHANGELOG.md
328
CHANGELOG.md
@@ -1,326 +1,6 @@
|
|||||||
# 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
|
|
||||||
- Change how JANET_PROFILE is loaded to allow more easily customizing the environment.
|
|
||||||
- Add `*repl-prompt*` dynamic binding to allow customizing the built in repl.
|
|
||||||
- Add multiple path support in the `JANET_PATH` environment variables. This lets
|
|
||||||
user more easily import modules from many directories.
|
|
||||||
|
|
||||||
## 1.36.0 - 2024-09-07
|
|
||||||
- Improve error messages in `bundle/add*` functions.
|
|
||||||
- Add CI testing and verify tests pass on the s390x architecture.
|
|
||||||
- Save `:source-form` in environment entries when `*debug*` is set.
|
|
||||||
- Add experimental `filewatch/` module for listening to file system changes on Linux and Windows.
|
|
||||||
- Add `bundle/who-is` to query which bundle a file on disk was installed by.
|
|
||||||
- Add `geomean` function
|
|
||||||
- Add `:R` and `:W` flags to `os/pipe` to create blocking pipes on Posix and Windows systems.
|
|
||||||
These streams cannot be directly read to and written from, but can be passed to subprocesses.
|
|
||||||
- Add `array/join`
|
|
||||||
- Add `tuple/join`
|
|
||||||
- Add `bundle/add-bin` to make installing scripts easier. This also establishes a packaging convention for it.
|
|
||||||
- Fix marshalling weak tables and weak arrays.
|
|
||||||
- Fix bug in `ev/` module that could accidentally close sockets on accident.
|
|
||||||
- Expose C functions for constructing weak tables in janet.h
|
|
||||||
- Let range take non-integer values.
|
|
||||||
|
|
||||||
## 1.35.2 - 2024-06-16
|
|
||||||
- Fix some documentation typos.
|
|
||||||
- Allow using `:only` in import without quoting.
|
|
||||||
|
|
||||||
## 1.35.0 - 2024-06-15
|
|
||||||
- Add `:only` argument to `import` to allow for easier control over imported bindings.
|
|
||||||
- Add extra optional `env` argument to `eval` and `eval-string`.
|
|
||||||
- Allow naming function literals with a keyword. This allows better stacktraces for macros without
|
|
||||||
accidentally adding new bindings.
|
|
||||||
- Add `bundle/` module for managing packages within Janet. This should replace the jpm packaging
|
|
||||||
format eventually and is much simpler and amenable to more complicated builds.
|
|
||||||
- Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks.
|
|
||||||
- Add `with-env`
|
|
||||||
- Add *module-make-env* dynamic binding
|
|
||||||
- Add buffer/format-at
|
|
||||||
- Add long form command line options for readable CLI usage
|
|
||||||
- Fix bug with `net/accept-loop` that would sometimes miss connections.
|
|
||||||
|
|
||||||
## 1.34.0 - 2024-03-22
|
|
||||||
- Add a new (split) PEG special by @ianthehenry
|
|
||||||
- Add buffer/push-* sized int and float by @pnelson
|
|
||||||
- Documentation improvements: @amano-kenji, @llmII, @MaxGyver83, @pepe, @sogaiu.
|
|
||||||
- Expose _exit to skip certain cleanup with os/exit.
|
|
||||||
- Swap set / body order for each by @sogaiu.
|
|
||||||
- Abort on assert failure instead of exit.
|
|
||||||
- Fix: os/proc-wait by @llmII.
|
|
||||||
- Fix macex1 to keep syntax location for all tuples.
|
|
||||||
- Restore if-let tail calls.
|
|
||||||
- Don't try and resume fibers that can't be resumed.
|
|
||||||
- Register stream on unmarshal.
|
|
||||||
- Fix asm roundtrip issue.
|
|
||||||
|
|
||||||
## 1.33.0 - 2024-01-07
|
|
||||||
- Add more + and * keywords to default-peg-grammar by @sogaiu.
|
|
||||||
- Use libc strlen in janet_buffer_push_cstring by @williewillus.
|
|
||||||
- Be a bit safer with reference counting.
|
|
||||||
- Add support for atomic loads in Janet's atomic abstraction.
|
|
||||||
- Fix poll event loop CPU usage issue.
|
|
||||||
- Add ipv6, shared, and cryptorand options to meson.
|
|
||||||
- Add more ipv6 feature detection.
|
|
||||||
- Fix loop for forever loop.
|
|
||||||
- Cleaned up unused NetStateConnect, fixed janet_async_end() ev refcount by @zevv.
|
|
||||||
- Fix warnings w/ MSVC and format.
|
|
||||||
- Fix marshal_one_env w/ JANET_MARSHAL_UNSAFE.
|
|
||||||
- Fix `(default)`.
|
|
||||||
- Fix cannot marshal fiber with c stackframe, in a dynamic way that is fairly conservative.
|
|
||||||
- Fix typo for SIGALARM in os/proc-kill.
|
|
||||||
- Prevent bytecode optimization from remove mk* instructions.
|
|
||||||
- Fix arity typo in peg.c by @pepe.
|
|
||||||
- Update Makefile for MinGW.
|
|
||||||
- Fix canceling waiting fiber.
|
|
||||||
- Add a new (sub) PEG special by @ianthehenry.
|
|
||||||
- Fix if net/server's handler has incorrect arity.
|
|
||||||
- Fix macex raising on ().
|
|
||||||
|
|
||||||
## 1.32.1 - 2023-10-15
|
|
||||||
- Fix return value from C function `janet_dobytes` when called on Janet functions that yield to event loop.
|
|
||||||
- Change C API for event loop interaction - get rid of JanetListener and instead use `janet_async_start` and `janet_async_end`.
|
|
||||||
- Rework event loop to make fewer system calls on kqueue and epoll.
|
|
||||||
- Expose atomic refcount abstraction in janet.h
|
|
||||||
- Add `array/weak` for weak references in arrays
|
|
||||||
- Add support for weak tables via `table/weak`, `table/weak-keys`, and `table/weak-values`.
|
|
||||||
- Fix compiler bug with using the result of `(break x)` expression in some contexts.
|
|
||||||
- Rework internal event loop code to be better behaved on Windows
|
|
||||||
- Update meson build to work better on windows
|
|
||||||
|
|
||||||
## 1.31.0 - 2023-09-17
|
|
||||||
- Report line and column when using `janet_dobytes`
|
|
||||||
- Add `:unless` loop modifier
|
|
||||||
- Allow calling `reverse` on generators.
|
|
||||||
- Improve performance of a number of core functions including `partition`, `mean`, `keys`, `values`, `pairs`, `interleave`.
|
|
||||||
- Add `lengthable?`
|
|
||||||
- Add `os/sigaction`
|
|
||||||
- Change `every?` and `any?` to behave like the functional versions of the `and` and `or` macros.
|
|
||||||
- Fix bug with garbage collecting threaded abstract types.
|
|
||||||
- Add `:signal` to the `sandbox` function to allow intercepting signals.
|
|
||||||
|
|
||||||
## 1.30.0 - 2023-08-05
|
|
||||||
- Change indexing of `array/remove` to start from -1 at the end instead of -2.
|
|
||||||
- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
|
|
||||||
- Fix bug with marshalling channels
|
|
||||||
- Add `div` for floored division
|
|
||||||
- Make `div` and `mod` variadic
|
|
||||||
- Support `bnot` for integer types.
|
|
||||||
- Define `(mod x 0)` as `x`
|
|
||||||
- Add `ffi/pointer-cfunction` to convert pointers to cfunctions
|
|
||||||
|
|
||||||
## 1.29.1 - 2023-06-19
|
|
||||||
- Add support for passing booleans to PEGs for "always" and "never" matching.
|
|
||||||
- Allow dictionary types for `take` and `drop`
|
|
||||||
- Fix bug with closing channels while other fibers were waiting on them - `ev/take`, `ev/give`, and `ev/select` will now return the correct (documented) value when another fiber closes the channel.
|
|
||||||
- Add `ffi/calling-conventions` to show all available calling conventions for FFI.
|
|
||||||
- Add `net/setsockopt`
|
|
||||||
- Add `signal` argument to `os/proc-kill` to send signals besides `SIGKILL` on Posix.
|
|
||||||
- Add `source` argument to `os/clock` to get different time sources.
|
|
||||||
- Various combinator functions now are variadic like `map`
|
|
||||||
- Add `file/lines` to iterate over lines in a file lazily.
|
|
||||||
- Reorganize test suite to be sorted by module rather than pseudo-randomly.
|
|
||||||
- Add `*task-id*`
|
|
||||||
- Add `env` argument to `fiber/new`.
|
|
||||||
- Add `JANET_NO_AMALG` flag to Makefile to properly incremental builds
|
|
||||||
- Optimize bytecode compiler to generate fewer instructions and improve loops.
|
|
||||||
- Fix bug with `ev/gather` and hung fibers.
|
|
||||||
- Add `os/isatty`
|
|
||||||
- Add `has-key?` and `has-value?`
|
|
||||||
- Make imperative arithmetic macros variadic
|
|
||||||
- `ev/connect` now yields to the event loop instead of blocking while waiting for an ACK.
|
|
||||||
|
|
||||||
## 1.28.0 - 2023-05-13
|
|
||||||
- Various bug fixes
|
|
||||||
- Make nested short-fn's behave a bit more predictably (it is still not recommended to nest short-fns).
|
|
||||||
- Add `os/strftime` for date formatting.
|
|
||||||
- Fix `ev/select` on threaded channels sometimes live-locking.
|
|
||||||
- Support the `NO_COLOR` environment variable to turn off VT100 color codes in repl (and in scripts).
|
|
||||||
See http://no-color.org/
|
|
||||||
- Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`.
|
|
||||||
Instead, raise a compiler error.
|
|
||||||
- Change the names of `:user8` and `:user9` signals to `:interrupt` and `:await`
|
|
||||||
- Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`.
|
|
||||||
- Add `ev/all-tasks` to see all currently suspended fibers.
|
|
||||||
- Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier.
|
|
||||||
|
|
||||||
## 1.27.0 - 2023-03-05
|
|
||||||
- Change semantics around bracket tuples to no longer be equal to regular tuples.
|
|
||||||
- Add `index` argument to `ffi/write` for symmetry with `ffi/read`.
|
|
||||||
- Add `buffer/push-at`
|
|
||||||
- Add `ffi/pointer-buffer` to convert pointers to buffers the cannot be reallocated. This
|
|
||||||
allows easier manipulation of FFI memory, memory mapped files, and buffer memory shared between threads.
|
|
||||||
- Calling `ev/cancel` on a fiber waiting on `ev/gather` will correctly
|
|
||||||
cancel the child fibers.
|
|
||||||
- Add `(sandbox ...)` function to core for permission based security. Also add `janet_sandbox` to C API.
|
|
||||||
The sandbox allows limiting access to the file system, network, ffi, and OS resources at runtime.
|
|
||||||
- Add `(.locals)` function to debugger to see currently bound local symbols.
|
|
||||||
- Track symbol -> slot mapping so debugger can get symbolic information. This exposes local bindings
|
|
||||||
in `debug/stack` and `disasm`.
|
|
||||||
- Add `os/compiler` to detect what host compiler was used to compile the interpreter
|
|
||||||
- Add support for mingw and cygwin builds (mingw support also added in jpm).
|
|
||||||
|
|
||||||
## 1.26.0 - 2023-01-07
|
|
||||||
- Add `ffi/malloc` and `ffi/free`. Useful as tools of last resort.
|
|
||||||
- Add `ffi/jitfn` to allow calling function pointers generated at runtime from machine code.
|
|
||||||
Bring your own assembler, though.
|
|
||||||
- Channels can now be marshalled. Pending state is not saved, only items in the channel.
|
|
||||||
- Use the new `.length` function pointer on abstract types for lengths. Adding
|
|
||||||
a `length` method will still work as well.
|
|
||||||
- Support byte views on abstract types with the `.bytes` function pointer.
|
|
||||||
- Add the `u` format specifier to printf family functions.
|
|
||||||
- Allow printing 64 integer types in `printf` and `string/format` family functions.
|
|
||||||
- Allow importing modules from custom directories more easily with the `@` prefix
|
|
||||||
to module paths. For example, if there is a dynamic binding :custom-modules that
|
|
||||||
is a file system path to a directory of modules, import from that directory with
|
|
||||||
`(import @custom-modules/mymod)`.
|
|
||||||
- Fix error message bug in FFI library.
|
|
||||||
|
|
||||||
## 1.25.1 - 2022-10-29
|
|
||||||
- Add `memcmp` function to core library.
|
|
||||||
- Fix bug in `os/open` with `:rw` permissions not correct on Linux.
|
|
||||||
- Support config.mk for more easily configuring the Makefile.
|
|
||||||
|
|
||||||
## 1.25.0 - 2022-10-10
|
|
||||||
- Windows FFI fixes.
|
|
||||||
- Fix PEG `if-not` combinator with captures in the condition
|
|
||||||
- Fix bug with `os/date` with nil first argument
|
|
||||||
- Fix bug with `net/accept` on Linux that could leak file descriptors to subprocesses
|
|
||||||
- Reduce number of hash collisions from pointer hashing
|
|
||||||
- Add optional parameter to `marshal` to skip cycle checking code
|
|
||||||
|
|
||||||
## 1.24.1 - 2022-08-24
|
|
||||||
- Fix FFI bug on Linux/Posix
|
|
||||||
- Improve parse error messages for bad delimiters.
|
|
||||||
- Add optional `name` parameter to the `short-fn` macro.
|
|
||||||
|
|
||||||
## 1.24.0 - 2022-08-14
|
|
||||||
- Add FFI support to 64-bit windows compiled with MSVC
|
|
||||||
- Don't process shared object names passed to dlopen.
|
|
||||||
- Add better support for windows console in the default shell.c for auto-completion and
|
|
||||||
other shell-like input features.
|
|
||||||
- Improve default error message from `assert`.
|
|
||||||
- Add the `tabseq` macro for simpler table comprehensions.
|
|
||||||
- Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to
|
|
||||||
this change, supervisor messages over threaded channels would be from ambiguous threads/fibers.
|
|
||||||
|
|
||||||
## 1.23.0 - 2022-06-20
|
|
||||||
- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available
|
|
||||||
on 64 bit linux, mac, and bsd systems.
|
|
||||||
- Allow using `&named` in function prototypes for named arguments. This is a more ergonomic
|
|
||||||
variant of `&keys` that isn't as redundant, more self documenting, and allows extension to
|
|
||||||
things like default arguments.
|
|
||||||
- Add `delay` macro for lazy evaluate-and-save thunks.
|
|
||||||
- Remove pthread.h from janet.h for easier includes.
|
|
||||||
- Add `debugger` - an easy to use debugger function that just takes a fiber.
|
|
||||||
- `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set.
|
|
||||||
- Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on
|
|
||||||
abnormal fiber signals.
|
|
||||||
- Allow running scripts with the `-d` flag to use the built-in debugger on errors and breakpoints.
|
|
||||||
- Add mutexes (locks) and reader-writer locks to ev module for thread coordination.
|
|
||||||
- Add `parse-all` as a generalization of the `parse` function.
|
|
||||||
- Add `os/cpu-count` to get the number of available processors on a machine
|
|
||||||
|
|
||||||
## 1.22.0 - 2022-05-09
|
|
||||||
- Prohibit negative size argument to `table/new`.
|
|
||||||
- Add `module/value`.
|
|
||||||
- Remove `file/popen`. Use `os/spawn` with the `:pipe` options instead.
|
|
||||||
- Fix bug in peg `thru` and `to` combinators.
|
|
||||||
- Fix printing issue in `doc` macro.
|
|
||||||
- Numerous updates to function docstrings
|
|
||||||
- Add `defdyn` aliases for various dynamic bindings used in core.
|
|
||||||
- Install `janet.h` symlink to make Janet native libraries and applications
|
|
||||||
easier to build without `jpm`.
|
|
||||||
|
|
||||||
## 1.21.2 - 2022-04-01
|
|
||||||
- C functions `janet_dobytes` and `janet_dostring` will now enter the event loop if it is enabled.
|
|
||||||
- Fix hashing regression - hash of negative 0 must be the same as positive 0 since they are equal.
|
|
||||||
- The `flycheck` function no longer pollutes the module/cache
|
|
||||||
- Fix quasiquote bug in compiler
|
|
||||||
- Disallow use of `cancel` and `resume` on fibers scheduled or created with `ev/go`, as well as the root
|
|
||||||
fiber.
|
|
||||||
|
|
||||||
## 1.20.0 - 2022-1-27
|
|
||||||
- Add `:missing-symbol` hook to `compile` that will act as a catch-all macro for undefined symbols.
|
|
||||||
- Add `:redef` dynamic binding that will allow users to redefine top-level bindings with late binding. This
|
|
||||||
is intended for development use.
|
|
||||||
- Fix a bug with reading from a stream returned by `os/open` on Windows and Linux.
|
|
||||||
- Add `:ppc64` as a detectable OS type.
|
|
||||||
- Add `& more` support for destructuring in the match macro.
|
|
||||||
- Add `& more` support for destructuring in all binding forms (`def`).
|
|
||||||
|
|
||||||
## 1.19.2 - 2021-12-06
|
|
||||||
- Fix bug with missing status lines in some stack traces.
|
|
||||||
- Update hash function to have better statistical properties.
|
|
||||||
|
|
||||||
## 1.19.1 - 2021-12-04
|
|
||||||
- Add an optional `prefix` parameter to `debug/stacktrace` to allow printing prettier error messages.
|
|
||||||
- Remove appveyor for CI pipeline
|
|
||||||
- Fixed a bug that prevented sending threaded abstracts over threaded channels.
|
|
||||||
- Fix bug in the `map` function with arity at least 3.
|
|
||||||
|
|
||||||
## 1.19.0 - 2021-11-27
|
|
||||||
- Add `math/log-gamma` to replace `math/gamma`, and change `math/gamma` to be the expected gamma function.
|
|
||||||
- Fix leaking file-descriptors in os/spawn and os/execute.
|
|
||||||
- Ctrl-C will now raise SIGINT.
|
|
||||||
- Allow quoted literals in the `match` macro to behave as expected in patterns.
|
|
||||||
- Fix windows net related bug for TCP servers.
|
|
||||||
- Allow evaluating ev streams with dofile.
|
|
||||||
- Fix `ev` related bug with operations on already closed file descriptors.
|
|
||||||
- Add struct and table agnostic `getproto` function.
|
|
||||||
- Add a number of functions related to structs.
|
|
||||||
- Add prototypes to structs. Structs can now inherit from other structs, just like tables.
|
|
||||||
- Create a struct with a prototype with `struct/with-proto`.
|
|
||||||
- Deadlocked channels will no longer exit early - instead they will hang, which is more intuitive.
|
|
||||||
|
|
||||||
## 1.18.1 - 2021-10-16
|
|
||||||
- Fix some documentation typos
|
|
||||||
- Fix - Set pipes passed to subprocess to blocking mode.
|
|
||||||
- Fix `-r` switch in repl.
|
|
||||||
|
|
||||||
## 1.18.0 - 2021-10-10
|
|
||||||
- Allow `ev/cancel` to work on already scheduled fibers.
|
|
||||||
- Fix bugs with ev/ module.
|
|
||||||
- Add optional `base` argument to scan-number
|
|
||||||
- Add `-i` flag to janet binary to make it easier to run image files from the command line
|
|
||||||
- Remove `thread/` module.
|
|
||||||
- Add `(number ...)` pattern to peg for more efficient number parsing using Janet's
|
|
||||||
scan-number function without immediate string creation.
|
|
||||||
|
|
||||||
## 1.17.2 - 2021-09-18
|
|
||||||
- Remove include of windows.h from janet.h. This caused issues on certain projects.
|
|
||||||
- Fix formatting in doc-format to better handle special characters in signatures.
|
|
||||||
- Fix some marshalling bugs.
|
|
||||||
- Add optional Makefile target to install jpm as well.
|
|
||||||
- Supervisor channels in threads will no longer include a wasteful copy of the fiber in every
|
|
||||||
message across a thread.
|
|
||||||
- Allow passing a closure to `ev/thread` as well as a whole fiber.
|
|
||||||
- Allow passing a closure directly to `ev/go` to spawn fibers on the event loop.
|
|
||||||
|
|
||||||
## 1.17.1 - 2021-08-29
|
|
||||||
- Fix docstring typos
|
|
||||||
- Add `make install-jpm-git` to make jpm co-install simpler if using the Makefile.
|
|
||||||
- Fix bugs with starting ev/threads and fiber marshaling.
|
|
||||||
|
|
||||||
## 1.17.0 - 2021-08-21
|
|
||||||
- Add the `-E` flag for one-liners with the `short-fn` syntax for argument passing.
|
|
||||||
- Add support for threaded abstract types. Threaded abstract types can easily be shared between threads.
|
|
||||||
- Deprecate the `thread` library. Use threaded channels and ev instead.
|
|
||||||
- Channels can now be marshalled.
|
|
||||||
- Add the ability to close channels with `ev/chan-close` (or `:close`).
|
|
||||||
- Add threaded channels with `ev/thread-chan`.
|
|
||||||
- Add `JANET_FN` and `JANET_REG` macros to more easily define C functions that export their source mapping information.
|
|
||||||
- Add `janet_interpreter_interrupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
|
|
||||||
- Add `table/clear`
|
|
||||||
- Add build option to disable the threading library without disabling all threads.
|
|
||||||
- Remove JPM from the main Janet distribution. Instead, JPM must be installed
|
|
||||||
separately like any other package.
|
|
||||||
- Fix issue with `ev/go` when called with an initial value and supervisor.
|
|
||||||
- Add the C API functions `janet_vm_save` and `janet_vm_load` to allow
|
|
||||||
saving and restoring the entire VM state.
|
|
||||||
|
|
||||||
## 1.16.1 - 2021-06-09
|
## 1.16.1 - 2021-06-09
|
||||||
- Add `maclintf` - a utility for adding linting messages when inside macros.
|
- Add `maclintf` - a utility for adding linting messages when inside macros.
|
||||||
- Print source code of offending line on compiler warnings and errors.
|
- Print source code of offending line on compiler warnings and errors.
|
||||||
@@ -340,7 +20,7 @@ saving and restoring the entire VM state.
|
|||||||
- Add compiler warnings and deprecation levels.
|
- Add compiler warnings and deprecation levels.
|
||||||
- Add `as-macro` to make using macros within quasiquote easier to do hygienically.
|
- Add `as-macro` to make using macros within quasiquote easier to do hygienically.
|
||||||
- Expose `JANET_OUT_OF_MEMORY` as part of the Janet API.
|
- Expose `JANET_OUT_OF_MEMORY` as part of the Janet API.
|
||||||
- Add `native-deps` option to `declare-native` in `jpm`. This lets native libraries link to other
|
- Add `native-deps` option to `decalre-native` in `jpm`. This lets native libraries link to other
|
||||||
native libraries when building with jpm.
|
native libraries when building with jpm.
|
||||||
- Remove the `tarray` module. The functionality of typed arrays will be moved to an external module
|
- Remove the `tarray` module. The functionality of typed arrays will be moved to an external module
|
||||||
that can be installed via `jpm`.
|
that can be installed via `jpm`.
|
||||||
@@ -366,7 +46,7 @@ saving and restoring the entire VM state.
|
|||||||
- Sort keys in pretty printing output.
|
- Sort keys in pretty printing output.
|
||||||
|
|
||||||
## 1.15.3 - 2021-02-28
|
## 1.15.3 - 2021-02-28
|
||||||
- Fix a fiber bug that occurred in deeply nested fibers
|
- Fix a fiber bug that occured in deeply nested fibers
|
||||||
- Add `unref` combinator to pegs.
|
- Add `unref` combinator to pegs.
|
||||||
- Small docstring changes.
|
- Small docstring changes.
|
||||||
|
|
||||||
@@ -516,13 +196,13 @@ saving and restoring the entire VM state.
|
|||||||
- Add `symbol/slice`
|
- Add `symbol/slice`
|
||||||
- Add `keyword/slice`
|
- Add `keyword/slice`
|
||||||
- Allow cross compilation with Makefile.
|
- Allow cross compilation with Makefile.
|
||||||
- Change `compare-primitive` to `cmp` and make it more efficient.
|
- Change `compare-primitve` to `cmp` and make it more efficient.
|
||||||
- Add `reverse!` for reversing an array or buffer in place.
|
- Add `reverse!` for reversing an array or buffer in place.
|
||||||
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
|
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
|
||||||
- Add `repeat` macro for iterating something n times.
|
- Add `repeat` macro for iterating something n times.
|
||||||
- Add `eachy` (each yield) macro for iterating a fiber.
|
- Add `eachy` (each yield) macro for iterating a fiber.
|
||||||
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
|
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
|
||||||
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexadecimal digits.
|
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
|
||||||
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
|
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
|
||||||
|
|
||||||
## 1.10.1 - 2020-06-18
|
## 1.10.1 - 2020-06-18
|
||||||
|
|||||||
@@ -64,23 +64,6 @@ ensure a consistent code style for C.
|
|||||||
All janet code in the project should be formatted similar to the code in core.janet.
|
All janet code in the project should be formatted similar to the code in core.janet.
|
||||||
The auto formatting from janet.vim will work well.
|
The auto formatting from janet.vim will work well.
|
||||||
|
|
||||||
## Typo Fixing and One-Line changes
|
|
||||||
|
|
||||||
Typo fixes are welcome, as are simple one line fixes. Do not open many separate pull requests for each
|
|
||||||
individual typo fix. This is incredibly annoying to deal with as someone needs to review each PR, run
|
|
||||||
CI, and merge. Instead, accumulate batches of typo fixes into a single PR. If there are objections to
|
|
||||||
specific changes, these can be addressed in the review process before the final merge, if the changes
|
|
||||||
are accepted.
|
|
||||||
|
|
||||||
Similarly, low effort and bad faith changes are annoying to developers and such issues may be closed
|
|
||||||
immediately without response.
|
|
||||||
|
|
||||||
## Contributions from Automated Tools
|
|
||||||
|
|
||||||
People making changes found or generated by automated tools MUST note this when opening an issue
|
|
||||||
or creating a pull request. This can help give context to developers if the change/issue is
|
|
||||||
confusing or nonsensical.
|
|
||||||
|
|
||||||
## Suggesting Changes
|
## Suggesting Changes
|
||||||
|
|
||||||
To suggest changes, open an issue on GitHub. Check GitHub for other issues
|
To suggest changes, open an issue on GitHub. Check GitHub for other issues
|
||||||
|
|||||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
|||||||
Copyright (c) 2023 Calvin Rose and contributors
|
Copyright (c) 2021 Calvin Rose and contributors
|
||||||
|
|
||||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||||||
this software and associated documentation files (the "Software"), to deal in
|
this software and associated documentation files (the "Software"), to deal in
|
||||||
|
|||||||
190
Makefile
190
Makefile
@@ -1,4 +1,4 @@
|
|||||||
# Copyright (c) 2024 Calvin Rose
|
# Copyright (c) 2021 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
|
||||||
@@ -21,99 +21,60 @@
|
|||||||
################################
|
################################
|
||||||
##### Set global variables #####
|
##### Set global variables #####
|
||||||
################################
|
################################
|
||||||
sinclude config.mk
|
|
||||||
PREFIX?=/usr/local
|
PREFIX?=/usr/local
|
||||||
|
|
||||||
JANETCONF_HEADER?=src/conf/janetconf.h
|
|
||||||
INCLUDEDIR?=$(PREFIX)/include
|
INCLUDEDIR?=$(PREFIX)/include
|
||||||
BINDIR?=$(PREFIX)/bin
|
BINDIR?=$(PREFIX)/bin
|
||||||
LIBDIR?=$(PREFIX)/lib
|
LIBDIR?=$(PREFIX)/lib
|
||||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
|
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
|
||||||
CLIBS=-lm -lpthread
|
CLIBS=-lm -lpthread
|
||||||
JANET_TARGET=build/janet
|
JANET_TARGET=build/janet
|
||||||
JANET_BOOT=build/janet_boot
|
|
||||||
JANET_IMPORT_LIB=build/janet.lib
|
|
||||||
JANET_LIBRARY_IMPORT_LIB=build/libjanet.lib
|
|
||||||
JANET_LIBRARY=build/libjanet.so
|
JANET_LIBRARY=build/libjanet.so
|
||||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||||
JANET_PATH?=$(LIBDIR)/janet
|
JANET_PATH?=$(LIBDIR)/janet
|
||||||
JANET_MANPATH?=$(PREFIX)/share/man/man1/
|
JANET_MANPATH?=$(PREFIX)/share/man/man1/
|
||||||
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||||
JANET_DIST_DIR?=janet-dist
|
JANET_DIST_DIR?=janet-dist
|
||||||
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
|
|
||||||
JANET_TARGET_OBJECTS=build/janet.o build/shell.o
|
|
||||||
JPM_TAG?=master
|
|
||||||
SPORK_TAG?=master
|
|
||||||
HAS_SHARED?=1
|
|
||||||
DEBUGGER=gdb
|
DEBUGGER=gdb
|
||||||
SONAME_SETTER=-Wl,-soname,
|
SONAME_SETTER=-Wl,-soname,
|
||||||
|
|
||||||
# For cross compilation
|
# For cross compilation
|
||||||
HOSTCC?=$(CC)
|
HOSTCC?=$(CC)
|
||||||
HOSTAR?=$(AR)
|
HOSTAR?=$(AR)
|
||||||
# Symbols are (optionally) removed later, keep -g as default!
|
CFLAGS?=-O2
|
||||||
CFLAGS?=-O2 -g
|
|
||||||
LDFLAGS?=-rdynamic
|
LDFLAGS?=-rdynamic
|
||||||
LIBJANET_LDFLAGS?=$(LD_FLAGS)
|
|
||||||
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
|
||||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
|
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
|
||||||
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||||
|
|
||||||
# Disable amalgamated build
|
|
||||||
ifeq ($(JANET_NO_AMALG), 1)
|
|
||||||
JANET_TARGET_OBJECTS+=$(patsubst src/%.c,build/%.bin.o,$(JANET_CORE_SOURCES))
|
|
||||||
JANET_BOOT_FLAGS+=image-only
|
|
||||||
endif
|
|
||||||
|
|
||||||
# For installation
|
# For installation
|
||||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||||
|
|
||||||
# Check OS
|
# Check OS
|
||||||
UNAME?=$(shell uname -s)
|
UNAME:=$(shell uname -s)
|
||||||
ifeq ($(UNAME), Darwin)
|
ifeq ($(UNAME), Darwin)
|
||||||
CLIBS:=$(CLIBS) -ldl
|
CLIBS:=$(CLIBS) -ldl
|
||||||
SONAME_SETTER:=-Wl,-install_name,
|
SONAME_SETTER:=-Wl,-install_name,
|
||||||
JANET_LIBRARY=build/libjanet.dylib
|
|
||||||
LDCONFIG:=true
|
LDCONFIG:=true
|
||||||
else ifeq ($(UNAME), Linux)
|
else ifeq ($(UNAME), Linux)
|
||||||
CLIBS:=$(CLIBS) -lrt -ldl
|
CLIBS:=$(CLIBS) -lrt -ldl
|
||||||
endif
|
endif
|
||||||
|
|
||||||
# For other unix likes, add flags here!
|
# For other unix likes, add flags here!
|
||||||
ifeq ($(UNAME), Haiku)
|
ifeq ($(UNAME), Haiku)
|
||||||
LDCONFIG:=true
|
LDCONFIG:=true
|
||||||
LDFLAGS=-Wl,--export-dynamic
|
LDFLAGS=-Wl,--export-dynamic
|
||||||
endif
|
endif
|
||||||
# For Android (termux)
|
|
||||||
ifeq ($(UNAME), Linux) # uname on Darwin doesn't recognise -o
|
|
||||||
ifeq ($(shell uname -o), Android)
|
|
||||||
CLIBS:=$(CLIBS) -landroid-spawn
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
# Mingw
|
$(shell mkdir -p build/core build/c build/boot)
|
||||||
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||||
CLIBS:=-lws2_32 -lpsapi -lwsock32
|
|
||||||
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
|
|
||||||
LIBJANET_LDFLAGS:=-Wl,--out-implib,$(JANET_LIBRARY_IMPORT_LIB)
|
|
||||||
JANET_TARGET:=$(JANET_TARGET).exe
|
|
||||||
JANET_BOOT:=$(JANET_BOOT).exe
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
$(shell mkdir -p build/core build/c build/boot build/mainclient)
|
|
||||||
all: $(JANET_TARGET) $(JANET_STATIC_LIBRARY) build/janet.h
|
|
||||||
ifeq ($(HAS_SHARED), 1)
|
|
||||||
all: $(JANET_LIBRARY)
|
|
||||||
endif
|
|
||||||
|
|
||||||
######################
|
######################
|
||||||
##### Name Files #####
|
##### Name Files #####
|
||||||
######################
|
######################
|
||||||
|
|
||||||
JANET_HEADERS=src/include/janet.h $(JANETCONF_HEADER)
|
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
|
||||||
|
|
||||||
JANET_LOCAL_HEADERS=src/core/features.h \
|
JANET_LOCAL_HEADERS=src/core/features.h \
|
||||||
src/core/util.h \
|
src/core/util.h \
|
||||||
@@ -138,9 +99,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
|||||||
src/core/debug.c \
|
src/core/debug.c \
|
||||||
src/core/emit.c \
|
src/core/emit.c \
|
||||||
src/core/ev.c \
|
src/core/ev.c \
|
||||||
src/core/ffi.c \
|
|
||||||
src/core/fiber.c \
|
src/core/fiber.c \
|
||||||
src/core/filewatch.c \
|
|
||||||
src/core/gc.c \
|
src/core/gc.c \
|
||||||
src/core/inttypes.c \
|
src/core/inttypes.c \
|
||||||
src/core/io.c \
|
src/core/io.c \
|
||||||
@@ -154,12 +113,12 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
|||||||
src/core/regalloc.c \
|
src/core/regalloc.c \
|
||||||
src/core/run.c \
|
src/core/run.c \
|
||||||
src/core/specials.c \
|
src/core/specials.c \
|
||||||
src/core/state.c \
|
|
||||||
src/core/string.c \
|
src/core/string.c \
|
||||||
src/core/strtod.c \
|
src/core/strtod.c \
|
||||||
src/core/struct.c \
|
src/core/struct.c \
|
||||||
src/core/symcache.c \
|
src/core/symcache.c \
|
||||||
src/core/table.c \
|
src/core/table.c \
|
||||||
|
src/core/thread.c \
|
||||||
src/core/tuple.c \
|
src/core/tuple.c \
|
||||||
src/core/util.c \
|
src/core/util.c \
|
||||||
src/core/value.c \
|
src/core/value.c \
|
||||||
@@ -186,53 +145,42 @@ $(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
|
|||||||
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
||||||
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
|
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
$(JANET_BOOT): $(JANET_BOOT_OBJECTS)
|
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||||
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||||
|
|
||||||
# Now the reason we bootstrap in the first place
|
# Now the reason we bootstrap in the first place
|
||||||
build/c/janet.c: $(JANET_BOOT) src/boot/boot.janet
|
build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||||
$(RUN) $(JANET_BOOT) $(JANET_BOOT_FLAGS) > $@
|
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
|
||||||
cksum $@
|
cksum $@
|
||||||
|
|
||||||
##################
|
|
||||||
##### Quicky #####
|
|
||||||
##################
|
|
||||||
|
|
||||||
build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
|
||||||
$(HOSTCC) $(BUILD_CFLAGS) -o $@ -c $<
|
|
||||||
|
|
||||||
########################
|
########################
|
||||||
##### Amalgamation #####
|
##### Amalgamation #####
|
||||||
########################
|
########################
|
||||||
|
|
||||||
ifeq ($(UNAME), Darwin)
|
SONAME=libjanet.so.1.16
|
||||||
SONAME=libjanet.1.37.dylib
|
|
||||||
else
|
|
||||||
SONAME=libjanet.so.1.37
|
|
||||||
endif
|
|
||||||
|
|
||||||
build/c/shell.c: src/mainclient/shell.c
|
build/c/shell.c: src/mainclient/shell.c
|
||||||
cp $< $@
|
cp $< $@
|
||||||
|
|
||||||
build/janet.h: $(JANET_TARGET) src/include/janet.h $(JANETCONF_HEADER)
|
build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
|
||||||
$(RUN) ./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
|
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h src/conf/janetconf.h $@
|
||||||
|
|
||||||
build/janetconf.h: $(JANETCONF_HEADER)
|
build/janetconf.h: src/conf/janetconf.h
|
||||||
cp $< $@
|
cp $< $@
|
||||||
|
|
||||||
build/janet.o: build/c/janet.c $(JANETCONF_HEADER) src/include/janet.h
|
build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
|
||||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||||
|
|
||||||
build/shell.o: build/c/shell.c $(JANETCONF_HEADER) src/include/janet.h
|
build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
|
||||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||||
|
|
||||||
$(JANET_TARGET): $(JANET_TARGET_OBJECTS)
|
$(JANET_TARGET): build/janet.o build/shell.o
|
||||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
|
$(JANET_LIBRARY): build/janet.o build/shell.o
|
||||||
$(HOSTCC) $(LIBJANET_LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
|
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||||
$(HOSTAR) rcs $@ $^
|
$(HOSTAR) rcs $@ $^
|
||||||
|
|
||||||
###################
|
###################
|
||||||
@@ -244,23 +192,25 @@ $(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
|
|||||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||||
|
|
||||||
repl: $(JANET_TARGET)
|
repl: $(JANET_TARGET)
|
||||||
$(RUN) ./$(JANET_TARGET)
|
./$(JANET_TARGET)
|
||||||
|
|
||||||
debug: $(JANET_TARGET)
|
debug: $(JANET_TARGET)
|
||||||
$(DEBUGGER) ./$(JANET_TARGET)
|
$(DEBUGGER) ./$(JANET_TARGET)
|
||||||
|
|
||||||
VALGRIND_COMMAND=valgrind --leak-check=full --quiet
|
VALGRIND_COMMAND=valgrind --leak-check=full
|
||||||
|
|
||||||
valgrind: $(JANET_TARGET)
|
valgrind: $(JANET_TARGET)
|
||||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
||||||
|
|
||||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||||
for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
|
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
|
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||||
|
./$(JANET_TARGET) -k jpm
|
||||||
|
|
||||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||||
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||||
|
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k jpm
|
||||||
|
|
||||||
callgrind: $(JANET_TARGET)
|
callgrind: $(JANET_TARGET)
|
||||||
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
@@ -273,25 +223,21 @@ 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_STATIC_LIBRARY) \
|
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||||
README.md build/c/janet.c build/c/shell.c
|
README.md build/c/janet.c build/c/shell.c jpm
|
||||||
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/
|
||||||
strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
|
cp jpm build/$(JANET_DIST_DIR)/bin/
|
||||||
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_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
|
cp $(JANET_LIBRARY) $(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 jpm.1 build/$(JANET_DIST_DIR)/man/man1/
|
||||||
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 #####
|
||||||
@@ -300,12 +246,16 @@ endif
|
|||||||
docs: build/doc.html
|
docs: build/doc.html
|
||||||
|
|
||||||
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||||
$(RUN) $(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||||
|
|
||||||
########################
|
########################
|
||||||
##### Installation #####
|
##### Installation #####
|
||||||
########################
|
########################
|
||||||
|
|
||||||
|
build/jpm: jpm $(JANET_TARGET)
|
||||||
|
$(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)"
|
||||||
|
chmod +x build/jpm
|
||||||
|
|
||||||
.INTERMEDIATE: build/janet.pc
|
.INTERMEDIATE: build/janet.pc
|
||||||
build/janet.pc: $(JANET_TARGET)
|
build/janet.pc: $(JANET_TARGET)
|
||||||
echo 'prefix=$(PREFIX)' > $@
|
echo 'prefix=$(PREFIX)' > $@
|
||||||
@@ -316,63 +266,38 @@ build/janet.pc: $(JANET_TARGET)
|
|||||||
echo "Name: janet" >> $@
|
echo "Name: janet" >> $@
|
||||||
echo "Url: https://janet-lang.org" >> $@
|
echo "Url: https://janet-lang.org" >> $@
|
||||||
echo "Description: Library for the Janet programming language." >> $@
|
echo "Description: Library for the Janet programming language." >> $@
|
||||||
$(RUN) $(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
||||||
echo 'Cflags: -I$${includedir}' >> $@
|
echo 'Cflags: -I$${includedir}' >> $@
|
||||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||||
echo 'Libs.private: $(CLIBS)' >> $@
|
echo 'Libs.private: $(CLIBS)' >> $@
|
||||||
|
|
||||||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
|
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/jpm build/janet.h
|
||||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||||
strip -x -S '$(DESTDIR)$(BINDIR)/janet'
|
|
||||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||||
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
|
||||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||||
if test $(UNAME) = Darwin ; then \
|
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
|
||||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib' ; \
|
|
||||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \
|
|
||||||
ln -sf libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
|
|
||||||
else \
|
|
||||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' ; \
|
|
||||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \
|
|
||||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
|
|
||||||
fi
|
|
||||||
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
|
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
|
||||||
|
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
|
||||||
|
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
|
||||||
|
cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
|
||||||
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
|
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
|
||||||
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
|
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||||
|
cp jpm.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||||
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)'
|
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
|
||||||
cp '$(JANET_LIBRARY_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
|
|
||||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
|
|
||||||
|
|
||||||
install-jpm-git: $(JANET_TARGET)
|
|
||||||
mkdir -p build
|
|
||||||
rm -rf build/jpm
|
|
||||||
git clone --depth=1 --branch='$(JPM_TAG)' https://github.com/janet-lang/jpm.git build/jpm
|
|
||||||
cd build/jpm && PREFIX='$(PREFIX)' \
|
|
||||||
DESTDIR=$(DESTDIR) \
|
|
||||||
JANET_MANPATH='$(JANET_MANPATH)' \
|
|
||||||
JANET_HEADERPATH='$(INCLUDEDIR)/janet' \
|
|
||||||
JANET_BINPATH='$(BINDIR)' \
|
|
||||||
JANET_LIBPATH='$(LIBDIR)' \
|
|
||||||
$(RUN) ../../$(JANET_TARGET) ./bootstrap.janet
|
|
||||||
|
|
||||||
install-spork-git: $(JANET_TARGET)
|
|
||||||
mkdir -p build
|
|
||||||
rm -rf build/spork
|
|
||||||
git clone --depth=1 --branch='$(SPORK_TAG)' https://github.com/janet-lang/spork.git build/spork
|
|
||||||
$(JANET_TARGET) -e '(bundle/install "build/spork")'
|
|
||||||
|
|
||||||
uninstall:
|
uninstall:
|
||||||
-rm '$(DESTDIR)$(BINDIR)/janet'
|
-rm '$(DESTDIR)$(BINDIR)/janet'
|
||||||
|
-rm '$(DESTDIR)$(BINDIR)/jpm'
|
||||||
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
|
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||||
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
|
||||||
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
|
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
|
||||||
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||||
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
|
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
|
||||||
|
-rm '$(DESTDIR)$(JANET_MANPATH)/jpm.1'
|
||||||
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
|
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
|
||||||
|
|
||||||
#################
|
#################
|
||||||
@@ -380,14 +305,14 @@ uninstall:
|
|||||||
#################
|
#################
|
||||||
|
|
||||||
format:
|
format:
|
||||||
sh tools/format.sh
|
tools/format.sh
|
||||||
|
|
||||||
grammar: build/janet.tmLanguage
|
grammar: build/janet.tmLanguage
|
||||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||||
$(RUN) $(JANET_TARGET) $< > $@
|
$(JANET_TARGET) $< > $@
|
||||||
|
|
||||||
compile-commands:
|
compile-commands:
|
||||||
# Requires pip install compiledb
|
# Requires pip install copmiledb
|
||||||
compiledb make
|
compiledb make
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
@@ -395,7 +320,18 @@ clean:
|
|||||||
-rm -rf test/install/build test/install/modpath
|
-rm -rf test/install/build test/install/modpath
|
||||||
|
|
||||||
test-install:
|
test-install:
|
||||||
echo "JPM has been removed from default install."
|
cd test/install \
|
||||||
|
&& rm -rf build .cache .manifests \
|
||||||
|
&& jpm --verbose build \
|
||||||
|
&& jpm --verbose test \
|
||||||
|
&& build/testexec \
|
||||||
|
&& jpm --verbose quickbin testexec.janet build/testexec2 \
|
||||||
|
&& build/testexec2 \
|
||||||
|
&& mkdir -p modpath \
|
||||||
|
&& jpm --verbose --testdeps --modpath=./modpath install https://github.com/janet-lang/json.git
|
||||||
|
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/jhydro.git
|
||||||
|
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/path.git
|
||||||
|
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/argparse.git
|
||||||
|
|
||||||
help:
|
help:
|
||||||
@echo
|
@echo
|
||||||
|
|||||||
301
README.md
301
README.md
@@ -1,133 +1,61 @@
|
|||||||
[](https://janet.zulipchat.com)
|
[](https://gitter.im/janet-language/community)
|
||||||
|
|
||||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
|
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
|
[](https://travis-ci.org/janet-lang/janet)
|
||||||
[](https://github.com/janet-lang/janet/actions/workflows/test.yml)
|
[](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
|
||||||
|
[](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
|
||||||
|
|
||||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||||
|
|
||||||
**Janet** is a programming language for system scripting, expressive automation, and
|
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||||
extending programs written in C or C++ with user scripting capabilities.
|
lisp-like language, but lists are replaced
|
||||||
|
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
|
||||||
Janet makes a good system scripting language, or a language to embed in other programs.
|
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||||
It's like Lua and GNU Guile in that regard. It has more built-in functionality and a richer core language than
|
|
||||||
Lua, but smaller than GNU Guile or Python. However, it is much easier to embed and port than Python or Guile.
|
|
||||||
|
|
||||||
There is a REPL for trying out the language, as well as the ability
|
There is a REPL for trying out the language, as well as the ability
|
||||||
to run script files. This client program is separate from the core runtime, so
|
to run script files. This client program is separate from the core runtime, so
|
||||||
Janet can be embedded in other programs. Try Janet in your browser at
|
Janet can be embedded in other programs. Try Janet in your browser at
|
||||||
<https://janet-lang.org>.
|
[https://janet-lang.org](https://janet-lang.org).
|
||||||
|
|
||||||
|
If you'd like to financially support the ongoing development of Janet, consider
|
||||||
|
[sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub.
|
||||||
|
|
||||||
<br>
|
<br>
|
||||||
|
|
||||||
## Examples
|
## Use Cases
|
||||||
|
|
||||||
See the examples directory for all provided example programs.
|
Janet makes a good system scripting language, or a language to embed in other programs.
|
||||||
|
It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
|
||||||
|
Lua, but smaller than GNU Guile or Python.
|
||||||
|
|
||||||
### Game of Life
|
## Features
|
||||||
|
|
||||||
```janet
|
* Minimal setup - one binary and you are good to go!
|
||||||
# John Conway's Game of Life
|
|
||||||
|
|
||||||
(def- window
|
|
||||||
(seq [x :range [-1 2]
|
|
||||||
y :range [-1 2]
|
|
||||||
:when (not (and (zero? x) (zero? y)))]
|
|
||||||
[x y]))
|
|
||||||
|
|
||||||
(defn- neighbors
|
|
||||||
[[x y]]
|
|
||||||
(map (fn [[x1 y1]] [(+ x x1) (+ y y1)]) window))
|
|
||||||
|
|
||||||
(defn tick
|
|
||||||
"Get the next state in the Game Of Life."
|
|
||||||
[state]
|
|
||||||
(def cell-set (frequencies state))
|
|
||||||
(def neighbor-set (frequencies (mapcat neighbors state)))
|
|
||||||
(seq [coord :keys neighbor-set
|
|
||||||
:let [count (get neighbor-set coord)]
|
|
||||||
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
|
||||||
coord))
|
|
||||||
|
|
||||||
(defn draw
|
|
||||||
"Draw cells in the game of life from (x1, y1) to (x2, y2)"
|
|
||||||
[state x1 y1 x2 y2]
|
|
||||||
(def cellset @{})
|
|
||||||
(each cell state (put cellset cell true))
|
|
||||||
(loop [x :range [x1 (+ 1 x2)]
|
|
||||||
:after (print)
|
|
||||||
y :range [y1 (+ 1 y2)]]
|
|
||||||
(file/write stdout (if (get cellset [x y]) "X " ". ")))
|
|
||||||
(print))
|
|
||||||
|
|
||||||
# Print the first 20 generations of a glider
|
|
||||||
(var *state* '[(0 0) (-1 0) (1 0) (1 1) (0 2)])
|
|
||||||
(for i 0 20
|
|
||||||
(print "generation " i)
|
|
||||||
(draw *state* -7 -7 7 7)
|
|
||||||
(set *state* (tick *state*)))
|
|
||||||
```
|
|
||||||
|
|
||||||
### TCP Echo Server
|
|
||||||
|
|
||||||
```janet
|
|
||||||
# A simple TCP echo server using the built-in socket networking and event loop.
|
|
||||||
|
|
||||||
(defn handler
|
|
||||||
"Simple handler for connections."
|
|
||||||
[stream]
|
|
||||||
(defer (:close stream)
|
|
||||||
(def id (gensym))
|
|
||||||
(def b @"")
|
|
||||||
(print "Connection " id "!")
|
|
||||||
(while (:read stream 1024 b)
|
|
||||||
(printf " %v -> %v" id b)
|
|
||||||
(:write stream b)
|
|
||||||
(buffer/clear b))
|
|
||||||
(printf "Done %v!" id)
|
|
||||||
(ev/sleep 0.5)))
|
|
||||||
|
|
||||||
(net/server "127.0.0.1" "8000" handler)
|
|
||||||
```
|
|
||||||
|
|
||||||
### Windows FFI Hello, World!
|
|
||||||
|
|
||||||
```janet
|
|
||||||
# Use the FFI to popup a Windows message box - no C required
|
|
||||||
|
|
||||||
(ffi/context "user32.dll")
|
|
||||||
|
|
||||||
(ffi/defbind MessageBoxA :int
|
|
||||||
[w :ptr text :string cap :string typ :int])
|
|
||||||
|
|
||||||
(MessageBoxA nil "Hello, World!" "Test" 0)
|
|
||||||
```
|
|
||||||
|
|
||||||
## Language Features
|
|
||||||
|
|
||||||
* 600+ functions and macros in the core library
|
|
||||||
* Built-in socket networking, threading, subprocesses, and file system functions.
|
|
||||||
* Parsing Expression Grammars (PEG) engine as a more robust Regex alternative
|
|
||||||
* Macros and compile-time computation
|
|
||||||
* Per-thread event loop for efficient IO (epoll/IOCP/kqueue)
|
|
||||||
* First-class green threads (continuations) as well as OS threads
|
|
||||||
* Erlang-style supervision trees that integrate with the event loop
|
|
||||||
* First-class closures
|
* First-class closures
|
||||||
* Garbage collection
|
* Garbage collection
|
||||||
* Distributed as janet.c and janet.h for embedding into a larger program.
|
* First-class green threads (continuations)
|
||||||
* Python-style generators (implemented as a plain macro)
|
* Python-style generators (implemented as a plain macro)
|
||||||
* Mutable and immutable arrays (array/tuple)
|
* Mutable and immutable arrays (array/tuple)
|
||||||
* Mutable and immutable hashtables (table/struct)
|
* Mutable and immutable hashtables (table/struct)
|
||||||
* Mutable and immutable strings (buffer/string)
|
* Mutable and immutable strings (buffer/string)
|
||||||
* Tail recursion
|
* Macros
|
||||||
* Interface with C functions and dynamically load plugins ("natives").
|
* Byte code interpreter with an assembly interface, as well as bytecode verification
|
||||||
* Built-in C FFI for when the native bindings are too much work
|
* Tail call Optimization
|
||||||
* REPL development with debugger and inspectable runtime
|
* Direct interop with C via abstract types and C functions
|
||||||
|
* Dynamically load C libraries
|
||||||
|
* Functional and imperative standard library
|
||||||
|
* Lexical scoping
|
||||||
|
* Imperative programming as well as functional
|
||||||
|
* REPL
|
||||||
|
* Parsing Expression Grammars built into the core library
|
||||||
|
* 400+ functions and macros in the core library
|
||||||
|
* Embedding Janet in other programs
|
||||||
|
* Interactive environment with detailed stack traces
|
||||||
|
|
||||||
## Documentation
|
## Documentation
|
||||||
|
|
||||||
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
|
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
|
||||||
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html).
|
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
|
||||||
|
|
||||||
Documentation is also available locally in the REPL.
|
Documentation is also available locally in the REPL.
|
||||||
Use the `(doc symbol-name)` macro to get API
|
Use the `(doc symbol-name)` macro to get API
|
||||||
@@ -135,7 +63,7 @@ documentation for symbols in the core library. For example,
|
|||||||
```
|
```
|
||||||
(doc apply)
|
(doc apply)
|
||||||
```
|
```
|
||||||
shows documentation for the `apply` function.
|
Shows documentation for the `apply` function.
|
||||||
|
|
||||||
To get a list of all bindings in the default
|
To get a list of all bindings in the default
|
||||||
environment, use the `(all-bindings)` function. You
|
environment, use the `(all-bindings)` function. You
|
||||||
@@ -154,13 +82,11 @@ the SourceHut mirror is actively maintained.
|
|||||||
|
|
||||||
The Makefile is non-portable and requires GNU-flavored make.
|
The Makefile is non-portable and requires GNU-flavored make.
|
||||||
|
|
||||||
```sh
|
```
|
||||||
cd somewhere/my/projects/janet
|
cd somewhere/my/projects/janet
|
||||||
make
|
make
|
||||||
make test
|
make test
|
||||||
make repl
|
make repl
|
||||||
make install
|
|
||||||
make install-jpm-git
|
|
||||||
```
|
```
|
||||||
|
|
||||||
Find out more about the available make targets by running `make help`.
|
Find out more about the available make targets by running `make help`.
|
||||||
@@ -170,45 +96,42 @@ Find out more about the available make targets by running `make help`.
|
|||||||
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
|
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
|
||||||
but you need to specify an alternative compiler, such as `gcc-x86`.
|
but you need to specify an alternative compiler, such as `gcc-x86`.
|
||||||
|
|
||||||
```sh
|
```
|
||||||
cd somewhere/my/projects/janet
|
cd somewhere/my/projects/janet
|
||||||
make CC=gcc-x86
|
make CC=gcc-x86
|
||||||
make test
|
make test
|
||||||
make repl
|
make repl
|
||||||
make install
|
|
||||||
make install-jpm-git
|
|
||||||
```
|
```
|
||||||
|
|
||||||
### FreeBSD
|
### FreeBSD
|
||||||
|
|
||||||
FreeBSD build instructions are the same as the UNIX-like build instructions,
|
FreeBSD build instructions are the same as the UNIX-like build instructions,
|
||||||
but you need `gmake` to compile. Alternatively, install the package directly with `pkg install lang/janet`.
|
but you need `gmake` to compile. Alternatively, install directly from
|
||||||
|
packages, using `pkg install lang/janet`.
|
||||||
|
|
||||||
```sh
|
```
|
||||||
cd somewhere/my/projects/janet
|
cd somewhere/my/projects/janet
|
||||||
gmake
|
gmake
|
||||||
gmake test
|
gmake test
|
||||||
gmake repl
|
gmake repl
|
||||||
gmake install
|
|
||||||
gmake install-jpm-git
|
|
||||||
```
|
```
|
||||||
|
|
||||||
### NetBSD
|
### NetBSD
|
||||||
|
|
||||||
NetBSD build instructions are the same as the FreeBSD build instructions.
|
NetBSD build instructions are the same as the FreeBSD build instructions.
|
||||||
Alternatively, install the package directly with `pkgin install janet`.
|
Alternatively, install directly from packages, using `pkgin install janet`.
|
||||||
|
|
||||||
### Windows
|
### Windows
|
||||||
|
|
||||||
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#).
|
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
|
||||||
2. Run a Visual Studio Command Prompt (`cl.exe` and `link.exe` need to be on your PATH) and `cd` to the directory with Janet.
|
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
|
||||||
3. Run `build_win` to compile Janet.
|
3. Run `build_win` to compile janet.
|
||||||
4. Run `build_win test` to make sure everything is working.
|
4. Run `build_win test` to make sure everything is working.
|
||||||
|
|
||||||
To build an `.msi` installer executable, in addition to the above steps, you will have to:
|
To build an `.msi` installer executable, in addition to the above steps, you will have to:
|
||||||
|
|
||||||
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
|
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases)
|
||||||
6. Run `build_win dist`.
|
6. run `build_win dist`
|
||||||
|
|
||||||
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
|
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
|
||||||
|
|
||||||
@@ -244,9 +167,9 @@ ninja -C build install
|
|||||||
|
|
||||||
Janet can be hacked on with pretty much any environment you like, but for IDE
|
Janet can be hacked on with pretty much any environment you like, but for IDE
|
||||||
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
|
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
|
||||||
best option, as it has excellent Meson integration. It also offers code completion
|
best option, as it has excellent meson integration. It also offers code completion
|
||||||
for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim,
|
for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim,
|
||||||
Emacs, and Atom each have syntax packages for the Janet language, though.
|
Emacs, and Atom will have syntax packages for the Janet language, though.
|
||||||
|
|
||||||
## Installation
|
## Installation
|
||||||
|
|
||||||
@@ -255,8 +178,8 @@ to try out the language, you don't need to install anything. You can also move t
|
|||||||
|
|
||||||
## Usage
|
## Usage
|
||||||
|
|
||||||
A REPL is launched when the binary is invoked with no arguments. Pass the `-h` flag
|
A REPL is launched when the binary is invoked with no arguments. Pass the -h flag
|
||||||
to display the usage information. Individual scripts can be run with `./janet myscript.janet`.
|
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
|
||||||
|
|
||||||
If you are looking to explore, you can print a list of all available macros, functions, and constants
|
If you are looking to explore, you can print a list of all available macros, functions, and constants
|
||||||
by entering the command `(all-bindings)` into the REPL.
|
by entering the command `(all-bindings)` into the REPL.
|
||||||
@@ -271,38 +194,32 @@ Hello, World!
|
|||||||
nil
|
nil
|
||||||
janet:3:> (os/exit)
|
janet:3:> (os/exit)
|
||||||
$ janet -h
|
$ janet -h
|
||||||
usage: janet [options] script args...
|
usage: build/janet [options] script args...
|
||||||
Options are:
|
Options are:
|
||||||
-h : Show this help
|
-h : Show this help
|
||||||
-v : Print the version string
|
-v : Print the version string
|
||||||
-s : Use raw stdin instead of getline like functionality
|
-s : Use raw stdin instead of getline like functionality
|
||||||
-e code : Execute a string of janet
|
-e code : Execute a string of janet
|
||||||
-E code arguments... : Evaluate an expression as a short-fn with arguments
|
|
||||||
-d : Set the debug flag in the REPL
|
|
||||||
-r : Enter the REPL after running all scripts
|
-r : Enter the REPL after running all scripts
|
||||||
-R : Disables loading profile.janet when JANET_PROFILE is present
|
|
||||||
-p : Keep on executing if there is a top-level error (persistent)
|
-p : Keep on executing if there is a top-level error (persistent)
|
||||||
-q : Hide logo (quiet)
|
-q : Hide prompt, logo, and REPL output (quiet)
|
||||||
-k : Compile scripts but do not execute (flycheck)
|
-k : Compile scripts but do not execute (flycheck)
|
||||||
-m syspath : Set system path for loading global modules
|
-m syspath : Set system path for loading global modules
|
||||||
-c source output : Compile janet source code into an image
|
-c source output : Compile janet source code into an image
|
||||||
-i : Load the script argument as an image file instead of source code
|
|
||||||
-n : Disable ANSI color output in the REPL
|
-n : Disable ANSI color output in the REPL
|
||||||
-l lib : Use a module before processing more arguments
|
-l path : Execute code in a file before running the main script
|
||||||
-w level : Set the lint warning level - default is "normal"
|
|
||||||
-x level : Set the lint error level - default is "none"
|
|
||||||
-- : Stop handling options
|
-- : Stop handling options
|
||||||
```
|
```
|
||||||
|
|
||||||
If installed, you can also run `man janet` to get usage information.
|
If installed, you can also run `man janet` and `man jpm` to get usage information.
|
||||||
|
|
||||||
## Embedding
|
## Embedding
|
||||||
|
|
||||||
Janet can be embedded in a host program very easily. The normal build
|
Janet can be embedded in a host program very easily. The normal build
|
||||||
will create a file `build/janet.c`, which is a single C file
|
will create a file `build/janet.c`, which is a single C file
|
||||||
that contains all the source to Janet. This file, along with
|
that contains all the source to Janet. This file, along with
|
||||||
`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C
|
`src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C
|
||||||
project and compiled into it. Janet should be compiled with `-std=c99`
|
project and compiled into the project. Janet should be compiled with `-std=c99`
|
||||||
on most compilers, and will need to be linked to the math library, `-lm`, and
|
on most compilers, and will need to be linked to the math library, `-lm`, and
|
||||||
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
|
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
|
||||||
there is no need for dynamic modules, add the define
|
there is no need for dynamic modules, add the define
|
||||||
@@ -310,88 +227,54 @@ there is no need for dynamic modules, add the define
|
|||||||
|
|
||||||
See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
|
See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
|
||||||
|
|
||||||
|
## Examples
|
||||||
|
|
||||||
|
See the examples directory for some example janet code.
|
||||||
|
|
||||||
## Discussion
|
## Discussion
|
||||||
|
|
||||||
Feel free to ask questions and join the discussion on the [Janet Zulip Instance](https://janet.zulipchat.com/)
|
Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||||
|
Gitter provides Matrix and irc bridges as well.
|
||||||
|
|
||||||
## FAQ
|
## FAQ
|
||||||
|
|
||||||
### How fast is it?
|
|
||||||
|
|
||||||
It is about the same speed as most interpreted languages without a JIT compiler. Tight, critical
|
|
||||||
loops should probably be written in C or C++ . Programs tend to be a bit faster than
|
|
||||||
they would be in a language like Python due to the discouragement of slow Object-Oriented abstraction
|
|
||||||
with lots of hash-table lookups, and making late-binding explicit. All values are boxed in an 8-byte
|
|
||||||
representation by default and allocated on the heap, with the exception of numbers, nils and booleans. The
|
|
||||||
PEG engine is a specialized interpreter that can efficiently process string and buffer data.
|
|
||||||
|
|
||||||
The GC is simple and stop-the-world, but GC knobs are exposed in the core library and separate threads
|
|
||||||
have isolated heaps and garbage collectors. Data that is shared between threads is reference counted.
|
|
||||||
|
|
||||||
YMMV.
|
|
||||||
|
|
||||||
### Where is (favorite feature from other language)?
|
|
||||||
|
|
||||||
It may exist, it may not. If you want to propose a major language feature, go ahead and open an issue, but
|
|
||||||
it will likely be closed as "will not implement". Often, such features make one usecase simpler at the expense
|
|
||||||
of 5 others by making the language more complicated.
|
|
||||||
|
|
||||||
### Is there a language spec?
|
|
||||||
|
|
||||||
There is not currently a spec besides the documentation at <https://janet-lang.org>.
|
|
||||||
|
|
||||||
### Is this Scheme/Common Lisp? Where are the cons cells?
|
|
||||||
|
|
||||||
Nope. There are no cons cells here.
|
|
||||||
|
|
||||||
### Is this a Clojure port?
|
|
||||||
|
|
||||||
No. It's similar to Clojure superficially because I like Lisps and I like the aesthetics.
|
|
||||||
Internally, Janet is not at all like Clojure, Scheme, or Common Lisp.
|
|
||||||
|
|
||||||
### Are the immutable data structures (tuples and structs) implemented as hash tries?
|
|
||||||
|
|
||||||
No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
|
|
||||||
and maps, instead they work well as table keys or other identifiers.
|
|
||||||
|
|
||||||
### Can I do object-oriented programming with Janet?
|
|
||||||
|
|
||||||
To some extent, yes. However, it is not the recommended method of abstraction, and performance may suffer.
|
|
||||||
That said, tables can be used to make mutable objects with inheritance and polymorphism, where object
|
|
||||||
methods are implemented with keywords.
|
|
||||||
|
|
||||||
```clj
|
|
||||||
(def Car @{:honk (fn [self msg] (print "car " self " goes " msg)) })
|
|
||||||
(def my-car (table/setproto @{} Car))
|
|
||||||
(:honk my-car "Beep!")
|
|
||||||
```
|
|
||||||
|
|
||||||
### Why can't we add (feature from Clojure) into the core?
|
|
||||||
|
|
||||||
Usually, one of a few reasons:
|
|
||||||
- Often, it already exists in a different form and the Clojure port would be redundant.
|
|
||||||
- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
|
|
||||||
Janet does not run on the JVM and has a more primitive garbage collector.
|
|
||||||
- We want to keep the Janet core small. With Lisps, a feature can usually be added as a library
|
|
||||||
without feeling "bolted on", especially when compared to ALGOL-like languages. Adding features
|
|
||||||
to the core also makes it a bit more difficult to keep Janet maximally portable.
|
|
||||||
|
|
||||||
### Can I bind to Rust/Zig/Go/Java/Nim/C++/D/Pascal/Fortran/Odin/Jai/(Some new "Systems" Programming Language)?
|
|
||||||
|
|
||||||
Probably, if that language has a good interface with C. But the programmer may need to do
|
|
||||||
some extra work to map Janet's internal memory model to that of the bound language. Janet
|
|
||||||
also uses `setjmp`/`longjmp` for non-local returns internally. This
|
|
||||||
approach is out of favor with many programmers now and doesn't always play well with other languages
|
|
||||||
that have exceptions or stack-unwinding.
|
|
||||||
|
|
||||||
### Why is my terminal spitting out junk when I run the REPL?
|
### Why is my terminal spitting out junk when I run the REPL?
|
||||||
|
|
||||||
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||||
support these, but some older terminals, Windows consoles, or embedded terminals
|
support these, but some older terminals, Windows consoles, or embedded terminals
|
||||||
will not. If your terminal does not support ANSI escape codes, run the REPL with
|
will not. If your terminal does not support ANSI escape codes, run the REPL with
|
||||||
the `-n` flag, which disables color output. You can also try the `-s` flag if further issues
|
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||||
ensue.
|
ensue.
|
||||||
|
|
||||||
|
### Where is (favorite feature from other language)?
|
||||||
|
|
||||||
|
It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
|
||||||
|
they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
|
||||||
|
of 5 others by making the language more complicated.
|
||||||
|
|
||||||
|
### Where is the example code?
|
||||||
|
|
||||||
|
In the examples directory.
|
||||||
|
|
||||||
|
### Is this a Clojure port?
|
||||||
|
|
||||||
|
No. It's similar to Clojure superficially because I like Lisps and I like the asthetics.
|
||||||
|
Internally, Janet is not at all like Clojure.
|
||||||
|
|
||||||
|
### Are the immutable data structures (tuples and structs) implemented as hash tries?
|
||||||
|
|
||||||
|
No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
|
||||||
|
and maps, instead they work well as table keys or other identifiers.
|
||||||
|
|
||||||
|
### Why can't we add (feature from Clojure) into the core?
|
||||||
|
|
||||||
|
Usually, one of a few reasons:
|
||||||
|
- Often, it already exists in a different form and the Clojure port would be redundant.
|
||||||
|
- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
|
||||||
|
Janet does not run on the JVM. We admittedly have a much more primitive GC.
|
||||||
|
- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
|
||||||
|
without feeling "bolted on", especially when compared to ALGOL like languages.
|
||||||
|
|
||||||
## Why is it called "Janet"?
|
## Why is it called "Janet"?
|
||||||
|
|
||||||
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||||
|
|||||||
55
appveyor.yml
Normal file
55
appveyor.yml
Normal file
@@ -0,0 +1,55 @@
|
|||||||
|
version: build-{build}
|
||||||
|
clone_folder: c:\projects\janet
|
||||||
|
image:
|
||||||
|
- Visual Studio 2019
|
||||||
|
configuration:
|
||||||
|
- Release
|
||||||
|
platform:
|
||||||
|
- x64
|
||||||
|
- x86
|
||||||
|
environment:
|
||||||
|
matrix:
|
||||||
|
- arch: Win64
|
||||||
|
matrix:
|
||||||
|
fast_finish: true
|
||||||
|
|
||||||
|
# skip unsupported combinations
|
||||||
|
init:
|
||||||
|
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||||
|
|
||||||
|
install:
|
||||||
|
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
|
||||||
|
- build_win all
|
||||||
|
- refreshenv
|
||||||
|
# We need to reload vcvars after refreshing
|
||||||
|
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||||
|
- build_win test-install
|
||||||
|
- set janet_outname=%appveyor_repo_tag_name%
|
||||||
|
- if "%janet_outname%"=="" set /P janet_outname=<build\version.txt
|
||||||
|
build: off
|
||||||
|
|
||||||
|
artifacts:
|
||||||
|
- name: janet.c
|
||||||
|
path: dist\janet.c
|
||||||
|
type: File
|
||||||
|
- name: janet.h
|
||||||
|
path: dist\janet.h
|
||||||
|
type: File
|
||||||
|
- name: shell.c
|
||||||
|
path: dist\shell.c
|
||||||
|
type: File
|
||||||
|
- name: "janet-$(janet_outname)-windows-%platform%"
|
||||||
|
path: dist
|
||||||
|
type: Zip
|
||||||
|
- path: "janet-$(janet_outname)-windows-%platform%-installer.msi"
|
||||||
|
type: File
|
||||||
|
|
||||||
|
deploy:
|
||||||
|
description: 'The Janet Programming Language.'
|
||||||
|
provider: GitHub
|
||||||
|
auth_token:
|
||||||
|
secure: lwEXy09qhj2jSH9s1C/KvCkAUqJSma8phFR+0kbsfUc3rVxpNK5uD3z9Md0SjYRx
|
||||||
|
artifact: /(janet|shell).*/
|
||||||
|
draft: true
|
||||||
|
on:
|
||||||
|
APPVEYOR_REPO_TAG: true
|
||||||
@@ -14,18 +14,13 @@
|
|||||||
@if "%1"=="test" goto TEST
|
@if "%1"=="test" goto TEST
|
||||||
@if "%1"=="dist" goto DIST
|
@if "%1"=="dist" goto DIST
|
||||||
@if "%1"=="install" goto INSTALL
|
@if "%1"=="install" goto INSTALL
|
||||||
|
@if "%1"=="test-install" goto TESTINSTALL
|
||||||
@if "%1"=="all" goto ALL
|
@if "%1"=="all" goto ALL
|
||||||
|
|
||||||
@rem Set compile and link options here
|
@rem Set compile and link options here
|
||||||
@setlocal
|
@setlocal
|
||||||
|
|
||||||
@rem Example use asan
|
|
||||||
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi
|
|
||||||
@rem set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib
|
|
||||||
|
|
||||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
|
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
|
||||||
@set JANET_LINK=link /nologo
|
@set JANET_LINK=link /nologo
|
||||||
|
|
||||||
@set JANET_LINK_STATIC=lib /nologo
|
@set JANET_LINK_STATIC=lib /nologo
|
||||||
|
|
||||||
@rem Add janet build tag
|
@rem Add janet build tag
|
||||||
@@ -41,34 +36,32 @@ if not exist build\boot mkdir build\boot
|
|||||||
@rem Build the bootstrap interpreter
|
@rem Build the bootstrap interpreter
|
||||||
for %%f in (src\core\*.c) do (
|
for %%f in (src\core\*.c) do (
|
||||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||||
@if not errorlevel 0 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
)
|
)
|
||||||
for %%f in (src\boot\*.c) do (
|
for %%f in (src\boot\*.c) do (
|
||||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||||
@if not errorlevel 0 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
)
|
)
|
||||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||||
@if not errorlevel 0 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
build\janet_boot . > build\c\janet.c
|
build\janet_boot . > build\c\janet.c
|
||||||
@if not errorlevel 0 goto :BUILDFAIL
|
|
||||||
|
|
||||||
@rem Build the sources
|
@rem Build the sources
|
||||||
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
|
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
|
||||||
@if not errorlevel 0 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||||
@if not errorlevel 0 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build the resources
|
@rem Build the resources
|
||||||
rc /nologo /fobuild\janet_win.res janet_win.rc
|
rc /nologo /fobuild\janet_win.res janet_win.rc
|
||||||
@if not errorlevel 0 goto :BUILDFAIL
|
|
||||||
|
|
||||||
@rem Link everything to main client
|
@rem Link everything to main client
|
||||||
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
|
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
|
||||||
@if not errorlevel 0 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build static library (libjanet.lib)
|
@rem Build static library (libjanet.a)
|
||||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
|
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
|
||||||
@if not errorlevel 0 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
echo === Successfully built janet.exe for Windows ===
|
echo === Successfully built janet.exe for Windows ===
|
||||||
echo === Run 'build_win test' to run tests. ==
|
echo === Run 'build_win test' to run tests. ==
|
||||||
@@ -93,16 +86,14 @@ exit /b 0
|
|||||||
:CLEAN
|
:CLEAN
|
||||||
del *.exe *.lib *.exp
|
del *.exe *.lib *.exp
|
||||||
rd /s /q build
|
rd /s /q build
|
||||||
if exist dist (
|
rd /s /q dist
|
||||||
rd /s /q dist
|
|
||||||
)
|
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
@rem Run tests
|
@rem Run tests
|
||||||
:TEST
|
:TEST
|
||||||
for %%f in (test/suite*.janet) do (
|
for %%f in (test/suite*.janet) do (
|
||||||
janet.exe test\%%f
|
janet.exe test\%%f
|
||||||
@if not errorlevel 0 goto TESTFAIL
|
@if errorlevel 1 goto TESTFAIL
|
||||||
)
|
)
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
@@ -126,6 +117,8 @@ janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h buil
|
|||||||
copy build\janet.h dist\janet.h
|
copy build\janet.h dist\janet.h
|
||||||
copy build\libjanet.lib dist\libjanet.lib
|
copy build\libjanet.lib dist\libjanet.lib
|
||||||
|
|
||||||
|
copy .\jpm dist\jpm
|
||||||
|
|
||||||
@rem Create installer
|
@rem Create installer
|
||||||
janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt
|
janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt
|
||||||
janet.exe -e "(print (os/arch))" > build\arch.txt
|
janet.exe -e "(print (os/arch))" > build\arch.txt
|
||||||
@@ -154,6 +147,34 @@ FOR %%a in (janet-*-windows-*-installer.msi) DO (
|
|||||||
)
|
)
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
|
@rem Test the installation.
|
||||||
|
:TESTINSTALL
|
||||||
|
pushd test\install
|
||||||
|
call jpm clean
|
||||||
|
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||||
|
call jpm test
|
||||||
|
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||||
|
call jpm --verbose --modpath=. install https://github.com/janet-lang/json.git
|
||||||
|
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||||
|
call build\testexec
|
||||||
|
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||||
|
call jpm --verbose quickbin testexec.janet build\testexec2.exe
|
||||||
|
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||||
|
call build\testexec2.exe
|
||||||
|
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||||
|
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
|
||||||
|
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||||
|
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
|
||||||
|
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||||
|
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
|
||||||
|
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||||
|
popd
|
||||||
|
exit /b 0
|
||||||
|
|
||||||
|
:TESTINSTALLFAIL
|
||||||
|
popd
|
||||||
|
goto :TESTFAIL
|
||||||
|
|
||||||
@rem build, test, dist, install. Useful for local dev.
|
@rem build, test, dist, install. Useful for local dev.
|
||||||
:ALL
|
:ALL
|
||||||
call %0 build
|
call %0 build
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
(defn dowork [name n]
|
(defn dowork [name n]
|
||||||
(print name " starting work...")
|
(print name " starting work...")
|
||||||
(os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")] :p)
|
(os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")])
|
||||||
(print name " finished work!"))
|
(print name " finished work!"))
|
||||||
|
|
||||||
# Will be done in parallel
|
# Will be done in parallel
|
||||||
|
|||||||
@@ -1,35 +0,0 @@
|
|||||||
(def conmap @{})
|
|
||||||
|
|
||||||
(defn broadcast [em msg]
|
|
||||||
(eachk par conmap
|
|
||||||
(if (not= par em)
|
|
||||||
(if-let [tar (get conmap par)]
|
|
||||||
(net/write tar (string/format "[%s]:%s" em msg))))))
|
|
||||||
|
|
||||||
(defn handler
|
|
||||||
[connection]
|
|
||||||
(print "connection: " connection)
|
|
||||||
(net/write connection "Whats your name?\n")
|
|
||||||
(def name (string/trim (string (ev/read connection 100))))
|
|
||||||
(print name " connected")
|
|
||||||
(if (get conmap name)
|
|
||||||
(do
|
|
||||||
(net/write connection "Name already taken!")
|
|
||||||
(:close connection))
|
|
||||||
(do
|
|
||||||
(put conmap name connection)
|
|
||||||
(net/write connection (string/format "Welcome %s\n" name))
|
|
||||||
(defer (do
|
|
||||||
(put conmap name nil)
|
|
||||||
(:close connection))
|
|
||||||
(while (def msg (ev/read connection 100))
|
|
||||||
(broadcast name (string msg)))
|
|
||||||
(print name " disconnected")))))
|
|
||||||
|
|
||||||
(defn main [& args]
|
|
||||||
(printf "STARTING SERVER...")
|
|
||||||
(flush)
|
|
||||||
(def my-server (net/listen "127.0.0.1" "8000"))
|
|
||||||
(forever
|
|
||||||
(def connection (net/accept my-server))
|
|
||||||
(ev/call handler connection)))
|
|
||||||
@@ -1,45 +0,0 @@
|
|||||||
(defn sleep
|
|
||||||
"Sleep the entire thread, not just a single fiber."
|
|
||||||
[n]
|
|
||||||
(os/sleep (* 0.1 n)))
|
|
||||||
|
|
||||||
(defn work [lock n]
|
|
||||||
(ev/acquire-lock lock)
|
|
||||||
(print "working " n "...")
|
|
||||||
(sleep n)
|
|
||||||
(print "done working...")
|
|
||||||
(ev/release-lock lock))
|
|
||||||
|
|
||||||
(defn reader
|
|
||||||
[rwlock n]
|
|
||||||
(ev/acquire-rlock rwlock)
|
|
||||||
(print "reading " n "...")
|
|
||||||
(sleep n)
|
|
||||||
(print "done reading " n "...")
|
|
||||||
(ev/release-rlock rwlock))
|
|
||||||
|
|
||||||
(defn writer
|
|
||||||
[rwlock n]
|
|
||||||
(ev/acquire-wlock rwlock)
|
|
||||||
(print "writing " n "...")
|
|
||||||
(sleep n)
|
|
||||||
(print "done writing...")
|
|
||||||
(ev/release-wlock rwlock))
|
|
||||||
|
|
||||||
(defn test-lock
|
|
||||||
[]
|
|
||||||
(def lock (ev/lock))
|
|
||||||
(for i 3 7
|
|
||||||
(ev/spawn-thread
|
|
||||||
(work lock i))))
|
|
||||||
|
|
||||||
(defn test-rwlock
|
|
||||||
[]
|
|
||||||
(def rwlock (ev/rwlock))
|
|
||||||
(for i 0 20
|
|
||||||
(if (> 0.1 (math/random))
|
|
||||||
(ev/spawn-thread (writer rwlock i))
|
|
||||||
(ev/spawn-thread (reader rwlock i)))))
|
|
||||||
|
|
||||||
(test-rwlock)
|
|
||||||
(test-lock)
|
|
||||||
@@ -10,13 +10,3 @@
|
|||||||
(ev/call worker :b 5)
|
(ev/call worker :b 5)
|
||||||
(ev/sleep 0.3)
|
(ev/sleep 0.3)
|
||||||
(ev/call worker :c 12)
|
(ev/call worker :c 12)
|
||||||
|
|
||||||
(defn worker2
|
|
||||||
[name]
|
|
||||||
(repeat 10
|
|
||||||
(ev/sleep 0.2)
|
|
||||||
(print name " working")))
|
|
||||||
|
|
||||||
(ev/go worker2 :bob)
|
|
||||||
(ev/go worker2 :joe)
|
|
||||||
(ev/go worker2 :sally)
|
|
||||||
|
|||||||
@@ -1,71 +0,0 @@
|
|||||||
# :lazy true needed for jpm quickbin
|
|
||||||
# lazily loads library on first function use
|
|
||||||
# so the `main` function
|
|
||||||
# can be marshalled.
|
|
||||||
(ffi/context "/usr/lib/libgtk-3.so" :lazy true)
|
|
||||||
|
|
||||||
(ffi/defbind
|
|
||||||
gtk-application-new :ptr
|
|
||||||
"Add docstrings as needed."
|
|
||||||
[title :string flags :uint])
|
|
||||||
|
|
||||||
(ffi/defbind
|
|
||||||
g-signal-connect-data :ulong
|
|
||||||
[a :ptr b :ptr c :ptr d :ptr e :ptr f :int])
|
|
||||||
|
|
||||||
(ffi/defbind
|
|
||||||
g-application-run :int
|
|
||||||
[app :ptr argc :int argv :ptr])
|
|
||||||
|
|
||||||
(ffi/defbind
|
|
||||||
gtk-application-window-new :ptr
|
|
||||||
[a :ptr])
|
|
||||||
|
|
||||||
(ffi/defbind
|
|
||||||
gtk-button-new-with-label :ptr
|
|
||||||
[a :ptr])
|
|
||||||
|
|
||||||
(ffi/defbind
|
|
||||||
gtk-container-add :void
|
|
||||||
[a :ptr b :ptr])
|
|
||||||
|
|
||||||
(ffi/defbind
|
|
||||||
gtk-widget-show-all :void
|
|
||||||
[a :ptr])
|
|
||||||
|
|
||||||
(ffi/defbind
|
|
||||||
gtk-button-set-label :void
|
|
||||||
[a :ptr b :ptr])
|
|
||||||
|
|
||||||
(def cb (delay (ffi/trampoline :default)))
|
|
||||||
|
|
||||||
(defn ffi/array
|
|
||||||
``Convert a janet array to a buffer that can be passed to FFI functions.
|
|
||||||
For example, to create an array of type `char *` (array of c strings), one
|
|
||||||
could use `(ffi/array ["hello" "world"] :ptr)`. One needs to be careful that
|
|
||||||
array elements are not garbage collected though - the GC can't follow references
|
|
||||||
inside an arbitrary byte buffer.``
|
|
||||||
[arr ctype &opt buf]
|
|
||||||
(default buf @"")
|
|
||||||
(each el arr
|
|
||||||
(ffi/write ctype el buf))
|
|
||||||
buf)
|
|
||||||
|
|
||||||
(defn on-active
|
|
||||||
[app]
|
|
||||||
(def window (gtk-application-window-new app))
|
|
||||||
(def btn (gtk-button-new-with-label "Click Me!"))
|
|
||||||
(g-signal-connect-data btn "clicked" (cb)
|
|
||||||
(fn [btn] (gtk-button-set-label btn "Hello World"))
|
|
||||||
nil 1)
|
|
||||||
(gtk-container-add window btn)
|
|
||||||
(gtk-widget-show-all window))
|
|
||||||
|
|
||||||
(defn main
|
|
||||||
[&]
|
|
||||||
(def app (gtk-application-new "org.janet-lang.example.HelloApp" 0))
|
|
||||||
(g-signal-connect-data app "activate" (cb) on-active nil 1)
|
|
||||||
# manually build an array with ffi/write
|
|
||||||
# - we are responsible for preventing gc when the arg array is used
|
|
||||||
(def argv (ffi/array (dyn *args*) :string))
|
|
||||||
(g-application-run app (length (dyn *args*)) argv))
|
|
||||||
@@ -1,227 +0,0 @@
|
|||||||
#include <stdio.h>
|
|
||||||
#include <stdint.h>
|
|
||||||
#include <string.h>
|
|
||||||
|
|
||||||
#ifdef _WIN32
|
|
||||||
#define EXPORTER __declspec(dllexport)
|
|
||||||
#else
|
|
||||||
#define EXPORTER
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Structs */
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
int a, b;
|
|
||||||
float c, d;
|
|
||||||
} Split;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
float c, d;
|
|
||||||
int a, b;
|
|
||||||
} SplitFlip;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
int u, v, w, x, y, z;
|
|
||||||
} SixInts;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
int a;
|
|
||||||
int b;
|
|
||||||
} intint;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
int a;
|
|
||||||
int b;
|
|
||||||
int c;
|
|
||||||
} intintint;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
uint64_t a;
|
|
||||||
uint64_t b;
|
|
||||||
} uint64pair;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
int64_t a;
|
|
||||||
int64_t b;
|
|
||||||
int64_t c;
|
|
||||||
} big;
|
|
||||||
|
|
||||||
/* Functions */
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
int int_fn(int a, int b) {
|
|
||||||
return (a << 2) + b;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
double my_fn(int64_t a, int64_t b, const char *x) {
|
|
||||||
return (double)(a + b) + 0.5 + strlen(x);
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
double double_fn(double x, double y, double z) {
|
|
||||||
return (x + y) * z * 3;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
double double_many(double x, double y, double z, double w, double a, double b) {
|
|
||||||
return x + y + z + w + a + b;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
double double_lots(
|
|
||||||
double a,
|
|
||||||
double b,
|
|
||||||
double c,
|
|
||||||
double d,
|
|
||||||
double e,
|
|
||||||
double f,
|
|
||||||
double g,
|
|
||||||
double h,
|
|
||||||
double i,
|
|
||||||
double j) {
|
|
||||||
return i + j;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
double double_lots_2(
|
|
||||||
double a,
|
|
||||||
double b,
|
|
||||||
double c,
|
|
||||||
double d,
|
|
||||||
double e,
|
|
||||||
double f,
|
|
||||||
double g,
|
|
||||||
double h,
|
|
||||||
double i,
|
|
||||||
double j) {
|
|
||||||
return a +
|
|
||||||
10.0 * b +
|
|
||||||
100.0 * c +
|
|
||||||
1000.0 * d +
|
|
||||||
10000.0 * e +
|
|
||||||
100000.0 * f +
|
|
||||||
1000000.0 * g +
|
|
||||||
10000000.0 * h +
|
|
||||||
100000000.0 * i +
|
|
||||||
1000000000.0 * j;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
double float_fn(float x, float y, float z) {
|
|
||||||
return (x + y) * z;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
int intint_fn(double x, intint ii) {
|
|
||||||
printf("double: %g\n", x);
|
|
||||||
return ii.a + ii.b;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
int intintint_fn(double x, intintint iii) {
|
|
||||||
printf("double: %g\n", x);
|
|
||||||
return iii.a + iii.b + iii.c;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
intint return_struct(int i) {
|
|
||||||
intint ret;
|
|
||||||
ret.a = i;
|
|
||||||
ret.b = i * i;
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
big struct_big(int i, double d) {
|
|
||||||
big ret;
|
|
||||||
ret.a = i;
|
|
||||||
ret.b = (int64_t) d;
|
|
||||||
ret.c = ret.a + ret.b + 1000;
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
void void_fn(void) {
|
|
||||||
printf("void fn ran\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
void void_fn_2(double y) {
|
|
||||||
printf("y = %f\n", y);
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
void void_ret_fn(int x) {
|
|
||||||
printf("void fn ran: %d\n", x);
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
int intintint_fn_2(intintint iii, int i) {
|
|
||||||
fprintf(stderr, "iii.a = %d, iii.b = %d, iii.c = %d, i = %d\n", iii.a, iii.b, iii.c, i);
|
|
||||||
return i * (iii.a + iii.b + iii.c);
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
float split_fn(Split s) {
|
|
||||||
return s.a * s.c + s.b * s.d;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
float split_flip_fn(SplitFlip s) {
|
|
||||||
return s.a * s.c + s.b * s.d;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
Split split_ret_fn(int x, float y) {
|
|
||||||
Split ret;
|
|
||||||
ret.a = x;
|
|
||||||
ret.b = x;
|
|
||||||
ret.c = y;
|
|
||||||
ret.d = y;
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
SplitFlip split_flip_ret_fn(int x, float y) {
|
|
||||||
SplitFlip ret;
|
|
||||||
ret.a = x;
|
|
||||||
ret.b = x;
|
|
||||||
ret.c = y;
|
|
||||||
ret.d = y;
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
SixInts sixints_fn(void) {
|
|
||||||
return (SixInts) {
|
|
||||||
6666, 1111, 2222, 3333, 4444, 5555
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
int sixints_fn_2(int x, SixInts s) {
|
|
||||||
return x + s.u + s.v + s.w + s.x + s.y + s.z;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
int sixints_fn_3(SixInts s, int x) {
|
|
||||||
return x + s.u + s.v + s.w + s.x + s.y + s.z;
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
intint stack_spill_fn(uint8_t a, uint8_t b, uint8_t c, uint8_t d,
|
|
||||||
uint8_t e, uint8_t f, uint8_t g, uint8_t h,
|
|
||||||
float i, float j, float k, float l,
|
|
||||||
float m, float n, float o, float p,
|
|
||||||
float s1, int8_t s2, uint8_t s3, double s4, uint8_t s5, intint s6) {
|
|
||||||
return (intint) {
|
|
||||||
(a | b | c | d | e | f | g | h) + (i + j + k + l + m + n + o + p),
|
|
||||||
s1 *s6.a + s2 *s6.b + s3 *s4 *s5
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
EXPORTER
|
|
||||||
double stack_spill_fn_2(uint64pair a, uint64pair b, uint64pair c, int8_t d, uint64pair e, int8_t f) {
|
|
||||||
return (double)(a.a * c.a + a.b * c.b + b.a * e.a) * f - (double)(b.b * e.b) + d;
|
|
||||||
}
|
|
||||||
@@ -1,150 +0,0 @@
|
|||||||
#
|
|
||||||
# Simple FFI test script that tests against a simple shared object
|
|
||||||
#
|
|
||||||
|
|
||||||
(def is-windows (= :windows (os/which)))
|
|
||||||
(def ffi/loc (string "examples/ffi/so." (if is-windows "dll" "so")))
|
|
||||||
(def ffi/source-loc "examples/ffi/so.c")
|
|
||||||
|
|
||||||
(if is-windows
|
|
||||||
(os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
|
|
||||||
(os/execute ["cc" ffi/source-loc "-g" "-shared" "-o" ffi/loc] :px))
|
|
||||||
|
|
||||||
(ffi/context ffi/loc)
|
|
||||||
|
|
||||||
(def intint (ffi/struct :int :int))
|
|
||||||
(def intintint (ffi/struct :int :int :int))
|
|
||||||
(def uint64pair (ffi/struct :u64 :u64))
|
|
||||||
(def big (ffi/struct :s64 :s64 :s64))
|
|
||||||
(def split (ffi/struct :int :int :float :float))
|
|
||||||
(def split-flip (ffi/struct :float :float :int :int))
|
|
||||||
(def six-ints (ffi/struct :int :int :int :int :int :int))
|
|
||||||
|
|
||||||
(ffi/defbind int-fn :int [a :int b :int])
|
|
||||||
(ffi/defbind double-fn :double [a :double b :double c :double])
|
|
||||||
(ffi/defbind double-many :double
|
|
||||||
[x :double y :double z :double w :double a :double b :double])
|
|
||||||
(ffi/defbind double-lots :double
|
|
||||||
[a :double b :double c :double d :double e :double f :double g :double h :double i :double j :double])
|
|
||||||
(ffi/defbind float-fn :double
|
|
||||||
[x :float y :float z :float])
|
|
||||||
(ffi/defbind intint-fn :int
|
|
||||||
[x :double ii [:int :int]])
|
|
||||||
(ffi/defbind return-struct [:int :int]
|
|
||||||
[i :int])
|
|
||||||
(ffi/defbind intintint-fn :int
|
|
||||||
[x :double iii intintint])
|
|
||||||
(ffi/defbind struct-big big
|
|
||||||
[i :int d :double])
|
|
||||||
(ffi/defbind void-fn :void [])
|
|
||||||
(ffi/defbind double-lots-2 :double
|
|
||||||
[a :double
|
|
||||||
b :double
|
|
||||||
c :double
|
|
||||||
d :double
|
|
||||||
e :double
|
|
||||||
f :double
|
|
||||||
g :double
|
|
||||||
h :double
|
|
||||||
i :double
|
|
||||||
j :double])
|
|
||||||
(ffi/defbind void-fn-2 :void [y :double])
|
|
||||||
(ffi/defbind intintint-fn-2 :int [iii intintint i :int])
|
|
||||||
(ffi/defbind split-fn :float [s split])
|
|
||||||
(ffi/defbind split-flip-fn :float [s split-flip])
|
|
||||||
(ffi/defbind split-ret-fn split [x :int y :float])
|
|
||||||
(ffi/defbind split-flip-ret-fn split-flip [x :int y :float])
|
|
||||||
(ffi/defbind sixints-fn six-ints [])
|
|
||||||
(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
|
|
||||||
(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
|
|
||||||
(ffi/defbind stack-spill-fn intint
|
|
||||||
[a :u8 b :u8 c :u8 d :u8
|
|
||||||
e :u8 f :u8 g :u8 h :u8
|
|
||||||
i :float j :float k :float l :float
|
|
||||||
m :float n :float o :float p :float
|
|
||||||
s1 :float s2 :s8 s3 :u8 s4 :double s5 :u8 s6 intint])
|
|
||||||
(ffi/defbind stack-spill-fn-2 :double [a uint64pair b uint64pair c uint64pair d :s8 e uint64pair f :s8])
|
|
||||||
(ffi/defbind-alias int-fn int-fn-aliased :int [a :int b :int])
|
|
||||||
|
|
||||||
#
|
|
||||||
# Struct reading and writing
|
|
||||||
#
|
|
||||||
|
|
||||||
(defn check-round-trip
|
|
||||||
[t value]
|
|
||||||
(def buf (ffi/write t value))
|
|
||||||
(def same-value (ffi/read t buf))
|
|
||||||
(assert (deep= value same-value)
|
|
||||||
(string/format "round trip %j (got %j)" value same-value)))
|
|
||||||
|
|
||||||
(check-round-trip :bool true)
|
|
||||||
(check-round-trip :bool false)
|
|
||||||
(check-round-trip :void nil)
|
|
||||||
(check-round-trip :void nil)
|
|
||||||
(check-round-trip :s8 10)
|
|
||||||
(check-round-trip :s8 0)
|
|
||||||
(check-round-trip :s8 -10)
|
|
||||||
(check-round-trip :u8 10)
|
|
||||||
(check-round-trip :u8 0)
|
|
||||||
(check-round-trip :s16 10)
|
|
||||||
(check-round-trip :s16 0)
|
|
||||||
(check-round-trip :s16 -12312)
|
|
||||||
(check-round-trip :u16 10)
|
|
||||||
(check-round-trip :u16 0)
|
|
||||||
(check-round-trip :u32 0)
|
|
||||||
(check-round-trip :u32 10)
|
|
||||||
(check-round-trip :u32 0xFFFF7777)
|
|
||||||
(check-round-trip :s32 0x7FFF7777)
|
|
||||||
(check-round-trip :s32 0)
|
|
||||||
(check-round-trip :s32 -1234567)
|
|
||||||
|
|
||||||
(def s (ffi/struct :s8 :s8 :s8 :float))
|
|
||||||
(check-round-trip s [1 3 5 123.5])
|
|
||||||
(check-round-trip s [-1 -3 -5 -123.5])
|
|
||||||
|
|
||||||
#
|
|
||||||
# Call functions
|
|
||||||
#
|
|
||||||
|
|
||||||
(tracev (sixints-fn))
|
|
||||||
(tracev (sixints-fn-2 100 [1 2 3 4 5 6]))
|
|
||||||
(tracev (sixints-fn-3 [1 2 3 4 5 6] 200))
|
|
||||||
(tracev (split-ret-fn 10 12))
|
|
||||||
(tracev (split-flip-ret-fn 10 12))
|
|
||||||
(tracev (split-flip-ret-fn 12 10))
|
|
||||||
(tracev (intintint-fn-2 [10 20 30] 3))
|
|
||||||
(tracev (split-fn [5 6 1.2 3.4]))
|
|
||||||
(tracev (void-fn-2 10.3))
|
|
||||||
(tracev (double-many 1 2 3 4 5 6))
|
|
||||||
(tracev (string/format "%.17g" (double-many 1 2 3 4 5 6)))
|
|
||||||
(tracev (type (double-many 1 2 3 4 5 6)))
|
|
||||||
(tracev (double-lots-2 0 1 2 3 4 5 6 7 8 9))
|
|
||||||
(tracev (void-fn))
|
|
||||||
(tracev (int-fn 10 20))
|
|
||||||
(tracev (double-fn 1.5 2.5 3.5))
|
|
||||||
(tracev (double-lots 1 2 3 4 5 6 7 8 9 10))
|
|
||||||
(tracev (float-fn 8 4 17))
|
|
||||||
(tracev (intint-fn 123.456 [10 20]))
|
|
||||||
(tracev (intintint-fn 123.456 [10 20 30]))
|
|
||||||
(tracev (return-struct 42))
|
|
||||||
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
|
|
||||||
(tracev (struct-big 11 99.5))
|
|
||||||
(tracev (int-fn-aliased 10 20))
|
|
||||||
|
|
||||||
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
|
|
||||||
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
|
|
||||||
(assert (= 183 (intintint-fn-2 [10 20 31] 3)))
|
|
||||||
(assert (= 264 (math/round (* 10 (split-fn [5 6 1.2 3.4])))))
|
|
||||||
(assert (= 9876543210 (double-lots-2 0 1 2 3 4 5 6 7 8 9)))
|
|
||||||
(assert (= 60 (int-fn 10 20)))
|
|
||||||
(assert (= 42 (double-fn 1.5 2.5 3.5)))
|
|
||||||
(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
|
|
||||||
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
|
|
||||||
(assert (= 204 (float-fn 8 4 17)))
|
|
||||||
(assert (= [0 38534415] (stack-spill-fn
|
|
||||||
0 0 0 0 0 0 0 0
|
|
||||||
0 0 0 0 0 0 0 0
|
|
||||||
1.5 -32 196 65536.5 3 [-15 32])))
|
|
||||||
(assert (= -2806 (stack-spill-fn-2 [2 3] [5 7] [9 11] -19 [13 17] -23)))
|
|
||||||
|
|
||||||
(print "Done.")
|
|
||||||
@@ -1,7 +0,0 @@
|
|||||||
(ffi/context "user32.dll")
|
|
||||||
|
|
||||||
(ffi/defbind MessageBoxA :int
|
|
||||||
[w :ptr text :string cap :string typ :int])
|
|
||||||
|
|
||||||
(MessageBoxA nil "Hello, World!" "Test" 0)
|
|
||||||
|
|
||||||
Binary file not shown.
@@ -1,17 +0,0 @@
|
|||||||
BITS 64
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; Code
|
|
||||||
;;;
|
|
||||||
mov rax, 1 ; write(
|
|
||||||
mov rdi, 1 ; STDOUT_FILENO,
|
|
||||||
lea rsi, [rel msg] ; msg,
|
|
||||||
mov rdx, msglen ; sizeof(msg)
|
|
||||||
syscall ; );
|
|
||||||
ret ; return;
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; Constants
|
|
||||||
;;;
|
|
||||||
msg: db "Hello, world!", 10
|
|
||||||
msglen: equ $ - msg
|
|
||||||
@@ -1,13 +0,0 @@
|
|||||||
###
|
|
||||||
### Relies on NASM being installed to assemble code.
|
|
||||||
### Only works on x86-64 Linux.
|
|
||||||
###
|
|
||||||
### Before running, compile hello.nasm to hello.bin with
|
|
||||||
### $ nasm hello.nasm -o hello.bin
|
|
||||||
|
|
||||||
(def bin (slurp "hello.bin"))
|
|
||||||
(def f (ffi/jitfn bin))
|
|
||||||
(def signature (ffi/signature :default :void))
|
|
||||||
(ffi/call f signature)
|
|
||||||
(print "called a jitted function with FFI!")
|
|
||||||
(print "machine code: " (describe (string/slice f)))
|
|
||||||
@@ -1,2 +0,0 @@
|
|||||||
(while (not (empty? (def line (getline))))
|
|
||||||
(prin "line: " line))
|
|
||||||
@@ -1,30 +0,0 @@
|
|||||||
(defn init-db [c]
|
|
||||||
(def res @{:clients @{}})
|
|
||||||
(var i 0)
|
|
||||||
(repeat c
|
|
||||||
(def n (string "client" i))
|
|
||||||
(put-in res [:clients n] @{:name n :projects @{}})
|
|
||||||
(++ i)
|
|
||||||
(repeat c
|
|
||||||
(def pn (string "project" i))
|
|
||||||
(put-in res [:clients n :projects pn] @{:name pn})
|
|
||||||
(++ i)
|
|
||||||
(repeat c
|
|
||||||
(def tn (string "task" i))
|
|
||||||
(put-in res [:clients n :projects pn :tasks tn] @{:name pn})
|
|
||||||
(++ i))))
|
|
||||||
res)
|
|
||||||
|
|
||||||
(loop [c :range [30 80 1]]
|
|
||||||
(var s (os/clock))
|
|
||||||
(print "Marshal DB with " c " clients, "
|
|
||||||
(* c c) " projects and "
|
|
||||||
(* c c c) " tasks. "
|
|
||||||
"Total " (+ (* c c c) (* c c) c) " tables")
|
|
||||||
(def buf (marshal (init-db c) @{} @""))
|
|
||||||
(print "Buffer is " (length buf) " bytes")
|
|
||||||
(print "Duration " (- (os/clock) s))
|
|
||||||
(set s (os/clock))
|
|
||||||
(gccollect)
|
|
||||||
(print "Collected garbage in " (- (os/clock) s)))
|
|
||||||
|
|
||||||
@@ -76,16 +76,9 @@ void num_array_put(void *p, Janet key, Janet value) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet num_array_length(int32_t argc, Janet *argv) {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
|
|
||||||
return janet_wrap_number(array->size);
|
|
||||||
}
|
|
||||||
|
|
||||||
static const JanetMethod methods[] = {
|
static const JanetMethod methods[] = {
|
||||||
{"scale", num_array_scale},
|
{"scale", num_array_scale},
|
||||||
{"sum", num_array_sum},
|
{"sum", num_array_sum},
|
||||||
{"length", num_array_length},
|
|
||||||
{NULL, NULL}
|
{NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -116,11 +109,6 @@ static const JanetReg cfuns[] = {
|
|||||||
"(numarray/scale numarray factor)\n\n"
|
"(numarray/scale numarray factor)\n\n"
|
||||||
"scale numarray by factor"
|
"scale numarray by factor"
|
||||||
},
|
},
|
||||||
{
|
|
||||||
"sum", num_array_sum,
|
|
||||||
"(numarray/sum numarray)\n\n"
|
|
||||||
"sums numarray"
|
|
||||||
},
|
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
(import /build/numarray)
|
(import build/numarray)
|
||||||
|
|
||||||
(def a (numarray/new 30))
|
(def a (numarray/new 30))
|
||||||
(print (get a 20))
|
(print (get a 20))
|
||||||
|
|||||||
@@ -1,5 +0,0 @@
|
|||||||
# Switch to python
|
|
||||||
|
|
||||||
(print "running in Janet")
|
|
||||||
(os/posix-exec ["python"] :p)
|
|
||||||
(print "will not print")
|
|
||||||
@@ -1 +0,0 @@
|
|||||||
(def abc 123)
|
|
||||||
@@ -1,7 +0,0 @@
|
|||||||
(defn install
|
|
||||||
[manifest &]
|
|
||||||
(bundle/add-file manifest "badmod.janet"))
|
|
||||||
|
|
||||||
(defn check
|
|
||||||
[&]
|
|
||||||
(error "Check failed!"))
|
|
||||||
@@ -1 +0,0 @@
|
|||||||
(defn fun [x] (range x))
|
|
||||||
@@ -1,3 +0,0 @@
|
|||||||
(defn install
|
|
||||||
[manifest &]
|
|
||||||
(bundle/add-file manifest "aliases-mod.janet"))
|
|
||||||
@@ -1,4 +0,0 @@
|
|||||||
@{
|
|
||||||
:name "sample-bundle-aliases"
|
|
||||||
:dependencies ["sample-dep1" "sample-dep2"]
|
|
||||||
}
|
|
||||||
@@ -1,4 +0,0 @@
|
|||||||
@{
|
|
||||||
:name "sample-bundle"
|
|
||||||
:dependencies ["sample-dep1" "sample-dep2"]
|
|
||||||
}
|
|
||||||
@@ -1,3 +0,0 @@
|
|||||||
(defn install
|
|
||||||
[manifest &]
|
|
||||||
(bundle/add-file manifest "mymod.janet"))
|
|
||||||
@@ -1,7 +0,0 @@
|
|||||||
(import dep1)
|
|
||||||
(import dep2)
|
|
||||||
|
|
||||||
(defn myfn
|
|
||||||
[x]
|
|
||||||
(def y (dep2/function x))
|
|
||||||
(dep1/function y))
|
|
||||||
@@ -1,4 +0,0 @@
|
|||||||
@{
|
|
||||||
:name "sample-dep1"
|
|
||||||
:dependencies ["sample-dep2"]
|
|
||||||
}
|
|
||||||
@@ -1,3 +0,0 @@
|
|||||||
(defn install
|
|
||||||
[manifest &]
|
|
||||||
(bundle/add-file manifest "dep1.janet"))
|
|
||||||
@@ -1,3 +0,0 @@
|
|||||||
(defn function
|
|
||||||
[x]
|
|
||||||
(+ x x))
|
|
||||||
@@ -1,3 +0,0 @@
|
|||||||
@{
|
|
||||||
:name "sample-dep2"
|
|
||||||
}
|
|
||||||
@@ -1,3 +0,0 @@
|
|||||||
(defn install
|
|
||||||
[manifest &]
|
|
||||||
(bundle/add-file manifest "dep2.janet"))
|
|
||||||
@@ -1,3 +0,0 @@
|
|||||||
(defn function
|
|
||||||
[x]
|
|
||||||
(* x x))
|
|
||||||
@@ -1,41 +0,0 @@
|
|||||||
###
|
|
||||||
### Usage: janet examples/sigaction.janet 1|2|3|4 &
|
|
||||||
###
|
|
||||||
### Then at shell: kill -s SIGTERM $!
|
|
||||||
###
|
|
||||||
|
|
||||||
(defn action
|
|
||||||
[]
|
|
||||||
(print "Handled SIGTERM!")
|
|
||||||
(flush)
|
|
||||||
(os/exit 1))
|
|
||||||
|
|
||||||
(defn main1
|
|
||||||
[]
|
|
||||||
(os/sigaction :term action true)
|
|
||||||
(forever))
|
|
||||||
|
|
||||||
(defn main2
|
|
||||||
[]
|
|
||||||
(os/sigaction :term action)
|
|
||||||
(forever))
|
|
||||||
|
|
||||||
(defn main3
|
|
||||||
[]
|
|
||||||
(os/sigaction :term action true)
|
|
||||||
(forever (ev/sleep math/inf)))
|
|
||||||
|
|
||||||
(defn main4
|
|
||||||
[]
|
|
||||||
(os/sigaction :term action)
|
|
||||||
(forever (ev/sleep math/inf)))
|
|
||||||
|
|
||||||
(defn main
|
|
||||||
[& args]
|
|
||||||
(def which (scan-number (get args 1 "1")))
|
|
||||||
(case which
|
|
||||||
1 (main1) # should work
|
|
||||||
2 (main2) # will not work
|
|
||||||
3 (main3) # should work
|
|
||||||
4 (main4) # should work
|
|
||||||
(error "bad main")))
|
|
||||||
@@ -1,22 +0,0 @@
|
|||||||
(def chan (ev/thread-chan 10))
|
|
||||||
|
|
||||||
(ev/spawn
|
|
||||||
(ev/sleep 0)
|
|
||||||
(print "started fiber!")
|
|
||||||
(ev/give chan (math/random))
|
|
||||||
(ev/give chan (math/random))
|
|
||||||
(ev/give chan (math/random))
|
|
||||||
(ev/sleep 0.5)
|
|
||||||
(for i 0 10
|
|
||||||
(print "giving to channel...")
|
|
||||||
(ev/give chan (math/random))
|
|
||||||
(ev/sleep 1))
|
|
||||||
(print "finished fiber!")
|
|
||||||
(:close chan))
|
|
||||||
|
|
||||||
(ev/do-thread
|
|
||||||
(print "started thread!")
|
|
||||||
(ev/sleep 1)
|
|
||||||
(while (def x (do (print "taking from channel...") (ev/take chan)))
|
|
||||||
(print "got " x " from thread!"))
|
|
||||||
(print "finished thread!"))
|
|
||||||
68
examples/threads.janet
Normal file
68
examples/threads.janet
Normal file
@@ -0,0 +1,68 @@
|
|||||||
|
(defn worker-main
|
||||||
|
"Sends 11 messages back to parent"
|
||||||
|
[parent]
|
||||||
|
(def name (thread/receive))
|
||||||
|
(def interval (thread/receive))
|
||||||
|
(for i 0 10
|
||||||
|
(os/sleep interval)
|
||||||
|
(:send parent (string/format "thread %s wakeup no. %d" name i)))
|
||||||
|
(:send parent name))
|
||||||
|
|
||||||
|
(defn make-worker
|
||||||
|
[name interval]
|
||||||
|
(-> (thread/new worker-main)
|
||||||
|
(:send name)
|
||||||
|
(:send interval)))
|
||||||
|
|
||||||
|
(def bob (make-worker "bob" 0.02))
|
||||||
|
(def joe (make-worker "joe" 0.03))
|
||||||
|
(def sam (make-worker "sam" 0.05))
|
||||||
|
|
||||||
|
# Receive out of order
|
||||||
|
(for i 0 33
|
||||||
|
(print (thread/receive)))
|
||||||
|
|
||||||
|
#
|
||||||
|
# Recursive Thread Tree - should pause for a bit, and then print a cool zigzag.
|
||||||
|
#
|
||||||
|
|
||||||
|
(def rng (math/rng (os/cryptorand 16)))
|
||||||
|
|
||||||
|
(defn choose [& xs]
|
||||||
|
(in xs (:int rng (length xs))))
|
||||||
|
|
||||||
|
(defn worker-tree
|
||||||
|
[parent]
|
||||||
|
(def name (thread/receive))
|
||||||
|
(def depth (thread/receive))
|
||||||
|
(if (< depth 5)
|
||||||
|
(do
|
||||||
|
(defn subtree []
|
||||||
|
(-> (thread/new worker-tree)
|
||||||
|
(:send (string name "/" (choose "bob" "marley" "harry" "suki" "anna" "yu")))
|
||||||
|
(:send (inc depth))))
|
||||||
|
(let [l (subtree)
|
||||||
|
r (subtree)
|
||||||
|
lrep (thread/receive)
|
||||||
|
rrep (thread/receive)]
|
||||||
|
(:send parent [name ;lrep ;rrep])))
|
||||||
|
(do
|
||||||
|
(:send parent [name]))))
|
||||||
|
|
||||||
|
(-> (thread/new worker-tree) (:send "adam") (:send 0))
|
||||||
|
(def lines (thread/receive))
|
||||||
|
(map print lines)
|
||||||
|
|
||||||
|
#
|
||||||
|
# Receive timeout
|
||||||
|
#
|
||||||
|
|
||||||
|
(def slow (make-worker "slow-loras" 0.5))
|
||||||
|
(for i 0 50
|
||||||
|
(try
|
||||||
|
(let [msg (thread/receive 0.1)]
|
||||||
|
(print "\n" msg))
|
||||||
|
([err] (prin ".") (:flush stdout))))
|
||||||
|
|
||||||
|
(print "\ndone timing, timeouts ending.")
|
||||||
|
(try (while true (print (thread/receive))) ([err] (print "done")))
|
||||||
@@ -1,10 +1,10 @@
|
|||||||
# An example of using Janet's extensible module system to import files from
|
# An example of using Janet's extensible module system
|
||||||
# URL. To try this, run `janet -l ./examples/urlloader.janet` from the command
|
# to import files from URL. To try this, run `janet -l examples/urlloader.janet`
|
||||||
# line, and then at the REPL type:
|
# from the repl, and then:
|
||||||
#
|
#
|
||||||
# (import https://raw.githubusercontent.com/janet-lang/janet/master/examples/colors.janet :as c)
|
# (import https://raw.githubusercontent.com/janet-lang/janet/master/examples/colors.janet :as c)
|
||||||
#
|
#
|
||||||
# This will import a file using curl. You can then try:
|
# This will import a file using curl. You can then try
|
||||||
#
|
#
|
||||||
# (print (c/color :green "Hello!"))
|
# (print (c/color :green "Hello!"))
|
||||||
#
|
#
|
||||||
@@ -13,9 +13,9 @@
|
|||||||
|
|
||||||
(defn- load-url
|
(defn- load-url
|
||||||
[url args]
|
[url args]
|
||||||
(def p (os/spawn ["curl" url "-s"] :p {:out :pipe}))
|
(def f (file/popen (string "curl " url)))
|
||||||
(def res (dofile (p :out) :source url ;args))
|
(def res (dofile f :source url ;args))
|
||||||
(:wait p)
|
(try (file/close f) ([err] nil))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
(defn- check-http-url
|
(defn- check-http-url
|
||||||
|
|||||||
@@ -1,20 +0,0 @@
|
|||||||
(def weak-k (table/weak-keys 10))
|
|
||||||
(def weak-v (table/weak-values 10))
|
|
||||||
(def weak-kv (table/weak 10))
|
|
||||||
|
|
||||||
(put weak-kv (gensym) 10)
|
|
||||||
(put weak-kv :hello :world)
|
|
||||||
(put weak-k :abc123zz77asda :stuff)
|
|
||||||
(put weak-k true :abc123zz77asda)
|
|
||||||
(put weak-k :zyzzyz false)
|
|
||||||
(put weak-v (gensym) 10)
|
|
||||||
(put weak-v 20 (gensym))
|
|
||||||
(print "before gc")
|
|
||||||
(tracev weak-k)
|
|
||||||
(tracev weak-v)
|
|
||||||
(tracev weak-kv)
|
|
||||||
(gccollect)
|
|
||||||
(print "after gc")
|
|
||||||
(tracev weak-k)
|
|
||||||
(tracev weak-v)
|
|
||||||
(tracev weak-kv)
|
|
||||||
31
janet.1
31
janet.1
@@ -3,9 +3,8 @@
|
|||||||
janet \- run the Janet language abstract machine
|
janet \- run the Janet language abstract machine
|
||||||
.SH SYNOPSIS
|
.SH SYNOPSIS
|
||||||
.B janet
|
.B janet
|
||||||
[\fB\-hvsrpnqik\fR]
|
[\fB\-hvsrpnqk\fR]
|
||||||
[\fB\-e\fR \fISOURCE\fR]
|
[\fB\-e\fR \fISOURCE\fR]
|
||||||
[\fB\-E\fR \fISOURCE ...ARGUMENTS\fR]
|
|
||||||
[\fB\-l\fR \fIMODULE\fR]
|
[\fB\-l\fR \fIMODULE\fR]
|
||||||
[\fB\-m\fR \fIPATH\fR]
|
[\fB\-m\fR \fIPATH\fR]
|
||||||
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
||||||
@@ -163,16 +162,6 @@ Read raw input from stdin and forgo prompt history and other readline-like featu
|
|||||||
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
|
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
|
||||||
arguments are executed before later ones.
|
arguments are executed before later ones.
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-E\ code\ arguments...
|
|
||||||
Execute a single Janet expression as a Janet short-fn, passing the remaining command line arguments to the expression. This allows
|
|
||||||
more concise one-liners with command line arguments.
|
|
||||||
|
|
||||||
Example: janet -E '(print $0)' 12 is equivalent to '((short-fn (print $0)) 12)', which is in turn equivalent to
|
|
||||||
`((fn [k] (print k)) 12)`
|
|
||||||
|
|
||||||
See docs for the `short-fn` function for more details.
|
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-d
|
.BR \-d
|
||||||
Enable debug mode. On all terminating signals as well the debug signal, this will
|
Enable debug mode. On all terminating signals as well the debug signal, this will
|
||||||
@@ -183,10 +172,6 @@ default repl.
|
|||||||
.BR \-n
|
.BR \-n
|
||||||
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-N
|
|
||||||
Enable ANSI colors in the repl. Has no effect if no repl is run.
|
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-r
|
.BR \-r
|
||||||
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
|
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
|
||||||
@@ -222,11 +207,6 @@ Precompiles Janet source code into an image, a binary dump that can be efficient
|
|||||||
Source should be a path to the Janet module to compile, and output should be the file path of
|
Source should be a path to the Janet module to compile, and output should be the file path of
|
||||||
resulting image. Output should usually end with the .jimage extension.
|
resulting image. Output should usually end with the .jimage extension.
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-i
|
|
||||||
When this flag is passed, a script passed to the interpreter will be treated as a janet image file
|
|
||||||
rather than a janet source file.
|
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-l\ lib
|
.BR \-l\ lib
|
||||||
Import a Janet module before running a script or repl. Multiple files can be loaded
|
Import a Janet module before running a script or repl. Multiple files can be loaded
|
||||||
@@ -255,8 +235,7 @@ and then arguments to the script.
|
|||||||
.RS
|
.RS
|
||||||
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
||||||
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||||
the default location set at compile time. This should be a list of as well as a colon
|
the default location set at compile time.
|
||||||
separate list of such directories.
|
|
||||||
.RE
|
.RE
|
||||||
|
|
||||||
.B JANET_PROFILE
|
.B JANET_PROFILE
|
||||||
@@ -273,11 +252,5 @@ This variable does nothing in the default configuration of Janet, as PRF is disa
|
|||||||
cannot be defined for this variable to have an effect.
|
cannot be defined for this variable to have an effect.
|
||||||
.RE
|
.RE
|
||||||
|
|
||||||
.B NO_COLOR
|
|
||||||
.RS
|
|
||||||
Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime
|
|
||||||
via dynamic bindings *err-color* and *pretty-format*, or via the command line parameters -n and -N.
|
|
||||||
.RE
|
|
||||||
|
|
||||||
.SH AUTHOR
|
.SH AUTHOR
|
||||||
Written by Calvin Rose <calsrose@gmail.com>
|
Written by Calvin Rose <calsrose@gmail.com>
|
||||||
|
|||||||
298
jpm.1
Normal file
298
jpm.1
Normal file
@@ -0,0 +1,298 @@
|
|||||||
|
.TH JPM 1
|
||||||
|
.SH NAME
|
||||||
|
jpm \- the Janet Project Manager, a build tool for Janet
|
||||||
|
.SH SYNOPSIS
|
||||||
|
.B jpm
|
||||||
|
[\fB\-\-flag ...\fR]
|
||||||
|
[\fB\-\-option=value ...\fR]
|
||||||
|
.IR command
|
||||||
|
.IR args ...
|
||||||
|
.SH DESCRIPTION
|
||||||
|
jpm is the build tool that ships with a standard Janet install. It is
|
||||||
|
used for building Janet projects, installing dependencies, installing
|
||||||
|
projects, building native modules, and exporting your Janet project to a
|
||||||
|
standalone executable. Although not required for working with Janet, it
|
||||||
|
removes much of the boilerplate with installing dependencies and
|
||||||
|
building native modules. jpm requires only Janet to run, and uses git
|
||||||
|
to install dependencies (jpm will work without git installed).
|
||||||
|
.SH DOCUMENTATION
|
||||||
|
|
||||||
|
jpm has several subcommands, each used for managing either a single Janet project or
|
||||||
|
all Janet modules installed on the system. Global commands, those that manage modules
|
||||||
|
at the system level, do things like install and uninstall packages, as well as clear the cache.
|
||||||
|
More interesting are the local commands. For more information on jpm usage, see https://janet-lang.org/docs/index.html
|
||||||
|
|
||||||
|
.SH FLAGS
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-nocolor
|
||||||
|
Disable color in the jpm debug repl.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-verbose
|
||||||
|
Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-test
|
||||||
|
If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-offline
|
||||||
|
Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
|
||||||
|
Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing
|
||||||
|
the network, for example, a build script that invokes curl will still have network access.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-auto\-shebang
|
||||||
|
Prepends installed scripts with a generated shebang line, such that they will use a janet binary located in JANET_BINPATH.
|
||||||
|
|
||||||
|
.SH OPTIONS
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-modpath=/some/path
|
||||||
|
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order. You most likely don't need this.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-headerpath=/some/path
|
||||||
|
Set the path the jpm will include when building C source code. This lets
|
||||||
|
you specify the location of janet.h and janetconf.h on your system. On a
|
||||||
|
normal install, this option is not needed.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-binpath=/some/path
|
||||||
|
Set the path that jpm will install scripts and standalone executables to. Executables
|
||||||
|
defined via declare-execuatble or scripts declared via declare-binscript will be installed
|
||||||
|
here when jpm install is run. Defaults to $JANET_BINPATH, or a reasonable default for the system.
|
||||||
|
See JANET_BINPATH for more.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-libpath=/some/path
|
||||||
|
Sets the path jpm will use to look for libjanet.a for building standalone executables. libjanet.so
|
||||||
|
is \fBnot\fR used for building native modules or standalone executables, only
|
||||||
|
for linking into applications that want to embed janet as a dynamic module.
|
||||||
|
Linking statically might be a better idea, even in that case. Defaults to
|
||||||
|
$JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-compiler=$CC
|
||||||
|
Sets the C compiler used for compiling native modules and standalone executables. Defaults
|
||||||
|
to cc.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-cpp\-compiler=$CXX
|
||||||
|
Sets the C++ compiler used for compiling native modules and standalone executables. Defaults
|
||||||
|
to c++..
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-linker
|
||||||
|
Sets the linker used to create native modules and executables. Only used on windows, where
|
||||||
|
it defaults to link.exe.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-pkglist=https://github.com/janet-lang/pkgs.git
|
||||||
|
Sets the git repository for the package listing used to resolve shorthand package names.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-\-archiver=$AR
|
||||||
|
Sets the command used for creating static libraries, use for linking into the standalone executable.
|
||||||
|
Native modules are compiled twice, once a normal native module (shared object), and once as an
|
||||||
|
archive. Defaults to ar.
|
||||||
|
|
||||||
|
.SH COMMANDS
|
||||||
|
.TP
|
||||||
|
.BR help
|
||||||
|
Shows the usage text and exits immediately.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR build
|
||||||
|
Builds all artifacts specified in the project.janet file in the current directory. Artifacts will
|
||||||
|
be created in the ./build/ directory.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR install\ [\fBrepo...\fR]
|
||||||
|
When run with no arguments, installs all installable artifacts in the current project to
|
||||||
|
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
|
||||||
|
take an optional git repository URL and will install all artifacts in that repository instead.
|
||||||
|
When run with an argument, install does not need to be run from a jpm project directory. Will also
|
||||||
|
install multiple dependencies in one command.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR uninstall\ [\fBname...\fR]
|
||||||
|
Uninstall a project installed with install. uninstall expects the name of the project, not the
|
||||||
|
repository url, path to installed file, or executable name. The name of the project must be specified
|
||||||
|
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
|
||||||
|
the current project if installed. Will also uninstall multiple packages in one command.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR clean
|
||||||
|
Remove all artifacts created by jpm. This just deletes the build folder.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR test
|
||||||
|
Runs jpm tests. jpm will run all janet source files in the test directory as tests. A test
|
||||||
|
is considered failing if it exits with a non-zero exit code.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR deps
|
||||||
|
Install all dependencies that this project requires recursively. jpm does not
|
||||||
|
resolve dependency issues, like conflicting versions of the same module are required, or
|
||||||
|
different modules with the same name. Dependencies are installed with git, so deps requires
|
||||||
|
git to be on the PATH.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR clear-cache
|
||||||
|
jpm caches git repositories that are needed to install modules from a remote
|
||||||
|
source in a global cache ($JANET_PATH/.cache). If these dependencies are out of
|
||||||
|
date or too large, clear-cache will remove the cache and jpm will rebuild it
|
||||||
|
when needed. clear-cache is a global command, so a project.janet is not
|
||||||
|
required.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR list-installed
|
||||||
|
List all installed packages in the current syspath.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR list-pkgs\ [\fBsearch\fR]
|
||||||
|
List all package aliases in the current package listing that contain the given search string.
|
||||||
|
If no search string is given, prints the entire listing.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR clear-manifest
|
||||||
|
jpm creates a manifest directory that contains a list of all installed files.
|
||||||
|
By deleting this directory, jpm will think that nothing is installed and will
|
||||||
|
try reinstalling everything on the jpm deps or jpm load-lockfile commands. Be careful with
|
||||||
|
this command, as it may leave extra files on your system and shouldn't be needed
|
||||||
|
most of the time in a healthy install.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR run\ [\fBrule\fR]
|
||||||
|
Run a given rule defined in project.janet. Project definitions files (project.janet) usually
|
||||||
|
contain a few artifact declarations, which set up rules that jpm can then resolve, or execute.
|
||||||
|
A project.janet can also create custom rules to create arbitrary files or run arbitrary code, much
|
||||||
|
like make. run will run a single rule or build a single file.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR rules
|
||||||
|
List all rules that can be run via run. This is useful for exploring rules in the project.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR rule-tree\ [\fBroot\fR]\ [\fBdepth\fR]
|
||||||
|
Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree
|
||||||
|
root, as well as a max depth to print. By default, prints the full tree for all rules. This
|
||||||
|
can be quite long, so it is recommended to give a root rule.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR show-paths
|
||||||
|
Show all of the paths used when installing and building artifacts.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR update-pkgs
|
||||||
|
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR quickbin\ [\fBentry\fR]\ [\fBexecutable\fR]
|
||||||
|
Create a standalone, statically linked executable from a Janet source file that contains a main function.
|
||||||
|
The main function is the entry point of the program and will receive command line arguments
|
||||||
|
as function arguments. The entry file can import other modules, including native C modules, and
|
||||||
|
jpm will attempt to include the dependencies into the generated executable.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR debug-repl
|
||||||
|
Load the current project.janet file and start a repl in it's environment. This lets a user better
|
||||||
|
debug the project file, as well as run rules manually.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR make-lockfile\ [\fBfilename\fR]
|
||||||
|
Create a lockfile. A lockfile is a record that describes what dependencies were installed at the
|
||||||
|
time of the lockfile's creation, including exact versions. A lockfile can then be later used
|
||||||
|
to set up that environment on a different machine via load-lockfile. By default, the lockfile
|
||||||
|
is created at lockfile.jdn, although any path can be used.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR load-lockfile\ [\fBfilename\fR]
|
||||||
|
Install dependencies from a lockfile previously created with make-lockfile. By default, will look
|
||||||
|
for a lockfile at lockfile.jdn, although any path can be used.
|
||||||
|
|
||||||
|
.SH ENVIRONMENT
|
||||||
|
|
||||||
|
.B JANET_PATH
|
||||||
|
.RS
|
||||||
|
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
||||||
|
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||||
|
the default location set at compile time, which can be determined with (dyn :syspath)
|
||||||
|
.RE
|
||||||
|
|
||||||
|
.B JANET_MODPATH
|
||||||
|
.RS
|
||||||
|
The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could
|
||||||
|
set this to a different directory if you want to. Doing so would let you import Janet modules
|
||||||
|
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install.
|
||||||
|
This variable is overwritten by the --modpath=/some/path if it is provided.
|
||||||
|
.RE
|
||||||
|
|
||||||
|
.B JANET_HEADERPATH
|
||||||
|
.RS
|
||||||
|
The location that jpm will look for janet header files (janet.h and janetconf.h) that are used
|
||||||
|
to build native modules and standalone executables. If janet.h and janetconf.h are available as
|
||||||
|
default includes on your system, this value is not required. If not provided, will default to
|
||||||
|
<jpm script location>/../include/janet. The --headerpath=/some/path option will override this
|
||||||
|
variable.
|
||||||
|
.RE
|
||||||
|
|
||||||
|
.B JANET_LIBPATH
|
||||||
|
.RS
|
||||||
|
Similar to JANET_HEADERPATH, this path is where jpm will look for
|
||||||
|
libjanet.a for creating standalone executables. This does not need to be
|
||||||
|
set on a normal install.
|
||||||
|
If not provided, this will default to <jpm script location>/../lib.
|
||||||
|
The --libpath=/some/path option will override this variable.
|
||||||
|
.RE
|
||||||
|
|
||||||
|
.B JANET_BINPATH
|
||||||
|
.RS
|
||||||
|
The directory where jpm will install binary scripts and executables to.
|
||||||
|
Defaults to
|
||||||
|
(dyn :syspath)/bin
|
||||||
|
The --binpath=/some/path will override this variable.
|
||||||
|
.RE
|
||||||
|
|
||||||
|
.B JANET_PKGLIST
|
||||||
|
.RS
|
||||||
|
The git repository URL that contains a listing of packages. This allows installing packages with shortnames, which
|
||||||
|
is mostly a convenience. However, package dependencies can use short names, package listings
|
||||||
|
can be used to choose a particular set of dependency versions for a whole project.
|
||||||
|
.RE
|
||||||
|
|
||||||
|
.B JANET_GIT
|
||||||
|
.RS
|
||||||
|
An optional path to a git executable to use to clone git dependencies. By default, uses "git" on the current $PATH. You shouldn't need to set this
|
||||||
|
if you have a normal install of git.
|
||||||
|
.RE
|
||||||
|
|
||||||
|
.B JPM_OS_WHICH
|
||||||
|
.RS
|
||||||
|
Use this option to override the C compiler and build system auto-detection for the host operating system. For example, set this
|
||||||
|
environment variable to "posix" to make sure that on platforms like MinGW, you will use GCC instead of MSVC. On most platforms, users will not need to
|
||||||
|
set this environment variable. Set this to one of the following
|
||||||
|
strings:
|
||||||
|
.IP
|
||||||
|
\- windows
|
||||||
|
.IP
|
||||||
|
\- macos
|
||||||
|
.IP
|
||||||
|
\- linux
|
||||||
|
.IP
|
||||||
|
\- freebsd
|
||||||
|
.IP
|
||||||
|
\- openbsd
|
||||||
|
.IP
|
||||||
|
\- netbsd
|
||||||
|
.IP
|
||||||
|
\- bsd
|
||||||
|
.IP
|
||||||
|
\- posix
|
||||||
|
.RE
|
||||||
|
|
||||||
|
|
||||||
|
.SH AUTHOR
|
||||||
|
Written by Calvin Rose <calsrose@gmail.com>
|
||||||
129
meson.build
129
meson.build
@@ -1,4 +1,4 @@
|
|||||||
# Copyright (c) 2024 Calvin Rose and contributors
|
# Copyright (c) 2021 Calvin Rose and contributors
|
||||||
#
|
#
|
||||||
# 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
|
||||||
@@ -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.37.0')
|
version : '1.16.1')
|
||||||
|
|
||||||
# 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')
|
||||||
@@ -30,7 +30,6 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet'
|
|||||||
cc = meson.get_compiler('c')
|
cc = meson.get_compiler('c')
|
||||||
m_dep = cc.find_library('m', required : false)
|
m_dep = cc.find_library('m', required : false)
|
||||||
dl_dep = cc.find_library('dl', required : false)
|
dl_dep = cc.find_library('dl', required : false)
|
||||||
android_spawn_dep = cc.find_library('android-spawn', required : false)
|
|
||||||
thread_dep = dependency('threads')
|
thread_dep = dependency('threads')
|
||||||
|
|
||||||
# Link options
|
# Link options
|
||||||
@@ -61,7 +60,6 @@ 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'))
|
||||||
@@ -74,13 +72,7 @@ conf.set('JANET_NO_UMASK', not get_option('umask'))
|
|||||||
conf.set('JANET_NO_REALPATH', not get_option('realpath'))
|
conf.set('JANET_NO_REALPATH', not get_option('realpath'))
|
||||||
conf.set('JANET_NO_PROCESSES', not get_option('processes'))
|
conf.set('JANET_NO_PROCESSES', not get_option('processes'))
|
||||||
conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
|
conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
|
||||||
conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
|
conf.set('JANET_EV_EPOLL', get_option('epoll'))
|
||||||
conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
|
|
||||||
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
|
|
||||||
conf.set('JANET_NO_FFI', not get_option('ffi'))
|
|
||||||
conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit'))
|
|
||||||
conf.set('JANET_NO_FILEWATCH', not get_option('filewatch'))
|
|
||||||
conf.set('JANET_NO_CRYPTORAND', not get_option('cryptorand'))
|
|
||||||
if get_option('os_name') != ''
|
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
|
||||||
@@ -121,9 +113,7 @@ core_src = [
|
|||||||
'src/core/debug.c',
|
'src/core/debug.c',
|
||||||
'src/core/emit.c',
|
'src/core/emit.c',
|
||||||
'src/core/ev.c',
|
'src/core/ev.c',
|
||||||
'src/core/ffi.c',
|
|
||||||
'src/core/fiber.c',
|
'src/core/fiber.c',
|
||||||
'src/core/filewatch.c',
|
|
||||||
'src/core/gc.c',
|
'src/core/gc.c',
|
||||||
'src/core/inttypes.c',
|
'src/core/inttypes.c',
|
||||||
'src/core/io.c',
|
'src/core/io.c',
|
||||||
@@ -137,12 +127,12 @@ core_src = [
|
|||||||
'src/core/regalloc.c',
|
'src/core/regalloc.c',
|
||||||
'src/core/run.c',
|
'src/core/run.c',
|
||||||
'src/core/specials.c',
|
'src/core/specials.c',
|
||||||
'src/core/state.c',
|
|
||||||
'src/core/string.c',
|
'src/core/string.c',
|
||||||
'src/core/strtod.c',
|
'src/core/strtod.c',
|
||||||
'src/core/struct.c',
|
'src/core/struct.c',
|
||||||
'src/core/symcache.c',
|
'src/core/symcache.c',
|
||||||
'src/core/table.c',
|
'src/core/table.c',
|
||||||
|
'src/core/thread.c',
|
||||||
'src/core/tuple.c',
|
'src/core/tuple.c',
|
||||||
'src/core/util.c',
|
'src/core/util.c',
|
||||||
'src/core/value.c',
|
'src/core/value.c',
|
||||||
@@ -168,59 +158,43 @@ mainclient_src = [
|
|||||||
janet_boot = executable('janet-boot', core_src, boot_src,
|
janet_boot = executable('janet-boot', core_src, boot_src,
|
||||||
include_directories : incdir,
|
include_directories : incdir,
|
||||||
c_args : '-DJANET_BOOTSTRAP',
|
c_args : '-DJANET_BOOTSTRAP',
|
||||||
dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep],
|
dependencies : [m_dep, dl_dep, thread_dep],
|
||||||
native : true)
|
native : true)
|
||||||
|
|
||||||
# Build janet.c
|
# Build janet.c
|
||||||
janetc = custom_target('janetc',
|
janetc = custom_target('janetc',
|
||||||
input : [janet_boot, 'src/boot/boot.janet'],
|
input : [janet_boot],
|
||||||
output : 'janet.c',
|
output : 'janet.c',
|
||||||
capture : true,
|
capture : true,
|
||||||
command : [
|
command : [
|
||||||
janet_boot, meson.current_source_dir(),
|
janet_boot, meson.current_source_dir(),
|
||||||
'JANET_PATH', janet_path
|
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
|
||||||
])
|
])
|
||||||
|
|
||||||
janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
|
janet_dependencies = [m_dep, dl_dep]
|
||||||
if not get_option('single_threaded')
|
if not get_option('single_threaded')
|
||||||
janet_dependencies += thread_dep
|
janet_dependencies += thread_dep
|
||||||
endif
|
endif
|
||||||
|
|
||||||
# Allow building with no shared library
|
libjanet = library('janet', janetc,
|
||||||
if cc.has_argument('-fvisibility=hidden')
|
|
||||||
lib_cflags = ['-fvisibility=hidden']
|
|
||||||
else
|
|
||||||
lib_cflags = []
|
|
||||||
endif
|
|
||||||
if get_option('shared')
|
|
||||||
libjanet = library('janet', janetc,
|
|
||||||
include_directories : incdir,
|
include_directories : incdir,
|
||||||
dependencies : janet_dependencies,
|
dependencies : janet_dependencies,
|
||||||
version: meson.project_version(),
|
version: meson.project_version(),
|
||||||
soversion: version_parts[0] + '.' + version_parts[1],
|
soversion: version_parts[0] + '.' + version_parts[1],
|
||||||
c_args : lib_cflags,
|
|
||||||
install : true)
|
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']
|
||||||
else
|
else
|
||||||
extra_cflags = ['-DJANET_DLL_IMPORT']
|
extra_cflags = []
|
||||||
endif
|
endif
|
||||||
janet_mainclient = executable('janet', mainclient_src,
|
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||||
include_directories : incdir,
|
include_directories : incdir,
|
||||||
dependencies : janet_dependencies,
|
dependencies : janet_dependencies,
|
||||||
link_with: [libjanet],
|
|
||||||
c_args : extra_cflags,
|
c_args : extra_cflags,
|
||||||
install : true)
|
install : true)
|
||||||
else
|
|
||||||
# No shared library
|
|
||||||
janet_mainclient = executable('janet', mainclient_src, janetc,
|
|
||||||
include_directories : incdir,
|
|
||||||
dependencies : janet_dependencies,
|
|
||||||
c_args : lib_cflags,
|
|
||||||
install : true)
|
|
||||||
endif
|
|
||||||
|
|
||||||
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)
|
||||||
@@ -247,37 +221,17 @@ docs = custom_target('docs',
|
|||||||
|
|
||||||
# Tests
|
# Tests
|
||||||
test_files = [
|
test_files = [
|
||||||
'test/suite-array.janet',
|
'test/suite0000.janet',
|
||||||
'test/suite-asm.janet',
|
'test/suite0001.janet',
|
||||||
'test/suite-boot.janet',
|
'test/suite0002.janet',
|
||||||
'test/suite-buffer.janet',
|
'test/suite0003.janet',
|
||||||
'test/suite-bundle.janet',
|
'test/suite0004.janet',
|
||||||
'test/suite-capi.janet',
|
'test/suite0005.janet',
|
||||||
'test/suite-cfuns.janet',
|
'test/suite0006.janet',
|
||||||
'test/suite-compile.janet',
|
'test/suite0007.janet',
|
||||||
'test/suite-corelib.janet',
|
'test/suite0008.janet',
|
||||||
'test/suite-debug.janet',
|
'test/suite0009.janet',
|
||||||
'test/suite-ev.janet',
|
'test/suite0010.janet'
|
||||||
'test/suite-ffi.janet',
|
|
||||||
'test/suite-filewatch.janet',
|
|
||||||
'test/suite-inttypes.janet',
|
|
||||||
'test/suite-io.janet',
|
|
||||||
'test/suite-marsh.janet',
|
|
||||||
'test/suite-math.janet',
|
|
||||||
'test/suite-os.janet',
|
|
||||||
'test/suite-parse.janet',
|
|
||||||
'test/suite-peg.janet',
|
|
||||||
'test/suite-pp.janet',
|
|
||||||
'test/suite-specials.janet',
|
|
||||||
'test/suite-string.janet',
|
|
||||||
'test/suite-strtod.janet',
|
|
||||||
'test/suite-struct.janet',
|
|
||||||
'test/suite-symcache.janet',
|
|
||||||
'test/suite-table.janet',
|
|
||||||
'test/suite-tuple.janet',
|
|
||||||
'test/suite-unknown.janet',
|
|
||||||
'test/suite-value.janet',
|
|
||||||
'test/suite-vm.janet'
|
|
||||||
]
|
]
|
||||||
foreach t : test_files
|
foreach t : test_files
|
||||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||||
@@ -287,15 +241,14 @@ 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)
|
||||||
if get_option('shared')
|
janet_dep = declare_dependency(include_directories : incdir,
|
||||||
janet_dep = declare_dependency(include_directories : incdir,
|
|
||||||
link_with : libjanet)
|
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')
|
||||||
@@ -305,12 +258,18 @@ patched_janet = custom_target('patched-janeth',
|
|||||||
install : true,
|
install : true,
|
||||||
install_dir : join_paths(get_option('includedir'), 'janet'),
|
install_dir : join_paths(get_option('includedir'), 'janet'),
|
||||||
build_by_default : true,
|
build_by_default : true,
|
||||||
output : ['janet_' + meson.project_version() + '.h'],
|
output : ['janet.h'],
|
||||||
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
|
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
|
||||||
|
if get_option('peg') and not get_option('reduced_os') and get_option('processes')
|
||||||
# Create a version of the janet.h header that matches what jpm often expects
|
install_man('jpm.1')
|
||||||
if meson.version().version_compare('>=0.61')
|
patched_jpm = custom_target('patched-jpm',
|
||||||
install_symlink('janet.h', pointing_to: 'janet/janet_' + meson.project_version() + '.h', install_dir: get_option('includedir'))
|
input : ['tools/patch-jpm.janet', 'jpm'],
|
||||||
install_symlink('janet.h', pointing_to: 'janet_' + meson.project_version() + '.h', install_dir: join_paths(get_option('includedir'), 'janet'))
|
install : true,
|
||||||
|
install_dir : get_option('bindir'),
|
||||||
|
build_by_default : true,
|
||||||
|
output : ['jpm'],
|
||||||
|
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
|
||||||
|
'--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
|
||||||
|
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir')),
|
||||||
|
'--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|||||||
@@ -11,18 +11,12 @@ 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 : true)
|
option('epoll', type : 'boolean', value : false)
|
||||||
option('kqueue', type : 'boolean', value : true)
|
|
||||||
option('interpreter_interrupt', type : 'boolean', value : true)
|
|
||||||
option('ffi', type : 'boolean', value : true)
|
|
||||||
option('ffi_jit', type : 'boolean', value : true)
|
|
||||||
option('filewatch', type : 'boolean', value : true)
|
|
||||||
|
|
||||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||||
@@ -31,5 +25,3 @@ 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 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
|
|||||||
2976
src/boot/boot.janet
2976
src/boot/boot.janet
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -22,7 +22,7 @@
|
|||||||
|
|
||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
#include <string.h>
|
#include <stdio.h>
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
|
|
||||||
#include "tests.h"
|
#include "tests.h"
|
||||||
@@ -35,11 +35,6 @@ int system_test() {
|
|||||||
assert(sizeof(void *) == 8);
|
assert(sizeof(void *) == 8);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Check the version defines are self consistent */
|
|
||||||
char version_combined[256];
|
|
||||||
sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
|
|
||||||
assert(!strcmp(JANET_VERSION, version_combined));
|
|
||||||
|
|
||||||
/* Reflexive testing and nanbox testing */
|
/* Reflexive testing and nanbox testing */
|
||||||
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
|
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
|
||||||
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
|
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
|
||||||
@@ -75,5 +70,6 @@ int system_test() {
|
|||||||
|
|
||||||
assert(janet_equals(tuple1, tuple2));
|
assert(janet_equals(tuple1, tuple2));
|
||||||
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
|
|||||||
@@ -4,10 +4,10 @@
|
|||||||
#define JANETCONF_H
|
#define JANETCONF_H
|
||||||
|
|
||||||
#define JANET_VERSION_MAJOR 1
|
#define JANET_VERSION_MAJOR 1
|
||||||
#define JANET_VERSION_MINOR 37
|
#define JANET_VERSION_MINOR 16
|
||||||
#define JANET_VERSION_PATCH 0
|
#define JANET_VERSION_PATCH 1
|
||||||
#define JANET_VERSION_EXTRA "-dev"
|
#define JANET_VERSION_EXTRA ""
|
||||||
#define JANET_VERSION "1.37.0-dev"
|
#define JANET_VERSION "1.16.1"
|
||||||
|
|
||||||
/* #define JANET_BUILD "local" */
|
/* #define JANET_BUILD "local" */
|
||||||
|
|
||||||
@@ -29,13 +29,9 @@
|
|||||||
/* #define JANET_NO_NET */
|
/* #define JANET_NO_NET */
|
||||||
/* #define JANET_NO_INT_TYPES */
|
/* #define JANET_NO_INT_TYPES */
|
||||||
/* #define JANET_NO_EV */
|
/* #define JANET_NO_EV */
|
||||||
/* #define JANET_NO_FILEWATCH */
|
|
||||||
/* #define JANET_NO_REALPATH */
|
/* #define JANET_NO_REALPATH */
|
||||||
/* #define JANET_NO_SYMLINKS */
|
/* #define JANET_NO_SYMLINKS */
|
||||||
/* #define JANET_NO_UMASK */
|
/* #define JANET_NO_UMASK */
|
||||||
/* #define JANET_NO_THREADS */
|
|
||||||
/* #define JANET_NO_FFI */
|
|
||||||
/* #define JANET_NO_FFI_JIT */
|
|
||||||
|
|
||||||
/* Other settings */
|
/* Other settings */
|
||||||
/* #define JANET_DEBUG */
|
/* #define JANET_DEBUG */
|
||||||
@@ -50,12 +46,7 @@
|
|||||||
/* #define JANET_STACK_MAX 16384 */
|
/* #define JANET_STACK_MAX 16384 */
|
||||||
/* #define JANET_OS_NAME my-custom-os */
|
/* #define JANET_OS_NAME my-custom-os */
|
||||||
/* #define JANET_ARCH_NAME pdp-8 */
|
/* #define JANET_ARCH_NAME pdp-8 */
|
||||||
/* #define JANET_EV_NO_EPOLL */
|
/* #define JANET_EV_EPOLL */
|
||||||
/* #define JANET_EV_NO_KQUEUE */
|
|
||||||
/* #define JANET_NO_INTERPRETER_INTERRUPT */
|
|
||||||
/* #define JANET_NO_IPV6 */
|
|
||||||
/* #define JANET_NO_CRYPTORAND */
|
|
||||||
/* #define JANET_USE_STDATOMIC */
|
|
||||||
|
|
||||||
/* Custom vm allocator support */
|
/* Custom vm allocator support */
|
||||||
/* #include <mimalloc.h> */
|
/* #include <mimalloc.h> */
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -23,15 +23,7 @@
|
|||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include "features.h"
|
#include "features.h"
|
||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "state.h"
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef JANET_EV
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
#include <windows.h>
|
|
||||||
#endif
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Create new userdata */
|
/* Create new userdata */
|
||||||
@@ -51,154 +43,3 @@ void *janet_abstract_end(void *x) {
|
|||||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||||
return janet_abstract_end(janet_abstract_begin(atype, size));
|
return janet_abstract_end(janet_abstract_begin(atype, size));
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef JANET_EV
|
|
||||||
|
|
||||||
/*
|
|
||||||
* Threaded abstracts
|
|
||||||
*/
|
|
||||||
|
|
||||||
void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size) {
|
|
||||||
JanetAbstractHead *header = janet_malloc(sizeof(JanetAbstractHead) + size);
|
|
||||||
if (NULL == header) {
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
janet_vm.next_collection += size + sizeof(JanetAbstractHead);
|
|
||||||
header->gc.flags = JANET_MEMORY_THREADED_ABSTRACT;
|
|
||||||
header->gc.data.next = NULL; /* Clear memory for address sanitizers */
|
|
||||||
header->gc.data.refcount = 1;
|
|
||||||
header->size = size;
|
|
||||||
header->type = atype;
|
|
||||||
void *abstract = (void *) & (header->data);
|
|
||||||
janet_table_put(&janet_vm.threaded_abstracts, janet_wrap_abstract(abstract), janet_wrap_false());
|
|
||||||
return abstract;
|
|
||||||
}
|
|
||||||
|
|
||||||
void *janet_abstract_end_threaded(void *x) {
|
|
||||||
janet_gc_settype((void *)(janet_abstract_head(x)), JANET_MEMORY_THREADED_ABSTRACT);
|
|
||||||
return x;
|
|
||||||
}
|
|
||||||
|
|
||||||
void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
|
|
||||||
return janet_abstract_end_threaded(janet_abstract_begin_threaded(atype, size));
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Refcounting primitives and sync primitives */
|
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
|
|
||||||
size_t janet_os_mutex_size(void) {
|
|
||||||
return sizeof(CRITICAL_SECTION);
|
|
||||||
}
|
|
||||||
|
|
||||||
size_t janet_os_rwlock_size(void) {
|
|
||||||
return sizeof(void *);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
|
||||||
InitializeCriticalSection((CRITICAL_SECTION *) mutex);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
|
|
||||||
DeleteCriticalSection((CRITICAL_SECTION *) mutex);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
|
||||||
EnterCriticalSection((CRITICAL_SECTION *) mutex);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
|
||||||
/* error handling? May want to keep counter */
|
|
||||||
LeaveCriticalSection((CRITICAL_SECTION *) mutex);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
|
||||||
InitializeSRWLock((PSRWLOCK) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
|
|
||||||
/* no op? */
|
|
||||||
(void) rwlock;
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
|
|
||||||
AcquireSRWLockShared((PSRWLOCK) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
|
|
||||||
AcquireSRWLockExclusive((PSRWLOCK) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
|
|
||||||
ReleaseSRWLockShared((PSRWLOCK) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
|
||||||
ReleaseSRWLockExclusive((PSRWLOCK) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
#else
|
|
||||||
|
|
||||||
size_t janet_os_mutex_size(void) {
|
|
||||||
return sizeof(pthread_mutex_t);
|
|
||||||
}
|
|
||||||
|
|
||||||
size_t janet_os_rwlock_size(void) {
|
|
||||||
return sizeof(pthread_rwlock_t);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
|
||||||
pthread_mutexattr_t attr;
|
|
||||||
pthread_mutexattr_init(&attr);
|
|
||||||
pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
|
|
||||||
pthread_mutex_init((pthread_mutex_t *) mutex, &attr);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
|
|
||||||
pthread_mutex_destroy((pthread_mutex_t *) mutex);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_mutex_lock(JanetOSMutex *mutex) {
|
|
||||||
pthread_mutex_lock((pthread_mutex_t *) mutex);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
|
|
||||||
int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
|
|
||||||
if (ret) janet_panic("cannot release lock");
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
|
|
||||||
pthread_rwlock_init((pthread_rwlock_t *) rwlock, NULL);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
|
|
||||||
pthread_rwlock_destroy((pthread_rwlock_t *) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
|
|
||||||
pthread_rwlock_rdlock((pthread_rwlock_t *) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
|
|
||||||
pthread_rwlock_wrlock((pthread_rwlock_t *) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
|
|
||||||
pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
|
||||||
pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
|
|
||||||
}
|
|
||||||
|
|
||||||
#endif
|
|
||||||
|
|
||||||
int32_t janet_abstract_incref(void *abst) {
|
|
||||||
return janet_atomic_inc(&janet_abstract_head(abst)->gc.data.refcount);
|
|
||||||
}
|
|
||||||
|
|
||||||
int32_t janet_abstract_decref(void *abst) {
|
|
||||||
return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
|
|
||||||
}
|
|
||||||
|
|
||||||
#endif
|
|
||||||
|
|||||||
247
src/core/array.c
247
src/core/array.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -30,10 +30,12 @@
|
|||||||
|
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
static void janet_array_impl(JanetArray *array, int32_t capacity) {
|
/* Creates a new array */
|
||||||
|
JanetArray *janet_array(int32_t capacity) {
|
||||||
|
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||||
Janet *data = NULL;
|
Janet *data = NULL;
|
||||||
if (capacity > 0) {
|
if (capacity > 0) {
|
||||||
janet_vm.next_collection += capacity * sizeof(Janet);
|
janet_vm_next_collection += capacity * sizeof(Janet);
|
||||||
data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
|
data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
|
||||||
if (NULL == data) {
|
if (NULL == data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
@@ -42,19 +44,6 @@ static void janet_array_impl(JanetArray *array, int32_t capacity) {
|
|||||||
array->count = 0;
|
array->count = 0;
|
||||||
array->capacity = capacity;
|
array->capacity = capacity;
|
||||||
array->data = data;
|
array->data = data;
|
||||||
}
|
|
||||||
|
|
||||||
/* Creates a new array */
|
|
||||||
JanetArray *janet_array(int32_t capacity) {
|
|
||||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
|
||||||
janet_array_impl(array, capacity);
|
|
||||||
return array;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Creates a new array with weak references */
|
|
||||||
JanetArray *janet_array_weak(int32_t capacity) {
|
|
||||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY_WEAK, sizeof(JanetArray));
|
|
||||||
janet_array_impl(array, capacity);
|
|
||||||
return array;
|
return array;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -83,7 +72,7 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
|
|||||||
if (NULL == newData) {
|
if (NULL == newData) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
janet_vm.next_collection += (capacity - array->capacity) * sizeof(Janet);
|
janet_vm_next_collection += (capacity - array->capacity) * sizeof(Janet);
|
||||||
array->data = newData;
|
array->data = newData;
|
||||||
array->capacity = capacity;
|
array->capacity = capacity;
|
||||||
}
|
}
|
||||||
@@ -133,30 +122,16 @@ Janet janet_array_peek(JanetArray *array) {
|
|||||||
|
|
||||||
/* C Functions */
|
/* C Functions */
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_new,
|
static Janet cfun_array_new(int32_t argc, Janet *argv) {
|
||||||
"(array/new capacity)",
|
|
||||||
"Creates a new empty array with a pre-allocated capacity. The same as "
|
|
||||||
"`(array)` but can be more efficient if the maximum size of an array is known.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
int32_t cap = janet_getinteger(argv, 0);
|
int32_t cap = janet_getinteger(argv, 0);
|
||||||
JanetArray *array = janet_array(cap);
|
JanetArray *array = janet_array(cap);
|
||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_weak,
|
static Janet cfun_array_new_filled(int32_t argc, Janet *argv) {
|
||||||
"(array/weak capacity)",
|
|
||||||
"Creates a new empty array with a pre-allocated capacity and support for weak references. Similar to `array/new`.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
int32_t cap = janet_getinteger(argv, 0);
|
|
||||||
JanetArray *array = janet_array_weak(cap);
|
|
||||||
return janet_wrap_array(array);
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_new_filled,
|
|
||||||
"(array/new-filled count &opt value)",
|
|
||||||
"Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
int32_t count = janet_getnat(argv, 0);
|
int32_t count = janet_getinteger(argv, 0);
|
||||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||||
JanetArray *array = janet_array(count);
|
JanetArray *array = janet_array(count);
|
||||||
for (int32_t i = 0; i < count; i++) {
|
for (int32_t i = 0; i < count; i++) {
|
||||||
@@ -166,10 +141,7 @@ JANET_CORE_FN(cfun_array_new_filled,
|
|||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_fill,
|
static Janet cfun_array_fill(int32_t argc, Janet *argv) {
|
||||||
"(array/fill arr &opt value)",
|
|
||||||
"Replace all elements of an array with `value` (defaulting to nil) without changing the length of the array. "
|
|
||||||
"Returns the modified array.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||||
@@ -179,26 +151,19 @@ JANET_CORE_FN(cfun_array_fill,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_pop,
|
static Janet cfun_array_pop(int32_t argc, Janet *argv) {
|
||||||
"(array/pop arr)",
|
|
||||||
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
|
||||||
"the input array.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
return janet_array_pop(array);
|
return janet_array_pop(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_peek,
|
static Janet cfun_array_peek(int32_t argc, Janet *argv) {
|
||||||
"(array/peek arr)",
|
|
||||||
"Returns the last element of the array. Does not modify the array.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
return janet_array_peek(array);
|
return janet_array_peek(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_push,
|
static Janet cfun_array_push(int32_t argc, Janet *argv) {
|
||||||
"(array/push arr & xs)",
|
|
||||||
"Push all the elements of xs to the end of an array. Modifies the input array and returns it.") {
|
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
if (INT32_MAX - argc + 1 <= array->count) {
|
if (INT32_MAX - argc + 1 <= array->count) {
|
||||||
@@ -211,12 +176,7 @@ JANET_CORE_FN(cfun_array_push,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_ensure,
|
static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
|
||||||
"(array/ensure arr capacity growth)",
|
|
||||||
"Ensures that the memory backing the array is large enough for `capacity` "
|
|
||||||
"items at the given rate of growth. `capacity` and `growth` must be integers. "
|
|
||||||
"If the backing capacity is already enough, then this function does nothing. "
|
|
||||||
"Otherwise, the backing memory will be reallocated so that there is enough space.") {
|
|
||||||
janet_fixarity(argc, 3);
|
janet_fixarity(argc, 3);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
int32_t newcount = janet_getinteger(argv, 1);
|
int32_t newcount = janet_getinteger(argv, 1);
|
||||||
@@ -226,13 +186,7 @@ JANET_CORE_FN(cfun_array_ensure,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_slice,
|
static Janet cfun_array_slice(int32_t argc, Janet *argv) {
|
||||||
"(array/slice arrtup &opt start end)",
|
|
||||||
"Takes a slice of array or tuple from `start` to `end`. The range is half open, "
|
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the "
|
|
||||||
"end of the array. By default, `start` is 0 and `end` is the length of the array. "
|
|
||||||
"Note that if the range is negative, it is taken as (start, end] to allow a full "
|
|
||||||
"negative slice range. Returns a new array.") {
|
|
||||||
JanetView view = janet_getindexed(argv, 0);
|
JanetView view = janet_getindexed(argv, 0);
|
||||||
JanetRange range = janet_getslice(argc, argv);
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
JanetArray *array = janet_array(range.end - range.start);
|
JanetArray *array = janet_array(range.end - range.start);
|
||||||
@@ -242,12 +196,7 @@ JANET_CORE_FN(cfun_array_slice,
|
|||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_concat,
|
static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
||||||
"(array/concat arr & parts)",
|
|
||||||
"Concatenates a variable number of arrays (and tuples) into the first argument, "
|
|
||||||
"which must be an array. If any of the parts are arrays or tuples, their elements will "
|
|
||||||
"be inserted into the array. Otherwise, each part in `parts` will be appended to `arr` in order. "
|
|
||||||
"Return the modified array `arr`.") {
|
|
||||||
int32_t i;
|
int32_t i;
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
@@ -261,11 +210,6 @@ JANET_CORE_FN(cfun_array_concat,
|
|||||||
int32_t j, len = 0;
|
int32_t j, len = 0;
|
||||||
const Janet *vals = NULL;
|
const Janet *vals = NULL;
|
||||||
janet_indexed_view(argv[i], &vals, &len);
|
janet_indexed_view(argv[i], &vals, &len);
|
||||||
if (array->data == vals) {
|
|
||||||
int32_t newcount = array->count + len;
|
|
||||||
janet_array_ensure(array, newcount, 2);
|
|
||||||
janet_indexed_view(argv[i], &vals, &len);
|
|
||||||
}
|
|
||||||
for (j = 0; j < len; j++)
|
for (j = 0; j < len; j++)
|
||||||
janet_array_push(array, vals[j]);
|
janet_array_push(array, vals[j]);
|
||||||
}
|
}
|
||||||
@@ -275,37 +219,7 @@ JANET_CORE_FN(cfun_array_concat,
|
|||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_join,
|
static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||||
"(array/join arr & parts)",
|
|
||||||
"Join a variable number of arrays and tuples into the first argument, "
|
|
||||||
"which must be an array. "
|
|
||||||
"Return the modified array `arr`.") {
|
|
||||||
int32_t i;
|
|
||||||
janet_arity(argc, 1, -1);
|
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
|
||||||
for (i = 1; i < argc; i++) {
|
|
||||||
int32_t j, len = 0;
|
|
||||||
const Janet *vals = NULL;
|
|
||||||
if (!janet_indexed_view(argv[i], &vals, &len)) {
|
|
||||||
janet_panicf("expected indexed type for argument %d, got %v", i, argv[i]);
|
|
||||||
}
|
|
||||||
if (array->data == vals) {
|
|
||||||
int32_t newcount = array->count + len;
|
|
||||||
janet_array_ensure(array, newcount, 2);
|
|
||||||
janet_indexed_view(argv[i], &vals, &len);
|
|
||||||
}
|
|
||||||
for (j = 0; j < len; j++)
|
|
||||||
janet_array_push(array, vals[j]);
|
|
||||||
}
|
|
||||||
return janet_wrap_array(array);
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_insert,
|
|
||||||
"(array/insert arr at & xs)",
|
|
||||||
"Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
|
|
||||||
"0 and the length of the array. A negative value for `at` will index backwards from "
|
|
||||||
"the end of the array, inserting after the index such that inserting at -1 appends to "
|
|
||||||
"the array. Returns the array.") {
|
|
||||||
size_t chunksize, restsize;
|
size_t chunksize, restsize;
|
||||||
janet_arity(argc, 2, -1);
|
janet_arity(argc, 2, -1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
@@ -331,18 +245,13 @@ JANET_CORE_FN(cfun_array_insert,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_remove,
|
static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||||
"(array/remove arr at &opt n)",
|
|
||||||
"Remove up to `n` elements starting at index `at` in array `arr`. `at` can index from "
|
|
||||||
"the end of the array with a negative index, and `n` must be a non-negative integer. "
|
|
||||||
"By default, `n` is 1. "
|
|
||||||
"Returns the array.") {
|
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
int32_t at = janet_getinteger(argv, 1);
|
int32_t at = janet_getinteger(argv, 1);
|
||||||
int32_t n = 1;
|
int32_t n = 1;
|
||||||
if (at < 0) {
|
if (at < 0) {
|
||||||
at = array->count + at;
|
at = array->count + at + 1;
|
||||||
}
|
}
|
||||||
if (at < 0 || at > array->count)
|
if (at < 0 || at > array->count)
|
||||||
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
|
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
|
||||||
@@ -361,9 +270,7 @@ JANET_CORE_FN(cfun_array_remove,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_trim,
|
static Janet cfun_array_trim(int32_t argc, Janet *argv) {
|
||||||
"(array/trim arr)",
|
|
||||||
"Set the backing capacity of an array to its current length. Returns the modified array.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
if (array->count) {
|
if (array->count) {
|
||||||
@@ -383,35 +290,103 @@ JANET_CORE_FN(cfun_array_trim,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_array_clear,
|
static Janet cfun_array_clear(int32_t argc, Janet *argv) {
|
||||||
"(array/clear arr)",
|
|
||||||
"Empties an array, setting it's count to 0 but does not free the backing capacity. "
|
|
||||||
"Returns the modified array.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
array->count = 0;
|
array->count = 0;
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg array_cfuns[] = {
|
||||||
|
{
|
||||||
|
"array/new", cfun_array_new,
|
||||||
|
JDOC("(array/new capacity)\n\n"
|
||||||
|
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||||
|
"(array) but can be more efficient if the maximum size of an array is known.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/new-filled", cfun_array_new_filled,
|
||||||
|
JDOC("(array/new-filled count &opt value)\n\n"
|
||||||
|
"Creates a new array of count elements, all set to value, which defaults to nil. Returns the new array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/fill", cfun_array_fill,
|
||||||
|
JDOC("(array/fill arr &opt value)\n\n"
|
||||||
|
"Replace all elements of an array with value (defaulting to nil) without changing the length of the array. "
|
||||||
|
"Returns the modified array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/pop", cfun_array_pop,
|
||||||
|
JDOC("(array/pop arr)\n\n"
|
||||||
|
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
||||||
|
"the input array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/peek", cfun_array_peek,
|
||||||
|
JDOC("(array/peek arr)\n\n"
|
||||||
|
"Returns the last element of the array. Does not modify the array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/push", cfun_array_push,
|
||||||
|
JDOC("(array/push arr x)\n\n"
|
||||||
|
"Insert an element in the end of an array. Modifies the input array and returns it.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/ensure", cfun_array_ensure,
|
||||||
|
JDOC("(array/ensure arr capacity growth)\n\n"
|
||||||
|
"Ensures that the memory backing the array is large enough for capacity "
|
||||||
|
"items at the given rate of growth. Capacity and growth must be integers. "
|
||||||
|
"If the backing capacity is already enough, then this function does nothing. "
|
||||||
|
"Otherwise, the backing memory will be reallocated so that there is enough space.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/slice", cfun_array_slice,
|
||||||
|
JDOC("(array/slice arrtup &opt start end)\n\n"
|
||||||
|
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||||
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
|
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||||
|
"Note that index -1 is synonymous with index (length arrtup) to allow a full "
|
||||||
|
"negative slice range. Returns a new array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/concat", cfun_array_concat,
|
||||||
|
JDOC("(array/concat arr & parts)\n\n"
|
||||||
|
"Concatenates a variable number of arrays (and tuples) into the first argument "
|
||||||
|
"which must be an array. If any of the parts are arrays or tuples, their elements will "
|
||||||
|
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||||
|
"Return the modified array arr.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/insert", cfun_array_insert,
|
||||||
|
JDOC("(array/insert arr at & xs)\n\n"
|
||||||
|
"Insert all xs into array arr at index at. at should be an integer between "
|
||||||
|
"0 and the length of the array. A negative value for at will index backwards from "
|
||||||
|
"the end of the array, such that inserting at -1 appends to the array. "
|
||||||
|
"Returns the array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/remove", cfun_array_remove,
|
||||||
|
JDOC("(array/remove arr at &opt n)\n\n"
|
||||||
|
"Remove up to n elements starting at index at in array arr. at can index from "
|
||||||
|
"the end of the array with a negative index, and n must be a non-negative integer. "
|
||||||
|
"By default, n is 1. "
|
||||||
|
"Returns the array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/trim", cfun_array_trim,
|
||||||
|
JDOC("(array/trim arr)\n\n"
|
||||||
|
"Set the backing capacity of an array to its current length. Returns the modified array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/clear", cfun_array_clear,
|
||||||
|
JDOC("(array/clear arr)\n\n"
|
||||||
|
"Empties an array, setting it's count to 0 but does not free the backing capacity. "
|
||||||
|
"Returns the modified array.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* Load the array module */
|
/* Load the array module */
|
||||||
void janet_lib_array(JanetTable *env) {
|
void janet_lib_array(JanetTable *env) {
|
||||||
JanetRegExt array_cfuns[] = {
|
janet_core_cfuns(env, NULL, array_cfuns);
|
||||||
JANET_CORE_REG("array/new", cfun_array_new),
|
|
||||||
JANET_CORE_REG("array/weak", cfun_array_weak),
|
|
||||||
JANET_CORE_REG("array/new-filled", cfun_array_new_filled),
|
|
||||||
JANET_CORE_REG("array/fill", cfun_array_fill),
|
|
||||||
JANET_CORE_REG("array/pop", cfun_array_pop),
|
|
||||||
JANET_CORE_REG("array/peek", cfun_array_peek),
|
|
||||||
JANET_CORE_REG("array/push", cfun_array_push),
|
|
||||||
JANET_CORE_REG("array/ensure", cfun_array_ensure),
|
|
||||||
JANET_CORE_REG("array/slice", cfun_array_slice),
|
|
||||||
JANET_CORE_REG("array/concat", cfun_array_concat),
|
|
||||||
JANET_CORE_REG("array/insert", cfun_array_insert),
|
|
||||||
JANET_CORE_REG("array/remove", cfun_array_remove),
|
|
||||||
JANET_CORE_REG("array/trim", cfun_array_trim),
|
|
||||||
JANET_CORE_REG("array/clear", cfun_array_clear),
|
|
||||||
JANET_CORE_REG("array/join", cfun_array_join),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, array_cfuns);
|
|
||||||
}
|
}
|
||||||
|
|||||||
182
src/core/asm.c
182
src/core/asm.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -75,7 +75,6 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"cmp", JOP_COMPARE},
|
{"cmp", JOP_COMPARE},
|
||||||
{"cncl", JOP_CANCEL},
|
{"cncl", JOP_CANCEL},
|
||||||
{"div", JOP_DIVIDE},
|
{"div", JOP_DIVIDE},
|
||||||
{"divf", JOP_DIVIDE_FLOOR},
|
|
||||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||||
{"eq", JOP_EQUALS},
|
{"eq", JOP_EQUALS},
|
||||||
{"eqim", JOP_EQUALS_IMMEDIATE},
|
{"eqim", JOP_EQUALS_IMMEDIATE},
|
||||||
@@ -138,7 +137,6 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"sru", JOP_SHIFT_RIGHT_UNSIGNED},
|
{"sru", JOP_SHIFT_RIGHT_UNSIGNED},
|
||||||
{"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
|
{"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
|
||||||
{"sub", JOP_SUBTRACT},
|
{"sub", JOP_SUBTRACT},
|
||||||
{"subim", JOP_SUBTRACT_IMMEDIATE},
|
|
||||||
{"tcall", JOP_TAILCALL},
|
{"tcall", JOP_TAILCALL},
|
||||||
{"tchck", JOP_TYPECHECK}
|
{"tchck", JOP_TYPECHECK}
|
||||||
};
|
};
|
||||||
@@ -189,11 +187,7 @@ static void janet_asm_longjmp(JanetAssembler *a) {
|
|||||||
|
|
||||||
/* Throw some kind of assembly error */
|
/* Throw some kind of assembly error */
|
||||||
static void janet_asm_error(JanetAssembler *a, const char *message) {
|
static void janet_asm_error(JanetAssembler *a, const char *message) {
|
||||||
if (a->errindex < 0) {
|
|
||||||
a->errmessage = janet_formatc("%s", message);
|
|
||||||
} else {
|
|
||||||
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
|
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
|
||||||
}
|
|
||||||
janet_asm_longjmp(a);
|
janet_asm_longjmp(a);
|
||||||
}
|
}
|
||||||
#define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
|
#define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
|
||||||
@@ -522,7 +516,6 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
#endif
|
#endif
|
||||||
if (NULL != a.parent) {
|
if (NULL != a.parent) {
|
||||||
janet_asm_deinit(&a);
|
janet_asm_deinit(&a);
|
||||||
a.parent->errmessage = a.errmessage;
|
|
||||||
janet_asm_longjmp(a.parent);
|
janet_asm_longjmp(a.parent);
|
||||||
}
|
}
|
||||||
result.funcdef = NULL;
|
result.funcdef = NULL;
|
||||||
@@ -560,13 +553,6 @@ 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 */
|
|
||||||
x = janet_get1(s, janet_ckeywordv("structarg"));
|
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
|
||||||
|
|
||||||
/* Check source */
|
/* Check source */
|
||||||
x = janet_get1(s, janet_ckeywordv("source"));
|
x = janet_get1(s, janet_ckeywordv("source"));
|
||||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||||
@@ -611,9 +597,6 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
|
|
||||||
/* Parse sub funcdefs */
|
/* Parse sub funcdefs */
|
||||||
x = janet_get1(s, janet_ckeywordv("closures"));
|
x = janet_get1(s, janet_ckeywordv("closures"));
|
||||||
if (janet_checktype(x, JANET_NIL)) {
|
|
||||||
x = janet_get1(s, janet_ckeywordv("defs"));
|
|
||||||
}
|
|
||||||
if (janet_indexed_view(x, &arr, &count)) {
|
if (janet_indexed_view(x, &arr, &count)) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
for (i = 0; i < count; i++) {
|
for (i = 0; i < count; i++) {
|
||||||
@@ -726,70 +709,16 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Set symbolmap */
|
|
||||||
def->symbolmap = NULL;
|
|
||||||
def->symbolmap_length = 0;
|
|
||||||
x = janet_get1(s, janet_ckeywordv("symbolmap"));
|
|
||||||
if (janet_indexed_view(x, &arr, &count)) {
|
|
||||||
def->symbolmap_length = count;
|
|
||||||
def->symbolmap = janet_malloc(sizeof(JanetSymbolMap) * (size_t)count);
|
|
||||||
if (NULL == def->symbolmap) {
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
for (i = 0; i < count; i++) {
|
|
||||||
const Janet *tup;
|
|
||||||
Janet entry = arr[i];
|
|
||||||
JanetSymbolMap ss;
|
|
||||||
if (!janet_checktype(entry, JANET_TUPLE)) {
|
|
||||||
janet_asm_error(&a, "expected tuple");
|
|
||||||
}
|
|
||||||
tup = janet_unwrap_tuple(entry);
|
|
||||||
if (janet_keyeq(tup[0], "upvalue")) {
|
|
||||||
ss.birth_pc = UINT32_MAX;
|
|
||||||
} else if (!janet_checkint(tup[0])) {
|
|
||||||
janet_asm_error(&a, "expected integer");
|
|
||||||
} else {
|
|
||||||
ss.birth_pc = janet_unwrap_integer(tup[0]);
|
|
||||||
}
|
|
||||||
if (!janet_checkint(tup[1])) {
|
|
||||||
janet_asm_error(&a, "expected integer");
|
|
||||||
}
|
|
||||||
if (!janet_checkint(tup[2])) {
|
|
||||||
janet_asm_error(&a, "expected integer");
|
|
||||||
}
|
|
||||||
if (!janet_checktype(tup[3], JANET_SYMBOL)) {
|
|
||||||
janet_asm_error(&a, "expected symbol");
|
|
||||||
}
|
|
||||||
ss.death_pc = janet_unwrap_integer(tup[1]);
|
|
||||||
ss.slot_index = janet_unwrap_integer(tup[2]);
|
|
||||||
ss.symbol = janet_unwrap_symbol(tup[3]);
|
|
||||||
def->symbolmap[i] = ss;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
|
|
||||||
|
|
||||||
/* Set environments */
|
/* Set environments */
|
||||||
x = janet_get1(s, janet_ckeywordv("environments"));
|
def->environments =
|
||||||
if (janet_indexed_view(x, &arr, &count)) {
|
janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||||
def->environments_length = count;
|
if (NULL == def->environments) {
|
||||||
if (def->environments_length) {
|
|
||||||
def->environments = janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
|
||||||
}
|
|
||||||
for (int32_t i = 0; i < count; i++) {
|
|
||||||
if (!janet_checkint(arr[i])) {
|
|
||||||
janet_asm_error(&a, "expected integer");
|
|
||||||
}
|
|
||||||
def->environments[i] = janet_unwrap_integer(arr[i]);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (def->environments_length && NULL == def->environments) {
|
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Verify the func def */
|
/* Verify the func def */
|
||||||
int verify_status = janet_verify(def);
|
if (janet_verify(def)) {
|
||||||
if (verify_status) {
|
janet_asm_error(&a, "invalid assembly");
|
||||||
janet_asm_errorv(&a, janet_formatc("invalid assembly (%d)", verify_status));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Add final flags */
|
/* Add final flags */
|
||||||
@@ -932,29 +861,6 @@ static Janet janet_disasm_slotcount(JanetFuncDef *def) {
|
|||||||
return janet_wrap_integer(def->slotcount);
|
return janet_wrap_integer(def->slotcount);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_disasm_symbolslots(JanetFuncDef *def) {
|
|
||||||
if (def->symbolmap == NULL) {
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
|
||||||
JanetArray *symbolslots = janet_array(def->symbolmap_length);
|
|
||||||
Janet upvaluekw = janet_ckeywordv("upvalue");
|
|
||||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
|
||||||
JanetSymbolMap ss = def->symbolmap[i];
|
|
||||||
Janet *t = janet_tuple_begin(4);
|
|
||||||
if (ss.birth_pc == UINT32_MAX) {
|
|
||||||
t[0] = upvaluekw;
|
|
||||||
} else {
|
|
||||||
t[0] = janet_wrap_integer(ss.birth_pc);
|
|
||||||
}
|
|
||||||
t[1] = janet_wrap_integer(ss.death_pc);
|
|
||||||
t[2] = janet_wrap_integer(ss.slot_index);
|
|
||||||
t[3] = janet_wrap_symbol(ss.symbol);
|
|
||||||
symbolslots->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
|
||||||
}
|
|
||||||
symbolslots->count = def->symbolmap_length;
|
|
||||||
return janet_wrap_array(symbolslots);
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
|
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
|
||||||
JanetArray *bcode = janet_array(def->bytecode_length);
|
JanetArray *bcode = janet_array(def->bytecode_length);
|
||||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||||
@@ -978,10 +884,6 @@ static Janet janet_disasm_vararg(JanetFuncDef *def) {
|
|||||||
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_disasm_structarg(JanetFuncDef *def) {
|
|
||||||
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG);
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
||||||
JanetArray *constants = janet_array(def->constants_length);
|
JanetArray *constants = janet_array(def->constants_length);
|
||||||
for (int32_t i = 0; i < def->constants_length; i++) {
|
for (int32_t i = 0; i < def->constants_length; i++) {
|
||||||
@@ -1031,10 +933,8 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
|
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
|
|
||||||
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
|
|
||||||
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
|
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
|
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
|
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
|
||||||
@@ -1042,40 +942,18 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
return janet_wrap_struct(janet_table_to_struct(ret));
|
return janet_wrap_struct(janet_table_to_struct(ret));
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_asm,
|
/* C Function for assembly */
|
||||||
"(asm assembly)",
|
static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||||
"Returns a new function that is the compiled result of the assembly.\n"
|
|
||||||
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
|
|
||||||
"to the return value of disasm. Will throw an\n"
|
|
||||||
"error on invalid assembly.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetAssembleResult res;
|
JanetAssembleResult res;
|
||||||
res = janet_asm(argv[0], 0);
|
res = janet_asm(argv[0], 0);
|
||||||
if (res.status != JANET_ASSEMBLE_OK) {
|
if (res.status != JANET_ASSEMBLE_OK) {
|
||||||
janet_panics(res.error ? res.error : janet_cstring("invalid assembly"));
|
janet_panics(res.error);
|
||||||
}
|
}
|
||||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_disasm,
|
static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
||||||
"(disasm func &opt field)",
|
|
||||||
"Returns assembly that could be used to compile the given function. "
|
|
||||||
"func must be a function, not a c function. Will throw on error on a badly "
|
|
||||||
"typed argument. If given a field name, will only return that part of the function assembly. "
|
|
||||||
"Possible fields are:\n\n"
|
|
||||||
"* :arity - number of required and optional arguments.\n"
|
|
||||||
"* :min-arity - minimum number of arguments function can be called with.\n"
|
|
||||||
"* :max-arity - maximum number of arguments function can be called with.\n"
|
|
||||||
"* :vararg - true if function can take a variable number of arguments.\n"
|
|
||||||
"* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
|
|
||||||
"* :source - name of source file that this function was compiled from.\n"
|
|
||||||
"* :name - name of function.\n"
|
|
||||||
"* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
|
|
||||||
"* :symbolmap - all symbols and their slots.\n"
|
|
||||||
"* :constants - an array of constants referenced by this function.\n"
|
|
||||||
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
|
||||||
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
|
||||||
"* :defs - other function definitions that this function may instantiate.\n") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetFunction *f = janet_getfunction(argv, 0);
|
JanetFunction *f = janet_getfunction(argv, 0);
|
||||||
if (argc == 2) {
|
if (argc == 2) {
|
||||||
@@ -1087,7 +965,6 @@ JANET_CORE_FN(cfun_disasm,
|
|||||||
if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
|
if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
|
||||||
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
||||||
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
||||||
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
|
|
||||||
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
||||||
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
||||||
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
||||||
@@ -1099,14 +976,41 @@ JANET_CORE_FN(cfun_disasm,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg asm_cfuns[] = {
|
||||||
|
{
|
||||||
|
"asm", cfun_asm,
|
||||||
|
JDOC("(asm assembly)\n\n"
|
||||||
|
"Returns a new function that is the compiled result of the assembly.\n"
|
||||||
|
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
|
||||||
|
"to the return value of disasm. Will throw an\n"
|
||||||
|
"error on invalid assembly.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"disasm", cfun_disasm,
|
||||||
|
JDOC("(disasm func &opt field)\n\n"
|
||||||
|
"Returns assembly that could be used to compile the given function.\n"
|
||||||
|
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||||
|
"typed argument. If given a field name, will only return that part of the function assembly.\n"
|
||||||
|
"Possible fields are:\n\n"
|
||||||
|
"* :arity - number of required and optional arguments.\n\n"
|
||||||
|
"* :min-arity - minimum number of arguments function can be called with.\n\n"
|
||||||
|
"* :max-arity - maximum number of arguments function can be called with.\n\n"
|
||||||
|
"* :vararg - true if function can take a variable number of arguments.\n\n"
|
||||||
|
"* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n\n"
|
||||||
|
"* :source - name of source file that this function was compiled from.\n\n"
|
||||||
|
"* :name - name of function.\n\n"
|
||||||
|
"* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n\n"
|
||||||
|
"* :constants - an array of constants referenced by this function.\n\n"
|
||||||
|
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n\n"
|
||||||
|
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n\n"
|
||||||
|
"* :defs - other function definitions that this function may instantiate.\n")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* Load the library */
|
/* Load the library */
|
||||||
void janet_lib_asm(JanetTable *env) {
|
void janet_lib_asm(JanetTable *env) {
|
||||||
JanetRegExt asm_cfuns[] = {
|
janet_core_cfuns(env, NULL, asm_cfuns);
|
||||||
JANET_CORE_REG("asm", cfun_asm),
|
|
||||||
JANET_CORE_REG("disasm", cfun_disasm),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, asm_cfuns);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -28,15 +28,8 @@
|
|||||||
#include "state.h"
|
#include "state.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Allow for managed buffers that cannot realloc/free their backing memory */
|
|
||||||
static void janet_buffer_can_realloc(JanetBuffer *buffer) {
|
|
||||||
if (buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) {
|
|
||||||
janet_panic("buffer cannot reallocate foreign memory");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Initialize a buffer */
|
/* Initialize a buffer */
|
||||||
static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity) {
|
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||||
uint8_t *data = NULL;
|
uint8_t *data = NULL;
|
||||||
if (capacity < 4) capacity = 4;
|
if (capacity < 4) capacity = 4;
|
||||||
janet_gcpressure(capacity);
|
janet_gcpressure(capacity);
|
||||||
@@ -50,37 +43,15 @@ static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity
|
|||||||
return buffer;
|
return buffer;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Initialize a buffer */
|
|
||||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
|
||||||
janet_buffer_init_impl(buffer, capacity);
|
|
||||||
buffer->gc.data.next = NULL;
|
|
||||||
buffer->gc.flags = JANET_MEM_DISABLED;
|
|
||||||
return buffer;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Initialize an unmanaged buffer */
|
|
||||||
JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count) {
|
|
||||||
if (count < 0) janet_panic("count < 0");
|
|
||||||
if (capacity < count) janet_panic("capacity < count");
|
|
||||||
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
|
|
||||||
buffer->gc.flags |= JANET_BUFFER_FLAG_NO_REALLOC;
|
|
||||||
buffer->capacity = capacity;
|
|
||||||
buffer->count = count;
|
|
||||||
buffer->data = (uint8_t *) memory;
|
|
||||||
return buffer;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Deinitialize a buffer (free data memory) */
|
/* Deinitialize a buffer (free data memory) */
|
||||||
void janet_buffer_deinit(JanetBuffer *buffer) {
|
void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||||
if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
|
||||||
janet_free(buffer->data);
|
janet_free(buffer->data);
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Initialize a buffer */
|
/* Initialize a buffer */
|
||||||
JanetBuffer *janet_buffer(int32_t capacity) {
|
JanetBuffer *janet_buffer(int32_t capacity) {
|
||||||
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
|
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
|
||||||
return janet_buffer_init_impl(buffer, capacity);
|
return janet_buffer_init(buffer, capacity);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Ensure that the buffer has enough internal capacity */
|
/* Ensure that the buffer has enough internal capacity */
|
||||||
@@ -88,7 +59,6 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
|||||||
uint8_t *new_data;
|
uint8_t *new_data;
|
||||||
uint8_t *old = buffer->data;
|
uint8_t *old = buffer->data;
|
||||||
if (capacity <= buffer->capacity) return;
|
if (capacity <= buffer->capacity) return;
|
||||||
janet_buffer_can_realloc(buffer);
|
|
||||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||||
janet_gcpressure(capacity - buffer->capacity);
|
janet_gcpressure(capacity - buffer->capacity);
|
||||||
@@ -121,7 +91,6 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
|||||||
}
|
}
|
||||||
int32_t new_size = buffer->count + n;
|
int32_t new_size = buffer->count + n;
|
||||||
if (new_size > buffer->capacity) {
|
if (new_size > buffer->capacity) {
|
||||||
janet_buffer_can_realloc(buffer);
|
|
||||||
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
|
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
|
||||||
uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||||
janet_gcpressure(new_capacity - buffer->capacity);
|
janet_gcpressure(new_capacity - buffer->capacity);
|
||||||
@@ -135,7 +104,8 @@ 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 = (int32_t) strlen(cstring);
|
int32_t len = 0;
|
||||||
|
while (cstring[len]) ++len;
|
||||||
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -192,52 +162,28 @@ void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
|||||||
|
|
||||||
/* C functions */
|
/* C functions */
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_new,
|
static Janet cfun_buffer_new(int32_t argc, Janet *argv) {
|
||||||
"(buffer/new capacity)",
|
|
||||||
"Creates a new, empty buffer with enough backing memory for `capacity` bytes. "
|
|
||||||
"Returns a new buffer of length 0.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
int32_t cap = janet_getinteger(argv, 0);
|
int32_t cap = janet_getinteger(argv, 0);
|
||||||
JanetBuffer *buffer = janet_buffer(cap);
|
JanetBuffer *buffer = janet_buffer(cap);
|
||||||
return janet_wrap_buffer(buffer);
|
return janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_new_filled,
|
static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
|
||||||
"(buffer/new-filled count &opt byte)",
|
|
||||||
"Creates a new buffer of length `count` filled with `byte`. By default, `byte` is 0. "
|
|
||||||
"Returns the new buffer.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
int32_t count = janet_getinteger(argv, 0);
|
int32_t count = janet_getinteger(argv, 0);
|
||||||
if (count < 0) count = 0;
|
|
||||||
int32_t byte = 0;
|
int32_t byte = 0;
|
||||||
if (argc == 2) {
|
if (argc == 2) {
|
||||||
byte = janet_getinteger(argv, 1) & 0xFF;
|
byte = janet_getinteger(argv, 1) & 0xFF;
|
||||||
}
|
}
|
||||||
JanetBuffer *buffer = janet_buffer(count);
|
JanetBuffer *buffer = janet_buffer(count);
|
||||||
if (buffer->data && count > 0)
|
if (buffer->data)
|
||||||
memset(buffer->data, byte, count);
|
memset(buffer->data, byte, count);
|
||||||
buffer->count = count;
|
buffer->count = count;
|
||||||
return janet_wrap_buffer(buffer);
|
return janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_frombytes,
|
static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
|
||||||
"(buffer/from-bytes & byte-vals)",
|
|
||||||
"Creates a buffer from integer parameters with byte values. All integers "
|
|
||||||
"will be coerced to the range of 1 byte 0-255.") {
|
|
||||||
int32_t i;
|
|
||||||
JanetBuffer *buffer = janet_buffer(argc);
|
|
||||||
for (i = 0; i < argc; i++) {
|
|
||||||
int32_t c = janet_getinteger(argv, i);
|
|
||||||
buffer->data[i] = c & 0xFF;
|
|
||||||
}
|
|
||||||
buffer->count = argc;
|
|
||||||
return janet_wrap_buffer(buffer);
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_fill,
|
|
||||||
"(buffer/fill buffer &opt byte)",
|
|
||||||
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
|
|
||||||
"Returns the modified buffer.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
int32_t byte = 0;
|
int32_t byte = 0;
|
||||||
@@ -250,13 +196,9 @@ JANET_CORE_FN(cfun_buffer_fill,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_trim,
|
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
|
||||||
"(buffer/trim buffer)",
|
|
||||||
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
|
|
||||||
"modified buffer.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
janet_buffer_can_realloc(buffer);
|
|
||||||
if (buffer->count < buffer->capacity) {
|
if (buffer->count < buffer->capacity) {
|
||||||
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
|
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
|
||||||
uint8_t *newData = janet_realloc(buffer->data, newcap);
|
uint8_t *newData = janet_realloc(buffer->data, newcap);
|
||||||
@@ -269,10 +211,7 @@ JANET_CORE_FN(cfun_buffer_trim,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_u8,
|
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||||
"(buffer/push-byte buffer & xs)",
|
|
||||||
"Append bytes to a buffer. Will expand the buffer as necessary. "
|
|
||||||
"Returns the modified buffer. Will throw an error if the buffer overflows.") {
|
|
||||||
int32_t i;
|
int32_t i;
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
@@ -282,11 +221,7 @@ JANET_CORE_FN(cfun_buffer_u8,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_word,
|
static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
|
||||||
"(buffer/push-word buffer & xs)",
|
|
||||||
"Append machine words to a buffer. The 4 bytes of the integer are appended "
|
|
||||||
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
|
|
||||||
"throw an error if the buffer overflows.") {
|
|
||||||
int32_t i;
|
int32_t i;
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
@@ -300,12 +235,7 @@ JANET_CORE_FN(cfun_buffer_word,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_chars,
|
static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||||
"(buffer/push-string buffer & xs)",
|
|
||||||
"Push byte sequences onto the end of a buffer. "
|
|
||||||
"Will accept any of strings, keywords, symbols, and buffers. "
|
|
||||||
"Returns the modified buffer. "
|
|
||||||
"Will throw an error if the buffer overflows.") {
|
|
||||||
int32_t i;
|
int32_t i;
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
@@ -320,135 +250,11 @@ JANET_CORE_FN(cfun_buffer_chars,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static int should_reverse_bytes(const Janet *argv, int32_t argc) {
|
static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
|
||||||
JanetKeyword order_kw = janet_getkeyword(argv, argc);
|
int32_t i;
|
||||||
if (!janet_cstrcmp(order_kw, "le")) {
|
janet_arity(argc, 1, -1);
|
||||||
#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);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
int reverse = should_reverse_bytes(argv, 1);
|
for (i = 1; i < argc; i++) {
|
||||||
uint16_t data = janet_getuinteger16(argv, 2);
|
|
||||||
uint8_t bytes[sizeof(data)];
|
|
||||||
memcpy(bytes, &data, sizeof(bytes));
|
|
||||||
if (reverse) {
|
|
||||||
uint8_t temp = bytes[1];
|
|
||||||
bytes[1] = bytes[0];
|
|
||||||
bytes[0] = temp;
|
|
||||||
}
|
|
||||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
|
||||||
return argv[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_push_uint32,
|
|
||||||
"(buffer/push-uint32 buffer order data)",
|
|
||||||
"Push a 32 bit unsigned integer data onto the end of the buffer. "
|
|
||||||
"Returns the modified buffer.") {
|
|
||||||
janet_fixarity(argc, 3);
|
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
|
||||||
int reverse = should_reverse_bytes(argv, 1);
|
|
||||||
uint32_t data = janet_getuinteger(argv, 2);
|
|
||||||
uint8_t bytes[sizeof(data)];
|
|
||||||
memcpy(bytes, &data, sizeof(bytes));
|
|
||||||
if (reverse)
|
|
||||||
reverse_u32(bytes);
|
|
||||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
|
||||||
return argv[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_push_uint64,
|
|
||||||
"(buffer/push-uint64 buffer order data)",
|
|
||||||
"Push a 64 bit unsigned integer data onto the end of the buffer. "
|
|
||||||
"Returns the modified buffer.") {
|
|
||||||
janet_fixarity(argc, 3);
|
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
|
||||||
int reverse = should_reverse_bytes(argv, 1);
|
|
||||||
uint64_t data = janet_getuinteger64(argv, 2);
|
|
||||||
uint8_t bytes[sizeof(data)];
|
|
||||||
memcpy(bytes, &data, sizeof(bytes));
|
|
||||||
if (reverse)
|
|
||||||
reverse_u64(bytes);
|
|
||||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
|
||||||
return argv[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_push_float32,
|
|
||||||
"(buffer/push-float32 buffer order data)",
|
|
||||||
"Push the underlying bytes of a 32 bit float data onto the end of the buffer. "
|
|
||||||
"Returns the modified buffer.") {
|
|
||||||
janet_fixarity(argc, 3);
|
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
|
||||||
int reverse = should_reverse_bytes(argv, 1);
|
|
||||||
float data = (float) janet_getnumber(argv, 2);
|
|
||||||
uint8_t bytes[sizeof(data)];
|
|
||||||
memcpy(bytes, &data, sizeof(bytes));
|
|
||||||
if (reverse)
|
|
||||||
reverse_u32(bytes);
|
|
||||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
|
||||||
return argv[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_push_float64,
|
|
||||||
"(buffer/push-float64 buffer order data)",
|
|
||||||
"Push the underlying bytes of a 64 bit float data onto the end of the buffer. "
|
|
||||||
"Returns the modified buffer.") {
|
|
||||||
janet_fixarity(argc, 3);
|
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
|
||||||
int reverse = should_reverse_bytes(argv, 1);
|
|
||||||
double data = janet_getnumber(argv, 2);
|
|
||||||
uint8_t bytes[sizeof(data)];
|
|
||||||
memcpy(bytes, &data, sizeof(bytes));
|
|
||||||
if (reverse)
|
|
||||||
reverse_u64(bytes);
|
|
||||||
janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
|
|
||||||
return argv[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) {
|
|
||||||
for (int32_t i = argc_offset; i < argc; i++) {
|
|
||||||
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
||||||
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
|
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
|
||||||
} else {
|
} else {
|
||||||
@@ -460,53 +266,18 @@ static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offs
|
|||||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_push_at,
|
|
||||||
"(buffer/push-at buffer index & xs)",
|
|
||||||
"Same as buffer/push, but copies the new data into the buffer "
|
|
||||||
" at index `index`.") {
|
|
||||||
janet_arity(argc, 2, -1);
|
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
|
||||||
int32_t index = janet_getinteger(argv, 1);
|
|
||||||
int32_t old_count = buffer->count;
|
|
||||||
if (index < 0 || index > old_count) {
|
|
||||||
janet_panicf("index out of range [0, %d)", old_count);
|
|
||||||
}
|
|
||||||
buffer->count = index;
|
|
||||||
buffer_push_impl(buffer, argv, 2, argc);
|
|
||||||
if (buffer->count < old_count) {
|
|
||||||
buffer->count = old_count;
|
|
||||||
}
|
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_push,
|
|
||||||
"(buffer/push buffer & xs)",
|
|
||||||
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
|
|
||||||
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
|
|
||||||
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
|
|
||||||
"Returns the modified buffer. "
|
|
||||||
"Will throw an error if the buffer overflows.") {
|
|
||||||
janet_arity(argc, 1, -1);
|
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
|
||||||
buffer_push_impl(buffer, argv, 1, argc);
|
|
||||||
return argv[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_clear,
|
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
|
||||||
"(buffer/clear buffer)",
|
|
||||||
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
|
||||||
"its memory so it can be efficiently refilled. Returns the modified buffer.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_popn,
|
static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
|
||||||
"(buffer/popn buffer n)",
|
|
||||||
"Removes the last `n` bytes from the buffer. Returns the modified buffer.") {
|
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
int32_t n = janet_getinteger(argv, 1);
|
int32_t n = janet_getinteger(argv, 1);
|
||||||
@@ -519,12 +290,7 @@ JANET_CORE_FN(cfun_buffer_popn,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_slice,
|
static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
|
||||||
"(buffer/slice bytes &opt start end)",
|
|
||||||
"Takes a slice of a byte sequence from `start` to `end`. The range is half open, "
|
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
|
||||||
"end of the array. By default, `start` is 0 and `end` is the length of the buffer. "
|
|
||||||
"Returns a new buffer.") {
|
|
||||||
JanetByteView view = janet_getbytes(argv, 0);
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
JanetRange range = janet_getslice(argc, argv);
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
||||||
@@ -548,9 +314,7 @@ static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, int32_t *index, i
|
|||||||
*bit = which_bit;
|
*bit = which_bit;
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_bitset,
|
static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
|
||||||
"(buffer/bit-set buffer index)",
|
|
||||||
"Sets the bit at the given bit-index. Returns the buffer.") {
|
|
||||||
int bit;
|
int bit;
|
||||||
int32_t index;
|
int32_t index;
|
||||||
JanetBuffer *buffer;
|
JanetBuffer *buffer;
|
||||||
@@ -559,9 +323,7 @@ JANET_CORE_FN(cfun_buffer_bitset,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_bitclear,
|
static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
|
||||||
"(buffer/bit-clear buffer index)",
|
|
||||||
"Clears the bit at the given bit-index. Returns the buffer.") {
|
|
||||||
int bit;
|
int bit;
|
||||||
int32_t index;
|
int32_t index;
|
||||||
JanetBuffer *buffer;
|
JanetBuffer *buffer;
|
||||||
@@ -570,9 +332,7 @@ JANET_CORE_FN(cfun_buffer_bitclear,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_bitget,
|
static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
|
||||||
"(buffer/bit buffer index)",
|
|
||||||
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.") {
|
|
||||||
int bit;
|
int bit;
|
||||||
int32_t index;
|
int32_t index;
|
||||||
JanetBuffer *buffer;
|
JanetBuffer *buffer;
|
||||||
@@ -580,9 +340,7 @@ JANET_CORE_FN(cfun_buffer_bitget,
|
|||||||
return janet_wrap_boolean(buffer->data[index] & (1 << bit));
|
return janet_wrap_boolean(buffer->data[index] & (1 << bit));
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_bittoggle,
|
static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
|
||||||
"(buffer/bit-toggle buffer index)",
|
|
||||||
"Toggles the bit at the given bit index in buffer. Returns the buffer.") {
|
|
||||||
int bit;
|
int bit;
|
||||||
int32_t index;
|
int32_t index;
|
||||||
JanetBuffer *buffer;
|
JanetBuffer *buffer;
|
||||||
@@ -591,26 +349,20 @@ JANET_CORE_FN(cfun_buffer_bittoggle,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_blit,
|
static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||||
"(buffer/blit dest src &opt dest-start src-start src-end)",
|
|
||||||
"Insert the contents of `src` into `dest`. Can optionally take indices that "
|
|
||||||
"indicate which part of `src` to copy into which part of `dest`. Indices can be "
|
|
||||||
"negative in order to index from the end of `src` or `dest`. Returns `dest`.") {
|
|
||||||
janet_arity(argc, 2, 5);
|
janet_arity(argc, 2, 5);
|
||||||
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||||
JanetByteView src = janet_getbytes(argv, 1);
|
JanetByteView src = janet_getbytes(argv, 1);
|
||||||
int same_buf = src.bytes == dest->data;
|
int same_buf = src.bytes == dest->data;
|
||||||
int32_t offset_dest = 0;
|
int32_t offset_dest = 0;
|
||||||
int32_t offset_src = 0;
|
int32_t offset_src = 0;
|
||||||
if (argc > 2 && !janet_checktype(argv[2], JANET_NIL))
|
if (argc > 2)
|
||||||
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
|
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
|
||||||
if (argc > 3 && !janet_checktype(argv[3], JANET_NIL))
|
if (argc > 3)
|
||||||
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
|
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
|
||||||
int32_t length_src;
|
int32_t length_src;
|
||||||
if (argc > 4) {
|
if (argc > 4) {
|
||||||
int32_t src_end = src.len;
|
int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
|
||||||
if (!janet_checktype(argv[4], JANET_NIL))
|
|
||||||
src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
|
|
||||||
length_src = src_end - offset_src;
|
length_src = src_end - offset_src;
|
||||||
if (length_src < 0) length_src = 0;
|
if (length_src < 0) length_src = 0;
|
||||||
} else {
|
} else {
|
||||||
@@ -634,10 +386,7 @@ JANET_CORE_FN(cfun_buffer_blit,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_format,
|
static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
|
||||||
"(buffer/format buffer format & args)",
|
|
||||||
"Snprintf like functionality for printing values into a buffer. Returns "
|
|
||||||
"the modified buffer.") {
|
|
||||||
janet_arity(argc, 2, -1);
|
janet_arity(argc, 2, -1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
const char *strfrmt = (const char *) janet_getstring(argv, 1);
|
const char *strfrmt = (const char *) janet_getstring(argv, 1);
|
||||||
@@ -645,55 +394,116 @@ JANET_CORE_FN(cfun_buffer_format,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_format_at,
|
static const JanetReg buffer_cfuns[] = {
|
||||||
"(buffer/format-at buffer at format & args)",
|
{
|
||||||
|
"buffer/new", cfun_buffer_new,
|
||||||
|
JDOC("(buffer/new capacity)\n\n"
|
||||||
|
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
|
||||||
|
"Returns a new buffer of length 0.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/new-filled", cfun_buffer_new_filled,
|
||||||
|
JDOC("(buffer/new-filled count &opt byte)\n\n"
|
||||||
|
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
|
||||||
|
"Returns the new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/fill", cfun_buffer_fill,
|
||||||
|
JDOC("(buffer/fill buffer &opt byte)\n\n"
|
||||||
|
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
|
||||||
|
"Returns the modified buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/trim", cfun_buffer_trim,
|
||||||
|
JDOC("(buffer/trim buffer)\n\n"
|
||||||
|
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
|
||||||
|
"modified buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/push-byte", cfun_buffer_u8,
|
||||||
|
JDOC("(buffer/push-byte buffer & xs)\n\n"
|
||||||
|
"Append bytes to a buffer. Will expand the buffer as necessary. "
|
||||||
|
"Returns the modified buffer. Will throw an error if the buffer overflows.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/push-word", cfun_buffer_word,
|
||||||
|
JDOC("(buffer/push-word buffer & xs)\n\n"
|
||||||
|
"Append machine words to a buffer. The 4 bytes of the integer are appended "
|
||||||
|
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
|
||||||
|
"throw an error if the buffer overflows.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/push-string", cfun_buffer_chars,
|
||||||
|
JDOC("(buffer/push-string buffer & xs)\n\n"
|
||||||
|
"Push byte sequences onto the end of a buffer. "
|
||||||
|
"Will accept any of strings, keywords, symbols, and buffers. "
|
||||||
|
"Returns the modified buffer. "
|
||||||
|
"Will throw an error if the buffer overflows.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/push", cfun_buffer_push,
|
||||||
|
JDOC("(buffer/push buffer & xs)\n\n"
|
||||||
|
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
|
||||||
|
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
|
||||||
|
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
|
||||||
|
"Returns the modified buffer. "
|
||||||
|
"Will throw an error if the buffer overflows.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/popn", cfun_buffer_popn,
|
||||||
|
JDOC("(buffer/popn buffer n)\n\n"
|
||||||
|
"Removes the last n bytes from the buffer. Returns the modified buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/clear", cfun_buffer_clear,
|
||||||
|
JDOC("(buffer/clear buffer)\n\n"
|
||||||
|
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
||||||
|
"its memory so it can be efficiently refilled. Returns the modified buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/slice", cfun_buffer_slice,
|
||||||
|
JDOC("(buffer/slice bytes &opt start end)\n\n"
|
||||||
|
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||||
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
|
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||||
|
"Returns a new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit-set", cfun_buffer_bitset,
|
||||||
|
JDOC("(buffer/bit-set buffer index)\n\n"
|
||||||
|
"Sets the bit at the given bit-index. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit-clear", cfun_buffer_bitclear,
|
||||||
|
JDOC("(buffer/bit-clear buffer index)\n\n"
|
||||||
|
"Clears the bit at the given bit-index. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit", cfun_buffer_bitget,
|
||||||
|
JDOC("(buffer/bit buffer index)\n\n"
|
||||||
|
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit-toggle", cfun_buffer_bittoggle,
|
||||||
|
JDOC("(buffer/bit-toggle buffer index)\n\n"
|
||||||
|
"Toggles the bit at the given bit index in buffer. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/blit", cfun_buffer_blit,
|
||||||
|
JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n"
|
||||||
|
"Insert the contents of src into dest. Can optionally take indices that "
|
||||||
|
"indicate which part of src to copy into which part of dest. Indices can be "
|
||||||
|
"negative to index from the end of src or dest. Returns dest.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/format", cfun_buffer_format,
|
||||||
|
JDOC("(buffer/format buffer format & args)\n\n"
|
||||||
"Snprintf like functionality for printing values into a buffer. Returns "
|
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||||
"the modified buffer.") {
|
" the modified buffer.")
|
||||||
janet_arity(argc, 2, -1);
|
},
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
{NULL, NULL, NULL}
|
||||||
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[] = {
|
janet_core_cfuns(env, NULL, buffer_cfuns);
|
||||||
JANET_CORE_REG("buffer/new", cfun_buffer_new),
|
|
||||||
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
|
|
||||||
JANET_CORE_REG("buffer/from-bytes", cfun_buffer_frombytes),
|
|
||||||
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
|
|
||||||
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
|
|
||||||
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
|
|
||||||
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
|
|
||||||
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
|
|
||||||
JANET_CORE_REG("buffer/push-uint16", cfun_buffer_push_uint16),
|
|
||||||
JANET_CORE_REG("buffer/push-uint32", cfun_buffer_push_uint32),
|
|
||||||
JANET_CORE_REG("buffer/push-uint64", cfun_buffer_push_uint64),
|
|
||||||
JANET_CORE_REG("buffer/push-float32", cfun_buffer_push_float32),
|
|
||||||
JANET_CORE_REG("buffer/push-float64", cfun_buffer_push_float64),
|
|
||||||
JANET_CORE_REG("buffer/push", cfun_buffer_push),
|
|
||||||
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
|
|
||||||
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
|
|
||||||
JANET_CORE_REG("buffer/clear", cfun_buffer_clear),
|
|
||||||
JANET_CORE_REG("buffer/slice", cfun_buffer_slice),
|
|
||||||
JANET_CORE_REG("buffer/bit-set", cfun_buffer_bitset),
|
|
||||||
JANET_CORE_REG("buffer/bit-clear", cfun_buffer_bitclear),
|
|
||||||
JANET_CORE_REG("buffer/bit", cfun_buffer_bitget),
|
|
||||||
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
|
|
||||||
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
|
|
||||||
JANET_CORE_REG("buffer/format", cfun_buffer_format),
|
|
||||||
JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, buffer_cfuns);
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -25,7 +25,6 @@
|
|||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "regalloc.h"
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Look up table for instructions */
|
/* Look up table for instructions */
|
||||||
@@ -37,13 +36,11 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_0, /* JOP_RETURN_NIL, */
|
JINT_0, /* JOP_RETURN_NIL, */
|
||||||
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
|
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
|
||||||
JINT_SSS, /* JOP_ADD, */
|
JINT_SSS, /* JOP_ADD, */
|
||||||
JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */
|
|
||||||
JINT_SSS, /* JOP_SUBTRACT, */
|
JINT_SSS, /* JOP_SUBTRACT, */
|
||||||
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
|
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
|
||||||
JINT_SSS, /* JOP_MULTIPLY, */
|
JINT_SSS, /* JOP_MULTIPLY, */
|
||||||
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
||||||
JINT_SSS, /* JOP_DIVIDE, */
|
JINT_SSS, /* JOP_DIVIDE, */
|
||||||
JINT_SSS, /* JOP_DIVIDE_FLOOR */
|
|
||||||
JINT_SSS, /* JOP_MODULO, */
|
JINT_SSS, /* JOP_MODULO, */
|
||||||
JINT_SSS, /* JOP_REMAINDER, */
|
JINT_SSS, /* JOP_REMAINDER, */
|
||||||
JINT_SSS, /* JOP_BAND, */
|
JINT_SSS, /* JOP_BAND, */
|
||||||
@@ -109,294 +106,6 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_SSS /* JOP_CANCEL, */
|
JINT_SSS /* JOP_CANCEL, */
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Remove all noops while preserving jumps and debugging information.
|
|
||||||
* Useful as part of a filtering compiler pass. */
|
|
||||||
void janet_bytecode_remove_noops(JanetFuncDef *def) {
|
|
||||||
|
|
||||||
/* Get an instruction rewrite map so we can rewrite jumps */
|
|
||||||
uint32_t *pc_map = janet_smalloc(sizeof(uint32_t) * (1 + def->bytecode_length));
|
|
||||||
uint32_t new_bytecode_length = 0;
|
|
||||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
|
||||||
uint32_t instr = def->bytecode[i];
|
|
||||||
uint32_t opcode = instr & 0x7F;
|
|
||||||
pc_map[i] = new_bytecode_length;
|
|
||||||
if (opcode != JOP_NOOP) {
|
|
||||||
new_bytecode_length++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
pc_map[def->bytecode_length] = new_bytecode_length;
|
|
||||||
|
|
||||||
/* Linear scan rewrite bytecode and sourcemap. Also fix jumps. */
|
|
||||||
int32_t j = 0;
|
|
||||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
|
||||||
uint32_t instr = def->bytecode[i];
|
|
||||||
uint32_t opcode = instr & 0x7F;
|
|
||||||
int32_t old_jump_target = 0;
|
|
||||||
int32_t new_jump_target = 0;
|
|
||||||
switch (opcode) {
|
|
||||||
case JOP_NOOP:
|
|
||||||
continue;
|
|
||||||
case JOP_JUMP:
|
|
||||||
/* relative pc is in DS field of instruction */
|
|
||||||
old_jump_target = i + (((int32_t)instr) >> 8);
|
|
||||||
new_jump_target = pc_map[old_jump_target];
|
|
||||||
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 8;
|
|
||||||
break;
|
|
||||||
case JOP_JUMP_IF:
|
|
||||||
case JOP_JUMP_IF_NIL:
|
|
||||||
case JOP_JUMP_IF_NOT:
|
|
||||||
case JOP_JUMP_IF_NOT_NIL:
|
|
||||||
/* relative pc is in ES field of instruction */
|
|
||||||
old_jump_target = i + (((int32_t)instr) >> 16);
|
|
||||||
new_jump_target = pc_map[old_jump_target];
|
|
||||||
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 16;
|
|
||||||
break;
|
|
||||||
default:
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
def->bytecode[j] = instr;
|
|
||||||
if (def->sourcemap != NULL) {
|
|
||||||
def->sourcemap[j] = def->sourcemap[i];
|
|
||||||
}
|
|
||||||
j++;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Rewrite symbolmap */
|
|
||||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
|
||||||
JanetSymbolMap *sm = def->symbolmap + i;
|
|
||||||
/* Don't rewrite upvalue mappings */
|
|
||||||
if (sm->birth_pc < UINT32_MAX) {
|
|
||||||
sm->birth_pc = pc_map[sm->birth_pc];
|
|
||||||
sm->death_pc = pc_map[sm->death_pc];
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
def->bytecode_length = new_bytecode_length;
|
|
||||||
def->bytecode = janet_realloc(def->bytecode, def->bytecode_length * sizeof(uint32_t));
|
|
||||||
janet_sfree(pc_map);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Remove redundant loads, moves and other instructions if possible and convert them to
|
|
||||||
* noops. Input is assumed valid bytecode. */
|
|
||||||
void janet_bytecode_movopt(JanetFuncDef *def) {
|
|
||||||
JanetcRegisterAllocator ra;
|
|
||||||
int recur = 1;
|
|
||||||
|
|
||||||
/* Iterate this until no more instructions can be removed. */
|
|
||||||
while (recur) {
|
|
||||||
janetc_regalloc_init(&ra);
|
|
||||||
|
|
||||||
/* Look for slots that have writes but no reads (and aren't in the closure bitset). */
|
|
||||||
if (def->closure_bitset != NULL) {
|
|
||||||
for (int32_t i = 0; i < def->slotcount; i++) {
|
|
||||||
int32_t index = i >> 5;
|
|
||||||
uint32_t mask = 1U << (((uint32_t) i) & 31);
|
|
||||||
if (def->closure_bitset[index] & mask) {
|
|
||||||
janetc_regalloc_touch(&ra, i);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
#define AA ((instr >> 8) & 0xFF)
|
|
||||||
#define BB ((instr >> 16) & 0xFF)
|
|
||||||
#define CC (instr >> 24)
|
|
||||||
#define DD (instr >> 8)
|
|
||||||
#define EE (instr >> 16)
|
|
||||||
|
|
||||||
/* Check reads and writes */
|
|
||||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
|
||||||
uint32_t instr = def->bytecode[i];
|
|
||||||
switch (instr & 0x7F) {
|
|
||||||
|
|
||||||
/* Group instructions my how they read from slots */
|
|
||||||
|
|
||||||
/* No reads or writes */
|
|
||||||
default:
|
|
||||||
janet_assert(0, "unhandled instruction");
|
|
||||||
case JOP_JUMP:
|
|
||||||
case JOP_NOOP:
|
|
||||||
case JOP_RETURN_NIL:
|
|
||||||
/* Write A */
|
|
||||||
case JOP_LOAD_INTEGER:
|
|
||||||
case JOP_LOAD_CONSTANT:
|
|
||||||
case JOP_LOAD_UPVALUE:
|
|
||||||
case JOP_CLOSURE:
|
|
||||||
/* Write D */
|
|
||||||
case JOP_LOAD_NIL:
|
|
||||||
case JOP_LOAD_TRUE:
|
|
||||||
case JOP_LOAD_FALSE:
|
|
||||||
case JOP_LOAD_SELF:
|
|
||||||
break;
|
|
||||||
case JOP_MAKE_ARRAY:
|
|
||||||
case JOP_MAKE_BUFFER:
|
|
||||||
case JOP_MAKE_STRING:
|
|
||||||
case JOP_MAKE_STRUCT:
|
|
||||||
case JOP_MAKE_TABLE:
|
|
||||||
case JOP_MAKE_TUPLE:
|
|
||||||
case JOP_MAKE_BRACKET_TUPLE:
|
|
||||||
/* Reads from the stack, don't remove */
|
|
||||||
janetc_regalloc_touch(&ra, DD);
|
|
||||||
break;
|
|
||||||
|
|
||||||
/* Read A */
|
|
||||||
case JOP_ERROR:
|
|
||||||
case JOP_TYPECHECK:
|
|
||||||
case JOP_JUMP_IF:
|
|
||||||
case JOP_JUMP_IF_NOT:
|
|
||||||
case JOP_JUMP_IF_NIL:
|
|
||||||
case JOP_JUMP_IF_NOT_NIL:
|
|
||||||
case JOP_SET_UPVALUE:
|
|
||||||
/* Write E, Read A */
|
|
||||||
case JOP_MOVE_FAR:
|
|
||||||
janetc_regalloc_touch(&ra, AA);
|
|
||||||
break;
|
|
||||||
|
|
||||||
/* Read B */
|
|
||||||
case JOP_SIGNAL:
|
|
||||||
/* Write A, Read B */
|
|
||||||
case JOP_ADD_IMMEDIATE:
|
|
||||||
case JOP_SUBTRACT_IMMEDIATE:
|
|
||||||
case JOP_MULTIPLY_IMMEDIATE:
|
|
||||||
case JOP_DIVIDE_IMMEDIATE:
|
|
||||||
case JOP_SHIFT_LEFT_IMMEDIATE:
|
|
||||||
case JOP_SHIFT_RIGHT_IMMEDIATE:
|
|
||||||
case JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE:
|
|
||||||
case JOP_GREATER_THAN_IMMEDIATE:
|
|
||||||
case JOP_LESS_THAN_IMMEDIATE:
|
|
||||||
case JOP_EQUALS_IMMEDIATE:
|
|
||||||
case JOP_NOT_EQUALS_IMMEDIATE:
|
|
||||||
case JOP_GET_INDEX:
|
|
||||||
janetc_regalloc_touch(&ra, BB);
|
|
||||||
break;
|
|
||||||
|
|
||||||
/* Read D */
|
|
||||||
case JOP_RETURN:
|
|
||||||
case JOP_PUSH:
|
|
||||||
case JOP_PUSH_ARRAY:
|
|
||||||
case JOP_TAILCALL:
|
|
||||||
janetc_regalloc_touch(&ra, DD);
|
|
||||||
break;
|
|
||||||
|
|
||||||
/* Write A, Read E */
|
|
||||||
case JOP_MOVE_NEAR:
|
|
||||||
case JOP_LENGTH:
|
|
||||||
case JOP_BNOT:
|
|
||||||
case JOP_CALL:
|
|
||||||
janetc_regalloc_touch(&ra, EE);
|
|
||||||
break;
|
|
||||||
|
|
||||||
/* Read A, B */
|
|
||||||
case JOP_PUT_INDEX:
|
|
||||||
janetc_regalloc_touch(&ra, AA);
|
|
||||||
janetc_regalloc_touch(&ra, BB);
|
|
||||||
break;
|
|
||||||
|
|
||||||
/* Read A, E */
|
|
||||||
case JOP_PUSH_2:
|
|
||||||
janetc_regalloc_touch(&ra, AA);
|
|
||||||
janetc_regalloc_touch(&ra, EE);
|
|
||||||
break;
|
|
||||||
|
|
||||||
/* Read B, C */
|
|
||||||
case JOP_PROPAGATE:
|
|
||||||
/* Write A, Read B and C */
|
|
||||||
case JOP_BAND:
|
|
||||||
case JOP_BOR:
|
|
||||||
case JOP_BXOR:
|
|
||||||
case JOP_ADD:
|
|
||||||
case JOP_SUBTRACT:
|
|
||||||
case JOP_MULTIPLY:
|
|
||||||
case JOP_DIVIDE:
|
|
||||||
case JOP_DIVIDE_FLOOR:
|
|
||||||
case JOP_MODULO:
|
|
||||||
case JOP_REMAINDER:
|
|
||||||
case JOP_SHIFT_LEFT:
|
|
||||||
case JOP_SHIFT_RIGHT:
|
|
||||||
case JOP_SHIFT_RIGHT_UNSIGNED:
|
|
||||||
case JOP_GREATER_THAN:
|
|
||||||
case JOP_LESS_THAN:
|
|
||||||
case JOP_EQUALS:
|
|
||||||
case JOP_COMPARE:
|
|
||||||
case JOP_IN:
|
|
||||||
case JOP_GET:
|
|
||||||
case JOP_GREATER_THAN_EQUAL:
|
|
||||||
case JOP_LESS_THAN_EQUAL:
|
|
||||||
case JOP_NOT_EQUALS:
|
|
||||||
case JOP_CANCEL:
|
|
||||||
case JOP_RESUME:
|
|
||||||
case JOP_NEXT:
|
|
||||||
janetc_regalloc_touch(&ra, BB);
|
|
||||||
janetc_regalloc_touch(&ra, CC);
|
|
||||||
break;
|
|
||||||
|
|
||||||
/* Read A, B, C */
|
|
||||||
case JOP_PUT:
|
|
||||||
case JOP_PUSH_3:
|
|
||||||
janetc_regalloc_touch(&ra, AA);
|
|
||||||
janetc_regalloc_touch(&ra, BB);
|
|
||||||
janetc_regalloc_touch(&ra, CC);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Iterate and set noops on instructions that make writes that no one ever reads.
|
|
||||||
* Only set noops for instructions with no side effects - moves, loads, etc. that can't
|
|
||||||
* raise errors (outside of systemic errors like oom or stack overflow). */
|
|
||||||
recur = 0;
|
|
||||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
|
||||||
uint32_t instr = def->bytecode[i];
|
|
||||||
switch (instr & 0x7F) {
|
|
||||||
default:
|
|
||||||
break;
|
|
||||||
/* Write D */
|
|
||||||
case JOP_LOAD_NIL:
|
|
||||||
case JOP_LOAD_TRUE:
|
|
||||||
case JOP_LOAD_FALSE:
|
|
||||||
case JOP_LOAD_SELF:
|
|
||||||
case JOP_MAKE_ARRAY:
|
|
||||||
case JOP_MAKE_TUPLE:
|
|
||||||
case JOP_MAKE_BRACKET_TUPLE: {
|
|
||||||
if (!janetc_regalloc_check(&ra, DD)) {
|
|
||||||
def->bytecode[i] = JOP_NOOP;
|
|
||||||
recur = 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
/* Write E, Read A */
|
|
||||||
case JOP_MOVE_FAR: {
|
|
||||||
if (!janetc_regalloc_check(&ra, EE)) {
|
|
||||||
def->bytecode[i] = JOP_NOOP;
|
|
||||||
recur = 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
/* Write A, Read E */
|
|
||||||
case JOP_MOVE_NEAR:
|
|
||||||
/* Write A, Read B */
|
|
||||||
case JOP_GET_INDEX:
|
|
||||||
/* Write A */
|
|
||||||
case JOP_LOAD_INTEGER:
|
|
||||||
case JOP_LOAD_CONSTANT:
|
|
||||||
case JOP_LOAD_UPVALUE:
|
|
||||||
case JOP_CLOSURE: {
|
|
||||||
if (!janetc_regalloc_check(&ra, AA)) {
|
|
||||||
def->bytecode[i] = JOP_NOOP;
|
|
||||||
recur = 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
janetc_regalloc_deinit(&ra);
|
|
||||||
#undef AA
|
|
||||||
#undef BB
|
|
||||||
#undef CC
|
|
||||||
#undef DD
|
|
||||||
#undef EE
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Verify some bytecode */
|
/* Verify some bytecode */
|
||||||
int janet_verify(JanetFuncDef *def) {
|
int janet_verify(JanetFuncDef *def) {
|
||||||
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||||
@@ -509,7 +218,6 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
|||||||
def->closure_bitset = NULL;
|
def->closure_bitset = NULL;
|
||||||
def->flags = 0;
|
def->flags = 0;
|
||||||
def->slotcount = 0;
|
def->slotcount = 0;
|
||||||
def->symbolmap = NULL;
|
|
||||||
def->arity = 0;
|
def->arity = 0;
|
||||||
def->min_arity = 0;
|
def->min_arity = 0;
|
||||||
def->max_arity = INT32_MAX;
|
def->max_arity = INT32_MAX;
|
||||||
@@ -521,7 +229,6 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
|||||||
def->constants_length = 0;
|
def->constants_length = 0;
|
||||||
def->bytecode_length = 0;
|
def->bytecode_length = 0;
|
||||||
def->environments_length = 0;
|
def->environments_length = 0;
|
||||||
def->symbolmap_length = 0;
|
|
||||||
return def;
|
return def;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
233
src/core/capi.c
233
src/core/capi.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -25,25 +25,14 @@
|
|||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "fiber.h"
|
#include "fiber.h"
|
||||||
#include "util.h"
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#ifndef JANET_SINGLE_THREADED
|
#ifndef JANET_SINGLE_THREADED
|
||||||
#ifndef JANET_WINDOWS
|
#ifndef JANET_WINDOWS
|
||||||
#include <pthread.h>
|
#include <pthread.h>
|
||||||
#endif
|
#else
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Even if single threaded, include this for atomics! */
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
#include <windows.h>
|
#include <windows.h>
|
||||||
#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
|
#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) {
|
||||||
@@ -62,15 +51,15 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
void janet_signalv(JanetSignal sig, Janet message) {
|
void janet_signalv(JanetSignal sig, Janet message) {
|
||||||
if (janet_vm.return_reg != NULL) {
|
if (janet_vm_return_reg != NULL) {
|
||||||
*janet_vm.return_reg = message;
|
*janet_vm_return_reg = message;
|
||||||
if (NULL != janet_vm.fiber) {
|
if (NULL != janet_vm_fiber) {
|
||||||
janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP;
|
janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
|
||||||
}
|
}
|
||||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||||
_longjmp(*janet_vm.signal_buf, sig);
|
_longjmp(*janet_vm_jmp_buf, sig);
|
||||||
#else
|
#else
|
||||||
longjmp(*janet_vm.signal_buf, sig);
|
longjmp(*janet_vm_jmp_buf, sig);
|
||||||
#endif
|
#endif
|
||||||
} else {
|
} else {
|
||||||
const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message);
|
const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message);
|
||||||
@@ -220,46 +209,12 @@ const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const c
|
|||||||
#undef DEFINE_OPTLEN
|
#undef DEFINE_OPTLEN
|
||||||
|
|
||||||
const char *janet_getcstring(const Janet *argv, int32_t n) {
|
const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||||
if (!janet_checktype(argv[n], JANET_STRING)) {
|
const uint8_t *jstr = janet_getstring(argv, n);
|
||||||
janet_panic_type(argv[n], n, JANET_TFLAG_STRING);
|
const char *cstr = (const char *)jstr;
|
||||||
|
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||||
|
janet_panicf("string %v contains embedded 0s");
|
||||||
}
|
}
|
||||||
return janet_getcbytes(argv, n);
|
|
||||||
}
|
|
||||||
|
|
||||||
const char *janet_getcbytes(const Janet *argv, int32_t n) {
|
|
||||||
/* Ensure buffer 0-padded */
|
|
||||||
if (janet_checktype(argv[n], JANET_BUFFER)) {
|
|
||||||
JanetBuffer *b = janet_unwrap_buffer(argv[n]);
|
|
||||||
if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) {
|
|
||||||
/* Make a copy with janet_smalloc in the rare case we have a buffer that
|
|
||||||
* cannot be realloced and pushing a 0 byte would panic. */
|
|
||||||
char *new_string = janet_smalloc(b->count + 1);
|
|
||||||
memcpy(new_string, b->data, b->count);
|
|
||||||
new_string[b->count] = 0;
|
|
||||||
if (strlen(new_string) != (size_t) b->count) goto badzeros;
|
|
||||||
return new_string;
|
|
||||||
} else {
|
|
||||||
/* Ensure trailing 0 */
|
|
||||||
janet_buffer_push_u8(b, 0);
|
|
||||||
b->count--;
|
|
||||||
if (strlen((char *)b->data) != (size_t) b->count) goto badzeros;
|
|
||||||
return (const char *) b->data;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
JanetByteView view = janet_getbytes(argv, n);
|
|
||||||
const char *cstr = (const char *)view.bytes;
|
|
||||||
if (strlen(cstr) != (size_t) view.len) goto badzeros;
|
|
||||||
return cstr;
|
return cstr;
|
||||||
|
|
||||||
badzeros:
|
|
||||||
janet_panic("bytes contain embedded 0s");
|
|
||||||
}
|
|
||||||
|
|
||||||
const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
|
|
||||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
|
|
||||||
return dflt;
|
|
||||||
}
|
|
||||||
return janet_getcbytes(argv, n);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
int32_t janet_getnat(const Janet *argv, int32_t n) {
|
int32_t janet_getnat(const Janet *argv, int32_t n) {
|
||||||
@@ -304,53 +259,12 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
|||||||
return janet_unwrap_integer(x);
|
return janet_unwrap_integer(x);
|
||||||
}
|
}
|
||||||
|
|
||||||
uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
|
|
||||||
Janet x = argv[n];
|
|
||||||
if (!janet_checkuint(x)) {
|
|
||||||
janet_panicf("bad slot #%d, expected 32 bit unsigned integer, got %v", n, x);
|
|
||||||
}
|
|
||||||
return (uint32_t) janet_unwrap_number(x);
|
|
||||||
}
|
|
||||||
|
|
||||||
int16_t janet_getinteger16(const Janet *argv, int32_t n) {
|
|
||||||
Janet x = argv[n];
|
|
||||||
if (!janet_checkint16(x)) {
|
|
||||||
janet_panicf("bad slot #%d, expected 16 bit signed integer, got %v", n, x);
|
|
||||||
}
|
|
||||||
return (int16_t) janet_unwrap_number(x);
|
|
||||||
}
|
|
||||||
|
|
||||||
uint16_t janet_getuinteger16(const Janet *argv, int32_t n) {
|
|
||||||
Janet x = argv[n];
|
|
||||||
if (!janet_checkuint16(x)) {
|
|
||||||
janet_panicf("bad slot #%d, expected 16 bit unsigned integer, got %v", n, x);
|
|
||||||
}
|
|
||||||
return (uint16_t) janet_unwrap_number(x);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||||
#ifdef JANET_INT_TYPES
|
|
||||||
return janet_unwrap_s64(argv[n]);
|
|
||||||
#else
|
|
||||||
Janet x = argv[n];
|
Janet x = argv[n];
|
||||||
if (!janet_checkint64(x)) {
|
if (!janet_checkint64(x)) {
|
||||||
janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x);
|
janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x);
|
||||||
}
|
}
|
||||||
return (int64_t) janet_unwrap_number(x);
|
return (int64_t) janet_unwrap_number(x);
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
|
|
||||||
#ifdef JANET_INT_TYPES
|
|
||||||
return janet_unwrap_u64(argv[n]);
|
|
||||||
#else
|
|
||||||
Janet x = argv[n];
|
|
||||||
if (!janet_checkuint64(x)) {
|
|
||||||
janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
|
|
||||||
}
|
|
||||||
return (uint64_t) janet_unwrap_number(x);
|
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
|
|
||||||
size_t janet_getsize(const Janet *argv, int32_t n) {
|
size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||||
@@ -366,30 +280,16 @@ int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const c
|
|||||||
int32_t not_raw = raw;
|
int32_t not_raw = raw;
|
||||||
if (not_raw < 0) not_raw += length + 1;
|
if (not_raw < 0) not_raw += length + 1;
|
||||||
if (not_raw < 0 || not_raw > length)
|
if (not_raw < 0 || not_raw > length)
|
||||||
janet_panicf("%s index %d out of range [%d,%d]", which, (int64_t) raw, -(int64_t)length - 1, (int64_t) length);
|
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
|
||||||
return not_raw;
|
return not_raw;
|
||||||
}
|
}
|
||||||
|
|
||||||
int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
|
|
||||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
return janet_gethalfrange(argv, n, length, "start");
|
|
||||||
}
|
|
||||||
|
|
||||||
int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
|
|
||||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
|
|
||||||
return length;
|
|
||||||
}
|
|
||||||
return janet_gethalfrange(argv, n, length, "end");
|
|
||||||
}
|
|
||||||
|
|
||||||
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||||
int32_t raw = janet_getinteger(argv, n);
|
int32_t raw = janet_getinteger(argv, n);
|
||||||
int32_t not_raw = raw;
|
int32_t not_raw = raw;
|
||||||
if (not_raw < 0) not_raw += length;
|
if (not_raw < 0) not_raw += length;
|
||||||
if (not_raw < 0 || not_raw > length)
|
if (not_raw < 0 || not_raw > length)
|
||||||
janet_panicf("%s index %d out of range [%d,%d)", which, (int64_t)raw, -(int64_t)length, (int64_t)length);
|
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
|
||||||
return not_raw;
|
return not_raw;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -436,64 +336,51 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
|||||||
janet_arity(argc, 1, 3);
|
janet_arity(argc, 1, 3);
|
||||||
JanetRange range;
|
JanetRange range;
|
||||||
int32_t length = janet_length(argv[0]);
|
int32_t length = janet_length(argv[0]);
|
||||||
range.start = janet_getstartrange(argv, argc, 1, length);
|
if (argc == 1) {
|
||||||
range.end = janet_getendrange(argv, argc, 2, length);
|
range.start = 0;
|
||||||
|
range.end = length;
|
||||||
|
} else if (argc == 2) {
|
||||||
|
range.start = janet_checktype(argv[1], JANET_NIL)
|
||||||
|
? 0
|
||||||
|
: janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = length;
|
||||||
|
} else {
|
||||||
|
range.start = janet_checktype(argv[1], JANET_NIL)
|
||||||
|
? 0
|
||||||
|
: janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = janet_checktype(argv[2], JANET_NIL)
|
||||||
|
? length
|
||||||
|
: janet_gethalfrange(argv, 2, length, "end");
|
||||||
if (range.end < range.start)
|
if (range.end < range.start)
|
||||||
range.end = range.start;
|
range.end = range.start;
|
||||||
|
}
|
||||||
return range;
|
return range;
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_dyn(const char *name) {
|
Janet janet_dyn(const char *name) {
|
||||||
if (!janet_vm.fiber) {
|
if (!janet_vm_fiber) {
|
||||||
if (!janet_vm.top_dyns) return janet_wrap_nil();
|
if (!janet_vm_top_dyns) return janet_wrap_nil();
|
||||||
return janet_table_get(janet_vm.top_dyns, janet_ckeywordv(name));
|
return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
|
||||||
}
|
}
|
||||||
if (janet_vm.fiber->env) {
|
if (janet_vm_fiber->env) {
|
||||||
return janet_table_get(janet_vm.fiber->env, janet_ckeywordv(name));
|
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
|
||||||
} else {
|
} else {
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_setdyn(const char *name, Janet value) {
|
void janet_setdyn(const char *name, Janet value) {
|
||||||
if (!janet_vm.fiber) {
|
if (!janet_vm_fiber) {
|
||||||
if (!janet_vm.top_dyns) janet_vm.top_dyns = janet_table(10);
|
if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
|
||||||
janet_table_put(janet_vm.top_dyns, janet_ckeywordv(name), value);
|
janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
|
||||||
} else {
|
} else {
|
||||||
if (!janet_vm.fiber->env) {
|
if (!janet_vm_fiber->env) {
|
||||||
janet_vm.fiber->env = janet_table(1);
|
janet_vm_fiber->env = janet_table(1);
|
||||||
}
|
}
|
||||||
janet_table_put(janet_vm.fiber->env, janet_ckeywordv(name), value);
|
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Create a function that when called, returns X. Trivial in Janet, a pain in C. */
|
|
||||||
JanetFunction *janet_thunk_delay(Janet x) {
|
|
||||||
static const uint32_t bytecode[] = {
|
|
||||||
JOP_LOAD_CONSTANT,
|
|
||||||
JOP_RETURN
|
|
||||||
};
|
|
||||||
JanetFuncDef *def = janet_funcdef_alloc();
|
|
||||||
def->arity = 0;
|
|
||||||
def->min_arity = 0;
|
|
||||||
def->max_arity = INT32_MAX;
|
|
||||||
def->flags = JANET_FUNCDEF_FLAG_VARARG;
|
|
||||||
def->slotcount = 1;
|
|
||||||
def->bytecode = janet_malloc(sizeof(bytecode));
|
|
||||||
def->bytecode_length = (int32_t)(sizeof(bytecode) / sizeof(uint32_t));
|
|
||||||
def->constants = janet_malloc(sizeof(Janet));
|
|
||||||
def->constants_length = 1;
|
|
||||||
def->name = NULL;
|
|
||||||
if (!def->bytecode || !def->constants) {
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
def->constants[0] = x;
|
|
||||||
memcpy(def->bytecode, bytecode, sizeof(bytecode));
|
|
||||||
janet_def_addflags(def);
|
|
||||||
/* janet_verify(def); */
|
|
||||||
return janet_thunk(def);
|
|
||||||
}
|
|
||||||
|
|
||||||
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
|
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
|
||||||
uint64_t ret = 0;
|
uint64_t ret = 0;
|
||||||
const uint8_t *keyw = janet_getkeyword(argv, n);
|
const uint8_t *keyw = janet_getkeyword(argv, n);
|
||||||
@@ -546,41 +433,9 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
|
|||||||
return janet_getabstract(argv, n, at);
|
return janet_getabstract(argv, n, at);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Atomic refcounts */
|
|
||||||
|
|
||||||
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
return InterlockedIncrement(x);
|
|
||||||
#elif defined(JANET_USE_STDATOMIC)
|
|
||||||
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
|
|
||||||
#else
|
|
||||||
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
return InterlockedDecrement(x);
|
|
||||||
#elif defined(JANET_USE_STDATOMIC)
|
|
||||||
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
|
|
||||||
#else
|
|
||||||
return __atomic_add_fetch(x, -1, __ATOMIC_ACQ_REL);
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
return InterlockedOr(x, 0);
|
|
||||||
#elif defined(JANET_USE_STDATOMIC)
|
|
||||||
return atomic_load_explicit(x, memory_order_acquire);
|
|
||||||
#else
|
|
||||||
return __atomic_load_n(x, __ATOMIC_ACQUIRE);
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Some definitions for function-like macros */
|
/* Some definitions for function-like macros */
|
||||||
|
|
||||||
JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {
|
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
||||||
return janet_struct_head(st);
|
return janet_struct_head(st);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -588,10 +443,10 @@ JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
|
|||||||
return janet_abstract_head(abstract);
|
return janet_abstract_head(abstract);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_API JanetStringHead *(janet_string_head)(JanetString s) {
|
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
|
||||||
return janet_string_head(s);
|
return janet_string_head(s);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_API JanetTupleHead *(janet_tuple_head)(JanetTuple tuple) {
|
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
|
||||||
return janet_tuple_head(tuple);
|
return janet_tuple_head(tuple);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -99,7 +99,7 @@ static JanetSlot opfunction(
|
|||||||
static int can_be_imm(Janet x, int8_t *out) {
|
static int can_be_imm(Janet x, int8_t *out) {
|
||||||
if (!janet_checkint(x)) return 0;
|
if (!janet_checkint(x)) return 0;
|
||||||
int32_t integer = janet_unwrap_integer(x);
|
int32_t integer = janet_unwrap_integer(x);
|
||||||
if (integer > INT8_MAX || integer < INT8_MIN) return 0;
|
if (integer > 127 || integer < -127) return 0;
|
||||||
*out = (int8_t) integer;
|
*out = (int8_t) integer;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -116,11 +116,12 @@ static JanetSlot opreduce(
|
|||||||
JanetSlot *args,
|
JanetSlot *args,
|
||||||
int op,
|
int op,
|
||||||
int opim,
|
int opim,
|
||||||
Janet nullary,
|
Janet nullary) {
|
||||||
Janet unary) {
|
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
int32_t i, len;
|
int32_t i, len;
|
||||||
int8_t imm = 0;
|
int8_t imm = 0;
|
||||||
|
int neg = opim < 0;
|
||||||
|
if (opim < 0) opim = -opim;
|
||||||
len = janet_v_count(args);
|
len = janet_v_count(args);
|
||||||
JanetSlot t;
|
JanetSlot t;
|
||||||
if (len == 0) {
|
if (len == 0) {
|
||||||
@@ -131,19 +132,19 @@ static JanetSlot opreduce(
|
|||||||
if (op == JOP_SUBTRACT) {
|
if (op == JOP_SUBTRACT) {
|
||||||
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
|
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
|
||||||
} else {
|
} else {
|
||||||
janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1);
|
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||||
}
|
}
|
||||||
return t;
|
return t;
|
||||||
}
|
}
|
||||||
t = janetc_gettarget(opts);
|
t = janetc_gettarget(opts);
|
||||||
if (opim && can_slot_be_imm(args[1], &imm)) {
|
if (opim && can_slot_be_imm(args[1], &imm)) {
|
||||||
janetc_emit_ssi(c, opim, t, args[0], imm, 1);
|
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
|
||||||
} else {
|
} else {
|
||||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||||
}
|
}
|
||||||
for (i = 2; i < len; i++) {
|
for (i = 2; i < len; i++) {
|
||||||
if (opim && can_slot_be_imm(args[i], &imm)) {
|
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||||
janetc_emit_ssi(c, opim, t, t, imm, 1);
|
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
|
||||||
} else {
|
} else {
|
||||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||||
}
|
}
|
||||||
@@ -154,7 +155,7 @@ static JanetSlot opreduce(
|
|||||||
/* Function optimizers */
|
/* Function optimizers */
|
||||||
|
|
||||||
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil());
|
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||||
@@ -171,7 +172,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
|||||||
return t;
|
return t;
|
||||||
}
|
}
|
||||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil());
|
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||||
if (janet_v_count(args) == 3) {
|
if (janet_v_count(args) == 3) {
|
||||||
@@ -191,14 +192,20 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
|||||||
c->buffer[label] |= (current - label) << 16;
|
c->buffer[label] |= (current - label) << 16;
|
||||||
return t;
|
return t;
|
||||||
} else {
|
} else {
|
||||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil());
|
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||||
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
|
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||||
|
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
|
||||||
|
}
|
||||||
|
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||||
|
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
|
||||||
|
}
|
||||||
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
|
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||||
if (opts.flags & JANET_FOPTS_DROP) {
|
if (opts.flags & JANET_FOPTS_DROP) {
|
||||||
@@ -255,43 +262,34 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
|||||||
/* Variadic operators specialization */
|
/* Variadic operators specialization */
|
||||||
|
|
||||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
|
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||||
}
|
}
|
||||||
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_SUBTRACT, JOP_SUBTRACT_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
|
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||||
}
|
}
|
||||||
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
|
||||||
static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) {
|
|
||||||
return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1));
|
|
||||||
}
|
|
||||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
|
||||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1));
|
|
||||||
}
|
|
||||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
|
||||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1));
|
|
||||||
}
|
}
|
||||||
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1));
|
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
|
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
|
||||||
}
|
}
|
||||||
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
|
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
|
||||||
}
|
}
|
||||||
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
|
||||||
}
|
}
|
||||||
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
||||||
return genericSS(opts, JOP_BNOT, args[0]);
|
return genericSS(opts, JOP_BNOT, args[0]);
|
||||||
@@ -385,11 +383,10 @@ static const JanetFunOptimizer optimizers[] = {
|
|||||||
{fixarity2, do_propagate},
|
{fixarity2, do_propagate},
|
||||||
{arity2or3, do_get},
|
{arity2or3, do_get},
|
||||||
{arity1or2, do_next},
|
{arity1or2, do_next},
|
||||||
{NULL, do_modulo},
|
{fixarity2, do_modulo},
|
||||||
{NULL, do_remainder},
|
{fixarity2, do_remainder},
|
||||||
{fixarity2, do_cmp},
|
{fixarity2, do_cmp},
|
||||||
{fixarity2, do_cancel},
|
{fixarity2, do_cancel},
|
||||||
{NULL, do_divf}
|
|
||||||
};
|
};
|
||||||
|
|
||||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -93,14 +93,10 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
|
|||||||
/* Add a slot to a scope with a symbol associated with it (def or var). */
|
/* Add a slot to a scope with a symbol associated with it (def or var). */
|
||||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
||||||
SymPair sp;
|
SymPair sp;
|
||||||
int32_t cnt = janet_v_count(c->buffer);
|
|
||||||
sp.sym = sym;
|
sp.sym = sym;
|
||||||
sp.sym2 = sym;
|
|
||||||
sp.slot = s;
|
sp.slot = s;
|
||||||
sp.keep = 0;
|
sp.keep = 0;
|
||||||
sp.slot.flags |= JANET_SLOT_NAMED;
|
sp.slot.flags |= JANET_SLOT_NAMED;
|
||||||
sp.birth_pc = cnt ? cnt - 1 : 0;
|
|
||||||
sp.death_pc = UINT32_MAX;
|
|
||||||
janet_v_push(c->scope->syms, sp);
|
janet_v_push(c->scope->syms, sp);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -163,27 +159,21 @@ void janetc_popscope(JanetCompiler *c) {
|
|||||||
if (oldscope->flags & JANET_SCOPE_CLOSURE) {
|
if (oldscope->flags & JANET_SCOPE_CLOSURE) {
|
||||||
newscope->flags |= JANET_SCOPE_CLOSURE;
|
newscope->flags |= JANET_SCOPE_CLOSURE;
|
||||||
}
|
}
|
||||||
if (newscope->ra.max < oldscope->ra.max) {
|
if (newscope->ra.max < oldscope->ra.max)
|
||||||
newscope->ra.max = oldscope->ra.max;
|
newscope->ra.max = oldscope->ra.max;
|
||||||
}
|
|
||||||
|
|
||||||
/* Keep upvalue slots and symbols for debugging. */
|
/* Keep upvalue slots */
|
||||||
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
|
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
|
||||||
SymPair pair = oldscope->syms[i];
|
SymPair pair = oldscope->syms[i];
|
||||||
|
if (pair.keep) {
|
||||||
/* The variable should not be lexically accessible */
|
/* The variable should not be lexically accessible */
|
||||||
pair.sym = NULL;
|
pair.sym = NULL;
|
||||||
if (pair.death_pc == UINT32_MAX) {
|
|
||||||
pair.death_pc = (uint32_t) janet_v_count(c->buffer);
|
|
||||||
}
|
|
||||||
if (pair.keep) {
|
|
||||||
/* The variable should also not be included in the locals */
|
|
||||||
pair.sym2 = NULL;
|
|
||||||
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
|
|
||||||
}
|
|
||||||
janet_v_push(newscope->syms, pair);
|
janet_v_push(newscope->syms, pair);
|
||||||
|
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
}
|
||||||
/* Free the old scope */
|
/* Free the old scope */
|
||||||
janet_v_free(oldscope->consts);
|
janet_v_free(oldscope->consts);
|
||||||
janet_v_free(oldscope->syms);
|
janet_v_free(oldscope->syms);
|
||||||
@@ -207,39 +197,6 @@ void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static int lookup_missing(
|
|
||||||
JanetCompiler *c,
|
|
||||||
const uint8_t *sym,
|
|
||||||
JanetFunction *handler,
|
|
||||||
JanetBinding *out) {
|
|
||||||
int32_t minar = handler->def->min_arity;
|
|
||||||
int32_t maxar = handler->def->max_arity;
|
|
||||||
if (minar > 1 || maxar < 1) {
|
|
||||||
janetc_error(c, janet_cstring("missing symbol lookup handler must take 1 argument"));
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
Janet args[1] = { janet_wrap_symbol(sym) };
|
|
||||||
JanetFiber *fiberp = janet_fiber(handler, 64, 1, args);
|
|
||||||
if (NULL == fiberp) {
|
|
||||||
janetc_error(c, janet_cstring("failed to call missing symbol lookup handler"));
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
fiberp->env = c->env;
|
|
||||||
int lock = janet_gclock();
|
|
||||||
Janet tempOut;
|
|
||||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
|
||||||
janet_gcunlock(lock);
|
|
||||||
if (status != JANET_SIGNAL_OK) {
|
|
||||||
janetc_error(c, janet_formatc("(lookup) %V", tempOut));
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Convert return value as entry. */
|
|
||||||
/* Alternative could use janet_resolve_ext(c->env, sym) to read result from environment. */
|
|
||||||
*out = janet_binding_from_entry(tempOut);
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Allow searching for symbols. Return information about the symbol */
|
/* Allow searching for symbols. Return information about the symbol */
|
||||||
JanetSlot janetc_resolve(
|
JanetSlot janetc_resolve(
|
||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
@@ -273,21 +230,6 @@ JanetSlot janetc_resolve(
|
|||||||
/* Symbol not found - check for global */
|
/* Symbol not found - check for global */
|
||||||
{
|
{
|
||||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||||
if (binding.type == JANET_BINDING_NONE) {
|
|
||||||
Janet handler = janet_table_get(c->env, janet_ckeywordv("missing-symbol"));
|
|
||||||
switch (janet_type(handler)) {
|
|
||||||
case JANET_NIL:
|
|
||||||
break;
|
|
||||||
case JANET_FUNCTION:
|
|
||||||
if (!lookup_missing(c, sym, janet_unwrap_function(handler), &binding))
|
|
||||||
return janetc_cslot(janet_wrap_nil());
|
|
||||||
break;
|
|
||||||
default:
|
|
||||||
janetc_error(c, janet_formatc("invalid lookup handler %V", handler));
|
|
||||||
return janetc_cslot(janet_wrap_nil());
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
switch (binding.type) {
|
switch (binding.type) {
|
||||||
default:
|
default:
|
||||||
case JANET_BINDING_NONE:
|
case JANET_BINDING_NONE:
|
||||||
@@ -297,12 +239,6 @@ JanetSlot janetc_resolve(
|
|||||||
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
||||||
ret = janetc_cslot(binding.value);
|
ret = janetc_cslot(binding.value);
|
||||||
break;
|
break;
|
||||||
case JANET_BINDING_DYNAMIC_DEF:
|
|
||||||
case JANET_BINDING_DYNAMIC_MACRO:
|
|
||||||
ret = janetc_cslot(binding.value);
|
|
||||||
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOTTYPE_ANY;
|
|
||||||
ret.flags &= ~JANET_SLOT_CONSTANT;
|
|
||||||
break;
|
|
||||||
case JANET_BINDING_VAR: {
|
case JANET_BINDING_VAR: {
|
||||||
ret = janetc_cslot(binding.value);
|
ret = janetc_cslot(binding.value);
|
||||||
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
||||||
@@ -344,7 +280,6 @@ found:
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* non-local scope needs to expose its environment */
|
/* non-local scope needs to expose its environment */
|
||||||
JanetScope *original_scope = scope;
|
|
||||||
pair->keep = 1;
|
pair->keep = 1;
|
||||||
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
|
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
|
||||||
scope = scope->parent;
|
scope = scope->parent;
|
||||||
@@ -366,7 +301,7 @@ found:
|
|||||||
/* Check if scope already has env. If so, break */
|
/* Check if scope already has env. If so, break */
|
||||||
len = janet_v_count(scope->envs);
|
len = janet_v_count(scope->envs);
|
||||||
for (j = 0; j < len; j++) {
|
for (j = 0; j < len; j++) {
|
||||||
if (scope->envs[j].envindex == envindex) {
|
if (scope->envs[j] == envindex) {
|
||||||
scopefound = 1;
|
scopefound = 1;
|
||||||
envindex = j;
|
envindex = j;
|
||||||
break;
|
break;
|
||||||
@@ -375,10 +310,7 @@ found:
|
|||||||
/* Add the environment if it is not already referenced */
|
/* Add the environment if it is not already referenced */
|
||||||
if (!scopefound) {
|
if (!scopefound) {
|
||||||
len = janet_v_count(scope->envs);
|
len = janet_v_count(scope->envs);
|
||||||
JanetEnvRef ref;
|
janet_v_push(scope->envs, envindex);
|
||||||
ref.envindex = envindex;
|
|
||||||
ref.scope = original_scope;
|
|
||||||
janet_v_push(scope->envs, ref);
|
|
||||||
envindex = len;
|
envindex = len;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -422,7 +354,6 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
|
|||||||
int32_t i;
|
int32_t i;
|
||||||
JanetSlot *ret = NULL;
|
JanetSlot *ret = NULL;
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
|
|
||||||
for (i = 0; i < len; i++) {
|
for (i = 0; i < len; i++) {
|
||||||
janet_v_push(ret, janetc_value(subopts, vals[i]));
|
janet_v_push(ret, janetc_value(subopts, vals[i]));
|
||||||
}
|
}
|
||||||
@@ -433,7 +364,6 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
|
|||||||
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
|
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
|
||||||
JanetSlot *ret = NULL;
|
JanetSlot *ret = NULL;
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
|
|
||||||
const JanetKV *kvs = NULL;
|
const JanetKV *kvs = NULL;
|
||||||
int32_t cap = 0, len = 0;
|
int32_t cap = 0, len = 0;
|
||||||
janet_dictionary_view(ds, &kvs, &len, &cap);
|
janet_dictionary_view(ds, &kvs, &len, &cap);
|
||||||
@@ -721,7 +651,7 @@ static int macroexpand1(
|
|||||||
}
|
}
|
||||||
Janet macroval;
|
Janet macroval;
|
||||||
JanetBindingType btype = janet_resolve(c->env, name, ¯oval);
|
JanetBindingType btype = janet_resolve(c->env, name, ¯oval);
|
||||||
if (!(btype == JANET_BINDING_MACRO || btype == JANET_BINDING_DYNAMIC_MACRO) ||
|
if (btype != JANET_BINDING_MACRO ||
|
||||||
!janet_checktype(macroval, JANET_FUNCTION))
|
!janet_checktype(macroval, JANET_FUNCTION))
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
@@ -746,14 +676,12 @@ static int macroexpand1(
|
|||||||
int lock = janet_gclock();
|
int lock = janet_gclock();
|
||||||
Janet mf_kw = janet_ckeywordv("macro-form");
|
Janet mf_kw = janet_ckeywordv("macro-form");
|
||||||
janet_table_put(c->env, mf_kw, x);
|
janet_table_put(c->env, mf_kw, x);
|
||||||
Janet ml_kw = janet_ckeywordv("macro-lints");
|
|
||||||
if (c->lints) {
|
|
||||||
janet_table_put(c->env, ml_kw, janet_wrap_array(c->lints));
|
|
||||||
}
|
|
||||||
Janet tempOut;
|
Janet tempOut;
|
||||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
||||||
janet_table_put(c->env, mf_kw, janet_wrap_nil());
|
janet_table_put(c->env, mf_kw, janet_wrap_nil());
|
||||||
janet_table_put(c->env, ml_kw, janet_wrap_nil());
|
if (c->lints) {
|
||||||
|
janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints));
|
||||||
|
}
|
||||||
janet_gcunlock(lock);
|
janet_gcunlock(lock);
|
||||||
if (status != JANET_SIGNAL_OK) {
|
if (status != JANET_SIGNAL_OK) {
|
||||||
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
|
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
|
||||||
@@ -886,10 +814,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
|
|
||||||
/* Copy envs */
|
/* Copy envs */
|
||||||
def->environments_length = janet_v_count(scope->envs);
|
def->environments_length = janet_v_count(scope->envs);
|
||||||
def->environments = janet_malloc(sizeof(int32_t) * def->environments_length);
|
def->environments = janet_v_flatten(scope->envs);
|
||||||
for (int32_t i = 0; i < def->environments_length; i++) {
|
|
||||||
def->environments[i] = scope->envs[i].envindex;
|
|
||||||
}
|
|
||||||
|
|
||||||
def->constants_length = janet_v_count(scope->consts);
|
def->constants_length = janet_v_count(scope->consts);
|
||||||
def->constants = janet_v_flatten(scope->consts);
|
def->constants = janet_v_flatten(scope->consts);
|
||||||
@@ -934,7 +859,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(slotchunks, sizeof(uint32_t));
|
uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
|
||||||
if (NULL == chunks) {
|
if (NULL == chunks) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -944,66 +869,9 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
def->closure_bitset = chunks;
|
def->closure_bitset = chunks;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Capture symbol to local mapping */
|
|
||||||
JanetSymbolMap *locals = NULL;
|
|
||||||
|
|
||||||
/* Symbol -> upvalue mapping */
|
|
||||||
JanetScope *top = c->scope;
|
|
||||||
while (top->parent) top = top->parent;
|
|
||||||
for (JanetScope *s = top; s != NULL; s = s->child) {
|
|
||||||
for (int32_t j = 0; j < janet_v_count(scope->envs); j++) {
|
|
||||||
JanetEnvRef ref = scope->envs[j];
|
|
||||||
JanetScope *upscope = ref.scope;
|
|
||||||
if (upscope != s) continue;
|
|
||||||
for (int32_t i = 0; i < janet_v_count(upscope->syms); i++) {
|
|
||||||
SymPair pair = upscope->syms[i];
|
|
||||||
if (pair.sym2) {
|
|
||||||
JanetSymbolMap jsm;
|
|
||||||
jsm.birth_pc = UINT32_MAX;
|
|
||||||
jsm.death_pc = j;
|
|
||||||
jsm.slot_index = pair.slot.index;
|
|
||||||
jsm.symbol = pair.sym2;
|
|
||||||
janet_v_push(locals, jsm);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Symbol -> slot mapping */
|
|
||||||
for (int32_t i = 0; i < janet_v_count(scope->syms); i++) {
|
|
||||||
SymPair pair = scope->syms[i];
|
|
||||||
if (pair.sym2) {
|
|
||||||
JanetSymbolMap jsm;
|
|
||||||
if (pair.death_pc == UINT32_MAX) {
|
|
||||||
jsm.death_pc = def->bytecode_length;
|
|
||||||
} else {
|
|
||||||
jsm.death_pc = pair.death_pc - scope->bytecode_start;
|
|
||||||
}
|
|
||||||
/* Handle birth_pc == 0 correctly */
|
|
||||||
if ((uint32_t) scope->bytecode_start > pair.birth_pc) {
|
|
||||||
jsm.birth_pc = 0;
|
|
||||||
} else {
|
|
||||||
jsm.birth_pc = pair.birth_pc - scope->bytecode_start;
|
|
||||||
}
|
|
||||||
janet_assert(jsm.birth_pc <= jsm.death_pc, "birth pc after death pc");
|
|
||||||
janet_assert(jsm.birth_pc < (uint32_t) def->bytecode_length, "bad birth pc");
|
|
||||||
janet_assert(jsm.death_pc <= (uint32_t) def->bytecode_length, "bad death pc");
|
|
||||||
jsm.slot_index = pair.slot.index;
|
|
||||||
jsm.symbol = pair.sym2;
|
|
||||||
janet_v_push(locals, jsm);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
def->symbolmap_length = janet_v_count(locals);
|
|
||||||
def->symbolmap = janet_v_flatten(locals);
|
|
||||||
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
|
|
||||||
|
|
||||||
/* Pop the scope */
|
/* Pop the scope */
|
||||||
janetc_popscope(c);
|
janetc_popscope(c);
|
||||||
|
|
||||||
/* Do basic optimization */
|
|
||||||
janet_bytecode_movopt(def);
|
|
||||||
janet_bytecode_remove_noops(def);
|
|
||||||
|
|
||||||
return def;
|
return def;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1056,7 +924,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 {
|
||||||
@@ -1074,34 +942,18 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* C Function for compiling */
|
/* C Function for compiling */
|
||||||
JANET_CORE_FN(cfun_compile,
|
static Janet cfun(int32_t argc, Janet *argv) {
|
||||||
"(compile ast &opt env source lints)",
|
|
||||||
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
|
||||||
"Pair the compile function with parsing functionality to implement "
|
|
||||||
"eval. Returns a new function and does not modify ast. Returns an error "
|
|
||||||
"struct with keys :line, :column, and :error if compilation fails. "
|
|
||||||
"If a `lints` array is given, linting messages will be appended to the array. "
|
|
||||||
"Each message will be a tuple of the form `(level line col message)`.") {
|
|
||||||
janet_arity(argc, 1, 4);
|
janet_arity(argc, 1, 4);
|
||||||
JanetTable *env = (argc > 1 && !janet_checktype(argv[1], JANET_NIL))
|
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
|
||||||
? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
|
||||||
if (NULL == env) {
|
if (NULL == env) {
|
||||||
env = janet_table(0);
|
env = janet_table(0);
|
||||||
janet_vm.fiber->env = env;
|
janet_vm_fiber->env = env;
|
||||||
}
|
}
|
||||||
const uint8_t *source = NULL;
|
const uint8_t *source = NULL;
|
||||||
if (argc >= 3) {
|
if (argc >= 3) {
|
||||||
Janet x = argv[2];
|
source = janet_getstring(argv, 2);
|
||||||
if (janet_checktype(x, JANET_STRING)) {
|
|
||||||
source = janet_unwrap_string(x);
|
|
||||||
} else if (janet_checktype(x, JANET_KEYWORD)) {
|
|
||||||
source = janet_unwrap_keyword(x);
|
|
||||||
} else if (!janet_checktype(x, JANET_NIL)) {
|
|
||||||
janet_panic_type(x, 2, JANET_TFLAG_STRING | JANET_TFLAG_KEYWORD);
|
|
||||||
}
|
}
|
||||||
}
|
JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
|
||||||
JanetArray *lints = (argc >= 4 && !janet_checktype(argv[3], JANET_NIL))
|
|
||||||
? janet_getarray(argv, 3) : NULL;
|
|
||||||
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
|
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
|
||||||
if (res.status == JANET_COMPILE_OK) {
|
if (res.status == JANET_COMPILE_OK) {
|
||||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||||
@@ -1121,10 +973,20 @@ JANET_CORE_FN(cfun_compile,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg compile_cfuns[] = {
|
||||||
|
{
|
||||||
|
"compile", cfun,
|
||||||
|
JDOC("(compile ast &opt env source lints)\n\n"
|
||||||
|
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
||||||
|
"Pair the compile function with parsing functionality to implement "
|
||||||
|
"eval. Returns a new function and does not modify ast. Returns an error "
|
||||||
|
"struct with keys :line, :column, and :error if compilation fails. "
|
||||||
|
"If a `lints` array is given, linting messages will be appended to the array. "
|
||||||
|
"Each message will be a tuple of the form `(level line col message)`.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
void janet_lib_compile(JanetTable *env) {
|
void janet_lib_compile(JanetTable *env) {
|
||||||
JanetRegExt cfuns[] = {
|
janet_core_cfuns(env, NULL, compile_cfuns);
|
||||||
JANET_CORE_REG("compile", cfun_compile),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -69,7 +69,6 @@ typedef enum {
|
|||||||
#define JANET_FUN_REMAINDER 30
|
#define JANET_FUN_REMAINDER 30
|
||||||
#define JANET_FUN_CMP 31
|
#define JANET_FUN_CMP 31
|
||||||
#define JANET_FUN_CANCEL 32
|
#define JANET_FUN_CANCEL 32
|
||||||
#define JANET_FUN_DIVIDE_FLOOR 33
|
|
||||||
|
|
||||||
/* Compiler typedefs */
|
/* Compiler typedefs */
|
||||||
typedef struct JanetCompiler JanetCompiler;
|
typedef struct JanetCompiler JanetCompiler;
|
||||||
@@ -112,21 +111,13 @@ struct JanetSlot {
|
|||||||
typedef struct SymPair {
|
typedef struct SymPair {
|
||||||
JanetSlot slot;
|
JanetSlot slot;
|
||||||
const uint8_t *sym;
|
const uint8_t *sym;
|
||||||
const uint8_t *sym2;
|
|
||||||
int keep;
|
int keep;
|
||||||
uint32_t birth_pc;
|
|
||||||
uint32_t death_pc;
|
|
||||||
} SymPair;
|
} SymPair;
|
||||||
|
|
||||||
typedef struct JanetEnvRef {
|
|
||||||
int32_t envindex;
|
|
||||||
JanetScope *scope;
|
|
||||||
} JanetEnvRef;
|
|
||||||
|
|
||||||
/* A lexical scope during compilation */
|
/* A lexical scope during compilation */
|
||||||
struct JanetScope {
|
struct JanetScope {
|
||||||
|
|
||||||
/* For debugging the compiler */
|
/* For debugging */
|
||||||
const char *name;
|
const char *name;
|
||||||
|
|
||||||
/* Scopes are doubly linked list */
|
/* Scopes are doubly linked list */
|
||||||
@@ -142,7 +133,7 @@ struct JanetScope {
|
|||||||
/* FuncDefs */
|
/* FuncDefs */
|
||||||
JanetFuncDef **defs;
|
JanetFuncDef **defs;
|
||||||
|
|
||||||
/* Register allocator */
|
/* Regsiter allocator */
|
||||||
JanetcRegisterAllocator ra;
|
JanetcRegisterAllocator ra;
|
||||||
|
|
||||||
/* Upvalue allocator */
|
/* Upvalue allocator */
|
||||||
@@ -151,7 +142,7 @@ struct JanetScope {
|
|||||||
/* Referenced closure environments. The values at each index correspond
|
/* Referenced closure environments. The values at each index correspond
|
||||||
* to which index to get the environment from in the parent. The environment
|
* to which index to get the environment from in the parent. The environment
|
||||||
* that corresponds to the direct parent's stack will always have value 0. */
|
* that corresponds to the direct parent's stack will always have value 0. */
|
||||||
JanetEnvRef *envs;
|
int32_t *envs;
|
||||||
|
|
||||||
int32_t bytecode_start;
|
int32_t bytecode_start;
|
||||||
int flags;
|
int flags;
|
||||||
@@ -188,7 +179,6 @@ struct JanetCompiler {
|
|||||||
#define JANET_FOPTS_TAIL 0x10000
|
#define JANET_FOPTS_TAIL 0x10000
|
||||||
#define JANET_FOPTS_HINT 0x20000
|
#define JANET_FOPTS_HINT 0x20000
|
||||||
#define JANET_FOPTS_DROP 0x40000
|
#define JANET_FOPTS_DROP 0x40000
|
||||||
#define JANET_FOPTS_ACCEPT_SPLICE 0x80000
|
|
||||||
|
|
||||||
/* Options for compiling a single form */
|
/* Options for compiling a single form */
|
||||||
struct JanetFopts {
|
struct JanetFopts {
|
||||||
@@ -237,7 +227,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
|
|||||||
/* Get a bunch of slots for function arguments */
|
/* Get a bunch of slots for function arguments */
|
||||||
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
|
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
|
||||||
|
|
||||||
/* Push slots loaded via janetc_toslots. */
|
/* Push slots load via janetc_toslots. */
|
||||||
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
|
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
|
||||||
|
|
||||||
/* Free slots loaded via janetc_toslots */
|
/* Free slots loaded via janetc_toslots */
|
||||||
@@ -262,14 +252,10 @@ void janetc_popscope(JanetCompiler *c);
|
|||||||
void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot);
|
void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot);
|
||||||
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
|
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
|
||||||
|
|
||||||
/* Create a destroy slot */
|
/* Create a destory slots */
|
||||||
JanetSlot janetc_cslot(Janet x);
|
JanetSlot janetc_cslot(Janet x);
|
||||||
|
|
||||||
/* Search for a symbol */
|
/* Search for a symbol */
|
||||||
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
||||||
|
|
||||||
/* Bytecode optimization */
|
|
||||||
void janet_bytecode_movopt(JanetFuncDef *def);
|
|
||||||
void janet_bytecode_remove_noops(JanetFuncDef *def);
|
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
255
src/core/debug.c
255
src/core/debug.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -55,7 +55,7 @@ void janet_debug_find(
|
|||||||
JanetFuncDef **def_out, int32_t *pc_out,
|
JanetFuncDef **def_out, int32_t *pc_out,
|
||||||
const uint8_t *source, int32_t sourceLine, int32_t sourceColumn) {
|
const uint8_t *source, int32_t sourceLine, int32_t sourceColumn) {
|
||||||
/* Scan the heap for right func def */
|
/* Scan the heap for right func def */
|
||||||
JanetGCObject *current = janet_vm.blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
/* Keep track of the best source mapping we have seen so far */
|
/* Keep track of the best source mapping we have seen so far */
|
||||||
int32_t besti = -1;
|
int32_t besti = -1;
|
||||||
int32_t best_line = -1;
|
int32_t best_line = -1;
|
||||||
@@ -86,7 +86,7 @@ void janet_debug_find(
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
current = current->data.next;
|
current = current->next;
|
||||||
}
|
}
|
||||||
if (best_def) {
|
if (best_def) {
|
||||||
*def_out = best_def;
|
*def_out = best_def;
|
||||||
@@ -96,19 +96,15 @@ void janet_debug_find(
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
|
||||||
const char *prefix = janet_checktype(err, JANET_NIL) ? NULL : "";
|
|
||||||
janet_stacktrace_ext(fiber, err, prefix);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Error reporting. This can be emulated from within Janet, but for
|
/* Error reporting. This can be emulated from within Janet, but for
|
||||||
* consistency with the top level code it is defined once. */
|
* consitency with the top level code it is defined once. */
|
||||||
void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||||
|
|
||||||
int32_t fi;
|
int32_t fi;
|
||||||
const char *errstr = (const char *)janet_to_string(err);
|
const char *errstr = (const char *)janet_to_string(err);
|
||||||
JanetFiber **fibers = NULL;
|
JanetFiber **fibers = NULL;
|
||||||
int wrote_error = !prefix;
|
|
||||||
|
/* Don't print error line if it is nil. */
|
||||||
|
int wrote_error = janet_checktype(err, JANET_NIL);
|
||||||
|
|
||||||
int print_color = janet_truthy(janet_dyn("err-color"));
|
int print_color = janet_truthy(janet_dyn("err-color"));
|
||||||
if (print_color) janet_eprintf("\x1b[31m");
|
if (print_color) janet_eprintf("\x1b[31m");
|
||||||
@@ -122,7 +118,6 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
|||||||
fiber = fibers[fi];
|
fiber = fibers[fi];
|
||||||
int32_t i = fiber->frame;
|
int32_t i = fiber->frame;
|
||||||
while (i > 0) {
|
while (i > 0) {
|
||||||
JanetCFunRegistry *reg = NULL;
|
|
||||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||||
JanetFuncDef *def = NULL;
|
JanetFuncDef *def = NULL;
|
||||||
i = frame->prevframe;
|
i = frame->prevframe;
|
||||||
@@ -130,10 +125,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
|||||||
/* Print prelude to stack frame */
|
/* Print prelude to stack frame */
|
||||||
if (!wrote_error) {
|
if (!wrote_error) {
|
||||||
JanetFiberStatus status = janet_fiber_status(fiber);
|
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||||
|
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
|
||||||
janet_eprintf("%s%s: %s\n",
|
janet_eprintf("%s%s: %s\n",
|
||||||
prefix ? prefix : "",
|
prefix,
|
||||||
janet_status_names[status],
|
janet_status_names[status],
|
||||||
errstr ? errstr : janet_status_names[status]);
|
errstr);
|
||||||
wrote_error = 1;
|
wrote_error = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -148,23 +144,15 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
|||||||
} else {
|
} else {
|
||||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||||
if (cfun) {
|
if (cfun) {
|
||||||
reg = janet_registry_get(cfun);
|
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||||
if (NULL != reg && NULL != reg->name) {
|
if (!janet_checktype(name, JANET_NIL))
|
||||||
if (reg->name_prefix) {
|
janet_eprintf(" %s", (const char *)janet_to_string(name));
|
||||||
janet_eprintf(" %s/%s", reg->name_prefix, reg->name);
|
else
|
||||||
} else {
|
|
||||||
janet_eprintf(" %s", reg->name);
|
|
||||||
}
|
|
||||||
if (NULL != reg->source_file) {
|
|
||||||
janet_eprintf(" [%s]", reg->source_file);
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
janet_eprintf(" <cfunction>");
|
janet_eprintf(" <cfunction>");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
|
||||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||||
janet_eprintf(" (tail call)");
|
janet_eprintf(" (tailcall)");
|
||||||
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) {
|
||||||
@@ -173,18 +161,8 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
|||||||
} else {
|
} else {
|
||||||
janet_eprintf(" pc=%d", off);
|
janet_eprintf(" pc=%d", off);
|
||||||
}
|
}
|
||||||
} else if (NULL != reg) {
|
|
||||||
/* C Function */
|
|
||||||
if (reg->source_line > 0) {
|
|
||||||
janet_eprintf(" on line %d", (long) reg->source_line);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
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");
|
|
||||||
}
|
|
||||||
*/
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -217,13 +195,7 @@ static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32
|
|||||||
*bytecode_offset = offset;
|
*bytecode_offset = offset;
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_debug_break,
|
static Janet cfun_debug_break(int32_t argc, Janet *argv) {
|
||||||
"(debug/break source line col)",
|
|
||||||
"Sets a breakpoint in `source` at a given line and column. "
|
|
||||||
"Will throw an error if the breakpoint location "
|
|
||||||
"cannot be found. For example\n\n"
|
|
||||||
"\t(debug/break \"core.janet\" 10 4)\n\n"
|
|
||||||
"will set a breakpoint at line 10, 4th column of the file core.janet.") {
|
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset;
|
int32_t offset;
|
||||||
helper_find(argc, argv, &def, &offset);
|
helper_find(argc, argv, &def, &offset);
|
||||||
@@ -231,11 +203,7 @@ JANET_CORE_FN(cfun_debug_break,
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_debug_unbreak,
|
static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
||||||
"(debug/unbreak source line column)",
|
|
||||||
"Remove a breakpoint with a source key at a given line and column. "
|
|
||||||
"Will throw an error if the breakpoint "
|
|
||||||
"cannot be found.") {
|
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset = 0;
|
int32_t offset = 0;
|
||||||
helper_find(argc, argv, &def, &offset);
|
helper_find(argc, argv, &def, &offset);
|
||||||
@@ -243,11 +211,7 @@ JANET_CORE_FN(cfun_debug_unbreak,
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_debug_fbreak,
|
static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
|
||||||
"(debug/fbreak fun &opt pc)",
|
|
||||||
"Set a breakpoint in a given function. pc is an optional offset, which "
|
|
||||||
"is in bytecode instructions. fun is a function value. Will throw an error "
|
|
||||||
"if the offset is too large or negative.") {
|
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset = 0;
|
int32_t offset = 0;
|
||||||
helper_find_fun(argc, argv, &def, &offset);
|
helper_find_fun(argc, argv, &def, &offset);
|
||||||
@@ -255,9 +219,7 @@ JANET_CORE_FN(cfun_debug_fbreak,
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_debug_unfbreak,
|
static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
|
||||||
"(debug/unfbreak fun &opt pc)",
|
|
||||||
"Unset a breakpoint set with debug/fbreak.") {
|
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset;
|
int32_t offset;
|
||||||
helper_find_fun(argc, argv, &def, &offset);
|
helper_find_fun(argc, argv, &def, &offset);
|
||||||
@@ -265,12 +227,7 @@ JANET_CORE_FN(cfun_debug_unfbreak,
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_debug_lineage,
|
static Janet cfun_debug_lineage(int32_t argc, Janet *argv) {
|
||||||
"(debug/lineage fib)",
|
|
||||||
"Returns an array of all child fibers from a root fiber. This function "
|
|
||||||
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
|
||||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
|
||||||
"be used mostly for debugging purposes.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
JanetArray *array = janet_array(0);
|
JanetArray *array = janet_array(0);
|
||||||
@@ -295,20 +252,9 @@ static Janet doframe(JanetStackFrame *frame) {
|
|||||||
} else {
|
} else {
|
||||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||||
if (cfun) {
|
if (cfun) {
|
||||||
JanetCFunRegistry *reg = janet_registry_get(cfun);
|
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||||
if (NULL != reg->name) {
|
if (!janet_checktype(name, JANET_NIL)) {
|
||||||
if (NULL != reg->name_prefix) {
|
janet_table_put(t, janet_ckeywordv("name"), name);
|
||||||
janet_table_put(t, janet_ckeywordv("name"), janet_wrap_string(janet_formatc("%s/%s", reg->name_prefix, reg->name)));
|
|
||||||
} else {
|
|
||||||
janet_table_put(t, janet_ckeywordv("name"), janet_cstringv(reg->name));
|
|
||||||
}
|
|
||||||
if (NULL != reg->source_file) {
|
|
||||||
janet_table_put(t, janet_ckeywordv("source"), janet_cstringv(reg->source_file));
|
|
||||||
}
|
|
||||||
if (reg->source_line > 0) {
|
|
||||||
janet_table_put(t, janet_ckeywordv("source-line"), janet_wrap_integer(reg->source_line));
|
|
||||||
janet_table_put(t, janet_ckeywordv("source-column"), janet_wrap_integer(1));
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());
|
janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());
|
||||||
@@ -319,7 +265,6 @@ static Janet doframe(JanetStackFrame *frame) {
|
|||||||
if (frame->func && frame->pc) {
|
if (frame->func && frame->pc) {
|
||||||
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
|
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
|
||||||
JanetArray *slots;
|
JanetArray *slots;
|
||||||
janet_assert(def != NULL, "def != NULL");
|
|
||||||
off = (int32_t)(frame->pc - def->bytecode);
|
off = (int32_t)(frame->pc - def->bytecode);
|
||||||
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
||||||
if (def->sourcemap) {
|
if (def->sourcemap) {
|
||||||
@@ -335,46 +280,11 @@ static Janet doframe(JanetStackFrame *frame) {
|
|||||||
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||||
slots->count = def->slotcount;
|
slots->count = def->slotcount;
|
||||||
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
||||||
/* Add local bindings */
|
|
||||||
if (def->symbolmap) {
|
|
||||||
JanetTable *local_bindings = janet_table(0);
|
|
||||||
for (int32_t i = def->symbolmap_length - 1; i >= 0; i--) {
|
|
||||||
JanetSymbolMap jsm = def->symbolmap[i];
|
|
||||||
Janet value = janet_wrap_nil();
|
|
||||||
uint32_t pc = (uint32_t)(frame->pc - def->bytecode);
|
|
||||||
if (jsm.birth_pc == UINT32_MAX) {
|
|
||||||
JanetFuncEnv *env = frame->func->envs[jsm.death_pc];
|
|
||||||
if (env->offset > 0) {
|
|
||||||
value = env->as.fiber->data[env->offset + jsm.slot_index];
|
|
||||||
} else {
|
|
||||||
value = env->as.values[jsm.slot_index];
|
|
||||||
}
|
|
||||||
} else if (pc >= jsm.birth_pc && pc < jsm.death_pc) {
|
|
||||||
value = stack[jsm.slot_index];
|
|
||||||
}
|
|
||||||
janet_table_put(local_bindings, janet_wrap_symbol(jsm.symbol), value);
|
|
||||||
}
|
|
||||||
janet_table_put(t, janet_ckeywordv("locals"), janet_wrap_table(local_bindings));
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
return janet_wrap_table(t);
|
return janet_wrap_table(t);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_debug_stack,
|
static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
|
||||||
"(debug/stack fib)",
|
|
||||||
"Gets information about the stack as an array of tables. Each table "
|
|
||||||
"in the array contains information about a stack frame. The top-most, current "
|
|
||||||
"stack frame is the first table in the array, and the bottom-most stack frame "
|
|
||||||
"is the last value. Each stack frame contains some of the following attributes:\n\n"
|
|
||||||
"* :c - true if the stack frame is a c function invocation\n\n"
|
|
||||||
"* :source-column - the current source column of the stack frame\n\n"
|
|
||||||
"* :function - the function that the stack frame represents\n\n"
|
|
||||||
"* :source-line - the current source line of the stack frame\n\n"
|
|
||||||
"* :name - the human-friendly name of the function\n\n"
|
|
||||||
"* :pc - integer indicating the location of the program counter\n\n"
|
|
||||||
"* :source - string with the file path or other identifier for the source code\n\n"
|
|
||||||
"* :slots - array of all values in each slot\n\n"
|
|
||||||
"* :tail - boolean indicating a tail call") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
JanetArray *array = janet_array(0);
|
JanetArray *array = janet_array(0);
|
||||||
@@ -390,24 +300,15 @@ JANET_CORE_FN(cfun_debug_stack,
|
|||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_debug_stacktrace,
|
static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
|
||||||
"(debug/stacktrace fiber &opt err prefix)",
|
janet_arity(argc, 1, 2);
|
||||||
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
|
|
||||||
"an error value to print the stack trace with. If `prefix` is nil or not "
|
|
||||||
"provided, will skip the error line. Returns the fiber.") {
|
|
||||||
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];
|
||||||
const char *prefix = janet_optcstring(argv, argc, 2, NULL);
|
janet_stacktrace(fiber, x);
|
||||||
janet_stacktrace_ext(fiber, x, prefix);
|
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_debug_argstack,
|
static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
|
||||||
"(debug/arg-stack fiber)",
|
|
||||||
"Gets all values currently on the fiber's argument stack. Normally, "
|
|
||||||
"this should be empty unless the fiber signals while pushing arguments "
|
|
||||||
"to make a function call. Returns a new array.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
|
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
|
||||||
@@ -416,11 +317,7 @@ JANET_CORE_FN(cfun_debug_argstack,
|
|||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_debug_step,
|
static Janet cfun_debug_step(int32_t argc, Janet *argv) {
|
||||||
"(debug/step fiber &opt x)",
|
|
||||||
"Run a fiber for one virtual instruction of the Janet machine. Can optionally "
|
|
||||||
"pass in a value that will be passed as the resuming value. Returns the signal value, "
|
|
||||||
"which will usually be nil, as breakpoints raise nil signals.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
Janet out = janet_wrap_nil();
|
Janet out = janet_wrap_nil();
|
||||||
@@ -428,19 +325,85 @@ JANET_CORE_FN(cfun_debug_step,
|
|||||||
return out;
|
return out;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg debug_cfuns[] = {
|
||||||
|
{
|
||||||
|
"debug/break", cfun_debug_break,
|
||||||
|
JDOC("(debug/break source line col)\n\n"
|
||||||
|
"Sets a breakpoint in `source` at a given line and column. "
|
||||||
|
"Will throw an error if the breakpoint location "
|
||||||
|
"cannot be found. For example\n\n"
|
||||||
|
"\t(debug/break \"core.janet\" 10 4)\n\n"
|
||||||
|
"wil set a breakpoint at line 10, 4th column of the file core.janet.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/unbreak", cfun_debug_unbreak,
|
||||||
|
JDOC("(debug/unbreak source line column)\n\n"
|
||||||
|
"Remove a breakpoint with a source key at a given line and column. "
|
||||||
|
"Will throw an error if the breakpoint "
|
||||||
|
"cannot be found.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/fbreak", cfun_debug_fbreak,
|
||||||
|
JDOC("(debug/fbreak fun &opt pc)\n\n"
|
||||||
|
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||||
|
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||||
|
"if the offset is too large or negative.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/unfbreak", cfun_debug_unfbreak,
|
||||||
|
JDOC("(debug/unfbreak fun &opt pc)\n\n"
|
||||||
|
"Unset a breakpoint set with debug/fbreak.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/arg-stack", cfun_debug_argstack,
|
||||||
|
JDOC("(debug/arg-stack fiber)\n\n"
|
||||||
|
"Gets all values currently on the fiber's argument stack. Normally, "
|
||||||
|
"this should be empty unless the fiber signals while pushing arguments "
|
||||||
|
"to make a function call. Returns a new array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/stack", cfun_debug_stack,
|
||||||
|
JDOC("(debug/stack fib)\n\n"
|
||||||
|
"Gets information about the stack as an array of tables. Each table "
|
||||||
|
"in the array contains information about a stack frame. The top-most, current "
|
||||||
|
"stack frame is the first table in the array, and the bottom-most stack frame "
|
||||||
|
"is the last value. Each stack frame contains some of the following attributes:\n\n"
|
||||||
|
"* :c - true if the stack frame is a c function invocation\n\n"
|
||||||
|
"* :column - the current source column of the stack frame\n\n"
|
||||||
|
"* :function - the function that the stack frame represents\n\n"
|
||||||
|
"* :line - the current source line of the stack frame\n\n"
|
||||||
|
"* :name - the human-friendly name of the function\n\n"
|
||||||
|
"* :pc - integer indicating the location of the program counter\n\n"
|
||||||
|
"* :source - string with the file path or other identifier for the source code\n\n"
|
||||||
|
"* :slots - array of all values in each slot\n\n"
|
||||||
|
"* :tail - boolean indicating a tail call")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/stacktrace", cfun_debug_stacktrace,
|
||||||
|
JDOC("(debug/stacktrace fiber &opt err)\n\n"
|
||||||
|
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
|
||||||
|
"an error value to print the stack trace with. If `err` is nil or not "
|
||||||
|
"provided, will skipp the error line. Returns the fiber.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/lineage", cfun_debug_lineage,
|
||||||
|
JDOC("(debug/lineage fib)\n\n"
|
||||||
|
"Returns an array of all child fibers from a root fiber. This function "
|
||||||
|
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
||||||
|
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||||
|
"be used mostly for debugging purposes.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/step", cfun_debug_step,
|
||||||
|
JDOC("(debug/step fiber &opt x)\n\n"
|
||||||
|
"Run a fiber for one virtual instruction of the Janet machine. Can optionally "
|
||||||
|
"pass in a value that will be passed as the resuming value. Returns the signal value, "
|
||||||
|
"which will usually be nil, as breakpoints raise nil signals.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_debug(JanetTable *env) {
|
void janet_lib_debug(JanetTable *env) {
|
||||||
JanetRegExt debug_cfuns[] = {
|
janet_core_cfuns(env, NULL, debug_cfuns);
|
||||||
JANET_CORE_REG("debug/break", cfun_debug_break),
|
|
||||||
JANET_CORE_REG("debug/unbreak", cfun_debug_unbreak),
|
|
||||||
JANET_CORE_REG("debug/fbreak", cfun_debug_fbreak),
|
|
||||||
JANET_CORE_REG("debug/unfbreak", cfun_debug_unfbreak),
|
|
||||||
JANET_CORE_REG("debug/arg-stack", cfun_debug_argstack),
|
|
||||||
JANET_CORE_REG("debug/stack", cfun_debug_stack),
|
|
||||||
JANET_CORE_REG("debug/stacktrace", cfun_debug_stacktrace),
|
|
||||||
JANET_CORE_REG("debug/lineage", cfun_debug_lineage),
|
|
||||||
JANET_CORE_REG("debug/step", cfun_debug_step),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, debug_cfuns);
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -26,7 +26,6 @@
|
|||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
#include "util.h"
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Get a register */
|
/* Get a register */
|
||||||
@@ -129,8 +128,7 @@ static void janetc_movenear(JanetCompiler *c,
|
|||||||
((uint32_t)(src.envindex) << 16) |
|
((uint32_t)(src.envindex) << 16) |
|
||||||
((uint32_t)(dest) << 8) |
|
((uint32_t)(dest) << 8) |
|
||||||
JOP_LOAD_UPVALUE);
|
JOP_LOAD_UPVALUE);
|
||||||
} else if (src.index != dest) {
|
} else if (src.index > 0xFF || src.index != dest) {
|
||||||
janet_assert(src.index >= 0, "bad slot");
|
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
((uint32_t)(src.index) << 16) |
|
((uint32_t)(src.index) << 16) |
|
||||||
((uint32_t)(dest) << 8) |
|
((uint32_t)(dest) << 8) |
|
||||||
@@ -157,7 +155,6 @@ static void janetc_moveback(JanetCompiler *c,
|
|||||||
((uint32_t)(src) << 8) |
|
((uint32_t)(src) << 8) |
|
||||||
JOP_SET_UPVALUE);
|
JOP_SET_UPVALUE);
|
||||||
} else if (dest.index != src) {
|
} else if (dest.index != src) {
|
||||||
janet_assert(dest.index >= 0, "bad slot");
|
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
((uint32_t)(dest.index) << 16) |
|
((uint32_t)(dest.index) << 16) |
|
||||||
((uint32_t)(src) << 8) |
|
((uint32_t)(src) << 8) |
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
|
|||||||
2571
src/core/ev.c
2571
src/core/ev.c
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -26,10 +26,9 @@
|
|||||||
#define JANET_FEATURES_H_defined
|
#define JANET_FEATURES_H_defined
|
||||||
|
|
||||||
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|
||||||
|| defined(__bsdi__) || defined(__DragonFly__) || defined(__FreeBSD__)
|
|| defined(__bsdi__) || defined(__DragonFly__)
|
||||||
/* Use BSD source on any BSD systems, include OSX */
|
/* Use BSD source on any BSD systems, include OSX */
|
||||||
# define _BSD_SOURCE
|
# define _BSD_SOURCE
|
||||||
# define _POSIX_C_SOURCE 200809L
|
|
||||||
#else
|
#else
|
||||||
/* Use POSIX feature flags */
|
/* Use POSIX feature flags */
|
||||||
# ifndef _POSIX_C_SOURCE
|
# ifndef _POSIX_C_SOURCE
|
||||||
@@ -37,31 +36,13 @@
|
|||||||
# endif
|
# endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#if defined(__APPLE__)
|
|
||||||
#define _DARWIN_C_SOURCE
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Needed for sched.h for cpu count */
|
|
||||||
#ifdef __linux__
|
|
||||||
#define _GNU_SOURCE
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#if defined(WIN32) || defined(_WIN32)
|
#if defined(WIN32) || defined(_WIN32)
|
||||||
#define WIN32_LEAN_AND_MEAN
|
#define WIN32_LEAN_AND_MEAN
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* needed for inet_pton and InitializeSRWLock */
|
/* Needed for realpath on linux */
|
||||||
#ifdef __MINGW32__
|
#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
|
||||||
#define _WIN32_WINNT _WIN32_WINNT_VISTA
|
#define _XOPEN_SOURCE 500
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Needed for realpath on linux, as well as pthread rwlocks. */
|
|
||||||
#ifndef _XOPEN_SOURCE
|
|
||||||
#define _XOPEN_SOURCE 600
|
|
||||||
#endif
|
|
||||||
#if _XOPEN_SOURCE < 600
|
|
||||||
#undef _XOPEN_SOURCE
|
|
||||||
#define _XOPEN_SOURCE 600
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Needed for timegm and other extensions when building with -std=c99.
|
/* Needed for timegm and other extensions when building with -std=c99.
|
||||||
@@ -71,11 +52,4 @@
|
|||||||
#define _NETBSD_SOURCE
|
#define _NETBSD_SOURCE
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Needed for several things when building with -std=c99. */
|
|
||||||
#if !__BSD_VISIBLE && (defined(__DragonFly__) || defined(__FreeBSD__))
|
|
||||||
#define __BSD_VISIBLE 1
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#define _FILE_OFFSET_BITS 64
|
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
1897
src/core/ffi.c
1897
src/core/ffi.c
File diff suppressed because it is too large
Load Diff
241
src/core/fiber.c
241
src/core/fiber.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -39,10 +39,8 @@ static void fiber_reset(JanetFiber *fiber) {
|
|||||||
fiber->env = NULL;
|
fiber->env = NULL;
|
||||||
fiber->last_value = janet_wrap_nil();
|
fiber->last_value = janet_wrap_nil();
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
|
fiber->waiting = NULL;
|
||||||
fiber->sched_id = 0;
|
fiber->sched_id = 0;
|
||||||
fiber->ev_callback = NULL;
|
|
||||||
fiber->ev_state = NULL;
|
|
||||||
fiber->ev_stream = NULL;
|
|
||||||
fiber->supervisor_channel = NULL;
|
fiber->supervisor_channel = NULL;
|
||||||
#endif
|
#endif
|
||||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||||
@@ -59,7 +57,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
|
|||||||
if (NULL == data) {
|
if (NULL == data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
janet_vm.next_collection += sizeof(Janet) * capacity;
|
janet_vm_next_collection += sizeof(Janet) * capacity;
|
||||||
fiber->data = data;
|
fiber->data = data;
|
||||||
return fiber;
|
return fiber;
|
||||||
}
|
}
|
||||||
@@ -83,10 +81,10 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
|||||||
}
|
}
|
||||||
fiber->stacktop = newstacktop;
|
fiber->stacktop = newstacktop;
|
||||||
}
|
}
|
||||||
/* Don't panic on failure since we use this to implement janet_pcall */
|
|
||||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
|
fiber->waiting = NULL;
|
||||||
fiber->supervisor_channel = NULL;
|
fiber->supervisor_channel = NULL;
|
||||||
#endif
|
#endif
|
||||||
return fiber;
|
return fiber;
|
||||||
@@ -123,7 +121,7 @@ void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
|||||||
}
|
}
|
||||||
fiber->data = newData;
|
fiber->data = newData;
|
||||||
fiber->capacity = n;
|
fiber->capacity = n;
|
||||||
janet_vm.next_collection += sizeof(Janet) * diff;
|
janet_vm_next_collection += sizeof(Janet) * diff;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Grow fiber if needed */
|
/* Grow fiber if needed */
|
||||||
@@ -257,7 +255,7 @@ static void janet_env_detach(JanetFuncEnv *env) {
|
|||||||
int32_t len = env->length;
|
int32_t len = env->length;
|
||||||
size_t s = sizeof(Janet) * (size_t) len;
|
size_t s = sizeof(Janet) * (size_t) len;
|
||||||
Janet *vmem = janet_malloc(s);
|
Janet *vmem = janet_malloc(s);
|
||||||
janet_vm.next_collection += (uint32_t) s;
|
janet_vm_next_collection += (uint32_t) s;
|
||||||
if (NULL == vmem) {
|
if (NULL == vmem) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -444,19 +442,16 @@ JanetFiberStatus janet_fiber_status(JanetFiber *f) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
JanetFiber *janet_current_fiber(void) {
|
JanetFiber *janet_current_fiber(void) {
|
||||||
return janet_vm.fiber;
|
return janet_vm_fiber;
|
||||||
}
|
}
|
||||||
|
|
||||||
JanetFiber *janet_root_fiber(void) {
|
JanetFiber *janet_root_fiber(void) {
|
||||||
return janet_vm.root_fiber;
|
return janet_vm_root_fiber;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* CFuns */
|
/* CFuns */
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_getenv,
|
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||||
"(fiber/getenv fiber)",
|
|
||||||
"Gets the environment for a fiber. Returns nil if no such table is "
|
|
||||||
"set yet.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
return fiber->env ?
|
return fiber->env ?
|
||||||
@@ -464,10 +459,7 @@ JANET_CORE_FN(cfun_fiber_getenv,
|
|||||||
janet_wrap_nil();
|
janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_setenv,
|
static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
|
||||||
"(fiber/setenv fiber table)",
|
|
||||||
"Sets the environment table for a fiber. Set to nil to remove the current "
|
|
||||||
"environment.") {
|
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
if (janet_checktype(argv[1], JANET_NIL)) {
|
if (janet_checktype(argv[1], JANET_NIL)) {
|
||||||
@@ -478,44 +470,15 @@ JANET_CORE_FN(cfun_fiber_setenv,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_new,
|
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||||
"(fiber/new func &opt sigmask env)",
|
janet_arity(argc, 1, 2);
|
||||||
"Create a new fiber with function body func. Can optionally "
|
|
||||||
"take a set of signals `sigmask` to capture from child fibers, "
|
|
||||||
"and an environment table `env`. The mask is specified as a keyword where each character "
|
|
||||||
"is used to indicate a signal to block. If the ev module is enabled, and "
|
|
||||||
"this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
|
|
||||||
"will result in messages being sent to the supervisor channel. "
|
|
||||||
"The default sigmask is :y. "
|
|
||||||
"For example,\n\n"
|
|
||||||
" (fiber/new myfun :e123)\n\n"
|
|
||||||
"blocks error signals and user signals 1, 2 and 3. The signals are "
|
|
||||||
"as follows:\n\n"
|
|
||||||
"* :a - block all signals\n"
|
|
||||||
"* :d - block debug signals\n"
|
|
||||||
"* :e - block error signals\n"
|
|
||||||
"* :t - block termination signals: error + user[0-4]\n"
|
|
||||||
"* :u - block user signals\n"
|
|
||||||
"* :y - block yield signals\n"
|
|
||||||
"* :w - block await signals (user9)\n"
|
|
||||||
"* :r - block interrupt signals (user8)\n"
|
|
||||||
"* :0-9 - block a specific user signal\n\n"
|
|
||||||
"The sigmask argument also can take environment flags. If any mutually "
|
|
||||||
"exclusive flags are present, the last flag takes precedence.\n\n"
|
|
||||||
"* :i - inherit the environment from the current fiber\n"
|
|
||||||
"* :p - the environment table's prototype is the current environment table") {
|
|
||||||
janet_arity(argc, 1, 3);
|
|
||||||
JanetFunction *func = janet_getfunction(argv, 0);
|
JanetFunction *func = janet_getfunction(argv, 0);
|
||||||
JanetFiber *fiber;
|
JanetFiber *fiber;
|
||||||
if (func->def->min_arity > 1) {
|
if (func->def->min_arity > 1) {
|
||||||
janet_panicf("fiber function must accept 0 or 1 arguments");
|
janet_panicf("fiber function must accept 0 or 1 arguments");
|
||||||
}
|
}
|
||||||
fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
|
fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
|
||||||
janet_assert(fiber != NULL, "bad fiber arity check");
|
if (argc == 2) {
|
||||||
if (argc == 3 && !janet_checktype(argv[2], JANET_NIL)) {
|
|
||||||
fiber->env = janet_gettable(argv, 2);
|
|
||||||
}
|
|
||||||
if (argc >= 2) {
|
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetByteView view = janet_getbytes(argv, 1);
|
JanetByteView view = janet_getbytes(argv, 1);
|
||||||
fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||||
@@ -526,7 +489,7 @@ JANET_CORE_FN(cfun_fiber_new,
|
|||||||
} else {
|
} else {
|
||||||
switch (view.bytes[i]) {
|
switch (view.bytes[i]) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, w, r, i, or p", view.bytes[i]);
|
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
|
||||||
break;
|
break;
|
||||||
case 'a':
|
case 'a':
|
||||||
fiber->flags |=
|
fiber->flags |=
|
||||||
@@ -556,24 +519,18 @@ JANET_CORE_FN(cfun_fiber_new,
|
|||||||
case 'y':
|
case 'y':
|
||||||
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
||||||
break;
|
break;
|
||||||
case 'w':
|
|
||||||
fiber->flags |= JANET_FIBER_MASK_USER9;
|
|
||||||
break;
|
|
||||||
case 'r':
|
|
||||||
fiber->flags |= JANET_FIBER_MASK_USER8;
|
|
||||||
break;
|
|
||||||
case 'i':
|
case 'i':
|
||||||
if (!janet_vm.fiber->env) {
|
if (!janet_vm_fiber->env) {
|
||||||
janet_vm.fiber->env = janet_table(0);
|
janet_vm_fiber->env = janet_table(0);
|
||||||
}
|
}
|
||||||
fiber->env = janet_vm.fiber->env;
|
fiber->env = janet_vm_fiber->env;
|
||||||
break;
|
break;
|
||||||
case 'p':
|
case 'p':
|
||||||
if (!janet_vm.fiber->env) {
|
if (!janet_vm_fiber->env) {
|
||||||
janet_vm.fiber->env = janet_table(0);
|
janet_vm_fiber->env = janet_table(0);
|
||||||
}
|
}
|
||||||
fiber->env = janet_table(0);
|
fiber->env = janet_table(0);
|
||||||
fiber->env->proto = janet_vm.fiber->env;
|
fiber->env->proto = janet_vm_fiber->env;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -582,55 +539,32 @@ JANET_CORE_FN(cfun_fiber_new,
|
|||||||
return janet_wrap_fiber(fiber);
|
return janet_wrap_fiber(fiber);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_status,
|
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
||||||
"(fiber/status fib)",
|
|
||||||
"Get the status of a fiber. The status will be one of:\n\n"
|
|
||||||
"* :dead - the fiber has finished\n"
|
|
||||||
"* :error - the fiber has errored out\n"
|
|
||||||
"* :debug - the fiber is suspended in debug mode\n"
|
|
||||||
"* :pending - the fiber has been yielded\n"
|
|
||||||
"* :user(0-7) - the fiber is suspended by a user signal\n"
|
|
||||||
"* :interrupted - the fiber was interrupted\n"
|
|
||||||
"* :suspended - the fiber is waiting to be resumed by the scheduler\n"
|
|
||||||
"* :alive - the fiber is currently running and cannot be resumed\n"
|
|
||||||
"* :new - the fiber has just been created and not yet run") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
uint32_t s = janet_fiber_status(fiber);
|
uint32_t s = janet_fiber_status(fiber);
|
||||||
return janet_ckeywordv(janet_status_names[s]);
|
return janet_ckeywordv(janet_status_names[s]);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_current,
|
static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
|
||||||
"(fiber/current)",
|
|
||||||
"Returns the currently running fiber.") {
|
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
return janet_wrap_fiber(janet_vm.fiber);
|
return janet_wrap_fiber(janet_vm_fiber);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_root,
|
static Janet cfun_fiber_root(int32_t argc, Janet *argv) {
|
||||||
"(fiber/root)",
|
|
||||||
"Returns the current root fiber. The root fiber is the oldest ancestor "
|
|
||||||
"that does not have a parent.") {
|
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
return janet_wrap_fiber(janet_vm.root_fiber);
|
return janet_wrap_fiber(janet_vm_root_fiber);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_maxstack,
|
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
|
||||||
"(fiber/maxstack fib)",
|
|
||||||
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
|
||||||
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
|
||||||
"than this amount and will throw a stack-overflow error if more memory is needed. ") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
return janet_wrap_integer(fiber->maxstack);
|
return janet_wrap_integer(fiber->maxstack);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_setmaxstack,
|
static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||||
"(fiber/setmaxstack fib maxstack)",
|
|
||||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
|
||||||
"maximum stack size is usually 8192.") {
|
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
int32_t maxs = janet_getinteger(argv, 1);
|
int32_t maxs = janet_getinteger(argv, 1);
|
||||||
@@ -641,7 +575,9 @@ JANET_CORE_FN(cfun_fiber_setmaxstack,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
int janet_fiber_can_resume(JanetFiber *fiber) {
|
static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
JanetFiberStatus s = janet_fiber_status(fiber);
|
JanetFiberStatus s = janet_fiber_status(fiber);
|
||||||
int isFinished = s == JANET_STATUS_DEAD ||
|
int isFinished = s == JANET_STATUS_DEAD ||
|
||||||
s == JANET_STATUS_ERROR ||
|
s == JANET_STATUS_ERROR ||
|
||||||
@@ -650,39 +586,104 @@ int janet_fiber_can_resume(JanetFiber *fiber) {
|
|||||||
s == JANET_STATUS_USER2 ||
|
s == JANET_STATUS_USER2 ||
|
||||||
s == JANET_STATUS_USER3 ||
|
s == JANET_STATUS_USER3 ||
|
||||||
s == JANET_STATUS_USER4;
|
s == JANET_STATUS_USER4;
|
||||||
return !isFinished;
|
return janet_wrap_boolean(!isFinished);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_can_resume,
|
static Janet cfun_fiber_last_value(int32_t argc, Janet *argv) {
|
||||||
"(fiber/can-resume? fiber)",
|
|
||||||
"Check if a fiber is finished and cannot be resumed.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
|
||||||
return janet_wrap_boolean(janet_fiber_can_resume(fiber));
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_last_value,
|
|
||||||
"(fiber/last-value 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);
|
||||||
return fiber->last_value;
|
return fiber->last_value;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg fiber_cfuns[] = {
|
||||||
|
{
|
||||||
|
"fiber/new", cfun_fiber_new,
|
||||||
|
JDOC("(fiber/new func &opt sigmask)\n\n"
|
||||||
|
"Create a new fiber with function body func. Can optionally "
|
||||||
|
"take a set of signals to block from the current parent fiber "
|
||||||
|
"when called. The mask is specified as a keyword where each character "
|
||||||
|
"is used to indicate a signal to block. If the ev module is enabled, and "
|
||||||
|
"this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
|
||||||
|
"will result in messages being sent to the supervisor channel. "
|
||||||
|
"The default sigmask is :y. "
|
||||||
|
"For example,\n\n"
|
||||||
|
" (fiber/new myfun :e123)\n\n"
|
||||||
|
"blocks error signals and user signals 1, 2 and 3. The signals are "
|
||||||
|
"as follows:\n\n"
|
||||||
|
"* :a - block all signals\n"
|
||||||
|
"* :d - block debug signals\n"
|
||||||
|
"* :e - block error signals\n"
|
||||||
|
"* :t - block termination signals: error + user[0-4]\n"
|
||||||
|
"* :u - block user signals\n"
|
||||||
|
"* :y - block yield signals\n"
|
||||||
|
"* :0-9 - block a specific user signal\n\n"
|
||||||
|
"The sigmask argument also can take environment flags. If any mutually "
|
||||||
|
"exclusive flags are present, the last flag takes precedence.\n\n"
|
||||||
|
"* :i - inherit the environment from the current fiber\n"
|
||||||
|
"* :p - the environment table's prototype is the current environment table")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/status", cfun_fiber_status,
|
||||||
|
JDOC("(fiber/status fib)\n\n"
|
||||||
|
"Get the status of a fiber. The status will be one of:\n\n"
|
||||||
|
"* :dead - the fiber has finished\n"
|
||||||
|
"* :error - the fiber has errored out\n"
|
||||||
|
"* :debug - the fiber is suspended in debug mode\n"
|
||||||
|
"* :pending - the fiber has been yielded\n"
|
||||||
|
"* :user(0-9) - the fiber is suspended by a user signal\n"
|
||||||
|
"* :alive - the fiber is currently running and cannot be resumed\n"
|
||||||
|
"* :new - the fiber has just been created and not yet run")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/root", cfun_fiber_root,
|
||||||
|
JDOC("(fiber/root)\n\n"
|
||||||
|
"Returns the current root fiber. The root fiber is the oldest ancestor "
|
||||||
|
"that does not have a parent.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/current", cfun_fiber_current,
|
||||||
|
JDOC("(fiber/current)\n\n"
|
||||||
|
"Returns the currently running fiber.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/maxstack", cfun_fiber_maxstack,
|
||||||
|
JDOC("(fiber/maxstack fib)\n\n"
|
||||||
|
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
||||||
|
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
||||||
|
"than this amount and will throw a stack-overflow error if more memory is needed. ")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/setmaxstack", cfun_fiber_setmaxstack,
|
||||||
|
JDOC("(fiber/setmaxstack fib maxstack)\n\n"
|
||||||
|
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||||
|
"maximum stack size is usually 8192.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/getenv", cfun_fiber_getenv,
|
||||||
|
JDOC("(fiber/getenv fiber)\n\n"
|
||||||
|
"Gets the environment for a fiber. Returns nil if no such table is "
|
||||||
|
"set yet.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/setenv", cfun_fiber_setenv,
|
||||||
|
JDOC("(fiber/setenv fiber table)\n\n"
|
||||||
|
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||||
|
"environment.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/can-resume?", cfun_fiber_can_resume,
|
||||||
|
JDOC("(fiber/can-resume? fiber)\n\n"
|
||||||
|
"Check if a fiber is finished and cannot be resumed.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"fiber/last-value", cfun_fiber_last_value,
|
||||||
|
JDOC("(fiber/last-value\n\n"
|
||||||
|
"Get the last value returned or signaled from the fiber.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_fiber(JanetTable *env) {
|
void janet_lib_fiber(JanetTable *env) {
|
||||||
JanetRegExt fiber_cfuns[] = {
|
janet_core_cfuns(env, NULL, fiber_cfuns);
|
||||||
JANET_CORE_REG("fiber/new", cfun_fiber_new),
|
|
||||||
JANET_CORE_REG("fiber/status", cfun_fiber_status),
|
|
||||||
JANET_CORE_REG("fiber/root", cfun_fiber_root),
|
|
||||||
JANET_CORE_REG("fiber/current", cfun_fiber_current),
|
|
||||||
JANET_CORE_REG("fiber/maxstack", cfun_fiber_maxstack),
|
|
||||||
JANET_CORE_REG("fiber/setmaxstack", cfun_fiber_setmaxstack),
|
|
||||||
JANET_CORE_REG("fiber/getenv", cfun_fiber_getenv),
|
|
||||||
JANET_CORE_REG("fiber/setenv", cfun_fiber_setenv),
|
|
||||||
JANET_CORE_REG("fiber/can-resume?", cfun_fiber_can_resume),
|
|
||||||
JANET_CORE_REG("fiber/last-value", cfun_fiber_last_value),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, fiber_cfuns);
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -47,6 +47,7 @@
|
|||||||
#define JANET_FIBER_MASK_USER 0x3FF0
|
#define JANET_FIBER_MASK_USER 0x3FF0
|
||||||
|
|
||||||
#define JANET_FIBER_STATUS_MASK 0x3F0000
|
#define JANET_FIBER_STATUS_MASK 0x3F0000
|
||||||
|
#define JANET_FIBER_FLAG_SCHEDULED 0x800000
|
||||||
#define JANET_FIBER_RESUME_SIGNAL 0x400000
|
#define JANET_FIBER_RESUME_SIGNAL 0x400000
|
||||||
#define JANET_FIBER_STATUS_OFFSET 16
|
#define JANET_FIBER_STATUS_OFFSET 16
|
||||||
|
|
||||||
@@ -56,12 +57,7 @@
|
|||||||
#define JANET_FIBER_DID_LONGJUMP 0x8000000
|
#define JANET_FIBER_DID_LONGJUMP 0x8000000
|
||||||
#define JANET_FIBER_FLAG_MASK 0xF000000
|
#define JANET_FIBER_FLAG_MASK 0xF000000
|
||||||
|
|
||||||
#define JANET_FIBER_EV_FLAG_CANCELED 0x10000
|
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||||
#define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
|
|
||||||
#define JANET_FIBER_FLAG_ROOT 0x40000
|
|
||||||
#define JANET_FIBER_EV_FLAG_IN_FLIGHT 0x1
|
|
||||||
|
|
||||||
/* used only on windows, should otherwise be unset */
|
|
||||||
|
|
||||||
#define janet_fiber_set_status(f, s) do {\
|
#define janet_fiber_set_status(f, s) do {\
|
||||||
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\
|
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\
|
||||||
|
|||||||
@@ -1,689 +0,0 @@
|
|||||||
/*
|
|
||||||
* Copyright (c) 2024 Calvin Rose
|
|
||||||
*
|
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
||||||
* of this software and associated documentation files (the "Software"), to
|
|
||||||
* deal in the Software without restriction, including without limitation the
|
|
||||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
|
||||||
* sell copies of the Software, and to permit persons to whom the Software is
|
|
||||||
* furnished to do so, subject to the following conditions:
|
|
||||||
*
|
|
||||||
* The above copyright notice and this permission notice shall be included in
|
|
||||||
* all copies or substantial portions of the Software.
|
|
||||||
*
|
|
||||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
||||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
||||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
||||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
||||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
|
||||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
|
||||||
* IN THE SOFTWARE.
|
|
||||||
*/
|
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
|
||||||
#include "features.h"
|
|
||||||
#include <janet.h>
|
|
||||||
#include "util.h"
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef JANET_EV
|
|
||||||
#ifdef JANET_FILEWATCH
|
|
||||||
|
|
||||||
#ifdef JANET_LINUX
|
|
||||||
#include <sys/inotify.h>
|
|
||||||
#include <unistd.h>
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
#include <windows.h>
|
|
||||||
#endif
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
const char *name;
|
|
||||||
uint32_t flag;
|
|
||||||
} JanetWatchFlagName;
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
#ifndef JANET_WINDOWS
|
|
||||||
JanetStream *stream;
|
|
||||||
#endif
|
|
||||||
JanetTable* watch_descriptors;
|
|
||||||
JanetChannel *channel;
|
|
||||||
uint32_t default_flags;
|
|
||||||
int is_watching;
|
|
||||||
} JanetWatcher;
|
|
||||||
|
|
||||||
#ifdef JANET_LINUX
|
|
||||||
|
|
||||||
#include <sys/inotify.h>
|
|
||||||
#include <unistd.h>
|
|
||||||
|
|
||||||
static const JanetWatchFlagName watcher_flags_linux[] = {
|
|
||||||
{"access", IN_ACCESS},
|
|
||||||
{"all", IN_ALL_EVENTS},
|
|
||||||
{"attrib", IN_ATTRIB},
|
|
||||||
{"close-nowrite", IN_CLOSE_NOWRITE},
|
|
||||||
{"close-write", IN_CLOSE_WRITE},
|
|
||||||
{"create", IN_CREATE},
|
|
||||||
{"delete", IN_DELETE},
|
|
||||||
{"delete-self", IN_DELETE_SELF},
|
|
||||||
{"ignored", IN_IGNORED},
|
|
||||||
{"modify", IN_MODIFY},
|
|
||||||
{"move-self", IN_MOVE_SELF},
|
|
||||||
{"moved-from", IN_MOVED_FROM},
|
|
||||||
{"moved-to", IN_MOVED_TO},
|
|
||||||
{"open", IN_OPEN},
|
|
||||||
{"q-overflow", IN_Q_OVERFLOW},
|
|
||||||
{"unmount", IN_UNMOUNT},
|
|
||||||
};
|
|
||||||
|
|
||||||
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
|
|
||||||
uint32_t flags = 0;
|
|
||||||
for (int32_t i = 0; i < n; i++) {
|
|
||||||
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
|
|
||||||
janet_panicf("expected keyword, got %v", options[i]);
|
|
||||||
}
|
|
||||||
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
|
|
||||||
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_linux,
|
|
||||||
sizeof(watcher_flags_linux) / sizeof(JanetWatchFlagName),
|
|
||||||
sizeof(JanetWatchFlagName),
|
|
||||||
keyw);
|
|
||||||
if (!result) {
|
|
||||||
janet_panicf("unknown inotify flag %v", options[i]);
|
|
||||||
}
|
|
||||||
flags |= result->flag;
|
|
||||||
}
|
|
||||||
return flags;
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
|
|
||||||
int fd;
|
|
||||||
do {
|
|
||||||
fd = inotify_init1(IN_NONBLOCK | IN_CLOEXEC);
|
|
||||||
} while (fd == -1 && errno == EINTR);
|
|
||||||
if (fd == -1) {
|
|
||||||
janet_panicv(janet_ev_lasterr());
|
|
||||||
}
|
|
||||||
watcher->watch_descriptors = janet_table(0);
|
|
||||||
watcher->channel = channel;
|
|
||||||
watcher->default_flags = default_flags;
|
|
||||||
watcher->is_watching = 0;
|
|
||||||
watcher->stream = janet_stream(fd, JANET_STREAM_READABLE, NULL);
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
|
|
||||||
if (watcher->stream == NULL) janet_panic("watcher closed");
|
|
||||||
int result;
|
|
||||||
do {
|
|
||||||
result = inotify_add_watch(watcher->stream->handle, path, flags);
|
|
||||||
} while (result == -1 && errno == EINTR);
|
|
||||||
if (result == -1) {
|
|
||||||
janet_panicv(janet_ev_lasterr());
|
|
||||||
}
|
|
||||||
Janet name = janet_cstringv(path);
|
|
||||||
Janet wd = janet_wrap_integer(result);
|
|
||||||
janet_table_put(watcher->watch_descriptors, name, wd);
|
|
||||||
janet_table_put(watcher->watch_descriptors, wd, name);
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
|
||||||
if (watcher->stream == NULL) janet_panic("watcher closed");
|
|
||||||
Janet check = janet_table_get(watcher->watch_descriptors, janet_cstringv(path));
|
|
||||||
janet_assert(janet_checktype(check, JANET_NUMBER), "bad watch descriptor");
|
|
||||||
int watch_handle = janet_unwrap_integer(check);
|
|
||||||
int result;
|
|
||||||
do {
|
|
||||||
result = inotify_rm_watch(watcher->stream->handle, watch_handle);
|
|
||||||
} while (result != -1 && errno == EINTR);
|
|
||||||
if (result == -1) {
|
|
||||||
janet_panicv(janet_ev_lasterr());
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
|
|
||||||
JanetStream *stream = fiber->ev_stream;
|
|
||||||
JanetWatcher *watcher = *((JanetWatcher **) fiber->ev_state);
|
|
||||||
char buf[1024];
|
|
||||||
switch (event) {
|
|
||||||
default:
|
|
||||||
break;
|
|
||||||
case JANET_ASYNC_EVENT_MARK:
|
|
||||||
janet_mark(janet_wrap_abstract(watcher));
|
|
||||||
break;
|
|
||||||
case JANET_ASYNC_EVENT_CLOSE:
|
|
||||||
janet_schedule(fiber, janet_wrap_nil());
|
|
||||||
janet_async_end(fiber);
|
|
||||||
break;
|
|
||||||
case JANET_ASYNC_EVENT_ERR:
|
|
||||||
{
|
|
||||||
janet_schedule(fiber, janet_wrap_nil());
|
|
||||||
janet_async_end(fiber);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
read_more:
|
|
||||||
case JANET_ASYNC_EVENT_HUP:
|
|
||||||
case JANET_ASYNC_EVENT_INIT:
|
|
||||||
case JANET_ASYNC_EVENT_READ:
|
|
||||||
{
|
|
||||||
Janet name = janet_wrap_nil();
|
|
||||||
|
|
||||||
/* Assumption - read will never return partial events *
|
|
||||||
* From documentation:
|
|
||||||
*
|
|
||||||
* The behavior when the buffer given to read(2) is too small to
|
|
||||||
* return information about the next event depends on the kernel
|
|
||||||
* version: before Linux 2.6.21, read(2) returns 0; since Linux
|
|
||||||
* 2.6.21, read(2) fails with the error EINVAL. Specifying a buffer
|
|
||||||
* of size
|
|
||||||
*
|
|
||||||
* sizeof(struct inotify_event) + NAME_MAX + 1
|
|
||||||
*
|
|
||||||
* will be sufficient to read at least one event. */
|
|
||||||
ssize_t nread;
|
|
||||||
do {
|
|
||||||
nread = read(stream->handle, buf, sizeof(buf));
|
|
||||||
} while (nread == -1 && errno == EINTR);
|
|
||||||
|
|
||||||
/* Check for errors - special case errors that can just be waited on to fix */
|
|
||||||
if (nread == -1) {
|
|
||||||
if (errno == EAGAIN || errno == EWOULDBLOCK) {
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
janet_cancel(fiber, janet_ev_lasterr());
|
|
||||||
fiber->ev_state = NULL;
|
|
||||||
janet_async_end(fiber);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
if (nread < (ssize_t) sizeof(struct inotify_event)) break;
|
|
||||||
|
|
||||||
/* Iterate through all events read from the buffer */
|
|
||||||
char *cursor = buf;
|
|
||||||
while (cursor < buf + nread) {
|
|
||||||
struct inotify_event inevent;
|
|
||||||
memcpy(&inevent, cursor, sizeof(inevent));
|
|
||||||
cursor += sizeof(inevent);
|
|
||||||
/* Read path of inevent */
|
|
||||||
if (inevent.len) {
|
|
||||||
name = janet_cstringv(cursor);
|
|
||||||
cursor += inevent.len;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Got an event */
|
|
||||||
Janet path = janet_table_get(watcher->watch_descriptors, janet_wrap_integer(inevent.wd));
|
|
||||||
JanetKV *event = janet_struct_begin(6);
|
|
||||||
janet_struct_put(event, janet_ckeywordv("wd"), janet_wrap_integer(inevent.wd));
|
|
||||||
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
|
|
||||||
if (janet_checktype(name, JANET_NIL)) {
|
|
||||||
/* We were watching a file directly, so path is the full path. Split into dirname / basename */
|
|
||||||
JanetString spath = janet_unwrap_string(path);
|
|
||||||
const uint8_t *cursor = spath + janet_string_length(spath);
|
|
||||||
const uint8_t *cursor_end = cursor;
|
|
||||||
while (cursor > spath && cursor[0] != '/') {
|
|
||||||
cursor--;
|
|
||||||
}
|
|
||||||
if (cursor == spath) {
|
|
||||||
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
|
|
||||||
janet_struct_put(event, janet_ckeywordv("file-name"), name);
|
|
||||||
} else {
|
|
||||||
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath))));
|
|
||||||
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1))));
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
|
|
||||||
janet_struct_put(event, janet_ckeywordv("file-name"), name);
|
|
||||||
}
|
|
||||||
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_integer(inevent.cookie));
|
|
||||||
Janet etype = janet_ckeywordv("type");
|
|
||||||
const JanetWatchFlagName *wfn_end = watcher_flags_linux + sizeof(watcher_flags_linux) / sizeof(watcher_flags_linux[0]);
|
|
||||||
for (const JanetWatchFlagName *wfn = watcher_flags_linux; wfn < wfn_end; wfn++) {
|
|
||||||
if ((inevent.mask & wfn->flag) == wfn->flag) janet_struct_put(event, etype, janet_ckeywordv(wfn->name));
|
|
||||||
}
|
|
||||||
Janet eventv = janet_wrap_struct(janet_struct_end(event));
|
|
||||||
|
|
||||||
janet_channel_give(watcher->channel, eventv);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Read some more if possible */
|
|
||||||
goto read_more;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_listen(JanetWatcher *watcher) {
|
|
||||||
if (watcher->is_watching) janet_panic("already watching");
|
|
||||||
watcher->is_watching = 1;
|
|
||||||
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
|
|
||||||
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
|
|
||||||
JanetWatcher **state = janet_malloc(sizeof(JanetWatcher *)); /* Gross */
|
|
||||||
*state = watcher;
|
|
||||||
janet_async_start_fiber(fiber, watcher->stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, state);
|
|
||||||
janet_gcroot(janet_wrap_abstract(watcher));
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
|
||||||
if (!watcher->is_watching) return;
|
|
||||||
watcher->is_watching = 0;
|
|
||||||
janet_stream_close(watcher->stream);
|
|
||||||
janet_gcunroot(janet_wrap_abstract(watcher));
|
|
||||||
}
|
|
||||||
|
|
||||||
#elif JANET_WINDOWS
|
|
||||||
|
|
||||||
#define WATCHFLAG_RECURSIVE 0x100000u
|
|
||||||
|
|
||||||
static const JanetWatchFlagName watcher_flags_windows[] = {
|
|
||||||
{"all",
|
|
||||||
FILE_NOTIFY_CHANGE_ATTRIBUTES |
|
|
||||||
FILE_NOTIFY_CHANGE_CREATION |
|
|
||||||
FILE_NOTIFY_CHANGE_DIR_NAME |
|
|
||||||
FILE_NOTIFY_CHANGE_FILE_NAME |
|
|
||||||
FILE_NOTIFY_CHANGE_LAST_ACCESS |
|
|
||||||
FILE_NOTIFY_CHANGE_LAST_WRITE |
|
|
||||||
FILE_NOTIFY_CHANGE_SECURITY |
|
|
||||||
FILE_NOTIFY_CHANGE_SIZE |
|
|
||||||
WATCHFLAG_RECURSIVE},
|
|
||||||
{"attributes", FILE_NOTIFY_CHANGE_ATTRIBUTES},
|
|
||||||
{"creation", FILE_NOTIFY_CHANGE_CREATION},
|
|
||||||
{"dir-name", FILE_NOTIFY_CHANGE_DIR_NAME},
|
|
||||||
{"file-name", FILE_NOTIFY_CHANGE_FILE_NAME},
|
|
||||||
{"last-access", FILE_NOTIFY_CHANGE_LAST_ACCESS},
|
|
||||||
{"last-write", FILE_NOTIFY_CHANGE_LAST_WRITE},
|
|
||||||
{"recursive", WATCHFLAG_RECURSIVE},
|
|
||||||
{"security", FILE_NOTIFY_CHANGE_SECURITY},
|
|
||||||
{"size", FILE_NOTIFY_CHANGE_SIZE},
|
|
||||||
};
|
|
||||||
|
|
||||||
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
|
|
||||||
uint32_t flags = 0;
|
|
||||||
for (int32_t i = 0; i < n; i++) {
|
|
||||||
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
|
|
||||||
janet_panicf("expected keyword, got %v", options[i]);
|
|
||||||
}
|
|
||||||
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
|
|
||||||
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_windows,
|
|
||||||
sizeof(watcher_flags_windows) / sizeof(JanetWatchFlagName),
|
|
||||||
sizeof(JanetWatchFlagName),
|
|
||||||
keyw);
|
|
||||||
if (!result) {
|
|
||||||
janet_panicf("unknown windows filewatch flag %v", options[i]);
|
|
||||||
}
|
|
||||||
flags |= result->flag;
|
|
||||||
}
|
|
||||||
return flags;
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
|
|
||||||
watcher->watch_descriptors = janet_table(0);
|
|
||||||
watcher->channel = channel;
|
|
||||||
watcher->default_flags = default_flags;
|
|
||||||
watcher->is_watching = 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Since the file info padding includes embedded file names, we want to include more space for data.
|
|
||||||
* We also need to handle manually calculating changes if path names are too long, but ideally just avoid
|
|
||||||
* that scenario as much as possible */
|
|
||||||
#define FILE_INFO_PADDING (4096 * 4)
|
|
||||||
|
|
||||||
typedef struct {
|
|
||||||
OVERLAPPED overlapped;
|
|
||||||
JanetStream *stream;
|
|
||||||
JanetWatcher *watcher;
|
|
||||||
JanetFiber *fiber;
|
|
||||||
JanetString dir_path;
|
|
||||||
uint32_t flags;
|
|
||||||
uint64_t buf[FILE_INFO_PADDING / sizeof(uint64_t)]; /* Ensure alignment */
|
|
||||||
} OverlappedWatch;
|
|
||||||
|
|
||||||
#define NotifyChange FILE_NOTIFY_INFORMATION
|
|
||||||
|
|
||||||
static void read_dir_changes(OverlappedWatch *ow) {
|
|
||||||
BOOL result = ReadDirectoryChangesW(ow->stream->handle,
|
|
||||||
(NotifyChange *) ow->buf,
|
|
||||||
FILE_INFO_PADDING,
|
|
||||||
(ow->flags & WATCHFLAG_RECURSIVE) ? TRUE : FALSE,
|
|
||||||
ow->flags & ~WATCHFLAG_RECURSIVE,
|
|
||||||
NULL,
|
|
||||||
(OVERLAPPED *) ow,
|
|
||||||
NULL);
|
|
||||||
if (!result) {
|
|
||||||
janet_panicv(janet_ev_lasterr());
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static const char* watcher_actions_windows[] = {
|
|
||||||
"unknown",
|
|
||||||
"added",
|
|
||||||
"removed",
|
|
||||||
"modified",
|
|
||||||
"renamed-old",
|
|
||||||
"renamed-new",
|
|
||||||
};
|
|
||||||
|
|
||||||
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
|
|
||||||
OverlappedWatch *ow = (OverlappedWatch *) fiber->ev_state;
|
|
||||||
JanetWatcher *watcher = ow->watcher;
|
|
||||||
switch (event) {
|
|
||||||
default:
|
|
||||||
break;
|
|
||||||
case JANET_ASYNC_EVENT_INIT:
|
|
||||||
janet_async_in_flight(fiber);
|
|
||||||
break;
|
|
||||||
case JANET_ASYNC_EVENT_MARK:
|
|
||||||
janet_mark(janet_wrap_abstract(ow->stream));
|
|
||||||
janet_mark(janet_wrap_fiber(ow->fiber));
|
|
||||||
janet_mark(janet_wrap_abstract(watcher));
|
|
||||||
janet_mark(janet_wrap_string(ow->dir_path));
|
|
||||||
break;
|
|
||||||
case JANET_ASYNC_EVENT_CLOSE:
|
|
||||||
janet_table_remove(ow->watcher->watch_descriptors, janet_wrap_string(ow->dir_path));
|
|
||||||
break;
|
|
||||||
case JANET_ASYNC_EVENT_ERR:
|
|
||||||
case JANET_ASYNC_EVENT_FAILED:
|
|
||||||
janet_stream_close(ow->stream);
|
|
||||||
break;
|
|
||||||
case JANET_ASYNC_EVENT_COMPLETE:
|
|
||||||
{
|
|
||||||
if (!watcher->is_watching) {
|
|
||||||
janet_stream_close(ow->stream);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
|
|
||||||
NotifyChange *fni = (NotifyChange *) ow->buf;
|
|
||||||
|
|
||||||
while (1) {
|
|
||||||
/* Got an event */
|
|
||||||
|
|
||||||
/* Extract name */
|
|
||||||
Janet filename;
|
|
||||||
if (fni->FileNameLength) {
|
|
||||||
int32_t nbytes = (int32_t) WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), NULL, 0, NULL, NULL);
|
|
||||||
janet_assert(nbytes, "bad utf8 path");
|
|
||||||
uint8_t *into = janet_string_begin(nbytes);
|
|
||||||
WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), (char *) into, nbytes, NULL, NULL);
|
|
||||||
filename = janet_wrap_string(janet_string_end(into));
|
|
||||||
} else {
|
|
||||||
filename = janet_cstringv("");
|
|
||||||
}
|
|
||||||
|
|
||||||
JanetKV *event = janet_struct_begin(3);
|
|
||||||
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_actions_windows[fni->Action]));
|
|
||||||
janet_struct_put(event, janet_ckeywordv("file-name"), filename);
|
|
||||||
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(ow->dir_path));
|
|
||||||
Janet eventv = janet_wrap_struct(janet_struct_end(event));
|
|
||||||
|
|
||||||
janet_channel_give(watcher->channel, eventv);
|
|
||||||
|
|
||||||
/* Next event */
|
|
||||||
if (!fni->NextEntryOffset) break;
|
|
||||||
fni = (NotifyChange *) ((char *)fni + fni->NextEntryOffset);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Make another call to read directory changes */
|
|
||||||
read_dir_changes(ow);
|
|
||||||
janet_async_in_flight(fiber);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static void start_listening_ow(OverlappedWatch *ow) {
|
|
||||||
read_dir_changes(ow);
|
|
||||||
JanetStream *stream = ow->stream;
|
|
||||||
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
|
|
||||||
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
|
|
||||||
fiber->supervisor_channel = janet_root_fiber()->supervisor_channel;
|
|
||||||
ow->fiber = fiber;
|
|
||||||
janet_async_start_fiber(fiber, stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, ow);
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
|
|
||||||
HANDLE handle = CreateFileA(path,
|
|
||||||
FILE_LIST_DIRECTORY | GENERIC_READ,
|
|
||||||
FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
|
|
||||||
NULL,
|
|
||||||
OPEN_EXISTING,
|
|
||||||
FILE_FLAG_OVERLAPPED | FILE_FLAG_BACKUP_SEMANTICS,
|
|
||||||
NULL);
|
|
||||||
if (handle == INVALID_HANDLE_VALUE) {
|
|
||||||
janet_panicv(janet_ev_lasterr());
|
|
||||||
}
|
|
||||||
JanetStream *stream = janet_stream(handle, JANET_STREAM_READABLE, NULL);
|
|
||||||
OverlappedWatch *ow = janet_malloc(sizeof(OverlappedWatch));
|
|
||||||
memset(ow, 0, sizeof(OverlappedWatch));
|
|
||||||
ow->stream = stream;
|
|
||||||
ow->dir_path = janet_cstring(path);
|
|
||||||
ow->fiber = NULL;
|
|
||||||
Janet pathv = janet_wrap_string(ow->dir_path);
|
|
||||||
ow->flags = flags | watcher->default_flags;
|
|
||||||
ow->watcher = watcher;
|
|
||||||
ow->overlapped.hEvent = CreateEvent(NULL, FALSE, 0, NULL); /* Do we need this */
|
|
||||||
Janet streamv = janet_wrap_pointer(ow);
|
|
||||||
janet_table_put(watcher->watch_descriptors, pathv, streamv);
|
|
||||||
if (watcher->is_watching) {
|
|
||||||
start_listening_ow(ow);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
|
||||||
Janet pathv = janet_cstringv(path);
|
|
||||||
Janet streamv = janet_table_get(watcher->watch_descriptors, pathv);
|
|
||||||
if (janet_checktype(streamv, JANET_NIL)) {
|
|
||||||
janet_panicf("path %v is not being watched", pathv);
|
|
||||||
}
|
|
||||||
janet_table_remove(watcher->watch_descriptors, pathv);
|
|
||||||
OverlappedWatch *ow = janet_unwrap_pointer(streamv);
|
|
||||||
janet_stream_close(ow->stream);
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_listen(JanetWatcher *watcher) {
|
|
||||||
if (watcher->is_watching) janet_panic("already watching");
|
|
||||||
watcher->is_watching = 1;
|
|
||||||
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
|
|
||||||
const JanetKV *kv = watcher->watch_descriptors->data + i;
|
|
||||||
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
|
|
||||||
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
|
|
||||||
start_listening_ow(ow);
|
|
||||||
}
|
|
||||||
janet_gcroot(janet_wrap_abstract(watcher));
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
|
||||||
if (!watcher->is_watching) return;
|
|
||||||
watcher->is_watching = 0;
|
|
||||||
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
|
|
||||||
const JanetKV *kv = watcher->watch_descriptors->data + i;
|
|
||||||
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
|
|
||||||
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
|
|
||||||
janet_stream_close(ow->stream);
|
|
||||||
}
|
|
||||||
janet_table_clear(watcher->watch_descriptors);
|
|
||||||
janet_gcunroot(janet_wrap_abstract(watcher));
|
|
||||||
}
|
|
||||||
|
|
||||||
#else
|
|
||||||
|
|
||||||
/* Default implementation */
|
|
||||||
|
|
||||||
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
|
|
||||||
(void) options;
|
|
||||||
(void) n;
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
|
|
||||||
(void) watcher;
|
|
||||||
(void) channel;
|
|
||||||
(void) default_flags;
|
|
||||||
janet_panic("filewatch not supported on this platform");
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
|
|
||||||
(void) watcher;
|
|
||||||
(void) flags;
|
|
||||||
(void) path;
|
|
||||||
janet_panic("nyi");
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
|
||||||
(void) watcher;
|
|
||||||
(void) path;
|
|
||||||
janet_panic("nyi");
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_listen(JanetWatcher *watcher) {
|
|
||||||
(void) watcher;
|
|
||||||
janet_panic("nyi");
|
|
||||||
}
|
|
||||||
|
|
||||||
static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
|
||||||
(void) watcher;
|
|
||||||
janet_panic("nyi");
|
|
||||||
}
|
|
||||||
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* C Functions */
|
|
||||||
|
|
||||||
static int janet_filewatch_mark(void *p, size_t s) {
|
|
||||||
JanetWatcher *watcher = (JanetWatcher *) p;
|
|
||||||
(void) s;
|
|
||||||
if (watcher->channel == NULL) return 0; /* Incomplete initialization */
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
|
|
||||||
const JanetKV *kv = watcher->watch_descriptors->data + i;
|
|
||||||
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
|
|
||||||
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
|
|
||||||
janet_mark(janet_wrap_fiber(ow->fiber));
|
|
||||||
janet_mark(janet_wrap_abstract(ow->stream));
|
|
||||||
janet_mark(janet_wrap_string(ow->dir_path));
|
|
||||||
}
|
|
||||||
#else
|
|
||||||
janet_mark(janet_wrap_abstract(watcher->stream));
|
|
||||||
#endif
|
|
||||||
janet_mark(janet_wrap_abstract(watcher->channel));
|
|
||||||
janet_mark(janet_wrap_table(watcher->watch_descriptors));
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
static const JanetAbstractType janet_filewatch_at = {
|
|
||||||
"filewatch/watcher",
|
|
||||||
NULL,
|
|
||||||
janet_filewatch_mark,
|
|
||||||
JANET_ATEND_GCMARK
|
|
||||||
};
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_filewatch_make,
|
|
||||||
"(filewatch/new channel &opt default-flags)",
|
|
||||||
"Create a new filewatcher that will give events to a channel channel. See `filewatch/add` for available flags.\n\n"
|
|
||||||
"When an event is triggered by the filewatcher, a struct containing information will be given to channel as with `ev/give`. "
|
|
||||||
"The contents of the channel depend on the OS, but will contain some common keys:\n\n"
|
|
||||||
"* `:type` -- the type of the event that was raised.\n\n"
|
|
||||||
"* `:file-name` -- the base file name of the file that triggered the event.\n\n"
|
|
||||||
"* `:dir-name` -- the directory name of the file that triggered the event.\n\n"
|
|
||||||
"Events also will contain keys specific to the host OS.\n\n"
|
|
||||||
"Windows has no extra properties on events.\n\n"
|
|
||||||
"Linux has the following extra properties on events:\n\n"
|
|
||||||
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n"
|
|
||||||
"* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
|
|
||||||
"* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
|
|
||||||
"") {
|
|
||||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
|
||||||
janet_arity(argc, 1, -1);
|
|
||||||
JanetChannel *channel = janet_getchannel(argv, 0);
|
|
||||||
JanetWatcher *watcher = janet_abstract(&janet_filewatch_at, sizeof(JanetWatcher));
|
|
||||||
uint32_t default_flags = decode_watch_flags(argv + 1, argc - 1);
|
|
||||||
janet_watcher_init(watcher, channel, default_flags);
|
|
||||||
return janet_wrap_abstract(watcher);
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_filewatch_add,
|
|
||||||
"(filewatch/add watcher path &opt flags)",
|
|
||||||
"Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
|
|
||||||
"Windows/MINGW (flags correspond to FILE_NOTIFY_CHANGE_* flags in win32 documentation):\n\n"
|
|
||||||
"* `:all` - trigger an event for all of the below triggers.\n\n"
|
|
||||||
"* `:attributes` - FILE_NOTIFY_CHANGE_ATTRIBUTES\n\n"
|
|
||||||
"* `:creation` - FILE_NOTIFY_CHANGE_CREATION\n\n"
|
|
||||||
"* `:dir-name` - FILE_NOTIFY_CHANGE_DIR_NAME\n\n"
|
|
||||||
"* `:last-access` - FILE_NOTIFY_CHANGE_LAST_ACCESS\n\n"
|
|
||||||
"* `:last-write` - FILE_NOTIFY_CHANGE_LAST_WRITE\n\n"
|
|
||||||
"* `:security` - FILE_NOTIFY_CHANGE_SECURITY\n\n"
|
|
||||||
"* `:size` - FILE_NOTIFY_CHANGE_SIZE\n\n"
|
|
||||||
"* `:recursive` - watch subdirectories recursively\n\n"
|
|
||||||
"Linux (flags correspond to IN_* flags from <sys/inotify.h>):\n\n"
|
|
||||||
"* `:access` - IN_ACCESS\n\n"
|
|
||||||
"* `:all` - IN_ALL_EVENTS\n\n"
|
|
||||||
"* `:attrib` - IN_ATTRIB\n\n"
|
|
||||||
"* `:close-nowrite` - IN_CLOSE_NOWRITE\n\n"
|
|
||||||
"* `:close-write` - IN_CLOSE_WRITE\n\n"
|
|
||||||
"* `:create` - IN_CREATE\n\n"
|
|
||||||
"* `:delete` - IN_DELETE\n\n"
|
|
||||||
"* `:delete-self` - IN_DELETE_SELF\n\n"
|
|
||||||
"* `:ignored` - IN_IGNORED\n\n"
|
|
||||||
"* `:modify` - IN_MODIFY\n\n"
|
|
||||||
"* `:move-self` - IN_MOVE_SELF\n\n"
|
|
||||||
"* `:moved-from` - IN_MOVED_FROM\n\n"
|
|
||||||
"* `:moved-to` - IN_MOVED_TO\n\n"
|
|
||||||
"* `:open` - IN_OPEN\n\n"
|
|
||||||
"* `:q-overflow` - IN_Q_OVERFLOW\n\n"
|
|
||||||
"* `:unmount` - IN_UNMOUNT\n\n\n"
|
|
||||||
"On Windows, events will have the following possible types:\n\n"
|
|
||||||
"* `:unknown`\n\n"
|
|
||||||
"* `:added`\n\n"
|
|
||||||
"* `:removed`\n\n"
|
|
||||||
"* `:modified`\n\n"
|
|
||||||
"* `:renamed-old`\n\n"
|
|
||||||
"* `:renamed-new`\n\n"
|
|
||||||
"On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n"
|
|
||||||
"") {
|
|
||||||
janet_arity(argc, 2, -1);
|
|
||||||
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
|
|
||||||
const char *path = janet_getcstring(argv, 1);
|
|
||||||
uint32_t flags = watcher->default_flags | decode_watch_flags(argv + 2, argc - 2);
|
|
||||||
janet_watcher_add(watcher, path, flags);
|
|
||||||
return argv[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_filewatch_remove,
|
|
||||||
"(filewatch/remove watcher path)",
|
|
||||||
"Remove a path from the watcher.") {
|
|
||||||
janet_fixarity(argc, 2);
|
|
||||||
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
|
|
||||||
const char *path = janet_getcstring(argv, 1);
|
|
||||||
janet_watcher_remove(watcher, path);
|
|
||||||
return argv[0];
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_filewatch_listen,
|
|
||||||
"(filewatch/listen watcher)",
|
|
||||||
"Listen for changes in the watcher.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
|
|
||||||
janet_watcher_listen(watcher);
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_filewatch_unlisten,
|
|
||||||
"(filewatch/unlisten watcher)",
|
|
||||||
"Stop listening for changes on a given watcher.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
|
|
||||||
janet_watcher_unlisten(watcher);
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Module entry point */
|
|
||||||
void janet_lib_filewatch(JanetTable *env) {
|
|
||||||
JanetRegExt cfuns[] = {
|
|
||||||
JANET_CORE_REG("filewatch/new", cfun_filewatch_make),
|
|
||||||
JANET_CORE_REG("filewatch/add", cfun_filewatch_add),
|
|
||||||
JANET_CORE_REG("filewatch/remove", cfun_filewatch_remove),
|
|
||||||
JANET_CORE_REG("filewatch/listen", cfun_filewatch_listen),
|
|
||||||
JANET_CORE_REG("filewatch/unlisten", cfun_filewatch_unlisten),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
|
||||||
}
|
|
||||||
|
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
362
src/core/gc.c
362
src/core/gc.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -31,6 +31,28 @@
|
|||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
struct JanetScratch {
|
||||||
|
JanetScratchFinalizer finalize;
|
||||||
|
long long mem[]; /* for proper alignment */
|
||||||
|
};
|
||||||
|
|
||||||
|
/* GC State */
|
||||||
|
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_vm_block_count;
|
||||||
|
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
|
||||||
|
|
||||||
|
/* Roots */
|
||||||
|
JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||||
|
|
||||||
|
/* Scratch Memory */
|
||||||
|
JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||||
|
JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||||
|
|
||||||
/* Helpers for marking the various gc types */
|
/* Helpers for marking the various gc types */
|
||||||
static void janet_mark_funcenv(JanetFuncEnv *env);
|
static void janet_mark_funcenv(JanetFuncEnv *env);
|
||||||
static void janet_mark_funcdef(JanetFuncDef *def);
|
static void janet_mark_funcdef(JanetFuncDef *def);
|
||||||
@@ -50,7 +72,7 @@ static JANET_THREAD_LOCAL size_t orig_rootcount;
|
|||||||
|
|
||||||
/* Hint to the GC that we may need to collect */
|
/* Hint to the GC that we may need to collect */
|
||||||
void janet_gcpressure(size_t s) {
|
void janet_gcpressure(size_t s) {
|
||||||
janet_vm.next_collection += s;
|
janet_vm_next_collection += s;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Mark a value */
|
/* Mark a value */
|
||||||
@@ -105,14 +127,6 @@ static void janet_mark_buffer(JanetBuffer *buffer) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_abstract(void *adata) {
|
static void janet_mark_abstract(void *adata) {
|
||||||
#ifdef JANET_EV
|
|
||||||
/* Check if abstract type is a threaded abstract type. If it is, marking means
|
|
||||||
* updating the threaded_abstract table. */
|
|
||||||
if ((janet_abstract_head(adata)->gc.flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_THREADED_ABSTRACT) {
|
|
||||||
janet_table_put(&janet_vm.threaded_abstracts, janet_wrap_abstract(adata), janet_wrap_true());
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
if (janet_gc_reachable(janet_abstract_head(adata)))
|
if (janet_gc_reachable(janet_abstract_head(adata)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_abstract_head(adata));
|
janet_gc_mark(janet_abstract_head(adata));
|
||||||
@@ -123,8 +137,6 @@ static void janet_mark_abstract(void *adata) {
|
|||||||
|
|
||||||
/* Mark a bunch of items in memory */
|
/* Mark a bunch of items in memory */
|
||||||
static void janet_mark_many(const Janet *values, int32_t n) {
|
static void janet_mark_many(const Janet *values, int32_t n) {
|
||||||
if (values == NULL)
|
|
||||||
return;
|
|
||||||
const Janet *end = values + n;
|
const Janet *end = values + n;
|
||||||
while (values < end) {
|
while (values < end) {
|
||||||
janet_mark(*values);
|
janet_mark(*values);
|
||||||
@@ -132,24 +144,6 @@ static void janet_mark_many(const Janet *values, int32_t n) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Mark a bunch of key values items in memory */
|
|
||||||
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
|
|
||||||
const JanetKV *end = kvs + n;
|
|
||||||
while (kvs < end) {
|
|
||||||
janet_mark(kvs->key);
|
|
||||||
kvs++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Mark a bunch of key values items in memory */
|
|
||||||
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
|
|
||||||
const JanetKV *end = kvs + n;
|
|
||||||
while (kvs < end) {
|
|
||||||
janet_mark(kvs->value);
|
|
||||||
kvs++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Mark a bunch of key values items in memory */
|
/* Mark a bunch of key values items in memory */
|
||||||
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
|
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
|
||||||
const JanetKV *end = kvs + n;
|
const JanetKV *end = kvs + n;
|
||||||
@@ -164,9 +158,7 @@ static void janet_mark_array(JanetArray *array) {
|
|||||||
if (janet_gc_reachable(array))
|
if (janet_gc_reachable(array))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(array);
|
janet_gc_mark(array);
|
||||||
if (janet_gc_type((JanetGCObject *) array) == JANET_MEMORY_ARRAY) {
|
|
||||||
janet_mark_many(array->data, array->count);
|
janet_mark_many(array->data, array->count);
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_table(JanetTable *table) {
|
static void janet_mark_table(JanetTable *table) {
|
||||||
@@ -174,15 +166,7 @@ recur: /* Manual tail recursion */
|
|||||||
if (janet_gc_reachable(table))
|
if (janet_gc_reachable(table))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(table);
|
janet_gc_mark(table);
|
||||||
enum JanetMemoryType memtype = janet_gc_type(table);
|
|
||||||
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
|
|
||||||
janet_mark_values(table->data, table->capacity);
|
|
||||||
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
|
|
||||||
janet_mark_keys(table->data, table->capacity);
|
|
||||||
} else if (memtype == JANET_MEMORY_TABLE) {
|
|
||||||
janet_mark_kvs(table->data, table->capacity);
|
janet_mark_kvs(table->data, table->capacity);
|
||||||
}
|
|
||||||
/* do nothing for JANET_MEMORY_TABLE_WEAKKV */
|
|
||||||
if (table->proto) {
|
if (table->proto) {
|
||||||
table = table->proto;
|
table = table->proto;
|
||||||
goto recur;
|
goto recur;
|
||||||
@@ -190,13 +174,10 @@ recur: /* Manual tail recursion */
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_struct(const JanetKV *st) {
|
static void janet_mark_struct(const JanetKV *st) {
|
||||||
recur:
|
|
||||||
if (janet_gc_reachable(janet_struct_head(st)))
|
if (janet_gc_reachable(janet_struct_head(st)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_struct_head(st));
|
janet_gc_mark(janet_struct_head(st));
|
||||||
janet_mark_kvs(st, janet_struct_capacity(st));
|
janet_mark_kvs(st, janet_struct_capacity(st));
|
||||||
st = janet_struct_proto(st);
|
|
||||||
if (st) goto recur;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_tuple(const Janet *tuple) {
|
static void janet_mark_tuple(const Janet *tuple) {
|
||||||
@@ -237,12 +218,6 @@ static void janet_mark_funcdef(JanetFuncDef *def) {
|
|||||||
janet_mark_string(def->source);
|
janet_mark_string(def->source);
|
||||||
if (def->name)
|
if (def->name)
|
||||||
janet_mark_string(def->name);
|
janet_mark_string(def->name);
|
||||||
if (def->symbolmap) {
|
|
||||||
for (int i = 0; i < def->symbolmap_length; i++) {
|
|
||||||
janet_mark_string(def->symbolmap[i].symbol);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_function(JanetFunction *func) {
|
static void janet_mark_function(JanetFunction *func) {
|
||||||
@@ -296,12 +271,6 @@ recur:
|
|||||||
if (fiber->supervisor_channel) {
|
if (fiber->supervisor_channel) {
|
||||||
janet_mark_abstract(fiber->supervisor_channel);
|
janet_mark_abstract(fiber->supervisor_channel);
|
||||||
}
|
}
|
||||||
if (fiber->ev_stream) {
|
|
||||||
janet_mark_abstract(fiber->ev_stream);
|
|
||||||
}
|
|
||||||
if (fiber->ev_callback) {
|
|
||||||
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_MARK);
|
|
||||||
}
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Explicit tail recursion */
|
/* Explicit tail recursion */
|
||||||
@@ -321,25 +290,13 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
|||||||
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_ARRAY:
|
case JANET_MEMORY_ARRAY:
|
||||||
case JANET_MEMORY_ARRAY_WEAK:
|
|
||||||
janet_free(((JanetArray *) mem)->data);
|
janet_free(((JanetArray *) mem)->data);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_TABLE:
|
case JANET_MEMORY_TABLE:
|
||||||
case JANET_MEMORY_TABLE_WEAKK:
|
|
||||||
case JANET_MEMORY_TABLE_WEAKV:
|
|
||||||
case JANET_MEMORY_TABLE_WEAKKV:
|
|
||||||
janet_free(((JanetTable *) mem)->data);
|
janet_free(((JanetTable *) mem)->data);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FIBER: {
|
case JANET_MEMORY_FIBER:
|
||||||
JanetFiber *f = (JanetFiber *)mem;
|
janet_free(((JanetFiber *)mem)->data);
|
||||||
#ifdef JANET_EV
|
|
||||||
if (f->ev_state && !(f->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
|
|
||||||
janet_ev_dec_refcount();
|
|
||||||
janet_free(f->ev_state);
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
janet_free(f->data);
|
|
||||||
}
|
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_BUFFER:
|
case JANET_MEMORY_BUFFER:
|
||||||
janet_buffer_deinit((JanetBuffer *) mem);
|
janet_buffer_deinit((JanetBuffer *) mem);
|
||||||
@@ -366,159 +323,34 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
|||||||
janet_free(def->bytecode);
|
janet_free(def->bytecode);
|
||||||
janet_free(def->sourcemap);
|
janet_free(def->sourcemap);
|
||||||
janet_free(def->closure_bitset);
|
janet_free(def->closure_bitset);
|
||||||
janet_free(def->symbolmap);
|
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Check that a value x has been visited in the mark phase */
|
|
||||||
static int janet_check_liveref(Janet x) {
|
|
||||||
switch (janet_type(x)) {
|
|
||||||
default:
|
|
||||||
return 1;
|
|
||||||
case JANET_ARRAY:
|
|
||||||
case JANET_TABLE:
|
|
||||||
case JANET_FUNCTION:
|
|
||||||
case JANET_BUFFER:
|
|
||||||
case JANET_FIBER:
|
|
||||||
return janet_gc_reachable(janet_unwrap_pointer(x));
|
|
||||||
case JANET_STRING:
|
|
||||||
case JANET_SYMBOL:
|
|
||||||
case JANET_KEYWORD:
|
|
||||||
return janet_gc_reachable(janet_string_head(janet_unwrap_string(x)));
|
|
||||||
case JANET_ABSTRACT:
|
|
||||||
return janet_gc_reachable(janet_abstract_head(janet_unwrap_abstract(x)));
|
|
||||||
case JANET_TUPLE:
|
|
||||||
return janet_gc_reachable(janet_tuple_head(janet_unwrap_tuple(x)));
|
|
||||||
case JANET_STRUCT:
|
|
||||||
return janet_gc_reachable(janet_struct_head(janet_unwrap_struct(x)));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Iterate over all allocated memory, and free memory that is not
|
/* Iterate over all allocated memory, and free memory that is not
|
||||||
* marked as reachable. Flip the gc color flag for next sweep. */
|
* marked as reachable. Flip the gc color flag for next sweep. */
|
||||||
void janet_sweep() {
|
void janet_sweep() {
|
||||||
JanetGCObject *previous = NULL;
|
JanetGCObject *previous = NULL;
|
||||||
JanetGCObject *current = janet_vm.weak_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
JanetGCObject *next;
|
JanetGCObject *next;
|
||||||
|
|
||||||
/* Sweep weak heap to drop weak refs */
|
|
||||||
while (NULL != current) {
|
while (NULL != current) {
|
||||||
next = current->data.next;
|
next = current->next;
|
||||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
|
||||||
/* Check for dead references */
|
|
||||||
enum JanetMemoryType type = janet_gc_type(current);
|
|
||||||
if (type == JANET_MEMORY_ARRAY_WEAK) {
|
|
||||||
JanetArray *array = (JanetArray *) current;
|
|
||||||
for (uint32_t i = 0; i < (uint32_t) array->count; i++) {
|
|
||||||
if (!janet_check_liveref(array->data[i])) {
|
|
||||||
array->data[i] = janet_wrap_nil();
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
JanetTable *table = (JanetTable *) current;
|
|
||||||
int check_values = (type == JANET_MEMORY_TABLE_WEAKV) || (type == JANET_MEMORY_TABLE_WEAKKV);
|
|
||||||
int check_keys = (type == JANET_MEMORY_TABLE_WEAKK) || (type == JANET_MEMORY_TABLE_WEAKKV);
|
|
||||||
JanetKV *end = table->data + table->capacity;
|
|
||||||
JanetKV *kvs = table->data;
|
|
||||||
while (kvs < end) {
|
|
||||||
int drop = 0;
|
|
||||||
if (check_keys && !janet_check_liveref(kvs->key)) drop = 1;
|
|
||||||
if (check_values && !janet_check_liveref(kvs->value)) drop = 1;
|
|
||||||
if (drop) {
|
|
||||||
/* Inlined from janet_table_remove without search */
|
|
||||||
table->count--;
|
|
||||||
table->deleted++;
|
|
||||||
kvs->key = janet_wrap_nil();
|
|
||||||
kvs->value = janet_wrap_false();
|
|
||||||
}
|
|
||||||
kvs++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
current = next;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Sweep weak heap to free blocks */
|
|
||||||
previous = NULL;
|
|
||||||
current = janet_vm.weak_blocks;
|
|
||||||
while (NULL != current) {
|
|
||||||
next = current->data.next;
|
|
||||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||||
previous = current;
|
previous = current;
|
||||||
current->flags &= ~JANET_MEM_REACHABLE;
|
current->flags &= ~JANET_MEM_REACHABLE;
|
||||||
} else {
|
} else {
|
||||||
janet_vm.block_count--;
|
janet_vm_block_count--;
|
||||||
janet_deinit_block(current);
|
janet_deinit_block(current);
|
||||||
if (NULL != previous) {
|
if (NULL != previous) {
|
||||||
previous->data.next = next;
|
previous->next = next;
|
||||||
} else {
|
} else {
|
||||||
janet_vm.weak_blocks = next;
|
janet_vm_blocks = next;
|
||||||
}
|
}
|
||||||
janet_free(current);
|
janet_free(current);
|
||||||
}
|
}
|
||||||
current = next;
|
current = next;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Sweep main heap to free blocks */
|
|
||||||
previous = NULL;
|
|
||||||
current = janet_vm.blocks;
|
|
||||||
while (NULL != current) {
|
|
||||||
next = current->data.next;
|
|
||||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
|
||||||
previous = current;
|
|
||||||
current->flags &= ~JANET_MEM_REACHABLE;
|
|
||||||
} else {
|
|
||||||
janet_vm.block_count--;
|
|
||||||
janet_deinit_block(current);
|
|
||||||
if (NULL != previous) {
|
|
||||||
previous->data.next = next;
|
|
||||||
} else {
|
|
||||||
janet_vm.blocks = next;
|
|
||||||
}
|
|
||||||
janet_free(current);
|
|
||||||
}
|
|
||||||
current = next;
|
|
||||||
}
|
|
||||||
|
|
||||||
#ifdef JANET_EV
|
|
||||||
/* Sweep threaded abstract types for references to decrement */
|
|
||||||
JanetKV *items = janet_vm.threaded_abstracts.data;
|
|
||||||
for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
|
|
||||||
if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
|
|
||||||
|
|
||||||
/* If item was not visited during the mark phase, then this
|
|
||||||
* abstract type isn't present in the heap and needs its refcount
|
|
||||||
* decremented, and shouuld be removed from table. If the refcount is
|
|
||||||
* then 0, the item will be collected. This ensures that only one interpreter
|
|
||||||
* will clean up the threaded abstract. */
|
|
||||||
|
|
||||||
/* If not visited... */
|
|
||||||
if (!janet_truthy(items[i].value)) {
|
|
||||||
void *abst = janet_unwrap_abstract(items[i].key);
|
|
||||||
if (0 == janet_abstract_decref(abst)) {
|
|
||||||
/* Run finalizer */
|
|
||||||
JanetAbstractHead *head = janet_abstract_head(abst);
|
|
||||||
if (head->type->gc) {
|
|
||||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
|
||||||
}
|
|
||||||
/* Free memory */
|
|
||||||
janet_free(janet_abstract_head(abst));
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Mark as tombstone in place */
|
|
||||||
items[i].key = janet_wrap_nil();
|
|
||||||
items[i].value = janet_wrap_false();
|
|
||||||
janet_vm.threaded_abstracts.deleted++;
|
|
||||||
janet_vm.threaded_abstracts.count--;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Reset for next sweep */
|
|
||||||
items[i].value = janet_wrap_false();
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Allocate some memory that is tracked for garbage collection */
|
/* Allocate some memory that is tracked for garbage collection */
|
||||||
@@ -526,7 +358,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
|||||||
JanetGCObject *mem;
|
JanetGCObject *mem;
|
||||||
|
|
||||||
/* Make sure everything is inited */
|
/* Make sure everything is inited */
|
||||||
janet_assert(NULL != janet_vm.cache, "please initialize janet before use");
|
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
||||||
mem = janet_malloc(size);
|
mem = janet_malloc(size);
|
||||||
|
|
||||||
/* Check for bad malloc */
|
/* Check for bad malloc */
|
||||||
@@ -538,17 +370,10 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
|||||||
mem->flags = type;
|
mem->flags = type;
|
||||||
|
|
||||||
/* Prepend block to heap list */
|
/* Prepend block to heap list */
|
||||||
janet_vm.next_collection += size;
|
janet_vm_next_collection += size;
|
||||||
if (type < JANET_MEMORY_TABLE_WEAKK) {
|
mem->next = janet_vm_blocks;
|
||||||
/* normal heap */
|
janet_vm_blocks = mem;
|
||||||
mem->data.next = janet_vm.blocks;
|
janet_vm_block_count++;
|
||||||
janet_vm.blocks = mem;
|
|
||||||
} else {
|
|
||||||
/* weak heap */
|
|
||||||
mem->data.next = janet_vm.weak_blocks;
|
|
||||||
janet_vm.weak_blocks = mem;
|
|
||||||
}
|
|
||||||
janet_vm.block_count++;
|
|
||||||
|
|
||||||
return (void *)mem;
|
return (void *)mem;
|
||||||
}
|
}
|
||||||
@@ -562,10 +387,10 @@ static void free_one_scratch(JanetScratch *s) {
|
|||||||
|
|
||||||
/* Free all allocated scratch memory */
|
/* Free all allocated scratch memory */
|
||||||
static void janet_free_all_scratch(void) {
|
static void janet_free_all_scratch(void) {
|
||||||
for (size_t i = 0; i < janet_vm.scratch_len; i++) {
|
for (size_t i = 0; i < janet_scratch_len; i++) {
|
||||||
free_one_scratch(janet_vm.scratch_mem[i]);
|
free_one_scratch(janet_scratch_mem[i]);
|
||||||
}
|
}
|
||||||
janet_vm.scratch_len = 0;
|
janet_scratch_len = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static JanetScratch *janet_mem2scratch(void *mem) {
|
static JanetScratch *janet_mem2scratch(void *mem) {
|
||||||
@@ -576,31 +401,29 @@ static JanetScratch *janet_mem2scratch(void *mem) {
|
|||||||
/* Run garbage collection */
|
/* Run garbage collection */
|
||||||
void janet_collect(void) {
|
void janet_collect(void) {
|
||||||
uint32_t i;
|
uint32_t i;
|
||||||
if (janet_vm.gc_suspend) return;
|
if (janet_vm_gc_suspend) return;
|
||||||
depth = JANET_RECURSION_GUARD;
|
depth = JANET_RECURSION_GUARD;
|
||||||
janet_vm.gc_mark_phase = 1;
|
/* Try and prevent many major collections back to back.
|
||||||
/* Try to prevent many major collections back to back.
|
* A full collection will take O(janet_vm_block_count) time.
|
||||||
* A full collection will take O(janet_vm.block_count) time.
|
|
||||||
* If we have a large heap, make sure our interval is not too
|
* If we have a large heap, make sure our interval is not too
|
||||||
* small so we won't make many collections over it. This is just a
|
* small so we won't make many collections over it. This is just a
|
||||||
* heuristic for automatically changing the gc interval */
|
* heuristic for automatically changing the gc interval */
|
||||||
if (janet_vm.block_count * 8 > janet_vm.gc_interval) {
|
if (janet_vm_block_count * 8 > janet_vm_gc_interval) {
|
||||||
janet_vm.gc_interval = janet_vm.block_count * sizeof(JanetGCObject);
|
janet_vm_gc_interval = janet_vm_block_count * sizeof(JanetGCObject);
|
||||||
}
|
}
|
||||||
orig_rootcount = janet_vm.root_count;
|
orig_rootcount = janet_vm_root_count;
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
janet_ev_mark();
|
janet_ev_mark();
|
||||||
#endif
|
#endif
|
||||||
janet_mark_fiber(janet_vm.root_fiber);
|
janet_mark_fiber(janet_vm_root_fiber);
|
||||||
for (i = 0; i < orig_rootcount; i++)
|
for (i = 0; i < orig_rootcount; i++)
|
||||||
janet_mark(janet_vm.roots[i]);
|
janet_mark(janet_vm_roots[i]);
|
||||||
while (orig_rootcount < janet_vm.root_count) {
|
while (orig_rootcount < janet_vm_root_count) {
|
||||||
Janet x = janet_vm.roots[--janet_vm.root_count];
|
Janet x = janet_vm_roots[--janet_vm_root_count];
|
||||||
janet_mark(x);
|
janet_mark(x);
|
||||||
}
|
}
|
||||||
janet_vm.gc_mark_phase = 0;
|
|
||||||
janet_sweep();
|
janet_sweep();
|
||||||
janet_vm.next_collection = 0;
|
janet_vm_next_collection = 0;
|
||||||
janet_free_all_scratch();
|
janet_free_all_scratch();
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -608,17 +431,17 @@ void janet_collect(void) {
|
|||||||
* and all of its children. If gcroot is called on a value n times, unroot
|
* and all of its children. If gcroot is called on a value n times, unroot
|
||||||
* must also be called n times to remove it as a gc root. */
|
* must also be called n times to remove it as a gc root. */
|
||||||
void janet_gcroot(Janet root) {
|
void janet_gcroot(Janet root) {
|
||||||
size_t newcount = janet_vm.root_count + 1;
|
size_t newcount = janet_vm_root_count + 1;
|
||||||
if (newcount > janet_vm.root_capacity) {
|
if (newcount > janet_vm_root_capacity) {
|
||||||
size_t newcap = 2 * newcount;
|
size_t newcap = 2 * newcount;
|
||||||
janet_vm.roots = janet_realloc(janet_vm.roots, sizeof(Janet) * newcap);
|
janet_vm_roots = janet_realloc(janet_vm_roots, sizeof(Janet) * newcap);
|
||||||
if (NULL == janet_vm.roots) {
|
if (NULL == janet_vm_roots) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
janet_vm.root_capacity = newcap;
|
janet_vm_root_capacity = newcap;
|
||||||
}
|
}
|
||||||
janet_vm.roots[janet_vm.root_count] = root;
|
janet_vm_roots[janet_vm_root_count] = root;
|
||||||
janet_vm.root_count = newcount;
|
janet_vm_root_count = newcount;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Identity equality for GC purposes */
|
/* Identity equality for GC purposes */
|
||||||
@@ -639,11 +462,11 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
|||||||
/* Remove a root value from the GC. This allows the gc to potentially reclaim
|
/* Remove a root value from the GC. This allows the gc to potentially reclaim
|
||||||
* a value and all its children. */
|
* a value and all its children. */
|
||||||
int janet_gcunroot(Janet root) {
|
int janet_gcunroot(Janet root) {
|
||||||
Janet *vtop = janet_vm.roots + janet_vm.root_count;
|
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||||
/* Search from top to bottom as access is most likely LIFO */
|
/* Search from top to bottom as access is most likely LIFO */
|
||||||
for (Janet *v = janet_vm.roots; v < vtop; v++) {
|
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||||
if (janet_gc_idequals(root, *v)) {
|
if (janet_gc_idequals(root, *v)) {
|
||||||
*v = janet_vm.roots[--janet_vm.root_count];
|
*v = janet_vm_roots[--janet_vm_root_count];
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -652,12 +475,12 @@ int janet_gcunroot(Janet root) {
|
|||||||
|
|
||||||
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
||||||
int janet_gcunrootall(Janet root) {
|
int janet_gcunrootall(Janet root) {
|
||||||
Janet *vtop = janet_vm.roots + janet_vm.root_count;
|
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||||
int ret = 0;
|
int ret = 0;
|
||||||
/* Search from top to bottom as access is most likely LIFO */
|
/* Search from top to bottom as access is most likely LIFO */
|
||||||
for (Janet *v = janet_vm.roots; v < vtop; v++) {
|
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||||
if (janet_gc_idequals(root, *v)) {
|
if (janet_gc_idequals(root, *v)) {
|
||||||
*v = janet_vm.roots[--janet_vm.root_count];
|
*v = janet_vm_roots[--janet_vm_root_count];
|
||||||
vtop--;
|
vtop--;
|
||||||
ret = 1;
|
ret = 1;
|
||||||
}
|
}
|
||||||
@@ -667,44 +490,27 @@ int janet_gcunrootall(Janet root) {
|
|||||||
|
|
||||||
/* Free all allocated memory */
|
/* Free all allocated memory */
|
||||||
void janet_clear_memory(void) {
|
void janet_clear_memory(void) {
|
||||||
#ifdef JANET_EV
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
JanetKV *items = janet_vm.threaded_abstracts.data;
|
|
||||||
for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
|
|
||||||
if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
|
|
||||||
void *abst = janet_unwrap_abstract(items[i].key);
|
|
||||||
if (0 == janet_abstract_decref(abst)) {
|
|
||||||
JanetAbstractHead *head = janet_abstract_head(abst);
|
|
||||||
if (head->type->gc) {
|
|
||||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
|
||||||
}
|
|
||||||
janet_free(janet_abstract_head(abst));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
JanetGCObject *current = janet_vm.blocks;
|
|
||||||
while (NULL != current) {
|
while (NULL != current) {
|
||||||
janet_deinit_block(current);
|
janet_deinit_block(current);
|
||||||
JanetGCObject *next = current->data.next;
|
JanetGCObject *next = current->next;
|
||||||
janet_free(current);
|
janet_free(current);
|
||||||
current = next;
|
current = next;
|
||||||
}
|
}
|
||||||
janet_vm.blocks = NULL;
|
janet_vm_blocks = NULL;
|
||||||
janet_free_all_scratch();
|
janet_free_all_scratch();
|
||||||
janet_free(janet_vm.scratch_mem);
|
janet_free(janet_scratch_mem);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Primitives for suspending GC. */
|
/* Primitives for suspending GC. */
|
||||||
int janet_gclock(void) {
|
int janet_gclock(void) {
|
||||||
return janet_vm.gc_suspend++;
|
return janet_vm_gc_suspend++;
|
||||||
}
|
}
|
||||||
void janet_gcunlock(int handle) {
|
void janet_gcunlock(int handle) {
|
||||||
janet_vm.gc_suspend = handle;
|
janet_vm_gc_suspend = handle;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Scratch memory API
|
/* Scratch memory API */
|
||||||
* Scratch memory allocations do not need to be free (but optionally can be), and will be automatically cleaned
|
|
||||||
* up in the next call to janet_collect. */
|
|
||||||
|
|
||||||
void *janet_smalloc(size_t size) {
|
void *janet_smalloc(size_t size) {
|
||||||
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);
|
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);
|
||||||
@@ -712,16 +518,16 @@ void *janet_smalloc(size_t size) {
|
|||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
s->finalize = NULL;
|
s->finalize = NULL;
|
||||||
if (janet_vm.scratch_len == janet_vm.scratch_cap) {
|
if (janet_scratch_len == janet_scratch_cap) {
|
||||||
size_t newcap = 2 * janet_vm.scratch_cap + 2;
|
size_t newcap = 2 * janet_scratch_cap + 2;
|
||||||
JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_vm.scratch_mem, newcap * sizeof(JanetScratch));
|
JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
|
||||||
if (NULL == newmem) {
|
if (NULL == newmem) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
janet_vm.scratch_cap = newcap;
|
janet_scratch_cap = newcap;
|
||||||
janet_vm.scratch_mem = newmem;
|
janet_scratch_mem = newmem;
|
||||||
}
|
}
|
||||||
janet_vm.scratch_mem[janet_vm.scratch_len++] = s;
|
janet_scratch_mem[janet_scratch_len++] = s;
|
||||||
return (char *)(s->mem);
|
return (char *)(s->mem);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -738,14 +544,14 @@ void *janet_scalloc(size_t nmemb, size_t size) {
|
|||||||
void *janet_srealloc(void *mem, size_t size) {
|
void *janet_srealloc(void *mem, size_t size) {
|
||||||
if (NULL == mem) return janet_smalloc(size);
|
if (NULL == mem) return janet_smalloc(size);
|
||||||
JanetScratch *s = janet_mem2scratch(mem);
|
JanetScratch *s = janet_mem2scratch(mem);
|
||||||
if (janet_vm.scratch_len) {
|
if (janet_scratch_len) {
|
||||||
for (size_t i = janet_vm.scratch_len - 1; ; i--) {
|
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||||
if (janet_vm.scratch_mem[i] == s) {
|
if (janet_scratch_mem[i] == s) {
|
||||||
JanetScratch *news = janet_realloc(s, size + sizeof(JanetScratch));
|
JanetScratch *news = janet_realloc(s, size + sizeof(JanetScratch));
|
||||||
if (NULL == news) {
|
if (NULL == news) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
janet_vm.scratch_mem[i] = news;
|
janet_scratch_mem[i] = news;
|
||||||
return (char *)(news->mem);
|
return (char *)(news->mem);
|
||||||
}
|
}
|
||||||
if (i == 0) break;
|
if (i == 0) break;
|
||||||
@@ -762,10 +568,10 @@ void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
|
|||||||
void janet_sfree(void *mem) {
|
void janet_sfree(void *mem) {
|
||||||
if (NULL == mem) return;
|
if (NULL == mem) return;
|
||||||
JanetScratch *s = janet_mem2scratch(mem);
|
JanetScratch *s = janet_mem2scratch(mem);
|
||||||
if (janet_vm.scratch_len) {
|
if (janet_scratch_len) {
|
||||||
for (size_t i = janet_vm.scratch_len - 1; ; i--) {
|
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||||
if (janet_vm.scratch_mem[i] == s) {
|
if (janet_scratch_mem[i] == s) {
|
||||||
janet_vm.scratch_mem[i] = janet_vm.scratch_mem[--janet_vm.scratch_len];
|
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
|
||||||
free_one_scratch(s);
|
free_one_scratch(s);
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -55,16 +55,11 @@ enum JanetMemoryType {
|
|||||||
JANET_MEMORY_FUNCTION,
|
JANET_MEMORY_FUNCTION,
|
||||||
JANET_MEMORY_ABSTRACT,
|
JANET_MEMORY_ABSTRACT,
|
||||||
JANET_MEMORY_FUNCENV,
|
JANET_MEMORY_FUNCENV,
|
||||||
JANET_MEMORY_FUNCDEF,
|
JANET_MEMORY_FUNCDEF
|
||||||
JANET_MEMORY_THREADED_ABSTRACT,
|
|
||||||
JANET_MEMORY_TABLE_WEAKK,
|
|
||||||
JANET_MEMORY_TABLE_WEAKV,
|
|
||||||
JANET_MEMORY_TABLE_WEAKKV,
|
|
||||||
JANET_MEMORY_ARRAY_WEAK
|
|
||||||
};
|
};
|
||||||
|
|
||||||
/* To allocate collectable memory, one must call janet_alloc, initialize the memory,
|
/* To allocate collectable memory, one must calk janet_alloc, initialize the memory,
|
||||||
* and then call when janet_enablegc when it is initialized and reachable by the gc (on the JANET stack) */
|
* and then call when janet_enablegc when it is initailize and reachable by the gc (on the JANET stack) */
|
||||||
void *janet_gcalloc(enum JanetMemoryType type, size_t size);
|
void *janet_gcalloc(enum JanetMemoryType type, size_t size);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose & contributors
|
* Copyright (c) 2021 Calvin Rose & contributors
|
||||||
*
|
*
|
||||||
* 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
|
||||||
@@ -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];
|
||||||
snprintf(str, sizeof(str), "%" PRId64, *((int64_t *)p));
|
sprintf(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];
|
||||||
snprintf(str, sizeof(str), "%" PRIu64, *((uint64_t *)p));
|
sprintf(str, "%" PRIu64, *((uint64_t *)p));
|
||||||
janet_buffer_push_cstring(buffer, str);
|
janet_buffer_push_cstring(buffer, str);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -118,9 +118,10 @@ int64_t janet_unwrap_s64(Janet x) {
|
|||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
case JANET_NUMBER : {
|
case JANET_NUMBER : {
|
||||||
double d = janet_unwrap_number(x);
|
double dbl = janet_unwrap_number(x);
|
||||||
if (!janet_checkint64range(d)) break;
|
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||||
return (int64_t) d;
|
return (int64_t)dbl;
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
case JANET_STRING: {
|
case JANET_STRING: {
|
||||||
int64_t value;
|
int64_t value;
|
||||||
@@ -137,7 +138,7 @@ int64_t janet_unwrap_s64(Janet x) {
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
janet_panicf("can not convert %t %q to 64 bit signed integer", x, x);
|
janet_panicf("bad s64 initializer: %t", x);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -146,9 +147,12 @@ uint64_t janet_unwrap_u64(Janet x) {
|
|||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
case JANET_NUMBER : {
|
case JANET_NUMBER : {
|
||||||
double d = janet_unwrap_number(x);
|
double dbl = janet_unwrap_number(x);
|
||||||
if (!janet_checkuint64range(d)) break;
|
/* Allow negative values to be cast to "wrap around".
|
||||||
return (uint64_t) d;
|
* This let's addition and subtraction work as expected. */
|
||||||
|
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||||
|
return (uint64_t)dbl;
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
case JANET_STRING: {
|
case JANET_STRING: {
|
||||||
uint64_t value;
|
uint64_t value;
|
||||||
@@ -165,7 +169,7 @@ uint64_t janet_unwrap_u64(Janet x) {
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
janet_panicf("can not convert %t %q to a 64 bit unsigned integer", x, x);
|
janet_panicf("bad u64 initializer: %t", x);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -189,106 +193,16 @@ Janet janet_wrap_u64(uint64_t x) {
|
|||||||
return janet_wrap_abstract(box);
|
return janet_wrap_abstract(box);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_it_s64_new,
|
static Janet cfun_it_s64_new(int32_t argc, Janet *argv) {
|
||||||
"(int/s64 value)",
|
|
||||||
"Create a boxed signed 64 bit integer from a string value.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
|
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_it_u64_new,
|
static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||||
"(int/u64 value)",
|
|
||||||
"Create a boxed unsigned 64 bit integer from a string value.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_to_number,
|
|
||||||
"(int/to-number value)",
|
|
||||||
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
if (janet_type(argv[0]) == JANET_ABSTRACT) {
|
|
||||||
void *abst = janet_unwrap_abstract(argv[0]);
|
|
||||||
|
|
||||||
if (janet_abstract_type(abst) == &janet_s64_type) {
|
|
||||||
int64_t value = *((int64_t *)abst);
|
|
||||||
if (value > JANET_INTMAX_INT64) {
|
|
||||||
janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
|
|
||||||
}
|
|
||||||
if (value < -JANET_INTMAX_INT64) {
|
|
||||||
janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
|
|
||||||
}
|
|
||||||
return janet_wrap_number((double)value);
|
|
||||||
}
|
|
||||||
|
|
||||||
if (janet_abstract_type(abst) == &janet_u64_type) {
|
|
||||||
uint64_t value = *((uint64_t *)abst);
|
|
||||||
if (value > JANET_INTMAX_INT64) {
|
|
||||||
janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
|
|
||||||
}
|
|
||||||
|
|
||||||
return janet_wrap_number((double)value);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
janet_panicf("expected int/u64 or int/s64, got %q", argv[0]);
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_to_bytes,
|
|
||||||
"(int/to-bytes value &opt endianness buffer)",
|
|
||||||
"Write the bytes of an `int/s64` or `int/u64` into a buffer.\n"
|
|
||||||
"The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created.\n"
|
|
||||||
"Returns the modified buffer.\n"
|
|
||||||
"The `endianness` parameter indicates the byte order:\n"
|
|
||||||
"- `nil` (unset): system byte order\n"
|
|
||||||
"- `:le`: little-endian, least significant byte first\n"
|
|
||||||
"- `:be`: big-endian, most significant byte first\n") {
|
|
||||||
janet_arity(argc, 1, 3);
|
|
||||||
if (janet_is_int(argv[0]) == JANET_INT_NONE) {
|
|
||||||
janet_panicf("int/to-bytes: expected an int/s64 or int/u64, got %q", argv[0]);
|
|
||||||
}
|
|
||||||
|
|
||||||
int reverse = 0;
|
|
||||||
if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
|
|
||||||
JanetKeyword endianness_kw = janet_getkeyword(argv, 1);
|
|
||||||
if (!janet_cstrcmp(endianness_kw, "le")) {
|
|
||||||
#if JANET_BIG_ENDIAN
|
|
||||||
reverse = 1;
|
|
||||||
#endif
|
|
||||||
} else if (!janet_cstrcmp(endianness_kw, "be")) {
|
|
||||||
#if JANET_LITTLE_ENDIAN
|
|
||||||
reverse = 1;
|
|
||||||
#endif
|
|
||||||
} else {
|
|
||||||
janet_panicf("int/to-bytes: expected endianness :le, :be or nil, got %v", argv[1]);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
JanetBuffer *buffer = NULL;
|
|
||||||
if (argc > 2 && !janet_checktype(argv[2], JANET_NIL)) {
|
|
||||||
if (!janet_checktype(argv[2], JANET_BUFFER)) {
|
|
||||||
janet_panicf("int/to-bytes: expected buffer or nil, got %q", argv[2]);
|
|
||||||
}
|
|
||||||
|
|
||||||
buffer = janet_unwrap_buffer(argv[2]);
|
|
||||||
janet_buffer_extra(buffer, 8);
|
|
||||||
} else {
|
|
||||||
buffer = janet_buffer(8);
|
|
||||||
}
|
|
||||||
|
|
||||||
uint8_t *bytes = janet_unwrap_abstract(argv[0]);
|
|
||||||
if (reverse) {
|
|
||||||
for (int i = 0; i < 8; ++i) {
|
|
||||||
buffer->data[buffer->count + 7 - i] = bytes[i];
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
memcpy(buffer->data + buffer->count, bytes, 8);
|
|
||||||
}
|
|
||||||
buffer->count += 8;
|
|
||||||
|
|
||||||
return janet_wrap_buffer(buffer);
|
|
||||||
}
|
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* Code to support polymorphic comparison.
|
* Code to support polymorphic comparison.
|
||||||
* int/u64 and int/s64 support a "compare" method that allows
|
* int/u64 and int/s64 support a "compare" method that allows
|
||||||
@@ -303,8 +217,8 @@ static int compare_double_double(double x, double y) {
|
|||||||
|
|
||||||
static int compare_int64_double(int64_t x, double y) {
|
static int compare_int64_double(int64_t x, double y) {
|
||||||
if (isnan(y)) {
|
if (isnan(y)) {
|
||||||
return 0;
|
return 0; // clojure and python do this
|
||||||
} else if ((y > JANET_INTMIN_DOUBLE) && (y < JANET_INTMAX_DOUBLE)) {
|
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||||
double dx = (double) x;
|
double dx = (double) x;
|
||||||
return compare_double_double(dx, y);
|
return compare_double_double(dx, y);
|
||||||
} else if (y > ((double) INT64_MAX)) {
|
} else if (y > ((double) INT64_MAX)) {
|
||||||
@@ -319,10 +233,10 @@ static int compare_int64_double(int64_t x, double y) {
|
|||||||
|
|
||||||
static int compare_uint64_double(uint64_t x, double y) {
|
static int compare_uint64_double(uint64_t x, double y) {
|
||||||
if (isnan(y)) {
|
if (isnan(y)) {
|
||||||
return 0;
|
return 0; // clojure and python do this
|
||||||
} else if (y < 0) {
|
} else if (y < 0) {
|
||||||
return 1;
|
return 1;
|
||||||
} else if ((y >= 0) && (y < JANET_INTMAX_DOUBLE)) {
|
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||||
double dx = (double) x;
|
double dx = (double) x;
|
||||||
return compare_double_double(dx, y);
|
return compare_double_double(dx, y);
|
||||||
} else if (y > ((double) UINT64_MAX)) {
|
} else if (y > ((double) UINT64_MAX)) {
|
||||||
@@ -335,9 +249,8 @@ static int compare_uint64_double(uint64_t x, double y) {
|
|||||||
|
|
||||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
if (janet_is_int(argv[0]) != JANET_INT_S64) {
|
if (janet_is_int(argv[0]) != JANET_INT_S64)
|
||||||
janet_panic("compare method requires int/s64 as first argument");
|
janet_panic("compare method requires int/s64 as first argument");
|
||||||
}
|
|
||||||
int64_t x = janet_unwrap_s64(argv[0]);
|
int64_t x = janet_unwrap_s64(argv[0]);
|
||||||
switch (janet_type(argv[1])) {
|
switch (janet_type(argv[1])) {
|
||||||
default:
|
default:
|
||||||
@@ -352,6 +265,7 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
|||||||
int64_t y = *(int64_t *)abst;
|
int64_t y = *(int64_t *)abst;
|
||||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||||
} else if (janet_abstract_type(abst) == &janet_u64_type) {
|
} else if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||||
|
// comparing signed to unsigned -- be careful!
|
||||||
uint64_t y = *(uint64_t *)abst;
|
uint64_t y = *(uint64_t *)abst;
|
||||||
if (x < 0) {
|
if (x < 0) {
|
||||||
return janet_wrap_number(-1);
|
return janet_wrap_number(-1);
|
||||||
@@ -370,9 +284,8 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
|||||||
|
|
||||||
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
if (janet_is_int(argv[0]) != JANET_INT_U64) {
|
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
|
||||||
janet_panic("compare method requires int/u64 as first argument");
|
janet_panic("compare method requires int/u64 as first argument");
|
||||||
}
|
|
||||||
uint64_t x = janet_unwrap_u64(argv[0]);
|
uint64_t x = janet_unwrap_u64(argv[0]);
|
||||||
switch (janet_type(argv[1])) {
|
switch (janet_type(argv[1])) {
|
||||||
default:
|
default:
|
||||||
@@ -387,6 +300,7 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
|||||||
uint64_t y = *(uint64_t *)abst;
|
uint64_t y = *(uint64_t *)abst;
|
||||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||||
} else if (janet_abstract_type(abst) == &janet_s64_type) {
|
} else if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||||
|
// comparing unsigned to signed -- be careful!
|
||||||
int64_t y = *(int64_t *)abst;
|
int64_t y = *(int64_t *)abst;
|
||||||
if (y < 0) {
|
if (y < 0) {
|
||||||
return janet_wrap_number(1);
|
return janet_wrap_number(1);
|
||||||
@@ -403,52 +317,25 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
/*
|
|
||||||
* In C, signed arithmetic overflow is undefined behvior
|
|
||||||
* but unsigned arithmetic overflow is twos complement
|
|
||||||
*
|
|
||||||
* Reference:
|
|
||||||
* https://en.cppreference.com/w/cpp/language/ub
|
|
||||||
* http://blog.llvm.org/2011/05/what-every-c-programmer-should-know.html
|
|
||||||
*
|
|
||||||
* This means OPMETHOD & OPMETHODINVERT must always use
|
|
||||||
* unsigned arithmetic internally, regardless of the true type.
|
|
||||||
* This will not affect the end result (property of twos complement).
|
|
||||||
*/
|
|
||||||
#define OPMETHOD(T, type, name, oper) \
|
#define OPMETHOD(T, type, name, oper) \
|
||||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||||
janet_arity(argc, 2, -1); \
|
janet_arity(argc, 2, -1); \
|
||||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||||
*box = janet_unwrap_##type(argv[0]); \
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
for (int32_t i = 1; i < argc; i++) \
|
for (int32_t i = 1; i < argc; i++) \
|
||||||
/* This avoids undefined behavior. See above for why. */ \
|
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||||
*box = (T) ((uint64_t) (*box)) oper ((uint64_t) janet_unwrap_##type(argv[i])); \
|
|
||||||
return janet_wrap_abstract(box); \
|
return janet_wrap_abstract(box); \
|
||||||
} \
|
} \
|
||||||
|
|
||||||
#define OPMETHODINVERT(T, type, name, oper) \
|
#define OPMETHODINVERT(T, type, name, oper) \
|
||||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||||
janet_fixarity(argc, 2); \
|
janet_fixarity(argc, 2); \
|
||||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||||
*box = janet_unwrap_##type(argv[1]); \
|
*box = janet_unwrap_##type(argv[1]); \
|
||||||
/* This avoids undefined behavior. See above for why. */ \
|
*box oper##= janet_unwrap_##type(argv[0]); \
|
||||||
*box = (T) ((uint64_t) *box) oper ((uint64_t) janet_unwrap_##type(argv[0])); \
|
|
||||||
return janet_wrap_abstract(box); \
|
return janet_wrap_abstract(box); \
|
||||||
} \
|
} \
|
||||||
|
|
||||||
#define UNARYMETHOD(T, type, name, oper) \
|
|
||||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|
||||||
janet_fixarity(argc, 1); \
|
|
||||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
|
||||||
*box = oper(janet_unwrap_##type(argv[0])); \
|
|
||||||
return janet_wrap_abstract(box); \
|
|
||||||
} \
|
|
||||||
|
|
||||||
#define DIVZERO(name) DIVZERO_##name
|
|
||||||
#define DIVZERO_div janet_panic("division by zero")
|
|
||||||
#define DIVZERO_rem janet_panic("division by zero")
|
|
||||||
#define DIVZERO_mod return janet_wrap_abstract(box)
|
|
||||||
|
|
||||||
#define DIVMETHOD(T, type, name, oper) \
|
#define DIVMETHOD(T, type, name, oper) \
|
||||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||||
janet_arity(argc, 2, -1); \
|
janet_arity(argc, 2, -1); \
|
||||||
@@ -456,19 +343,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||||||
*box = janet_unwrap_##type(argv[0]); \
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
for (int32_t i = 1; i < argc; i++) { \
|
for (int32_t i = 1; i < argc; i++) { \
|
||||||
T value = janet_unwrap_##type(argv[i]); \
|
T value = janet_unwrap_##type(argv[i]); \
|
||||||
if (value == 0) DIVZERO(name); \
|
if (value == 0) janet_panic("division by zero"); \
|
||||||
*box oper##= value; \
|
*box oper##= value; \
|
||||||
} \
|
} \
|
||||||
return janet_wrap_abstract(box); \
|
return janet_wrap_abstract(box); \
|
||||||
} \
|
} \
|
||||||
|
|
||||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||||
janet_fixarity(argc, 2); \
|
janet_fixarity(argc, 2); \
|
||||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||||
*box = janet_unwrap_##type(argv[1]); \
|
*box = janet_unwrap_##type(argv[1]); \
|
||||||
T value = janet_unwrap_##type(argv[0]); \
|
T value = janet_unwrap_##type(argv[0]); \
|
||||||
if (value == 0) DIVZERO(name); \
|
if (value == 0) janet_panic("division by zero"); \
|
||||||
*box oper##= value; \
|
*box oper##= value; \
|
||||||
return janet_wrap_abstract(box); \
|
return janet_wrap_abstract(box); \
|
||||||
} \
|
} \
|
||||||
@@ -480,7 +367,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||||||
*box = janet_unwrap_##type(argv[0]); \
|
*box = janet_unwrap_##type(argv[0]); \
|
||||||
for (int32_t i = 1; i < argc; i++) { \
|
for (int32_t i = 1; i < argc; i++) { \
|
||||||
T value = janet_unwrap_##type(argv[i]); \
|
T value = janet_unwrap_##type(argv[i]); \
|
||||||
if (value == 0) DIVZERO(name); \
|
if (value == 0) janet_panic("division by zero"); \
|
||||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||||
*box oper##= value; \
|
*box oper##= value; \
|
||||||
} \
|
} \
|
||||||
@@ -488,95 +375,51 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||||||
} \
|
} \
|
||||||
|
|
||||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||||
janet_fixarity(argc, 2); \
|
janet_fixarity(argc, 2); \
|
||||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||||
*box = janet_unwrap_##type(argv[1]); \
|
*box = janet_unwrap_##type(argv[1]); \
|
||||||
T value = janet_unwrap_##type(argv[0]); \
|
T value = janet_unwrap_##type(argv[0]); \
|
||||||
if (value == 0) DIVZERO(name); \
|
if (value == 0) janet_panic("division by zero"); \
|
||||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||||
*box oper##= value; \
|
*box oper##= value; \
|
||||||
return janet_wrap_abstract(box); \
|
return janet_wrap_abstract(box); \
|
||||||
} \
|
} \
|
||||||
|
|
||||||
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
|
||||||
janet_fixarity(argc, 2);
|
|
||||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
|
||||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
|
||||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
|
||||||
if (op2 == 0) janet_panic("division by zero");
|
|
||||||
int64_t x = op1 / op2;
|
|
||||||
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
|
|
||||||
return janet_wrap_abstract(box);
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
|
||||||
janet_fixarity(argc, 2);
|
|
||||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
|
||||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
|
||||||
int64_t op1 = janet_unwrap_s64(argv[1]);
|
|
||||||
if (op2 == 0) janet_panic("division by zero");
|
|
||||||
int64_t x = op1 / op2;
|
|
||||||
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
|
|
||||||
return janet_wrap_abstract(box);
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||||
if (op2 == 0) {
|
|
||||||
*box = op1;
|
|
||||||
} else {
|
|
||||||
int64_t x = op1 % op2;
|
int64_t x = op1 % op2;
|
||||||
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
|
*box = (op1 > 0)
|
||||||
}
|
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||||
return janet_wrap_abstract(box);
|
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||||
}
|
|
||||||
|
|
||||||
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
|
||||||
janet_fixarity(argc, 2);
|
|
||||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
|
||||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
|
||||||
int64_t op1 = janet_unwrap_s64(argv[1]);
|
|
||||||
if (op2 == 0) {
|
|
||||||
*box = op1;
|
|
||||||
} else {
|
|
||||||
int64_t x = op1 % op2;
|
|
||||||
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
|
|
||||||
}
|
|
||||||
return janet_wrap_abstract(box);
|
return janet_wrap_abstract(box);
|
||||||
}
|
}
|
||||||
|
|
||||||
OPMETHOD(int64_t, s64, add, +)
|
OPMETHOD(int64_t, s64, add, +)
|
||||||
OPMETHOD(int64_t, s64, sub, -)
|
OPMETHOD(int64_t, s64, sub, -)
|
||||||
OPMETHODINVERT(int64_t, s64, sub, -)
|
OPMETHODINVERT(int64_t, s64, subi, -)
|
||||||
OPMETHOD(int64_t, s64, mul, *)
|
OPMETHOD(int64_t, s64, mul, *)
|
||||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||||
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
||||||
DIVMETHODINVERT_SIGNED(int64_t, s64, div, /)
|
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||||
DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %)
|
|
||||||
OPMETHOD(int64_t, s64, and, &)
|
OPMETHOD(int64_t, s64, and, &)
|
||||||
OPMETHOD(int64_t, s64, or, |)
|
OPMETHOD(int64_t, s64, or, |)
|
||||||
OPMETHOD(int64_t, s64, xor, ^)
|
OPMETHOD(int64_t, s64, xor, ^)
|
||||||
UNARYMETHOD(int64_t, s64, not, ~)
|
|
||||||
OPMETHOD(int64_t, s64, lshift, <<)
|
OPMETHOD(int64_t, s64, lshift, <<)
|
||||||
OPMETHOD(int64_t, s64, rshift, >>)
|
OPMETHOD(int64_t, s64, rshift, >>)
|
||||||
OPMETHOD(uint64_t, u64, add, +)
|
OPMETHOD(uint64_t, u64, add, +)
|
||||||
OPMETHOD(uint64_t, u64, sub, -)
|
OPMETHOD(uint64_t, u64, sub, -)
|
||||||
OPMETHODINVERT(uint64_t, u64, sub, -)
|
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||||
OPMETHOD(uint64_t, u64, mul, *)
|
OPMETHOD(uint64_t, u64, mul, *)
|
||||||
DIVMETHOD(uint64_t, u64, div, /)
|
DIVMETHOD(uint64_t, u64, div, /)
|
||||||
DIVMETHOD(uint64_t, u64, rem, %)
|
|
||||||
DIVMETHOD(uint64_t, u64, mod, %)
|
DIVMETHOD(uint64_t, u64, mod, %)
|
||||||
DIVMETHODINVERT(uint64_t, u64, div, /)
|
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||||
DIVMETHODINVERT(uint64_t, u64, rem, %)
|
|
||||||
DIVMETHODINVERT(uint64_t, u64, mod, %)
|
|
||||||
OPMETHOD(uint64_t, u64, and, &)
|
OPMETHOD(uint64_t, u64, and, &)
|
||||||
OPMETHOD(uint64_t, u64, or, |)
|
OPMETHOD(uint64_t, u64, or, |)
|
||||||
OPMETHOD(uint64_t, u64, xor, ^)
|
OPMETHOD(uint64_t, u64, xor, ^)
|
||||||
UNARYMETHOD(uint64_t, u64, not, ~)
|
|
||||||
OPMETHOD(uint64_t, u64, lshift, <<)
|
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||||
OPMETHOD(uint64_t, u64, rshift, >>)
|
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||||
|
|
||||||
@@ -585,6 +428,7 @@ OPMETHOD(uint64_t, u64, rshift, >>)
|
|||||||
#undef DIVMETHOD_SIGNED
|
#undef DIVMETHOD_SIGNED
|
||||||
#undef COMPMETHOD
|
#undef COMPMETHOD
|
||||||
|
|
||||||
|
|
||||||
static JanetMethod it_s64_methods[] = {
|
static JanetMethod it_s64_methods[] = {
|
||||||
{"+", cfun_it_s64_add},
|
{"+", cfun_it_s64_add},
|
||||||
{"r+", cfun_it_s64_add},
|
{"r+", cfun_it_s64_add},
|
||||||
@@ -594,22 +438,20 @@ static JanetMethod it_s64_methods[] = {
|
|||||||
{"r*", cfun_it_s64_mul},
|
{"r*", cfun_it_s64_mul},
|
||||||
{"/", cfun_it_s64_div},
|
{"/", cfun_it_s64_div},
|
||||||
{"r/", cfun_it_s64_divi},
|
{"r/", cfun_it_s64_divi},
|
||||||
{"div", cfun_it_s64_divf},
|
|
||||||
{"rdiv", cfun_it_s64_divfi},
|
|
||||||
{"mod", cfun_it_s64_mod},
|
{"mod", cfun_it_s64_mod},
|
||||||
{"rmod", cfun_it_s64_modi},
|
{"rmod", cfun_it_s64_mod},
|
||||||
{"%", cfun_it_s64_rem},
|
{"%", cfun_it_s64_rem},
|
||||||
{"r%", cfun_it_s64_remi},
|
{"r%", cfun_it_s64_rem},
|
||||||
{"&", cfun_it_s64_and},
|
{"&", cfun_it_s64_and},
|
||||||
{"r&", cfun_it_s64_and},
|
{"r&", cfun_it_s64_and},
|
||||||
{"|", cfun_it_s64_or},
|
{"|", cfun_it_s64_or},
|
||||||
{"r|", cfun_it_s64_or},
|
{"r|", cfun_it_s64_or},
|
||||||
{"^", cfun_it_s64_xor},
|
{"^", cfun_it_s64_xor},
|
||||||
{"r^", cfun_it_s64_xor},
|
{"r^", cfun_it_s64_xor},
|
||||||
{"~", cfun_it_s64_not},
|
|
||||||
{"<<", cfun_it_s64_lshift},
|
{"<<", cfun_it_s64_lshift},
|
||||||
{">>", cfun_it_s64_rshift},
|
{">>", cfun_it_s64_rshift},
|
||||||
{"compare", cfun_it_s64_compare},
|
{"compare", cfun_it_s64_compare},
|
||||||
|
|
||||||
{NULL, NULL}
|
{NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -622,22 +464,20 @@ static JanetMethod it_u64_methods[] = {
|
|||||||
{"r*", cfun_it_u64_mul},
|
{"r*", cfun_it_u64_mul},
|
||||||
{"/", cfun_it_u64_div},
|
{"/", cfun_it_u64_div},
|
||||||
{"r/", cfun_it_u64_divi},
|
{"r/", cfun_it_u64_divi},
|
||||||
{"div", cfun_it_u64_div},
|
|
||||||
{"rdiv", cfun_it_u64_divi},
|
|
||||||
{"mod", cfun_it_u64_mod},
|
{"mod", cfun_it_u64_mod},
|
||||||
{"rmod", cfun_it_u64_modi},
|
{"rmod", cfun_it_u64_mod},
|
||||||
{"%", cfun_it_u64_rem},
|
{"%", cfun_it_u64_mod},
|
||||||
{"r%", cfun_it_u64_remi},
|
{"r%", cfun_it_u64_mod},
|
||||||
{"&", cfun_it_u64_and},
|
{"&", cfun_it_u64_and},
|
||||||
{"r&", cfun_it_u64_and},
|
{"r&", cfun_it_u64_and},
|
||||||
{"|", cfun_it_u64_or},
|
{"|", cfun_it_u64_or},
|
||||||
{"r|", cfun_it_u64_or},
|
{"r|", cfun_it_u64_or},
|
||||||
{"^", cfun_it_u64_xor},
|
{"^", cfun_it_u64_xor},
|
||||||
{"r^", cfun_it_u64_xor},
|
{"r^", cfun_it_u64_xor},
|
||||||
{"~", cfun_it_u64_not},
|
|
||||||
{"<<", cfun_it_u64_lshift},
|
{"<<", cfun_it_u64_lshift},
|
||||||
{">>", cfun_it_u64_rshift},
|
{">>", cfun_it_u64_rshift},
|
||||||
{"compare", cfun_it_u64_compare},
|
{"compare", cfun_it_u64_compare},
|
||||||
|
|
||||||
{NULL, NULL}
|
{NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -665,16 +505,23 @@ static int it_u64_get(void *p, Janet key, Janet *out) {
|
|||||||
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods, out);
|
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods, out);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg it_cfuns[] = {
|
||||||
|
{
|
||||||
|
"int/s64", cfun_it_s64_new,
|
||||||
|
JDOC("(int/s64 value)\n\n"
|
||||||
|
"Create a boxed signed 64 bit integer from a string value.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"int/u64", cfun_it_u64_new,
|
||||||
|
JDOC("(int/u64 value)\n\n"
|
||||||
|
"Create a boxed unsigned 64 bit integer from a string value.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_inttypes(JanetTable *env) {
|
void janet_lib_inttypes(JanetTable *env) {
|
||||||
JanetRegExt it_cfuns[] = {
|
janet_core_cfuns(env, NULL, it_cfuns);
|
||||||
JANET_CORE_REG("int/s64", cfun_it_s64_new),
|
|
||||||
JANET_CORE_REG("int/u64", cfun_it_u64_new),
|
|
||||||
JANET_CORE_REG("int/to-number", cfun_to_number),
|
|
||||||
JANET_CORE_REG("int/to-bytes", cfun_to_bytes),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, it_cfuns);
|
|
||||||
janet_register_abstract_type(&janet_s64_type);
|
janet_register_abstract_type(&janet_s64_type);
|
||||||
janet_register_abstract_type(&janet_u64_type);
|
janet_register_abstract_type(&janet_u64_type);
|
||||||
}
|
}
|
||||||
|
|||||||
470
src/core/io.c
470
src/core/io.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -41,11 +41,6 @@ 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,
|
||||||
@@ -74,15 +69,12 @@ static int32_t checkflags(const uint8_t *str) {
|
|||||||
break;
|
break;
|
||||||
case 'w':
|
case 'w':
|
||||||
flags |= JANET_FILE_WRITE;
|
flags |= JANET_FILE_WRITE;
|
||||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
|
||||||
break;
|
break;
|
||||||
case 'a':
|
case 'a':
|
||||||
flags |= JANET_FILE_APPEND;
|
flags |= JANET_FILE_APPEND;
|
||||||
janet_sandbox_assert(JANET_SANDBOX_FS);
|
|
||||||
break;
|
break;
|
||||||
case 'r':
|
case 'r':
|
||||||
flags |= JANET_FILE_READ;
|
flags |= JANET_FILE_READ;
|
||||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
for (i = 1; i < len; i++) {
|
for (i = 1; i < len; i++) {
|
||||||
@@ -92,7 +84,6 @@ static int32_t checkflags(const uint8_t *str) {
|
|||||||
break;
|
break;
|
||||||
case '+':
|
case '+':
|
||||||
if (flags & JANET_FILE_UPDATE) return -1;
|
if (flags & JANET_FILE_UPDATE) return -1;
|
||||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
|
||||||
flags |= JANET_FILE_UPDATE;
|
flags |= JANET_FILE_UPDATE;
|
||||||
break;
|
break;
|
||||||
case 'b':
|
case 'b':
|
||||||
@@ -121,36 +112,49 @@ static void *makef(FILE *f, int32_t flags) {
|
|||||||
return iof;
|
return iof;
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_temp,
|
/* Open a process */
|
||||||
"(file/temp)",
|
#ifndef JANET_NO_PROCESSES
|
||||||
"Open an anonymous temporary file that is removed on close. "
|
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||||
"Raises an error on failure.") {
|
janet_arity(argc, 1, 2);
|
||||||
janet_sandbox_assert(JANET_SANDBOX_FS_TEMP);
|
const uint8_t *fname = janet_getstring(argv, 0);
|
||||||
|
const uint8_t *fmode = NULL;
|
||||||
|
int32_t flags;
|
||||||
|
if (argc == 2) {
|
||||||
|
fmode = janet_getkeyword(argv, 1);
|
||||||
|
flags = JANET_FILE_PIPED | checkflags(fmode);
|
||||||
|
if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) {
|
||||||
|
janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode);
|
||||||
|
}
|
||||||
|
fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w");
|
||||||
|
} else {
|
||||||
|
fmode = (const uint8_t *)"r";
|
||||||
|
flags = JANET_FILE_PIPED | JANET_FILE_READ;
|
||||||
|
}
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
#define popen _popen
|
||||||
|
#endif
|
||||||
|
FILE *f = popen((const char *)fname, (const char *)fmode);
|
||||||
|
if (!f) {
|
||||||
|
if (flags & JANET_FILE_NONIL)
|
||||||
|
janet_panicf("failed to popen %s: %s", fname, strerror(errno));
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
return janet_makefile(f, flags);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
|
||||||
(void)argv;
|
(void)argv;
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
// 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", janet_strerror(errno));
|
janet_panicf("unable to create temporary file - %s", strerror(errno));
|
||||||
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
|
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_fopen,
|
static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||||
"(file/open path &opt mode buffer-size)",
|
janet_arity(argc, 1, 2);
|
||||||
"Open a file. `path` is an absolute or relative path, and "
|
|
||||||
"`mode` is a set of flags indicating the mode to open the file in. "
|
|
||||||
"`mode` is a keyword where each character represents a flag. If the file "
|
|
||||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
|
||||||
"Mode flags:\n\n"
|
|
||||||
"* r - allow reading from the file\n\n"
|
|
||||||
"* w - allow writing to the file\n\n"
|
|
||||||
"* a - append to the file\n\n"
|
|
||||||
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
|
|
||||||
"* b - open the file in binary mode (rather than text mode)\n\n"
|
|
||||||
"* + - append to the file instead of overwriting it\n\n"
|
|
||||||
"* n - error if the file cannot be opened instead of returning nil\n\n"
|
|
||||||
"See fopen (<stdio.h>, C99) for further details.") {
|
|
||||||
janet_arity(argc, 1, 3);
|
|
||||||
const uint8_t *fname = janet_getstring(argv, 0);
|
const uint8_t *fname = janet_getstring(argv, 0);
|
||||||
const uint8_t *fmode;
|
const uint8_t *fmode;
|
||||||
int32_t flags;
|
int32_t flags;
|
||||||
@@ -159,21 +163,11 @@ JANET_CORE_FN(cfun_io_fopen,
|
|||||||
flags = checkflags(fmode);
|
flags = checkflags(fmode);
|
||||||
} else {
|
} else {
|
||||||
fmode = (const uint8_t *)"r";
|
fmode = (const uint8_t *)"r";
|
||||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
|
||||||
flags = JANET_FILE_READ;
|
flags = JANET_FILE_READ;
|
||||||
}
|
}
|
||||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||||
if (f != NULL) {
|
|
||||||
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
|
|
||||||
if (bufsize != BUFSIZ) {
|
|
||||||
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
|
|
||||||
if (result) {
|
|
||||||
janet_panic("failed to set buffer size for file");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return f ? janet_makefile(f, flags)
|
return f ? janet_makefile(f, flags)
|
||||||
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil())
|
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
|
||||||
: janet_wrap_nil();
|
: janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -190,16 +184,7 @@ static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Read a certain number of bytes into memory */
|
/* Read a certain number of bytes into memory */
|
||||||
JANET_CORE_FN(cfun_io_fread,
|
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||||
"(file/read f what &opt buf)",
|
|
||||||
"Read a number of bytes from a file `f` into a buffer. A buffer `buf` can "
|
|
||||||
"be provided as an optional third argument, otherwise a new buffer "
|
|
||||||
"is created. `what` can either be an integer or a keyword. Returns the "
|
|
||||||
"buffer with file contents. "
|
|
||||||
"Values for `what`:\n\n"
|
|
||||||
"* :all - read the whole file\n\n"
|
|
||||||
"* :line - read up to and including the next newline character\n\n"
|
|
||||||
"* n (integer) - read up to n bytes from the file") {
|
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||||
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
|
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
|
||||||
@@ -239,10 +224,7 @@ JANET_CORE_FN(cfun_io_fread,
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Write bytes to a file */
|
/* Write bytes to a file */
|
||||||
JANET_CORE_FN(cfun_io_fwrite,
|
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||||
"(file/write f bytes)",
|
|
||||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
|
||||||
"file.") {
|
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
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)
|
||||||
@@ -264,27 +246,21 @@ JANET_CORE_FN(cfun_io_fwrite,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static void io_assert_writeable(JanetFile *iof) {
|
/* Flush the bytes in the file */
|
||||||
|
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
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");
|
||||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||||
janet_panic("file is not writeable");
|
janet_panic("file is not writeable");
|
||||||
}
|
|
||||||
|
|
||||||
/* Flush the bytes in the file */
|
|
||||||
JANET_CORE_FN(cfun_io_fflush,
|
|
||||||
"(file/flush f)",
|
|
||||||
"Flush any buffered bytes to the file system. In most files, writes are "
|
|
||||||
"buffered for efficiency reasons. Returns the file handle.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
|
||||||
io_assert_writeable(iof);
|
|
||||||
if (fflush(iof->file))
|
if (fflush(iof->file))
|
||||||
janet_panic("could not flush file");
|
janet_panic("could not flush file");
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
|
#define pclose _pclose
|
||||||
#define WEXITSTATUS(x) x
|
#define WEXITSTATUS(x) x
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
@@ -292,9 +268,15 @@ JANET_CORE_FN(cfun_io_fflush,
|
|||||||
int janet_file_close(JanetFile *file) {
|
int janet_file_close(JanetFile *file) {
|
||||||
int ret = 0;
|
int ret = 0;
|
||||||
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||||
|
#ifndef JANET_NO_PROCESSES
|
||||||
|
if (file->flags & JANET_FILE_PIPED) {
|
||||||
|
ret = pclose(file->file);
|
||||||
|
} else
|
||||||
|
#endif
|
||||||
|
{
|
||||||
ret = fclose(file->file);
|
ret = fclose(file->file);
|
||||||
|
}
|
||||||
file->flags |= JANET_FILE_CLOSED;
|
file->flags |= JANET_FILE_CLOSED;
|
||||||
file->file = NULL; /* NULL dereference is easier to debug then other problems */
|
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
@@ -309,40 +291,39 @@ static int cfun_io_gc(void *p, size_t len) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Close a file */
|
/* Close a file */
|
||||||
JANET_CORE_FN(cfun_io_fclose,
|
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||||
"(file/close f)",
|
|
||||||
"Close a file and release all related resources. When you are "
|
|
||||||
"done reading a file, close it to prevent a resource leak and let "
|
|
||||||
"other processes read the file.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
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)
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||||
janet_panic("file not closable");
|
janet_panic("file not closable");
|
||||||
|
if (iof->flags & JANET_FILE_PIPED) {
|
||||||
|
#ifndef JANET_NO_PROCESSES
|
||||||
|
int status = pclose(iof->file);
|
||||||
|
iof->flags |= JANET_FILE_CLOSED;
|
||||||
|
if (status == -1) janet_panic("could not close file");
|
||||||
|
return janet_wrap_integer(WEXITSTATUS(status));
|
||||||
|
#else
|
||||||
|
return janet_wrap_nil();
|
||||||
|
#endif
|
||||||
|
} else {
|
||||||
if (fclose(iof->file)) {
|
if (fclose(iof->file)) {
|
||||||
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
|
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
|
||||||
janet_panic("could not close file");
|
janet_panic("could not close file");
|
||||||
}
|
}
|
||||||
iof->flags |= JANET_FILE_CLOSED;
|
iof->flags |= JANET_FILE_CLOSED;
|
||||||
|
}
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Seek a file */
|
/* Seek a file */
|
||||||
JANET_CORE_FN(cfun_io_fseek,
|
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||||
"(file/seek f &opt whence n)",
|
|
||||||
"Jump to a relative location in the file `f`. `whence` must be one of:\n\n"
|
|
||||||
"* :cur - jump relative to the current file location\n\n"
|
|
||||||
"* :set - jump relative to the beginning of the file\n\n"
|
|
||||||
"* :end - jump relative to the end of the file\n\n"
|
|
||||||
"By default, `whence` is :cur. Optionally a value `n` may be passed "
|
|
||||||
"for the relative number of bytes to seek in the file. `n` may be a real "
|
|
||||||
"number to handle large files of more than 4GB. Returns the file handle.") {
|
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
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");
|
||||||
int64_t offset = 0;
|
long int 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);
|
||||||
@@ -356,31 +337,18 @@ 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 = (int64_t) janet_getinteger64(argv, 2);
|
offset = (long) 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");
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_ftell,
|
|
||||||
"(file/tell f)",
|
|
||||||
"Get the current value of the file position for file `f`.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
|
||||||
if (iof->flags & JANET_FILE_CLOSED)
|
|
||||||
janet_panic("file is closed");
|
|
||||||
int64_t pos = ftell(iof->file);
|
|
||||||
if (pos == -1) janet_panic("error getting position in file");
|
|
||||||
return janet_wrap_number((double)pos);
|
|
||||||
}
|
|
||||||
|
|
||||||
static JanetMethod io_file_methods[] = {
|
static JanetMethod io_file_methods[] = {
|
||||||
{"close", cfun_io_fclose},
|
{"close", cfun_io_fclose},
|
||||||
{"flush", cfun_io_fflush},
|
{"flush", cfun_io_fflush},
|
||||||
{"read", cfun_io_fread},
|
{"read", cfun_io_fread},
|
||||||
{"seek", cfun_io_fseek},
|
{"seek", cfun_io_fseek},
|
||||||
{"tell", cfun_io_ftell},
|
|
||||||
{"write", cfun_io_fwrite},
|
{"write", cfun_io_fwrite},
|
||||||
{NULL, NULL}
|
{NULL, NULL}
|
||||||
};
|
};
|
||||||
@@ -466,19 +434,6 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
|||||||
janet_buffer_push_u8(buf, '\n');
|
janet_buffer_push_u8(buf, '\n');
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
case JANET_FUNCTION: {
|
|
||||||
/* Special case function */
|
|
||||||
JanetFunction *fun = janet_unwrap_function(x);
|
|
||||||
JanetBuffer *buf = janet_buffer(0);
|
|
||||||
for (int32_t i = offset; i < argc; ++i) {
|
|
||||||
janet_to_string_b(buf, argv[i]);
|
|
||||||
}
|
|
||||||
if (newline)
|
|
||||||
janet_buffer_push_u8(buf, '\n');
|
|
||||||
Janet args[1] = { janet_wrap_buffer(buf) };
|
|
||||||
janet_call(fun, 1, args);
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
f = dflt_file;
|
f = dflt_file;
|
||||||
if (f == NULL) janet_panic("cannot print to nil");
|
if (f == NULL) janet_panic("cannot print to nil");
|
||||||
@@ -488,7 +443,6 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
|||||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
JanetFile *iofile = abstract;
|
JanetFile *iofile = abstract;
|
||||||
io_assert_writeable(iofile);
|
|
||||||
f = iofile->file;
|
f = iofile->file;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -519,53 +473,35 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||||
int newline, const char *name, FILE *dflt_file) {
|
int newline, const char *name, FILE *dflt_file) {
|
||||||
Janet x = janet_dyn(name);
|
Janet x = janet_dyn(name);
|
||||||
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
|
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_print,
|
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||||
"(print & xs)",
|
|
||||||
"Print values to the console (standard out). Value are converted "
|
|
||||||
"to strings if they are not already. After printing all values, a "
|
|
||||||
"newline character is printed. Use the value of `(dyn :out stdout)` to determine "
|
|
||||||
"what to push characters to. Expects `(dyn :out stdout)` to be either a core/file or "
|
|
||||||
"a buffer. Returns nil.") {
|
|
||||||
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
|
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_prin,
|
static Janet cfun_io_prin(int32_t argc, Janet *argv) {
|
||||||
"(prin & xs)",
|
|
||||||
"Same as `print`, but does not add trailing newline.") {
|
|
||||||
return cfun_io_print_impl(argc, argv, 0, "out", stdout);
|
return cfun_io_print_impl(argc, argv, 0, "out", stdout);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_eprint,
|
static Janet cfun_io_eprint(int32_t argc, Janet *argv) {
|
||||||
"(eprint & xs)",
|
|
||||||
"Same as `print`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
|
|
||||||
return cfun_io_print_impl(argc, argv, 1, "err", stderr);
|
return cfun_io_print_impl(argc, argv, 1, "err", stderr);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_eprin,
|
static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
|
||||||
"(eprin & xs)",
|
|
||||||
"Same as `prin`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
|
|
||||||
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
|
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_xprint,
|
static Janet cfun_io_xprint(int32_t argc, Janet *argv) {
|
||||||
"(xprint to & xs)",
|
|
||||||
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
|
|
||||||
"newline character. The value to print "
|
|
||||||
"to is the first argument, and is otherwise the same as `print`. Returns nil.") {
|
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_xprin,
|
static Janet cfun_io_xprin(int32_t argc, Janet *argv) {
|
||||||
"(xprin to & xs)",
|
|
||||||
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
|
|
||||||
"to is the first argument, and is otherwise the same as `prin`. Returns nil.") {
|
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||||
}
|
}
|
||||||
@@ -584,16 +520,6 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
|||||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
case JANET_FUNCTION: {
|
|
||||||
/* Special case function */
|
|
||||||
JanetFunction *fun = janet_unwrap_function(x);
|
|
||||||
JanetBuffer *buf = janet_buffer(0);
|
|
||||||
janet_buffer_format(buf, fmt, offset, argc, argv);
|
|
||||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
|
||||||
Janet args[1] = { janet_wrap_buffer(buf) };
|
|
||||||
janet_call(fun, 1, args);
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
f = dflt_file;
|
f = dflt_file;
|
||||||
if (f == NULL) janet_panic("cannot print to nil");
|
if (f == NULL) janet_panic("cannot print to nil");
|
||||||
@@ -603,10 +529,6 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
|||||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
JanetFile *iofile = abstract;
|
JanetFile *iofile = abstract;
|
||||||
if (iofile->flags & JANET_FILE_CLOSED) {
|
|
||||||
janet_panic("cannot print to closed file");
|
|
||||||
}
|
|
||||||
io_assert_writeable(iofile);
|
|
||||||
f = iofile->file;
|
f = iofile->file;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -635,40 +557,28 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
|||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_printf,
|
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
|
||||||
"(printf fmt & xs)",
|
|
||||||
"Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :out stdout)` with a trailing newline.") {
|
|
||||||
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
|
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_prinf,
|
static Janet cfun_io_prinf(int32_t argc, Janet *argv) {
|
||||||
"(prinf fmt & xs)",
|
|
||||||
"Like `printf` but with no trailing newline.") {
|
|
||||||
return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
|
return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_eprintf,
|
static Janet cfun_io_eprintf(int32_t argc, Janet *argv) {
|
||||||
"(eprintf fmt & xs)",
|
|
||||||
"Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :err stderr)` with a trailing newline.") {
|
|
||||||
return cfun_io_printf_impl(argc, argv, 1, "err", stderr);
|
return cfun_io_printf_impl(argc, argv, 1, "err", stderr);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_eprinf,
|
static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
|
||||||
"(eprinf fmt & xs)",
|
|
||||||
"Like `eprintf` but with no trailing newline.") {
|
|
||||||
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
|
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_xprintf,
|
static Janet cfun_io_xprintf(int32_t argc, Janet *argv) {
|
||||||
"(xprintf to fmt & xs)",
|
|
||||||
"Like `printf` but prints to an explicit file or value `to`. Returns nil.") {
|
|
||||||
janet_arity(argc, 2, -1);
|
janet_arity(argc, 2, -1);
|
||||||
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_xprinf,
|
static Janet cfun_io_xprinf(int32_t argc, Janet *argv) {
|
||||||
"(xprinf to fmt & xs)",
|
|
||||||
"Like `prinf` but prints to an explicit file or value `to`. Returns nil.") {
|
|
||||||
janet_arity(argc, 2, -1);
|
janet_arity(argc, 2, -1);
|
||||||
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||||
}
|
}
|
||||||
@@ -691,18 +601,14 @@ static void janet_flusher(const char *name, FILE *dflt_file) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_flush,
|
static Janet cfun_io_flush(int32_t argc, Janet *argv) {
|
||||||
"(flush)",
|
|
||||||
"Flush `(dyn :out stdout)` if it is a file, otherwise do nothing.") {
|
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_flusher("out", stdout);
|
janet_flusher("out", stdout);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_io_eflush,
|
static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
|
||||||
"(eflush)",
|
|
||||||
"Flush `(dyn :err stderr)` if it is a file, otherwise do nothing.") {
|
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_flusher("err", stderr);
|
janet_flusher("err", stderr);
|
||||||
@@ -731,23 +637,12 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
|||||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||||
break;
|
break;
|
||||||
JanetFile *iofile = abstract;
|
JanetFile *iofile = abstract;
|
||||||
io_assert_writeable(iofile);
|
|
||||||
f = iofile->file;
|
f = iofile->file;
|
||||||
}
|
}
|
||||||
fwrite(buffer.data, buffer.count, 1, f);
|
fwrite(buffer.data, buffer.count, 1, f);
|
||||||
janet_buffer_deinit(&buffer);
|
janet_buffer_deinit(&buffer);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_FUNCTION: {
|
|
||||||
JanetFunction *fun = janet_unwrap_function(x);
|
|
||||||
int32_t len = 0;
|
|
||||||
while (format[len]) len++;
|
|
||||||
JanetBuffer *buf = janet_buffer(len);
|
|
||||||
janet_formatbv(buf, format, args);
|
|
||||||
Janet args[1] = { janet_wrap_buffer(buf) };
|
|
||||||
janet_call(fun, 1, args);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case JANET_BUFFER:
|
case JANET_BUFFER:
|
||||||
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
||||||
break;
|
break;
|
||||||
@@ -756,23 +651,179 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg io_cfuns[] = {
|
||||||
|
{
|
||||||
|
"print", cfun_io_print,
|
||||||
|
JDOC("(print & xs)\n\n"
|
||||||
|
"Print values to the console (standard out). Value are converted "
|
||||||
|
"to strings if they are not already. After printing all values, a "
|
||||||
|
"newline character is printed. Use the value of (dyn :out stdout) to determine "
|
||||||
|
"what to push characters to. Expects (dyn :out stdout) to be either a core/file or "
|
||||||
|
"a buffer. Returns nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"prin", cfun_io_prin,
|
||||||
|
JDOC("(prin & xs)\n\n"
|
||||||
|
"Same as print, but does not add trailing newline.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"printf", cfun_io_printf,
|
||||||
|
JDOC("(printf fmt & xs)\n\n"
|
||||||
|
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"prinf", cfun_io_prinf,
|
||||||
|
JDOC("(prinf fmt & xs)\n\n"
|
||||||
|
"Like printf but with no trailing newline.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"eprin", cfun_io_eprin,
|
||||||
|
JDOC("(eprin & xs)\n\n"
|
||||||
|
"Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"eprint", cfun_io_eprint,
|
||||||
|
JDOC("(eprint & xs)\n\n"
|
||||||
|
"Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"eprintf", cfun_io_eprintf,
|
||||||
|
JDOC("(eprintf fmt & xs)\n\n"
|
||||||
|
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"eprinf", cfun_io_eprinf,
|
||||||
|
JDOC("(eprinf fmt & xs)\n\n"
|
||||||
|
"Like eprintf but with no trailing newline.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"xprint", cfun_io_xprint,
|
||||||
|
JDOC("(xprint to & xs)\n\n"
|
||||||
|
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
|
||||||
|
"newline character. The value to print "
|
||||||
|
"to is the first argument, and is otherwise the same as print. Returns nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"xprin", cfun_io_xprin,
|
||||||
|
JDOC("(xprin to & xs)\n\n"
|
||||||
|
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
|
||||||
|
"to is the first argument, and is otherwise the same as prin. Returns nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"xprintf", cfun_io_xprintf,
|
||||||
|
JDOC("(xprint to fmt & xs)\n\n"
|
||||||
|
"Like printf but prints to an explicit file or value to. Returns nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"xprinf", cfun_io_xprinf,
|
||||||
|
JDOC("(xprin to fmt & xs)\n\n"
|
||||||
|
"Like prinf but prints to an explicit file or value to. Returns nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"flush", cfun_io_flush,
|
||||||
|
JDOC("(flush)\n\n"
|
||||||
|
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"eflush", cfun_io_eflush,
|
||||||
|
JDOC("(eflush)\n\n"
|
||||||
|
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"file/temp", cfun_io_temp,
|
||||||
|
JDOC("(file/temp)\n\n"
|
||||||
|
"Open an anonymous temporary file that is removed on close. "
|
||||||
|
"Raises an error on failure.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"file/open", cfun_io_fopen,
|
||||||
|
JDOC("(file/open path &opt mode)\n\n"
|
||||||
|
"Open a file. `path` is an absolute or relative path, and "
|
||||||
|
"`mode` is a set of flags indicating the mode to open the file in. "
|
||||||
|
"`mode` is a keyword where each character represents a flag. If the file "
|
||||||
|
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||||
|
"Mode flags:\n\n"
|
||||||
|
"* r - allow reading from the file\n\n"
|
||||||
|
"* w - allow writing to the file\n\n"
|
||||||
|
"* a - append to the file\n\n"
|
||||||
|
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
|
||||||
|
"* b - open the file in binary mode (rather than text mode)\n\n"
|
||||||
|
"* + - append to the file instead of overwriting it\n\n"
|
||||||
|
"* n - error if the file cannot be opened instead of returning nil")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"file/close", cfun_io_fclose,
|
||||||
|
JDOC("(file/close f)\n\n"
|
||||||
|
"Close a file and release all related resources. When you are "
|
||||||
|
"done reading a file, close it to prevent a resource leak and let "
|
||||||
|
"other processes read the file. If the file is the result of a file/popen "
|
||||||
|
"call, close waits for and returns the process exit status.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"file/read", cfun_io_fread,
|
||||||
|
JDOC("(file/read f what &opt buf)\n\n"
|
||||||
|
"Read a number of bytes from a file `f` into a buffer. A buffer `buf` can "
|
||||||
|
"be provided as an optional third argument, otherwise a new buffer "
|
||||||
|
"is created. `what` can either be an integer or a keyword. Returns the "
|
||||||
|
"buffer with file contents. "
|
||||||
|
"Values for `what`:\n\n"
|
||||||
|
"* :all - read the whole file\n\n"
|
||||||
|
"* :line - read up to and including the next newline character\n\n"
|
||||||
|
"* n (integer) - read up to n bytes from the file")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"file/write", cfun_io_fwrite,
|
||||||
|
JDOC("(file/write f bytes)\n\n"
|
||||||
|
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||||
|
"file.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"file/flush", cfun_io_fflush,
|
||||||
|
JDOC("(file/flush f)\n\n"
|
||||||
|
"Flush any buffered bytes to the file system. In most files, writes are "
|
||||||
|
"buffered for efficiency reasons. Returns the file handle.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"file/seek", cfun_io_fseek,
|
||||||
|
JDOC("(file/seek f &opt whence n)\n\n"
|
||||||
|
"Jump to a relative location in the file `f`. `whence` must be one of:\n\n"
|
||||||
|
"* :cur - jump relative to the current file location\n\n"
|
||||||
|
"* :set - jump relative to the beginning of the file\n\n"
|
||||||
|
"* :end - jump relative to the end of the file\n\n"
|
||||||
|
"By default, `whence` is :cur. Optionally a value `n` may be passed "
|
||||||
|
"for the relative number of bytes to seek in the file. `n` may be a real "
|
||||||
|
"number to handle large files of more than 4GB. Returns the file handle.")
|
||||||
|
},
|
||||||
|
#ifndef JANET_NO_PROCESSES
|
||||||
|
{
|
||||||
|
"file/popen", cfun_io_popen,
|
||||||
|
JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\n\n"
|
||||||
|
"Open a file that is backed by a process. The file must be opened in either "
|
||||||
|
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||||
|
"process can be read from the file. In :w mode, the stdin of the process "
|
||||||
|
"can be written to. Returns the new file.")
|
||||||
|
},
|
||||||
|
#endif
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* C API */
|
/* C API */
|
||||||
|
|
||||||
JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
|
JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
|
||||||
return janet_getabstract(argv, n, &janet_file_type);
|
return janet_getabstract(argv, n, &janet_file_type);
|
||||||
}
|
}
|
||||||
|
|
||||||
FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags) {
|
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||||
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
|
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
|
||||||
if (NULL != flags) *flags = iof->flags;
|
if (NULL != flags) *flags = iof->flags;
|
||||||
return iof->file;
|
return iof->file;
|
||||||
}
|
}
|
||||||
|
|
||||||
JanetFile *janet_makejfile(FILE *f, int32_t flags) {
|
JanetFile *janet_makejfile(FILE *f, int flags) {
|
||||||
return makef(f, flags);
|
return makef(f, flags);
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_makefile(FILE *f, int32_t flags) {
|
Janet janet_makefile(FILE *f, int flags) {
|
||||||
return janet_wrap_abstract(makef(f, flags));
|
return janet_wrap_abstract(makef(f, flags));
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -780,7 +831,7 @@ JanetAbstract janet_checkfile(Janet j) {
|
|||||||
return janet_checkabstract(j, &janet_file_type);
|
return janet_checkabstract(j, &janet_file_type);
|
||||||
}
|
}
|
||||||
|
|
||||||
FILE *janet_unwrapfile(Janet j, int32_t *flags) {
|
FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||||
JanetFile *iof = janet_unwrap_abstract(j);
|
JanetFile *iof = janet_unwrap_abstract(j);
|
||||||
if (NULL != flags) *flags = iof->flags;
|
if (NULL != flags) *flags = iof->flags;
|
||||||
return iof->file;
|
return iof->file;
|
||||||
@@ -788,45 +839,20 @@ FILE *janet_unwrapfile(Janet j, int32_t *flags) {
|
|||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_io(JanetTable *env) {
|
void janet_lib_io(JanetTable *env) {
|
||||||
JanetRegExt io_cfuns[] = {
|
janet_core_cfuns(env, NULL, io_cfuns);
|
||||||
JANET_CORE_REG("print", cfun_io_print),
|
|
||||||
JANET_CORE_REG("prin", cfun_io_prin),
|
|
||||||
JANET_CORE_REG("printf", cfun_io_printf),
|
|
||||||
JANET_CORE_REG("prinf", cfun_io_prinf),
|
|
||||||
JANET_CORE_REG("eprin", cfun_io_eprin),
|
|
||||||
JANET_CORE_REG("eprint", cfun_io_eprint),
|
|
||||||
JANET_CORE_REG("eprintf", cfun_io_eprintf),
|
|
||||||
JANET_CORE_REG("eprinf", cfun_io_eprinf),
|
|
||||||
JANET_CORE_REG("xprint", cfun_io_xprint),
|
|
||||||
JANET_CORE_REG("xprin", cfun_io_xprin),
|
|
||||||
JANET_CORE_REG("xprintf", cfun_io_xprintf),
|
|
||||||
JANET_CORE_REG("xprinf", cfun_io_xprinf),
|
|
||||||
JANET_CORE_REG("flush", cfun_io_flush),
|
|
||||||
JANET_CORE_REG("eflush", cfun_io_eflush),
|
|
||||||
JANET_CORE_REG("file/temp", cfun_io_temp),
|
|
||||||
JANET_CORE_REG("file/open", cfun_io_fopen),
|
|
||||||
JANET_CORE_REG("file/close", cfun_io_fclose),
|
|
||||||
JANET_CORE_REG("file/read", cfun_io_fread),
|
|
||||||
JANET_CORE_REG("file/write", cfun_io_fwrite),
|
|
||||||
JANET_CORE_REG("file/flush", cfun_io_fflush),
|
|
||||||
JANET_CORE_REG("file/seek", cfun_io_fseek),
|
|
||||||
JANET_CORE_REG("file/tell", cfun_io_ftell),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, io_cfuns);
|
|
||||||
janet_register_abstract_type(&janet_file_type);
|
janet_register_abstract_type(&janet_file_type);
|
||||||
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
|
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
|
||||||
/* stdout */
|
/* stdout */
|
||||||
JANET_CORE_DEF(env, "stdout",
|
janet_core_def(env, "stdout",
|
||||||
janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
|
janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
|
||||||
"The standard output file.");
|
JDOC("The standard output file."));
|
||||||
/* stderr */
|
/* stderr */
|
||||||
JANET_CORE_DEF(env, "stderr",
|
janet_core_def(env, "stderr",
|
||||||
janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
|
janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
|
||||||
"The standard error file.");
|
JDOC("The standard error file."));
|
||||||
/* stdin */
|
/* stdin */
|
||||||
JANET_CORE_DEF(env, "stdin",
|
janet_core_def(env, "stdin",
|
||||||
janet_makefile(stdin, JANET_FILE_READ | default_flags),
|
janet_makefile(stdin, JANET_FILE_READ | default_flags),
|
||||||
"The standard input file.");
|
JDOC("The standard input file."));
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|||||||
421
src/core/marsh.c
421
src/core/marsh.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -37,7 +37,6 @@ typedef struct {
|
|||||||
JanetFuncEnv **seen_envs;
|
JanetFuncEnv **seen_envs;
|
||||||
JanetFuncDef **seen_defs;
|
JanetFuncDef **seen_defs;
|
||||||
int32_t nextid;
|
int32_t nextid;
|
||||||
int maybe_cycles;
|
|
||||||
} MarshalState;
|
} MarshalState;
|
||||||
|
|
||||||
/* Lead bytes in marshaling protocol */
|
/* Lead bytes in marshaling protocol */
|
||||||
@@ -64,19 +63,7 @@ enum {
|
|||||||
LB_FUNCENV_REF, /* 219 */
|
LB_FUNCENV_REF, /* 219 */
|
||||||
LB_FUNCDEF_REF, /* 220 */
|
LB_FUNCDEF_REF, /* 220 */
|
||||||
LB_UNSAFE_CFUNCTION, /* 221 */
|
LB_UNSAFE_CFUNCTION, /* 221 */
|
||||||
LB_UNSAFE_POINTER, /* 222 */
|
LB_UNSAFE_POINTER /* 222 */
|
||||||
LB_STRUCT_PROTO, /* 223 */
|
|
||||||
#ifdef JANET_EV
|
|
||||||
LB_THREADED_ABSTRACT, /* 224 */
|
|
||||||
LB_POINTER_BUFFER, /* 225 */
|
|
||||||
#endif
|
|
||||||
LB_TABLE_WEAKK, /* 226 */
|
|
||||||
LB_TABLE_WEAKV, /* 227 */
|
|
||||||
LB_TABLE_WEAKKV, /* 228 */
|
|
||||||
LB_TABLE_WEAKK_PROTO, /* 229 */
|
|
||||||
LB_TABLE_WEAKV_PROTO, /* 230 */
|
|
||||||
LB_TABLE_WEAKKV_PROTO, /* 231 */
|
|
||||||
LB_ARRAY_WEAK, /* 232 */
|
|
||||||
} LeadBytes;
|
} LeadBytes;
|
||||||
|
|
||||||
/* Helper to look inside an entry in an environment */
|
/* Helper to look inside an entry in an environment */
|
||||||
@@ -161,10 +148,6 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
|
|||||||
janet_buffer_push_bytes(st->buf, bytes, len);
|
janet_buffer_push_bytes(st->buf, bytes, len);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void pushpointer(MarshalState *st, const void *ptr) {
|
|
||||||
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Marshal a size_t onto the buffer */
|
/* Marshal a size_t onto the buffer */
|
||||||
static void push64(MarshalState *st, uint64_t x) {
|
static void push64(MarshalState *st, uint64_t x) {
|
||||||
if (x <= 0xF0) {
|
if (x <= 0xF0) {
|
||||||
@@ -192,19 +175,6 @@ 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;
|
||||||
@@ -217,9 +187,7 @@ 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;
|
||||||
@@ -268,7 +236,6 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
|||||||
}
|
}
|
||||||
/* Add to lookup */
|
/* Add to lookup */
|
||||||
janet_v_push(st->seen_defs, def);
|
janet_v_push(st->seen_defs, def);
|
||||||
|
|
||||||
pushint(st, def->flags);
|
pushint(st, def->flags);
|
||||||
pushint(st, def->slotcount);
|
pushint(st, def->slotcount);
|
||||||
pushint(st, def->arity);
|
pushint(st, def->arity);
|
||||||
@@ -280,8 +247,6 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
|||||||
pushint(st, def->environments_length);
|
pushint(st, def->environments_length);
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||||
pushint(st, def->defs_length);
|
pushint(st, def->defs_length);
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
|
|
||||||
pushint(st, def->symbolmap_length);
|
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME)
|
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME)
|
||||||
marshal_one(st, janet_wrap_string(def->name), flags);
|
marshal_one(st, janet_wrap_string(def->name), flags);
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE)
|
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE)
|
||||||
@@ -289,15 +254,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
|||||||
|
|
||||||
/* marshal constants */
|
/* marshal constants */
|
||||||
for (int32_t i = 0; i < def->constants_length; i++)
|
for (int32_t i = 0; i < def->constants_length; i++)
|
||||||
marshal_one(st, def->constants[i], flags + 1);
|
marshal_one(st, def->constants[i], flags);
|
||||||
|
|
||||||
/* Marshal symbol map, if needed */
|
|
||||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
|
||||||
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
|
|
||||||
pushint(st, (int32_t) def->symbolmap[i].death_pc);
|
|
||||||
pushint(st, (int32_t) def->symbolmap[i].slot_index);
|
|
||||||
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags + 1);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* marshal the bytecode */
|
/* marshal the bytecode */
|
||||||
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
|
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
|
||||||
@@ -308,7 +265,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
|||||||
|
|
||||||
/* marshal the sub funcdefs if needed */
|
/* marshal the sub funcdefs if needed */
|
||||||
for (int32_t i = 0; i < def->defs_length; i++)
|
for (int32_t i = 0; i < def->defs_length; i++)
|
||||||
marshal_one_def(st, def->defs[i], flags + 1);
|
marshal_one_def(st, def->defs[i], flags);
|
||||||
|
|
||||||
/* marshal source maps if needed */
|
/* marshal source maps if needed */
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
|
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
|
||||||
@@ -350,7 +307,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_panicf("cannot marshal fiber with c stackframe (%v)", janet_wrap_cfunction((JanetCFunction) frame->pc));
|
if (!frame->func) janet_panic("cannot marshal fiber with c stackframe");
|
||||||
pushint(st, frame->flags);
|
pushint(st, frame->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);
|
||||||
@@ -368,7 +325,6 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
|||||||
}
|
}
|
||||||
if (fiber->child)
|
if (fiber->child)
|
||||||
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
|
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
|
||||||
marshal_one(st, fiber->last_value, flags + 1);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_marshal_size(JanetMarshalContext *ctx, size_t value) {
|
void janet_marshal_size(JanetMarshalContext *ctx, size_t value) {
|
||||||
@@ -385,15 +341,6 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
|
|||||||
pushint(st, value);
|
pushint(st, value);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Only use in unsafe - don't marshal pointers otherwise */
|
|
||||||
void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
|
|
||||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
|
||||||
janet_panic("can only marshal pointers in unsafe mode");
|
|
||||||
}
|
|
||||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
|
||||||
pushpointer(st, ptr);
|
|
||||||
}
|
|
||||||
|
|
||||||
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
|
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
|
||||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||||
pushbyte(st, value);
|
pushbyte(st, value);
|
||||||
@@ -410,52 +357,26 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
|
|||||||
marshal_one(st, x, ctx->flags + 1);
|
marshal_one(st, x, ctx->flags + 1);
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef JANET_MARSHAL_DEBUG
|
|
||||||
#define MARK_SEEN() \
|
|
||||||
do { if (st->maybe_cycles) { \
|
|
||||||
Janet _check = janet_table_get(&st->seen, x); \
|
|
||||||
if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \
|
|
||||||
janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \
|
|
||||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
|
|
||||||
} } while (0)
|
|
||||||
#else
|
|
||||||
#define MARK_SEEN() \
|
|
||||||
do { if (st->maybe_cycles) { \
|
|
||||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
|
|
||||||
} } while (0)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||||
Janet x = janet_wrap_abstract(abstract);
|
janet_table_put(&st->seen,
|
||||||
MARK_SEEN();
|
janet_wrap_abstract(abstract),
|
||||||
|
janet_wrap_integer(st->nextid++));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#define MARK_SEEN() \
|
||||||
|
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
|
||||||
|
|
||||||
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||||
void *abstract = janet_unwrap_abstract(x);
|
void *abstract = janet_unwrap_abstract(x);
|
||||||
#ifdef JANET_EV
|
|
||||||
/* Threaded abstract types get passed through as pointers in the unsafe mode */
|
|
||||||
if ((flags & JANET_MARSHAL_UNSAFE) &&
|
|
||||||
(JANET_MEMORY_THREADED_ABSTRACT == (janet_abstract_head(abstract)->gc.flags & JANET_MEM_TYPEBITS))) {
|
|
||||||
|
|
||||||
/* Increment refcount before sending message. This prevents a "death in transit" problem
|
|
||||||
* where a message is garbage collected while in transit between two threads - i.e., the sending threads
|
|
||||||
* loses the reference and runs a garbage collection before the receiving thread gets the message. */
|
|
||||||
janet_abstract_incref(abstract);
|
|
||||||
pushbyte(st, LB_THREADED_ABSTRACT);
|
|
||||||
pushbytes(st, (uint8_t *) &abstract, sizeof(abstract));
|
|
||||||
MARK_SEEN();
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
const JanetAbstractType *at = janet_abstract_type(abstract);
|
const JanetAbstractType *at = janet_abstract_type(abstract);
|
||||||
if (at->marshal) {
|
if (at->marshal) {
|
||||||
pushbyte(st, LB_ABSTRACT);
|
pushbyte(st, LB_ABSTRACT);
|
||||||
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
||||||
JanetMarshalContext context = {st, NULL, flags + 1, NULL, at};
|
JanetMarshalContext context = {st, NULL, flags, NULL, at};
|
||||||
at->marshal(abstract, &context);
|
at->marshal(abstract, &context);
|
||||||
} else {
|
} else {
|
||||||
janet_panicf("cannot marshal %p", x);
|
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -487,15 +408,12 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
|||||||
|
|
||||||
/* Check reference and registry value */
|
/* Check reference and registry value */
|
||||||
{
|
{
|
||||||
Janet check;
|
Janet check = janet_table_get(&st->seen, x);
|
||||||
if (st->maybe_cycles) {
|
|
||||||
check = janet_table_get(&st->seen, x);
|
|
||||||
if (janet_checkint(check)) {
|
if (janet_checkint(check)) {
|
||||||
pushbyte(st, LB_REFERENCE);
|
pushbyte(st, LB_REFERENCE);
|
||||||
pushint(st, janet_unwrap_integer(check));
|
pushint(st, janet_unwrap_integer(check));
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
|
||||||
if (st->rreg) {
|
if (st->rreg) {
|
||||||
check = janet_table_get(st->rreg, x);
|
check = janet_table_get(st->rreg, x);
|
||||||
if (janet_checktype(check, JANET_SYMBOL)) {
|
if (janet_checktype(check, JANET_SYMBOL)) {
|
||||||
@@ -557,16 +475,6 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
|||||||
JanetBuffer *buffer = janet_unwrap_buffer(x);
|
JanetBuffer *buffer = janet_unwrap_buffer(x);
|
||||||
/* Record reference */
|
/* Record reference */
|
||||||
MARK_SEEN();
|
MARK_SEEN();
|
||||||
#ifdef JANET_EV
|
|
||||||
if ((flags & JANET_MARSHAL_UNSAFE) &&
|
|
||||||
(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
|
||||||
pushbyte(st, LB_POINTER_BUFFER);
|
|
||||||
pushint(st, buffer->count);
|
|
||||||
pushint(st, buffer->capacity);
|
|
||||||
pushpointer(st, buffer->data);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
pushbyte(st, LB_BUFFER);
|
pushbyte(st, LB_BUFFER);
|
||||||
pushint(st, buffer->count);
|
pushint(st, buffer->count);
|
||||||
pushbytes(st, buffer->data, buffer->count);
|
pushbytes(st, buffer->data, buffer->count);
|
||||||
@@ -576,8 +484,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
|||||||
int32_t i;
|
int32_t i;
|
||||||
JanetArray *a = janet_unwrap_array(x);
|
JanetArray *a = janet_unwrap_array(x);
|
||||||
MARK_SEEN();
|
MARK_SEEN();
|
||||||
enum JanetMemoryType memtype = janet_gc_type(a);
|
pushbyte(st, LB_ARRAY);
|
||||||
pushbyte(st, memtype == JANET_MEMORY_ARRAY_WEAK ? LB_ARRAY_WEAK : LB_ARRAY);
|
|
||||||
pushint(st, a->count);
|
pushint(st, a->count);
|
||||||
for (i = 0; i < a->count; i++)
|
for (i = 0; i < a->count; i++)
|
||||||
marshal_one(st, a->data[i], flags + 1);
|
marshal_one(st, a->data[i], flags + 1);
|
||||||
@@ -600,16 +507,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
|||||||
case JANET_TABLE: {
|
case JANET_TABLE: {
|
||||||
JanetTable *t = janet_unwrap_table(x);
|
JanetTable *t = janet_unwrap_table(x);
|
||||||
MARK_SEEN();
|
MARK_SEEN();
|
||||||
enum JanetMemoryType memtype = janet_gc_type(t);
|
|
||||||
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
|
|
||||||
pushbyte(st, t->proto ? LB_TABLE_WEAKK_PROTO : LB_TABLE_WEAKK);
|
|
||||||
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
|
|
||||||
pushbyte(st, t->proto ? LB_TABLE_WEAKV_PROTO : LB_TABLE_WEAKV);
|
|
||||||
} else if (memtype == JANET_MEMORY_TABLE_WEAKKV) {
|
|
||||||
pushbyte(st, t->proto ? LB_TABLE_WEAKKV_PROTO : LB_TABLE_WEAKKV);
|
|
||||||
} else {
|
|
||||||
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
|
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
|
||||||
}
|
|
||||||
pushint(st, t->count);
|
pushint(st, t->count);
|
||||||
if (t->proto)
|
if (t->proto)
|
||||||
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
|
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
|
||||||
@@ -625,10 +523,8 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
|||||||
int32_t count;
|
int32_t count;
|
||||||
const JanetKV *struct_ = janet_unwrap_struct(x);
|
const JanetKV *struct_ = janet_unwrap_struct(x);
|
||||||
count = janet_struct_length(struct_);
|
count = janet_struct_length(struct_);
|
||||||
pushbyte(st, janet_struct_proto(struct_) ? LB_STRUCT_PROTO : LB_STRUCT);
|
pushbyte(st, LB_STRUCT);
|
||||||
pushint(st, count);
|
pushint(st, count);
|
||||||
if (janet_struct_proto(struct_))
|
|
||||||
marshal_one(st, janet_wrap_struct(janet_struct_proto(struct_)), flags + 1);
|
|
||||||
for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
|
for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
|
||||||
if (janet_checktype(struct_[i].key, JANET_NIL))
|
if (janet_checktype(struct_[i].key, JANET_NIL))
|
||||||
continue;
|
continue;
|
||||||
@@ -646,9 +542,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
|||||||
case JANET_FUNCTION: {
|
case JANET_FUNCTION: {
|
||||||
pushbyte(st, LB_FUNCTION);
|
pushbyte(st, LB_FUNCTION);
|
||||||
JanetFunction *func = janet_unwrap_function(x);
|
JanetFunction *func = janet_unwrap_function(x);
|
||||||
pushint(st, func->def->environments_length);
|
|
||||||
/* Mark seen before reading def */
|
/* Mark seen before reading def */
|
||||||
MARK_SEEN();
|
MARK_SEEN();
|
||||||
|
pushint(st, func->def->environments_length);
|
||||||
marshal_one_def(st, func->def, flags);
|
marshal_one_def(st, func->def, flags);
|
||||||
for (int32_t i = 0; i < func->def->environments_length; i++)
|
for (int32_t i = 0; i < func->def->environments_length; i++)
|
||||||
marshal_one_env(st, func->envs[i], flags + 1);
|
marshal_one_env(st, func->envs[i], flags + 1);
|
||||||
@@ -672,7 +568,8 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
|||||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||||
MARK_SEEN();
|
MARK_SEEN();
|
||||||
pushbyte(st, LB_UNSAFE_POINTER);
|
pushbyte(st, LB_UNSAFE_POINTER);
|
||||||
pushpointer(st, janet_unwrap_pointer(x));
|
void *ptr = janet_unwrap_pointer(x);
|
||||||
|
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
no_registry:
|
no_registry:
|
||||||
@@ -694,7 +591,6 @@ void janet_marshal(
|
|||||||
st.seen_defs = NULL;
|
st.seen_defs = NULL;
|
||||||
st.seen_envs = NULL;
|
st.seen_envs = NULL;
|
||||||
st.rreg = rreg;
|
st.rreg = rreg;
|
||||||
st.maybe_cycles = !(flags & JANET_MARSHAL_NO_CYCLES);
|
|
||||||
janet_table_init(&st.seen, 0);
|
janet_table_init(&st.seen, 0);
|
||||||
marshal_one(&st, x, flags);
|
marshal_one(&st, x, flags);
|
||||||
janet_table_deinit(&st.seen);
|
janet_table_deinit(&st.seen);
|
||||||
@@ -779,22 +675,9 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef JANET_MARSHAL_DEBUG
|
|
||||||
static void dump_reference_table(UnmarshalState *st) {
|
|
||||||
for (int32_t i = 0; i < janet_v_count(st->lookup); i++) {
|
|
||||||
janet_eprintf(" reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Assert a janet type */
|
/* Assert a janet type */
|
||||||
static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) {
|
static void janet_asserttype(Janet x, JanetType t) {
|
||||||
if (!janet_checktype(x, t)) {
|
if (!janet_checktype(x, t)) {
|
||||||
#ifdef JANET_MARSHAL_DEBUG
|
|
||||||
dump_reference_table(st);
|
|
||||||
#else
|
|
||||||
(void) st;
|
|
||||||
#endif
|
|
||||||
janet_panicf("expected type %T, got %v", 1 << t, x);
|
janet_panicf("expected type %T, got %v", 1 << t, x);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -846,7 +729,7 @@ static const uint8_t *unmarshal_one_env(
|
|||||||
Janet fiberv;
|
Janet fiberv;
|
||||||
/* On stack variant */
|
/* On stack variant */
|
||||||
data = unmarshal_one(st, data, &fiberv, flags);
|
data = unmarshal_one(st, data, &fiberv, flags);
|
||||||
janet_asserttype(fiberv, JANET_FIBER, st);
|
janet_asserttype(fiberv, JANET_FIBER);
|
||||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||||
/* Negative offset indicates untrusted input */
|
/* Negative offset indicates untrusted input */
|
||||||
env->offset = -offset;
|
env->offset = -offset;
|
||||||
@@ -912,8 +795,6 @@ static const uint8_t *unmarshal_one_def(
|
|||||||
def->constants = NULL;
|
def->constants = NULL;
|
||||||
def->bytecode = NULL;
|
def->bytecode = NULL;
|
||||||
def->sourcemap = NULL;
|
def->sourcemap = NULL;
|
||||||
def->symbolmap = NULL;
|
|
||||||
def->symbolmap_length = 0;
|
|
||||||
janet_v_push(st->lookup_defs, def);
|
janet_v_push(st->lookup_defs, def);
|
||||||
|
|
||||||
/* Set default lengths to zero */
|
/* Set default lengths to zero */
|
||||||
@@ -921,7 +802,6 @@ static const uint8_t *unmarshal_one_def(
|
|||||||
int32_t constants_length = 0;
|
int32_t constants_length = 0;
|
||||||
int32_t environments_length = 0;
|
int32_t environments_length = 0;
|
||||||
int32_t defs_length = 0;
|
int32_t defs_length = 0;
|
||||||
int32_t symbolmap_length = 0;
|
|
||||||
|
|
||||||
/* Read flags and other fixed values */
|
/* Read flags and other fixed values */
|
||||||
def->flags = readint(st, &data);
|
def->flags = readint(st, &data);
|
||||||
@@ -937,20 +817,18 @@ static const uint8_t *unmarshal_one_def(
|
|||||||
environments_length = readnat(st, &data);
|
environments_length = readnat(st, &data);
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||||
defs_length = readnat(st, &data);
|
defs_length = readnat(st, &data);
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
|
|
||||||
symbolmap_length = readnat(st, &data);
|
|
||||||
|
|
||||||
/* Check name and source (optional) */
|
/* Check name and source (optional) */
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||||
Janet x;
|
Janet x;
|
||||||
data = unmarshal_one(st, data, &x, flags + 1);
|
data = unmarshal_one(st, data, &x, flags + 1);
|
||||||
janet_asserttype(x, JANET_STRING, st);
|
janet_asserttype(x, JANET_STRING);
|
||||||
def->name = janet_unwrap_string(x);
|
def->name = janet_unwrap_string(x);
|
||||||
}
|
}
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
|
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
|
||||||
Janet x;
|
Janet x;
|
||||||
data = unmarshal_one(st, data, &x, flags + 1);
|
data = unmarshal_one(st, data, &x, flags + 1);
|
||||||
janet_asserttype(x, JANET_STRING, st);
|
janet_asserttype(x, JANET_STRING);
|
||||||
def->source = janet_unwrap_string(x);
|
def->source = janet_unwrap_string(x);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -967,27 +845,6 @@ static const uint8_t *unmarshal_one_def(
|
|||||||
}
|
}
|
||||||
def->constants_length = constants_length;
|
def->constants_length = constants_length;
|
||||||
|
|
||||||
/* Unmarshal symbol map, if needed */
|
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP) {
|
|
||||||
size_t size = sizeof(JanetSymbolMap) * symbolmap_length;
|
|
||||||
def->symbolmap = janet_malloc(size);
|
|
||||||
if (def->symbolmap == NULL) {
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
for (int32_t i = 0; i < symbolmap_length; i++) {
|
|
||||||
def->symbolmap[i].birth_pc = (uint32_t) readint(st, &data);
|
|
||||||
def->symbolmap[i].death_pc = (uint32_t) readint(st, &data);
|
|
||||||
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
|
|
||||||
Janet value;
|
|
||||||
data = unmarshal_one(st, data, &value, flags + 1);
|
|
||||||
if (!janet_checktype(value, JANET_SYMBOL)) {
|
|
||||||
janet_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value);
|
|
||||||
}
|
|
||||||
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
|
|
||||||
}
|
|
||||||
def->symbolmap_length = (uint32_t) symbolmap_length;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Unmarshal bytecode */
|
/* Unmarshal bytecode */
|
||||||
def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
|
def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
|
||||||
if (!def->bytecode) {
|
if (!def->bytecode) {
|
||||||
@@ -1078,13 +935,10 @@ static const uint8_t *unmarshal_one_fiber(
|
|||||||
fiber->data = NULL;
|
fiber->data = NULL;
|
||||||
fiber->child = NULL;
|
fiber->child = NULL;
|
||||||
fiber->env = NULL;
|
fiber->env = NULL;
|
||||||
fiber->last_value = janet_wrap_nil();
|
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
|
fiber->waiting = NULL;
|
||||||
fiber->sched_id = 0;
|
fiber->sched_id = 0;
|
||||||
fiber->supervisor_channel = NULL;
|
fiber->supervisor_channel = NULL;
|
||||||
fiber->ev_state = NULL;
|
|
||||||
fiber->ev_callback = NULL;
|
|
||||||
fiber->ev_stream = NULL;
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Push fiber to seen stack */
|
/* Push fiber to seen stack */
|
||||||
@@ -1133,7 +987,7 @@ static const uint8_t *unmarshal_one_fiber(
|
|||||||
/* Get function */
|
/* Get function */
|
||||||
Janet funcv;
|
Janet funcv;
|
||||||
data = unmarshal_one(st, data, &funcv, flags + 1);
|
data = unmarshal_one(st, data, &funcv, flags + 1);
|
||||||
janet_asserttype(funcv, JANET_FUNCTION, st);
|
janet_asserttype(funcv, JANET_FUNCTION);
|
||||||
func = janet_unwrap_function(funcv);
|
func = janet_unwrap_function(funcv);
|
||||||
def = func->def;
|
def = func->def;
|
||||||
|
|
||||||
@@ -1179,7 +1033,7 @@ static const uint8_t *unmarshal_one_fiber(
|
|||||||
Janet envv;
|
Janet envv;
|
||||||
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
|
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||||
janet_asserttype(envv, JANET_TABLE, st);
|
janet_asserttype(envv, JANET_TABLE);
|
||||||
fiber_env = janet_unwrap_table(envv);
|
fiber_env = janet_unwrap_table(envv);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1188,13 +1042,10 @@ static const uint8_t *unmarshal_one_fiber(
|
|||||||
Janet fiberv;
|
Janet fiberv;
|
||||||
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||||
data = unmarshal_one(st, data, &fiberv, flags + 1);
|
data = unmarshal_one(st, data, &fiberv, flags + 1);
|
||||||
janet_asserttype(fiberv, JANET_FIBER, st);
|
janet_asserttype(fiberv, JANET_FIBER);
|
||||||
fiber->child = janet_unwrap_fiber(fiberv);
|
fiber->child = janet_unwrap_fiber(fiberv);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Get the fiber last value */
|
|
||||||
data = unmarshal_one(st, data, &fiber->last_value, flags + 1);
|
|
||||||
|
|
||||||
/* We have valid fiber, finally construct remaining fields. */
|
/* We have valid fiber, finally construct remaining fields. */
|
||||||
fiber->frame = frame;
|
fiber->frame = frame;
|
||||||
fiber->flags = fiber_flags;
|
fiber->flags = fiber_flags;
|
||||||
@@ -1232,18 +1083,6 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
|
|||||||
return read64(st, &(ctx->data));
|
return read64(st, &(ctx->data));
|
||||||
}
|
}
|
||||||
|
|
||||||
void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
|
|
||||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
|
||||||
janet_panic("can only unmarshal pointers in unsafe mode");
|
|
||||||
}
|
|
||||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
|
||||||
void *ptr;
|
|
||||||
MARSH_EOS(st, ctx->data + sizeof(void *) - 1);
|
|
||||||
memcpy((char *) &ptr, ctx->data, sizeof(void *));
|
|
||||||
ctx->data += sizeof(void *);
|
|
||||||
return ptr;
|
|
||||||
}
|
|
||||||
|
|
||||||
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
||||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||||
MARSH_EOS(st, ctx->data);
|
MARSH_EOS(st, ctx->data);
|
||||||
@@ -1264,49 +1103,32 @@ Janet janet_unmarshal_janet(JanetMarshalContext *ctx) {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p) {
|
void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
|
||||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||||
if (ctx->at == NULL) {
|
if (ctx->at == NULL) {
|
||||||
janet_panicf("janet_unmarshal_abstract called more than once");
|
janet_panicf("janet_unmarshal_abstract called more than once");
|
||||||
}
|
}
|
||||||
|
void *p = janet_abstract(ctx->at, size);
|
||||||
janet_v_push(st->lookup, janet_wrap_abstract(p));
|
janet_v_push(st->lookup, janet_wrap_abstract(p));
|
||||||
ctx->at = NULL;
|
ctx->at = NULL;
|
||||||
}
|
|
||||||
|
|
||||||
void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
|
|
||||||
void *p = janet_abstract(ctx->at, size);
|
|
||||||
janet_unmarshal_abstract_reuse(ctx, p);
|
|
||||||
return p;
|
return p;
|
||||||
}
|
}
|
||||||
|
|
||||||
void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
|
|
||||||
#ifdef JANET_THREADS
|
|
||||||
void *p = janet_abstract_threaded(ctx->at, size);
|
|
||||||
janet_unmarshal_abstract_reuse(ctx, p);
|
|
||||||
return p;
|
|
||||||
#else
|
|
||||||
(void) ctx;
|
|
||||||
(void) size;
|
|
||||||
janet_panic("threaded abstracts not supported");
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
|
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
|
||||||
Janet key;
|
Janet key;
|
||||||
data = unmarshal_one(st, data, &key, flags + 1);
|
data = unmarshal_one(st, data, &key, flags + 1);
|
||||||
const JanetAbstractType *at = janet_get_abstract_type(key);
|
const JanetAbstractType *at = janet_get_abstract_type(key);
|
||||||
if (at == NULL) janet_panic("unknown abstract type");
|
if (at == NULL) goto oops;
|
||||||
if (at->unmarshal) {
|
if (at->unmarshal) {
|
||||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||||
void *abst = at->unmarshal(&context);
|
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||||
janet_assert(abst != NULL, "null pointer abstract");
|
|
||||||
*out = janet_wrap_abstract(abst);
|
|
||||||
if (context.at != NULL) {
|
if (context.at != NULL) {
|
||||||
janet_panic("janet_unmarshal_abstract not called");
|
janet_panicf("janet_unmarshal_abstract not called");
|
||||||
}
|
}
|
||||||
return context.data;
|
return context.data;
|
||||||
}
|
}
|
||||||
janet_panic("invalid abstract type - no unmarshal function pointer");
|
oops:
|
||||||
|
janet_panic("invalid abstract type");
|
||||||
}
|
}
|
||||||
|
|
||||||
static const uint8_t *unmarshal_one(
|
static const uint8_t *unmarshal_one(
|
||||||
@@ -1401,7 +1223,7 @@ static const uint8_t *unmarshal_one(
|
|||||||
}
|
}
|
||||||
case LB_FIBER: {
|
case LB_FIBER: {
|
||||||
JanetFiber *fiber;
|
JanetFiber *fiber;
|
||||||
data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1);
|
data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
|
||||||
*out = janet_wrap_fiber(fiber);
|
*out = janet_wrap_fiber(fiber);
|
||||||
return data;
|
return data;
|
||||||
}
|
}
|
||||||
@@ -1411,19 +1233,18 @@ static const uint8_t *unmarshal_one(
|
|||||||
data++;
|
data++;
|
||||||
int32_t len = readnat(st, &data);
|
int32_t len = readnat(st, &data);
|
||||||
if (len > 255) {
|
if (len > 255) {
|
||||||
janet_panicf("invalid function - too many environments (%d)", len);
|
janet_panicf("invalid function");
|
||||||
}
|
}
|
||||||
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
|
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
|
||||||
len * sizeof(JanetFuncEnv));
|
len * sizeof(JanetFuncEnv));
|
||||||
func->def = NULL;
|
|
||||||
for (int32_t i = 0; i < len; i++) {
|
|
||||||
func->envs[i] = NULL;
|
|
||||||
}
|
|
||||||
*out = janet_wrap_function(func);
|
*out = janet_wrap_function(func);
|
||||||
janet_v_push(st->lookup, *out);
|
janet_v_push(st->lookup, *out);
|
||||||
data = unmarshal_one_def(st, data, &def, flags + 1);
|
data = unmarshal_one_def(st, data, &def, flags + 1);
|
||||||
|
if (def->environments_length != len) {
|
||||||
|
janet_panicf("invalid function");
|
||||||
|
}
|
||||||
func->def = def;
|
func->def = def;
|
||||||
for (int32_t i = 0; i < len; i++) {
|
for (int32_t i = 0; i < def->environments_length; i++) {
|
||||||
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
|
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
|
||||||
}
|
}
|
||||||
return data;
|
return data;
|
||||||
@@ -1434,18 +1255,10 @@ static const uint8_t *unmarshal_one(
|
|||||||
}
|
}
|
||||||
case LB_REFERENCE:
|
case LB_REFERENCE:
|
||||||
case LB_ARRAY:
|
case LB_ARRAY:
|
||||||
case LB_ARRAY_WEAK:
|
|
||||||
case LB_TUPLE:
|
case LB_TUPLE:
|
||||||
case LB_STRUCT:
|
case LB_STRUCT:
|
||||||
case LB_STRUCT_PROTO:
|
|
||||||
case LB_TABLE:
|
case LB_TABLE:
|
||||||
case LB_TABLE_PROTO:
|
case LB_TABLE_PROTO:
|
||||||
case LB_TABLE_WEAKK:
|
|
||||||
case LB_TABLE_WEAKV:
|
|
||||||
case LB_TABLE_WEAKKV:
|
|
||||||
case LB_TABLE_WEAKK_PROTO:
|
|
||||||
case LB_TABLE_WEAKV_PROTO:
|
|
||||||
case LB_TABLE_WEAKKV_PROTO:
|
|
||||||
/* Things that open with integers */
|
/* Things that open with integers */
|
||||||
{
|
{
|
||||||
data++;
|
data++;
|
||||||
@@ -1454,9 +1267,9 @@ static const uint8_t *unmarshal_one(
|
|||||||
if (lead != LB_REFERENCE) {
|
if (lead != LB_REFERENCE) {
|
||||||
MARSH_EOS(st, data - 1 + len);
|
MARSH_EOS(st, data - 1 + len);
|
||||||
}
|
}
|
||||||
if (lead == LB_ARRAY || lead == LB_ARRAY_WEAK) {
|
if (lead == LB_ARRAY) {
|
||||||
/* Array */
|
/* Array */
|
||||||
JanetArray *array = (lead == LB_ARRAY_WEAK) ? janet_array_weak(len) : janet_array(len);
|
JanetArray *array = janet_array(len);
|
||||||
array->count = len;
|
array->count = len;
|
||||||
*out = janet_wrap_array(array);
|
*out = janet_wrap_array(array);
|
||||||
janet_v_push(st->lookup, *out);
|
janet_v_push(st->lookup, *out);
|
||||||
@@ -1473,15 +1286,9 @@ static const uint8_t *unmarshal_one(
|
|||||||
}
|
}
|
||||||
*out = janet_wrap_tuple(janet_tuple_end(tup));
|
*out = janet_wrap_tuple(janet_tuple_end(tup));
|
||||||
janet_v_push(st->lookup, *out);
|
janet_v_push(st->lookup, *out);
|
||||||
} else if (lead == LB_STRUCT || lead == LB_STRUCT_PROTO) {
|
} else if (lead == LB_STRUCT) {
|
||||||
/* Struct */
|
/* Struct */
|
||||||
JanetKV *struct_ = janet_struct_begin(len);
|
JanetKV *struct_ = janet_struct_begin(len);
|
||||||
if (lead == LB_STRUCT_PROTO) {
|
|
||||||
Janet proto;
|
|
||||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
|
||||||
janet_asserttype(proto, JANET_STRUCT, st);
|
|
||||||
janet_struct_proto(struct_) = janet_unwrap_struct(proto);
|
|
||||||
}
|
|
||||||
for (int32_t i = 0; i < len; i++) {
|
for (int32_t i = 0; i < len; i++) {
|
||||||
Janet key, value;
|
Janet key, value;
|
||||||
data = unmarshal_one(st, data, &key, flags + 1);
|
data = unmarshal_one(st, data, &key, flags + 1);
|
||||||
@@ -1496,22 +1303,13 @@ static const uint8_t *unmarshal_one(
|
|||||||
*out = st->lookup[len];
|
*out = st->lookup[len];
|
||||||
} else {
|
} else {
|
||||||
/* Table */
|
/* Table */
|
||||||
JanetTable *t;
|
JanetTable *t = janet_table(len);
|
||||||
if (lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKK) {
|
|
||||||
t = janet_table_weakk(len);
|
|
||||||
} else if (lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKV) {
|
|
||||||
t = janet_table_weakv(len);
|
|
||||||
} else if (lead == LB_TABLE_WEAKKV_PROTO || lead == LB_TABLE_WEAKKV) {
|
|
||||||
t = janet_table_weakkv(len);
|
|
||||||
} else {
|
|
||||||
t = janet_table(len);
|
|
||||||
}
|
|
||||||
*out = janet_wrap_table(t);
|
*out = janet_wrap_table(t);
|
||||||
janet_v_push(st->lookup, *out);
|
janet_v_push(st->lookup, *out);
|
||||||
if (lead == LB_TABLE_PROTO || lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKKV_PROTO) {
|
if (lead == LB_TABLE_PROTO) {
|
||||||
Janet proto;
|
Janet proto;
|
||||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||||
janet_asserttype(proto, JANET_TABLE, st);
|
janet_asserttype(proto, JANET_TABLE);
|
||||||
t->proto = janet_unwrap_table(proto);
|
t->proto = janet_unwrap_table(proto);
|
||||||
}
|
}
|
||||||
for (int32_t i = 0; i < len; i++) {
|
for (int32_t i = 0; i < len; i++) {
|
||||||
@@ -1541,29 +1339,6 @@ static const uint8_t *unmarshal_one(
|
|||||||
janet_v_push(st->lookup, *out);
|
janet_v_push(st->lookup, *out);
|
||||||
return data;
|
return data;
|
||||||
}
|
}
|
||||||
#ifdef JANET_EV
|
|
||||||
case LB_POINTER_BUFFER: {
|
|
||||||
data++;
|
|
||||||
int32_t count = readnat(st, &data);
|
|
||||||
int32_t capacity = readnat(st, &data);
|
|
||||||
MARSH_EOS(st, data + sizeof(void *));
|
|
||||||
union {
|
|
||||||
void *ptr;
|
|
||||||
uint8_t bytes[sizeof(void *)];
|
|
||||||
} u;
|
|
||||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
|
||||||
janet_panicf("unsafe flag not given, "
|
|
||||||
"will not unmarshal raw pointer at index %d",
|
|
||||||
(int)(data - st->start));
|
|
||||||
}
|
|
||||||
memcpy(u.bytes, data, sizeof(void *));
|
|
||||||
data += sizeof(void *);
|
|
||||||
JanetBuffer *buffer = janet_pointer_buffer_unsafe(u.ptr, capacity, count);
|
|
||||||
*out = janet_wrap_buffer(buffer);
|
|
||||||
janet_v_push(st->lookup, *out);
|
|
||||||
return data;
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
case LB_UNSAFE_CFUNCTION: {
|
case LB_UNSAFE_CFUNCTION: {
|
||||||
MARSH_EOS(st, data + sizeof(JanetCFunction));
|
MARSH_EOS(st, data + sizeof(JanetCFunction));
|
||||||
data++;
|
data++;
|
||||||
@@ -1582,42 +1357,6 @@ static const uint8_t *unmarshal_one(
|
|||||||
janet_v_push(st->lookup, *out);
|
janet_v_push(st->lookup, *out);
|
||||||
return data;
|
return data;
|
||||||
}
|
}
|
||||||
#ifdef JANET_EV
|
|
||||||
case LB_THREADED_ABSTRACT: {
|
|
||||||
MARSH_EOS(st, data + sizeof(void *));
|
|
||||||
data++;
|
|
||||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
|
||||||
janet_panicf("unsafe flag not given, "
|
|
||||||
"will not unmarshal threaded abstract pointer at index %d",
|
|
||||||
(int)(data - st->start));
|
|
||||||
}
|
|
||||||
union {
|
|
||||||
void *ptr;
|
|
||||||
uint8_t bytes[sizeof(void *)];
|
|
||||||
} u;
|
|
||||||
memcpy(u.bytes, data, sizeof(void *));
|
|
||||||
data += sizeof(void *);
|
|
||||||
|
|
||||||
if (flags & JANET_MARSHAL_DECREF) {
|
|
||||||
/* Decrement immediately and don't bother putting into heap */
|
|
||||||
janet_abstract_decref(u.ptr);
|
|
||||||
*out = janet_wrap_nil();
|
|
||||||
} else {
|
|
||||||
*out = janet_wrap_abstract(u.ptr);
|
|
||||||
Janet check = janet_table_get(&janet_vm.threaded_abstracts, *out);
|
|
||||||
if (janet_checktype(check, JANET_NIL)) {
|
|
||||||
/* Transfers reference from threaded channel buffer to current heap */
|
|
||||||
janet_table_put(&janet_vm.threaded_abstracts, *out, janet_wrap_false());
|
|
||||||
} else {
|
|
||||||
/* Heap reference already accounted for, remove threaded channel reference. */
|
|
||||||
janet_abstract_decref(u.ptr);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
janet_v_push(st->lookup, *out);
|
|
||||||
return data;
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
default: {
|
default: {
|
||||||
janet_panicf("unknown byte %x at index %d",
|
janet_panicf("unknown byte %x at index %d",
|
||||||
*data,
|
*data,
|
||||||
@@ -1625,6 +1364,7 @@ static const uint8_t *unmarshal_one(
|
|||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
#undef EXTRA
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_unmarshal(
|
Janet janet_unmarshal(
|
||||||
@@ -1651,28 +1391,16 @@ Janet janet_unmarshal(
|
|||||||
|
|
||||||
/* C functions */
|
/* C functions */
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_env_lookup,
|
static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
|
||||||
"(env-lookup env)",
|
|
||||||
"Creates a forward lookup table for unmarshalling from an environment. "
|
|
||||||
"To create a reverse lookup table, use the invert function to swap keys "
|
|
||||||
"and values in the returned table.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetTable *env = janet_gettable(argv, 0);
|
JanetTable *env = janet_gettable(argv, 0);
|
||||||
return janet_wrap_table(janet_env_lookup(env));
|
return janet_wrap_table(janet_env_lookup(env));
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_marshal,
|
static Janet cfun_marshal(int32_t argc, Janet *argv) {
|
||||||
"(marshal x &opt reverse-lookup buffer no-cycles)",
|
janet_arity(argc, 1, 3);
|
||||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
|
||||||
"can then later be unmarshalled to reconstruct the initial value. "
|
|
||||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
|
||||||
"aliased values that are found in the table. Then a forward "
|
|
||||||
"lookup table can be used to recover the original value when "
|
|
||||||
"unmarshalling.") {
|
|
||||||
janet_arity(argc, 1, 4);
|
|
||||||
JanetBuffer *buffer;
|
JanetBuffer *buffer;
|
||||||
JanetTable *rreg = NULL;
|
JanetTable *rreg = NULL;
|
||||||
uint32_t flags = 0;
|
|
||||||
if (argc > 1) {
|
if (argc > 1) {
|
||||||
rreg = janet_gettable(argv, 1);
|
rreg = janet_gettable(argv, 1);
|
||||||
}
|
}
|
||||||
@@ -1681,18 +1409,11 @@ JANET_CORE_FN(cfun_marshal,
|
|||||||
} else {
|
} else {
|
||||||
buffer = janet_buffer(10);
|
buffer = janet_buffer(10);
|
||||||
}
|
}
|
||||||
if (argc > 3 && janet_truthy(argv[3])) {
|
janet_marshal(buffer, argv[0], rreg, 0);
|
||||||
flags |= JANET_MARSHAL_NO_CYCLES;
|
|
||||||
}
|
|
||||||
janet_marshal(buffer, argv[0], rreg, flags);
|
|
||||||
return janet_wrap_buffer(buffer);
|
return janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_unmarshal,
|
static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
|
||||||
"(unmarshal buffer &opt lookup)",
|
|
||||||
"Unmarshal a value from a buffer. An optional lookup table "
|
|
||||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
|
||||||
"unmarshalled from the buffer.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetByteView view = janet_getbytes(argv, 0);
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
JanetTable *reg = NULL;
|
JanetTable *reg = NULL;
|
||||||
@@ -1702,13 +1423,35 @@ JANET_CORE_FN(cfun_unmarshal,
|
|||||||
return janet_unmarshal(view.bytes, (size_t) view.len, 0, reg, NULL);
|
return janet_unmarshal(view.bytes, (size_t) view.len, 0, reg, NULL);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg marsh_cfuns[] = {
|
||||||
|
{
|
||||||
|
"marshal", cfun_marshal,
|
||||||
|
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
|
||||||
|
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||||
|
"can then later be unmarshalled to reconstruct the initial value. "
|
||||||
|
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||||
|
"aliased values that are found in the table. Then a forward "
|
||||||
|
"lookup table can be used to recover the original value when "
|
||||||
|
"unmarshalling.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"unmarshal", cfun_unmarshal,
|
||||||
|
JDOC("(unmarshal buffer &opt lookup)\n\n"
|
||||||
|
"Unmarshal a value from a buffer. An optional lookup table "
|
||||||
|
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||||
|
"unmarshalled from the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"env-lookup", cfun_env_lookup,
|
||||||
|
JDOC("(env-lookup env)\n\n"
|
||||||
|
"Creates a forward lookup table for unmarshalling from an environment. "
|
||||||
|
"To create a reverse lookup table, use the invert function to swap keys "
|
||||||
|
"and values in the returned table.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_marsh(JanetTable *env) {
|
void janet_lib_marsh(JanetTable *env) {
|
||||||
JanetRegExt marsh_cfuns[] = {
|
janet_core_cfuns(env, NULL, marsh_cfuns);
|
||||||
JANET_CORE_REG("marshal", cfun_marshal),
|
|
||||||
JANET_CORE_REG("unmarshal", cfun_unmarshal),
|
|
||||||
JANET_CORE_REG("env-lookup", cfun_env_lookup),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, marsh_cfuns);
|
|
||||||
}
|
}
|
||||||
|
|||||||
486
src/core/math.c
486
src/core/math.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -23,12 +23,13 @@
|
|||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include "features.h"
|
#include "features.h"
|
||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "state.h"
|
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
|
|
||||||
|
static JANET_THREAD_LOCAL JanetRNG janet_vm_rng = {0, 0, 0, 0, 0};
|
||||||
|
|
||||||
static int janet_rng_get(void *p, Janet key, Janet *out);
|
static int janet_rng_get(void *p, Janet key, Janet *out);
|
||||||
static Janet janet_rng_next(void *p, Janet key);
|
static Janet janet_rng_next(void *p, Janet key);
|
||||||
|
|
||||||
@@ -68,7 +69,7 @@ const JanetAbstractType janet_rng_type = {
|
|||||||
};
|
};
|
||||||
|
|
||||||
JanetRNG *janet_default_rng(void) {
|
JanetRNG *janet_default_rng(void) {
|
||||||
return &janet_vm.rng;
|
return &janet_vm_rng;
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_rng_seed(JanetRNG *rng, uint32_t seed) {
|
void janet_rng_seed(JanetRNG *rng, uint32_t seed) {
|
||||||
@@ -85,10 +86,10 @@ void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len) {
|
|||||||
uint8_t state[16] = {0};
|
uint8_t state[16] = {0};
|
||||||
for (int32_t i = 0; i < len; i++)
|
for (int32_t i = 0; i < len; i++)
|
||||||
state[i & 0xF] ^= bytes[i];
|
state[i & 0xF] ^= bytes[i];
|
||||||
rng->a = state[0] + ((uint32_t) state[1] << 8) + ((uint32_t) state[2] << 16) + ((uint32_t) state[3] << 24);
|
rng->a = state[0] + (state[1] << 8) + (state[2] << 16) + (state[3] << 24);
|
||||||
rng->b = state[4] + ((uint32_t) state[5] << 8) + ((uint32_t) state[6] << 16) + ((uint32_t) state[7] << 24);
|
rng->b = state[4] + (state[5] << 8) + (state[6] << 16) + (state[7] << 24);
|
||||||
rng->c = state[8] + ((uint32_t) state[9] << 8) + ((uint32_t) state[10] << 16) + ((uint32_t) state[11] << 24);
|
rng->c = state[8] + (state[9] << 8) + (state[10] << 16) + (state[11] << 24);
|
||||||
rng->d = state[12] + ((uint32_t) state[13] << 8) + ((uint32_t) state[14] << 16) + ((uint32_t) state[15] << 24);
|
rng->d = state[12] + (state[13] << 8) + (state[14] << 16) + (state[15] << 24);
|
||||||
rng->counter = 0u;
|
rng->counter = 0u;
|
||||||
/* a, b, c, d can't all be 0 */
|
/* a, b, c, d can't all be 0 */
|
||||||
if (rng->a == 0) rng->a = 1u;
|
if (rng->a == 0) rng->a = 1u;
|
||||||
@@ -117,12 +118,7 @@ double janet_rng_double(JanetRNG *rng) {
|
|||||||
return ldexp((double)(big >> (64 - 52)), -52);
|
return ldexp((double)(big >> (64 - 52)), -52);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_rng_make,
|
static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||||
"(math/rng &opt seed)",
|
|
||||||
"Creates a Pseudo-Random number generator, with an optional seed. "
|
|
||||||
"The seed should be an unsigned 32 bit integer or a buffer. "
|
|
||||||
"Do not use this for cryptography. Returns a core/rng abstract type."
|
|
||||||
) {
|
|
||||||
janet_arity(argc, 0, 1);
|
janet_arity(argc, 0, 1);
|
||||||
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
|
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
|
||||||
if (argc == 1) {
|
if (argc == 1) {
|
||||||
@@ -139,20 +135,13 @@ JANET_CORE_FN(cfun_rng_make,
|
|||||||
return janet_wrap_abstract(rng);
|
return janet_wrap_abstract(rng);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_rng_uniform,
|
static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
|
||||||
"(math/rng-uniform rng)",
|
|
||||||
"Extract a random number in the range [0, 1) from the RNG."
|
|
||||||
) {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||||
return janet_wrap_number(janet_rng_double(rng));
|
return janet_wrap_number(janet_rng_double(rng));
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_rng_int,
|
static Janet cfun_rng_int(int32_t argc, Janet *argv) {
|
||||||
"(math/rng-int rng &opt max)",
|
|
||||||
"Extract a random integer in the range [0, max) for max > 0 from the RNG. "
|
|
||||||
"If max is 0, return 0. If no max is given, the default is 2^31 - 1."
|
|
||||||
) {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||||
if (argc == 1) {
|
if (argc == 1) {
|
||||||
@@ -180,11 +169,7 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
|
|||||||
buf[3] = (word >> 24) & 0xFF;
|
buf[3] = (word >> 24) & 0xFF;
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_rng_buffer,
|
static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
|
||||||
"(math/rng-buffer rng n &opt buf)",
|
|
||||||
"Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
|
|
||||||
"provided, otherwise appends to the given buffer. Returns the buffer."
|
|
||||||
) {
|
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||||
int32_t n = janet_getnat(argv, 1);
|
int32_t n = janet_getnat(argv, 1);
|
||||||
@@ -229,219 +214,314 @@ static Janet janet_rng_next(void *p, Janet key) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Get a random number */
|
/* Get a random number */
|
||||||
JANET_CORE_FN(janet_rand,
|
static Janet janet_rand(int32_t argc, Janet *argv) {
|
||||||
"(math/random)",
|
|
||||||
"Returns a uniformly distributed random number between 0 and 1.") {
|
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
return janet_wrap_number(janet_rng_double(&janet_vm.rng));
|
return janet_wrap_number(janet_rng_double(&janet_vm_rng));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Seed the random number generator */
|
/* Seed the random number generator */
|
||||||
JANET_CORE_FN(janet_srand,
|
static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||||
"(math/seedrandom seed)",
|
|
||||||
"Set the seed for the random number generator. `seed` should be "
|
|
||||||
"an integer or a buffer."
|
|
||||||
) {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
if (janet_checkint(argv[0])) {
|
if (janet_checkint(argv[0])) {
|
||||||
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
|
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
|
||||||
janet_rng_seed(&janet_vm.rng, seed);
|
janet_rng_seed(&janet_vm_rng, seed);
|
||||||
} else {
|
} else {
|
||||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||||
janet_rng_longseed(&janet_vm.rng, bytes.bytes, bytes.len);
|
janet_rng_longseed(&janet_vm_rng, bytes.bytes, bytes.len);
|
||||||
}
|
}
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
#define JANET_DEFINE_NAMED_MATHOP(janet_name, fop, doc)\
|
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||||
JANET_CORE_FN(janet_##fop, "(math/" janet_name " x)", doc) {\
|
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||||
janet_fixarity(argc, 1); \
|
janet_fixarity(argc, 1); \
|
||||||
double x = janet_getnumber(argv, 0); \
|
double x = janet_getnumber(argv, 0); \
|
||||||
return janet_wrap_number(fop(x)); \
|
return janet_wrap_number(fop(x)); \
|
||||||
}
|
}
|
||||||
|
|
||||||
#define JANET_DEFINE_MATHOP(fop, doc) JANET_DEFINE_NAMED_MATHOP(#fop, fop, doc)
|
JANET_DEFINE_MATHOP(acos, acos)
|
||||||
|
JANET_DEFINE_MATHOP(asin, asin)
|
||||||
|
JANET_DEFINE_MATHOP(atan, atan)
|
||||||
|
JANET_DEFINE_MATHOP(cos, cos)
|
||||||
|
JANET_DEFINE_MATHOP(cosh, cosh)
|
||||||
|
JANET_DEFINE_MATHOP(acosh, acosh)
|
||||||
|
JANET_DEFINE_MATHOP(sin, sin)
|
||||||
|
JANET_DEFINE_MATHOP(sinh, sinh)
|
||||||
|
JANET_DEFINE_MATHOP(asinh, asinh)
|
||||||
|
JANET_DEFINE_MATHOP(tan, tan)
|
||||||
|
JANET_DEFINE_MATHOP(tanh, tanh)
|
||||||
|
JANET_DEFINE_MATHOP(atanh, atanh)
|
||||||
|
JANET_DEFINE_MATHOP(exp, exp)
|
||||||
|
JANET_DEFINE_MATHOP(exp2, exp2)
|
||||||
|
JANET_DEFINE_MATHOP(expm1, expm1)
|
||||||
|
JANET_DEFINE_MATHOP(log, log)
|
||||||
|
JANET_DEFINE_MATHOP(log10, log10)
|
||||||
|
JANET_DEFINE_MATHOP(log2, log2)
|
||||||
|
JANET_DEFINE_MATHOP(sqrt, sqrt)
|
||||||
|
JANET_DEFINE_MATHOP(cbrt, cbrt)
|
||||||
|
JANET_DEFINE_MATHOP(ceil, ceil)
|
||||||
|
JANET_DEFINE_MATHOP(fabs, fabs)
|
||||||
|
JANET_DEFINE_MATHOP(floor, floor)
|
||||||
|
JANET_DEFINE_MATHOP(trunc, trunc)
|
||||||
|
JANET_DEFINE_MATHOP(round, round)
|
||||||
|
JANET_DEFINE_MATHOP(gamma, lgamma)
|
||||||
|
JANET_DEFINE_MATHOP(log1p, log1p)
|
||||||
|
JANET_DEFINE_MATHOP(erf, erf)
|
||||||
|
JANET_DEFINE_MATHOP(erfc, erfc)
|
||||||
|
|
||||||
JANET_DEFINE_MATHOP(acos, "Returns the arccosine of x.")
|
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||||
JANET_DEFINE_MATHOP(asin, "Returns the arcsin of x.")
|
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||||
JANET_DEFINE_MATHOP(atan, "Returns the arctangent of x.")
|
|
||||||
JANET_DEFINE_MATHOP(cos, "Returns the cosine of x.")
|
|
||||||
JANET_DEFINE_MATHOP(cosh, "Returns the hyperbolic cosine of x.")
|
|
||||||
JANET_DEFINE_MATHOP(acosh, "Returns the hyperbolic arccosine of x.")
|
|
||||||
JANET_DEFINE_MATHOP(sin, "Returns the sine of x.")
|
|
||||||
JANET_DEFINE_MATHOP(sinh, "Returns the hyperbolic sine of x.")
|
|
||||||
JANET_DEFINE_MATHOP(asinh, "Returns the hyperbolic arcsine of x.")
|
|
||||||
JANET_DEFINE_MATHOP(tan, "Returns the tangent of x.")
|
|
||||||
JANET_DEFINE_MATHOP(tanh, "Returns the hyperbolic tangent of x.")
|
|
||||||
JANET_DEFINE_MATHOP(atanh, "Returns the hyperbolic arctangent of x.")
|
|
||||||
JANET_DEFINE_MATHOP(exp, "Returns e to the power of x.")
|
|
||||||
JANET_DEFINE_MATHOP(exp2, "Returns 2 to the power of x.")
|
|
||||||
JANET_DEFINE_MATHOP(expm1, "Returns e to the power of x minus 1.")
|
|
||||||
JANET_DEFINE_MATHOP(log, "Returns the natural logarithm of x.")
|
|
||||||
JANET_DEFINE_MATHOP(log10, "Returns the log base 10 of x.")
|
|
||||||
JANET_DEFINE_MATHOP(log2, "Returns the log base 2 of x.")
|
|
||||||
JANET_DEFINE_MATHOP(sqrt, "Returns the square root of x.")
|
|
||||||
JANET_DEFINE_MATHOP(cbrt, "Returns the cube root of x.")
|
|
||||||
JANET_DEFINE_MATHOP(ceil, "Returns the smallest integer value number that is not less than x.")
|
|
||||||
JANET_DEFINE_MATHOP(floor, "Returns the largest integer value number that is not greater than x.")
|
|
||||||
JANET_DEFINE_MATHOP(trunc, "Returns the integer between x and 0 nearest to x.")
|
|
||||||
JANET_DEFINE_MATHOP(round, "Returns the integer nearest to x.")
|
|
||||||
JANET_DEFINE_MATHOP(log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
|
||||||
JANET_DEFINE_MATHOP(erf, "Returns the error function of x.")
|
|
||||||
JANET_DEFINE_MATHOP(erfc, "Returns the complementary error function of x.")
|
|
||||||
JANET_DEFINE_NAMED_MATHOP("log-gamma", lgamma, "Returns log-gamma(x).")
|
|
||||||
JANET_DEFINE_NAMED_MATHOP("abs", fabs, "Return the absolute value of x.")
|
|
||||||
JANET_DEFINE_NAMED_MATHOP("gamma", tgamma, "Returns gamma(x).")
|
|
||||||
|
|
||||||
#define JANET_DEFINE_MATH2OP(name, fop, signature, doc)\
|
|
||||||
JANET_CORE_FN(janet_##name, signature, doc) {\
|
|
||||||
janet_fixarity(argc, 2); \
|
janet_fixarity(argc, 2); \
|
||||||
double lhs = janet_getnumber(argv, 0); \
|
double lhs = janet_getnumber(argv, 0); \
|
||||||
double rhs = janet_getnumber(argv, 1); \
|
double rhs = janet_getnumber(argv, 1); \
|
||||||
return janet_wrap_number(fop(lhs, rhs)); \
|
return janet_wrap_number(fop(lhs, rhs)); \
|
||||||
}
|
}\
|
||||||
|
|
||||||
JANET_DEFINE_MATH2OP(atan2, atan2, "(math/atan2 y x)", "Returns the arctangent of y/x. Works even when x is 0.")
|
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||||
JANET_DEFINE_MATH2OP(pow, pow, "(math/pow a x)", "Returns a to the power of x.")
|
JANET_DEFINE_MATH2OP(pow, pow)
|
||||||
JANET_DEFINE_MATH2OP(hypot, hypot, "(math/hypot a b)", "Returns c from the equation c^2 = a^2 + b^2.")
|
JANET_DEFINE_MATH2OP(hypot, hypot)
|
||||||
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point value after x in the direction of y.")
|
JANET_DEFINE_MATH2OP(nextafter, nextafter)
|
||||||
|
|
||||||
JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
|
static Janet janet_not(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
return janet_wrap_boolean(!janet_truthy(argv[0]));
|
return janet_wrap_boolean(!janet_truthy(argv[0]));
|
||||||
}
|
}
|
||||||
|
|
||||||
static double janet_gcd(double x, double y) {
|
static const JanetReg math_cfuns[] = {
|
||||||
if (isnan(x) || isnan(y)) {
|
{
|
||||||
#ifdef NAN
|
"not", janet_not,
|
||||||
return NAN;
|
JDOC("(not x)\n\nReturns the boolean inverse of x.")
|
||||||
#else
|
},
|
||||||
return 0.0 / 0.0;
|
{
|
||||||
#endif
|
"math/random", janet_rand,
|
||||||
}
|
JDOC("(math/random)\n\n"
|
||||||
if (isinf(x) || isinf(y)) return INFINITY;
|
"Returns a uniformly distributed random number between 0 and 1.")
|
||||||
while (y != 0) {
|
},
|
||||||
double temp = y;
|
{
|
||||||
y = fmod(x, y);
|
"math/seedrandom", janet_srand,
|
||||||
x = temp;
|
JDOC("(math/seedrandom seed)\n\n"
|
||||||
}
|
"Set the seed for the random number generator. seed should be "
|
||||||
return x;
|
"an integer or a buffer.")
|
||||||
}
|
},
|
||||||
|
{
|
||||||
static double janet_lcm(double x, double y) {
|
"math/cos", janet_cos,
|
||||||
return (x / janet_gcd(x, y)) * y;
|
JDOC("(math/cos x)\n\n"
|
||||||
}
|
"Returns the cosine of x.")
|
||||||
|
},
|
||||||
JANET_CORE_FN(janet_cfun_gcd, "(math/gcd x y)",
|
{
|
||||||
"Returns the greatest common divisor between x and y.") {
|
"math/sin", janet_sin,
|
||||||
janet_fixarity(argc, 2);
|
JDOC("(math/sin x)\n\n"
|
||||||
double x = janet_getnumber(argv, 0);
|
"Returns the sine of x.")
|
||||||
double y = janet_getnumber(argv, 1);
|
},
|
||||||
return janet_wrap_number(janet_gcd(x, y));
|
{
|
||||||
}
|
"math/tan", janet_tan,
|
||||||
|
JDOC("(math/tan x)\n\n"
|
||||||
JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
|
"Returns the tangent of x.")
|
||||||
"Returns the least common multiple of x and y.") {
|
},
|
||||||
janet_fixarity(argc, 2);
|
{
|
||||||
double x = janet_getnumber(argv, 0);
|
"math/acos", janet_acos,
|
||||||
double y = janet_getnumber(argv, 1);
|
JDOC("(math/acos x)\n\n"
|
||||||
return janet_wrap_number(janet_lcm(x, y));
|
"Returns the arccosine of x.")
|
||||||
}
|
},
|
||||||
|
{
|
||||||
JANET_CORE_FN(janet_cfun_frexp, "(math/frexp x)",
|
"math/asin", janet_asin,
|
||||||
"Returns a tuple of (mantissa, exponent) from number.") {
|
JDOC("(math/asin x)\n\n"
|
||||||
janet_fixarity(argc, 1);
|
"Returns the arcsine of x.")
|
||||||
double x = janet_getnumber(argv, 0);
|
},
|
||||||
int exp;
|
{
|
||||||
x = frexp(x, &exp);
|
"math/atan", janet_atan,
|
||||||
Janet *result = janet_tuple_begin(2);
|
JDOC("(math/atan x)\n\n"
|
||||||
result[0] = janet_wrap_number(x);
|
"Returns the arctangent of x.")
|
||||||
result[1] = janet_wrap_number((double) exp);
|
},
|
||||||
return janet_wrap_tuple(janet_tuple_end(result));
|
{
|
||||||
}
|
"math/exp", janet_exp,
|
||||||
|
JDOC("(math/exp x)\n\n"
|
||||||
JANET_CORE_FN(janet_cfun_ldexp, "(math/ldexp m e)",
|
"Returns e to the power of x.")
|
||||||
"Creates a new number from a mantissa and an exponent.") {
|
},
|
||||||
janet_fixarity(argc, 2);
|
{
|
||||||
double x = janet_getnumber(argv, 0);
|
"math/log", janet_log,
|
||||||
int32_t y = janet_getinteger(argv, 1);
|
JDOC("(math/log x)\n\n"
|
||||||
return janet_wrap_number(ldexp(x, y));
|
"Returns log base natural number of x.")
|
||||||
}
|
},
|
||||||
|
{
|
||||||
|
"math/log10", janet_log10,
|
||||||
|
JDOC("(math/log10 x)\n\n"
|
||||||
|
"Returns log base 10 of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/log2", janet_log2,
|
||||||
|
JDOC("(math/log2 x)\n\n"
|
||||||
|
"Returns log base 2 of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/sqrt", janet_sqrt,
|
||||||
|
JDOC("(math/sqrt x)\n\n"
|
||||||
|
"Returns the square root of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/cbrt", janet_cbrt,
|
||||||
|
JDOC("(math/cbrt x)\n\n"
|
||||||
|
"Returns the cube root of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/floor", janet_floor,
|
||||||
|
JDOC("(math/floor x)\n\n"
|
||||||
|
"Returns the largest integer value number that is not greater than x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/ceil", janet_ceil,
|
||||||
|
JDOC("(math/ceil x)\n\n"
|
||||||
|
"Returns the smallest integer value number that is not less than x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/pow", janet_pow,
|
||||||
|
JDOC("(math/pow a x)\n\n"
|
||||||
|
"Return a to the power of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/abs", janet_fabs,
|
||||||
|
JDOC("(math/abs x)\n\n"
|
||||||
|
"Return the absolute value of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/sinh", janet_sinh,
|
||||||
|
JDOC("(math/sinh x)\n\n"
|
||||||
|
"Return the hyperbolic sine of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/cosh", janet_cosh,
|
||||||
|
JDOC("(math/cosh x)\n\n"
|
||||||
|
"Return the hyperbolic cosine of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/tanh", janet_tanh,
|
||||||
|
JDOC("(math/tanh x)\n\n"
|
||||||
|
"Return the hyperbolic tangent of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/atanh", janet_atanh,
|
||||||
|
JDOC("(math/atanh x)\n\n"
|
||||||
|
"Return the hyperbolic arctangent of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/asinh", janet_asinh,
|
||||||
|
JDOC("(math/asinh x)\n\n"
|
||||||
|
"Return the hyperbolic arcsine of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/acosh", janet_acosh,
|
||||||
|
JDOC("(math/acosh x)\n\n"
|
||||||
|
"Return the hyperbolic arccosine of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/atan2", janet_atan2,
|
||||||
|
JDOC("(math/atan2 y x)\n\n"
|
||||||
|
"Return the arctangent of y/x. Works even when x is 0.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/rng", cfun_rng_make,
|
||||||
|
JDOC("(math/rng &opt seed)\n\n"
|
||||||
|
"Creates a Psuedo-Random number generator, with an optional seed. "
|
||||||
|
"The seed should be an unsigned 32 bit integer or a buffer. "
|
||||||
|
"Do not use this for cryptography. Returns a core/rng abstract type.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/rng-uniform", cfun_rng_uniform,
|
||||||
|
JDOC("(math/rng-seed rng seed)\n\n"
|
||||||
|
"Extract a random number in the range [0, 1) from the RNG.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/rng-int", cfun_rng_int,
|
||||||
|
JDOC("(math/rng-int rng &opt max)\n\n"
|
||||||
|
"Extract a random random integer in the range [0, max] from the RNG. If "
|
||||||
|
"no max is given, the default is 2^31 - 1.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/rng-buffer", cfun_rng_buffer,
|
||||||
|
JDOC("(math/rng-buffer rng n &opt buf)\n\n"
|
||||||
|
"Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
|
||||||
|
"provided, otherwise appends to the given buffer. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/hypot", janet_hypot,
|
||||||
|
JDOC("(math/hypot a b)\n\n"
|
||||||
|
"Returns the c from the equation c^2 = a^2 + b^2")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/exp2", janet_exp2,
|
||||||
|
JDOC("(math/exp2 x)\n\n"
|
||||||
|
"Returns 2 to the power of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/log1p", janet_log1p,
|
||||||
|
JDOC("(math/log1p x)\n\n"
|
||||||
|
"Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/gamma", janet_gamma,
|
||||||
|
JDOC("(math/gamma x)\n\n"
|
||||||
|
"Returns gamma(x).")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/erfc", janet_erfc,
|
||||||
|
JDOC("(math/erfc x)\n\n"
|
||||||
|
"Returns the complementary error function of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/erf", janet_erf,
|
||||||
|
JDOC("(math/erf x)\n\n"
|
||||||
|
"Returns the error function of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/expm1", janet_expm1,
|
||||||
|
JDOC("(math/expm1 x)\n\n"
|
||||||
|
"Returns e to the power of x minus 1.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/trunc", janet_trunc,
|
||||||
|
JDOC("(math/trunc x)\n\n"
|
||||||
|
"Returns the integer between x and 0 nearest to x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/round", janet_round,
|
||||||
|
JDOC("(math/round x)\n\n"
|
||||||
|
"Returns the integer nearest to x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/next", janet_nextafter,
|
||||||
|
JDOC("(math/next x y)\n\n"
|
||||||
|
"Returns the next representable floating point value after x in the direction of y.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_math(JanetTable *env) {
|
void janet_lib_math(JanetTable *env) {
|
||||||
JanetRegExt math_cfuns[] = {
|
janet_core_cfuns(env, NULL, math_cfuns);
|
||||||
JANET_CORE_REG("not", janet_not),
|
|
||||||
JANET_CORE_REG("math/random", janet_rand),
|
|
||||||
JANET_CORE_REG("math/seedrandom", janet_srand),
|
|
||||||
JANET_CORE_REG("math/cos", janet_cos),
|
|
||||||
JANET_CORE_REG("math/sin", janet_sin),
|
|
||||||
JANET_CORE_REG("math/tan", janet_tan),
|
|
||||||
JANET_CORE_REG("math/acos", janet_acos),
|
|
||||||
JANET_CORE_REG("math/asin", janet_asin),
|
|
||||||
JANET_CORE_REG("math/atan", janet_atan),
|
|
||||||
JANET_CORE_REG("math/exp", janet_exp),
|
|
||||||
JANET_CORE_REG("math/log", janet_log),
|
|
||||||
JANET_CORE_REG("math/log10", janet_log10),
|
|
||||||
JANET_CORE_REG("math/log2", janet_log2),
|
|
||||||
JANET_CORE_REG("math/sqrt", janet_sqrt),
|
|
||||||
JANET_CORE_REG("math/cbrt", janet_cbrt),
|
|
||||||
JANET_CORE_REG("math/floor", janet_floor),
|
|
||||||
JANET_CORE_REG("math/ceil", janet_ceil),
|
|
||||||
JANET_CORE_REG("math/pow", janet_pow),
|
|
||||||
JANET_CORE_REG("math/abs", janet_fabs),
|
|
||||||
JANET_CORE_REG("math/sinh", janet_sinh),
|
|
||||||
JANET_CORE_REG("math/cosh", janet_cosh),
|
|
||||||
JANET_CORE_REG("math/tanh", janet_tanh),
|
|
||||||
JANET_CORE_REG("math/atanh", janet_atanh),
|
|
||||||
JANET_CORE_REG("math/asinh", janet_asinh),
|
|
||||||
JANET_CORE_REG("math/acosh", janet_acosh),
|
|
||||||
JANET_CORE_REG("math/atan2", janet_atan2),
|
|
||||||
JANET_CORE_REG("math/rng", cfun_rng_make),
|
|
||||||
JANET_CORE_REG("math/rng-uniform", cfun_rng_uniform),
|
|
||||||
JANET_CORE_REG("math/rng-int", cfun_rng_int),
|
|
||||||
JANET_CORE_REG("math/rng-buffer", cfun_rng_buffer),
|
|
||||||
JANET_CORE_REG("math/hypot", janet_hypot),
|
|
||||||
JANET_CORE_REG("math/exp2", janet_exp2),
|
|
||||||
JANET_CORE_REG("math/log1p", janet_log1p),
|
|
||||||
JANET_CORE_REG("math/gamma", janet_tgamma),
|
|
||||||
JANET_CORE_REG("math/log-gamma", janet_lgamma),
|
|
||||||
JANET_CORE_REG("math/erfc", janet_erfc),
|
|
||||||
JANET_CORE_REG("math/erf", janet_erf),
|
|
||||||
JANET_CORE_REG("math/expm1", janet_expm1),
|
|
||||||
JANET_CORE_REG("math/trunc", janet_trunc),
|
|
||||||
JANET_CORE_REG("math/round", janet_round),
|
|
||||||
JANET_CORE_REG("math/next", janet_nextafter),
|
|
||||||
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
|
|
||||||
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
|
|
||||||
JANET_CORE_REG("math/frexp", janet_cfun_frexp),
|
|
||||||
JANET_CORE_REG("math/ldexp", janet_cfun_ldexp),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, math_cfuns);
|
|
||||||
janet_register_abstract_type(&janet_rng_type);
|
janet_register_abstract_type(&janet_rng_type);
|
||||||
#ifdef JANET_BOOTSTRAP
|
#ifdef JANET_BOOTSTRAP
|
||||||
JANET_CORE_DEF(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||||
"The value pi.");
|
JDOC("The value pi."));
|
||||||
JANET_CORE_DEF(env, "math/e", janet_wrap_number(2.7182818284590451),
|
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
|
||||||
"The base of the natural log.");
|
JDOC("The base of the natural log."));
|
||||||
JANET_CORE_DEF(env, "math/inf", janet_wrap_number(INFINITY),
|
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
|
||||||
"The number representing positive infinity");
|
JDOC("The number representing positive infinity"));
|
||||||
JANET_CORE_DEF(env, "math/-inf", janet_wrap_number(-INFINITY),
|
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
|
||||||
"The number representing negative infinity");
|
JDOC("The number representing negative infinity"));
|
||||||
JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN),
|
janet_def(env, "math/int32-min", janet_wrap_number(INT32_MIN),
|
||||||
"The minimum contiguous integer representable by a 32 bit signed integer");
|
JDOC("The minimum contiguous integer representable by a 32 bit signed integer"));
|
||||||
JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
|
janet_def(env, "math/int32-max", janet_wrap_number(INT32_MAX),
|
||||||
"The maximum contiguous integer representable by a 32 bit signed integer");
|
JDOC("The maximum contiguous integer represtenable by a 32 bit signed integer"));
|
||||||
JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
|
janet_def(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
|
||||||
"The minimum contiguous integer representable by a double (2^53)");
|
JDOC("The minimum contiguous integer representable by a double (2^53)"));
|
||||||
JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
|
janet_def(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
|
||||||
"The maximum contiguous integer representable by a double (-(2^53))");
|
JDOC("The maximum contiguous integer represtenable by a double (-(2^53))"));
|
||||||
#ifdef NAN
|
#ifdef NAN
|
||||||
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
|
janet_def(env, "math/nan", janet_wrap_number(NAN),
|
||||||
#else
|
#else
|
||||||
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(0.0 / 0.0), "Not a number (IEEE-754 NaN)");
|
janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0),
|
||||||
#endif
|
#endif
|
||||||
|
JDOC("Not a number (IEEE-754 NaN)"));
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|||||||
675
src/core/net.c
675
src/core/net.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose and contributors.
|
* Copyright (c) 2021 Calvin Rose and contributors.
|
||||||
*
|
*
|
||||||
* 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
|
||||||
@@ -24,7 +24,6 @@
|
|||||||
#include "features.h"
|
#include "features.h"
|
||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "fiber.h"
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#ifdef JANET_NET
|
#ifdef JANET_NET
|
||||||
@@ -35,13 +34,10 @@
|
|||||||
#include <windows.h>
|
#include <windows.h>
|
||||||
#include <ws2tcpip.h>
|
#include <ws2tcpip.h>
|
||||||
#include <mswsock.h>
|
#include <mswsock.h>
|
||||||
#ifdef JANET_MSVC
|
|
||||||
#pragma comment (lib, "Ws2_32.lib")
|
#pragma comment (lib, "Ws2_32.lib")
|
||||||
#pragma comment (lib, "Mswsock.lib")
|
#pragma comment (lib, "Mswsock.lib")
|
||||||
#pragma comment (lib, "Advapi32.lib")
|
#pragma comment (lib, "Advapi32.lib")
|
||||||
#endif
|
|
||||||
#else
|
#else
|
||||||
#include <arpa/inet.h>
|
|
||||||
#include <unistd.h>
|
#include <unistd.h>
|
||||||
#include <signal.h>
|
#include <signal.h>
|
||||||
#include <sys/ioctl.h>
|
#include <sys/ioctl.h>
|
||||||
@@ -77,23 +73,6 @@ const JanetAbstractType janet_address_type = {
|
|||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* maximum number of bytes in a socket address host (post name resolution) */
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
#ifdef JANET_NO_IPV6
|
|
||||||
#define SA_ADDRSTRLEN (INET_ADDRSTRLEN + 1)
|
|
||||||
#else
|
|
||||||
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
|
|
||||||
#endif
|
|
||||||
typedef unsigned short in_port_t;
|
|
||||||
#else
|
|
||||||
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
|
|
||||||
#ifdef JANET_NO_IPV6
|
|
||||||
#define SA_ADDRSTRLEN JANET_SA_MAX(INET_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
|
|
||||||
#else
|
|
||||||
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
|
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
static JanetStream *make_stream(JSock handle, uint32_t flags);
|
static JanetStream *make_stream(JSock handle, uint32_t flags);
|
||||||
|
|
||||||
/* We pass this flag to all send calls to prevent sigpipe */
|
/* We pass this flag to all send calls to prevent sigpipe */
|
||||||
@@ -120,57 +99,12 @@ static void janet_net_socknoblock(JSock s) {
|
|||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
/* State machine for async connect */
|
|
||||||
|
|
||||||
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
|
||||||
JanetStream *stream = fiber->ev_stream;
|
|
||||||
switch (event) {
|
|
||||||
default:
|
|
||||||
break;
|
|
||||||
#ifndef JANET_WINDOWS
|
|
||||||
/* Wait until we have an actual event before checking.
|
|
||||||
* Windows doesn't support async connect with this, just try immediately.*/
|
|
||||||
case JANET_ASYNC_EVENT_INIT:
|
|
||||||
#endif
|
|
||||||
case JANET_ASYNC_EVENT_DEINIT:
|
|
||||||
return;
|
|
||||||
case JANET_ASYNC_EVENT_CLOSE:
|
|
||||||
janet_cancel(fiber, janet_cstringv("stream closed"));
|
|
||||||
janet_async_end(fiber);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
int res = 0;
|
|
||||||
int size = sizeof(res);
|
|
||||||
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
|
|
||||||
#else
|
|
||||||
int res = 0;
|
|
||||||
socklen_t size = sizeof res;
|
|
||||||
int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
|
|
||||||
#endif
|
|
||||||
if (r == 0) {
|
|
||||||
if (res == 0) {
|
|
||||||
janet_schedule(fiber, janet_wrap_abstract(stream));
|
|
||||||
} else {
|
|
||||||
janet_cancel(fiber, janet_cstringv(janet_strerror(res)));
|
|
||||||
stream->flags |= JANET_STREAM_TOCLOSE;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
janet_cancel(fiber, janet_ev_lasterr());
|
|
||||||
stream->flags |= JANET_STREAM_TOCLOSE;
|
|
||||||
}
|
|
||||||
janet_async_end(fiber);
|
|
||||||
}
|
|
||||||
|
|
||||||
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
|
|
||||||
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* State machine for accepting connections. */
|
/* State machine for accepting connections. */
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
|
JanetListenerState head;
|
||||||
WSAOVERLAPPED overlapped;
|
WSAOVERLAPPED overlapped;
|
||||||
JanetFunction *function;
|
JanetFunction *function;
|
||||||
JanetStream *lstream;
|
JanetStream *lstream;
|
||||||
@@ -178,74 +112,72 @@ typedef struct {
|
|||||||
char buf[1024];
|
char buf[1024];
|
||||||
} NetStateAccept;
|
} NetStateAccept;
|
||||||
|
|
||||||
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err);
|
static int net_sched_accept_impl(NetStateAccept *state, Janet *err);
|
||||||
|
|
||||||
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
|
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
|
||||||
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
|
NetStateAccept *state = (NetStateAccept *)s;
|
||||||
switch (event) {
|
switch (event) {
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
case JANET_ASYNC_EVENT_MARK: {
|
case JANET_ASYNC_EVENT_MARK: {
|
||||||
if (state->lstream) janet_mark(janet_wrap_abstract(state->lstream));
|
if (state->lstream) janet_mark(janet_wrap_abstract(state->lstream));
|
||||||
if (state->astream) janet_mark(janet_wrap_abstract(state->astream));
|
if (state->astream) janet_mark(janet_wrap_abstract(state->astream));
|
||||||
if (state->function) janet_mark(janet_wrap_function(state->function));
|
if (state->function) janet_mark(janet_wrap_abstract(state->function));
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_ASYNC_EVENT_CLOSE:
|
case JANET_ASYNC_EVENT_CLOSE:
|
||||||
janet_schedule(fiber, janet_wrap_nil());
|
janet_schedule(s->fiber, janet_wrap_nil());
|
||||||
janet_async_end(fiber);
|
return JANET_ASYNC_STATUS_DONE;
|
||||||
return;
|
|
||||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||||
if (state->astream->flags & JANET_STREAM_CLOSED) {
|
int seconds;
|
||||||
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
|
int bytes = sizeof(seconds);
|
||||||
janet_async_end(fiber);
|
if (NO_ERROR != getsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_CONNECT_TIME,
|
||||||
return;
|
(char *)&seconds, &bytes)) {
|
||||||
|
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
|
||||||
|
return JANET_ASYNC_STATUS_DONE;
|
||||||
}
|
}
|
||||||
SOCKET lsock = (SOCKET) state->lstream->handle;
|
|
||||||
if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
|
if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
|
||||||
(char *) &lsock, sizeof(lsock))) {
|
(char *) & (state->lstream->handle), sizeof(SOCKET))) {
|
||||||
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
|
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
|
||||||
janet_async_end(fiber);
|
return JANET_ASYNC_STATUS_DONE;
|
||||||
return;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet streamv = janet_wrap_abstract(state->astream);
|
Janet streamv = janet_wrap_abstract(state->astream);
|
||||||
if (state->function) {
|
if (state->function) {
|
||||||
/* Schedule worker */
|
/* Schedule worker */
|
||||||
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
|
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||||
sub_fiber->supervisor_channel = fiber->supervisor_channel;
|
fiber->supervisor_channel = s->fiber->supervisor_channel;
|
||||||
janet_schedule(sub_fiber, janet_wrap_nil());
|
janet_schedule(fiber, janet_wrap_nil());
|
||||||
/* Now listen again for next connection */
|
/* Now listen again for next connection */
|
||||||
Janet err;
|
Janet err;
|
||||||
if (net_sched_accept_impl(state, fiber, &err)) {
|
if (net_sched_accept_impl(state, &err)) {
|
||||||
janet_cancel(fiber, err);
|
janet_cancel(s->fiber, err);
|
||||||
janet_async_end(fiber);
|
return JANET_ASYNC_STATUS_DONE;
|
||||||
return;
|
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
janet_schedule(fiber, streamv);
|
janet_schedule(s->fiber, streamv);
|
||||||
janet_async_end(fiber);
|
return JANET_ASYNC_STATUS_DONE;
|
||||||
return;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||||
Janet err;
|
Janet err;
|
||||||
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
|
SOCKET lsock = (SOCKET) stream->handle;
|
||||||
|
JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||||
|
NetStateAccept *state = (NetStateAccept *)s;
|
||||||
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
|
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
|
||||||
memset(&state->buf, 0, 1024);
|
memset(&state->buf, 0, 1024);
|
||||||
state->function = fun;
|
state->function = fun;
|
||||||
state->lstream = stream;
|
state->lstream = stream;
|
||||||
if (net_sched_accept_impl(state, janet_root_fiber(), &err)) {
|
s->tag = &state->overlapped;
|
||||||
janet_free(state);
|
if (net_sched_accept_impl(state, &err)) janet_panicv(err);
|
||||||
janet_panicv(err);
|
janet_await();
|
||||||
}
|
|
||||||
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err) {
|
static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
|
||||||
SOCKET lsock = (SOCKET) state->lstream->handle;
|
SOCKET lsock = (SOCKET) state->lstream->handle;
|
||||||
SOCKET asock = WSASocketW(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED);
|
SOCKET asock = WSASocketW(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED);
|
||||||
if (asock == INVALID_SOCKET) {
|
if (asock == INVALID_SOCKET) {
|
||||||
@@ -257,11 +189,7 @@ static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet
|
|||||||
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
|
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
|
||||||
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
|
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
|
||||||
int code = WSAGetLastError();
|
int code = WSAGetLastError();
|
||||||
if (code == WSA_IO_PENDING) {
|
if (code == WSA_IO_PENDING) return 0; /* indicates io is happening async */
|
||||||
/* indicates io is happening async */
|
|
||||||
janet_async_in_flight(fiber);
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
*err = janet_ev_lasterr();
|
*err = janet_ev_lasterr();
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -271,12 +199,12 @@ static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet
|
|||||||
#else
|
#else
|
||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
|
JanetListenerState head;
|
||||||
JanetFunction *function;
|
JanetFunction *function;
|
||||||
} NetStateAccept;
|
} NetStateAccept;
|
||||||
|
|
||||||
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
|
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
|
||||||
JanetStream *stream = fiber->ev_stream;
|
NetStateAccept *state = (NetStateAccept *)s;
|
||||||
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
|
|
||||||
switch (event) {
|
switch (event) {
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
@@ -285,47 +213,39 @@ void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_ASYNC_EVENT_CLOSE:
|
case JANET_ASYNC_EVENT_CLOSE:
|
||||||
janet_schedule(fiber, janet_wrap_nil());
|
janet_schedule(s->fiber, janet_wrap_nil());
|
||||||
janet_async_end(fiber);
|
return JANET_ASYNC_STATUS_DONE;
|
||||||
return;
|
|
||||||
case JANET_ASYNC_EVENT_INIT:
|
|
||||||
case JANET_ASYNC_EVENT_READ: {
|
case JANET_ASYNC_EVENT_READ: {
|
||||||
#if defined(JANET_LINUX)
|
JSock connfd = accept(s->stream->handle, NULL, NULL);
|
||||||
JSock connfd = accept4(stream->handle, NULL, NULL, SOCK_CLOEXEC);
|
|
||||||
#else
|
|
||||||
/* On BSDs, CLOEXEC should be inherited from server socket */
|
|
||||||
JSock connfd = accept(stream->handle, NULL, NULL);
|
|
||||||
#endif
|
|
||||||
if (JSOCKVALID(connfd)) {
|
if (JSOCKVALID(connfd)) {
|
||||||
janet_net_socknoblock(connfd);
|
janet_net_socknoblock(connfd);
|
||||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||||
Janet streamv = janet_wrap_abstract(stream);
|
Janet streamv = janet_wrap_abstract(stream);
|
||||||
if (state->function) {
|
if (state->function) {
|
||||||
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
|
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||||
sub_fiber->supervisor_channel = fiber->supervisor_channel;
|
fiber->supervisor_channel = s->fiber->supervisor_channel;
|
||||||
janet_schedule(sub_fiber, janet_wrap_nil());
|
janet_schedule(fiber, janet_wrap_nil());
|
||||||
} else {
|
} else {
|
||||||
janet_schedule(fiber, streamv);
|
janet_schedule(s->fiber, streamv);
|
||||||
janet_async_end(fiber);
|
return JANET_ASYNC_STATUS_DONE;
|
||||||
return;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||||
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
|
NetStateAccept *state = (NetStateAccept *) janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||||
memset(state, 0, sizeof(NetStateAccept));
|
|
||||||
state->function = fun;
|
state->function = fun;
|
||||||
if (fun) janet_stream_level_triggered(stream);
|
janet_await();
|
||||||
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Address info */
|
/* Adress info */
|
||||||
|
|
||||||
static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
|
static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
|
||||||
JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL);
|
JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL);
|
||||||
@@ -339,8 +259,7 @@ static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Needs argc >= offset + 2 */
|
/* Needs argc >= offset + 2 */
|
||||||
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1,
|
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1, otherwise 0 */
|
||||||
* otherwise 0. Also, ignores is_bind when is a unix socket. */
|
|
||||||
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) {
|
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) {
|
||||||
/* Unix socket support - not yet supported on windows. */
|
/* Unix socket support - not yet supported on windows. */
|
||||||
#ifndef JANET_WINDOWS
|
#ifndef JANET_WINDOWS
|
||||||
@@ -366,12 +285,12 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
|
|||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
/* Get host and port */
|
/* Get host and port */
|
||||||
char *host = (char *)janet_getcstring(argv, offset);
|
const char *host = janet_getcstring(argv, offset);
|
||||||
char *port = NULL;
|
const char *port;
|
||||||
if (janet_checkint(argv[offset + 1])) {
|
if (janet_checkint(argv[offset + 1])) {
|
||||||
port = (char *)janet_to_string(argv[offset + 1]);
|
port = (const char *)janet_to_string(argv[offset + 1]);
|
||||||
} else {
|
} else {
|
||||||
port = (char *)janet_optcstring(argv, offset + 2, offset + 1, NULL);
|
port = janet_optcstring(argv, offset + 2, offset + 1, NULL);
|
||||||
}
|
}
|
||||||
/* getaddrinfo */
|
/* getaddrinfo */
|
||||||
struct addrinfo *ai = NULL;
|
struct addrinfo *ai = NULL;
|
||||||
@@ -392,15 +311,7 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
|
|||||||
* C Funs
|
* C Funs
|
||||||
*/
|
*/
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_net_sockaddr,
|
static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) {
|
||||||
"(net/address host port &opt type multi)",
|
|
||||||
"Look up the connection information for a given hostname, port, and connection type. Returns "
|
|
||||||
"a handle that can be used to send datagrams over network without establishing a connection. "
|
|
||||||
"On Posix platforms, you can use :unix for host to connect to a unix domain socket, where the name is "
|
|
||||||
"given in the port argument. On Linux, abstract "
|
|
||||||
"unix domain sockets are specified with a leading '@' character in port. If `multi` is truthy, will "
|
|
||||||
"return all address that match in an array instead of just the first.") {
|
|
||||||
janet_sandbox_assert(JANET_SANDBOX_NET_CONNECT); /* connect OR listen */
|
|
||||||
janet_arity(argc, 2, 4);
|
janet_arity(argc, 2, 4);
|
||||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||||
int is_unix = 0;
|
int is_unix = 0;
|
||||||
@@ -439,50 +350,13 @@ JANET_CORE_FN(cfun_net_sockaddr,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_net_connect,
|
static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||||
"(net/connect host port &opt type bindhost bindport)",
|
janet_arity(argc, 2, 3);
|
||||||
"Open a connection to communicate with a server. Returns a duplex stream "
|
|
||||||
"that can be used to communicate with the server. Type is an optional keyword "
|
|
||||||
"to specify a connection type, either :stream or :datagram. The default is :stream. "
|
|
||||||
"Bindhost is an optional string to select from what address to make the outgoing "
|
|
||||||
"connection, with the default being the same as using the OS's preferred address. ") {
|
|
||||||
janet_sandbox_assert(JANET_SANDBOX_NET_CONNECT);
|
|
||||||
janet_arity(argc, 2, 5);
|
|
||||||
|
|
||||||
/* Check arguments */
|
|
||||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||||
int is_unix = 0;
|
int is_unix = 0;
|
||||||
char *bindhost = (char *) janet_optcstring(argv, argc, 3, NULL);
|
|
||||||
char *bindport = NULL;
|
|
||||||
if (argc >= 5 && janet_checkint(argv[4])) {
|
|
||||||
bindport = (char *)janet_to_string(argv[4]);
|
|
||||||
} else {
|
|
||||||
bindport = (char *)janet_optcstring(argv, argc, 4, NULL);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Where we're connecting to */
|
|
||||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
|
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
|
||||||
|
|
||||||
/* Check if we're binding address */
|
|
||||||
struct addrinfo *binding = NULL;
|
|
||||||
if (bindhost != NULL) {
|
|
||||||
if (is_unix) {
|
|
||||||
freeaddrinfo(ai);
|
|
||||||
janet_panic("bindhost not supported for unix domain sockets");
|
|
||||||
}
|
|
||||||
/* getaddrinfo */
|
|
||||||
struct addrinfo hints;
|
|
||||||
memset(&hints, 0, sizeof(hints));
|
|
||||||
hints.ai_family = AF_UNSPEC;
|
|
||||||
hints.ai_socktype = socktype;
|
|
||||||
hints.ai_flags = 0;
|
|
||||||
int status = getaddrinfo(bindhost, bindport, &hints, &binding);
|
|
||||||
if (status) {
|
|
||||||
freeaddrinfo(ai);
|
|
||||||
janet_panicf("could not get address info for bindhost: %s", gai_strerror(status));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Create socket */
|
/* Create socket */
|
||||||
JSock sock = JSOCKDEFAULT;
|
JSock sock = JSOCKDEFAULT;
|
||||||
void *addr = NULL;
|
void *addr = NULL;
|
||||||
@@ -491,9 +365,7 @@ JANET_CORE_FN(cfun_net_connect,
|
|||||||
if (is_unix) {
|
if (is_unix) {
|
||||||
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||||
if (!JSOCKVALID(sock)) {
|
if (!JSOCKVALID(sock)) {
|
||||||
Janet v = janet_ev_lasterr();
|
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||||
janet_free(ai);
|
|
||||||
janet_panicf("could not create socket: %V", v);
|
|
||||||
}
|
}
|
||||||
addr = (void *) ai;
|
addr = (void *) ai;
|
||||||
addrlen = sizeof(struct sockaddr_un);
|
addrlen = sizeof(struct sockaddr_un);
|
||||||
@@ -503,7 +375,7 @@ JANET_CORE_FN(cfun_net_connect,
|
|||||||
struct addrinfo *rp = NULL;
|
struct addrinfo *rp = NULL;
|
||||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
sock = WSASocketW(rp->ai_family, rp->ai_socktype, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
|
sock = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
|
||||||
#else
|
#else
|
||||||
sock = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
sock = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||||
#endif
|
#endif
|
||||||
@@ -514,48 +386,17 @@ JANET_CORE_FN(cfun_net_connect,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (NULL == addr) {
|
if (NULL == addr) {
|
||||||
Janet v = janet_ev_lasterr();
|
|
||||||
if (binding) freeaddrinfo(binding);
|
|
||||||
freeaddrinfo(ai);
|
freeaddrinfo(ai);
|
||||||
janet_panicf("could not create socket: %V", v);
|
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Bind to bindhost and bindport if given */
|
|
||||||
if (binding) {
|
|
||||||
struct addrinfo *rp = NULL;
|
|
||||||
int did_bind = 0;
|
|
||||||
for (rp = binding; rp != NULL; rp = rp->ai_next) {
|
|
||||||
if (bind(sock, rp->ai_addr, (int) rp->ai_addrlen) == 0) {
|
|
||||||
did_bind = 1;
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (!did_bind) {
|
|
||||||
Janet v = janet_ev_lasterr();
|
|
||||||
freeaddrinfo(binding);
|
|
||||||
freeaddrinfo(ai);
|
|
||||||
JSOCKCLOSE(sock);
|
|
||||||
janet_panicf("could not bind outgoing address: %V", v);
|
|
||||||
} else {
|
|
||||||
freeaddrinfo(binding);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Wrap socket in abstract type JanetStream */
|
|
||||||
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
|
||||||
|
|
||||||
/* Set up the socket for non-blocking IO before connecting */
|
|
||||||
janet_net_socknoblock(sock);
|
|
||||||
|
|
||||||
/* Connect to socket */
|
/* Connect to socket */
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
|
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
|
||||||
int err = WSAGetLastError();
|
|
||||||
freeaddrinfo(ai);
|
freeaddrinfo(ai);
|
||||||
#else
|
#else
|
||||||
int status = connect(sock, addr, addrlen);
|
int status = connect(sock, addr, addrlen);
|
||||||
int err = errno;
|
|
||||||
if (is_unix) {
|
if (is_unix) {
|
||||||
janet_free(ai);
|
janet_free(ai);
|
||||||
} else {
|
} else {
|
||||||
@@ -563,19 +404,17 @@ JANET_CORE_FN(cfun_net_connect,
|
|||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
if (status) {
|
if (status == -1) {
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
if (err != WSAEWOULDBLOCK) {
|
|
||||||
#else
|
|
||||||
if (err != EINPROGRESS) {
|
|
||||||
#endif
|
|
||||||
JSOCKCLOSE(sock);
|
JSOCKCLOSE(sock);
|
||||||
Janet lasterr = janet_ev_lasterr();
|
janet_panicf("could not connect to socket: %V", janet_ev_lasterr());
|
||||||
janet_panicf("could not connect socket: %V", lasterr);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
net_sched_connect(stream);
|
/* Set up the socket for non-blocking IO after connect - TODO - non-blocking connect? */
|
||||||
|
janet_net_socknoblock(sock);
|
||||||
|
|
||||||
|
/* Wrap socket in abstract type JanetStream */
|
||||||
|
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||||
|
return janet_wrap_abstract(stream);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const char *serverify_socket(JSock sfd) {
|
static const char *serverify_socket(JSock sfd) {
|
||||||
@@ -603,14 +442,7 @@ static const char *serverify_socket(JSock sfd) {
|
|||||||
#define JANET_SHUTDOWN_W SHUT_WR
|
#define JANET_SHUTDOWN_W SHUT_WR
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_net_shutdown,
|
static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
|
||||||
"(net/shutdown stream &opt mode)",
|
|
||||||
"Stop communication on this socket in a graceful manner, either in both directions or just "
|
|
||||||
"reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
|
|
||||||
"\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
|
|
||||||
"* `:r` disables reading new data from the socket.\n"
|
|
||||||
"* `:w` disable writing data to the socket.\n\n"
|
|
||||||
"Returns the original socket.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||||
janet_stream_flags(stream, JANET_STREAM_SOCKET);
|
janet_stream_flags(stream, JANET_STREAM_SOCKET);
|
||||||
@@ -641,14 +473,7 @@ JANET_CORE_FN(cfun_net_shutdown,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_net_listen,
|
static Janet cfun_net_listen(int32_t argc, Janet *argv) {
|
||||||
"(net/listen host port &opt type)",
|
|
||||||
"Creates a server. Returns a new stream that is neither readable nor "
|
|
||||||
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
|
|
||||||
"The type parameter specifies the type of network connection, either "
|
|
||||||
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
|
|
||||||
":stream. The host and port arguments are the same as in net/address.") {
|
|
||||||
janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
|
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
|
|
||||||
/* Get host, port, and handler*/
|
/* Get host, port, and handler*/
|
||||||
@@ -722,115 +547,15 @@ JANET_CORE_FN(cfun_net_listen,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Types of socket's we need to deal with - relevant type puns below.
|
static Janet cfun_stream_accept_loop(int32_t argc, Janet *argv) {
|
||||||
struct sockaddr *sa; // Common base structure
|
|
||||||
struct sockaddr_storage *ss; // Size of largest socket address type
|
|
||||||
struct sockaddr_in *sin; // IPv4 address + port
|
|
||||||
struct sockaddr_in6 *sin6; // IPv6 address + port
|
|
||||||
struct sockaddr_un *sun; // Unix Domain Socket Address
|
|
||||||
*/
|
|
||||||
|
|
||||||
/* Turn a socket address into a host, port pair.
|
|
||||||
* For unix domain sockets, returned tuple will have only a single element, the path string. */
|
|
||||||
static Janet janet_so_getname(const void *sa_any) {
|
|
||||||
const struct sockaddr *sa = sa_any;
|
|
||||||
char buffer[SA_ADDRSTRLEN];
|
|
||||||
switch (sa->sa_family) {
|
|
||||||
default:
|
|
||||||
janet_panic("unknown address family");
|
|
||||||
case AF_INET: {
|
|
||||||
const struct sockaddr_in *sai = sa_any;
|
|
||||||
if (!inet_ntop(AF_INET, &(sai->sin_addr), buffer, sizeof(buffer))) {
|
|
||||||
janet_panic("unable to decode ipv4 host address");
|
|
||||||
}
|
|
||||||
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
|
|
||||||
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
|
||||||
}
|
|
||||||
#ifndef JANET_NO_IPV6
|
|
||||||
case AF_INET6: {
|
|
||||||
const struct sockaddr_in6 *sai6 = sa_any;
|
|
||||||
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
|
|
||||||
janet_panic("unable to decode ipv4 host address");
|
|
||||||
}
|
|
||||||
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
|
|
||||||
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
#ifndef JANET_WINDOWS
|
|
||||||
case AF_UNIX: {
|
|
||||||
const struct sockaddr_un *sun = sa_any;
|
|
||||||
Janet pathname;
|
|
||||||
if (sun->sun_path[0] == '\0') {
|
|
||||||
memcpy(buffer, sun->sun_path, sizeof(sun->sun_path));
|
|
||||||
buffer[0] = '@';
|
|
||||||
pathname = janet_cstringv(buffer);
|
|
||||||
} else {
|
|
||||||
pathname = janet_cstringv(sun->sun_path);
|
|
||||||
}
|
|
||||||
return janet_wrap_tuple(janet_tuple_n(&pathname, 1));
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_net_getsockname,
|
|
||||||
"(net/localname stream)",
|
|
||||||
"Gets the local address and port in a tuple in that order.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
JanetStream *js = janet_getabstract(argv, 0, &janet_stream_type);
|
|
||||||
if (js->flags & JANET_STREAM_CLOSED) janet_panic("stream closed");
|
|
||||||
struct sockaddr_storage ss;
|
|
||||||
socklen_t slen = sizeof(ss);
|
|
||||||
memset(&ss, 0, slen);
|
|
||||||
if (getsockname((JSock)js->handle, (struct sockaddr *) &ss, &slen)) {
|
|
||||||
janet_panicf("Failed to get localname on %v: %V", argv[0], janet_ev_lasterr());
|
|
||||||
}
|
|
||||||
janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
|
|
||||||
return janet_so_getname(&ss);
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_net_getpeername,
|
|
||||||
"(net/peername stream)",
|
|
||||||
"Gets the remote peer's address and port in a tuple in that order.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
JanetStream *js = janet_getabstract(argv, 0, &janet_stream_type);
|
|
||||||
if (js->flags & JANET_STREAM_CLOSED) janet_panic("stream closed");
|
|
||||||
struct sockaddr_storage ss;
|
|
||||||
socklen_t slen = sizeof(ss);
|
|
||||||
memset(&ss, 0, slen);
|
|
||||||
if (getpeername((JSock)js->handle, (struct sockaddr *)&ss, &slen)) {
|
|
||||||
janet_panicf("Failed to get peername on %v: %V", argv[0], janet_ev_lasterr());
|
|
||||||
}
|
|
||||||
janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
|
|
||||||
return janet_so_getname(&ss);
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_net_address_unpack,
|
|
||||||
"(net/address-unpack address)",
|
|
||||||
"Given an address returned by net/address, return a host, port pair. Unix domain sockets "
|
|
||||||
"will have only the path in the returned tuple.") {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
struct sockaddr *sa = janet_getabstract(argv, 0, &janet_address_type);
|
|
||||||
return janet_so_getname(sa);
|
|
||||||
}
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_stream_accept_loop,
|
|
||||||
"(net/accept-loop stream handler)",
|
|
||||||
"Shorthand for running a server stream that will continuously accept new connections. "
|
|
||||||
"Blocks the current fiber until the stream is closed, and will return the stream.") {
|
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
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);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_stream_accept,
|
static Janet cfun_stream_accept(int32_t argc, Janet *argv) {
|
||||||
"(net/accept stream &opt timeout)",
|
|
||||||
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
|
|
||||||
"Takes an optional timeout in seconds, after which will return nil. "
|
|
||||||
"Returns a new duplex stream which represents a connection to the client.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
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);
|
||||||
@@ -839,13 +564,7 @@ JANET_CORE_FN(cfun_stream_accept,
|
|||||||
janet_sched_accept(stream, NULL);
|
janet_sched_accept(stream, NULL);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_stream_read,
|
static Janet cfun_stream_read(int32_t argc, Janet *argv) {
|
||||||
"(net/read stream nbytes &opt buf timeout)",
|
|
||||||
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
|
|
||||||
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
|
|
||||||
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
|
|
||||||
"Takes an optional timeout in seconds, after which will return nil. "
|
|
||||||
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") {
|
|
||||||
janet_arity(argc, 2, 4);
|
janet_arity(argc, 2, 4);
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||||
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
||||||
@@ -859,12 +578,10 @@ JANET_CORE_FN(cfun_stream_read,
|
|||||||
if (to != INFINITY) janet_addtimeout(to);
|
if (to != INFINITY) janet_addtimeout(to);
|
||||||
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
|
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
|
||||||
}
|
}
|
||||||
|
janet_await();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_stream_chunk,
|
static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
|
||||||
"(net/chunk stream nbytes &opt buf timeout)",
|
|
||||||
"Same a net/read, but will wait for all n bytes to arrive rather than return early. "
|
|
||||||
"Takes an optional timeout in seconds, after which will return nil.") {
|
|
||||||
janet_arity(argc, 2, 4);
|
janet_arity(argc, 2, 4);
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||||
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
||||||
@@ -873,12 +590,10 @@ JANET_CORE_FN(cfun_stream_chunk,
|
|||||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||||
if (to != INFINITY) janet_addtimeout(to);
|
if (to != INFINITY) janet_addtimeout(to);
|
||||||
janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL);
|
janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL);
|
||||||
|
janet_await();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_stream_recv_from,
|
static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) {
|
||||||
"(net/recv-from stream nbytes buf &opt timeout)",
|
|
||||||
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
|
|
||||||
"packet came from. Takes an optional timeout in seconds, after which will return nil.") {
|
|
||||||
janet_arity(argc, 3, 4);
|
janet_arity(argc, 3, 4);
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||||
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
|
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
|
||||||
@@ -887,13 +602,10 @@ JANET_CORE_FN(cfun_stream_recv_from,
|
|||||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||||
if (to != INFINITY) janet_addtimeout(to);
|
if (to != INFINITY) janet_addtimeout(to);
|
||||||
janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL);
|
janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL);
|
||||||
|
janet_await();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_stream_write,
|
static Janet cfun_stream_write(int32_t argc, Janet *argv) {
|
||||||
"(net/write stream data &opt timeout)",
|
|
||||||
"Write data to a stream, suspending the current fiber until the write "
|
|
||||||
"completes. Takes an optional timeout in seconds, after which will return nil. "
|
|
||||||
"Returns nil, or raises an error if the write failed.") {
|
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||||
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
|
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
|
||||||
@@ -906,13 +618,10 @@ JANET_CORE_FN(cfun_stream_write,
|
|||||||
if (to != INFINITY) janet_addtimeout(to);
|
if (to != INFINITY) janet_addtimeout(to);
|
||||||
janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL);
|
janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL);
|
||||||
}
|
}
|
||||||
|
janet_await();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_stream_send_to,
|
static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
|
||||||
"(net/send-to stream dest data &opt timeout)",
|
|
||||||
"Writes a datagram to a server stream. dest is a the destination address of the packet. "
|
|
||||||
"Takes an optional timeout in seconds, after which will return nil. "
|
|
||||||
"Returns stream.") {
|
|
||||||
janet_arity(argc, 3, 4);
|
janet_arity(argc, 3, 4);
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||||
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
|
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
|
||||||
@@ -926,12 +635,10 @@ JANET_CORE_FN(cfun_stream_send_to,
|
|||||||
if (to != INFINITY) janet_addtimeout(to);
|
if (to != INFINITY) janet_addtimeout(to);
|
||||||
janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL);
|
janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL);
|
||||||
}
|
}
|
||||||
|
janet_await();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_stream_flush,
|
static Janet cfun_stream_flush(int32_t argc, Janet *argv) {
|
||||||
"(net/flush stream)",
|
|
||||||
"Make sure that a stream is not buffering any data. This temporarily disables Nagle's algorithm. "
|
|
||||||
"Use this to make sure data is sent without delay. Returns stream.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||||
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
|
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
|
||||||
@@ -943,104 +650,6 @@ JANET_CORE_FN(cfun_stream_flush,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
struct sockopt_type {
|
|
||||||
const char *name;
|
|
||||||
int level;
|
|
||||||
int optname;
|
|
||||||
enum JanetType type;
|
|
||||||
};
|
|
||||||
|
|
||||||
/* List of supported socket options; The type JANET_POINTER is used
|
|
||||||
* for options that require special handling depending on the type. */
|
|
||||||
static const struct sockopt_type sockopt_type_list[] = {
|
|
||||||
{ "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
|
|
||||||
{ "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
|
|
||||||
{ "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
|
|
||||||
{ "ip-multicast-ttl", IPPROTO_IP, IP_MULTICAST_TTL, JANET_NUMBER },
|
|
||||||
{ "ip-add-membership", IPPROTO_IP, IP_ADD_MEMBERSHIP, JANET_POINTER },
|
|
||||||
{ "ip-drop-membership", IPPROTO_IP, IP_DROP_MEMBERSHIP, JANET_POINTER },
|
|
||||||
#ifndef JANET_NO_IPV6
|
|
||||||
{ "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
|
|
||||||
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
|
|
||||||
#endif
|
|
||||||
{ NULL, 0, 0, JANET_POINTER }
|
|
||||||
};
|
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_net_setsockopt,
|
|
||||||
"(net/setsockopt stream option value)",
|
|
||||||
"set socket options.\n"
|
|
||||||
"\n"
|
|
||||||
"supported options and associated value types:\n"
|
|
||||||
"- :so-broadcast boolean\n"
|
|
||||||
"- :so-reuseaddr boolean\n"
|
|
||||||
"- :so-keepalive boolean\n"
|
|
||||||
"- :ip-multicast-ttl number\n"
|
|
||||||
"- :ip-add-membership string\n"
|
|
||||||
"- :ip-drop-membership string\n"
|
|
||||||
"- :ipv6-join-group string\n"
|
|
||||||
"- :ipv6-leave-group string\n") {
|
|
||||||
janet_arity(argc, 3, 3);
|
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
|
||||||
janet_stream_flags(stream, JANET_STREAM_SOCKET);
|
|
||||||
JanetKeyword optstr = janet_getkeyword(argv, 1);
|
|
||||||
|
|
||||||
const struct sockopt_type *st = sockopt_type_list;
|
|
||||||
while (st->name) {
|
|
||||||
if (janet_cstrcmp(optstr, st->name) == 0) {
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
st++;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (st->name == NULL) {
|
|
||||||
janet_panicf("unknown socket option %q", argv[1]);
|
|
||||||
}
|
|
||||||
|
|
||||||
union {
|
|
||||||
int v_int;
|
|
||||||
struct ip_mreq v_mreq;
|
|
||||||
#ifndef JANET_NO_IPV6
|
|
||||||
struct ipv6_mreq v_mreq6;
|
|
||||||
#endif
|
|
||||||
} val;
|
|
||||||
|
|
||||||
void *optval = (void *)&val;
|
|
||||||
socklen_t optlen = 0;
|
|
||||||
|
|
||||||
if (st->type == JANET_BOOLEAN) {
|
|
||||||
val.v_int = janet_getboolean(argv, 2);
|
|
||||||
optlen = sizeof(val.v_int);
|
|
||||||
} else if (st->type == JANET_NUMBER) {
|
|
||||||
val.v_int = janet_getinteger(argv, 2);
|
|
||||||
optlen = sizeof(val.v_int);
|
|
||||||
} else if (st->optname == IP_ADD_MEMBERSHIP || st->optname == IP_DROP_MEMBERSHIP) {
|
|
||||||
const char *addr = janet_getcstring(argv, 2);
|
|
||||||
memset(&val.v_mreq, 0, sizeof val.v_mreq);
|
|
||||||
val.v_mreq.imr_interface.s_addr = htonl(INADDR_ANY);
|
|
||||||
inet_pton(AF_INET, addr, &val.v_mreq.imr_multiaddr.s_addr);
|
|
||||||
optlen = sizeof(val.v_mreq);
|
|
||||||
#ifndef JANET_NO_IPV6
|
|
||||||
} else if (st->optname == IPV6_JOIN_GROUP || st->optname == IPV6_LEAVE_GROUP) {
|
|
||||||
const char *addr = janet_getcstring(argv, 2);
|
|
||||||
memset(&val.v_mreq6, 0, sizeof val.v_mreq6);
|
|
||||||
val.v_mreq6.ipv6mr_interface = 0;
|
|
||||||
inet_pton(AF_INET6, addr, &val.v_mreq6.ipv6mr_multiaddr);
|
|
||||||
optlen = sizeof(val.v_mreq6);
|
|
||||||
#endif
|
|
||||||
} else {
|
|
||||||
janet_panicf("invalid socket option type");
|
|
||||||
}
|
|
||||||
|
|
||||||
janet_assert(optlen != 0, "invalid socket option value");
|
|
||||||
|
|
||||||
int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
|
|
||||||
if (r == -1) {
|
|
||||||
janet_panicf("setsockopt(%q): %s", argv[1], janet_strerror(errno));
|
|
||||||
}
|
|
||||||
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
|
||||||
|
|
||||||
static const JanetMethod net_stream_methods[] = {
|
static const JanetMethod net_stream_methods[] = {
|
||||||
{"chunk", cfun_stream_chunk},
|
{"chunk", cfun_stream_chunk},
|
||||||
{"close", janet_cfun_stream_close},
|
{"close", janet_cfun_stream_close},
|
||||||
@@ -1051,11 +660,11 @@ static const JanetMethod net_stream_methods[] = {
|
|||||||
{"accept-loop", cfun_stream_accept_loop},
|
{"accept-loop", cfun_stream_accept_loop},
|
||||||
{"send-to", cfun_stream_send_to},
|
{"send-to", cfun_stream_send_to},
|
||||||
{"recv-from", cfun_stream_recv_from},
|
{"recv-from", cfun_stream_recv_from},
|
||||||
|
{"recv-from", cfun_stream_recv_from},
|
||||||
{"evread", janet_cfun_stream_read},
|
{"evread", janet_cfun_stream_read},
|
||||||
{"evchunk", janet_cfun_stream_chunk},
|
{"evchunk", janet_cfun_stream_chunk},
|
||||||
{"evwrite", janet_cfun_stream_write},
|
{"evwrite", janet_cfun_stream_write},
|
||||||
{"shutdown", cfun_net_shutdown},
|
{"shutdown", cfun_net_shutdown},
|
||||||
{"setsockopt", cfun_net_setsockopt},
|
|
||||||
{NULL, NULL}
|
{NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -1063,27 +672,101 @@ static JanetStream *make_stream(JSock handle, uint32_t flags) {
|
|||||||
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
|
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg net_cfuns[] = {
|
||||||
|
{
|
||||||
|
"net/address", cfun_net_sockaddr,
|
||||||
|
JDOC("(net/address host port &opt type)\n\n"
|
||||||
|
"Look up the connection information for a given hostname, port, and connection type. Returns "
|
||||||
|
"a handle that can be used to send datagrams over network without establishing a connection. "
|
||||||
|
"On Posix platforms, you can use :unix for host to connect to a unix domain socket, where the name is "
|
||||||
|
"given in the port argument. On Linux, abstract "
|
||||||
|
"unix domain sockets are specified with a leading '@' character in port.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/listen", cfun_net_listen,
|
||||||
|
JDOC("(net/listen host port &opt type)\n\n"
|
||||||
|
"Creates a server. Returns a new stream that is neither readable nor "
|
||||||
|
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
|
||||||
|
"The type parameter specifies the type of network connection, either "
|
||||||
|
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
|
||||||
|
":stream. The host and port arguments are the same as in net/address.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/accept", cfun_stream_accept,
|
||||||
|
JDOC("(net/accept stream &opt timeout)\n\n"
|
||||||
|
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
|
||||||
|
"Takes an optional timeout in seconds, after which will return nil. "
|
||||||
|
"Returns a new duplex stream which represents a connection to the client.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/accept-loop", cfun_stream_accept_loop,
|
||||||
|
JDOC("(net/accept-loop stream handler)\n\n"
|
||||||
|
"Shorthand for running a server stream that will continuously accept new connections. "
|
||||||
|
"Blocks the current fiber until the stream is closed, and will return the stream.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/read", cfun_stream_read,
|
||||||
|
JDOC("(net/read stream nbytes &opt buf timeout)\n\n"
|
||||||
|
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
|
||||||
|
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
|
||||||
|
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
|
||||||
|
"Takes an optional timeout in seconds, after which will return nil. "
|
||||||
|
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/chunk", cfun_stream_chunk,
|
||||||
|
JDOC("(net/chunk stream nbytes &opt buf timeout)\n\n"
|
||||||
|
"Same a net/read, but will wait for all n bytes to arrive rather than return early. "
|
||||||
|
"Takes an optional timeout in seconds, after which will return nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/write", cfun_stream_write,
|
||||||
|
JDOC("(net/write stream data &opt timeout)\n\n"
|
||||||
|
"Write data to a stream, suspending the current fiber until the write "
|
||||||
|
"completes. Takes an optional timeout in seconds, after which will return nil. "
|
||||||
|
"Returns nil, or raises an error if the write failed.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/send-to", cfun_stream_send_to,
|
||||||
|
JDOC("(net/send-to stream dest data &opt timeout)\n\n"
|
||||||
|
"Writes a datagram to a server stream. dest is a the destination address of the packet. "
|
||||||
|
"Takes an optional timeout in seconds, after which will return nil. "
|
||||||
|
"Returns stream.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/recv-from", cfun_stream_recv_from,
|
||||||
|
JDOC("(net/recv-from stream nbytes buf &opt timoeut)\n\n"
|
||||||
|
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
|
||||||
|
"packet came from. Takes an optional timeout in seconds, after which will return nil.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/flush", cfun_stream_flush,
|
||||||
|
JDOC("(net/flush stream)\n\n"
|
||||||
|
"Make sure that a stream is not buffering any data. This temporarily disables Nagle's algorithm. "
|
||||||
|
"Use this to make sure data is sent without delay. Returns stream.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/connect", cfun_net_connect,
|
||||||
|
JDOC("(net/connect host port &opt type)\n\n"
|
||||||
|
"Open a connection to communicate with a server. Returns a duplex stream "
|
||||||
|
"that can be used to communicate with the server. Type is an optional keyword "
|
||||||
|
"to specify a connection type, either :stream or :datagram. The default is :stream. ")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"net/shutdown", cfun_net_shutdown,
|
||||||
|
JDOC("(net/shutdown stream &opt mode)\n\n"
|
||||||
|
"Stop communication on this socket in a graceful manner, either in both directions or just "
|
||||||
|
"reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
|
||||||
|
"\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
|
||||||
|
"* `:r` disables reading new data from the socket.\n"
|
||||||
|
"* `:w` disable writing data to the socket.\n\n"
|
||||||
|
"Returns the original socket.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
void janet_lib_net(JanetTable *env) {
|
void janet_lib_net(JanetTable *env) {
|
||||||
JanetRegExt net_cfuns[] = {
|
janet_core_cfuns(env, NULL, net_cfuns);
|
||||||
JANET_CORE_REG("net/address", cfun_net_sockaddr),
|
|
||||||
JANET_CORE_REG("net/listen", cfun_net_listen),
|
|
||||||
JANET_CORE_REG("net/accept", cfun_stream_accept),
|
|
||||||
JANET_CORE_REG("net/accept-loop", cfun_stream_accept_loop),
|
|
||||||
JANET_CORE_REG("net/read", cfun_stream_read),
|
|
||||||
JANET_CORE_REG("net/chunk", cfun_stream_chunk),
|
|
||||||
JANET_CORE_REG("net/write", cfun_stream_write),
|
|
||||||
JANET_CORE_REG("net/send-to", cfun_stream_send_to),
|
|
||||||
JANET_CORE_REG("net/recv-from", cfun_stream_recv_from),
|
|
||||||
JANET_CORE_REG("net/flush", cfun_stream_flush),
|
|
||||||
JANET_CORE_REG("net/connect", cfun_net_connect),
|
|
||||||
JANET_CORE_REG("net/shutdown", cfun_net_shutdown),
|
|
||||||
JANET_CORE_REG("net/peername", cfun_net_getpeername),
|
|
||||||
JANET_CORE_REG("net/localname", cfun_net_getsockname),
|
|
||||||
JANET_CORE_REG("net/address-unpack", cfun_net_address_unpack),
|
|
||||||
JANET_CORE_REG("net/setsockopt", cfun_net_setsockopt),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, net_cfuns);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_net_init(void) {
|
void janet_net_init(void) {
|
||||||
|
|||||||
1421
src/core/os.c
1421
src/core/os.c
File diff suppressed because it is too large
Load Diff
300
src/core/parse.c
300
src/core/parse.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -51,15 +51,15 @@ static const uint32_t symchars[8] = {
|
|||||||
};
|
};
|
||||||
|
|
||||||
/* Check if a character is a valid symbol character
|
/* Check if a character is a valid symbol character
|
||||||
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_| */
|
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
|
||||||
int janet_is_symbol_char(uint8_t c) {
|
static int is_symbol_char(uint8_t c) {
|
||||||
return symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
return symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Validate some utf8. Useful for identifiers. Only validates
|
/* Validate some utf8. Useful for identifiers. Only validates
|
||||||
* the encoding, does not check for valid code points (they
|
* the encoding, does not check for valid code points (they
|
||||||
* are less well defined than the encoding). */
|
* are less well defined than the encoding). */
|
||||||
int janet_valid_utf8(const uint8_t *str, int32_t len) {
|
static int valid_utf8(const uint8_t *str, int32_t len) {
|
||||||
int32_t i = 0;
|
int32_t i = 0;
|
||||||
int32_t j;
|
int32_t j;
|
||||||
while (i < len) {
|
while (i < len) {
|
||||||
@@ -206,37 +206,6 @@ static void popstate(JanetParser *p, Janet val) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static void delim_error(JanetParser *parser, size_t stack_index, char c, const char *msg) {
|
|
||||||
JanetParseState *s = parser->states + stack_index;
|
|
||||||
JanetBuffer *buffer = janet_buffer(40);
|
|
||||||
if (msg) {
|
|
||||||
janet_buffer_push_cstring(buffer, msg);
|
|
||||||
}
|
|
||||||
if (c) {
|
|
||||||
janet_buffer_push_u8(buffer, c);
|
|
||||||
}
|
|
||||||
if (stack_index > 0) {
|
|
||||||
janet_buffer_push_cstring(buffer, ", ");
|
|
||||||
if (s->flags & PFLAG_PARENS) {
|
|
||||||
janet_buffer_push_u8(buffer, '(');
|
|
||||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
|
||||||
janet_buffer_push_u8(buffer, '[');
|
|
||||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
|
||||||
janet_buffer_push_u8(buffer, '{');
|
|
||||||
} else if (s->flags & PFLAG_STRING) {
|
|
||||||
janet_buffer_push_u8(buffer, '"');
|
|
||||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
|
||||||
int32_t i;
|
|
||||||
for (i = 0; i < s->argn; i++) {
|
|
||||||
janet_buffer_push_u8(buffer, '`');
|
|
||||||
}
|
|
||||||
}
|
|
||||||
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
|
||||||
}
|
|
||||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
|
||||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
|
||||||
}
|
|
||||||
|
|
||||||
static int checkescape(uint8_t c) {
|
static int checkescape(uint8_t c) {
|
||||||
switch (c) {
|
switch (c) {
|
||||||
default:
|
default:
|
||||||
@@ -259,14 +228,6 @@ static int checkescape(uint8_t c) {
|
|||||||
return '\f';
|
return '\f';
|
||||||
case 'v':
|
case 'v':
|
||||||
return '\v';
|
return '\v';
|
||||||
case 'a':
|
|
||||||
return '\a';
|
|
||||||
case 'b':
|
|
||||||
return '\b';
|
|
||||||
case '\'':
|
|
||||||
return '\'';
|
|
||||||
case '?':
|
|
||||||
return '?';
|
|
||||||
case 'e':
|
case 'e':
|
||||||
return 27;
|
return 27;
|
||||||
case '"':
|
case '"':
|
||||||
@@ -450,7 +411,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
Janet ret;
|
Janet ret;
|
||||||
double numval;
|
double numval;
|
||||||
int32_t blen;
|
int32_t blen;
|
||||||
if (janet_is_symbol_char(c)) {
|
if (is_symbol_char(c)) {
|
||||||
push_buf(p, (uint8_t) c);
|
push_buf(p, (uint8_t) c);
|
||||||
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
|
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
|
||||||
return 1;
|
return 1;
|
||||||
@@ -461,19 +422,14 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
|
int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
|
||||||
if (p->buf[0] == ':') {
|
if (p->buf[0] == ':') {
|
||||||
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
||||||
int valid = (!state->argn) || janet_valid_utf8(p->buf + 1, blen - 1);
|
int valid = (!state->argn) || valid_utf8(p->buf + 1, blen - 1);
|
||||||
if (!valid) {
|
if (!valid) {
|
||||||
p->error = "invalid utf-8 in keyword";
|
p->error = "invalid utf-8 in keyword";
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
ret = janet_keywordv(p->buf + 1, blen - 1);
|
ret = janet_keywordv(p->buf + 1, blen - 1);
|
||||||
#ifdef JANET_INT_TYPES
|
|
||||||
} else if (start_num && !janet_scan_numeric(p->buf, blen, &ret)) {
|
|
||||||
(void) numval;
|
|
||||||
#else
|
|
||||||
} else if (start_num && !janet_scan_number(p->buf, blen, &numval)) {
|
} else if (start_num && !janet_scan_number(p->buf, blen, &numval)) {
|
||||||
ret = janet_wrap_number(numval);
|
ret = janet_wrap_number(numval);
|
||||||
#endif
|
|
||||||
} else if (!check_str_const("nil", p->buf, blen)) {
|
} else if (!check_str_const("nil", p->buf, blen)) {
|
||||||
ret = janet_wrap_nil();
|
ret = janet_wrap_nil();
|
||||||
} else if (!check_str_const("false", p->buf, blen)) {
|
} else if (!check_str_const("false", p->buf, blen)) {
|
||||||
@@ -486,7 +442,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
return 0;
|
return 0;
|
||||||
} else {
|
} else {
|
||||||
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
||||||
int valid = (!state->argn) || janet_valid_utf8(p->buf, blen);
|
int valid = (!state->argn) || valid_utf8(p->buf, blen);
|
||||||
if (!valid) {
|
if (!valid) {
|
||||||
p->error = "invalid utf-8 in symbol";
|
p->error = "invalid utf-8 in symbol";
|
||||||
return 0;
|
return 0;
|
||||||
@@ -626,7 +582,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
switch (c) {
|
switch (c) {
|
||||||
default:
|
default:
|
||||||
if (is_whitespace(c)) return 1;
|
if (is_whitespace(c)) return 1;
|
||||||
if (!janet_is_symbol_char(c)) {
|
if (!is_symbol_char(c)) {
|
||||||
p->error = "unexpected character";
|
p->error = "unexpected character";
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -656,7 +612,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
case '}': {
|
case '}': {
|
||||||
Janet ds;
|
Janet ds;
|
||||||
if (p->statecount == 1) {
|
if (p->statecount == 1) {
|
||||||
delim_error(p, 0, c, "unexpected closing delimiter ");
|
p->error = "unexpected delimiter";
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
||||||
@@ -677,7 +633,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
ds = close_struct(p, state);
|
ds = close_struct(p, state);
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
delim_error(p, p->statecount - 1, c, "mismatched delimiter ");
|
p->error = "mismatched delimiter";
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
popstate(p, ds);
|
popstate(p, ds);
|
||||||
@@ -728,7 +684,26 @@ void janet_parser_eof(JanetParser *parser) {
|
|||||||
size_t oldline = parser->line;
|
size_t oldline = parser->line;
|
||||||
janet_parser_consume(parser, '\n');
|
janet_parser_consume(parser, '\n');
|
||||||
if (parser->statecount > 1) {
|
if (parser->statecount > 1) {
|
||||||
delim_error(parser, parser->statecount - 1, 0, "unexpected end of source");
|
JanetParseState *s = parser->states + (parser->statecount - 1);
|
||||||
|
JanetBuffer *buffer = janet_buffer(40);
|
||||||
|
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
|
||||||
|
if (s->flags & PFLAG_PARENS) {
|
||||||
|
janet_buffer_push_u8(buffer, '(');
|
||||||
|
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||||
|
janet_buffer_push_u8(buffer, '[');
|
||||||
|
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||||
|
janet_buffer_push_u8(buffer, '{');
|
||||||
|
} else if (s->flags & PFLAG_STRING) {
|
||||||
|
janet_buffer_push_u8(buffer, '"');
|
||||||
|
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||||
|
int32_t i;
|
||||||
|
for (i = 0; i < s->argn; i++) {
|
||||||
|
janet_buffer_push_u8(buffer, '`');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
||||||
|
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||||
|
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||||
}
|
}
|
||||||
parser->line = oldline;
|
parser->line = oldline;
|
||||||
parser->column = oldcolumn;
|
parser->column = oldcolumn;
|
||||||
@@ -771,7 +746,6 @@ Janet janet_parser_produce(JanetParser *parser) {
|
|||||||
}
|
}
|
||||||
parser->pending--;
|
parser->pending--;
|
||||||
parser->argcount--;
|
parser->argcount--;
|
||||||
parser->states[0].argn--;
|
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -785,7 +759,6 @@ Janet janet_parser_produce_wrapped(JanetParser *parser) {
|
|||||||
}
|
}
|
||||||
parser->pending--;
|
parser->pending--;
|
||||||
parser->argcount--;
|
parser->argcount--;
|
||||||
parser->states[0].argn--;
|
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -905,10 +878,7 @@ const JanetAbstractType janet_parser_type = {
|
|||||||
};
|
};
|
||||||
|
|
||||||
/* C Function parser */
|
/* C Function parser */
|
||||||
JANET_CORE_FN(cfun_parse_parser,
|
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
|
||||||
"(parser/new)",
|
|
||||||
"Creates and returns a new parser object. Parsers are state machines "
|
|
||||||
"that can receive bytes and generate a stream of values.") {
|
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||||
@@ -916,11 +886,7 @@ JANET_CORE_FN(cfun_parse_parser,
|
|||||||
return janet_wrap_abstract(p);
|
return janet_wrap_abstract(p);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_consume,
|
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||||
"(parser/consume parser bytes &opt index)",
|
|
||||||
"Input bytes into the parser and parse them. Will not throw errors "
|
|
||||||
"if there is a parse error. Starts at the byte index given by `index`. Returns "
|
|
||||||
"the number of bytes read.") {
|
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
JanetByteView view = janet_getbytes(argv, 1);
|
JanetByteView view = janet_getbytes(argv, 1);
|
||||||
@@ -945,20 +911,14 @@ JANET_CORE_FN(cfun_parse_consume,
|
|||||||
return janet_wrap_integer(i);
|
return janet_wrap_integer(i);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_eof,
|
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
|
||||||
"(parser/eof parser)",
|
|
||||||
"Indicate to the parser that the end of file was reached. This puts the parser in the :dead state.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
janet_parser_eof(p);
|
janet_parser_eof(p);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_insert,
|
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||||
"(parser/insert parser value)",
|
|
||||||
"Insert a value into the parser. This means that the parser state can be manipulated "
|
|
||||||
"in between chunks of bytes. This would allow a user to add extra elements to arrays "
|
|
||||||
"and tuples, for example. Returns the parser.") {
|
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
JanetParseState *s = p->states + p->statecount - 1;
|
JanetParseState *s = p->states + p->statecount - 1;
|
||||||
@@ -997,17 +957,13 @@ JANET_CORE_FN(cfun_parse_insert,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_has_more,
|
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
|
||||||
"(parser/has-more parser)",
|
|
||||||
"Check if the parser has more values in the value queue.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
return janet_wrap_boolean(janet_parser_has_more(p));
|
return janet_wrap_boolean(janet_parser_has_more(p));
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_byte,
|
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||||
"(parser/byte parser b)",
|
|
||||||
"Input a single byte `b` into the parser byte stream. Returns the parser.") {
|
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
int32_t i = janet_getinteger(argv, 1);
|
int32_t i = janet_getinteger(argv, 1);
|
||||||
@@ -1015,13 +971,7 @@ JANET_CORE_FN(cfun_parse_byte,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_status,
|
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||||
"(parser/status parser)",
|
|
||||||
"Gets the current status of the parser state machine. The status will "
|
|
||||||
"be one of:\n\n"
|
|
||||||
"* :pending - a value is being parsed.\n\n"
|
|
||||||
"* :error - a parsing error was encountered.\n\n"
|
|
||||||
"* :root - the parser can either read more values or safely terminate.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
const char *stat = NULL;
|
const char *stat = NULL;
|
||||||
@@ -1042,12 +992,7 @@ JANET_CORE_FN(cfun_parse_status,
|
|||||||
return janet_ckeywordv(stat);
|
return janet_ckeywordv(stat);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_error,
|
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||||
"(parser/error parser)",
|
|
||||||
"If the parser is in the error state, returns the message associated with "
|
|
||||||
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
|
|
||||||
"queue, so be sure to handle everything in the queue before calling "
|
|
||||||
"`parser/error`.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
const char *err = janet_parser_error(p);
|
const char *err = janet_parser_error(p);
|
||||||
@@ -1059,13 +1004,7 @@ JANET_CORE_FN(cfun_parse_error,
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_produce,
|
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||||
"(parser/produce parser &opt wrap)",
|
|
||||||
"Dequeue the next value in the parse queue. Will return nil if "
|
|
||||||
"no parsed values are in the queue, otherwise will dequeue the "
|
|
||||||
"next value. If `wrap` is truthy, will return a 1-element tuple that "
|
|
||||||
"wraps the result. This tuple can be used for source-mapping "
|
|
||||||
"purposes.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
if (argc == 2 && janet_truthy(argv[1])) {
|
if (argc == 2 && janet_truthy(argv[1])) {
|
||||||
@@ -1075,22 +1014,14 @@ JANET_CORE_FN(cfun_parse_produce,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_flush,
|
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||||
"(parser/flush parser)",
|
|
||||||
"Clears the parser state and parse queue. Can be used to reset the parser "
|
|
||||||
"if an error was encountered. Does not reset the line and column counter, so "
|
|
||||||
"to begin parsing in a new context, create a new parser.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
janet_parser_flush(p);
|
janet_parser_flush(p);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_where,
|
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||||
"(parser/where parser &opt line col)",
|
|
||||||
"Returns the current line number and column of the parser's internal state. If line is "
|
|
||||||
"provided, the current line number of the parser is first set to that value. If column is "
|
|
||||||
"also provided, the current column number of the parser is also first set to that value.") {
|
|
||||||
janet_arity(argc, 1, 3);
|
janet_arity(argc, 1, 3);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
if (argc > 1) {
|
if (argc > 1) {
|
||||||
@@ -1120,9 +1051,8 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
|||||||
|
|
||||||
if (s->flags & PFLAG_CONTAINER) {
|
if (s->flags & PFLAG_CONTAINER) {
|
||||||
JanetArray *container_args = janet_array(s->argn);
|
JanetArray *container_args = janet_array(s->argn);
|
||||||
for (int32_t i = 0; i < s->argn; i++) {
|
container_args->count = s->argn;
|
||||||
janet_array_push(container_args, args[i]);
|
safe_memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||||
}
|
|
||||||
janet_table_put(state, janet_ckeywordv("args"),
|
janet_table_put(state, janet_ckeywordv("args"),
|
||||||
janet_wrap_array(container_args));
|
janet_wrap_array(container_args));
|
||||||
}
|
}
|
||||||
@@ -1207,8 +1137,7 @@ static Janet parser_state_delimiters(const JanetParser *_p) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
/* avoid ptr arithmetic on NULL */
|
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||||
str = janet_string(oldcount ? p->buf + oldcount : p->buf, (int32_t)(p->bufcount - oldcount));
|
|
||||||
p->bufcount = oldcount;
|
p->bufcount = oldcount;
|
||||||
return janet_wrap_string(str);
|
return janet_wrap_string(str);
|
||||||
}
|
}
|
||||||
@@ -1218,15 +1147,11 @@ static Janet parser_state_frames(const JanetParser *p) {
|
|||||||
JanetArray *states = janet_array(count);
|
JanetArray *states = janet_array(count);
|
||||||
states->count = count;
|
states->count = count;
|
||||||
uint8_t *buf = p->buf;
|
uint8_t *buf = p->buf;
|
||||||
/* Iterate arg stack backwards */
|
Janet *args = p->args;
|
||||||
Janet *args = p->argcount ? p->args + p->argcount : p->args; /* avoid ptr arithmetic on NULL */
|
|
||||||
for (int32_t i = count - 1; i >= 0; --i) {
|
for (int32_t i = count - 1; i >= 0; --i) {
|
||||||
JanetParseState *s = p->states + i;
|
JanetParseState *s = p->states + i;
|
||||||
/* avoid ptr arithmetic on args if NULL */
|
|
||||||
if ((s->flags & PFLAG_CONTAINER) && s->argn) {
|
|
||||||
args -= s->argn;
|
|
||||||
}
|
|
||||||
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
|
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
|
||||||
|
args -= s->argn;
|
||||||
}
|
}
|
||||||
return janet_wrap_array(states);
|
return janet_wrap_array(states);
|
||||||
}
|
}
|
||||||
@@ -1237,16 +1162,7 @@ static const struct ParserStateGetter parser_state_getters[] = {
|
|||||||
{NULL, NULL}
|
{NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_state,
|
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||||
"(parser/state parser &opt key)",
|
|
||||||
"Returns a representation of the internal state of the parser. If a key is passed, "
|
|
||||||
"only that information about the state is returned. Allowed keys are:\n\n"
|
|
||||||
"* :delimiters - Each byte in the string represents a nested data structure. For example, "
|
|
||||||
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
|
||||||
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.\n\n"
|
|
||||||
"* :frames - Each table in the array represents a 'frame' in the parser state. Frames "
|
|
||||||
"contain information about the start of the expression being parsed as well as the "
|
|
||||||
"type of that expression and some type-specific information.") {
|
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
const uint8_t *key = NULL;
|
const uint8_t *key = NULL;
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
@@ -1274,11 +1190,7 @@ JANET_CORE_FN(cfun_parse_state,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_parse_clone,
|
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
|
||||||
"(parser/clone p)",
|
|
||||||
"Creates a deep clone of a parser that is identical to the input parser. "
|
|
||||||
"This cloned parser can be used to continue parsing from a good checkpoint "
|
|
||||||
"if parsing later fails. Returns a new parser.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
|
JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
|
||||||
JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||||
@@ -1313,23 +1225,105 @@ static Janet parsernext(void *p, Janet key) {
|
|||||||
return janet_nextmethod(parser_methods, key);
|
return janet_nextmethod(parser_methods, key);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg parse_cfuns[] = {
|
||||||
|
{
|
||||||
|
"parser/new", cfun_parse_parser,
|
||||||
|
JDOC("(parser/new)\n\n"
|
||||||
|
"Creates and returns a new parser object. Parsers are state machines "
|
||||||
|
"that can receive bytes, and generate a stream of values.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/clone", cfun_parse_clone,
|
||||||
|
JDOC("(parser/clone p)\n\n"
|
||||||
|
"Creates a deep clone of a parser that is identical to the input parser. "
|
||||||
|
"This cloned parser can be used to continue parsing from a good checkpoint "
|
||||||
|
"if parsing later fails. Returns a new parser.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/has-more", cfun_parse_has_more,
|
||||||
|
JDOC("(parser/has-more parser)\n\n"
|
||||||
|
"Check if the parser has more values in the value queue.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/produce", cfun_parse_produce,
|
||||||
|
JDOC("(parser/produce parser &opt wrap)\n\n"
|
||||||
|
"Dequeue the next value in the parse queue. Will return nil if "
|
||||||
|
"no parsed values are in the queue, otherwise will dequeue the "
|
||||||
|
"next value. If `wrap` is truthy, will return a 1-element tuple that "
|
||||||
|
"wraps the result. This tuple can be used for source-mapping "
|
||||||
|
"purposes.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/consume", cfun_parse_consume,
|
||||||
|
JDOC("(parser/consume parser bytes &opt index)\n\n"
|
||||||
|
"Input bytes into the parser and parse them. Will not throw errors "
|
||||||
|
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||||
|
"the number of bytes read.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/byte", cfun_parse_byte,
|
||||||
|
JDOC("(parser/byte parser b)\n\n"
|
||||||
|
"Input a single byte into the parser byte stream. Returns the parser.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/error", cfun_parse_error,
|
||||||
|
JDOC("(parser/error parser)\n\n"
|
||||||
|
"If the parser is in the error state, returns the message associated with "
|
||||||
|
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
|
||||||
|
"queue, so be sure to handle everything in the queue before calling "
|
||||||
|
"parser/error.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/status", cfun_parse_status,
|
||||||
|
JDOC("(parser/status parser)\n\n"
|
||||||
|
"Gets the current status of the parser state machine. The status will "
|
||||||
|
"be one of:\n\n"
|
||||||
|
"* :pending - a value is being parsed.\n\n"
|
||||||
|
"* :error - a parsing error was encountered.\n\n"
|
||||||
|
"* :root - the parser can either read more values or safely terminate.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/flush", cfun_parse_flush,
|
||||||
|
JDOC("(parser/flush parser)\n\n"
|
||||||
|
"Clears the parser state and parse queue. Can be used to reset the parser "
|
||||||
|
"if an error was encountered. Does not reset the line and column counter, so "
|
||||||
|
"to begin parsing in a new context, create a new parser.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/state", cfun_parse_state,
|
||||||
|
JDOC("(parser/state parser &opt key)\n\n"
|
||||||
|
"Returns a representation of the internal state of the parser. If a key is passed, "
|
||||||
|
"only that information about the state is returned. Allowed keys are:\n\n"
|
||||||
|
"* :delimiters - Each byte in the string represents a nested data structure. For example, "
|
||||||
|
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
||||||
|
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.\n\n"
|
||||||
|
"* :frames - Each table in the array represents a 'frame' in the parser state. Frames "
|
||||||
|
"contain information about the start of the expression being parsed as well as the "
|
||||||
|
"type of that expression and some type-specific information.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/where", cfun_parse_where,
|
||||||
|
JDOC("(parser/where parser &opt line col)\n\n"
|
||||||
|
"Returns the current line number and column of the parser's internal state. If line is "
|
||||||
|
"provided, the current line number of the parser is first set to that value. If column is "
|
||||||
|
"also provided, the current column number of the parser is also first set to that value.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/eof", cfun_parse_eof,
|
||||||
|
JDOC("(parser/eof parser)\n\n"
|
||||||
|
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/insert", cfun_parse_insert,
|
||||||
|
JDOC("(parser/insert parser value)\n\n"
|
||||||
|
"Insert a value into the parser. This means that the parser state can be manipulated "
|
||||||
|
"in between chunks of bytes. This would allow a user to add extra elements to arrays "
|
||||||
|
"and tuples, for example. Returns the parser.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* Load the library */
|
/* Load the library */
|
||||||
void janet_lib_parse(JanetTable *env) {
|
void janet_lib_parse(JanetTable *env) {
|
||||||
JanetRegExt parse_cfuns[] = {
|
janet_core_cfuns(env, NULL, parse_cfuns);
|
||||||
JANET_CORE_REG("parser/new", cfun_parse_parser),
|
|
||||||
JANET_CORE_REG("parser/clone", cfun_parse_clone),
|
|
||||||
JANET_CORE_REG("parser/has-more", cfun_parse_has_more),
|
|
||||||
JANET_CORE_REG("parser/produce", cfun_parse_produce),
|
|
||||||
JANET_CORE_REG("parser/consume", cfun_parse_consume),
|
|
||||||
JANET_CORE_REG("parser/byte", cfun_parse_byte),
|
|
||||||
JANET_CORE_REG("parser/error", cfun_parse_error),
|
|
||||||
JANET_CORE_REG("parser/status", cfun_parse_status),
|
|
||||||
JANET_CORE_REG("parser/flush", cfun_parse_flush),
|
|
||||||
JANET_CORE_REG("parser/state", cfun_parse_state),
|
|
||||||
JANET_CORE_REG("parser/where", cfun_parse_where),
|
|
||||||
JANET_CORE_REG("parser/eof", cfun_parse_eof),
|
|
||||||
JANET_CORE_REG("parser/insert", cfun_parse_insert),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, parse_cfuns);
|
|
||||||
}
|
}
|
||||||
|
|||||||
361
src/core/peg.c
361
src/core/peg.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -39,10 +39,6 @@
|
|||||||
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;
|
||||||
@@ -118,12 +114,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->outer_text_end; c++) {
|
for (const uint8_t *c = s->text_start; c < s->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->outer_text_end; c++) {
|
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
|
||||||
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
|
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
|
||||||
}
|
}
|
||||||
s->linemaplen = newline_count;
|
s->linemaplen = newline_count;
|
||||||
@@ -134,7 +130,7 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
|
|||||||
* a newline character is consider to be on the same line as the character before
|
* a newline character is consider to be on the same line as the character before
|
||||||
* (\n is line terminator, not line separator).
|
* (\n is line terminator, not line separator).
|
||||||
* - in the not-found case, we still want to find the greatest-indexed newline that
|
* - in the not-found case, we still want to find the greatest-indexed newline that
|
||||||
* is before position. we use that to calculate the line and column.
|
* is before position. we use that to calcuate the line and column.
|
||||||
* - in the case that lo = 0 and s->linemap[0] is still greater than position, we
|
* - in the case that lo = 0 and s->linemap[0] is still greater than position, we
|
||||||
* are on the first line and our column is position + 1. */
|
* are on the first line and our column is position + 1. */
|
||||||
int32_t hi = s->linemaplen; /* hi is greater than the actual line */
|
int32_t hi = s->linemaplen; /* hi is greater than the actual line */
|
||||||
@@ -183,7 +179,7 @@ static const uint8_t *peg_rule(
|
|||||||
const uint32_t *rule,
|
const uint32_t *rule,
|
||||||
const uint8_t *text) {
|
const uint8_t *text) {
|
||||||
tail:
|
tail:
|
||||||
switch (*rule) {
|
switch (*rule & 0x1F) {
|
||||||
default:
|
default:
|
||||||
janet_panic("unexpected opcode");
|
janet_panic("unexpected opcode");
|
||||||
return NULL;
|
return NULL;
|
||||||
@@ -215,10 +211,9 @@ tail:
|
|||||||
}
|
}
|
||||||
|
|
||||||
case RULE_SET: {
|
case RULE_SET: {
|
||||||
if (text >= s->text_end) return NULL;
|
|
||||||
uint32_t word = rule[1 + (text[0] >> 5)];
|
uint32_t word = rule[1 + (text[0] >> 5)];
|
||||||
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
|
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
|
||||||
return (word & mask)
|
return (text < s->text_end && (word & mask))
|
||||||
? text + 1
|
? text + 1
|
||||||
: NULL;
|
: NULL;
|
||||||
}
|
}
|
||||||
@@ -265,52 +260,30 @@ tail:
|
|||||||
goto tail;
|
goto tail;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_IF: {
|
case RULE_IF:
|
||||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
|
||||||
const uint32_t *rule_b = s->bytecode + rule[2];
|
|
||||||
down1(s);
|
|
||||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
|
||||||
up1(s);
|
|
||||||
if (!result) return NULL;
|
|
||||||
rule = rule_b;
|
|
||||||
goto tail;
|
|
||||||
}
|
|
||||||
case RULE_IFNOT: {
|
case RULE_IFNOT: {
|
||||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||||
const uint32_t *rule_b = s->bytecode + rule[2];
|
const uint32_t *rule_b = s->bytecode + rule[2];
|
||||||
down1(s);
|
down1(s);
|
||||||
CapState cs = cap_save(s);
|
|
||||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||||
if (!!result) {
|
|
||||||
up1(s);
|
|
||||||
return NULL;
|
|
||||||
} else {
|
|
||||||
cap_load(s, cs);
|
|
||||||
up1(s);
|
up1(s);
|
||||||
|
if (rule[0] == RULE_IF ? !result : !!result) return NULL;
|
||||||
rule = rule_b;
|
rule = rule_b;
|
||||||
goto tail;
|
goto tail;
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
case RULE_NOT: {
|
case RULE_NOT: {
|
||||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||||
down1(s);
|
down1(s);
|
||||||
CapState cs = cap_save(s);
|
|
||||||
const uint8_t *result = peg_rule(s, rule_a, text);
|
const uint8_t *result = peg_rule(s, rule_a, text);
|
||||||
if (result) {
|
|
||||||
up1(s);
|
up1(s);
|
||||||
return NULL;
|
return (result) ? NULL : text;
|
||||||
} else {
|
|
||||||
cap_load(s, cs);
|
|
||||||
up1(s);
|
|
||||||
return text;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_THRU:
|
case RULE_THRU:
|
||||||
case RULE_TO: {
|
case RULE_TO: {
|
||||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||||
const uint8_t *next_text = NULL;
|
const uint8_t *next_text;
|
||||||
CapState cs = cap_save(s);
|
CapState cs = cap_save(s);
|
||||||
down1(s);
|
down1(s);
|
||||||
while (text <= s->text_end) {
|
while (text <= s->text_end) {
|
||||||
@@ -320,7 +293,6 @@ tail:
|
|||||||
if (rule[0] == RULE_TO) cap_load(s, cs2);
|
if (rule[0] == RULE_TO) cap_load(s, cs2);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
cap_load(s, cs2);
|
|
||||||
text++;
|
text++;
|
||||||
}
|
}
|
||||||
up1(s);
|
up1(s);
|
||||||
@@ -415,25 +387,6 @@ tail:
|
|||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_CAPTURE_NUM: {
|
|
||||||
down1(s);
|
|
||||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
|
||||||
up1(s);
|
|
||||||
if (!result) return NULL;
|
|
||||||
/* check number parsing */
|
|
||||||
double x = 0.0;
|
|
||||||
int32_t base = (int32_t) rule[2];
|
|
||||||
if (janet_scan_number_base(text, (int32_t)(result - text), base, &x)) return NULL;
|
|
||||||
/* Specialized pushcap - avoid intermediate string creation */
|
|
||||||
if (!s->has_backref && s->mode == PEG_MODE_ACCUMULATE) {
|
|
||||||
janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text));
|
|
||||||
} else {
|
|
||||||
uint32_t tag = rule[3];
|
|
||||||
pushcap(s, janet_wrap_number(x), tag);
|
|
||||||
}
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
case RULE_ACCUMULATE: {
|
case RULE_ACCUMULATE: {
|
||||||
uint32_t tag = rule[2];
|
uint32_t tag = rule[2];
|
||||||
int oldmode = s->mode;
|
int oldmode = s->mode;
|
||||||
@@ -465,16 +418,6 @@ tail:
|
|||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_ONLY_TAGS: {
|
|
||||||
CapState cs = cap_save(s);
|
|
||||||
down1(s);
|
|
||||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
|
||||||
up1(s);
|
|
||||||
if (!result) return NULL;
|
|
||||||
cap_load_keept(s, cs);
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
case RULE_GROUP: {
|
case RULE_GROUP: {
|
||||||
uint32_t tag = rule[2];
|
uint32_t tag = rule[2];
|
||||||
int oldmode = s->mode;
|
int oldmode = s->mode;
|
||||||
@@ -496,92 +439,6 @@ tail:
|
|||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_NTH: {
|
|
||||||
uint32_t nth = rule[1];
|
|
||||||
if (nth > INT32_MAX) nth = INT32_MAX;
|
|
||||||
uint32_t tag = rule[3];
|
|
||||||
int oldmode = s->mode;
|
|
||||||
CapState cs = cap_save(s);
|
|
||||||
s->mode = PEG_MODE_NORMAL;
|
|
||||||
down1(s);
|
|
||||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
|
|
||||||
up1(s);
|
|
||||||
s->mode = oldmode;
|
|
||||||
if (!result) return NULL;
|
|
||||||
int32_t num_sub_captures = s->captures->count - cs.cap;
|
|
||||||
Janet cap;
|
|
||||||
if (num_sub_captures > (int32_t) nth) {
|
|
||||||
cap = s->captures->data[cs.cap + nth];
|
|
||||||
} else {
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
cap_load_keept(s, cs);
|
|
||||||
pushcap(s, cap, tag);
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
case RULE_SUB: {
|
|
||||||
const uint8_t *text_start = text;
|
|
||||||
const uint32_t *rule_window = s->bytecode + rule[1];
|
|
||||||
const uint32_t *rule_subpattern = s->bytecode + rule[2];
|
|
||||||
down1(s);
|
|
||||||
const uint8_t *window_end = peg_rule(s, rule_window, text);
|
|
||||||
up1(s);
|
|
||||||
if (!window_end) {
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
const uint8_t *saved_end = s->text_end;
|
|
||||||
s->text_end = window_end;
|
|
||||||
down1(s);
|
|
||||||
const uint8_t *next_text = peg_rule(s, rule_subpattern, text_start);
|
|
||||||
up1(s);
|
|
||||||
s->text_end = saved_end;
|
|
||||||
|
|
||||||
if (!next_text) {
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
return window_end;
|
|
||||||
}
|
|
||||||
|
|
||||||
case RULE_SPLIT: {
|
|
||||||
const uint8_t *saved_end = s->text_end;
|
|
||||||
const uint32_t *rule_separator = s->bytecode + rule[1];
|
|
||||||
const uint32_t *rule_subpattern = s->bytecode + rule[2];
|
|
||||||
|
|
||||||
const uint8_t *separator_end = NULL;
|
|
||||||
do {
|
|
||||||
const uint8_t *text_start = text;
|
|
||||||
CapState cs = cap_save(s);
|
|
||||||
down1(s);
|
|
||||||
while (text <= s->text_end) {
|
|
||||||
separator_end = peg_rule(s, rule_separator, text);
|
|
||||||
cap_load(s, cs);
|
|
||||||
if (separator_end) {
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
text++;
|
|
||||||
}
|
|
||||||
up1(s);
|
|
||||||
|
|
||||||
if (separator_end) {
|
|
||||||
s->text_end = text;
|
|
||||||
text = separator_end;
|
|
||||||
}
|
|
||||||
|
|
||||||
down1(s);
|
|
||||||
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
|
|
||||||
up1(s);
|
|
||||||
s->text_end = saved_end;
|
|
||||||
|
|
||||||
if (!subpattern_end) {
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
} while (separator_end);
|
|
||||||
|
|
||||||
return s->text_end;
|
|
||||||
}
|
|
||||||
|
|
||||||
case RULE_REPLACE:
|
case RULE_REPLACE:
|
||||||
case RULE_MATCHTIME: {
|
case RULE_MATCHTIME: {
|
||||||
uint32_t tag = rule[3];
|
uint32_t tag = rule[3];
|
||||||
@@ -701,11 +558,11 @@ tail:
|
|||||||
case RULE_READINT: {
|
case RULE_READINT: {
|
||||||
uint32_t tag = rule[2];
|
uint32_t tag = rule[2];
|
||||||
uint32_t signedness = rule[1] & 0x10;
|
uint32_t signedness = rule[1] & 0x10;
|
||||||
uint32_t endianness = rule[1] & 0x20;
|
uint32_t endianess = rule[1] & 0x20;
|
||||||
int width = (int)(rule[1] & 0xF);
|
int width = (int)(rule[1] & 0xF);
|
||||||
if (text + width > s->text_end) return NULL;
|
if (text + width > s->text_end) return NULL;
|
||||||
uint64_t accum = 0;
|
uint64_t accum = 0;
|
||||||
if (endianness) {
|
if (endianess) {
|
||||||
/* BE */
|
/* BE */
|
||||||
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
|
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
|
||||||
} else {
|
} else {
|
||||||
@@ -1095,9 +952,6 @@ static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
|
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
|
||||||
spec_onerule(b, argc, argv, RULE_DROP);
|
spec_onerule(b, argc, argv, RULE_DROP);
|
||||||
}
|
}
|
||||||
static void spec_only_tags(Builder *b, int32_t argc, const Janet *argv) {
|
|
||||||
spec_onerule(b, argc, argv, RULE_ONLY_TAGS);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Rule of the form [rule, tag] */
|
/* Rule of the form [rule, tag] */
|
||||||
static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
||||||
@@ -1121,34 +975,6 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
spec_cap1(b, argc, argv, RULE_UNREF);
|
spec_cap1(b, argc, argv, RULE_UNREF);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void spec_nth(Builder *b, int32_t argc, const Janet *argv) {
|
|
||||||
peg_arity(b, argc, 2, 3);
|
|
||||||
Reserve r = reserve(b, 4);
|
|
||||||
uint32_t nth = peg_getnat(b, argv[0]);
|
|
||||||
uint32_t rule = peg_compile1(b, argv[1]);
|
|
||||||
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
|
|
||||||
emit_3(r, RULE_NTH, nth, rule, tag);
|
|
||||||
}
|
|
||||||
|
|
||||||
static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
|
|
||||||
peg_arity(b, argc, 1, 3);
|
|
||||||
Reserve r = reserve(b, 4);
|
|
||||||
uint32_t base = 0;
|
|
||||||
if (argc >= 2) {
|
|
||||||
if (!janet_checktype(argv[1], JANET_NIL)) {
|
|
||||||
if (!janet_checkint(argv[1])) goto error;
|
|
||||||
base = (uint32_t) janet_unwrap_integer(argv[1]);
|
|
||||||
if (base < 2 || base > 36) goto error;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
|
|
||||||
uint32_t rule = peg_compile1(b, argv[0]);
|
|
||||||
emit_3(r, RULE_CAPTURE_NUM, rule, base, tag);
|
|
||||||
return;
|
|
||||||
error:
|
|
||||||
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[1]);
|
|
||||||
}
|
|
||||||
|
|
||||||
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
|
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
|
||||||
peg_arity(b, argc, 1, 2);
|
peg_arity(b, argc, 1, 2);
|
||||||
Reserve r = reserve(b, 3);
|
Reserve r = reserve(b, 3);
|
||||||
@@ -1212,29 +1038,13 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
Janet fun = argv[1];
|
Janet fun = argv[1];
|
||||||
if (!janet_checktype(fun, JANET_FUNCTION) &&
|
if (!janet_checktype(fun, JANET_FUNCTION) &&
|
||||||
!janet_checktype(fun, JANET_CFUNCTION)) {
|
!janet_checktype(fun, JANET_CFUNCTION)) {
|
||||||
peg_panicf(b, "expected function or cfunction, got %v", fun);
|
peg_panicf(b, "expected function|cfunction, got %v", fun);
|
||||||
}
|
}
|
||||||
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
|
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
|
||||||
uint32_t cindex = emit_constant(b, fun);
|
uint32_t cindex = emit_constant(b, fun);
|
||||||
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
|
||||||
@@ -1308,9 +1118,6 @@ static const SpecialPair peg_specials[] = {
|
|||||||
{"line", spec_line},
|
{"line", spec_line},
|
||||||
{"look", spec_look},
|
{"look", spec_look},
|
||||||
{"not", spec_not},
|
{"not", spec_not},
|
||||||
{"nth", spec_nth},
|
|
||||||
{"number", spec_capture_number},
|
|
||||||
{"only-tags", spec_only_tags},
|
|
||||||
{"opt", spec_opt},
|
{"opt", spec_opt},
|
||||||
{"position", spec_position},
|
{"position", spec_position},
|
||||||
{"quote", spec_capture},
|
{"quote", spec_capture},
|
||||||
@@ -1320,8 +1127,6 @@ 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},
|
||||||
@@ -1393,13 +1198,6 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
|||||||
default:
|
default:
|
||||||
peg_panic(b, "unexpected peg source");
|
peg_panic(b, "unexpected peg source");
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
case JANET_BOOLEAN: {
|
|
||||||
int n = janet_unwrap_boolean(peg);
|
|
||||||
Reserve r = reserve(b, 2);
|
|
||||||
emit_1(r, n ? RULE_NCHAR : RULE_NOTNCHAR, 0);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case JANET_NUMBER: {
|
case JANET_NUMBER: {
|
||||||
int32_t n = peg_getinteger(b, peg);
|
int32_t n = peg_getinteger(b, peg);
|
||||||
Reserve r = reserve(b, 2);
|
Reserve r = reserve(b, 2);
|
||||||
@@ -1416,18 +1214,6 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
|||||||
emit_bytes(b, RULE_LITERAL, len, str);
|
emit_bytes(b, RULE_LITERAL, len, str);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_TABLE: {
|
|
||||||
/* Build grammar table */
|
|
||||||
JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));
|
|
||||||
new_grammar->proto = grammar;
|
|
||||||
b->grammar = grammar = new_grammar;
|
|
||||||
/* Run the main rule */
|
|
||||||
Janet main_rule = janet_table_rawget(grammar, janet_ckeywordv("main"));
|
|
||||||
if (janet_checktype(main_rule, JANET_NIL))
|
|
||||||
peg_panic(b, "grammar requires :main rule");
|
|
||||||
rule = peg_compile1(b, main_rule);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case JANET_STRUCT: {
|
case JANET_STRUCT: {
|
||||||
/* Build grammar table */
|
/* Build grammar table */
|
||||||
const JanetKV *st = janet_unwrap_struct(peg);
|
const JanetKV *st = janet_unwrap_struct(peg);
|
||||||
@@ -1563,7 +1349,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) {
|
switch (instr & 0x1F) {
|
||||||
case RULE_LITERAL:
|
case RULE_LITERAL:
|
||||||
i += 2 + ((rule[1] + 3) >> 2);
|
i += 2 + ((rule[1] + 3) >> 2);
|
||||||
break;
|
break;
|
||||||
@@ -1633,12 +1419,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
|||||||
if (rule[1] >= clen) goto bad;
|
if (rule[1] >= clen) goto bad;
|
||||||
i += 3;
|
i += 3;
|
||||||
break;
|
break;
|
||||||
case RULE_CAPTURE_NUM:
|
|
||||||
/* [rule, base, tag] */
|
|
||||||
if (rule[1] >= blen) goto bad;
|
|
||||||
op_flags[rule[1]] |= 0x01;
|
|
||||||
i += 4;
|
|
||||||
break;
|
|
||||||
case RULE_ACCUMULATE:
|
case RULE_ACCUMULATE:
|
||||||
case RULE_GROUP:
|
case RULE_GROUP:
|
||||||
case RULE_CAPTURE:
|
case RULE_CAPTURE:
|
||||||
@@ -1656,18 +1436,8 @@ 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_ONLY_TAGS:
|
|
||||||
case RULE_NOT:
|
case RULE_NOT:
|
||||||
case RULE_TO:
|
case RULE_TO:
|
||||||
case RULE_THRU:
|
case RULE_THRU:
|
||||||
@@ -1677,16 +1447,10 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
|||||||
i += 2;
|
i += 2;
|
||||||
break;
|
break;
|
||||||
case RULE_READINT:
|
case RULE_READINT:
|
||||||
/* [ width | (endianness << 5) | (signedness << 6), tag ] */
|
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
|
||||||
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
|
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
|
||||||
i += 3;
|
i += 3;
|
||||||
break;
|
break;
|
||||||
case RULE_NTH:
|
|
||||||
/* [nth, rule, tag] */
|
|
||||||
if (rule[2] >= blen) goto bad;
|
|
||||||
op_flags[rule[2]] |= 0x01;
|
|
||||||
i += 4;
|
|
||||||
break;
|
|
||||||
default:
|
default:
|
||||||
goto bad;
|
goto bad;
|
||||||
}
|
}
|
||||||
@@ -1777,11 +1541,7 @@ static JanetPeg *compile_peg(Janet x) {
|
|||||||
* C Functions
|
* C Functions
|
||||||
*/
|
*/
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_peg_compile,
|
static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
|
||||||
"(peg/compile peg)",
|
|
||||||
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
|
|
||||||
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement "
|
|
||||||
"the grammar of the peg for otherwise undefined peg keywords.") {
|
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetPeg *peg = compile_peg(argv[0]);
|
JanetPeg *peg = compile_peg(argv[0]);
|
||||||
return janet_wrap_abstract(peg);
|
return janet_wrap_abstract(peg);
|
||||||
@@ -1792,7 +1552,7 @@ typedef struct {
|
|||||||
JanetPeg *peg;
|
JanetPeg *peg;
|
||||||
PegState s;
|
PegState s;
|
||||||
JanetByteView bytes;
|
JanetByteView bytes;
|
||||||
Janet subst;
|
JanetByteView repl;
|
||||||
int32_t start;
|
int32_t start;
|
||||||
} PegCall;
|
} PegCall;
|
||||||
|
|
||||||
@@ -1800,7 +1560,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, min, -1);
|
janet_arity(argc, get_replace, -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]);
|
||||||
@@ -1808,7 +1568,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
|||||||
ret.peg = compile_peg(argv[0]);
|
ret.peg = compile_peg(argv[0]);
|
||||||
}
|
}
|
||||||
if (get_replace) {
|
if (get_replace) {
|
||||||
ret.subst = argv[1];
|
ret.repl = janet_getbytes(argv, 1);
|
||||||
ret.bytes = janet_getbytes(argv, 2);
|
ret.bytes = janet_getbytes(argv, 2);
|
||||||
} else {
|
} else {
|
||||||
ret.bytes = janet_getbytes(argv, 1);
|
ret.bytes = janet_getbytes(argv, 1);
|
||||||
@@ -1825,7 +1585,6 @@ 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);
|
||||||
@@ -1840,25 +1599,18 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void peg_call_reset(PegCall *c) {
|
static void peg_call_reset(PegCall *c) {
|
||||||
c->s.depth = JANET_RECURSION_GUARD;
|
|
||||||
c->s.captures->count = 0;
|
c->s.captures->count = 0;
|
||||||
c->s.tagged_captures->count = 0;
|
|
||||||
c->s.scratch->count = 0;
|
c->s.scratch->count = 0;
|
||||||
c->s.tags->count = 0;
|
c->s.tags->count = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_peg_match,
|
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||||
"(peg/match peg text &opt start & args)",
|
|
||||||
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
|
||||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.") {
|
|
||||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||||
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start);
|
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start);
|
||||||
return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil();
|
return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_peg_find,
|
static Janet cfun_peg_find(int32_t argc, Janet *argv) {
|
||||||
"(peg/find peg text &opt start & args)",
|
|
||||||
"Find first index where the peg matches in text. Returns an integer, or nil if not found.") {
|
|
||||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||||
peg_call_reset(&c);
|
peg_call_reset(&c);
|
||||||
@@ -1868,9 +1620,7 @@ JANET_CORE_FN(cfun_peg_find,
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_peg_find_all,
|
static Janet cfun_peg_find_all(int32_t argc, Janet *argv) {
|
||||||
"(peg/find-all peg text &opt start & args)",
|
|
||||||
"Find all indexes where the peg matches in text. Returns an array of integers.") {
|
|
||||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||||
JanetArray *ret = janet_array(0);
|
JanetArray *ret = janet_array(0);
|
||||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||||
@@ -1894,8 +1644,7 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
|||||||
trail = i;
|
trail = i;
|
||||||
}
|
}
|
||||||
int32_t nexti = (int32_t)(result - c.bytes.bytes);
|
int32_t nexti = (int32_t)(result - c.bytes.bytes);
|
||||||
JanetByteView subst = janet_text_substitution(&c.subst, c.bytes.bytes + i, nexti - i, c.s.captures);
|
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
|
||||||
janet_buffer_push_bytes(ret, subst.bytes, subst.len);
|
|
||||||
trail = nexti;
|
trail = nexti;
|
||||||
if (nexti == i) nexti++;
|
if (nexti == i) nexti++;
|
||||||
i = nexti;
|
i = nexti;
|
||||||
@@ -1910,22 +1659,11 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
|||||||
return janet_wrap_buffer(ret);
|
return janet_wrap_buffer(ret);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_peg_replace_all,
|
static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) {
|
||||||
"(peg/replace-all peg subst text &opt start & args)",
|
|
||||||
"Replace all matches of `peg` in `text` with `subst`, returning a new buffer. "
|
|
||||||
"The peg does not need to make captures to do replacement. "
|
|
||||||
"If `subst` is a function, it will be called with the "
|
|
||||||
"matching text followed by any captures.") {
|
|
||||||
return cfun_peg_replace_generic(argc, argv, 0);
|
return cfun_peg_replace_generic(argc, argv, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_peg_replace,
|
static Janet cfun_peg_replace(int32_t argc, Janet *argv) {
|
||||||
"(peg/replace peg subst text &opt start & args)",
|
|
||||||
"Replace first match of `peg` in `text` with `subst`, returning a new buffer. "
|
|
||||||
"The peg does not need to make captures to do replacement. "
|
|
||||||
"If `subst` is a function, it will be called with the "
|
|
||||||
"matching text followed by any captures. "
|
|
||||||
"If no matches are found, returns the input string in a new buffer.") {
|
|
||||||
return cfun_peg_replace_generic(argc, argv, 1);
|
return cfun_peg_replace_generic(argc, argv, 1);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1950,18 +1688,47 @@ static Janet peg_next(void *p, Janet key) {
|
|||||||
return janet_nextmethod(peg_methods, key);
|
return janet_nextmethod(peg_methods, key);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static const JanetReg peg_cfuns[] = {
|
||||||
|
{
|
||||||
|
"peg/compile", cfun_peg_compile,
|
||||||
|
JDOC("(peg/compile peg)\n\n"
|
||||||
|
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
|
||||||
|
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment "
|
||||||
|
"the grammar of the peg for otherwise undefined peg keywords.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"peg/match", cfun_peg_match,
|
||||||
|
JDOC("(peg/match peg text &opt start & args)\n\n"
|
||||||
|
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
||||||
|
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"peg/find", cfun_peg_find,
|
||||||
|
JDOC("(peg/find peg text &opt start & args)\n\n"
|
||||||
|
"Find first index where the peg matches in text. Returns an integer, or nil if not found.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"peg/find-all", cfun_peg_find_all,
|
||||||
|
JDOC("(peg/find-all peg text &opt start & args)\n\n"
|
||||||
|
"Find all indexes where the peg matches in text. Returns an array of integers.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"peg/replace", cfun_peg_replace,
|
||||||
|
JDOC("(peg/replace peg repl text &opt start & args)\n\n"
|
||||||
|
"Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
|
||||||
|
"If no matches are found, returns the input string in a new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"peg/replace-all", cfun_peg_replace_all,
|
||||||
|
JDOC("(peg/replace-all peg repl text &opt start & args)\n\n"
|
||||||
|
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
/* Load the peg module */
|
/* Load the peg module */
|
||||||
void janet_lib_peg(JanetTable *env) {
|
void janet_lib_peg(JanetTable *env) {
|
||||||
JanetRegExt cfuns[] = {
|
janet_core_cfuns(env, NULL, peg_cfuns);
|
||||||
JANET_CORE_REG("peg/compile", cfun_peg_compile),
|
|
||||||
JANET_CORE_REG("peg/match", cfun_peg_match),
|
|
||||||
JANET_CORE_REG("peg/find", cfun_peg_find),
|
|
||||||
JANET_CORE_REG("peg/find-all", cfun_peg_find_all),
|
|
||||||
JANET_CORE_REG("peg/replace", cfun_peg_replace),
|
|
||||||
JANET_CORE_REG("peg/replace-all", cfun_peg_replace_all),
|
|
||||||
JANET_REG_END
|
|
||||||
};
|
|
||||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
|
||||||
janet_register_abstract_type(&janet_peg_type);
|
janet_register_abstract_type(&janet_peg_type);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
173
src/core/pp.c
173
src/core/pp.c
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -30,8 +30,6 @@
|
|||||||
|
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
#include <ctype.h>
|
#include <ctype.h>
|
||||||
#include <inttypes.h>
|
|
||||||
#include <float.h>
|
|
||||||
|
|
||||||
/* Implements a pretty printer for Janet. The pretty printer
|
/* Implements a pretty printer for Janet. The pretty printer
|
||||||
* is simple and not that flexible, but fast. */
|
* is simple and not that flexible, but fast. */
|
||||||
@@ -39,15 +37,11 @@
|
|||||||
/* Temporary buffer size */
|
/* Temporary buffer size */
|
||||||
#define BUFSIZE 64
|
#define BUFSIZE 64
|
||||||
|
|
||||||
/* Preprocessor hacks */
|
|
||||||
#define STR_HELPER(x) #x
|
|
||||||
#define STR(x) STR_HELPER(x)
|
|
||||||
|
|
||||||
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||||
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||||
const char *fmt = (x == floor(x) &&
|
const char *fmt = (x == floor(x) &&
|
||||||
x <= JANET_INTMAX_DOUBLE &&
|
x <= JANET_INTMAX_DOUBLE &&
|
||||||
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : ("%." STR(DBL_DIG) "g");
|
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
|
||||||
int count;
|
int count;
|
||||||
if (x == 0.0) {
|
if (x == 0.0) {
|
||||||
/* Prevent printing of '-0' */
|
/* Prevent printing of '-0' */
|
||||||
@@ -114,7 +108,7 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
|
|||||||
pbuf.p = pointer;
|
pbuf.p = pointer;
|
||||||
*c++ = '<';
|
*c++ = '<';
|
||||||
/* Maximum of 32 bytes for abstract type name */
|
/* Maximum of 32 bytes for abstract type name */
|
||||||
for (i = 0; i < 32 && title[i]; ++i)
|
for (i = 0; title[i] && i < 32; ++i)
|
||||||
*c++ = ((uint8_t *)title) [i];
|
*c++ = ((uint8_t *)title) [i];
|
||||||
*c++ = ' ';
|
*c++ = ' ';
|
||||||
*c++ = '0';
|
*c++ = '0';
|
||||||
@@ -157,12 +151,6 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
|||||||
case '\v':
|
case '\v':
|
||||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
|
||||||
break;
|
break;
|
||||||
case '\a':
|
|
||||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
|
|
||||||
break;
|
|
||||||
case '\b':
|
|
||||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
|
|
||||||
break;
|
|
||||||
case 27:
|
case 27:
|
||||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
|
||||||
break;
|
break;
|
||||||
@@ -239,14 +227,12 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
|||||||
}
|
}
|
||||||
return;
|
return;
|
||||||
case JANET_CFUNCTION: {
|
case JANET_CFUNCTION: {
|
||||||
JanetCFunRegistry *reg = janet_registry_get(janet_unwrap_cfunction(x));
|
Janet check = janet_table_get(janet_vm_registry, x);
|
||||||
if (NULL != reg) {
|
if (janet_checktype(check, JANET_SYMBOL)) {
|
||||||
janet_buffer_push_cstring(buffer, "<cfunction ");
|
janet_buffer_push_cstring(buffer, "<cfunction ");
|
||||||
if (NULL != reg->name_prefix) {
|
janet_buffer_push_bytes(buffer,
|
||||||
janet_buffer_push_cstring(buffer, reg->name_prefix);
|
janet_unwrap_symbol(check),
|
||||||
janet_buffer_push_u8(buffer, '/');
|
janet_string_length(janet_unwrap_symbol(check)));
|
||||||
}
|
|
||||||
janet_buffer_push_cstring(buffer, reg->name);
|
|
||||||
janet_buffer_push_u8(buffer, '>');
|
janet_buffer_push_u8(buffer, '>');
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -255,10 +241,6 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
|||||||
case JANET_FUNCTION: {
|
case JANET_FUNCTION: {
|
||||||
JanetFunction *fun = janet_unwrap_function(x);
|
JanetFunction *fun = janet_unwrap_function(x);
|
||||||
JanetFuncDef *def = fun->def;
|
JanetFuncDef *def = fun->def;
|
||||||
if (def == NULL) {
|
|
||||||
janet_buffer_push_cstring(buffer, "<incomplete function>");
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
if (def->name) {
|
if (def->name) {
|
||||||
const uint8_t *n = def->name;
|
const uint8_t *n = def->name;
|
||||||
janet_buffer_push_cstring(buffer, "<function ");
|
janet_buffer_push_cstring(buffer, "<function ");
|
||||||
@@ -277,13 +259,21 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
|||||||
|
|
||||||
/* See parse.c for full table */
|
/* See parse.c for full table */
|
||||||
|
|
||||||
|
static const uint32_t pp_symchars[8] = {
|
||||||
|
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
|
||||||
|
0x00000000, 0x00000000, 0x00000000, 0x00000000
|
||||||
|
};
|
||||||
|
|
||||||
|
static int pp_is_symbol_char(uint8_t c) {
|
||||||
|
return pp_symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||||
|
}
|
||||||
|
|
||||||
/* Check if a symbol or keyword contains no symbol characters */
|
/* Check if a symbol or keyword contains no symbol characters */
|
||||||
static int contains_bad_chars(const uint8_t *sym, int issym) {
|
static int contains_bad_chars(const uint8_t *sym, int issym) {
|
||||||
int32_t len = janet_string_length(sym);
|
int32_t len = janet_string_length(sym);
|
||||||
if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1;
|
if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1;
|
||||||
if (!janet_valid_utf8(sym, len)) return 1;
|
|
||||||
for (int32_t i = 0; i < len; i++) {
|
for (int32_t i = 0; i < len; i++) {
|
||||||
if (!janet_is_symbol_char(sym[i])) return 1;
|
if (!pp_is_symbol_char(sym[i])) return 1;
|
||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -379,10 +369,8 @@ 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);
|
||||||
double num = janet_unwrap_number(x);
|
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
|
||||||
if (isnan(num)) return 1;
|
S->buffer->count += count;
|
||||||
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:
|
||||||
@@ -580,12 +568,12 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
case JANET_STRUCT:
|
case JANET_STRUCT:
|
||||||
case JANET_TABLE: {
|
case JANET_TABLE: {
|
||||||
int istable = janet_checktype(x, JANET_TABLE);
|
int istable = janet_checktype(x, JANET_TABLE);
|
||||||
|
janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
|
||||||
|
|
||||||
/* For object-like tables, print class name */
|
/* For object-like tables, print class name */
|
||||||
if (istable) {
|
if (istable) {
|
||||||
JanetTable *t = janet_unwrap_table(x);
|
JanetTable *t = janet_unwrap_table(x);
|
||||||
JanetTable *proto = t->proto;
|
JanetTable *proto = t->proto;
|
||||||
janet_buffer_push_cstring(S->buffer, "@");
|
|
||||||
if (NULL != proto) {
|
if (NULL != proto) {
|
||||||
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
|
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
|
||||||
const uint8_t *n;
|
const uint8_t *n;
|
||||||
@@ -600,25 +588,8 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
} else {
|
|
||||||
JanetStruct st = janet_unwrap_struct(x);
|
|
||||||
JanetStruct proto = janet_struct_proto(st);
|
|
||||||
if (NULL != proto) {
|
|
||||||
Janet name = janet_struct_get(proto, janet_ckeywordv("_name"));
|
|
||||||
const uint8_t *n;
|
|
||||||
int32_t len;
|
|
||||||
if (janet_bytes_view(name, &n, &len)) {
|
|
||||||
if (S->flags & JANET_PRETTY_COLOR) {
|
|
||||||
janet_buffer_push_cstring(S->buffer, janet_class_color);
|
|
||||||
}
|
|
||||||
janet_buffer_push_bytes(S->buffer, n, len);
|
|
||||||
if (S->flags & JANET_PRETTY_COLOR) {
|
|
||||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
janet_buffer_push_cstring(S->buffer, "{");
|
janet_buffer_push_cstring(S->buffer, "{");
|
||||||
|
}
|
||||||
|
|
||||||
S->depth--;
|
S->depth--;
|
||||||
S->indent += 2;
|
S->indent += 2;
|
||||||
@@ -654,7 +625,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
janet_sorted_keys(kvs, cap, S->keysort_buffer == NULL ? NULL : S->keysort_buffer + ks_start);
|
janet_sorted_keys(kvs, cap, S->keysort_buffer + ks_start);
|
||||||
S->keysort_start += len;
|
S->keysort_start += len;
|
||||||
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
|
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
|
||||||
len = JANET_PRETTY_DICT_LIMIT;
|
len = JANET_PRETTY_DICT_LIMIT;
|
||||||
@@ -753,7 +724,7 @@ static void pushtypes(JanetBuffer *buffer, int types) {
|
|||||||
if (first) {
|
if (first) {
|
||||||
first = 0;
|
first = 0;
|
||||||
} else {
|
} else {
|
||||||
janet_buffer_push_cstring(buffer, (types == 1) ? " or " : ", ");
|
janet_buffer_push_u8(buffer, '|');
|
||||||
}
|
}
|
||||||
janet_buffer_push_cstring(buffer, janet_type_names[i]);
|
janet_buffer_push_cstring(buffer, janet_type_names[i]);
|
||||||
}
|
}
|
||||||
@@ -768,48 +739,20 @@ static void pushtypes(JanetBuffer *buffer, int types) {
|
|||||||
|
|
||||||
#define MAX_ITEM 256
|
#define MAX_ITEM 256
|
||||||
#define FMT_FLAGS "-+ #0"
|
#define FMT_FLAGS "-+ #0"
|
||||||
#define FMT_REPLACE_INTTYPES "diouxX"
|
|
||||||
#define MAX_FORMAT 32
|
#define MAX_FORMAT 32
|
||||||
|
|
||||||
struct FmtMapping {
|
|
||||||
char c;
|
|
||||||
const char *mapping;
|
|
||||||
};
|
|
||||||
|
|
||||||
/* Janet uses fixed width integer types for most things, so map
|
|
||||||
* format specifiers to these fixed sizes */
|
|
||||||
static const struct FmtMapping format_mappings[] = {
|
|
||||||
{'D', PRId64},
|
|
||||||
{'I', PRIi64},
|
|
||||||
{'d', PRId64},
|
|
||||||
{'i', PRIi64},
|
|
||||||
{'o', PRIo64},
|
|
||||||
{'u', PRIu64},
|
|
||||||
{'x', PRIx64},
|
|
||||||
{'X', PRIX64},
|
|
||||||
};
|
|
||||||
|
|
||||||
static const char *get_fmt_mapping(char c) {
|
|
||||||
for (size_t i = 0; i < (sizeof(format_mappings) / sizeof(struct FmtMapping)); i++) {
|
|
||||||
if (format_mappings[i].c == c)
|
|
||||||
return format_mappings[i].mapping;
|
|
||||||
}
|
|
||||||
janet_assert(0, "bad format mapping");
|
|
||||||
}
|
|
||||||
|
|
||||||
static const char *scanformat(
|
static const char *scanformat(
|
||||||
const char *strfrmt,
|
const char *strfrmt,
|
||||||
char *form,
|
char *form,
|
||||||
char width[3],
|
char width[3],
|
||||||
char precision[3]) {
|
char precision[3]) {
|
||||||
const char *p = strfrmt;
|
const char *p = strfrmt;
|
||||||
|
|
||||||
/* Parse strfrmt */
|
|
||||||
memset(width, '\0', 3);
|
memset(width, '\0', 3);
|
||||||
memset(precision, '\0', 3);
|
memset(precision, '\0', 3);
|
||||||
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
|
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
|
||||||
p++; /* skip flags */
|
p++; /* skip flags */
|
||||||
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS)) janet_panic("invalid format (repeated flags)");
|
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
|
||||||
|
janet_panic("invalid format (repeated flags)");
|
||||||
if (isdigit((int)(*p)))
|
if (isdigit((int)(*p)))
|
||||||
width[0] = *p++; /* skip width */
|
width[0] = *p++; /* skip width */
|
||||||
if (isdigit((int)(*p)))
|
if (isdigit((int)(*p)))
|
||||||
@@ -823,23 +766,10 @@ static const char *scanformat(
|
|||||||
}
|
}
|
||||||
if (isdigit((int)(*p)))
|
if (isdigit((int)(*p)))
|
||||||
janet_panic("invalid format (width or precision too long)");
|
janet_panic("invalid format (width or precision too long)");
|
||||||
|
|
||||||
/* Write to form - replace characters with fixed size stuff */
|
|
||||||
*(form++) = '%';
|
*(form++) = '%';
|
||||||
const char *p2 = strfrmt;
|
memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
|
||||||
while (p2 <= p) {
|
form += (p - strfrmt) + 1;
|
||||||
char *loc = strchr(FMT_REPLACE_INTTYPES, *p2);
|
|
||||||
if (loc != NULL && *loc != '\0') {
|
|
||||||
const char *mapping = get_fmt_mapping(*p2++);
|
|
||||||
size_t len = strlen(mapping);
|
|
||||||
memcpy(form, mapping, len);
|
|
||||||
form += len;
|
|
||||||
} else {
|
|
||||||
*(form++) = *(p2++);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
*form = '\0';
|
*form = '\0';
|
||||||
|
|
||||||
return p;
|
return p;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -859,27 +789,16 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
|||||||
c = scanformat(c, form, width, precision);
|
c = scanformat(c, form, width, precision);
|
||||||
switch (*c++) {
|
switch (*c++) {
|
||||||
case 'c': {
|
case 'c': {
|
||||||
int n = va_arg(args, int);
|
int n = va_arg(args, long);
|
||||||
nb = snprintf(item, MAX_ITEM, form, n);
|
nb = snprintf(item, MAX_ITEM, form, n);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'd':
|
case 'd':
|
||||||
case 'i': {
|
case 'i':
|
||||||
int64_t n = (int64_t) va_arg(args, int32_t);
|
|
||||||
nb = snprintf(item, MAX_ITEM, form, n);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case 'D':
|
|
||||||
case 'I': {
|
|
||||||
int64_t n = va_arg(args, int64_t);
|
|
||||||
nb = snprintf(item, MAX_ITEM, form, n);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case 'x':
|
|
||||||
case 'X':
|
|
||||||
case 'o':
|
case 'o':
|
||||||
case 'u': {
|
case 'x':
|
||||||
uint64_t n = va_arg(args, uint64_t);
|
case 'X': {
|
||||||
|
int32_t n = va_arg(args, long);
|
||||||
nb = snprintf(item, MAX_ITEM, form, n);
|
nb = snprintf(item, MAX_ITEM, form, n);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -923,7 +842,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
|||||||
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
|
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
|
||||||
break;
|
break;
|
||||||
case 'T': {
|
case 'T': {
|
||||||
int types = va_arg(args, int);
|
int types = va_arg(args, long);
|
||||||
pushtypes(b, types);
|
pushtypes(b, types);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -962,7 +881,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (nb >= MAX_ITEM)
|
if (nb >= MAX_ITEM)
|
||||||
janet_panic("format buffer overflow");
|
janet_panicf("format buffer overflow", form);
|
||||||
if (nb > 0)
|
if (nb > 0)
|
||||||
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
||||||
}
|
}
|
||||||
@@ -1032,19 +951,12 @@ void janet_buffer_format(
|
|||||||
janet_getinteger(argv, arg));
|
janet_getinteger(argv, arg));
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'D':
|
|
||||||
case 'I':
|
|
||||||
case 'd':
|
case 'd':
|
||||||
case 'i': {
|
case 'i':
|
||||||
int64_t n = janet_getinteger64(argv, arg);
|
|
||||||
nb = snprintf(item, MAX_ITEM, form, n);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
case 'x':
|
|
||||||
case 'X':
|
|
||||||
case 'o':
|
case 'o':
|
||||||
case 'u': {
|
case 'x':
|
||||||
uint64_t n = janet_getuinteger64(argv, arg);
|
case 'X': {
|
||||||
|
int32_t n = janet_getinteger(argv, arg);
|
||||||
nb = snprintf(item, MAX_ITEM, form, n);
|
nb = snprintf(item, MAX_ITEM, form, n);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -1060,9 +972,8 @@ void janet_buffer_format(
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 's': {
|
case 's': {
|
||||||
JanetByteView bytes = janet_getbytes(argv, arg);
|
const uint8_t *s = janet_getstring(argv, arg);
|
||||||
const uint8_t *s = bytes.bytes;
|
int32_t l = janet_string_length(s);
|
||||||
int32_t l = bytes.len;
|
|
||||||
if (form[2] == '\0')
|
if (form[2] == '\0')
|
||||||
janet_buffer_push_bytes(b, s, l);
|
janet_buffer_push_bytes(b, s, l);
|
||||||
else {
|
else {
|
||||||
@@ -1122,7 +1033,7 @@ void janet_buffer_format(
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (nb >= MAX_ITEM)
|
if (nb >= MAX_ITEM)
|
||||||
janet_panic("format buffer overflow");
|
janet_panicf("format buffer overflow", form);
|
||||||
if (nb > 0)
|
if (nb > 0)
|
||||||
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -27,8 +27,6 @@
|
|||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* The JanetRegisterAllocator is really just a bitset. */
|
|
||||||
|
|
||||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||||
ra->chunks = NULL;
|
ra->chunks = NULL;
|
||||||
ra->count = 0;
|
ra->count = 0;
|
||||||
@@ -141,14 +139,6 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
|
|||||||
ra->chunks[chunk] &= ~ithbit(bit);
|
ra->chunks[chunk] &= ~ithbit(bit);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Check if a register is set. */
|
|
||||||
int janetc_regalloc_check(JanetcRegisterAllocator *ra, int32_t reg) {
|
|
||||||
int32_t chunk = reg >> 5;
|
|
||||||
int32_t bit = reg & 0x1F;
|
|
||||||
while (chunk >= ra->count) pushchunk(ra);
|
|
||||||
return !!(ra->chunks[chunk] & ithbit(bit));
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Get a register that will fit in 8 bits (< 256). Do not call this
|
/* Get a register that will fit in 8 bits (< 256). Do not call this
|
||||||
* twice with the same value of nth without calling janetc_regalloc_free
|
* twice with the same value of nth without calling janetc_regalloc_free
|
||||||
* on the returned register before. */
|
* on the returned register before. */
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -56,6 +56,5 @@ int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth
|
|||||||
void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRegisterTemp nth);
|
void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRegisterTemp nth);
|
||||||
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
|
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
|
||||||
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
|
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
|
||||||
int janetc_regalloc_check(JanetcRegisterAllocator *ra, int32_t reg);
|
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -23,7 +23,6 @@
|
|||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include "features.h"
|
#include "features.h"
|
||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "state.h"
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Run a string */
|
/* Run a string */
|
||||||
@@ -32,7 +31,6 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
int errflags = 0, done = 0;
|
int errflags = 0, done = 0;
|
||||||
int32_t index = 0;
|
int32_t index = 0;
|
||||||
Janet ret = janet_wrap_nil();
|
Janet ret = janet_wrap_nil();
|
||||||
JanetFiber *fiber = NULL;
|
|
||||||
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
||||||
|
|
||||||
if (where) janet_gcroot(janet_wrap_string(where));
|
if (where) janet_gcroot(janet_wrap_string(where));
|
||||||
@@ -48,30 +46,22 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
JanetCompileResult cres = janet_compile(form, env, where);
|
JanetCompileResult cres = janet_compile(form, env, where);
|
||||||
if (cres.status == JANET_COMPILE_OK) {
|
if (cres.status == JANET_COMPILE_OK) {
|
||||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||||
fiber = janet_fiber(f, 64, 0, NULL);
|
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||||
fiber->env = env;
|
fiber->env = env;
|
||||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||||
janet_stacktrace_ext(fiber, ret, "");
|
janet_stacktrace(fiber, ret);
|
||||||
errflags |= 0x01;
|
errflags |= 0x01;
|
||||||
done = 1;
|
done = 1;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
ret = janet_wrap_string(cres.error);
|
ret = janet_wrap_string(cres.error);
|
||||||
int32_t line = (int32_t) parser.line;
|
|
||||||
int32_t col = (int32_t) parser.column;
|
|
||||||
if ((cres.error_mapping.line > 0) &&
|
|
||||||
(cres.error_mapping.column > 0)) {
|
|
||||||
line = cres.error_mapping.line;
|
|
||||||
col = cres.error_mapping.column;
|
|
||||||
}
|
|
||||||
if (cres.macrofiber) {
|
if (cres.macrofiber) {
|
||||||
janet_eprintf("%s:%d:%d: compile error", sourcePath,
|
janet_eprintf("compile error in %s: ", sourcePath);
|
||||||
line, col);
|
janet_stacktrace(cres.macrofiber, ret);
|
||||||
janet_stacktrace_ext(cres.macrofiber, ret, "");
|
|
||||||
} else {
|
} else {
|
||||||
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
|
janet_eprintf("compile error in %s: %s\n", sourcePath,
|
||||||
line, col, (const char *)cres.error);
|
(const char *)cres.error);
|
||||||
}
|
}
|
||||||
errflags |= 0x02;
|
errflags |= 0x02;
|
||||||
done = 1;
|
done = 1;
|
||||||
@@ -89,9 +79,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
const char *e = janet_parser_error(&parser);
|
const char *e = janet_parser_error(&parser);
|
||||||
errflags |= 0x04;
|
errflags |= 0x04;
|
||||||
ret = janet_cstringv(e);
|
ret = janet_cstringv(e);
|
||||||
int32_t line = (int32_t) parser.line;
|
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
|
||||||
int32_t col = (int32_t) parser.column;
|
|
||||||
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
|
|
||||||
done = 1;
|
done = 1;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -110,19 +98,6 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
/* Clean up and return errors */
|
/* Clean up and return errors */
|
||||||
janet_parser_deinit(&parser);
|
janet_parser_deinit(&parser);
|
||||||
if (where) janet_gcunroot(janet_wrap_string(where));
|
if (where) janet_gcunroot(janet_wrap_string(where));
|
||||||
#ifdef JANET_EV
|
|
||||||
/* Enter the event loop if we are not already in it */
|
|
||||||
if (janet_vm.stackn == 0) {
|
|
||||||
if (fiber) {
|
|
||||||
janet_gcroot(janet_wrap_fiber(fiber));
|
|
||||||
}
|
|
||||||
janet_loop();
|
|
||||||
if (fiber) {
|
|
||||||
janet_gcunroot(janet_wrap_fiber(fiber));
|
|
||||||
ret = fiber->last_value;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
if (out) *out = ret;
|
if (out) *out = ret;
|
||||||
return errflags;
|
return errflags;
|
||||||
}
|
}
|
||||||
@@ -133,19 +108,3 @@ int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Jan
|
|||||||
return janet_dobytes(env, (const uint8_t *)str, len, sourcePath, out);
|
return janet_dobytes(env, (const uint8_t *)str, len, sourcePath, out);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Run a fiber to completion (use event loop if enabled). Return the status. */
|
|
||||||
int janet_loop_fiber(JanetFiber *fiber) {
|
|
||||||
int status;
|
|
||||||
#ifdef JANET_EV
|
|
||||||
janet_schedule(fiber, janet_wrap_nil());
|
|
||||||
janet_loop();
|
|
||||||
status = janet_fiber_status(fiber);
|
|
||||||
#else
|
|
||||||
Janet out;
|
|
||||||
status = janet_continue(fiber, janet_wrap_nil(), &out);
|
|
||||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
|
||||||
janet_stacktrace_ext(fiber, out, "");
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
return status;
|
|
||||||
}
|
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2024 Calvin Rose
|
* Copyright (c) 2021 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
|
||||||
@@ -31,7 +31,7 @@
|
|||||||
|
|
||||||
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
if (argn != 1) {
|
if (argn != 1) {
|
||||||
janetc_cerror(opts.compiler, "expected 1 argument to quote");
|
janetc_cerror(opts.compiler, "expected 1 argument");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
return janetc_cslot(argv[0]);
|
return janetc_cslot(argv[0]);
|
||||||
@@ -39,12 +39,8 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
|
|
||||||
static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
JanetSlot ret;
|
JanetSlot ret;
|
||||||
if (!(opts.flags & JANET_FOPTS_ACCEPT_SPLICE)) {
|
|
||||||
janetc_cerror(opts.compiler, "splice can only be used in function parameters and data constructors, it has no effect here");
|
|
||||||
return janetc_cslot(janet_wrap_nil());
|
|
||||||
}
|
|
||||||
if (argn != 1) {
|
if (argn != 1) {
|
||||||
janetc_cerror(opts.compiler, "expected 1 argument to splice");
|
janetc_cerror(opts.compiler, "expected 1 argument");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
ret = janetc_value(opts, argv[0]);
|
ret = janetc_value(opts, argv[0]);
|
||||||
@@ -66,8 +62,6 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
|||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
JanetSlot *slots = NULL;
|
JanetSlot *slots = NULL;
|
||||||
JanetFopts subopts = opts;
|
|
||||||
subopts.flags &= ~JANET_FOPTS_HINT;
|
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default:
|
default:
|
||||||
return janetc_cslot(x);
|
return janetc_cslot(x);
|
||||||
@@ -79,9 +73,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
|||||||
const uint8_t *head = janet_unwrap_symbol(tup[0]);
|
const uint8_t *head = janet_unwrap_symbol(tup[0]);
|
||||||
if (!janet_cstrcmp(head, "unquote")) {
|
if (!janet_cstrcmp(head, "unquote")) {
|
||||||
if (level == 0) {
|
if (level == 0) {
|
||||||
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
|
||||||
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
|
|
||||||
return janetc_value(subopts, tup[1]);
|
|
||||||
} else {
|
} else {
|
||||||
level--;
|
level--;
|
||||||
}
|
}
|
||||||
@@ -90,7 +82,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
for (i = 0; i < len; i++)
|
for (i = 0; i < len; i++)
|
||||||
janet_v_push(slots, quasiquote(subopts, tup[i], depth - 1, level));
|
janet_v_push(slots, quasiquote(opts, tup[i], depth - 1, level));
|
||||||
return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||||
? JOP_MAKE_BRACKET_TUPLE
|
? JOP_MAKE_BRACKET_TUPLE
|
||||||
: JOP_MAKE_TUPLE);
|
: JOP_MAKE_TUPLE);
|
||||||
@@ -99,7 +91,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
|||||||
int32_t i;
|
int32_t i;
|
||||||
JanetArray *array = janet_unwrap_array(x);
|
JanetArray *array = janet_unwrap_array(x);
|
||||||
for (i = 0; i < array->count; i++)
|
for (i = 0; i < array->count; i++)
|
||||||
janet_v_push(slots, quasiquote(subopts, array->data[i], depth - 1, level));
|
janet_v_push(slots, quasiquote(opts, array->data[i], depth - 1, level));
|
||||||
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
||||||
}
|
}
|
||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
@@ -108,8 +100,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
|||||||
int32_t len, cap = 0;
|
int32_t len, cap = 0;
|
||||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||||
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
||||||
JanetSlot key = quasiquote(subopts, kv->key, depth - 1, level);
|
JanetSlot key = quasiquote(opts, kv->key, depth - 1, level);
|
||||||
JanetSlot value = quasiquote(subopts, kv->value, depth - 1, level);
|
JanetSlot value = quasiquote(opts, kv->value, depth - 1, level);
|
||||||
key.flags &= ~JANET_SLOT_SPLICED;
|
key.flags &= ~JANET_SLOT_SPLICED;
|
||||||
value.flags &= ~JANET_SLOT_SPLICED;
|
value.flags &= ~JANET_SLOT_SPLICED;
|
||||||
janet_v_push(slots, key);
|
janet_v_push(slots, key);
|
||||||
@@ -123,7 +115,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
|||||||
|
|
||||||
static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
if (argn != 1) {
|
if (argn != 1) {
|
||||||
janetc_cerror(opts.compiler, "expected 1 argument to quasiquote");
|
janetc_cerror(opts.compiler, "expected 1 argument");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
|
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
|
||||||
@@ -149,7 +141,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 destructuring, got %v", left));
|
janetc_cerror(c, "unexpected type in destructuring");
|
||||||
return 1;
|
return 1;
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
/* Leaf, assign right to left */
|
/* Leaf, assign right to left */
|
||||||
@@ -162,67 +154,6 @@ static int destructure(JanetCompiler *c,
|
|||||||
for (int32_t i = 0; i < len; i++) {
|
for (int32_t i = 0; i < len; i++) {
|
||||||
JanetSlot nextright = janetc_farslot(c);
|
JanetSlot nextright = janetc_farslot(c);
|
||||||
Janet subval = values[i];
|
Janet subval = values[i];
|
||||||
|
|
||||||
if (janet_checktype(subval, JANET_SYMBOL) && !janet_cstrcmp(janet_unwrap_symbol(subval), "&")) {
|
|
||||||
if (i + 1 >= len) {
|
|
||||||
janetc_cerror(c, "expected symbol following '& in destructuring pattern");
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (i + 2 < len) {
|
|
||||||
int32_t num_extra = len - i - 1;
|
|
||||||
Janet *extra = janet_tuple_begin(num_extra);
|
|
||||||
janet_tuple_flag(extra) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
|
||||||
|
|
||||||
for (int32_t j = 0; j < num_extra; ++j) {
|
|
||||||
extra[j] = values[j + i + 1];
|
|
||||||
}
|
|
||||||
|
|
||||||
janetc_error(c, janet_formatc("expected a single symbol follow '& in destructuring pattern, found %q", janet_wrap_tuple(janet_tuple_end(extra))));
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (!janet_checktype(values[i + 1], JANET_SYMBOL)) {
|
|
||||||
janetc_error(c, janet_formatc("expected symbol following '& in destructuring pattern, found %q", values[i + 1]));
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
JanetSlot argi = janetc_farslot(c);
|
|
||||||
JanetSlot arg = janetc_farslot(c);
|
|
||||||
JanetSlot len = janetc_farslot(c);
|
|
||||||
|
|
||||||
janetc_emit_si(c, JOP_LOAD_INTEGER, argi, i, 0);
|
|
||||||
janetc_emit_ss(c, JOP_LENGTH, len, right, 0);
|
|
||||||
|
|
||||||
/* loop condition - reuse arg slot for the condition result */
|
|
||||||
int32_t label_loop_start = janetc_emit_sss(c, JOP_LESS_THAN, arg, argi, len, 0);
|
|
||||||
int32_t label_loop_cond_jump = janetc_emit_si(c, JOP_JUMP_IF_NOT, arg, 0, 0);
|
|
||||||
|
|
||||||
/* loop body */
|
|
||||||
janetc_emit_sss(c, JOP_GET, arg, right, argi, 0);
|
|
||||||
janetc_emit_s(c, JOP_PUSH, arg, 0);
|
|
||||||
janetc_emit_ssi(c, JOP_ADD_IMMEDIATE, argi, argi, 1, 0);
|
|
||||||
|
|
||||||
/* loop - jump back to the start of the loop */
|
|
||||||
int32_t label_loop_loop = janet_v_count(c->buffer);
|
|
||||||
janetc_emit(c, JOP_JUMP);
|
|
||||||
int32_t label_loop_exit = janet_v_count(c->buffer);
|
|
||||||
|
|
||||||
/* avoid shifting negative numbers */
|
|
||||||
c->buffer[label_loop_cond_jump] |= (uint32_t)(label_loop_exit - label_loop_cond_jump) << 16;
|
|
||||||
c->buffer[label_loop_loop] |= (uint32_t)(label_loop_start - label_loop_loop) << 8;
|
|
||||||
|
|
||||||
janetc_freeslot(c, argi);
|
|
||||||
janetc_freeslot(c, arg);
|
|
||||||
janetc_freeslot(c, len);
|
|
||||||
|
|
||||||
janetc_emit_s(c, JOP_MAKE_TUPLE, nextright, 1);
|
|
||||||
|
|
||||||
leaf(c, janet_unwrap_symbol(values[i + 1]), nextright, attr);
|
|
||||||
janetc_freeslot(c, nextright);
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (i < 0x100) {
|
if (i < 0x100) {
|
||||||
janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
|
janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
|
||||||
} else {
|
} else {
|
||||||
@@ -263,7 +194,7 @@ static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
|||||||
|
|
||||||
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
if (argn != 2) {
|
if (argn != 2) {
|
||||||
janetc_cerror(opts.compiler, "expected 2 arguments to set");
|
janetc_cerror(opts.compiler, "expected 2 arguments");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
||||||
@@ -305,24 +236,14 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Add attributes to a global def or var table */
|
/* Add attributes to a global def or var table */
|
||||||
static JanetTable *handleattr(JanetCompiler *c, const char *kind, int32_t argn, const Janet *argv) {
|
static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetTable *tab = janet_table(2);
|
JanetTable *tab = janet_table(2);
|
||||||
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
|
|
||||||
? ((const char *)janet_unwrap_symbol(argv[0]))
|
|
||||||
: "<multiple bindings>";
|
|
||||||
if (argn < 2) {
|
|
||||||
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
for (i = 1; i < argn - 1; i++) {
|
for (i = 1; i < argn - 1; i++) {
|
||||||
Janet attr = argv[i];
|
Janet attr = argv[i];
|
||||||
switch (janet_type(attr)) {
|
switch (janet_type(attr)) {
|
||||||
case JANET_TUPLE:
|
|
||||||
janetc_cerror(c, "unexpected form - did you intend to use defn?");
|
|
||||||
break;
|
|
||||||
default:
|
default:
|
||||||
janetc_error(c, janet_formatc("cannot add metadata %v to binding %s", attr, binding_name));
|
janetc_cerror(c, "could not add metadata to binding");
|
||||||
break;
|
break;
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD:
|
||||||
janet_table_put(tab, attr, janet_wrap_true());
|
janet_table_put(tab, attr, janet_wrap_true());
|
||||||
@@ -338,52 +259,18 @@ static JanetTable *handleattr(JanetCompiler *c, const char *kind, int32_t argn,
|
|||||||
return tab;
|
return tab;
|
||||||
}
|
}
|
||||||
|
|
||||||
typedef struct SlotHeadPair {
|
static JanetSlot dohead(JanetCompiler *c, JanetFopts opts, Janet *head, int32_t argn, const Janet *argv) {
|
||||||
Janet lhs;
|
|
||||||
JanetSlot rhs;
|
|
||||||
} SlotHeadPair;
|
|
||||||
|
|
||||||
SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopts opts, Janet lhs, Janet rhs) {
|
|
||||||
|
|
||||||
/* Detect if we can do an optimization to avoid some allocations */
|
|
||||||
int can_destructure_lhs = janet_checktype(lhs, JANET_TUPLE)
|
|
||||||
|| janet_checktype(lhs, JANET_ARRAY);
|
|
||||||
int rhs_is_indexed = janet_checktype(rhs, JANET_ARRAY)
|
|
||||||
|| (janet_checktype(rhs, JANET_TUPLE) && (janet_tuple_flag(janet_unwrap_tuple(rhs)) & JANET_TUPLE_FLAG_BRACKETCTOR));
|
|
||||||
uint32_t has_drop = opts.flags & JANET_FOPTS_DROP;
|
|
||||||
|
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
|
JanetSlot ret;
|
||||||
|
if (argn < 2) {
|
||||||
|
janetc_cerror(c, "expected at least 2 arguments");
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
*head = argv[0];
|
||||||
subopts.flags = opts.flags & ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
|
subopts.flags = opts.flags & ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
|
||||||
|
|
||||||
if (has_drop && can_destructure_lhs && rhs_is_indexed) {
|
|
||||||
/* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */
|
|
||||||
JanetView view_lhs = {0};
|
|
||||||
JanetView view_rhs = {0};
|
|
||||||
janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
|
|
||||||
janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
|
|
||||||
int found_amp = 0;
|
|
||||||
for (int32_t i = 0; i < view_lhs.len; i++) {
|
|
||||||
if (janet_symeq(view_lhs.items[i], "&")) {
|
|
||||||
found_amp = 1;
|
|
||||||
/* Good error will be generated later. */
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (!found_amp) {
|
|
||||||
for (int32_t i = 0; i < view_lhs.len; i++) {
|
|
||||||
Janet sub_rhs = view_rhs.len <= i ? janet_wrap_nil() : view_rhs.items[i];
|
|
||||||
into = dohead_destructure(c, into, subopts, view_lhs.items[i], sub_rhs);
|
|
||||||
}
|
|
||||||
return into;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* No optimization, do the simple way */
|
|
||||||
subopts.hint = opts.hint;
|
subopts.hint = opts.hint;
|
||||||
JanetSlot ret = janetc_value(subopts, rhs);
|
ret = janetc_value(subopts, argv[argn - 1]);
|
||||||
SlotHeadPair shp = {lhs, ret};
|
return ret;
|
||||||
janet_v_push(into, shp);
|
|
||||||
return into;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Def or var a symbol in a local scope */
|
/* Def or var a symbol in a local scope */
|
||||||
@@ -391,17 +278,7 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
|
|||||||
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
||||||
ret.index > 0 &&
|
ret.index > 0 &&
|
||||||
ret.envindex >= 0;
|
ret.envindex >= 0;
|
||||||
/* optimization for `(def x my-def)` - don't emit a movn/movf instruction, we can just alias my-def */
|
if (!isUnnamedRegister) {
|
||||||
/* TODO - implement optimization for `(def x my-var)` correctly as well w/ de-aliasing */
|
|
||||||
int canAlias = !(flags & JANET_SLOT_MUTABLE) &&
|
|
||||||
!(ret.flags & JANET_SLOT_MUTABLE) &&
|
|
||||||
(ret.flags & JANET_SLOT_NAMED) &&
|
|
||||||
(ret.index >= 0) &&
|
|
||||||
(ret.envindex == -1);
|
|
||||||
if (canAlias) {
|
|
||||||
ret.flags &= ~JANET_SLOT_MUTABLE;
|
|
||||||
isUnnamedRegister = 1; /* don't free slot after use - is an alias for another slot */
|
|
||||||
} else if (!isUnnamedRegister) {
|
|
||||||
/* Slot is not able to be named */
|
/* Slot is not able to be named */
|
||||||
JanetSlot localslot = janetc_farslot(c);
|
JanetSlot localslot = janetc_farslot(c);
|
||||||
janetc_copy(c, localslot, ret);
|
janetc_copy(c, localslot, ret);
|
||||||
@@ -421,20 +298,8 @@ static int varleaf(
|
|||||||
/* Global var, generate var */
|
/* Global var, generate var */
|
||||||
JanetSlot refslot;
|
JanetSlot refslot;
|
||||||
JanetTable *entry = janet_table_clone(reftab);
|
JanetTable *entry = janet_table_clone(reftab);
|
||||||
|
JanetArray *ref = janet_array(1);
|
||||||
Janet redef_kw = janet_ckeywordv("redef");
|
|
||||||
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
|
|
||||||
|
|
||||||
JanetArray *ref;
|
|
||||||
JanetBinding old_binding;
|
|
||||||
if (is_redef && (old_binding = janet_resolve_ext(c->env, sym),
|
|
||||||
old_binding.type == JANET_BINDING_VAR)) {
|
|
||||||
ref = janet_unwrap_array(old_binding.value);
|
|
||||||
} else {
|
|
||||||
ref = janet_array(1);
|
|
||||||
janet_array_push(ref, janet_wrap_nil());
|
janet_array_push(ref, janet_wrap_nil());
|
||||||
}
|
|
||||||
|
|
||||||
janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
||||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
janet_table_put(entry, janet_ckeywordv("source-map"),
|
||||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
@@ -449,23 +314,11 @@ static int varleaf(
|
|||||||
|
|
||||||
static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
JanetTable *attr_table = handleattr(c, "var", argn, argv);
|
Janet head;
|
||||||
if (c->result.status == JANET_COMPILE_ERROR) {
|
JanetSlot ret = dohead(c, opts, &head, argn, argv);
|
||||||
|
if (c->result.status == JANET_COMPILE_ERROR)
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
destructure(c, argv[0], ret, varleaf, handleattr(c, argn, argv));
|
||||||
SlotHeadPair *into = NULL;
|
|
||||||
into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
|
|
||||||
if (c->result.status == JANET_COMPILE_ERROR) {
|
|
||||||
janet_v_free(into);
|
|
||||||
return janetc_cslot(janet_wrap_nil());
|
|
||||||
}
|
|
||||||
JanetSlot ret;
|
|
||||||
janet_assert(janet_v_count(into) > 0, "bad destructure");
|
|
||||||
for (int32_t i = 0; i < janet_v_count(into); i++) {
|
|
||||||
destructure(c, into[i].lhs, into[i].rhs, varleaf, attr_table);
|
|
||||||
ret = into[i].rhs;
|
|
||||||
}
|
|
||||||
janet_v_free(into);
|
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -478,78 +331,29 @@ static int defleaf(
|
|||||||
JanetTable *entry = janet_table_clone(tab);
|
JanetTable *entry = janet_table_clone(tab);
|
||||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
janet_table_put(entry, janet_ckeywordv("source-map"),
|
||||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
|
|
||||||
Janet redef_kw = janet_ckeywordv("redef");
|
|
||||||
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
|
|
||||||
if (is_redef) janet_table_put(entry, redef_kw, janet_wrap_true());
|
|
||||||
|
|
||||||
if (is_redef) {
|
|
||||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
|
||||||
JanetArray *ref;
|
|
||||||
if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
|
|
||||||
ref = janet_unwrap_array(binding.value);
|
|
||||||
} else {
|
|
||||||
ref = janet_array(1);
|
|
||||||
janet_array_push(ref, janet_wrap_nil());
|
|
||||||
}
|
|
||||||
janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
|
||||||
JanetSlot refslot = janetc_cslot(janet_wrap_array(ref));
|
|
||||||
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
|
||||||
} else {
|
|
||||||
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
||||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
|
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
|
||||||
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Add env entry to env */
|
/* Add env entry to env */
|
||||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
||||||
|
|
||||||
|
/* Put value in table when evaulated */
|
||||||
|
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
|
||||||
}
|
}
|
||||||
return namelocal(c, sym, 0, s);
|
return namelocal(c, sym, 0, s);
|
||||||
}
|
}
|
||||||
|
|
||||||
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
JanetTable *attr_table = handleattr(c, "def", argn, argv);
|
Janet head;
|
||||||
if (c->result.status == JANET_COMPILE_ERROR) {
|
|
||||||
return janetc_cslot(janet_wrap_nil());
|
|
||||||
}
|
|
||||||
opts.flags &= ~JANET_FOPTS_HINT;
|
opts.flags &= ~JANET_FOPTS_HINT;
|
||||||
SlotHeadPair *into = NULL;
|
JanetSlot ret = dohead(c, opts, &head, argn, argv);
|
||||||
into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
|
if (c->result.status == JANET_COMPILE_ERROR)
|
||||||
if (c->result.status == JANET_COMPILE_ERROR) {
|
|
||||||
janet_v_free(into);
|
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
destructure(c, argv[0], ret, defleaf, handleattr(c, argn, argv));
|
||||||
JanetSlot ret;
|
|
||||||
janet_assert(janet_v_count(into) > 0, "bad destructure");
|
|
||||||
for (int32_t i = 0; i < janet_v_count(into); i++) {
|
|
||||||
destructure(c, into[i].lhs, into[i].rhs, defleaf, attr_table);
|
|
||||||
ret = into[i].rhs;
|
|
||||||
}
|
|
||||||
janet_v_free(into);
|
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
|
|
||||||
static int janetc_check_nil_form(Janet x, Janet *capture, uint32_t fun_tag) {
|
|
||||||
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
|
||||||
JanetTuple tup = janet_unwrap_tuple(x);
|
|
||||||
if (3 != janet_tuple_length(tup)) return 0;
|
|
||||||
Janet op1 = tup[0];
|
|
||||||
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
|
|
||||||
JanetFunction *fun = janet_unwrap_function(op1);
|
|
||||||
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
|
||||||
if (tag != fun_tag) return 0;
|
|
||||||
if (janet_checktype(tup[1], JANET_NIL)) {
|
|
||||||
*capture = tup[2];
|
|
||||||
return 1;
|
|
||||||
} else if (janet_checktype(tup[2], JANET_NIL)) {
|
|
||||||
*capture = tup[1];
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* :condition
|
* :condition
|
||||||
* ...
|
* ...
|
||||||
@@ -570,7 +374,6 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
JanetScope condscope, tempscope;
|
JanetScope condscope, tempscope;
|
||||||
const int tail = opts.flags & JANET_FOPTS_TAIL;
|
const int tail = opts.flags & JANET_FOPTS_TAIL;
|
||||||
const int drop = opts.flags & JANET_FOPTS_DROP;
|
const int drop = opts.flags & JANET_FOPTS_DROP;
|
||||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
|
||||||
|
|
||||||
if (argn < 2 || argn > 3) {
|
if (argn < 2 || argn > 3) {
|
||||||
janetc_cerror(c, "expected 2 or 3 arguments to if");
|
janetc_cerror(c, "expected 2 or 3 arguments to if");
|
||||||
@@ -584,7 +387,6 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
/* Get options */
|
/* Get options */
|
||||||
condopts = janetc_fopts_default(c);
|
condopts = janetc_fopts_default(c);
|
||||||
bodyopts = opts;
|
bodyopts = opts;
|
||||||
bodyopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
|
|
||||||
|
|
||||||
/* Set target for compilation */
|
/* Set target for compilation */
|
||||||
target = (drop || tail)
|
target = (drop || tail)
|
||||||
@@ -593,24 +395,12 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
|
|
||||||
/* Compile condition */
|
/* Compile condition */
|
||||||
janetc_scope(&condscope, c, 0, "if");
|
janetc_scope(&condscope, c, 0, "if");
|
||||||
|
cond = janetc_value(condopts, argv[0]);
|
||||||
Janet condform = argv[0];
|
|
||||||
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
|
|
||||||
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
|
||||||
} else if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
|
|
||||||
ifnjmp = JOP_JUMP_IF_NIL;
|
|
||||||
}
|
|
||||||
|
|
||||||
cond = janetc_value(condopts, condform);
|
|
||||||
|
|
||||||
/* Check constant condition. */
|
/* 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) {
|
||||||
int swap_condition = 0;
|
if (!janet_truthy(cond.constant)) {
|
||||||
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;
|
||||||
@@ -628,7 +418,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Compile jump to right */
|
/* Compile jump to right */
|
||||||
labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0);
|
labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
|
||||||
|
|
||||||
/* Condition left body */
|
/* Condition left body */
|
||||||
janetc_scope(&tempscope, c, 0, "if-true");
|
janetc_scope(&tempscope, c, 0, "if-true");
|
||||||
@@ -638,7 +428,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
|
|
||||||
/* Compile jump to done */
|
/* Compile jump to done */
|
||||||
labeljd = janet_v_count(c->buffer);
|
labeljd = janet_v_count(c->buffer);
|
||||||
if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP);
|
if (!tail) janetc_emit(c, JOP_JUMP);
|
||||||
|
|
||||||
/* Compile right body */
|
/* Compile right body */
|
||||||
labelr = janet_v_count(c->buffer);
|
labelr = janet_v_count(c->buffer);
|
||||||
@@ -673,7 +463,6 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
subopts.flags = JANET_FOPTS_DROP;
|
subopts.flags = JANET_FOPTS_DROP;
|
||||||
} else {
|
} else {
|
||||||
subopts = opts;
|
subopts = opts;
|
||||||
subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
|
|
||||||
}
|
}
|
||||||
ret = janetc_value(subopts, argv[i]);
|
ret = janetc_value(subopts, argv[i]);
|
||||||
if (i != argn - 1) {
|
if (i != argn - 1) {
|
||||||
@@ -684,6 +473,7 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Compile an upscope form. Upscope forms execute their body sequentially and
|
/* Compile an upscope form. Upscope forms execute their body sequentially and
|
||||||
* evaluate to the last expression in the body, but without lexical scope. */
|
* evaluate to the last expression in the body, but without lexical scope. */
|
||||||
static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
@@ -696,7 +486,6 @@ static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv
|
|||||||
subopts.flags = JANET_FOPTS_DROP;
|
subopts.flags = JANET_FOPTS_DROP;
|
||||||
} else {
|
} else {
|
||||||
subopts = opts;
|
subopts = opts;
|
||||||
subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
|
|
||||||
}
|
}
|
||||||
ret = janetc_value(subopts, argv[i]);
|
ret = janetc_value(subopts, argv[i]);
|
||||||
if (i != argn - 1) {
|
if (i != argn - 1) {
|
||||||
@@ -749,8 +538,9 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
|
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
|
||||||
/* Closure body with return argument */
|
/* Closure body with return argument */
|
||||||
subopts.flags |= JANET_FOPTS_TAIL;
|
subopts.flags |= JANET_FOPTS_TAIL;
|
||||||
janetc_value(subopts, argv[0]);
|
JanetSlot ret = janetc_value(subopts, argv[0]);
|
||||||
return janetc_cslot(janet_wrap_nil());
|
ret.flags |= JANET_SLOT_RETURNED;
|
||||||
|
return ret;
|
||||||
} else {
|
} else {
|
||||||
/* while loop IIFE or no argument */
|
/* while loop IIFE or no argument */
|
||||||
if (argn) {
|
if (argn) {
|
||||||
@@ -758,7 +548,9 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
janetc_value(subopts, argv[0]);
|
janetc_value(subopts, argv[0]);
|
||||||
}
|
}
|
||||||
janetc_emit(c, JOP_RETURN_NIL);
|
janetc_emit(c, JOP_RETURN_NIL);
|
||||||
return janetc_cslot(janet_wrap_nil());
|
JanetSlot s = janetc_cslot(janet_wrap_nil());
|
||||||
|
s.flags |= JANET_SLOT_RETURNED;
|
||||||
|
return s;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
if (argn) {
|
if (argn) {
|
||||||
@@ -771,6 +563,20 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Check if a form matches the pattern (not= nil _) */
|
||||||
|
static int janetc_check_notnil_form(Janet x, Janet *capture) {
|
||||||
|
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
||||||
|
JanetTuple tup = janet_unwrap_tuple(x);
|
||||||
|
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
|
||||||
|
if (3 != janet_tuple_length(tup)) return 0;
|
||||||
|
JanetFunction *fun = janet_unwrap_function(tup[0]);
|
||||||
|
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
||||||
|
if (tag != JANET_FUN_NEQ) return 0;
|
||||||
|
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
|
||||||
|
*capture = tup[2];
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* :whiletop
|
* :whiletop
|
||||||
* ...
|
* ...
|
||||||
@@ -787,13 +593,12 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
JanetScope tempscope;
|
JanetScope tempscope;
|
||||||
int32_t labelwt, labeld, labeljt, labelc, i;
|
int32_t labelwt, labeld, labeljt, labelc, i;
|
||||||
int infinite = 0;
|
int infinite = 0;
|
||||||
int is_nil_form = 0;
|
|
||||||
int is_notnil_form = 0;
|
int is_notnil_form = 0;
|
||||||
uint8_t ifjmp = JOP_JUMP_IF;
|
uint8_t ifjmp = JOP_JUMP_IF;
|
||||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
||||||
|
|
||||||
if (argn < 1) {
|
if (argn < 2) {
|
||||||
janetc_cerror(c, "expected at least 1 argument to while");
|
janetc_cerror(c, "expected at least 2 arguments");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -801,16 +606,11 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
|
|
||||||
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||||
|
|
||||||
/* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the
|
/* Check for `(not= nil _)` in condition, and if so, use the
|
||||||
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
|
* 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(condform, &condform, JANET_FUN_EQ)) {
|
if (janetc_check_notnil_form(condform, &condform)) {
|
||||||
is_nil_form = 1;
|
|
||||||
ifjmp = JOP_JUMP_IF_NIL;
|
|
||||||
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
|
||||||
}
|
|
||||||
if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
|
|
||||||
is_notnil_form = 1;
|
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;
|
||||||
@@ -822,9 +622,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
/* Check for constant condition */
|
/* Check for constant condition */
|
||||||
if (cond.flags & JANET_SLOT_CONSTANT) {
|
if (cond.flags & JANET_SLOT_CONSTANT) {
|
||||||
/* Loop never executes */
|
/* Loop never executes */
|
||||||
int never_executes = is_nil_form
|
int never_executes = is_notnil_form
|
||||||
? !janet_checktype(cond.constant, JANET_NIL)
|
|
||||||
: is_notnil_form
|
|
||||||
? janet_checktype(cond.constant, JANET_NIL)
|
? janet_checktype(cond.constant, JANET_NIL)
|
||||||
: !janet_truthy(cond.constant);
|
: !janet_truthy(cond.constant);
|
||||||
if (never_executes) {
|
if (never_executes) {
|
||||||
@@ -915,7 +713,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
JanetSlot ret;
|
JanetSlot ret;
|
||||||
Janet head;
|
Janet head;
|
||||||
JanetScope fnscope;
|
JanetScope fnscope;
|
||||||
int32_t paramcount, argi, parami, arity, min_arity = 0, max_arity, defindex, i;
|
int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
const Janet *params;
|
const Janet *params;
|
||||||
const char *errmsg = NULL;
|
const char *errmsg = NULL;
|
||||||
@@ -925,10 +723,8 @@ 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;
|
|
||||||
|
|
||||||
/* Begin function */
|
/* Begin function */
|
||||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||||
@@ -944,10 +740,6 @@ 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)) {
|
||||||
@@ -957,9 +749,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
|
|
||||||
/* Keep track of destructured parameters */
|
/* Keep track of destructured parameters */
|
||||||
JanetSlot *destructed_params = NULL;
|
JanetSlot *destructed_params = NULL;
|
||||||
JanetSlot *named_params = NULL;
|
|
||||||
JanetTable *named_table = NULL;
|
|
||||||
JanetSlot named_slot;
|
|
||||||
|
|
||||||
/* Compile function parameters */
|
/* Compile function parameters */
|
||||||
params = janet_unwrap_tuple(argv[parami]);
|
params = janet_unwrap_tuple(argv[parami]);
|
||||||
@@ -967,20 +756,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
arity = paramcount;
|
arity = paramcount;
|
||||||
for (i = 0; i < paramcount; i++) {
|
for (i = 0; i < paramcount; i++) {
|
||||||
Janet param = params[i];
|
Janet param = params[i];
|
||||||
if (namedargs) {
|
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||||
arity--;
|
|
||||||
if (!janet_checktype(param, JANET_SYMBOL)) {
|
|
||||||
errmsg = "only named arguments can follow &named";
|
|
||||||
goto error;
|
|
||||||
}
|
|
||||||
Janet key = janet_wrap_keyword(janet_unwrap_symbol(param));
|
|
||||||
janet_table_put(named_table, key, param);
|
|
||||||
janet_v_push(named_params, janetc_farslot(c));
|
|
||||||
} else if (janet_checktype(param, JANET_SYMBOL)) {
|
|
||||||
/* Check for varargs and unfixed arity */
|
/* Check for varargs and unfixed arity */
|
||||||
const uint8_t *sym = janet_unwrap_symbol(param);
|
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
|
||||||
if (sym[0] == '&') {
|
|
||||||
if (!janet_cstrcmp(sym, "&")) {
|
|
||||||
if (seenamp) {
|
if (seenamp) {
|
||||||
errmsg = "& in unexpected location";
|
errmsg = "& in unexpected location";
|
||||||
goto error;
|
goto error;
|
||||||
@@ -995,7 +773,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
goto error;
|
goto error;
|
||||||
}
|
}
|
||||||
seenamp = 1;
|
seenamp = 1;
|
||||||
} else if (!janet_cstrcmp(sym, "&opt")) {
|
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
|
||||||
if (seenopt) {
|
if (seenopt) {
|
||||||
errmsg = "only one &opt allowed";
|
errmsg = "only one &opt allowed";
|
||||||
goto error;
|
goto error;
|
||||||
@@ -1006,7 +784,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
min_arity = i;
|
min_arity = i;
|
||||||
arity--;
|
arity--;
|
||||||
seenopt = 1;
|
seenopt = 1;
|
||||||
} else if (!janet_cstrcmp(sym, "&keys")) {
|
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) {
|
||||||
if (seenamp) {
|
if (seenamp) {
|
||||||
errmsg = "&keys in unexpected location";
|
errmsg = "&keys in unexpected location";
|
||||||
goto error;
|
goto error;
|
||||||
@@ -1019,23 +797,8 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
goto error;
|
goto error;
|
||||||
}
|
}
|
||||||
seenamp = 1;
|
seenamp = 1;
|
||||||
} else if (!janet_cstrcmp(sym, "&named")) {
|
|
||||||
if (seenamp) {
|
|
||||||
errmsg = "&named in unexpected location";
|
|
||||||
goto error;
|
|
||||||
}
|
|
||||||
vararg = 1;
|
|
||||||
structarg = 1;
|
|
||||||
arity--;
|
|
||||||
seenamp = 1;
|
|
||||||
namedargs = 1;
|
|
||||||
named_table = janet_table(10);
|
|
||||||
named_slot = janetc_farslot(c);
|
|
||||||
} else {
|
} else {
|
||||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||||
}
|
|
||||||
} else {
|
|
||||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
janet_v_push(destructed_params, janetc_farslot(c));
|
janet_v_push(destructed_params, janetc_farslot(c));
|
||||||
@@ -1047,7 +810,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
for (i = 0; i < paramcount; i++) {
|
for (i = 0; i < paramcount; i++) {
|
||||||
Janet param = params[i];
|
Janet param = params[i];
|
||||||
if (!janet_checktype(param, JANET_SYMBOL)) {
|
if (!janet_checktype(param, JANET_SYMBOL)) {
|
||||||
janet_assert(janet_v_count(destructed_params) > j, "out of bounds");
|
|
||||||
JanetSlot reg = destructed_params[j++];
|
JanetSlot reg = destructed_params[j++];
|
||||||
destructure(c, param, reg, defleaf, NULL);
|
destructure(c, param, reg, defleaf, NULL);
|
||||||
janetc_freeslot(c, reg);
|
janetc_freeslot(c, reg);
|
||||||
@@ -1055,37 +817,15 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
}
|
}
|
||||||
janet_v_free(destructed_params);
|
janet_v_free(destructed_params);
|
||||||
|
|
||||||
/* Compile named arguments */
|
|
||||||
if (namedargs) {
|
|
||||||
Janet param = janet_wrap_table(named_table);
|
|
||||||
destructure(c, param, named_slot, defleaf, NULL);
|
|
||||||
janetc_freeslot(c, named_slot);
|
|
||||||
janet_v_free(named_params);
|
|
||||||
}
|
|
||||||
|
|
||||||
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||||
if (!seenopt) min_arity = arity;
|
if (!seenopt) min_arity = arity;
|
||||||
|
|
||||||
/* Check for self ref (also avoid if arguments shadow own name) */
|
/* Check for self ref */
|
||||||
if (selfref) {
|
if (selfref) {
|
||||||
/* Check if the parameters shadow the function name. If so, don't
|
|
||||||
* emit JOP_LOAD_SELF and add a binding since that most users
|
|
||||||
* seem to expect that function parameters take precedence over the
|
|
||||||
* function name */
|
|
||||||
const uint8_t *sym = janet_unwrap_symbol(head);
|
|
||||||
int32_t len = janet_v_count(c->scope->syms);
|
|
||||||
int found = 0;
|
|
||||||
for (int32_t i = 0; i < len; i++) {
|
|
||||||
if (c->scope->syms[i].sym == sym) {
|
|
||||||
found = 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (!found) {
|
|
||||||
JanetSlot slot = janetc_farslot(c);
|
JanetSlot slot = janetc_farslot(c);
|
||||||
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
|
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
|
||||||
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
|
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
|
||||||
janetc_nameslot(c, sym, slot);
|
janetc_nameslot(c, janet_unwrap_symbol(head), slot);
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Compile function body */
|
/* Compile function body */
|
||||||
@@ -1108,7 +848,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 (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
|
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||||
janet_def_addflags(def);
|
janet_def_addflags(def);
|
||||||
defindex = janetc_addfuncdef(c, def);
|
defindex = janetc_addfuncdef(c, def);
|
||||||
|
|
||||||
@@ -1152,3 +892,4 @@ const JanetSpecial *janetc_special(const uint8_t *name) {
|
|||||||
sizeof(JanetSpecial),
|
sizeof(JanetSpecial),
|
||||||
name);
|
name);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user