mirror of
https://github.com/janet-lang/janet
synced 2025-10-28 14:17:42 +00:00
Compare commits
1 Commits
ffi
...
cuddled-sy
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
2739605184 |
@@ -9,3 +9,4 @@ tasks:
|
||||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
gmake test-install
|
||||
|
||||
@@ -1,21 +0,0 @@
|
||||
image: archlinux
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- with-epoll: |
|
||||
cd janet
|
||||
meson setup with-epoll --buildtype=release
|
||||
cd with-epoll
|
||||
meson configure -Depoll=true
|
||||
ninja
|
||||
ninja test
|
||||
- no-epoll: |
|
||||
cd janet
|
||||
meson setup no-epoll --buildtype=release
|
||||
cd no-epoll
|
||||
meson configure -Depoll=false
|
||||
ninja
|
||||
ninja test
|
||||
sudo ninja install
|
||||
@@ -3,30 +3,10 @@ sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
- meson
|
||||
tasks:
|
||||
- gmake: |
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
- meson_min: |
|
||||
cd janet
|
||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true -Dffi=false
|
||||
cd build_meson_min
|
||||
ninja
|
||||
- meson_prf: |
|
||||
cd janet
|
||||
meson setup build_meson_prf --buildtype=release -Dprf=true
|
||||
cd build_meson_prf
|
||||
ninja
|
||||
ninja test
|
||||
- meson_default: |
|
||||
cd janet
|
||||
meson setup build_meson_default --buildtype=release
|
||||
cd build_meson_default
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
|
||||
|
||||
8
.gitattributes
vendored
8
.gitattributes
vendored
@@ -1,8 +0,0 @@
|
||||
*.janet text eol=lf
|
||||
*.c text eol=lf
|
||||
*.h text eol=lf
|
||||
*.md text eol=lf
|
||||
*.yml text eol=lf
|
||||
*.build text eol=lf
|
||||
*.txt text eol=lf
|
||||
*.sh text eol=lf
|
||||
|
||||
62
.github/workflows/release.yml
vendored
62
.github/workflows/release.yml
vendored
@@ -1,62 +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-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 }}-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-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
|
||||
37
.github/workflows/test.yml
vendored
37
.github/workflows/test.yml
vendored
@@ -1,37 +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 ]
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Compile the project
|
||||
run: make clean && make
|
||||
- name: Test the project
|
||||
run: make test
|
||||
|
||||
test-windows:
|
||||
name: Build and test on 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
|
||||
- name: Test the project
|
||||
shell: cmd
|
||||
run: build_win test
|
||||
14
.gitignore
vendored
14
.gitignore
vendored
@@ -32,11 +32,6 @@ lockfile.janet
|
||||
# Local directory for testing
|
||||
local
|
||||
|
||||
# Common test files I use.
|
||||
temp.janet
|
||||
temp*.janet
|
||||
scratch.janet
|
||||
|
||||
# Emscripten
|
||||
*.bc
|
||||
janet.js
|
||||
@@ -48,7 +43,6 @@ janet.wasm
|
||||
|
||||
# Generate test files
|
||||
*.out
|
||||
.orig
|
||||
|
||||
# Tools
|
||||
xxd
|
||||
@@ -56,7 +50,6 @@ xxd.exe
|
||||
|
||||
# VSCode
|
||||
.vs
|
||||
.clangd
|
||||
|
||||
# Swap files
|
||||
*.swp
|
||||
@@ -68,10 +61,6 @@ tags
|
||||
vgcore.*
|
||||
*.out.*
|
||||
|
||||
# Wix artifacts
|
||||
*.msi
|
||||
*.wixpdb
|
||||
|
||||
# Created by https://www.gitignore.io/api/c
|
||||
|
||||
### C ###
|
||||
@@ -142,6 +131,3 @@ compile_commands.json
|
||||
CTestTestfile.cmake
|
||||
|
||||
# End of https://www.gitignore.io/api/cmake
|
||||
|
||||
# Astyle
|
||||
*.orig
|
||||
|
||||
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
|
||||
- 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"
|
||||
390
CHANGELOG.md
390
CHANGELOG.md
@@ -1,396 +1,6 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers.
|
||||
- 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_interupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
|
||||
- Add `table/clear`
|
||||
- Add build option to disable the threading library without disabling all threads.
|
||||
- Remove JPM from the main Janet distribution. Instead, JPM must be installed
|
||||
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
|
||||
- Add `maclintf` - a utility for adding linting messages when inside macros.
|
||||
- Print source code of offending line on compiler warnings and errors.
|
||||
- Fix some issues with linting and re-add missing `make docs`.
|
||||
- Allow controlling linting with dynamic bindings `:lint-warn`, `:lint-error`, and `:lint-levels`.
|
||||
- Add `-w` and `-x` command line flags to the `janet` binary to set linting thresholds.
|
||||
linting thresholds are as follows:
|
||||
- :none - will never be trigger.
|
||||
- :relaxed - will only trigger on `:relaxed` lints.
|
||||
- :normal - will trigger on `:relaxed` and `:normal` lints.
|
||||
- :strict - will trigger on `:strict`, `:normal`, and `:relaxed` lints. This will catch the most issues
|
||||
but can be distracting.
|
||||
|
||||
## 1.16.0 - 2021-05-30
|
||||
- Add color documentation to the `doc` macro - enable/disable with `(dyn :doc-color)`.
|
||||
- Remove simpler HTML docs from distribution - use website or built-in documentation instead.
|
||||
- Add compiler warnings and deprecation levels.
|
||||
- Add `as-macro` to make using macros within quasiquote easier to do hygienically.
|
||||
- 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
|
||||
native libraries when building with jpm.
|
||||
- Remove the `tarray` module. The functionality of typed arrays will be moved to an external module
|
||||
that can be installed via `jpm`.
|
||||
- Add `from-pairs` to core.
|
||||
- Add `JPM_OS_WHICH` environment variable to jpm to allow changing auto-detection behavior.
|
||||
- The flychecker will consider any top-level calls of functions that start with `define-` to
|
||||
be safe to execute and execute them. This allows certain patterns (like spork/path) to be
|
||||
better processed by the flychecker.
|
||||
|
||||
## 1.15.5 - 2021-04-25
|
||||
- Add `declare-headers` to jpm.
|
||||
- Fix error using unix pipes on BSDs.
|
||||
- Support .cc and .cxx extensions in `jpm` for C++ code.
|
||||
- Change networking code to not create as many HUP errors.
|
||||
- Add `net/shutdown` to close sockets in one direction without hang ups.
|
||||
- Update code for printing the debug repl
|
||||
|
||||
## 1.15.4 - 2021-03-16
|
||||
- Increase default nesting depth of pretty printing to `JANET_RECURSION_GUARD`
|
||||
- Update meson.build
|
||||
- Add option to automatically add shebang line in installed scripts with `jpm`.
|
||||
- Add `partition-by` and `group-by` to the core.
|
||||
- Sort keys in pretty printing output.
|
||||
|
||||
## 1.15.3 - 2021-02-28
|
||||
- Fix a fiber bug that occured in deeply nested fibers
|
||||
- Add `unref` combinator to pegs.
|
||||
- Small docstring changes.
|
||||
|
||||
## 1.15.2 - 2021-02-15
|
||||
- Fix bug in windows version of `os/spawn` and `os/execute` with setting environment variables.
|
||||
- Fix documentation typos.
|
||||
- Fix peg integer reading combinators when used with capture tags.
|
||||
|
||||
## 1.15.0 - 2021-02-08
|
||||
- Fix `gtim` and `ltim` bytecode instructions on non-integer values.
|
||||
- Clean up output of flychecking to be the same as the repl.
|
||||
- Change behavior of `debug/stacktrace` with a nil error value.
|
||||
- Add optional argument to `parser/produce`.
|
||||
- Add `no-core` option to creating standalone binaries to make execution faster.
|
||||
- Fix bug where a buffer overflow could be confused with an out of memory error.
|
||||
- Change error output to `file:line:column: message`. Column is in bytes - tabs
|
||||
are considered to have width 1 (instead of 8).
|
||||
|
||||
## 1.14.2 - 2021-01-23
|
||||
- Allow `JANET_PROFILE` env variable to load a profile before loading the repl.
|
||||
- Update `tracev` macro to allow `def` and `var` inside to work as expected.
|
||||
- Use `(dyn :peg-grammar)` for passing a default grammar to `peg/compile` instead of loading
|
||||
`default-peg-grammar` directly from the root environment.
|
||||
- Add `ev/thread` for combining threading with the event loop.
|
||||
- Add `ev/do-thread` to make `ev/thread` easier to use.
|
||||
- Automatically set supervisor channel in `net/accept-loop` and `net/server` correctly.
|
||||
|
||||
## 1.14.1 - 2021-01-18
|
||||
- Add `doc-of` for reverse documentation lookup.
|
||||
- Add `ev/give-supervsior` to send a message to the supervising channel.
|
||||
- Add `ev/gather` and `chan` argument to `ev/go`. This new argument allows "supervisor channels"
|
||||
for fibers to enable structured concurrency.
|
||||
- Make `-k` flag work on stdin if no files are given.
|
||||
- Add `flycheck` function to core.
|
||||
- Make `backmatch` and `backref` more expressive in pegs.
|
||||
- Fix buggy `string/split`.
|
||||
- Add `fiber/last-value` to get the value that was last yielded, errored, or signaled
|
||||
by a fiber.
|
||||
- Remove `:generate` verb from `loop` macros. Instead, use the `:in` verb
|
||||
which will now work on fibers as well as other data structures.
|
||||
- Define `next`, `get`, and `in` for fibers. This lets
|
||||
`each`, `map`, and similar iteration macros can now iterate over fibers.
|
||||
- Remove macro `eachy`, which can be replaced by `each`.
|
||||
- Add `dflt` argument to find-index.
|
||||
- Deprecate `file/popen` in favor of `os/spawn`.
|
||||
- Add `:all` keyword to `ev/read` and `net/read` to make them more like `file/read`. However, we
|
||||
do not provide any `:line` option as that requires buffering.
|
||||
- Change repl behavior to make Ctrl-C raise SIGINT on posix. The old behavior for Ctrl-C,
|
||||
to clear the current line buffer, has been moved to Ctrl-Q.
|
||||
- Importing modules that start with `/` is now the only way to import from project root.
|
||||
Before, this would import from / on disk. Previous imports that did not start with `.` or `/`
|
||||
are now unambiguously importing from the syspath, instead of checking both the syspath and
|
||||
the project root. This is backwards incompatible and dependencies should be updated for this.
|
||||
- Change hash function for numbers.
|
||||
- Improve error handling of `dofile`.
|
||||
- Bug fixes in networking and subprocess code.
|
||||
- Use markdown formatting in more places for docstrings.
|
||||
|
||||
## 1.13.1 - 2020-12-13
|
||||
- Pretty printing a table with a prototype will look for `:_name` instead of `:name`
|
||||
in the prototype table to tag the output.
|
||||
- `match` macro implementation changed to be tail recursive.
|
||||
- Adds a :preload loader which allows one to manually put things into `module/cache`.
|
||||
- Add `buffer/push` function.
|
||||
- Backtick delimited strings and buffers are now reindented based on the column of the
|
||||
opening delimiter. Whitespace in columns to the left of the starting column is ignored unless
|
||||
there are non-space/non-newline characters in that region, in which case the old behavior is preserved.
|
||||
- Argument to `(error)` combinator in PEGs is now optional.
|
||||
- Add `(line)` and `(column)` combinators to PEGs to capture source line and column.
|
||||
This should make error reporting a bit easier.
|
||||
- Add `merge-module` to core.
|
||||
- During installation and release, merge janetconf.h into janet.h for easier install.
|
||||
- Add `upscope` special form.
|
||||
- `os/execute` and `os/spawn` can take streams for redirecting IO.
|
||||
- Add `:parser` and `:read` parameters to `run-context`.
|
||||
- Add `os/open` if ev is enabled.
|
||||
- Add `os/pipe` if ev is enabled.
|
||||
- Add `janet_thread_current(void)` to C API
|
||||
- Add integer parsing forms to pegs. This makes parsing many binary protocols easier.
|
||||
- Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows.
|
||||
- Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users
|
||||
for single threaded cooperative scheduling and asynchronous IO.
|
||||
- Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts
|
||||
and are more flexible. They also allow further improvements to these utility functions.
|
||||
- Various small bug fixes.
|
||||
|
||||
## 1.12.2 - 2020-09-20
|
||||
- Add janet\_try and janet\_restore to C API.
|
||||
- Fix `os/execute` regression on windows.
|
||||
- Add :pipe option to `os/spawn`.
|
||||
- Fix docstring typos.
|
||||
|
||||
## 1.12.1 - 2020-09-07
|
||||
- Make `zero?`, `one?`, `pos?`, and `neg?` polymorphic.
|
||||
- Add C++ support to jpm and improve C++ interop in janet.h.
|
||||
- Add `%t` formatter to `printf`, `string/format`, and other formatter functions.
|
||||
- Expose `janet_cfuns_prefix` in C API.
|
||||
- Add `os/proc-wait` and `os/proc-kill` for interacting with processes.
|
||||
- Add `janet_getjfile` to C API.
|
||||
- Allow redirection of stdin, stdout, and stderr by passing keywords in the env table in `os/spawn` and `os/execute`.
|
||||
- Add `os/spawn` to get a core/process back instead of an exit code as in `os/execute`.
|
||||
When called like this, `os/execute` returns immediately.
|
||||
- Add `:x` flag to os/execute to raise error when exit code is non-zero.
|
||||
- Don't run `main` when flychecking.
|
||||
- Add `:n` flag to `file/open` to raise an error if file cannot be opened.
|
||||
- Fix import macro to not try and coerce everything to a string.
|
||||
- Allow passing a second argument to `disasm`.
|
||||
- Add `cancel`. Resumes a fiber but makes it immediately error at the yield point.
|
||||
- Allow multi-line paste into built in repl.
|
||||
- Add `(curenv)`.
|
||||
- Change `net/read`, `net/chunk`, and `net/write` to raise errors in the case of failures.
|
||||
- Add `janet_continue_signal` to C API. This indirectly enables C functions that yield to the event loop
|
||||
to raise errors or other signals.
|
||||
- Update meson build script to fix bug on Debian's version of meson
|
||||
- Add `xprint`, `xprin`, `xprintf`, and `xprinf`.
|
||||
- `net/write` now raises an error message if write fails.
|
||||
- Fix issue with SIGPIPE on macOS and BSDs.
|
||||
|
||||
## 1.11.3 - 2020-08-03
|
||||
- Add `JANET_HASHSEED` environment variable when `JANET_PRF` is enabled.
|
||||
- Expose `janet_cryptorand` in C API.
|
||||
- Properly initialize PRF in default janet program
|
||||
- Add `index-of` to core library.
|
||||
- Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile)
|
||||
- Fix defaults on Windows for ARM
|
||||
- Fix defaults on NetBSD.
|
||||
|
||||
## 1.11.1 - 2020-07-25
|
||||
- Fix jpm and git with multiple git installs on Windows
|
||||
- Fix importing a .so file in the current directory
|
||||
- Allow passing byte sequence types directly to typed-array constructors.
|
||||
- Fix bug sending files between threads.
|
||||
- Disable PRF by default.
|
||||
- Update the soname.
|
||||
|
||||
## 1.11.0 - 2020-07-18
|
||||
- Add `forever` macro.
|
||||
- Add `any?` predicate to core.
|
||||
- Add `jpm list-pkgs` subcommand to see which package aliases are in the listing.
|
||||
- Add `jpm list-installed` subcommand to see which packages are installed.
|
||||
- Add `math/int-min`, `math/int-max`, `math/int32-min`, and `math/int32-max` for getting integer limits.
|
||||
- The gc interval is now autotuned, to prevent very bad gc behavior.
|
||||
- Improvements to the bytecode compiler, Janet will now generate more efficient bytecode.
|
||||
- Add `peg/find`, `peg/find-all`, `peg/replace`, and `peg/replace-all`
|
||||
- Add `math/nan`
|
||||
- Add `forv` macro
|
||||
- Add `symbol/slice`
|
||||
- Add `keyword/slice`
|
||||
- Allow cross compilation with Makefile.
|
||||
- Change `compare-primitve` to `cmp` and make it more efficient.
|
||||
- Add `reverse!` for reversing an array or buffer in place.
|
||||
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
|
||||
- Add `repeat` macro for iterating something n times.
|
||||
- Add `eachy` (each yield) macro for iterating a fiber.
|
||||
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
|
||||
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
|
||||
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
|
||||
|
||||
## 1.10.1 - 2020-06-18
|
||||
- Expose `janet_table_clear` in API.
|
||||
- Respect `JANET_NO_PROCESSES` define when building
|
||||
- Fix `jpm` rules having multiple copies of the same dependency.
|
||||
- Fix `jpm` install in some cases.
|
||||
- Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types
|
||||
to their current length.
|
||||
|
||||
## 1.10.0 - 2020-06-14
|
||||
- Hardcode default jpm paths on install so env variables are needed in fewer cases.
|
||||
- Add `:no-compile` to `create-executable` option for jpm.
|
||||
- Fix bug with the `trace` function.
|
||||
- Add `:h`, `:a`, and `:c` flags to `thread/new` for creating new kinds of threads.
|
||||
By default, threads will now consume much less memory per thread, but sending data between
|
||||
threads may cost more.
|
||||
- Fix flychecking when using the `use` macro.
|
||||
- CTRL-C no longer exits the repl, and instead cancels the current form.
|
||||
- Various small bug fixes
|
||||
- New MSI installer instead of NSIS based installer.
|
||||
- Make `os/realpath` work on windows.
|
||||
- Add polymorphic `compare` functions for comparing numbers.
|
||||
- Add `to` and `thru` peg combinators.
|
||||
- Add `JANET_GIT` environment variable to jpm to use a specific git binary (useful mainly on windows).
|
||||
- `asm` and `disasm` functions now use keywords instead of macros for keys. Also
|
||||
some slight changes to the way constants are encoded (remove wrapping `quote` in some cases).
|
||||
- Expose current macro form inside macros as (dyn :macro-form)
|
||||
- Add `tracev` macro.
|
||||
- Fix compiler bug that emitted incorrect code in some cases for while loops that create closures.
|
||||
- Add `:fresh` option to `(import ...)` to overwrite the module cache.
|
||||
- `(range x y 0)` will return an empty array instead of hanging forever.
|
||||
- Rename `jpm repl` to `jpm debug-repl`.
|
||||
|
||||
## 1.9.1 - 2020-05-12
|
||||
- Add :prefix option to declare-source
|
||||
- Re-enable minimal builds with the debugger.
|
||||
- Add several flags for configuring Janet on different platforms.
|
||||
- Fix broken meson build from 1.9.0 and add meson to CI.
|
||||
- Fix compilation issue when nanboxing is disabled.
|
||||
|
||||
## 1.9.0 - 2020-05-10
|
||||
- Add `:ldflags` option to many jpm declare functions.
|
||||
- Add `errorf` to core.
|
||||
- Add `lenprefix` combinator to PEGs.
|
||||
- Add `%M`, `%m`, `%N`, and `%n` formatters to formatting functions. These are the
|
||||
same as `%Q`, `%q`, `%P`, and `%p`, but will not truncate long values.
|
||||
- Add `fiber/root`.
|
||||
- Add beta `net/` module to core for socket based networking.
|
||||
- Add the `parse` function to parse strings of source code more conveniently.
|
||||
- Add `jpm rule-tree` subcommand.
|
||||
- Add `--offline` flag to jpm to force use of the cache.
|
||||
- Allow sending pointers and C functions across threads via `thread/send`.
|
||||
- Fix bug in `getline`.
|
||||
- Add `sh-rule` and `sh-phony` to jpm's dialect of Janet.
|
||||
- Change C api's `janet_formatb` -> `janet_formatbv`, and add new function `janet_formatb` to C api.
|
||||
- Add `edefer` macro to core.
|
||||
- A struct/table literal/constructor with duplicate keys will use the last value given.
|
||||
Previously, this was inconsistent between tables and structs, literals and constructor functions.
|
||||
- Add debugger to core. The debugger functions are only available
|
||||
in a debug repl, and are prefixed by a `.`.
|
||||
- Add `sort-by` and `sorted-by` to core.
|
||||
- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`.
|
||||
- Add `math/erf`
|
||||
- Add `math/erfc`
|
||||
- Add `math/log1p`
|
||||
- Add `math/next`
|
||||
- Add os/umask
|
||||
- Add os/perm-int
|
||||
- Add os/perm-string
|
||||
- Add :int-permissions option for os/stat.
|
||||
- Add `jpm repl` subcommand, as well as `post-deps` macro in project.janet files.
|
||||
- Various bug fixes.
|
||||
|
||||
## 1.8.1 - 2020-03-31
|
||||
- Fix bugs for big endian systems
|
||||
- Fix 1.8.0 regression on BSDs
|
||||
|
||||
@@ -14,6 +14,7 @@ Please read this document before making contributions.
|
||||
on how to reproduce it. If it is a compiler or language bug, please try to include a minimal
|
||||
example. This means don't post all 200 lines of code from your project, but spend some time
|
||||
distilling the problem to just the relevant code.
|
||||
* Add the `bug` tag to the issue.
|
||||
|
||||
## Contributing Changes
|
||||
|
||||
@@ -29,13 +30,13 @@ may require changes before being merged.
|
||||
the test folder and make sure it is run when`make test` is invoked.
|
||||
* Be consistent with the style. For C this means follow the indentation and style in
|
||||
other files (files have MIT license at top, 4 spaces indentation, no trailing
|
||||
whitespace, cuddled brackets, etc.) Use `make format` to automatically format your C code with
|
||||
whitespace, cuddled brackets, etc.) Use `make format` to
|
||||
automatically format your C code with
|
||||
[astyle](http://astyle.sourceforge.net/astyle.html). You will probably need
|
||||
to install this, but it can be installed with most package managers.
|
||||
|
||||
For janet code, use lisp indentation with 2 spaces. One can use janet.vim to
|
||||
do this indentation, or approximate as close as possible. There is a janet formatter
|
||||
in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well.
|
||||
For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to
|
||||
do this indentation, or approximate as close as possible.
|
||||
|
||||
## C style
|
||||
|
||||
@@ -73,3 +74,4 @@ timely manner. In short, if you want extra functionality now, then build it.
|
||||
|
||||
* Include a good description of the problem that is being solved
|
||||
* Include descriptions of potential solutions if you have some in mind.
|
||||
* Add the appropriate tags to the issue. For new features, add the `enhancement` tag.
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
||||
Copyright (c) 2021 Calvin Rose and contributors
|
||||
Copyright (c) 2020 Calvin Rose and contributors
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||||
this software and associated documentation files (the "Software"), to deal in
|
||||
|
||||
192
Makefile
192
Makefile
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
# Copyright (c) 2020 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
|
||||
@@ -27,28 +27,18 @@ PREFIX?=/usr/local
|
||||
INCLUDEDIR?=$(PREFIX)/include
|
||||
BINDIR?=$(PREFIX)/bin
|
||||
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 || echo local)\""
|
||||
CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(LIBDIR)/janet
|
||||
JANET_MANPATH?=$(PREFIX)/share/man/man1/
|
||||
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
JANET_DIST_DIR?=janet-dist
|
||||
JPM_TAG?=master
|
||||
MANPATH?=$(PREFIX)/share/man/man1/
|
||||
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
|
||||
# For cross compilation
|
||||
HOSTCC?=$(CC)
|
||||
HOSTAR?=$(AR)
|
||||
CFLAGS?=-O2
|
||||
LDFLAGS?=-rdynamic
|
||||
|
||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
|
||||
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
|
||||
LDFLAGS:=$(LDFLAGS) -rdynamic
|
||||
|
||||
# For installation
|
||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
@@ -57,27 +47,18 @@ LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
UNAME:=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CLIBS:=$(CLIBS) -ldl
|
||||
SONAME_SETTER:=-Wl,-install_name,
|
||||
JANET_LIBRARY=build/libjanet.dylib
|
||||
LDCONFIG:=true
|
||||
else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
endif
|
||||
|
||||
# For other unix likes, add flags here!
|
||||
ifeq ($(UNAME), Haiku)
|
||||
LDCONFIG:=true
|
||||
LDFLAGS=-Wl,--export-dynamic
|
||||
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
|
||||
|
||||
$(shell mkdir -p build/core build/c build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
|
||||
|
||||
######################
|
||||
##### Name Files #####
|
||||
@@ -107,15 +88,12 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/corelib.c \
|
||||
src/core/debug.c \
|
||||
src/core/emit.c \
|
||||
src/core/ev.c \
|
||||
src/core/ffi.c \
|
||||
src/core/fiber.c \
|
||||
src/core/gc.c \
|
||||
src/core/inttypes.c \
|
||||
src/core/io.c \
|
||||
src/core/marsh.c \
|
||||
src/core/math.c \
|
||||
src/core/net.c \
|
||||
src/core/os.c \
|
||||
src/core/parse.c \
|
||||
src/core/peg.c \
|
||||
@@ -123,13 +101,14 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/regalloc.c \
|
||||
src/core/run.c \
|
||||
src/core/specials.c \
|
||||
src/core/state.c \
|
||||
src/core/string.c \
|
||||
src/core/strtod.c \
|
||||
src/core/struct.c \
|
||||
src/core/symcache.c \
|
||||
src/core/table.c \
|
||||
src/core/thread.c \
|
||||
src/core/tuple.c \
|
||||
src/core/typedarray.c \
|
||||
src/core/util.c \
|
||||
src/core/value.c \
|
||||
src/core/vector.c \
|
||||
@@ -149,60 +128,52 @@ JANET_BOOT_HEADERS=src/boot/tests.h
|
||||
##########################################################
|
||||
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
|
||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS)
|
||||
|
||||
$(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)
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
|
||||
|
||||
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
|
||||
cksum $@
|
||||
build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@
|
||||
|
||||
########################
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
ifeq ($(UNAME), Darwin)
|
||||
SONAME=libjanet.1.22.dylib
|
||||
else
|
||||
SONAME=libjanet.so.1.22
|
||||
endif
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
|
||||
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h src/conf/janetconf.h $@
|
||||
build/janet.h: src/include/janet.h
|
||||
cp $< $@
|
||||
|
||||
build/janetconf.h: src/conf/janetconf.h
|
||||
cp $< $@
|
||||
|
||||
build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
build/janet.o: build/janet.c build/janet.h build/janetconf.h
|
||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
build/shell.o: build/shell.c build/janet.h build/janetconf.h
|
||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
$(JANET_TARGET): build/janet.o build/shell.o
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): build/janet.o build/shell.o
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||
$(HOSTAR) rcs $@ $^
|
||||
$(AR) rcs $@ $^
|
||||
|
||||
###################
|
||||
##### Testing #####
|
||||
###################
|
||||
|
||||
# Testing assumes HOSTCC=CC
|
||||
|
||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||
|
||||
repl: $(JANET_TARGET)
|
||||
@@ -219,10 +190,12 @@ valgrind: $(JANET_TARGET)
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
./$(JANET_TARGET) -k auxbin/jpm
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
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
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k auxbin/jpm
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
@@ -234,21 +207,13 @@ callgrind: $(JANET_TARGET)
|
||||
dist: build/janet-dist.tar.gz
|
||||
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
build/janet.h \
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
README.md build/c/janet.c build/c/shell.c
|
||||
mkdir -p build/$(JANET_DIST_DIR)/bin
|
||||
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/include
|
||||
cp build/janet.h build/$(JANET_DIST_DIR)/include/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/lib/
|
||||
cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/man/man1/
|
||||
cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1
|
||||
mkdir -p build/$(JANET_DIST_DIR)/src/
|
||||
cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
|
||||
cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
|
||||
cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
|
||||
src/include/janet.h src/conf/janetconf.h \
|
||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/janet.c build/shell.c auxbin/jpm
|
||||
$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
|
||||
mkdir -p build/$(JANET_DIST_DIR)
|
||||
cp -r $^ build/$(JANET_DIST_DIR)/
|
||||
cd build && tar -czvf ../$@ $(JANET_DIST_DIR)
|
||||
|
||||
#########################
|
||||
##### Documentation #####
|
||||
@@ -263,6 +228,8 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
##### Installation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1
|
||||
|
||||
.INTERMEDIATE: build/janet.pc
|
||||
build/janet.pc: $(JANET_TARGET)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
@@ -275,52 +242,36 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo "Description: Library for the Janet programming language." >> $@
|
||||
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
||||
echo 'Cflags: -I$${includedir}' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
|
||||
install: $(JANET_TARGET) build/janet.pc
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
ln -sf '$(DESTDIR)$(INCLUDEDIR)/janet/janet.h' '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||
cp -rf $(JANET_HEADERS) '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||
if test $(UNAME) = Darwin ; then \
|
||||
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_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
|
||||
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
|
||||
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
|
||||
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
|
||||
cp -rf auxbin/* '$(DESTDIR)$(BINDIR)'
|
||||
mkdir -p '$(DESTDIR)$(MANPATH)'
|
||||
cp janet.1 '$(DESTDIR)$(MANPATH)'
|
||||
cp jpm.1 '$(DESTDIR)$(MANPATH)'
|
||||
mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
|
||||
|
||||
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)' \
|
||||
../../$(JANET_TARGET) ./bootstrap.janet
|
||||
|
||||
uninstall:
|
||||
-rm '$(DESTDIR)$(BINDIR)/janet'
|
||||
-rm '$(DESTDIR)$(BINDIR)/jpm'
|
||||
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
|
||||
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
|
||||
-rm '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
|
||||
-rm '$(DESTDIR)$(MANPATH)/janet.1'
|
||||
-rm '$(DESTDIR)$(MANPATH)/jpm.1'
|
||||
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
|
||||
|
||||
#################
|
||||
@@ -334,38 +285,21 @@ grammar: build/janet.tmLanguage
|
||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) $< > $@
|
||||
|
||||
compile-commands:
|
||||
# Requires pip install copmiledb
|
||||
compiledb make
|
||||
|
||||
clean:
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
-rm -rf test/install/build test/install/modpath
|
||||
|
||||
test-install:
|
||||
echo "JPM has been removed from default install."
|
||||
|
||||
help:
|
||||
@echo
|
||||
@echo 'Janet: A Dynamic Language & Bytecode VM'
|
||||
@echo
|
||||
@echo Usage:
|
||||
@echo ' make Build Janet'
|
||||
@echo ' make repl Start a REPL from a built Janet'
|
||||
@echo
|
||||
@echo ' make test Test a built Janet'
|
||||
@echo ' make valgrind Assess Janet with Valgrind'
|
||||
@echo ' make callgrind Assess Janet with Valgrind, using Callgrind'
|
||||
@echo ' make valtest Run the test suite with Valgrind to check for memory leaks'
|
||||
@echo ' make dist Create a distribution tarball'
|
||||
@echo ' make docs Generate documentation'
|
||||
@echo ' make debug Run janet with GDB or LLDB'
|
||||
@echo ' make install Install into the current filesystem'
|
||||
@echo ' make uninstall Uninstall from the current filesystem'
|
||||
@echo ' make clean Clean intermediate build artifacts'
|
||||
@echo " make format Format Janet's own source files"
|
||||
@echo ' make grammar Generate a TextMate language grammar'
|
||||
@echo
|
||||
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 \
|
||||
&& jpm --verbose --testdeps --modpath=. install https://github.com/janet-lang/json.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
|
||||
|
||||
.PHONY: clean install repl debug valgrind test \
|
||||
valtest dist uninstall docs grammar format help compile-commands
|
||||
valtest emscripten dist uninstall docs grammar format
|
||||
|
||||
150
README.md
150
README.md
@@ -1,24 +1,22 @@
|
||||
[](https://gitter.im/janet-language/community)
|
||||
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
|
||||
[](https://github.com/janet-lang/janet/actions/workflows/test.yml)
|
||||
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||
lisp-like language, but lists are replaced
|
||||
modern lisp, but lists are replaced
|
||||
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
|
||||
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
|
||||
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
|
||||
Janet can be embedded in other programs. Try Janet in your browser at
|
||||
Janet can be embedded into other programs. Try Janet in your browser at
|
||||
[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>
|
||||
|
||||
## Use Cases
|
||||
@@ -29,27 +27,24 @@ Lua, but smaller than GNU Guile or Python.
|
||||
|
||||
## Features
|
||||
|
||||
* Configurable at build time - turn features on or off for a smaller or more featureful build
|
||||
* Minimal setup - one binary and you are good to go!
|
||||
* First-class closures
|
||||
* First class closures
|
||||
* Garbage collection
|
||||
* First-class green threads (continuations)
|
||||
* Python-style generators (implemented as a plain macro)
|
||||
* First class green threads (continuations)
|
||||
* Python style generators (implemented as a plain macro)
|
||||
* Mutable and immutable arrays (array/tuple)
|
||||
* Mutable and immutable hashtables (table/struct)
|
||||
* Mutable and immutable strings (buffer/string)
|
||||
* Macros
|
||||
* Multithreading
|
||||
* Per-thread event loop for efficient evented IO
|
||||
* Lisp Macros
|
||||
* Byte code interpreter with an assembly interface, as well as bytecode verification
|
||||
* Tail call Optimization
|
||||
* Tailcall Optimization
|
||||
* 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
|
||||
* Parsing Expression Grammars built in to the core library
|
||||
* 400+ functions and macros in the core library
|
||||
* Embedding Janet in other programs
|
||||
* Interactive environment with detailed stack traces
|
||||
@@ -59,17 +54,17 @@ Lua, but smaller than GNU Guile or Python.
|
||||
* 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)
|
||||
|
||||
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
|
||||
documentation for symbols in the core library. For example,
|
||||
```
|
||||
(doc apply)
|
||||
(doc doc)
|
||||
```
|
||||
Shows documentation for the `apply` function.
|
||||
Shows documentation for the doc macro.
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-bindings)` function. You
|
||||
can also use the `(doc)` macro with no arguments if you are in the REPL
|
||||
can also use the `(doc)` macro with no arguments if you are in the repl
|
||||
to show bound symbols.
|
||||
|
||||
## Source
|
||||
@@ -80,7 +75,7 @@ the SourceHut mirror is actively maintained.
|
||||
|
||||
## Building
|
||||
|
||||
### macOS and Unix-like
|
||||
### macos and Unix-like
|
||||
|
||||
The Makefile is non-portable and requires GNU-flavored make.
|
||||
|
||||
@@ -89,15 +84,11 @@ cd somewhere/my/projects/janet
|
||||
make
|
||||
make test
|
||||
make repl
|
||||
make install
|
||||
make install-jpm-git
|
||||
```
|
||||
|
||||
Find out more about the available make targets by running `make help`.
|
||||
|
||||
### 32-bit Haiku
|
||||
|
||||
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`.
|
||||
|
||||
```
|
||||
@@ -105,13 +96,11 @@ cd somewhere/my/projects/janet
|
||||
make CC=gcc-x86
|
||||
make test
|
||||
make repl
|
||||
make install
|
||||
make install-jpm-git
|
||||
```
|
||||
|
||||
### FreeBSD
|
||||
|
||||
FreeBSD build instructions are the same as the UNIX-like build instructions,
|
||||
FreeBSD build instructions are the same as the unix-like build instuctions,
|
||||
but you need `gmake` to compile. Alternatively, install directly from
|
||||
packages, using `pkg install lang/janet`.
|
||||
|
||||
@@ -120,15 +109,8 @@ cd somewhere/my/projects/janet
|
||||
gmake
|
||||
gmake test
|
||||
gmake repl
|
||||
gmake install
|
||||
gmake install-jpm-git
|
||||
```
|
||||
|
||||
### NetBSD
|
||||
|
||||
NetBSD build instructions are the same as the FreeBSD build instructions.
|
||||
Alternatively, install directly from packages, using `pkgin install janet`.
|
||||
|
||||
### 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#)
|
||||
@@ -136,20 +118,13 @@ Alternatively, install directly from packages, using `pkgin install janet`.
|
||||
3. Run `build_win` to compile janet.
|
||||
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:
|
||||
|
||||
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases)
|
||||
6. run `build_win dist`
|
||||
|
||||
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
|
||||
|
||||
### Meson
|
||||
|
||||
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross-platform build
|
||||
system. Although Meson has a Python dependency, Meson is a very complete build system that
|
||||
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
||||
system. Although Meson has a python dependency, Meson is a very complete build system that
|
||||
is maybe more convenient and flexible for integrating into existing pipelines.
|
||||
Meson also provides much better IDE integration than Make or batch files, as well as support
|
||||
for cross-compilation.
|
||||
for cross compilation.
|
||||
|
||||
For the impatient, building with Meson is as follows. The options provided to
|
||||
`meson setup` below emulate Janet's Makefile.
|
||||
@@ -160,7 +135,6 @@ cd janet
|
||||
meson setup build \
|
||||
--buildtype release \
|
||||
--optimization 2 \
|
||||
--libdir /usr/local/lib \
|
||||
-Dgit_hash=$(git log --pretty=format:'%h' -n 1)
|
||||
ninja -C build
|
||||
|
||||
@@ -181,16 +155,16 @@ Emacs, and Atom will have syntax packages for the Janet language, though.
|
||||
|
||||
## Installation
|
||||
|
||||
See the [Introduction](https://janet-lang.org/docs/index.html) for more details. If you just want
|
||||
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
|
||||
to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
|
||||
|
||||
## Usage
|
||||
|
||||
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`
|
||||
|
||||
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.
|
||||
|
||||
```
|
||||
$ janet
|
||||
@@ -208,25 +182,25 @@ Options are:
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-r : Enter the REPL after running all scripts
|
||||
-p : Keep on executing if there is a top-level error (persistent)
|
||||
-q : Hide prompt, logo, and REPL output (quiet)
|
||||
-r : Enter the repl after running all scripts
|
||||
-p : Keep on executing if there is a top level error (persistent)
|
||||
-q : Hide prompt, logo, and repl output (quiet)
|
||||
-k : Compile scripts but do not execute (flycheck)
|
||||
-m syspath : Set system path for loading global modules
|
||||
-c source output : Compile janet source code into an image
|
||||
-n : Disable ANSI color output in the REPL
|
||||
-n : Disable ANSI color output in the repl
|
||||
-l path : Execute code in a file before running the main script
|
||||
-- : 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
|
||||
|
||||
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
|
||||
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/include/janetconf.h` can dragged into any C
|
||||
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
|
||||
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
|
||||
@@ -241,65 +215,21 @@ See the examples directory for some example janet code.
|
||||
|
||||
## Discussion
|
||||
|
||||
Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||
Gitter provides Matrix and irc bridges as well.
|
||||
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
||||
|
||||
## FAQ
|
||||
|
||||
### 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.
|
||||
|
||||
### 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.
|
||||
|
||||
### 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 implemeted with keywords.
|
||||
|
||||
```
|
||||
(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, usually a feature can 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.
|
||||
|
||||
### Why is my terminal spitting out junk when I run the REPL?
|
||||
### Why is my terminal is spitting out junk when I run the repl?
|
||||
|
||||
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||
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
|
||||
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
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
ensue.
|
||||
|
||||
## Why is it called "Janet"?
|
||||
## Why Janet
|
||||
|
||||
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
||||
|
||||
64
appveyor.yml
Normal file
64
appveyor.yml
Normal file
@@ -0,0 +1,64 @@
|
||||
version: build-{build}
|
||||
clone_folder: c:\projects\janet
|
||||
image:
|
||||
- Visual Studio 2019
|
||||
configuration:
|
||||
- Release
|
||||
- Debug
|
||||
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%
|
||||
- choco install nsis -y -pre --version 3.05
|
||||
# Replace makensis.exe and files with special long string build. This should
|
||||
# prevent issues when setting PATH during installation.
|
||||
- 7z e "tools\nsis-3.05-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
|
||||
- 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 janet_outname=v1.8.1
|
||||
build: off
|
||||
|
||||
artifacts:
|
||||
- name: janet.c
|
||||
path: dist\janet.c
|
||||
type: File
|
||||
- name: janet.h
|
||||
path: dist\janet.h
|
||||
type: File
|
||||
- name: janetconf.h
|
||||
path: dist\janetconf.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-installer.exe"
|
||||
name: "janet-$(janet_outname)-windows-%platform%-installer.exe"
|
||||
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
|
||||
BIN
assets/janet-the-good-place.gif
Normal file
BIN
assets/janet-the-good-place.gif
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 109 KiB |
1063
auxbin/jpm
Executable file
1063
auxbin/jpm
Executable file
File diff suppressed because it is too large
Load Diff
@@ -14,18 +14,13 @@
|
||||
@if "%1"=="test" goto TEST
|
||||
@if "%1"=="dist" goto DIST
|
||||
@if "%1"=="install" goto INSTALL
|
||||
@if "%1"=="test-install" goto TESTINSTALL
|
||||
@if "%1"=="all" goto ALL
|
||||
|
||||
@rem Set compile and link options here
|
||||
@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_LINK=link /nologo
|
||||
|
||||
@set JANET_LINK_STATIC=lib /nologo
|
||||
|
||||
@rem Add janet build tag
|
||||
@@ -33,10 +28,10 @@ if not "%JANET_BUILD%" == "" (
|
||||
@set JANET_COMPILE=%JANET_COMPILE% /DJANET_BUILD="\"%JANET_BUILD%\""
|
||||
)
|
||||
|
||||
if not exist build mkdir build
|
||||
if not exist build\core mkdir build\core
|
||||
if not exist build\c mkdir build\c
|
||||
if not exist build\boot mkdir build\boot
|
||||
mkdir build
|
||||
mkdir build\core
|
||||
mkdir build\mainclient
|
||||
mkdir build\boot
|
||||
|
||||
@rem Build the bootstrap interpreter
|
||||
for %%f in (src\core\*.c) do (
|
||||
@@ -49,10 +44,10 @@ for %%f in (src\boot\*.c) do (
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
build\janet_boot . > build\c\janet.c
|
||||
build\janet_boot . > build\janet.c
|
||||
|
||||
@rem Build the sources
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@@ -87,7 +82,7 @@ exit /b 1
|
||||
@echo command prompt.
|
||||
exit /b 0
|
||||
|
||||
@rem Clean build artifacts
|
||||
@rem Clean build artifacts
|
||||
:CLEAN
|
||||
del *.exe *.lib *.exp
|
||||
rd /s /q build
|
||||
@@ -107,9 +102,8 @@ exit /b 0
|
||||
mkdir dist
|
||||
janet.exe tools\gendoc.janet > dist\doc.html
|
||||
janet.exe tools\removecr.janet dist\doc.html
|
||||
janet.exe tools\removecr.janet build\c\janet.c
|
||||
|
||||
copy build\c\janet.c dist\janet.c
|
||||
copy build\janet.c dist\janet.c
|
||||
copy src\mainclient\shell.c dist\shell.c
|
||||
copy janet.exe dist\janet.exe
|
||||
copy LICENSE dist\LICENSE
|
||||
@@ -118,38 +112,58 @@ copy README.md dist\README.md
|
||||
copy janet.lib dist\janet.lib
|
||||
copy janet.exp dist\janet.exp
|
||||
|
||||
janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h
|
||||
copy build\janet.h dist\janet.h
|
||||
copy src\include\janet.h dist\janet.h
|
||||
copy src\conf\janetconf.h dist\janetconf.h
|
||||
copy build\libjanet.lib dist\libjanet.lib
|
||||
|
||||
copy auxbin\jpm dist\jpm
|
||||
copy tools\jpm.bat dist\jpm.bat
|
||||
|
||||
@rem Create installer
|
||||
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) :x64))" > build\64bit.txt
|
||||
set /p JANET_VERSION= < build\version.txt
|
||||
set /p BUILDARCH= < build\arch.txt
|
||||
set /p SIXTYFOUR= < build\64bit.txt
|
||||
echo "JANET_VERSION is %JANET_VERSION%"
|
||||
if defined APPVEYOR_REPO_TAG_NAME (
|
||||
set RELEASE_VERSION=%APPVEYOR_REPO_TAG_NAME%
|
||||
) else (
|
||||
set RELEASE_VERSION=%JANET_VERSION%
|
||||
)
|
||||
if defined CI (
|
||||
set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\"
|
||||
) else (
|
||||
set WIXBIN=
|
||||
)
|
||||
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\
|
||||
%WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi
|
||||
"C:\Program Files (x86)\NSIS\makensis.exe" /DVERSION=%JANET_VERSION% /DSIXTYFOUR=%SIXTYFOUR% janet-installer.nsi
|
||||
exit /b 0
|
||||
|
||||
@rem Run the installer. (Installs to the local user with default settings)
|
||||
:INSTALL
|
||||
FOR %%a in (janet-*-windows-*-installer.msi) DO (
|
||||
@echo Running Installer %%a...
|
||||
%%a /QN
|
||||
@echo Running Installer...
|
||||
FOR %%a in (janet-*-windows-installer.exe) DO (
|
||||
%%a /S /CurrentUser
|
||||
)
|
||||
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.
|
||||
:ALL
|
||||
call %0 build
|
||||
|
||||
@@ -1,22 +1,23 @@
|
||||
# Example of dst bytecode assembly
|
||||
|
||||
# Fibonacci sequence, implemented with naive recursion.
|
||||
(def fibasm
|
||||
(asm
|
||||
'{:arity 1
|
||||
:bytecode @[(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0), push argument for next function call
|
||||
(call 2 1) # $2 = call($1)
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0)
|
||||
(call 0 1) # $0 = call($1)
|
||||
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||
:done
|
||||
(ret 0) # return $0
|
||||
]}))
|
||||
(def fibasm (asm '{
|
||||
arity 1
|
||||
bytecode [
|
||||
(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0), push argument for next function call
|
||||
(call 2 1) # $2 = call($1)
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0)
|
||||
(call 0 1) # $0 = call($1)
|
||||
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||
:done
|
||||
(ret 0) # return $0
|
||||
]
|
||||
}))
|
||||
|
||||
# Test it
|
||||
|
||||
|
||||
@@ -1,22 +0,0 @@
|
||||
(defn dowork [name n]
|
||||
(print name " starting work...")
|
||||
(os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")] :p)
|
||||
(print name " finished work!"))
|
||||
|
||||
# Will be done in parallel
|
||||
(print "starting group A")
|
||||
(ev/call dowork "A 2" 2)
|
||||
(ev/call dowork "A 1" 1)
|
||||
(ev/call dowork "A 3" 3)
|
||||
|
||||
(ev/sleep 4)
|
||||
|
||||
# Will also be done in parallel
|
||||
(print "starting group B")
|
||||
(ev/call dowork "B 2" 2)
|
||||
(ev/call dowork "B 1" 1)
|
||||
(ev/call dowork "B 3" 3)
|
||||
|
||||
(ev/sleep 4)
|
||||
|
||||
(print "all work done")
|
||||
@@ -1,15 +0,0 @@
|
||||
(def c (ev/chan 4))
|
||||
|
||||
(defn writer []
|
||||
(for i 0 10
|
||||
(ev/sleep 0.1)
|
||||
(print "writer giving item " i "...")
|
||||
(ev/give c (string "item " i))))
|
||||
|
||||
(defn reader [name]
|
||||
(forever
|
||||
(print "reader " name " got " (ev/take c))))
|
||||
|
||||
(ev/call writer)
|
||||
(each letter [:a :b :c :d :e :f :g]
|
||||
(ev/call reader letter))
|
||||
@@ -1,18 +1,20 @@
|
||||
###
|
||||
### A useful debugger library for Janet. Should be used
|
||||
### inside a debug repl. This has been moved into the core.
|
||||
### inside a debug repl.
|
||||
###
|
||||
|
||||
(defn .fiber
|
||||
"Get the current fiber being debugged."
|
||||
[]
|
||||
(dyn :fiber))
|
||||
(if-let [entry (dyn '_fiber)]
|
||||
(entry :value)
|
||||
(dyn :fiber)))
|
||||
|
||||
(defn .stack
|
||||
"Print the current fiber stack"
|
||||
[]
|
||||
(print)
|
||||
(with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
|
||||
(debug/stacktrace (.fiber) "")
|
||||
(print))
|
||||
|
||||
(defn .frame
|
||||
|
||||
@@ -1,5 +0,0 @@
|
||||
(with [conn (net/connect "127.0.0.1" 8000)]
|
||||
(print "writing abcdefg...")
|
||||
(:write conn "abcdefg")
|
||||
(print "reading...")
|
||||
(printf "got: %v" (:read conn 1024)))
|
||||
@@ -1,15 +0,0 @@
|
||||
(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)
|
||||
@@ -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)
|
||||
@@ -1,22 +0,0 @@
|
||||
(defn worker
|
||||
"Run for a number of iterations."
|
||||
[name iterations]
|
||||
(for i 0 iterations
|
||||
(ev/sleep 1)
|
||||
(print "worker " name " iteration " i)))
|
||||
|
||||
(ev/call worker :a 10)
|
||||
(ev/sleep 0.2)
|
||||
(ev/call worker :b 5)
|
||||
(ev/sleep 0.3)
|
||||
(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,56 +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."
|
||||
[a :ptr b :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
|
||||
[a :ptr b :int c :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 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)
|
||||
(g-application-run app 0 nil))
|
||||
@@ -1,87 +0,0 @@
|
||||
#include <stdio.h>
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
|
||||
int int_fn(int a, int b) {
|
||||
return (a << 2) + b;
|
||||
}
|
||||
|
||||
double my_fn(int64_t a, int64_t b, const char *x) {
|
||||
return (double)(a + b) + 0.5 + strlen(x);
|
||||
}
|
||||
|
||||
double double_fn(double x, double y, double z) {
|
||||
return (x + y) * z * 3;
|
||||
}
|
||||
|
||||
double double_many(double x, double y, double z, double w, double a, double b) {
|
||||
return x + y + z + w + a + b;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
double float_fn(float x, float y, float z) {
|
||||
return (x + y) * z;
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
int a;
|
||||
int b;
|
||||
} intint;
|
||||
|
||||
typedef struct {
|
||||
int a;
|
||||
int b;
|
||||
int c;
|
||||
} intintint;
|
||||
|
||||
int intint_fn(double x, intint ii) {
|
||||
printf("double: %g\n", x);
|
||||
return ii.a + ii.b;
|
||||
}
|
||||
|
||||
int intintint_fn(double x, intintint iii) {
|
||||
printf("double: %g\n", x);
|
||||
return iii.a + iii.b + iii.c;
|
||||
}
|
||||
|
||||
intint return_struct(int i) {
|
||||
intint ret;
|
||||
ret.a = i;
|
||||
ret.b = i * i;
|
||||
return ret;
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
int64_t a;
|
||||
int64_t b;
|
||||
int64_t c;
|
||||
} big;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
void void_fn(void) {
|
||||
printf("void fn ran\n");
|
||||
}
|
||||
|
||||
void void_ret_fn(int x) {
|
||||
printf("void fn ran: %d\n", x);
|
||||
}
|
||||
@@ -1,128 +0,0 @@
|
||||
(def ffi/loc "ffitest/so.so")
|
||||
(def ffi/source-loc "ffitest/so.c")
|
||||
|
||||
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px)
|
||||
(def module (ffi/native ffi/loc))
|
||||
|
||||
(def int-fn-sig (ffi/signature :default :int :int :int))
|
||||
(def int-fn-pointer (ffi/lookup module "int_fn"))
|
||||
(defn int-fn
|
||||
[x y]
|
||||
(ffi/call int-fn-pointer int-fn-sig x y))
|
||||
|
||||
(def double-fn-sig (ffi/signature :default :double :double :double :double))
|
||||
(def double-fn-pointer (ffi/lookup module "double_fn"))
|
||||
(defn double-fn
|
||||
[x y z]
|
||||
(ffi/call double-fn-pointer double-fn-sig x y z))
|
||||
|
||||
(def double-many-sig (ffi/signature :default :double :double :double :double :double :double :double))
|
||||
(def double-many-pointer (ffi/lookup module "double_many"))
|
||||
(defn double-many
|
||||
[x y z w a b]
|
||||
(ffi/call double-many-pointer double-many-sig x y z w a b))
|
||||
|
||||
(def double-lots-sig (ffi/signature :default :double
|
||||
:double :double :double :double :double
|
||||
:double :double :double :double :double))
|
||||
(def double-lots-pointer (ffi/lookup module "double_lots"))
|
||||
(defn double-lots
|
||||
[a b c d e f g h i j]
|
||||
(ffi/call double-lots-pointer double-lots-sig a b c d e f g h i j))
|
||||
|
||||
(def float-fn-sig (ffi/signature :default :double :float :float :float))
|
||||
(def float-fn-pointer (ffi/lookup module "float_fn"))
|
||||
(defn float-fn
|
||||
[x y z]
|
||||
(ffi/call float-fn-pointer float-fn-sig x y z))
|
||||
|
||||
(def intint-fn-sig (ffi/signature :default :int :double [:int :int]))
|
||||
(def intint-fn-pointer (ffi/lookup module "intint_fn"))
|
||||
(defn intint-fn
|
||||
[x ii]
|
||||
(ffi/call intint-fn-pointer intint-fn-sig x ii))
|
||||
|
||||
(def return-struct-sig (ffi/signature :default [:int :int] :int))
|
||||
(def return-struct-pointer (ffi/lookup module "return_struct"))
|
||||
(defn return-struct-fn
|
||||
[i]
|
||||
(ffi/call return-struct-pointer return-struct-sig i))
|
||||
|
||||
(def intintint (ffi/struct :int :int :int))
|
||||
(def intintint-fn-sig (ffi/signature :default :int :double intintint))
|
||||
(def intintint-fn-pointer (ffi/lookup module "intintint_fn"))
|
||||
(defn intintint-fn
|
||||
[x iii]
|
||||
(ffi/call intintint-fn-pointer intintint-fn-sig x iii))
|
||||
|
||||
(def big (ffi/struct :s64 :s64 :s64))
|
||||
(def struct-big-fn-sig (ffi/signature :default big :int :double))
|
||||
(def struct-big-fn-pointer (ffi/lookup module "struct_big"))
|
||||
(defn struct-big-fn
|
||||
[i d]
|
||||
(ffi/call struct-big-fn-pointer struct-big-fn-sig i d))
|
||||
|
||||
(def void-fn-pointer (ffi/lookup module "void_fn"))
|
||||
(def void-fn-sig (ffi/signature :default :void))
|
||||
(defn void-fn
|
||||
[]
|
||||
(ffi/call void-fn-pointer void-fn-sig))
|
||||
|
||||
#
|
||||
# Call functions
|
||||
#
|
||||
|
||||
(pp (void-fn))
|
||||
(pp (int-fn 10 20))
|
||||
(pp (double-fn 1.5 2.5 3.5))
|
||||
(pp (double-many 1 2 3 4 5 6))
|
||||
(pp (double-lots 1 2 3 4 5 6 7 8 9 10))
|
||||
(pp (float-fn 8 4 17))
|
||||
(pp (intint-fn 123.456 [10 20]))
|
||||
(pp (intintint-fn 123.456 [10 20 30]))
|
||||
(pp (return-struct-fn 42))
|
||||
(pp (struct-big-fn 11 99.5))
|
||||
|
||||
(assert (= 60 (int-fn 10 20)))
|
||||
(assert (= 42 (double-fn 1.5 2.5 3.5)))
|
||||
(assert (= 21 (double-many 1 2 3 4 5 6)))
|
||||
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
|
||||
(assert (= 204 (float-fn 8 4 17)))
|
||||
|
||||
#
|
||||
# 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])
|
||||
|
||||
(print "Done.")
|
||||
@@ -1,19 +0,0 @@
|
||||
(def f
|
||||
(coro
|
||||
(for i 0 10
|
||||
(yield (string "yield " i))
|
||||
(os/sleep 0))))
|
||||
|
||||
(print "simple yielding")
|
||||
(each item f (print "got: " item ", now " (fiber/status f)))
|
||||
|
||||
(def f
|
||||
(coro
|
||||
(for i 0 10
|
||||
(yield (string "yield " i))
|
||||
(ev/sleep 0))))
|
||||
|
||||
(print "complex yielding")
|
||||
(each item f (print "got: " item ", now " (fiber/status f)))
|
||||
|
||||
(print (fiber/status f))
|
||||
@@ -1,4 +1,10 @@
|
||||
(import /build/numarray)
|
||||
(import cook)
|
||||
|
||||
(cook/make-native
|
||||
:name "numarray"
|
||||
:source @["numarray.c"])
|
||||
|
||||
(import build/numarray :as numarray)
|
||||
|
||||
(def a (numarray/new 30))
|
||||
(print (get a 20))
|
||||
@@ -7,13 +7,13 @@ typedef struct {
|
||||
} num_array;
|
||||
|
||||
static num_array *num_array_init(num_array *array, size_t size) {
|
||||
array->data = (double *)janet_calloc(size, sizeof(double));
|
||||
array->data = (double *)calloc(size, sizeof(double));
|
||||
array->size = size;
|
||||
return array;
|
||||
}
|
||||
|
||||
static void num_array_deinit(num_array *array) {
|
||||
janet_free(array->data);
|
||||
free(array->data);
|
||||
}
|
||||
|
||||
static int num_array_gc(void *p, size_t s) {
|
||||
@@ -23,7 +23,7 @@ static int num_array_gc(void *p, size_t s) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
int num_array_get(void *p, Janet key, Janet *out);
|
||||
Janet num_array_get(void *p, Janet key);
|
||||
void num_array_put(void *p, Janet key, Janet value);
|
||||
|
||||
static const JanetAbstractType num_array_type = {
|
||||
@@ -31,8 +31,7 @@ static const JanetAbstractType num_array_type = {
|
||||
num_array_gc,
|
||||
NULL,
|
||||
num_array_get,
|
||||
num_array_put,
|
||||
JANET_ATEND_PUT
|
||||
num_array_put
|
||||
};
|
||||
|
||||
static Janet num_array_new(int32_t argc, Janet *argv) {
|
||||
@@ -76,33 +75,27 @@ 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[] = {
|
||||
{"scale", num_array_scale},
|
||||
{"sum", num_array_sum},
|
||||
{"length", num_array_length},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
int num_array_get(void *p, Janet key, Janet *out) {
|
||||
Janet num_array_get(void *p, Janet key) {
|
||||
size_t index;
|
||||
Janet value;
|
||||
num_array *array = (num_array *)p;
|
||||
if (janet_checktype(key, JANET_KEYWORD))
|
||||
return janet_getmethod(janet_unwrap_keyword(key), methods, out);
|
||||
return janet_getmethod(janet_unwrap_keyword(key), methods);
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = (size_t)janet_unwrap_integer(key);
|
||||
if (index >= array->size) {
|
||||
return 0;
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
*out = janet_wrap_number(array->data[index]);
|
||||
value = janet_wrap_number(array->data[index]);
|
||||
}
|
||||
return 1;
|
||||
return value;
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
@@ -116,11 +109,6 @@ static const JanetReg cfuns[] = {
|
||||
"(numarray/scale numarray factor)\n\n"
|
||||
"scale numarray by factor"
|
||||
},
|
||||
{
|
||||
"sum", num_array_sum,
|
||||
"(numarray/sum numarray)\n\n"
|
||||
"sums numarray"
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -1,7 +0,0 @@
|
||||
(declare-project
|
||||
:name "numarray"
|
||||
:description "Example c lib with abstract type")
|
||||
|
||||
(declare-native
|
||||
:name "numarray"
|
||||
:source @["numarray.c"])
|
||||
@@ -1,23 +0,0 @@
|
||||
(def channels
|
||||
(seq [:repeat 5] (ev/chan 4)))
|
||||
|
||||
(defn writer [c]
|
||||
(for i 0 3
|
||||
(def item (string i ":" (mod (hash c) 999)))
|
||||
(ev/sleep 0.1)
|
||||
(print "writer giving item " item " to " c "...")
|
||||
(ev/give c item))
|
||||
(print "Done!"))
|
||||
|
||||
(defn reader [name]
|
||||
(forever
|
||||
(def [_ c x] (ev/rselect ;channels))
|
||||
(print "reader " name " got " x " from " c)))
|
||||
|
||||
# Readers
|
||||
(each letter [:a :b :c :d :e :f :g]
|
||||
(ev/call reader letter))
|
||||
|
||||
# Writers
|
||||
(each c channels
|
||||
(ev/call writer c))
|
||||
@@ -1,37 +0,0 @@
|
||||
###
|
||||
### examples/select2.janet
|
||||
###
|
||||
### Mix reads and writes in select.
|
||||
###
|
||||
|
||||
(def c1 (ev/chan 40))
|
||||
(def c2 (ev/chan 40))
|
||||
(def c3 (ev/chan 40))
|
||||
(def c4 (ev/chan 40))
|
||||
|
||||
(def c5 (ev/chan 4))
|
||||
|
||||
(defn worker
|
||||
[c n x]
|
||||
(forever
|
||||
(ev/sleep n)
|
||||
(ev/give c x)))
|
||||
|
||||
(defn writer-worker
|
||||
[c]
|
||||
(forever
|
||||
(ev/sleep 0.2)
|
||||
(print "writing " (ev/take c))))
|
||||
|
||||
(ev/call worker c1 1 :item1)
|
||||
(ev/sleep 0.2)
|
||||
(ev/call worker c2 1 :item2)
|
||||
(ev/sleep 0.1)
|
||||
(ev/call worker c3 1 :item3)
|
||||
(ev/sleep 0.2)
|
||||
(ev/call worker c4 1 :item4)
|
||||
(ev/sleep 0.1)
|
||||
(ev/call worker c4 1 :item5)
|
||||
(ev/call writer-worker c5)
|
||||
|
||||
(forever (pp (ev/rselect c1 c2 c3 c4 [c5 :thing])))
|
||||
73
examples/tarray.janet
Normal file
73
examples/tarray.janet
Normal file
@@ -0,0 +1,73 @@
|
||||
# naive matrix implementation for testing typed array
|
||||
|
||||
(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
|
||||
|
||||
(defn matrix/row [mat i]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(tarray/new :float64 ncol 1 (* i ncol) array))
|
||||
|
||||
(defn matrix/column [mat j]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(tarray/new :float64 nrow ncol j array))
|
||||
|
||||
(defn matrix/set [mat i j value]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(set (array (+ (* i ncol) j)) value))
|
||||
|
||||
(defn matrix/get [mat i j value]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(array (+ (* i ncol) j)))
|
||||
|
||||
|
||||
# other variants to test rows and cols views
|
||||
|
||||
(defn matrix/set* [mat i j value]
|
||||
(set ((matrix/row mat i) j) value))
|
||||
|
||||
(defn matrix/set** [mat i j value]
|
||||
(set ((matrix/column mat j) i) value))
|
||||
|
||||
|
||||
(defn matrix/get* [mat i j value]
|
||||
((matrix/row mat i) j))
|
||||
|
||||
(defn matrix/get** [mat i j value]
|
||||
((matrix/column mat j) i))
|
||||
|
||||
|
||||
(defn tarray/print [arr]
|
||||
(def size (tarray/length arr))
|
||||
(prinf "[%2i]" size)
|
||||
(for i 0 size
|
||||
(prinf " %+6.3f " (arr i)))
|
||||
(print))
|
||||
|
||||
(defn matrix/print [mat]
|
||||
(def {:nrow nrow :ncol ncol :array tarray} mat)
|
||||
(printf "matrix %iX%i %p" nrow ncol tarray)
|
||||
(for i 0 nrow
|
||||
(tarray/print (matrix/row mat i))))
|
||||
|
||||
|
||||
(def nr 5)
|
||||
(def nc 4)
|
||||
(def A (matrix nr nc))
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set* A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set** A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
|
||||
(printf "properties:\n%p" (tarray/properties (A :array)))
|
||||
(for i 0 nr
|
||||
(printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i))))
|
||||
(for i 0 nc
|
||||
(printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))
|
||||
@@ -1,6 +0,0 @@
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(printf "Connected to %q!" conn)
|
||||
(:write conn "Echo...")
|
||||
(print "Wrote to connection...")
|
||||
(def res (:read conn 1024))
|
||||
(pp res))
|
||||
@@ -1,20 +0,0 @@
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(print "Connection " id "!")
|
||||
(while (:read stream 1024 b)
|
||||
(repeat 10 (print "work for " id " ...") (ev/sleep 0.1))
|
||||
(:write stream b)
|
||||
(buffer/clear b))
|
||||
(printf "Done %v!" id)))
|
||||
|
||||
# Run server.
|
||||
(let [server (net/server "127.0.0.1" "8000")]
|
||||
(print "Starting echo server on 127.0.0.1:8000")
|
||||
(forever
|
||||
(if-let [conn (:accept server)]
|
||||
(ev/call handler conn)
|
||||
(print "no new connections"))))
|
||||
@@ -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,5 +0,0 @@
|
||||
(def conn (net/connect "127.0.0.1" "8009" :datagram))
|
||||
(:write conn (string/format "%q" (os/cryptorand 16)))
|
||||
(def x (:read conn 1024))
|
||||
(pp x)
|
||||
|
||||
@@ -1,6 +0,0 @@
|
||||
(def server (net/listen "127.0.0.1" "8009" :datagram))
|
||||
(while true
|
||||
(def buf @"")
|
||||
(def who (:recv-from server 1024 buf))
|
||||
(printf "got %q from %v, echoing!" buf who)
|
||||
(:send-to server who buf))
|
||||
@@ -1,10 +1,10 @@
|
||||
# An example of using Janet's extensible module system to import files from
|
||||
# URL. To try this, run `janet -l ./examples/urlloader.janet` from the command
|
||||
# line, and then at the REPL type:
|
||||
# An example of using Janet's extensible module system
|
||||
# to import files from URL. To try this, run `janet -l examples/urlloader.janet`
|
||||
# from the repl, and then:
|
||||
#
|
||||
# (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!"))
|
||||
#
|
||||
@@ -13,9 +13,9 @@
|
||||
|
||||
(defn- load-url
|
||||
[url args]
|
||||
(def p (os/spawn ["curl" url "-s"] :p {:out :pipe}))
|
||||
(def res (dofile (p :out) :source url ;args))
|
||||
(:wait p)
|
||||
(def f (file/popen (string "curl " url)))
|
||||
(def res (dofile f :source url ;args))
|
||||
(try (file/close f) ([err] nil))
|
||||
res)
|
||||
|
||||
(defn- check-http-url
|
||||
|
||||
210
janet-installer.nsi
Normal file
210
janet-installer.nsi
Normal file
@@ -0,0 +1,210 @@
|
||||
Unicode True
|
||||
|
||||
!echo "Program Files: ${PROGRAMFILES}"
|
||||
!addplugindir "tools\"
|
||||
|
||||
# Version
|
||||
!define PRODUCT_VERSION "${VERSION}.0"
|
||||
VIProductVersion "${PRODUCT_VERSION}"
|
||||
VIFileVersion "${PRODUCT_VERSION}"
|
||||
|
||||
# Use the modern UI
|
||||
!define MULTIUSER_EXECUTIONLEVEL Highest
|
||||
!define MULTIUSER_MUI
|
||||
!define MULTIUSER_INSTALLMODE_COMMANDLINE
|
||||
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
|
||||
|
||||
!if ${SIXTYFOUR} == "true"
|
||||
!define MULTIUSER_USE_PROGRAMFILES64
|
||||
!endif
|
||||
|
||||
# Includes
|
||||
!include "MultiUser.nsh"
|
||||
!include "MUI2.nsh"
|
||||
!include "LogicLib.nsh"
|
||||
|
||||
# Basics
|
||||
Name "Janet"
|
||||
|
||||
# Do some NSIS-fu to figure out at compile time if we are in appveyor
|
||||
!define OUTNAME $%APPVEYOR_REPO_TAG_NAME%
|
||||
!define "CHECK_${OUTNAME}"
|
||||
!define DOLLAR "$"
|
||||
!ifdef CHECK_${DOLLAR}%APPVEYOR_REPO_TAG_NAME%
|
||||
# We are not in the appveyor environment, use version name
|
||||
!define OUTNAME_PART v${VERSION}
|
||||
!else
|
||||
# We are in appveyor, use git tag name for installer
|
||||
!define OUTNAME_PART ${OUTNAME}
|
||||
!endif
|
||||
OutFile "janet-${OUTNAME_PART}-windows-installer.exe"
|
||||
|
||||
# Some Configuration
|
||||
!define APPNAME "Janet"
|
||||
!define DESCRIPTION "The Janet Programming Language"
|
||||
!define HELPURL "http://janet-lang.org"
|
||||
BrandingText "The Janet Programming Language"
|
||||
|
||||
# Macros for setting registry values
|
||||
!define UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet-${VERSION}"
|
||||
!macro WriteEnv key value
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}" "${value}"
|
||||
${Else}
|
||||
WriteRegExpandStr HKCU "Environment" "${key}" "${value}"
|
||||
${EndIf}
|
||||
!macroend
|
||||
!macro DelEnv key
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}"
|
||||
${Else}
|
||||
DeleteRegValue HKCU "Environment" "${key}"
|
||||
${EndIf}
|
||||
!macroend
|
||||
|
||||
# MUI Configuration
|
||||
!define MUI_ICON "assets\icon.ico"
|
||||
!define MUI_UNICON "assets\icon.ico"
|
||||
!define MUI_HEADERIMAGE
|
||||
!define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png"
|
||||
!define MUI_HEADERIMAGE_RIGHT
|
||||
!define MUI_ABORTWARNING
|
||||
|
||||
# Show a welcome page first
|
||||
!insertmacro MUI_PAGE_WELCOME
|
||||
!insertmacro MUI_PAGE_LICENSE "LICENSE"
|
||||
|
||||
# Pick Install Directory
|
||||
!insertmacro MULTIUSER_PAGE_INSTALLMODE
|
||||
!insertmacro MUI_PAGE_DIRECTORY
|
||||
!insertmacro MUI_PAGE_INSTFILES
|
||||
|
||||
# Done
|
||||
!insertmacro MUI_PAGE_FINISH
|
||||
|
||||
# Need to set a language.
|
||||
!insertmacro MUI_LANGUAGE "English"
|
||||
|
||||
function .onInit
|
||||
!insertmacro MULTIUSER_INIT
|
||||
functionEnd
|
||||
|
||||
section "Janet" BfWSection
|
||||
|
||||
createDirectory "$INSTDIR\Library"
|
||||
createDirectory "$INSTDIR\C"
|
||||
createDirectory "$INSTDIR\bin"
|
||||
createDirectory "$INSTDIR\docs"
|
||||
setOutPath "$INSTDIR"
|
||||
|
||||
# Bin files
|
||||
file /oname=bin\janet.exe dist\janet.exe
|
||||
file /oname=logo.ico assets\icon.ico
|
||||
file /oname=bin\jpm.janet auxbin\jpm
|
||||
file /oname=bin\jpm.bat tools\jpm.bat
|
||||
|
||||
# C headers and library files
|
||||
file /oname=C\janet.h dist\janet.h
|
||||
file /oname=C\janetconf.h dist\janetconf.h
|
||||
file /oname=C\janet.lib dist\janet.lib
|
||||
file /oname=C\janet.exp dist\janet.exp
|
||||
file /oname=C\janet.c dist\janet.c
|
||||
file /oname=C\libjanet.lib dist\libjanet.lib
|
||||
|
||||
# Documentation
|
||||
file /oname=docs\docs.html dist\doc.html
|
||||
|
||||
# Other
|
||||
file README.md
|
||||
file LICENSE
|
||||
|
||||
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
||||
writeUninstaller "$INSTDIR\uninstall.exe"
|
||||
|
||||
# Start Menu
|
||||
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
||||
|
||||
# Update path
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
EnVar::SetHKLM
|
||||
${Else}
|
||||
EnVar::SetHKCU
|
||||
${EndIf}
|
||||
EnVar::AddValue "PATH" "$INSTDIR\bin"
|
||||
Pop $0
|
||||
|
||||
# Set up Environment variables
|
||||
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
|
||||
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
|
||||
!insertmacro WriteEnv JANET_LIBPATH "$INSTDIR\C"
|
||||
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
|
||||
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
# Registry information for add/remove programs
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayIcon" "$INSTDIR\logo.ico"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "Publisher" "Janet-Lang.org"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "${VERSION}"
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
|
||||
# Add uninstall
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "UninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "QuietUninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode /S"
|
||||
|
||||
sectionEnd
|
||||
|
||||
# Uninstaller
|
||||
|
||||
function un.onInit
|
||||
!insertmacro MULTIUSER_UNINIT
|
||||
functionEnd
|
||||
|
||||
section "uninstall"
|
||||
|
||||
# Remove Start Menu launcher
|
||||
delete "$SMPROGRAMS\Janet.lnk"
|
||||
|
||||
# Remove files
|
||||
delete "$INSTDIR\logo.ico"
|
||||
delete "$INSTDIR\README.md"
|
||||
delete "$INSTDIR\LICENSE"
|
||||
rmdir /r "$INSTDIR\Library"
|
||||
rmdir /r "$INSTDIR\bin"
|
||||
rmdir /r "$INSTDIR\C"
|
||||
rmdir /r "$INSTDIR\docs"
|
||||
|
||||
# Remove env vars
|
||||
!insertmacro DelEnv JANET_PATH
|
||||
!insertmacro DelEnv JANET_HEADERPATH
|
||||
!insertmacro DelEnv JANET_LIBPATH
|
||||
!insertmacro DelEnv JANET_BINPATH
|
||||
|
||||
# Unset PATH
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
EnVar::SetHKLM
|
||||
${Else}
|
||||
EnVar::SetHKCU
|
||||
${EndIf}
|
||||
EnVar::DeleteValue "PATH" "$INSTDIR\bin"
|
||||
Pop $0
|
||||
|
||||
# make sure windows knows about the change
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
# Always delete uninstaller as the last action
|
||||
delete "$INSTDIR\uninstall.exe"
|
||||
|
||||
# Remove uninstaller information from the registry
|
||||
DeleteRegKey SHCTX "${UNINST_KEY}"
|
||||
|
||||
sectionEnd
|
||||
74
janet.1
74
janet.1
@@ -3,21 +3,18 @@
|
||||
janet \- run the Janet language abstract machine
|
||||
.SH SYNOPSIS
|
||||
.B janet
|
||||
[\fB\-hvsrpnqik\fR]
|
||||
[\fB\-hvsrpnqk\fR]
|
||||
[\fB\-e\fR \fISOURCE\fR]
|
||||
[\fB\-E\fR \fISOURCE ...ARGUMENTS\fR]
|
||||
[\fB\-l\fR \fIMODULE\fR]
|
||||
[\fB\-m\fR \fIPATH\fR]
|
||||
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
||||
[\fB\-w\fR \fILEVEL\fR]
|
||||
[\fB\-x\fR \fILEVEL\fR]
|
||||
[\fB\-\-\fR]
|
||||
.BR script
|
||||
.BR args ...
|
||||
.SH DESCRIPTION
|
||||
Janet is a functional and imperative programming language and bytecode interpreter.
|
||||
It is a Lisp-like language, but lists are replaced by other data structures
|
||||
(arrays, tables, structs, tuples). The language also features bridging
|
||||
It is a modern lisp, but lists are replaced by other data structures with better utility
|
||||
and performance (arrays, tables, structs, tuples). The language also features bridging
|
||||
to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
|
||||
There is a repl for trying out the language, as well as the ability to run script files.
|
||||
@@ -67,10 +64,6 @@ Move cursor to the beginning of input line.
|
||||
.BR Ctrl\-B
|
||||
Move cursor one character to the left.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-D
|
||||
If on a newline, indicate end of stream and exit the repl.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-E
|
||||
Move cursor to the end of input line.
|
||||
@@ -103,14 +96,6 @@ Delete everything before the cursor on the input line.
|
||||
.BR Ctrl\-W
|
||||
Delete one word before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-G
|
||||
Show documentation for the current symbol under the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-Q
|
||||
Clear the current command, including already typed lines.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-B/Alt\-F
|
||||
Move cursor backwards and forwards one word.
|
||||
@@ -163,17 +148,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
|
||||
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.
|
||||
|
||||
.TP
|
||||
.BR \-d
|
||||
Enable debug mode. On all terminating signals as well the debug signal, this will
|
||||
cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a
|
||||
default repl.
|
||||
|
||||
.TP
|
||||
.BR \-n
|
||||
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||
@@ -183,10 +157,6 @@ Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
|
||||
arguments, a REPL is opened.
|
||||
|
||||
.TP
|
||||
.BR \-R
|
||||
If using the REPL, disable loading the user profile from the JANET_PROFILE environment variable.
|
||||
|
||||
.TP
|
||||
.BR \-p
|
||||
Turn on the persistent flag. By default, when Janet is executing commands from a file and encounters an error,
|
||||
@@ -195,7 +165,7 @@ after an error. Persistent mode can be good for debugging and testing.
|
||||
|
||||
.TP
|
||||
.BR \-q
|
||||
Hide the logo in the repl.
|
||||
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||
|
||||
.TP
|
||||
.BR \-k
|
||||
@@ -214,27 +184,11 @@ Source should be a path to the Janet module to compile, and output should be the
|
||||
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
|
||||
.BR \-l\ lib
|
||||
Import a Janet module before running a script or repl. Multiple files can be loaded
|
||||
.BR \-l\ path
|
||||
Load a Janet file before running a script or repl. Multiple files can be loaded
|
||||
in this manner, and exports from each file will be made available to the script
|
||||
or repl.
|
||||
.TP
|
||||
.BR \-w\ level
|
||||
Set the warning linting level for Janet.
|
||||
This linting level should be one of :relaxed, :none, :strict, :normal, or a
|
||||
Janet number. Any linting message that is of a greater lint level than this setting will be displayed as
|
||||
a warning, but not stop compilation or execution.
|
||||
.TP
|
||||
.BR \-x\ level
|
||||
Set the error linting level for Janet.
|
||||
This linting level should be one of :relaxed, :none, :strict, :normal, or a
|
||||
Janet number. Any linting message that is of a greater lint level will cause a compilation error
|
||||
and stop compilation.
|
||||
|
||||
.TP
|
||||
.BR \-\-
|
||||
Stop parsing command line arguments. All arguments after this one will be considered file names
|
||||
@@ -249,19 +203,5 @@ find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||
the default location set at compile time.
|
||||
.RE
|
||||
|
||||
.B JANET_PROFILE
|
||||
.RS
|
||||
Path to a profile file that the interpreter will load before entering the REPL. This profile file will
|
||||
not run for scripts, though. This behavior can be disabled with the -R option.
|
||||
.RE
|
||||
|
||||
.B JANET_HASHSEED
|
||||
.RS
|
||||
To disable randomization of Janet's PRF on start up, one can set this variable. This can have the
|
||||
effect of making programs deterministic that otherwise would depend on the random seed chosen at program start.
|
||||
This variable does nothing in the default configuration of Janet, as PRF is disabled by default. Also, JANET_REDUCED_OS
|
||||
cannot be defined for this variable to have an effect.
|
||||
.RE
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
|
||||
207
jpm.1
Normal file
207
jpm.1
Normal file
@@ -0,0 +1,207 @@
|
||||
.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 \-\-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.
|
||||
|
||||
.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 compiler used for compiling native modules and standalone executables. Defaults
|
||||
to cc.
|
||||
|
||||
.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.
|
||||
|
||||
.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.
|
||||
|
||||
.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 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 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.
|
||||
|
||||
.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 standalong 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.
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
109
meson.build
109
meson.build
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2021 Calvin Rose and contributors
|
||||
# Copyright (c) 2020 Calvin Rose and contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -19,8 +19,8 @@
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.22.1')
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.8.1')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -30,11 +30,10 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet'
|
||||
cc = meson.get_compiler('c')
|
||||
m_dep = cc.find_library('m', required : false)
|
||||
dl_dep = cc.find_library('dl', required : false)
|
||||
android_spawn_dep = cc.find_library('android-spawn', required : false)
|
||||
thread_dep = dependency('threads')
|
||||
|
||||
# Link options
|
||||
if get_option('default_library') != 'static' and build_machine.system() != 'windows'
|
||||
if build_machine.system() != 'windows'
|
||||
add_project_link_arguments('-rdynamic', language : 'c')
|
||||
endif
|
||||
|
||||
@@ -60,23 +59,14 @@ conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
|
||||
conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
||||
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_NO_NET', not get_option('net'))
|
||||
conf.set('JANET_NO_EV', not get_option('ev') or get_option('single_threaded'))
|
||||
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
|
||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||
conf.set('JANET_PRF', get_option('prf'))
|
||||
conf.set('JANET_NO_PRF', not get_option('prf'))
|
||||
conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
|
||||
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
|
||||
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
|
||||
conf.set('JANET_STACK_MAX', get_option('stack_max'))
|
||||
conf.set('JANET_NO_UMASK', not get_option('umask'))
|
||||
conf.set('JANET_NO_REALPATH', not get_option('realpath'))
|
||||
conf.set('JANET_NO_PROCESSES', not get_option('processes'))
|
||||
conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
|
||||
conf.set('JANET_EV_NO_EPOLL', not 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'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
@@ -116,15 +106,12 @@ core_src = [
|
||||
'src/core/corelib.c',
|
||||
'src/core/debug.c',
|
||||
'src/core/emit.c',
|
||||
'src/core/ev.c',
|
||||
'src/core/ffi.c',
|
||||
'src/core/fiber.c',
|
||||
'src/core/gc.c',
|
||||
'src/core/inttypes.c',
|
||||
'src/core/io.c',
|
||||
'src/core/marsh.c',
|
||||
'src/core/math.c',
|
||||
'src/core/net.c',
|
||||
'src/core/os.c',
|
||||
'src/core/parse.c',
|
||||
'src/core/peg.c',
|
||||
@@ -132,13 +119,14 @@ core_src = [
|
||||
'src/core/regalloc.c',
|
||||
'src/core/run.c',
|
||||
'src/core/specials.c',
|
||||
'src/core/state.c',
|
||||
'src/core/string.c',
|
||||
'src/core/strtod.c',
|
||||
'src/core/struct.c',
|
||||
'src/core/symcache.c',
|
||||
'src/core/table.c',
|
||||
'src/core/thread.c',
|
||||
'src/core/tuple.c',
|
||||
'src/core/typedarray.c',
|
||||
'src/core/util.c',
|
||||
'src/core/value.c',
|
||||
'src/core/vector.c',
|
||||
@@ -163,7 +151,7 @@ mainclient_src = [
|
||||
janet_boot = executable('janet-boot', core_src, boot_src,
|
||||
include_directories : incdir,
|
||||
c_args : '-DJANET_BOOTSTRAP',
|
||||
dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep],
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
native : true)
|
||||
|
||||
# Build janet.c
|
||||
@@ -173,45 +161,40 @@ janetc = custom_target('janetc',
|
||||
capture : true,
|
||||
command : [
|
||||
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]
|
||||
if not get_option('single_threaded')
|
||||
janet_dependencies += thread_dep
|
||||
endif
|
||||
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
install : true)
|
||||
|
||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||
# shaves off about 10k on linux x64, likely similar on other platforms.
|
||||
if cc.has_argument('-fvisibility=hidden')
|
||||
extra_cflags = ['-fvisibility=hidden']
|
||||
native_cc = meson.get_compiler('c', native: true)
|
||||
cross_cc = meson.get_compiler('c', native: false)
|
||||
if native_cc.has_argument('-fvisibility=hidden')
|
||||
extra_native_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_cflags = []
|
||||
extra_native_cflags = []
|
||||
endif
|
||||
if cross_cc.has_argument('-fvisibility=hidden')
|
||||
extra_cross_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_cross_cflags = []
|
||||
endif
|
||||
|
||||
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
c_args : extra_cflags,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_native_cflags,
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
native_cc = meson.get_compiler('c', native: true)
|
||||
if native_cc.has_argument('-fvisibility=hidden')
|
||||
extra_native_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_native_cflags = []
|
||||
endif
|
||||
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
c_args : extra_native_cflags,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_cross_cflags,
|
||||
native : true)
|
||||
else
|
||||
janet_nativeclient = janet_mainclient
|
||||
@@ -226,17 +209,15 @@ docs = custom_target('docs',
|
||||
|
||||
# Tests
|
||||
test_files = [
|
||||
'test/suite0000.janet',
|
||||
'test/suite0001.janet',
|
||||
'test/suite0002.janet',
|
||||
'test/suite0003.janet',
|
||||
'test/suite0004.janet',
|
||||
'test/suite0005.janet',
|
||||
'test/suite0006.janet',
|
||||
'test/suite0007.janet',
|
||||
'test/suite0008.janet',
|
||||
'test/suite0009.janet',
|
||||
'test/suite0010.janet'
|
||||
'test/suite0.janet',
|
||||
'test/suite1.janet',
|
||||
'test/suite2.janet',
|
||||
'test/suite3.janet',
|
||||
'test/suite4.janet',
|
||||
'test/suite5.janet',
|
||||
'test/suite6.janet',
|
||||
'test/suite7.janet',
|
||||
'test/suite8.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
@@ -252,22 +233,14 @@ janet_dep = declare_dependency(include_directories : incdir,
|
||||
# pkgconfig
|
||||
pkg = import('pkgconfig')
|
||||
pkg.generate(libjanet,
|
||||
subdirs: 'janet',
|
||||
description: 'Library for the Janet programming language.')
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
install_man('jpm.1')
|
||||
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||
janet_binscripts = [
|
||||
'auxbin/jpm'
|
||||
]
|
||||
install_data(sources : janet_binscripts, install_dir : get_option('bindir'))
|
||||
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
|
||||
patched_janet = custom_target('patched-janeth',
|
||||
input : ['tools/patch-header.janet', 'src/include/janet.h', jconf],
|
||||
install : true,
|
||||
install_dir : join_paths(get_option('includedir'), 'janet'),
|
||||
build_by_default : true,
|
||||
output : ['janet.h'],
|
||||
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
|
||||
|
||||
# Create a version of the janet.h header that matches what jpm often expects
|
||||
if meson.version().version_compare('>=0.61')
|
||||
install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir'))
|
||||
endif
|
||||
|
||||
|
||||
@@ -8,18 +8,9 @@ option('sourcemaps', type : 'boolean', value : true)
|
||||
option('reduced_os', type : 'boolean', value : false)
|
||||
option('assembler', type : 'boolean', value : true)
|
||||
option('peg', type : 'boolean', value : true)
|
||||
option('typed_array', type : 'boolean', value : true)
|
||||
option('int_types', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : false)
|
||||
option('net', type : 'boolean', value : true)
|
||||
option('ev', type : 'boolean', value : true)
|
||||
option('processes', type : 'boolean', value : true)
|
||||
option('umask', type : 'boolean', value : true)
|
||||
option('realpath', type : 'boolean', value : true)
|
||||
option('simple_getline', type : 'boolean', value : false)
|
||||
option('epoll', type : 'boolean', value : false)
|
||||
option('kqueue', type : 'boolean', value : false)
|
||||
option('interpreter_interrupt', type : 'boolean', value : false)
|
||||
option('ffi', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : true)
|
||||
|
||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -93,7 +93,7 @@ int main(int argc, const char **argv) {
|
||||
fseek(boot_file, 0, SEEK_END);
|
||||
size_t boot_size = ftell(boot_file);
|
||||
fseek(boot_file, 0, SEEK_SET);
|
||||
unsigned char *boot_buffer = janet_malloc(boot_size);
|
||||
unsigned char *boot_buffer = malloc(boot_size);
|
||||
if (NULL == boot_buffer) {
|
||||
fprintf(stderr, "Failed to allocate boot buffer\n");
|
||||
exit(1);
|
||||
@@ -105,7 +105,7 @@ int main(int argc, const char **argv) {
|
||||
fclose(boot_file);
|
||||
|
||||
status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
|
||||
janet_free(boot_buffer);
|
||||
free(boot_buffer);
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
||||
3533
src/boot/boot.janet
3533
src/boot/boot.janet
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,7 +23,6 @@
|
||||
#include <janet.h>
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <math.h>
|
||||
|
||||
#include "tests.h"
|
||||
|
||||
@@ -45,31 +44,11 @@ int system_test() {
|
||||
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
|
||||
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
|
||||
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
|
||||
#ifdef NAN
|
||||
assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER));
|
||||
#else
|
||||
assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER));
|
||||
#endif
|
||||
|
||||
assert(NULL != &janet_wrap_nil);
|
||||
|
||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||
|
||||
Janet *t1 = janet_tuple_begin(3);
|
||||
t1[0] = janet_wrap_nil();
|
||||
t1[1] = janet_wrap_integer(4);
|
||||
t1[2] = janet_cstringv("hi");
|
||||
Janet tuple1 = janet_wrap_tuple(janet_tuple_end(t1));
|
||||
|
||||
Janet *t2 = janet_tuple_begin(3);
|
||||
t2[0] = janet_wrap_nil();
|
||||
t2[1] = janet_wrap_integer(4);
|
||||
t2[2] = janet_cstringv("hi");
|
||||
Janet tuple2 = janet_wrap_tuple(janet_tuple_end(t2));
|
||||
|
||||
assert(janet_equals(tuple1, tuple2));
|
||||
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -61,11 +61,5 @@ int table_test() {
|
||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||
|
||||
assert(t2->count == 4);
|
||||
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
||||
assert(t2->count == 3);
|
||||
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||
assert(t2->count == 2);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,13 +1,36 @@
|
||||
/* This will be generated by the build system if this file is not used */
|
||||
/*
|
||||
* Copyright (c) 2020 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.
|
||||
*/
|
||||
|
||||
/* This is an example janetconf.h file. This will be usually generated
|
||||
* by the build system. */
|
||||
|
||||
#ifndef JANETCONF_H
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 22
|
||||
#define JANET_VERSION_MINOR 8
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.22.1-dev"
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.8.1"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -18,47 +41,23 @@
|
||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||
|
||||
/* These settings should be specified before amalgamation is
|
||||
* built. Any build with these set should be considered non-standard, and
|
||||
* certain Janet libraries should be expected not to work. */
|
||||
* built. */
|
||||
/* #define JANET_NO_DOCSTRINGS */
|
||||
/* #define JANET_NO_SOURCEMAPS */
|
||||
/* #define JANET_REDUCED_OS */
|
||||
/* #define JANET_NO_PROCESSES */
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_NET */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
/* #define JANET_NO_EV */
|
||||
/* #define JANET_NO_REALPATH */
|
||||
/* #define JANET_NO_SYMLINKS */
|
||||
/* #define JANET_NO_UMASK */
|
||||
/* #define JANET_NO_THREADS */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_DEBUG */
|
||||
/* #define JANET_PRF */
|
||||
/* #define JANET_NO_UTC_MKTIME */
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
/* #define JANET_NO_PRF */
|
||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
|
||||
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
|
||||
/* #define JANET_RECURSION_GUARD 1024 */
|
||||
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||
/* #define JANET_STACK_MAX 16384 */
|
||||
/* #define JANET_OS_NAME my-custom-os */
|
||||
/* #define JANET_ARCH_NAME pdp-8 */
|
||||
/* #define JANET_EV_NO_EPOLL */
|
||||
/* #define JANET_EV_NO_KQUEUE */
|
||||
/* #define JANET_NO_INTERPRETER_INTERRUPT */
|
||||
|
||||
/* Custom vm allocator support */
|
||||
/* #include <mimalloc.h> */
|
||||
/* #define janet_malloc(X) mi_malloc((X)) */
|
||||
/* #define janet_realloc(X, Y) mi_realloc((X), (Y)) */
|
||||
/* #define janet_calloc(X, Y) mi_calloc((X), (Y)) */
|
||||
/* #define janet_free(X) mi_free((X)) */
|
||||
|
||||
/* Main client settings, does not affect library code */
|
||||
/* #define JANET_SIMPLE_GETLINE */
|
||||
|
||||
#endif /* end of include guard: JANETCONF_H */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,14 +23,7 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "gc.h"
|
||||
#include "state.h"
|
||||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Create new userdata */
|
||||
@@ -50,170 +43,3 @@ void *janet_abstract_end(void *x) {
|
||||
void *janet_abstract(const JanetAbstractType *atype, size_t 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
|
||||
|
||||
void janet_os_mutex_size(void) {
|
||||
return sizeof(CRITICAL_SECTION);
|
||||
}
|
||||
|
||||
void janet_os_rwlock_size(void) {
|
||||
return sizeof(SRWLock);
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return InterlockedIncrement(&ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return InterlockedDecrement(&ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
pthread_mutexattr_t attr;
|
||||
pthread_mutexattr_init(&attr);
|
||||
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_incref(janet_abstract_head(abst));
|
||||
}
|
||||
|
||||
int32_t janet_abstract_decref(void *abst) {
|
||||
return janet_decref(janet_abstract_head(abst));
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
208
src/core/array.c
208
src/core/array.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -35,8 +35,8 @@ JanetArray *janet_array(int32_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
Janet *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm.next_collection += capacity * sizeof(Janet);
|
||||
data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
|
||||
janet_vm_next_collection += capacity * sizeof(Janet);
|
||||
data = (Janet *) malloc(sizeof(Janet) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -52,7 +52,7 @@ JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
array->capacity = n;
|
||||
array->count = n;
|
||||
array->data = janet_malloc(sizeof(Janet) * (size_t) n);
|
||||
array->data = malloc(sizeof(Janet) * (size_t) n);
|
||||
if (!array->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -68,11 +68,11 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
|
||||
int64_t new_capacity = ((int64_t) capacity) * growth;
|
||||
if (new_capacity > INT32_MAX) new_capacity = INT32_MAX;
|
||||
capacity = (int32_t) new_capacity;
|
||||
newData = janet_realloc(old, capacity * sizeof(Janet));
|
||||
newData = realloc(old, capacity * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
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->capacity = capacity;
|
||||
}
|
||||
@@ -122,21 +122,16 @@ Janet janet_array_peek(JanetArray *array) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
JANET_CORE_FN(cfun_array_new,
|
||||
"(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.") {
|
||||
static Janet cfun_array_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetArray *array = janet_array(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.") {
|
||||
static Janet cfun_array_new_filled(int32_t argc, Janet *argv) {
|
||||
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();
|
||||
JanetArray *array = janet_array(count);
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
@@ -146,10 +141,7 @@ JANET_CORE_FN(cfun_array_new_filled,
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_fill,
|
||||
"(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.") {
|
||||
static Janet cfun_array_fill(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
@@ -159,26 +151,19 @@ JANET_CORE_FN(cfun_array_fill,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_pop,
|
||||
"(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.") {
|
||||
static Janet cfun_array_pop(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
return janet_array_pop(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_peek,
|
||||
"(array/peek arr)",
|
||||
"Returns the last element of the array. Does not modify the array.") {
|
||||
static Janet cfun_array_peek(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
return janet_array_peek(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_push,
|
||||
"(array/push arr x)",
|
||||
"Insert an element in the end of an array. Modifies the input array and returns it.") {
|
||||
static Janet cfun_array_push(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (INT32_MAX - argc + 1 <= array->count) {
|
||||
@@ -191,12 +176,7 @@ JANET_CORE_FN(cfun_array_push,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_ensure,
|
||||
"(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.") {
|
||||
static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t newcount = janet_getinteger(argv, 1);
|
||||
@@ -206,13 +186,7 @@ JANET_CORE_FN(cfun_array_ensure,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_slice,
|
||||
"(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 index -1 is synonymous with index `(length arrtup)` to allow a full "
|
||||
"negative slice range. Returns a new array.") {
|
||||
static Janet cfun_array_slice(int32_t argc, Janet *argv) {
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetArray *array = janet_array(range.end - range.start);
|
||||
@@ -222,12 +196,7 @@ JANET_CORE_FN(cfun_array_slice,
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_concat,
|
||||
"(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`.") {
|
||||
static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
@@ -241,11 +210,6 @@ JANET_CORE_FN(cfun_array_concat,
|
||||
int32_t j, len = 0;
|
||||
const Janet *vals = NULL;
|
||||
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++)
|
||||
janet_array_push(array, vals[j]);
|
||||
}
|
||||
@@ -255,12 +219,7 @@ JANET_CORE_FN(cfun_array_concat,
|
||||
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, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.") {
|
||||
static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||
size_t chunksize, restsize;
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
@@ -286,12 +245,7 @@ JANET_CORE_FN(cfun_array_insert,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_remove,
|
||||
"(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.") {
|
||||
static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t at = janet_getinteger(argv, 1);
|
||||
@@ -316,55 +270,85 @@ JANET_CORE_FN(cfun_array_remove,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_trim,
|
||||
"(array/trim arr)",
|
||||
"Set the backing capacity of an array to its current length. Returns the modified array.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (array->count) {
|
||||
if (array->count < array->capacity) {
|
||||
Janet *newData = janet_realloc(array->data, array->count * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
array->data = newData;
|
||||
array->capacity = array->count;
|
||||
}
|
||||
} else {
|
||||
array->capacity = 0;
|
||||
janet_free(array->data);
|
||||
array->data = NULL;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_clear,
|
||||
"(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);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
array->count = 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 variadic number of arrays (and tuples) into the first argument "
|
||||
"which must 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 of xs into array arr at index at. at should be an integer "
|
||||
"0 and the length of the array. A negative value for at will index 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.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the array module */
|
||||
void janet_lib_array(JanetTable *env) {
|
||||
JanetRegExt array_cfuns[] = {
|
||||
JANET_CORE_REG("array/new", cfun_array_new),
|
||||
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_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, array_cfuns);
|
||||
janet_core_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
|
||||
315
src/core/asm.c
315
src/core/asm.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -53,6 +53,7 @@ struct JanetAssembler {
|
||||
|
||||
Janet name;
|
||||
JanetTable labels; /* keyword -> bytecode index */
|
||||
JanetTable constants; /* symbol -> constant index */
|
||||
JanetTable slots; /* symbol -> slot index */
|
||||
JanetTable envs; /* symbol -> environment index */
|
||||
JanetTable defs; /* symbol -> funcdefs index */
|
||||
@@ -73,7 +74,6 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"call", JOP_CALL},
|
||||
{"clo", JOP_CLOSURE},
|
||||
{"cmp", JOP_COMPARE},
|
||||
{"cncl", JOP_CANCEL},
|
||||
{"div", JOP_DIVIDE},
|
||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||
{"eq", JOP_EQUALS},
|
||||
@@ -113,8 +113,6 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"movn", JOP_MOVE_NEAR},
|
||||
{"mul", JOP_MULTIPLY},
|
||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||
{"neq", JOP_NOT_EQUALS},
|
||||
{"neqim", JOP_NOT_EQUALS_IMMEDIATE},
|
||||
{"next", JOP_NEXT},
|
||||
{"noop", JOP_NOOP},
|
||||
{"prop", JOP_PROPAGATE},
|
||||
@@ -174,6 +172,7 @@ static void janet_asm_deinit(JanetAssembler *a) {
|
||||
janet_table_deinit(&a->slots);
|
||||
janet_table_deinit(&a->labels);
|
||||
janet_table_deinit(&a->envs);
|
||||
janet_table_deinit(&a->constants);
|
||||
janet_table_deinit(&a->defs);
|
||||
}
|
||||
|
||||
@@ -224,7 +223,7 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
|
||||
janet_table_put(&a->envs, envname, janet_wrap_number(envindex));
|
||||
if (envindex >= a->environments_capacity) {
|
||||
int32_t newcap = 2 * envindex;
|
||||
def->environments = janet_realloc(def->environments, newcap * sizeof(int32_t));
|
||||
def->environments = realloc(def->environments, newcap * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -253,6 +252,9 @@ static int32_t doarg_1(
|
||||
case JANET_OAT_ENVIRONMENT:
|
||||
c = &a->envs;
|
||||
break;
|
||||
case JANET_OAT_CONSTANT:
|
||||
c = &a->constants;
|
||||
break;
|
||||
case JANET_OAT_LABEL:
|
||||
c = &a->labels;
|
||||
break;
|
||||
@@ -504,6 +506,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
a.defs_capacity = 0;
|
||||
a.name = janet_wrap_nil();
|
||||
janet_table_init(&a.labels, 0);
|
||||
janet_table_init(&a.constants, 0);
|
||||
janet_table_init(&a.slots, 0);
|
||||
janet_table_init(&a.envs, 0);
|
||||
janet_table_init(&a.defs, 0);
|
||||
@@ -531,38 +534,34 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
"expected struct or table for assembly source");
|
||||
|
||||
/* Check for function name */
|
||||
a.name = janet_get1(s, janet_ckeywordv("name"));
|
||||
a.name = janet_get1(s, janet_csymbolv("name"));
|
||||
if (!janet_checktype(a.name, JANET_NIL)) {
|
||||
def->name = janet_to_string(a.name);
|
||||
}
|
||||
|
||||
/* Set function arity */
|
||||
x = janet_get1(s, janet_ckeywordv("arity"));
|
||||
x = janet_get1(s, janet_csymbolv("arity"));
|
||||
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
|
||||
janet_asm_assert(&a, def->arity >= 0, "arity must be non-negative");
|
||||
|
||||
x = janet_get1(s, janet_ckeywordv("max-arity"));
|
||||
x = janet_get1(s, janet_csymbolv("max-arity"));
|
||||
def->max_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||
janet_asm_assert(&a, def->max_arity >= def->arity, "max-arity must be greater than or equal to arity");
|
||||
|
||||
x = janet_get1(s, janet_ckeywordv("min-arity"));
|
||||
x = janet_get1(s, janet_csymbolv("min-arity"));
|
||||
def->min_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||
janet_asm_assert(&a, def->min_arity <= def->arity, "min-arity must be less than or equal to arity");
|
||||
|
||||
/* Check vararg */
|
||||
x = janet_get1(s, janet_ckeywordv("vararg"));
|
||||
x = janet_get1(s, janet_csymbolv("vararg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
/* Check structarg */
|
||||
x = janet_get1(s, janet_ckeywordv("structarg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
|
||||
/* Check source */
|
||||
x = janet_get1(s, janet_ckeywordv("source"));
|
||||
x = janet_get1(s, janet_csymbolv("source"));
|
||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||
|
||||
/* Create slot aliases */
|
||||
x = janet_get1(s, janet_ckeywordv("slots"));
|
||||
x = janet_get1(s, janet_csymbolv("slots"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
for (i = 0; i < count; i++) {
|
||||
Janet v = arr[i];
|
||||
@@ -583,16 +582,34 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse constants */
|
||||
x = janet_get1(s, janet_ckeywordv("constants"));
|
||||
x = janet_get1(s, janet_csymbolv("constants"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->constants_length = count;
|
||||
def->constants = janet_malloc(sizeof(Janet) * (size_t) count);
|
||||
def->constants = malloc(sizeof(Janet) * (size_t) count);
|
||||
if (NULL == def->constants) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (i = 0; i < count; i++) {
|
||||
Janet ct = arr[i];
|
||||
def->constants[i] = ct;
|
||||
if (janet_checktype(ct, JANET_TUPLE) &&
|
||||
janet_tuple_length(janet_unwrap_tuple(ct)) > 1 &&
|
||||
janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) {
|
||||
const Janet *t = janet_unwrap_tuple(ct);
|
||||
int32_t tcount = janet_tuple_length(t);
|
||||
const uint8_t *macro = janet_unwrap_symbol(t[0]);
|
||||
if (0 == janet_cstrcmp(macro, "quote")) {
|
||||
def->constants[i] = t[1];
|
||||
} else if (tcount == 3 &&
|
||||
janet_checktype(t[1], JANET_SYMBOL) &&
|
||||
0 == janet_cstrcmp(macro, "def")) {
|
||||
def->constants[i] = t[2];
|
||||
janet_table_put(&a.constants, t[1], janet_wrap_integer(i));
|
||||
} else {
|
||||
janet_asm_errorv(&a, janet_formatc("could not parse constant \"%v\"", ct));
|
||||
}
|
||||
} else {
|
||||
def->constants[i] = ct;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
def->constants = NULL;
|
||||
@@ -600,7 +617,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse sub funcdefs */
|
||||
x = janet_get1(s, janet_ckeywordv("closures"));
|
||||
x = janet_get1(s, janet_csymbolv("closures"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
@@ -611,14 +628,14 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
if (subres.status != JANET_ASSEMBLE_OK) {
|
||||
janet_asm_errorv(&a, subres.error);
|
||||
}
|
||||
subname = janet_get1(arr[i], janet_ckeywordv("name"));
|
||||
subname = janet_get1(arr[i], janet_csymbolv("name"));
|
||||
if (!janet_checktype(subname, JANET_NIL)) {
|
||||
janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length));
|
||||
}
|
||||
newlen = def->defs_length + 1;
|
||||
if (a.defs_capacity < newlen) {
|
||||
int32_t newcap = newlen;
|
||||
def->defs = janet_realloc(def->defs, newcap * sizeof(JanetFuncDef *));
|
||||
def->defs = realloc(def->defs, newcap * sizeof(JanetFuncDef *));
|
||||
if (NULL == def->defs) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -630,7 +647,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse bytecode and labels */
|
||||
x = janet_get1(s, janet_ckeywordv("bytecode"));
|
||||
x = janet_get1(s, janet_csymbolv("bytecode"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
/* Do labels and find length */
|
||||
int32_t blength = 0;
|
||||
@@ -647,7 +664,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
/* Allocate bytecode array */
|
||||
def->bytecode_length = blength;
|
||||
def->bytecode = janet_malloc(sizeof(uint32_t) * (size_t) blength);
|
||||
def->bytecode = malloc(sizeof(uint32_t) * (size_t) blength);
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -686,13 +703,10 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
a.errindex = -1;
|
||||
|
||||
/* Check for source mapping */
|
||||
x = janet_get1(s, janet_ckeywordv("sourcemap"));
|
||||
x = janet_get1(s, janet_csymbolv("sourcemap"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||
def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
for (i = 0; i < count; i++) {
|
||||
const Janet *tup;
|
||||
Janet entry = arr[i];
|
||||
@@ -715,19 +729,13 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
|
||||
/* Set environments */
|
||||
def->environments =
|
||||
janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
|
||||
/* Verify the func def */
|
||||
if (janet_verify(def)) {
|
||||
janet_asm_error(&a, "invalid assembly");
|
||||
}
|
||||
|
||||
/* Add final flags */
|
||||
janet_def_addflags(def);
|
||||
|
||||
/* Finish everything and return funcdef */
|
||||
janet_asm_deinit(&a);
|
||||
result.error = NULL;
|
||||
@@ -845,119 +853,92 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/*
|
||||
* Disasm sections
|
||||
*/
|
||||
|
||||
static Janet janet_disasm_arity(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->arity);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_min_arity(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->min_arity);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_max_arity(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->max_arity);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_slotcount(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->slotcount);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
|
||||
Janet janet_disasm(JanetFuncDef *def) {
|
||||
int32_t i;
|
||||
JanetArray *bcode = janet_array(def->bytecode_length);
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
JanetArray *constants;
|
||||
JanetTable *ret = janet_table(10);
|
||||
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
|
||||
janet_table_put(ret, janet_csymbolv("min-arity"), janet_wrap_integer(def->min_arity));
|
||||
janet_table_put(ret, janet_csymbolv("max-arity"), janet_wrap_integer(def->max_arity));
|
||||
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
|
||||
if (NULL != def->source) {
|
||||
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
||||
}
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
||||
}
|
||||
if (NULL != def->name) {
|
||||
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
||||
}
|
||||
|
||||
/* Add constants */
|
||||
if (def->constants_length > 0) {
|
||||
constants = janet_array(def->constants_length);
|
||||
janet_table_put(ret, janet_csymbolv("constants"), janet_wrap_array(constants));
|
||||
for (i = 0; i < def->constants_length; i++) {
|
||||
Janet src = def->constants[i];
|
||||
Janet dest;
|
||||
if (janet_checktype(src, JANET_TUPLE)) {
|
||||
dest = janet_wrap_tuple(tup2(janet_csymbolv("quote"), src));
|
||||
} else {
|
||||
dest = src;
|
||||
}
|
||||
constants->data[i] = dest;
|
||||
}
|
||||
constants->count = def->constants_length;
|
||||
}
|
||||
|
||||
/* Add bytecode */
|
||||
for (i = 0; i < def->bytecode_length; i++) {
|
||||
bcode->data[i] = janet_asm_decode_instruction(def->bytecode[i]);
|
||||
}
|
||||
bcode->count = def->bytecode_length;
|
||||
return janet_wrap_array(bcode);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_source(JanetFuncDef *def) {
|
||||
if (def->source != NULL) return janet_wrap_string(def->source);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_disasm_name(JanetFuncDef *def) {
|
||||
if (def->name != NULL) return janet_wrap_string(def->name);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_disasm_vararg(JanetFuncDef *def) {
|
||||
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) {
|
||||
JanetArray *constants = janet_array(def->constants_length);
|
||||
for (int32_t i = 0; i < def->constants_length; i++) {
|
||||
constants->data[i] = def->constants[i];
|
||||
/* Add source map */
|
||||
if (NULL != def->sourcemap) {
|
||||
JanetArray *sourcemap = janet_array(def->bytecode_length);
|
||||
for (i = 0; i < def->bytecode_length; i++) {
|
||||
Janet *t = janet_tuple_begin(2);
|
||||
JanetSourceMapping mapping = def->sourcemap[i];
|
||||
t[0] = janet_wrap_integer(mapping.line);
|
||||
t[1] = janet_wrap_integer(mapping.column);
|
||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
}
|
||||
sourcemap->count = def->bytecode_length;
|
||||
janet_table_put(ret, janet_csymbolv("sourcemap"), janet_wrap_array(sourcemap));
|
||||
}
|
||||
constants->count = def->constants_length;
|
||||
return janet_wrap_array(constants);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_sourcemap(JanetFuncDef *def) {
|
||||
if (NULL == def->sourcemap) return janet_wrap_nil();
|
||||
JanetArray *sourcemap = janet_array(def->bytecode_length);
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
Janet *t = janet_tuple_begin(2);
|
||||
JanetSourceMapping mapping = def->sourcemap[i];
|
||||
t[0] = janet_wrap_integer(mapping.line);
|
||||
t[1] = janet_wrap_integer(mapping.column);
|
||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
/* Add environments */
|
||||
if (NULL != def->environments) {
|
||||
JanetArray *envs = janet_array(def->environments_length);
|
||||
for (i = 0; i < def->environments_length; i++) {
|
||||
envs->data[i] = janet_wrap_integer(def->environments[i]);
|
||||
}
|
||||
envs->count = def->environments_length;
|
||||
janet_table_put(ret, janet_csymbolv("environments"), janet_wrap_array(envs));
|
||||
}
|
||||
sourcemap->count = def->bytecode_length;
|
||||
return janet_wrap_array(sourcemap);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_environments(JanetFuncDef *def) {
|
||||
JanetArray *envs = janet_array(def->environments_length);
|
||||
for (int32_t i = 0; i < def->environments_length; i++) {
|
||||
envs->data[i] = janet_wrap_integer(def->environments[i]);
|
||||
/* Add closures */
|
||||
/* Funcdefs cannot be recursive */
|
||||
if (NULL != def->defs) {
|
||||
JanetArray *defs = janet_array(def->defs_length);
|
||||
for (i = 0; i < def->defs_length; i++) {
|
||||
defs->data[i] = janet_disasm(def->defs[i]);
|
||||
}
|
||||
defs->count = def->defs_length;
|
||||
janet_table_put(ret, janet_csymbolv("defs"), janet_wrap_array(defs));
|
||||
}
|
||||
envs->count = def->environments_length;
|
||||
return janet_wrap_array(envs);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_defs(JanetFuncDef *def) {
|
||||
JanetArray *defs = janet_array(def->defs_length);
|
||||
for (int32_t i = 0; i < def->defs_length; i++) {
|
||||
defs->data[i] = janet_disasm(def->defs[i]);
|
||||
}
|
||||
defs->count = def->defs_length;
|
||||
return janet_wrap_array(defs);
|
||||
}
|
||||
/* Add slotcount */
|
||||
janet_table_put(ret, janet_csymbolv("slotcount"), janet_wrap_integer(def->slotcount));
|
||||
|
||||
Janet janet_disasm(JanetFuncDef *def) {
|
||||
JanetTable *ret = janet_table(10);
|
||||
janet_table_put(ret, janet_ckeywordv("arity"), janet_disasm_arity(def));
|
||||
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_disasm_min_arity(def));
|
||||
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_disasm_max_arity(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("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("slotcount"), janet_disasm_slotcount(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("environments"), janet_disasm_environments(def));
|
||||
janet_table_put(ret, janet_ckeywordv("defs"), janet_disasm_defs(def));
|
||||
return janet_wrap_struct(janet_table_to_struct(ret));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_asm,
|
||||
"(asm assembly)",
|
||||
"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);
|
||||
/* C Function for assembly */
|
||||
static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
JanetAssembleResult res;
|
||||
res = janet_asm(argv[0], 0);
|
||||
if (res.status != JANET_ASSEMBLE_OK) {
|
||||
@@ -966,55 +947,33 @@ JANET_CORE_FN(cfun_asm,
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_disasm,
|
||||
"(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"
|
||||
"* :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);
|
||||
static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
JanetFunction *f = janet_getfunction(argv, 0);
|
||||
if (argc == 2) {
|
||||
JanetKeyword kw = janet_getkeyword(argv, 1);
|
||||
if (!janet_cstrcmp(kw, "arity")) return janet_disasm_arity(f->def);
|
||||
if (!janet_cstrcmp(kw, "min-arity")) return janet_disasm_min_arity(f->def);
|
||||
if (!janet_cstrcmp(kw, "max-arity")) return janet_disasm_max_arity(f->def);
|
||||
if (!janet_cstrcmp(kw, "bytecode")) return janet_disasm_bytecode(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, "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, "constants")) return janet_disasm_constants(f->def);
|
||||
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
||||
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);
|
||||
if (!janet_cstrcmp(kw, "defs")) return janet_disasm_defs(f->def);
|
||||
janet_panicf("unknown disasm key %v", argv[1]);
|
||||
} else {
|
||||
return janet_disasm(f->def);
|
||||
}
|
||||
return janet_disasm(f->def);
|
||||
}
|
||||
|
||||
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 wiki. Will throw an\n"
|
||||
"error on invalid assembly.")
|
||||
},
|
||||
{
|
||||
"disasm", cfun_disasm,
|
||||
JDOC("(disasm func)\n\n"
|
||||
"Returns assembly that could be used be compile the given function.\n"
|
||||
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||
"typed argument.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the library */
|
||||
void janet_lib_asm(JanetTable *env) {
|
||||
JanetRegExt 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);
|
||||
janet_core_cfuns(env, NULL, asm_cfuns);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -31,11 +31,12 @@
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity < 4) capacity = 4;
|
||||
janet_gcpressure(capacity);
|
||||
data = janet_malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
if (capacity > 0) {
|
||||
janet_gcpressure(capacity);
|
||||
data = malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
buffer->count = 0;
|
||||
buffer->capacity = capacity;
|
||||
@@ -45,7 +46,7 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
|
||||
/* Deinitialize a buffer (free data memory) */
|
||||
void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||
janet_free(buffer->data);
|
||||
free(buffer->data);
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
@@ -62,7 +63,7 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||
janet_gcpressure(capacity - buffer->capacity);
|
||||
new_data = janet_realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -91,8 +92,8 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
}
|
||||
int32_t new_size = buffer->count + n;
|
||||
if (new_size > buffer->capacity) {
|
||||
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));
|
||||
int32_t new_capacity = new_size * 2;
|
||||
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -162,38 +163,28 @@ void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||
|
||||
/* C functions */
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_new,
|
||||
"(buffer/new capacity)",
|
||||
"Creates a new, empty buffer with enough backing memory for `capacity` bytes. "
|
||||
"Returns a new buffer of length 0.") {
|
||||
static Janet cfun_buffer_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetBuffer *buffer = janet_buffer(cap);
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_new_filled,
|
||||
"(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.") {
|
||||
static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t count = janet_getinteger(argv, 0);
|
||||
if (count < 0) count = 0;
|
||||
int32_t byte = 0;
|
||||
if (argc == 2) {
|
||||
byte = janet_getinteger(argv, 1) & 0xFF;
|
||||
}
|
||||
JanetBuffer *buffer = janet_buffer(count);
|
||||
if (buffer->data && count > 0)
|
||||
if (buffer->data)
|
||||
memset(buffer->data, byte, count);
|
||||
buffer->count = count;
|
||||
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.") {
|
||||
static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t byte = 0;
|
||||
@@ -206,28 +197,7 @@ JANET_CORE_FN(cfun_buffer_fill,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_trim,
|
||||
"(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);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
if (buffer->count < buffer->capacity) {
|
||||
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
|
||||
uint8_t *newData = janet_realloc(buffer->data, newcap);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
buffer->data = newData;
|
||||
buffer->capacity = newcap;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_u8,
|
||||
"(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.") {
|
||||
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
@@ -237,11 +207,7 @@ JANET_CORE_FN(cfun_buffer_u8,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_word,
|
||||
"(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.") {
|
||||
static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
@@ -255,12 +221,7 @@ JANET_CORE_FN(cfun_buffer_word,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_chars,
|
||||
"(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.") {
|
||||
static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
@@ -275,45 +236,14 @@ JANET_CORE_FN(cfun_buffer_chars,
|
||||
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.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
||||
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
|
||||
} else {
|
||||
JanetByteView view = janet_getbytes(argv, i);
|
||||
if (view.bytes == buffer->data) {
|
||||
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
|
||||
view.bytes = buffer->data;
|
||||
}
|
||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||
}
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_clear,
|
||||
"(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.") {
|
||||
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
buffer->count = 0;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_popn,
|
||||
"(buffer/popn buffer n)",
|
||||
"Removes the last `n` bytes from the buffer. Returns the modified buffer.") {
|
||||
static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t n = janet_getinteger(argv, 1);
|
||||
@@ -326,12 +256,7 @@ JANET_CORE_FN(cfun_buffer_popn,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_slice,
|
||||
"(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.") {
|
||||
static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
||||
@@ -355,9 +280,7 @@ static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, int32_t *index, i
|
||||
*bit = which_bit;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_bitset,
|
||||
"(buffer/bit-set buffer index)",
|
||||
"Sets the bit at the given bit-index. Returns the buffer.") {
|
||||
static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
|
||||
int bit;
|
||||
int32_t index;
|
||||
JanetBuffer *buffer;
|
||||
@@ -366,9 +289,7 @@ JANET_CORE_FN(cfun_buffer_bitset,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_bitclear,
|
||||
"(buffer/bit-clear buffer index)",
|
||||
"Clears the bit at the given bit-index. Returns the buffer.") {
|
||||
static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
|
||||
int bit;
|
||||
int32_t index;
|
||||
JanetBuffer *buffer;
|
||||
@@ -377,9 +298,7 @@ JANET_CORE_FN(cfun_buffer_bitclear,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_bitget,
|
||||
"(buffer/bit buffer index)",
|
||||
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.") {
|
||||
static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
|
||||
int bit;
|
||||
int32_t index;
|
||||
JanetBuffer *buffer;
|
||||
@@ -387,9 +306,7 @@ JANET_CORE_FN(cfun_buffer_bitget,
|
||||
return janet_wrap_boolean(buffer->data[index] & (1 << bit));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_bittoggle,
|
||||
"(buffer/bit-toggle buffer index)",
|
||||
"Toggles the bit at the given bit index in buffer. Returns the buffer.") {
|
||||
static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
|
||||
int bit;
|
||||
int32_t index;
|
||||
JanetBuffer *buffer;
|
||||
@@ -398,11 +315,7 @@ JANET_CORE_FN(cfun_buffer_bittoggle,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_blit,
|
||||
"(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`.") {
|
||||
static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 5);
|
||||
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||
JanetByteView src = janet_getbytes(argv, 1);
|
||||
@@ -439,10 +352,7 @@ JANET_CORE_FN(cfun_buffer_blit,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_format,
|
||||
"(buffer/format buffer format & args)",
|
||||
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||
" the modified buffer.") {
|
||||
static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
const char *strfrmt = (const char *) janet_getstring(argv, 1);
|
||||
@@ -450,26 +360,100 @@ JANET_CORE_FN(cfun_buffer_format,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg buffer_cfuns[] = {
|
||||
{
|
||||
"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/push-byte", cfun_buffer_u8,
|
||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||
"Append a byte 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 x)\n\n"
|
||||
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
|
||||
"throw an error if the buffer overflows.")
|
||||
},
|
||||
{
|
||||
"buffer/push-string", cfun_buffer_chars,
|
||||
JDOC("(buffer/push-string buffer str)\n\n"
|
||||
"Push a string onto the end of a buffer. Non string values will be converted "
|
||||
"to strings before being pushed. 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 "
|
||||
" the modified buffer.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
void janet_lib_buffer(JanetTable *env) {
|
||||
JanetRegExt buffer_cfuns[] = {
|
||||
JANET_CORE_REG("buffer/new", cfun_buffer_new),
|
||||
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
|
||||
JANET_CORE_REG("buffer/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", cfun_buffer_push),
|
||||
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_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, buffer_cfuns);
|
||||
janet_core_cfuns(env, NULL, buffer_cfuns);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -101,13 +101,10 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_NEXT */
|
||||
JINT_SSS, /* JOP_NOT_EQUALS, */
|
||||
JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */
|
||||
JINT_SSS /* JOP_CANCEL, */
|
||||
};
|
||||
|
||||
/* Verify some bytecode */
|
||||
int janet_verify(JanetFuncDef *def) {
|
||||
int32_t janet_verify(JanetFuncDef *def) {
|
||||
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||
int32_t i;
|
||||
int32_t maxslot = def->arity + vargs;
|
||||
|
||||
117
src/core/capi.c
117
src/core/capi.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -27,43 +27,18 @@
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <pthread.h>
|
||||
#else
|
||||
#include <windows.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
#ifdef JANET_TOP_LEVEL_SIGNAL
|
||||
JANET_TOP_LEVEL_SIGNAL(msg);
|
||||
#else
|
||||
fputs(msg, stdout);
|
||||
# ifdef JANET_SINGLE_THREADED
|
||||
exit(-1);
|
||||
# elif defined(JANET_WINDOWS)
|
||||
ExitThread(-1);
|
||||
# else
|
||||
pthread_exit(NULL);
|
||||
# endif
|
||||
#endif
|
||||
}
|
||||
|
||||
void janet_signalv(JanetSignal sig, Janet message) {
|
||||
if (janet_vm.return_reg != NULL) {
|
||||
*janet_vm.return_reg = message;
|
||||
if (NULL != janet_vm.fiber) {
|
||||
janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP;
|
||||
}
|
||||
if (janet_vm_return_reg != NULL) {
|
||||
*janet_vm_return_reg = message;
|
||||
janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
_longjmp(*janet_vm.signal_buf, sig);
|
||||
_longjmp(*janet_vm_jmp_buf, sig);
|
||||
#else
|
||||
longjmp(*janet_vm.signal_buf, sig);
|
||||
longjmp(*janet_vm_jmp_buf, sig);
|
||||
#endif
|
||||
} else {
|
||||
const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message);
|
||||
janet_top_level_signal(str);
|
||||
fputs((const char *)janet_formatc("janet top level signal - %v\n", message), stdout);
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -79,7 +54,7 @@ void janet_panicf(const char *format, ...) {
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
janet_formatb(&buffer, format, args);
|
||||
va_end(args);
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
@@ -149,23 +124,6 @@ int janet_getmethod(const uint8_t *method, const JanetMethod *methods, Janet *ou
|
||||
return 0;
|
||||
}
|
||||
|
||||
Janet janet_nextmethod(const JanetMethod *methods, Janet key) {
|
||||
if (!janet_checktype(key, JANET_NIL)) {
|
||||
while (methods->name) {
|
||||
if (janet_keyeq(key, methods->name)) {
|
||||
methods++;
|
||||
break;
|
||||
}
|
||||
methods++;
|
||||
}
|
||||
}
|
||||
if (methods->name) {
|
||||
return janet_ckeywordv(methods->name);
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
DEFINE_GETTER(number, NUMBER, double)
|
||||
DEFINE_GETTER(array, ARRAY, JanetArray *)
|
||||
DEFINE_GETTER(tuple, TUPLE, const Janet *)
|
||||
@@ -212,7 +170,7 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||
const uint8_t *jstr = janet_getstring(argv, n);
|
||||
const char *cstr = (const char *)jstr;
|
||||
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||
janet_panic("string contains embedded 0s");
|
||||
janet_panicf("string %v contains embedded 0s");
|
||||
}
|
||||
return cstr;
|
||||
}
|
||||
@@ -260,27 +218,11 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
}
|
||||
|
||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||
#ifdef JANET_INTTYPES
|
||||
return janet_unwrap_s64(argv[n]);
|
||||
#else
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint64(x)) {
|
||||
janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x);
|
||||
}
|
||||
return (int64_t) janet_unwrap_number(x);
|
||||
#endif
|
||||
}
|
||||
|
||||
uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
|
||||
#ifdef JANET_INTTYPES
|
||||
return janet_unwrap_u64(argv[n]);
|
||||
#else
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint64(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) {
|
||||
@@ -293,20 +235,18 @@ size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||
|
||||
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length + 1;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
|
||||
return not_raw;
|
||||
if (raw < 0) raw += length + 1;
|
||||
if (raw < 0 || raw > length)
|
||||
janet_panicf("%s index %d out of range [0,%d]", which, raw, length);
|
||||
return raw;
|
||||
}
|
||||
|
||||
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
|
||||
return not_raw;
|
||||
if (raw < 0) raw += length;
|
||||
if (raw < 0 || raw > length)
|
||||
janet_panicf("%s index %d out of range [0,%d)", which, raw, length);
|
||||
return raw;
|
||||
}
|
||||
|
||||
JanetView janet_getindexed(const Janet *argv, int32_t n) {
|
||||
@@ -374,27 +314,20 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||
}
|
||||
|
||||
Janet janet_dyn(const char *name) {
|
||||
if (!janet_vm.fiber) {
|
||||
if (!janet_vm.top_dyns) return janet_wrap_nil();
|
||||
return janet_table_get(janet_vm.top_dyns, janet_ckeywordv(name));
|
||||
}
|
||||
if (janet_vm.fiber->env) {
|
||||
return janet_table_get(janet_vm.fiber->env, janet_ckeywordv(name));
|
||||
if (!janet_vm_fiber) return janet_wrap_nil();
|
||||
if (janet_vm_fiber->env) {
|
||||
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
void janet_setdyn(const char *name, Janet value) {
|
||||
if (!janet_vm.fiber) {
|
||||
if (!janet_vm.top_dyns) janet_vm.top_dyns = janet_table(10);
|
||||
janet_table_put(janet_vm.top_dyns, janet_ckeywordv(name), value);
|
||||
} else {
|
||||
if (!janet_vm.fiber->env) {
|
||||
janet_vm.fiber->env = janet_table(1);
|
||||
}
|
||||
janet_table_put(janet_vm.fiber->env, janet_ckeywordv(name), value);
|
||||
if (!janet_vm_fiber) return;
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(1);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||
}
|
||||
|
||||
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
|
||||
|
||||
134
src/core/cfuns.c
134
src/core/cfuns.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -33,11 +33,6 @@ static int arity1or2(JanetFopts opts, JanetSlot *args) {
|
||||
int32_t arity = janet_v_count(args);
|
||||
return arity == 1 || arity == 2;
|
||||
}
|
||||
static int arity2or3(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
int32_t arity = janet_v_count(args);
|
||||
return arity == 2 || arity == 3;
|
||||
}
|
||||
static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
return janet_v_count(args) == 1;
|
||||
@@ -95,67 +90,34 @@ static JanetSlot opfunction(
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Check if a value can be coerced to an immediate value */
|
||||
static int can_be_imm(Janet x, int8_t *out) {
|
||||
if (!janet_checkint(x)) return 0;
|
||||
int32_t integer = janet_unwrap_integer(x);
|
||||
if (integer > 127 || integer < -127) return 0;
|
||||
*out = (int8_t) integer;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Check if a slot can be coerced to an immediate value */
|
||||
static int can_slot_be_imm(JanetSlot s, int8_t *out) {
|
||||
if (!(s.flags & JANET_SLOT_CONSTANT)) return 0;
|
||||
return can_be_imm(s.constant, out);
|
||||
}
|
||||
|
||||
/* Emit a series of instructions instead of a function call to a math op */
|
||||
static JanetSlot opreduce(
|
||||
JanetFopts opts,
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
int opim,
|
||||
Janet nullary) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
int8_t imm = 0;
|
||||
int neg = opim < 0;
|
||||
if (opim < 0) opim = -opim;
|
||||
len = janet_v_count(args);
|
||||
JanetSlot t;
|
||||
if (len == 0) {
|
||||
return janetc_cslot(nullary);
|
||||
} else if (len == 1) {
|
||||
t = janetc_gettarget(opts);
|
||||
/* Special case subtract to be times -1 */
|
||||
if (op == JOP_SUBTRACT) {
|
||||
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||
}
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||
return t;
|
||||
}
|
||||
t = janetc_gettarget(opts);
|
||||
if (opim && can_slot_be_imm(args[1], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
}
|
||||
for (i = 2; i < len; i++) {
|
||||
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||
}
|
||||
}
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
for (i = 2; i < len; i++)
|
||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Function optimizers */
|
||||
|
||||
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_PROPAGATE, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||
@@ -172,40 +134,19 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
||||
return t;
|
||||
}
|
||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_IN, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
if (janet_v_count(args) == 3) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
JanetSlot t = janetc_gettarget(opts);
|
||||
int target_is_default = janetc_sequal(t, args[2]);
|
||||
JanetSlot dflt_slot = args[2];
|
||||
if (target_is_default) {
|
||||
dflt_slot = janetc_farslot(c);
|
||||
janetc_copy(c, dflt_slot, t);
|
||||
}
|
||||
janetc_emit_sss(c, JOP_GET, t, args[0], args[1], 1);
|
||||
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT_NIL, t, 0, 0);
|
||||
janetc_copy(c, t, dflt_slot);
|
||||
if (target_is_default) janetc_freeslot(c, dflt_slot);
|
||||
int32_t current = janet_v_count(c->buffer);
|
||||
c->buffer[label] |= (current - label) << 16;
|
||||
return t;
|
||||
} else {
|
||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
|
||||
}
|
||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
if (opts.flags & JANET_FOPTS_DROP) {
|
||||
@@ -231,9 +172,6 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
|
||||
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_cancel(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_CANCEL, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
/* Push phase */
|
||||
JanetCompiler *c = opts.compiler;
|
||||
@@ -262,34 +200,34 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
/* Variadic operators specialization */
|
||||
|
||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_SUBTRACT, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_MULTIPLY, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_DIVIDE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
|
||||
return opreduce(opts, args, JOP_BAND, janet_wrap_integer(-1));
|
||||
}
|
||||
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BOR, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BXOR, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
||||
return genericSS(opts, JOP_BNOT, args[0]);
|
||||
@@ -300,11 +238,9 @@ static JanetSlot compreduce(
|
||||
JanetFopts opts,
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
int opim,
|
||||
int invert) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
int8_t imm = 0;
|
||||
len = janet_v_count(args);
|
||||
int32_t *labels = NULL;
|
||||
JanetSlot t;
|
||||
@@ -315,17 +251,19 @@ static JanetSlot compreduce(
|
||||
}
|
||||
t = janetc_gettarget(opts);
|
||||
for (i = 1; i < len; i++) {
|
||||
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, args[i - 1], imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
|
||||
}
|
||||
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
|
||||
if (i != (len - 1)) {
|
||||
int32_t label = janetc_emit_si(c, invert ? JOP_JUMP_IF : JOP_JUMP_IF_NOT, t, 0, 1);
|
||||
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT, t, 0, 1);
|
||||
janet_v_push(labels, label);
|
||||
}
|
||||
}
|
||||
int32_t end = janet_v_count(c->buffer);
|
||||
if (invert) {
|
||||
janetc_emit_si(c, JOP_JUMP_IF, t, 3, 0);
|
||||
janetc_emit_s(c, JOP_LOAD_TRUE, t, 1);
|
||||
janetc_emit(c, JOP_JUMP | (2 << 8));
|
||||
janetc_emit_s(c, JOP_LOAD_FALSE, t, 1);
|
||||
}
|
||||
for (i = 0; i < janet_v_count(labels); i++) {
|
||||
int32_t label = labels[i];
|
||||
c->buffer[label] |= ((end - label) << 16);
|
||||
@@ -335,22 +273,22 @@ static JanetSlot compreduce(
|
||||
}
|
||||
|
||||
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_GREATER_THAN, JOP_GREATER_THAN_IMMEDIATE, 0);
|
||||
return compreduce(opts, args, JOP_GREATER_THAN, 0);
|
||||
}
|
||||
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_LESS_THAN, JOP_LESS_THAN_IMMEDIATE, 0);
|
||||
return compreduce(opts, args, JOP_LESS_THAN, 0);
|
||||
}
|
||||
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0, 0);
|
||||
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
|
||||
}
|
||||
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0, 0);
|
||||
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
|
||||
}
|
||||
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_EQUALS, JOP_EQUALS_IMMEDIATE, 0);
|
||||
return compreduce(opts, args, JOP_EQUALS, 0);
|
||||
}
|
||||
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, 1);
|
||||
return compreduce(opts, args, JOP_EQUALS, 1);
|
||||
}
|
||||
|
||||
/* Arranged by tag */
|
||||
@@ -381,12 +319,10 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{NULL, do_eq},
|
||||
{NULL, do_neq},
|
||||
{fixarity2, do_propagate},
|
||||
{arity2or3, do_get},
|
||||
{fixarity2, do_get},
|
||||
{arity1or2, do_next},
|
||||
{fixarity2, do_modulo},
|
||||
{fixarity2, do_remainder},
|
||||
{fixarity2, do_cmp},
|
||||
{fixarity2, do_cancel},
|
||||
};
|
||||
|
||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -53,36 +53,6 @@ void janetc_cerror(JanetCompiler *c, const char *m) {
|
||||
janetc_error(c, janet_cstring(m));
|
||||
}
|
||||
|
||||
static const char *janet_lint_level_names[] = {
|
||||
"relaxed",
|
||||
"normal",
|
||||
"strict"
|
||||
};
|
||||
|
||||
/* Emit compiler linter messages */
|
||||
void janetc_lintf(JanetCompiler *c, JanetCompileLintLevel level, const char *format, ...) {
|
||||
if (NULL != c->lints) {
|
||||
/* format message */
|
||||
va_list args;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
va_end(args);
|
||||
const uint8_t *str = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
/* construct linting payload */
|
||||
Janet *payload = janet_tuple_begin(4);
|
||||
payload[0] = janet_ckeywordv(janet_lint_level_names[level]);
|
||||
payload[1] = c->current_mapping.line == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.line);
|
||||
payload[2] = c->current_mapping.column == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.column);
|
||||
payload[3] = janet_wrap_string(str);
|
||||
janet_array_push(c->lints, janet_wrap_tuple(janet_tuple_end(payload)));
|
||||
}
|
||||
}
|
||||
|
||||
/* Free a slot */
|
||||
void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
|
||||
if (s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF | JANET_SLOT_NAMED)) return;
|
||||
@@ -197,39 +167,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 */
|
||||
JanetSlot janetc_resolve(
|
||||
JanetCompiler *c,
|
||||
@@ -262,62 +199,24 @@ JanetSlot janetc_resolve(
|
||||
|
||||
/* Symbol not found - check for global */
|
||||
{
|
||||
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) {
|
||||
Janet check;
|
||||
JanetBindingType btype = janet_resolve(c->env, sym, &check);
|
||||
switch (btype) {
|
||||
default:
|
||||
case JANET_BINDING_NONE:
|
||||
janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
case JANET_BINDING_DEF:
|
||||
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
||||
ret = janetc_cslot(binding.value);
|
||||
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;
|
||||
return janetc_cslot(check);
|
||||
case JANET_BINDING_VAR: {
|
||||
ret = janetc_cslot(binding.value);
|
||||
JanetSlot ret = janetc_cslot(check);
|
||||
/* TODO save type info */
|
||||
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
||||
ret.flags &= ~JANET_SLOT_CONSTANT;
|
||||
break;
|
||||
return ret;
|
||||
}
|
||||
}
|
||||
JanetCompileLintLevel depLevel = JANET_C_LINT_RELAXED;
|
||||
switch (binding.deprecation) {
|
||||
case JANET_BINDING_DEP_NONE:
|
||||
break;
|
||||
case JANET_BINDING_DEP_RELAXED:
|
||||
depLevel = JANET_C_LINT_RELAXED;
|
||||
break;
|
||||
case JANET_BINDING_DEP_NORMAL:
|
||||
depLevel = JANET_C_LINT_NORMAL;
|
||||
break;
|
||||
case JANET_BINDING_DEP_STRICT:
|
||||
depLevel = JANET_C_LINT_STRICT;
|
||||
break;
|
||||
}
|
||||
if (binding.deprecation != JANET_BINDING_DEP_NONE) {
|
||||
janetc_lintf(c, depLevel, "%q is deprecated", janet_wrap_symbol(sym));
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Symbol was found */
|
||||
@@ -500,7 +399,6 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
|
||||
int32_t mapbufstart = janet_v_count(c->mapbuffer);
|
||||
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
|
||||
janetc_value(opts, x);
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.2q", x);
|
||||
janetc_popscope(c);
|
||||
if (c->buffer) {
|
||||
janet_v__cnt(c->buffer) = bufstart;
|
||||
@@ -541,22 +439,22 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
min_arity = -1 - min_arity;
|
||||
if (min_arity > max && max >= 0) {
|
||||
const uint8_t *es = janet_formatc(
|
||||
"%v expects at most %d argument%s, got at least %d",
|
||||
fun.constant, max, max == 1 ? "" : "s", min_arity);
|
||||
"%v expects at most %d argument, got at least %d",
|
||||
fun.constant, max, min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
} else {
|
||||
/* Call has no splices */
|
||||
if (min_arity > max && max >= 0) {
|
||||
const uint8_t *es = janet_formatc(
|
||||
"%v expects at most %d argument%s, got %d",
|
||||
fun.constant, max, max == 1 ? "" : "s", min_arity);
|
||||
"%v expects at most %d argument, got %d",
|
||||
fun.constant, max, min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
if (min_arity < min) {
|
||||
const uint8_t *es = janet_formatc(
|
||||
"%v expects at least %d argument%s, got %d",
|
||||
fun.constant, min, min == 1 ? "" : "s", min_arity);
|
||||
"%v expects at least %d argument, got %d",
|
||||
fun.constant, min, min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
}
|
||||
@@ -606,40 +504,10 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
static JanetSlot janetc_maker(JanetFopts opts, JanetSlot *slots, int op) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
JanetSlot retslot;
|
||||
|
||||
/* Check if this structure is composed entirely of constants */
|
||||
int can_inline = 1;
|
||||
for (int32_t i = 0; i < janet_v_count(slots); i++) {
|
||||
if (!(slots[i].flags & JANET_SLOT_CONSTANT) ||
|
||||
(slots[i].flags & JANET_SLOT_SPLICED)) {
|
||||
can_inline = 0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if (can_inline && (op == JOP_MAKE_STRUCT)) {
|
||||
JanetKV *st = janet_struct_begin(janet_v_count(slots) / 2);
|
||||
for (int32_t i = 0; i < janet_v_count(slots); i += 2) {
|
||||
Janet k = slots[i].constant;
|
||||
Janet v = slots[i + 1].constant;
|
||||
janet_struct_put(st, k, v);
|
||||
}
|
||||
retslot = janetc_cslot(janet_wrap_struct(janet_struct_end(st)));
|
||||
janetc_freeslots(c, slots);
|
||||
} else if (can_inline && (op == JOP_MAKE_TUPLE)) {
|
||||
Janet *tup = janet_tuple_begin(janet_v_count(slots));
|
||||
for (int32_t i = 0; i < janet_v_count(slots); i++) {
|
||||
tup[i] = slots[i].constant;
|
||||
}
|
||||
retslot = janetc_cslot(janet_wrap_tuple(janet_tuple_end(tup)));
|
||||
janetc_freeslots(c, slots);
|
||||
} else {
|
||||
janetc_pushslots(c, slots);
|
||||
janetc_freeslots(c, slots);
|
||||
retslot = janetc_gettarget(opts);
|
||||
janetc_emit_s(c, op, retslot, 1);
|
||||
}
|
||||
|
||||
janetc_pushslots(c, slots);
|
||||
janetc_freeslots(c, slots);
|
||||
retslot = janetc_gettarget(opts);
|
||||
janetc_emit_s(c, op, retslot, 1);
|
||||
return retslot;
|
||||
}
|
||||
|
||||
@@ -705,7 +573,7 @@ static int macroexpand1(
|
||||
}
|
||||
Janet macroval;
|
||||
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))
|
||||
return 0;
|
||||
|
||||
@@ -728,14 +596,8 @@ static int macroexpand1(
|
||||
/* Set env */
|
||||
fiberp->env = c->env;
|
||||
int lock = janet_gclock();
|
||||
Janet mf_kw = janet_ckeywordv("macro-form");
|
||||
janet_table_put(c->env, mf_kw, x);
|
||||
Janet tempOut;
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
||||
janet_table_put(c->env, mf_kw, janet_wrap_nil());
|
||||
if (c->lints) {
|
||||
janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints));
|
||||
}
|
||||
janet_gcunlock(lock);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
|
||||
@@ -833,32 +695,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Add function flags to janet functions */
|
||||
void janet_def_addflags(JanetFuncDef *def) {
|
||||
int32_t set_flags = 0;
|
||||
int32_t unset_flags = 0;
|
||||
/* pos checks */
|
||||
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
/* negative checks */
|
||||
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
/* Update flags */
|
||||
def->flags |= set_flags;
|
||||
def->flags &= ~unset_flags;
|
||||
}
|
||||
|
||||
/* Compile a funcdef */
|
||||
/* Once the various other settings of the FuncDef have been tweaked,
|
||||
* call janet_def_addflags to set the proper flags for the funcdef */
|
||||
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
JanetScope *scope = c->scope;
|
||||
JanetFuncDef *def = janet_funcdef_alloc();
|
||||
@@ -880,7 +717,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
def->bytecode_length = janet_v_count(c->buffer) - scope->bytecode_start;
|
||||
if (def->bytecode_length) {
|
||||
size_t s = sizeof(int32_t) * (size_t) def->bytecode_length;
|
||||
def->bytecode = janet_malloc(s);
|
||||
def->bytecode = malloc(s);
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -888,7 +725,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
||||
if (NULL != c->mapbuffer && c->source) {
|
||||
size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length;
|
||||
def->sourcemap = janet_malloc(s);
|
||||
def->sourcemap = malloc(s);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -910,10 +747,8 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
/* Copy upvalue bitset */
|
||||
if (scope->ua.count) {
|
||||
/* Number of u32s we need to create a bitmask for all slots */
|
||||
int32_t slotchunks = (def->slotcount + 31) >> 5;
|
||||
/* numchunks is min of slotchunks and scope->ua.count */
|
||||
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
|
||||
uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
|
||||
int32_t numchunks = (def->slotcount + 31) >> 5;
|
||||
uint32_t *chunks = malloc(sizeof(uint32_t) * numchunks);
|
||||
if (NULL == chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -921,6 +756,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
|
||||
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
|
||||
def->closure_bitset = chunks;
|
||||
def->flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
}
|
||||
|
||||
/* Pop the scope */
|
||||
@@ -930,7 +766,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
/* Initialize a compiler */
|
||||
static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where, JanetArray *lints) {
|
||||
static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where) {
|
||||
c->scope = NULL;
|
||||
c->buffer = NULL;
|
||||
c->mapbuffer = NULL;
|
||||
@@ -939,7 +775,6 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where,
|
||||
c->source = where;
|
||||
c->current_mapping.line = -1;
|
||||
c->current_mapping.column = -1;
|
||||
c->lints = lints;
|
||||
/* Init result */
|
||||
c->result.error = NULL;
|
||||
c->result.status = JANET_COMPILE_OK;
|
||||
@@ -957,13 +792,12 @@ static void janetc_deinit(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
/* Compile a form. */
|
||||
JanetCompileResult janet_compile_lint(Janet source,
|
||||
JanetTable *env, const uint8_t *where, JanetArray *lints) {
|
||||
JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
|
||||
JanetCompiler c;
|
||||
JanetScope rootscope;
|
||||
JanetFopts fopts;
|
||||
|
||||
janetc_init(&c, env, where, lints);
|
||||
janetc_init(&c, env, where);
|
||||
|
||||
/* Push a function scope */
|
||||
janetc_scope(&rootscope, &c, JANET_SCOPE_FUNCTION | JANET_SCOPE_TOP, "root");
|
||||
@@ -979,7 +813,6 @@ JanetCompileResult janet_compile_lint(Janet source,
|
||||
if (c.result.status == JANET_COMPILE_OK) {
|
||||
JanetFuncDef *def = janetc_pop_funcdef(&c);
|
||||
def->name = janet_cstring("_thunk");
|
||||
janet_def_addflags(def);
|
||||
c.result.funcdef = def;
|
||||
} else {
|
||||
c.result.error_mapping = c.current_mapping;
|
||||
@@ -991,49 +824,26 @@ JanetCompileResult janet_compile_lint(Janet source,
|
||||
return c.result;
|
||||
}
|
||||
|
||||
JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
|
||||
return janet_compile_lint(source, env, where, NULL);
|
||||
}
|
||||
|
||||
/* C Function for compiling */
|
||||
JANET_CORE_FN(cfun,
|
||||
"(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);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
||||
static Janet cfun(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
|
||||
if (NULL == env) {
|
||||
env = janet_table(0);
|
||||
janet_vm.fiber->env = env;
|
||||
janet_vm_fiber->env = env;
|
||||
}
|
||||
const uint8_t *source = NULL;
|
||||
if (argc >= 3) {
|
||||
Janet x = 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 {
|
||||
janet_panic_type(x, 2, JANET_TFLAG_STRING | JANET_TFLAG_KEYWORD);
|
||||
}
|
||||
if (argc == 3) {
|
||||
source = janet_getstring(argv, 2);
|
||||
}
|
||||
JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
|
||||
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
|
||||
JanetCompileResult res = janet_compile(argv[0], env, source);
|
||||
if (res.status == JANET_COMPILE_OK) {
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
} else {
|
||||
JanetTable *t = janet_table(4);
|
||||
janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error));
|
||||
if (res.error_mapping.line > 0) {
|
||||
janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
|
||||
}
|
||||
if (res.error_mapping.column > 0) {
|
||||
janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
|
||||
}
|
||||
janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
|
||||
janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
|
||||
if (res.macrofiber) {
|
||||
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
|
||||
}
|
||||
@@ -1041,10 +851,18 @@ JANET_CORE_FN(cfun,
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetReg compile_cfuns[] = {
|
||||
{
|
||||
"compile", cfun,
|
||||
JDOC("(compile ast &opt env source)\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
"error if the ast cannot be compiled.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
void janet_lib_compile(JanetTable *env) {
|
||||
JanetRegExt cfuns[] = {
|
||||
JANET_CORE_REG("compile", cfun),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, cfuns);
|
||||
janet_core_cfuns(env, NULL, compile_cfuns);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -29,13 +29,6 @@
|
||||
#include "regalloc.h"
|
||||
#endif
|
||||
|
||||
/* Levels for compiler warnings */
|
||||
typedef enum {
|
||||
JANET_C_LINT_RELAXED,
|
||||
JANET_C_LINT_NORMAL,
|
||||
JANET_C_LINT_STRICT
|
||||
} JanetCompileLintLevel;
|
||||
|
||||
/* Tags for some functions for the prepared inliner */
|
||||
#define JANET_FUN_DEBUG 1
|
||||
#define JANET_FUN_ERROR 2
|
||||
@@ -67,8 +60,6 @@ typedef enum {
|
||||
#define JANET_FUN_NEXT 28
|
||||
#define JANET_FUN_MODULO 29
|
||||
#define JANET_FUN_REMAINDER 30
|
||||
#define JANET_FUN_CMP 31
|
||||
#define JANET_FUN_CANCEL 32
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct JanetCompiler JanetCompiler;
|
||||
@@ -85,10 +76,10 @@ typedef struct JanetSpecial JanetSpecial;
|
||||
#define JANET_SLOT_MUTABLE 0x40000
|
||||
#define JANET_SLOT_REF 0x80000
|
||||
#define JANET_SLOT_RETURNED 0x100000
|
||||
#define JANET_SLOT_DEP_NOTE 0x200000
|
||||
#define JANET_SLOT_DEP_WARN 0x400000
|
||||
#define JANET_SLOT_DEP_ERROR 0x800000
|
||||
#define JANET_SLOT_SPLICED 0x1000000
|
||||
/* Needed for handling single element arrays as global vars. */
|
||||
|
||||
/* Used for unquote-splicing */
|
||||
#define JANET_SLOT_SPLICED 0x200000
|
||||
|
||||
#define JANET_SLOTTYPE_ANY 0xFFFF
|
||||
|
||||
@@ -171,9 +162,6 @@ struct JanetCompiler {
|
||||
|
||||
/* Prevent unbounded recursion */
|
||||
int recursion_guard;
|
||||
|
||||
/* Collect linting results */
|
||||
JanetArray *lints;
|
||||
};
|
||||
|
||||
#define JANET_FOPTS_TAIL 0x10000
|
||||
@@ -240,9 +228,6 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s);
|
||||
void janetc_error(JanetCompiler *c, const uint8_t *m);
|
||||
void janetc_cerror(JanetCompiler *c, const char *m);
|
||||
|
||||
/* Linting */
|
||||
void janetc_lintf(JanetCompiler *C, JanetCompileLintLevel level, const char *format, ...);
|
||||
|
||||
/* Dispatch to correct form compiler */
|
||||
JanetSlot janetc_value(JanetFopts opts, Janet x);
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -35,19 +35,38 @@ extern const unsigned char *janet_core_image;
|
||||
extern size_t janet_core_image_size;
|
||||
#endif
|
||||
|
||||
/* Docstrings should only exist during bootstrap */
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
#define JDOC(x) (x)
|
||||
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
|
||||
* with native code. */
|
||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||
typedef int Clib;
|
||||
#define load_clib(name) ((void) name, 0)
|
||||
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
|
||||
#define error_clib() "dynamic libraries not supported"
|
||||
#elif defined(JANET_WINDOWS)
|
||||
#include <windows.h>
|
||||
typedef HINSTANCE Clib;
|
||||
#define load_clib(name) LoadLibrary((name))
|
||||
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
|
||||
static char error_clib_buf[256];
|
||||
static char *error_clib(void) {
|
||||
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
||||
error_clib_buf, sizeof(error_clib_buf), NULL);
|
||||
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
|
||||
return error_clib_buf;
|
||||
}
|
||||
#else
|
||||
#define JDOC(x) NULL
|
||||
#include <dlfcn.h>
|
||||
typedef void *Clib;
|
||||
#define load_clib(name) dlopen((name), RTLD_NOW)
|
||||
#define symbol_clib(lib, sym) dlsym((lib), (sym))
|
||||
#define error_clib() dlerror()
|
||||
#endif
|
||||
|
||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
char *processed_name = get_processed_name(name);
|
||||
Clib lib = load_clib(processed_name);
|
||||
Clib lib = load_clib(name);
|
||||
JanetModule init;
|
||||
JanetModconf getter;
|
||||
if (name != processed_name) janet_free(processed_name);
|
||||
if (!lib) {
|
||||
*error = janet_cstring(error_clib());
|
||||
return NULL;
|
||||
@@ -92,7 +111,7 @@ static const char *janet_dyncstring(const char *name, const char *dflt) {
|
||||
const uint8_t *jstr = janet_unwrap_string(x);
|
||||
const char *cstr = (const char *)jstr;
|
||||
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||
janet_panicf("string %v contains embedded 0s", x);
|
||||
janet_panicf("string %v contains embedded 0s");
|
||||
}
|
||||
return cstr;
|
||||
}
|
||||
@@ -105,18 +124,7 @@ static int is_path_sep(char c) {
|
||||
}
|
||||
|
||||
/* Used for module system. */
|
||||
JANET_CORE_FN(janet_core_expand_path,
|
||||
"(module/expand-path path template)",
|
||||
"Expands a path template as found in `module/paths` for `module/find`. "
|
||||
"This takes in a path (the argument to require) and a template string, "
|
||||
"to expand the path to a path that can be "
|
||||
"used for importing files. The replacements are as follows:\n\n"
|
||||
"* :all: -- the value of path verbatim\n\n"
|
||||
"* :cur: -- the current file, or (dyn :current-file)\n\n"
|
||||
"* :dir: -- the directory containing the current file\n\n"
|
||||
"* :name: -- the name component of path, with extension if given\n\n"
|
||||
"* :native: -- the extension used to load natives, .so or .dll\n\n"
|
||||
"* :sys: -- the system path, or (dyn :syspath)") {
|
||||
static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
const char *input = janet_getcstring(argv, 0);
|
||||
const char *template = janet_getcstring(argv, 1);
|
||||
@@ -239,13 +247,11 @@ JANET_CORE_FN(janet_core_expand_path,
|
||||
return janet_wrap_buffer(out);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_dyn,
|
||||
"(dyn key &opt default)",
|
||||
"Get a dynamic binding. Returns the default value (or nil) if no binding found.") {
|
||||
static Janet janet_core_dyn(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
Janet value;
|
||||
if (janet_vm.fiber->env) {
|
||||
value = janet_table_get(janet_vm.fiber->env, argv[0]);
|
||||
if (janet_vm_fiber->env) {
|
||||
value = janet_table_get(janet_vm_fiber->env, argv[0]);
|
||||
} else {
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
@@ -255,24 +261,16 @@ JANET_CORE_FN(janet_core_dyn,
|
||||
return value;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_setdyn,
|
||||
"(setdyn key value)",
|
||||
"Set a dynamic binding. Returns value.") {
|
||||
static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (!janet_vm.fiber->env) {
|
||||
janet_vm.fiber->env = janet_table(2);
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(2);
|
||||
}
|
||||
janet_table_put(janet_vm.fiber->env, argv[0], argv[1]);
|
||||
janet_table_put(janet_vm_fiber->env, argv[0], argv[1]);
|
||||
return argv[1];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_native,
|
||||
"(native path &opt env)",
|
||||
"Load a native module from the given path. The path "
|
||||
"must be an absolute or relative path on the file system, and is "
|
||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||
"Returns an environment table that contains functions and other values "
|
||||
"from the native module.") {
|
||||
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
JanetModule init;
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *path = janet_getstring(argv, 0);
|
||||
@@ -292,107 +290,67 @@ JANET_CORE_FN(janet_core_native,
|
||||
return janet_wrap_table(env);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_describe,
|
||||
"(describe x)",
|
||||
"Returns a string that is a human-readable description of `x`. "
|
||||
"For recursive data structures, the string returned contains a "
|
||||
"pointer value from which the identity of `x` "
|
||||
"can be determined.") {
|
||||
static Janet janet_core_describe(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_description_b(b, argv[i]);
|
||||
return janet_stringv(b->data, b->count);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_string,
|
||||
"(string & xs)",
|
||||
"Creates a string by concatenating the elements of `xs` together. If an "
|
||||
"element is not a byte sequence, it is converted to bytes via `describe`. "
|
||||
"Returns the new string.") {
|
||||
static Janet janet_core_string(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(b, argv[i]);
|
||||
return janet_stringv(b->data, b->count);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_symbol,
|
||||
"(symbol & xs)",
|
||||
"Creates a symbol by concatenating the elements of `xs` together. If an "
|
||||
"element is not a byte sequence, it is converted to bytes via `describe`. "
|
||||
"Returns the new symbol.") {
|
||||
static Janet janet_core_symbol(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(b, argv[i]);
|
||||
return janet_symbolv(b->data, b->count);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_keyword,
|
||||
"(keyword & xs)",
|
||||
"Creates a keyword by concatenating the elements of `xs` together. If an "
|
||||
"element is not a byte sequence, it is converted to bytes via `describe`. "
|
||||
"Returns the new keyword.") {
|
||||
static Janet janet_core_keyword(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(b, argv[i]);
|
||||
return janet_keywordv(b->data, b->count);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_buffer,
|
||||
"(buffer & xs)",
|
||||
"Creates a buffer by concatenating the elements of `xs` together. If an "
|
||||
"element is not a byte sequence, it is converted to bytes via `describe`. "
|
||||
"Returns the new buffer.") {
|
||||
static Janet janet_core_buffer(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(b, argv[i]);
|
||||
return janet_wrap_buffer(b);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_abstract,
|
||||
"(abstract? x)",
|
||||
"Check if x is an abstract type.") {
|
||||
static Janet janet_core_is_abstract(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktype(argv[0], JANET_ABSTRACT));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_scannumber,
|
||||
"(scan-number str &opt base)",
|
||||
"Parse a number from a byte sequence and return that number, either an integer "
|
||||
"or a real. The number "
|
||||
"must be in the same format as numbers in janet source code. Will return nil "
|
||||
"on an invalid number. Optionally provide a base - if a base is provided, no "
|
||||
"radix specifier is expected at the beginning of the number.") {
|
||||
static Janet janet_core_scannumber(int32_t argc, Janet *argv) {
|
||||
double number;
|
||||
janet_arity(argc, 1, 2);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
int32_t base = janet_optinteger(argv, argc, 1, 0);
|
||||
int valid = base == 0 || (base >= 2 && base <= 36);
|
||||
if (!valid) {
|
||||
janet_panicf("expected base between 2 and 36, got %d", base);
|
||||
}
|
||||
if (janet_scan_number_base(view.bytes, view.len, base, &number))
|
||||
if (janet_scan_number(view.bytes, view.len, &number))
|
||||
return janet_wrap_nil();
|
||||
return janet_wrap_number(number);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_tuple,
|
||||
"(tuple & items)",
|
||||
"Creates a new tuple that contains items. Returns the new tuple.") {
|
||||
static Janet janet_core_tuple(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_tuple(janet_tuple_n(argv, argc));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_array,
|
||||
"(array & items)",
|
||||
"Create a new array that contains items. Returns the new array.") {
|
||||
static Janet janet_core_array(int32_t argc, Janet *argv) {
|
||||
JanetArray *array = janet_array(argc);
|
||||
array->count = argc;
|
||||
safe_memcpy(array->data, argv, argc * sizeof(Janet));
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_slice,
|
||||
"(slice x &opt start end)",
|
||||
"Extract a sub-range of an indexed data structure or byte sequence.") {
|
||||
static Janet janet_core_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range;
|
||||
JanetByteView bview;
|
||||
JanetView iview;
|
||||
@@ -407,12 +365,7 @@ JANET_CORE_FN(janet_core_slice,
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_table,
|
||||
"(table & kvs)",
|
||||
"Creates a new table from a variadic number of keys and values. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new table.") {
|
||||
static Janet janet_core_table(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
if (argc & 1)
|
||||
janet_panic("expected even number of arguments");
|
||||
@@ -423,35 +376,10 @@ JANET_CORE_FN(janet_core_table,
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_getproto,
|
||||
"(getproto x)",
|
||||
"Get the prototype of a table or struct. Will return nil if `x` has no prototype.") {
|
||||
janet_fixarity(argc, 1);
|
||||
if (janet_checktype(argv[0], JANET_TABLE)) {
|
||||
JanetTable *t = janet_unwrap_table(argv[0]);
|
||||
return t->proto
|
||||
? janet_wrap_table(t->proto)
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
if (janet_checktype(argv[0], JANET_STRUCT)) {
|
||||
JanetStruct st = janet_unwrap_struct(argv[0]);
|
||||
return janet_struct_proto(st)
|
||||
? janet_wrap_struct(janet_struct_proto(st))
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
janet_panicf("expected struct|table, got %v", argv[0]);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_struct,
|
||||
"(struct & kvs)",
|
||||
"Create a new struct from a sequence of key value pairs. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new struct.") {
|
||||
static Janet janet_core_struct(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
if (argc & 1) {
|
||||
if (argc & 1)
|
||||
janet_panic("expected even number of arguments");
|
||||
}
|
||||
JanetKV *st = janet_struct_begin(argc >> 1);
|
||||
for (i = 0; i < argc; i += 2) {
|
||||
janet_struct_put(st, argv[i], argv[i + 1]);
|
||||
@@ -459,69 +387,37 @@ JANET_CORE_FN(janet_core_struct,
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_gensym,
|
||||
"(gensym)",
|
||||
"Returns a new symbol that is unique across the runtime. This means it "
|
||||
"will not collide with any already created symbols during compilation, so "
|
||||
"it can be used in macros to generate automatic bindings.") {
|
||||
static Janet janet_core_gensym(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_symbol(janet_symbol_gen());
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_gccollect,
|
||||
"(gccollect)",
|
||||
"Run garbage collection. You should probably not call this manually.") {
|
||||
static Janet janet_core_gccollect(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
(void) argc;
|
||||
janet_collect();
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_gcsetinterval,
|
||||
"(gcsetinterval interval)",
|
||||
"Set an integer number of bytes to allocate before running garbage collection. "
|
||||
"Low values for interval will be slower but use less memory. "
|
||||
"High values will be faster but use more memory.") {
|
||||
static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
size_t s = janet_getsize(argv, 0);
|
||||
/* limit interval to 48 bits */
|
||||
#ifdef JANET_64
|
||||
if (s >> 48) {
|
||||
if (s > 0xFFFFFFFFFFFFUl) {
|
||||
janet_panic("interval too large");
|
||||
}
|
||||
#endif
|
||||
janet_vm.gc_interval = s;
|
||||
janet_vm_gc_interval = s;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_gcinterval,
|
||||
"(gcinterval)",
|
||||
"Returns the integer number of bytes to allocate before running an iteration "
|
||||
"of garbage collection.") {
|
||||
static Janet janet_core_gcinterval(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number((double) janet_vm.gc_interval);
|
||||
return janet_wrap_number((double) janet_vm_gc_interval);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_type,
|
||||
"(type x)",
|
||||
"Returns the type of `x` as a keyword. `x` is one of:\n\n"
|
||||
"* :nil\n\n"
|
||||
"* :boolean\n\n"
|
||||
"* :number\n\n"
|
||||
"* :array\n\n"
|
||||
"* :tuple\n\n"
|
||||
"* :table\n\n"
|
||||
"* :struct\n\n"
|
||||
"* :string\n\n"
|
||||
"* :buffer\n\n"
|
||||
"* :symbol\n\n"
|
||||
"* :keyword\n\n"
|
||||
"* :function\n\n"
|
||||
"* :cfunction\n\n"
|
||||
"* :fiber\n\n"
|
||||
"or another keyword for an abstract type.") {
|
||||
static Janet janet_core_type(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetType t = janet_type(argv[0]);
|
||||
if (t == JANET_ABSTRACT) {
|
||||
@@ -531,24 +427,15 @@ JANET_CORE_FN(janet_core_type,
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_hash,
|
||||
"(hash value)",
|
||||
"Gets a hash for any value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all values. If two values are strictly equal, "
|
||||
"then they will have the same hash value.") {
|
||||
static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_number(janet_hash(argv[0]));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_getline,
|
||||
"(getline &opt prompt buf env)",
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. "
|
||||
"An optional environment table can be provided for auto-complete. "
|
||||
"Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.") {
|
||||
static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
FILE *in = janet_dynfile("in", stdin);
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
janet_arity(argc, 0, 3);
|
||||
janet_arity(argc, 0, 2);
|
||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||
if (argc >= 1) {
|
||||
const char *prompt = (const char *) janet_getstring(argv, 0);
|
||||
@@ -570,27 +457,21 @@ JANET_CORE_FN(janet_core_getline,
|
||||
return janet_wrap_buffer(buf);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_trace,
|
||||
"(trace func)",
|
||||
"Enable tracing on a function. Returns the function.") {
|
||||
static Janet janet_core_trace(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
func->gc.flags |= JANET_FUNCFLAG_TRACE;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_untrace,
|
||||
"(untrace func)",
|
||||
"Disables tracing on a function. Returns the function.") {
|
||||
static Janet janet_core_untrace(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
func->gc.flags &= ~JANET_FUNCFLAG_TRACE;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_check_int,
|
||||
"(int? x)",
|
||||
"Check if x can be exactly represented as a 32 bit signed two's complement integer.") {
|
||||
static Janet janet_core_check_int(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
@@ -599,9 +480,7 @@ ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_check_nat,
|
||||
"(nat? x)",
|
||||
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.") {
|
||||
static Janet janet_core_check_nat(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
@@ -610,9 +489,7 @@ ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_signal,
|
||||
"(signal what x)",
|
||||
"Raise a signal with payload x. ") {
|
||||
static Janet janet_core_signal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
int sig;
|
||||
if (janet_checkint(argv[0])) {
|
||||
@@ -623,20 +500,213 @@ JANET_CORE_FN(janet_core_signal,
|
||||
sig = JANET_SIGNAL_USER0 + s;
|
||||
} else {
|
||||
JanetKeyword kw = janet_getkeyword(argv, 0);
|
||||
if (!janet_cstrcmp(kw, "yield")) {
|
||||
sig = JANET_SIGNAL_YIELD;
|
||||
} else if (!janet_cstrcmp(kw, "error")) {
|
||||
sig = JANET_SIGNAL_ERROR;
|
||||
} else if (!janet_cstrcmp(kw, "debug")) {
|
||||
sig = JANET_SIGNAL_DEBUG;
|
||||
} else {
|
||||
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
|
||||
}
|
||||
if (!janet_cstrcmp(kw, "yield")) sig = JANET_SIGNAL_YIELD;
|
||||
if (!janet_cstrcmp(kw, "error")) sig = JANET_SIGNAL_ERROR;
|
||||
if (!janet_cstrcmp(kw, "debug")) sig = JANET_SIGNAL_DEBUG;
|
||||
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
|
||||
}
|
||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
janet_signalv(sig, payload);
|
||||
}
|
||||
|
||||
static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"native", janet_core_native,
|
||||
JDOC("(native path &opt env)\n\n"
|
||||
"Load a native module from the given path. The path "
|
||||
"must be an absolute or relative path on the file system, and is "
|
||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||
"Returns an environment table that contains functions and other values "
|
||||
"from the native module.")
|
||||
},
|
||||
{
|
||||
"describe", janet_core_describe,
|
||||
JDOC("(describe x)\n\n"
|
||||
"Returns a string that is a human readable description of a value x.")
|
||||
},
|
||||
{
|
||||
"string", janet_core_string,
|
||||
JDOC("(string & parts)\n\n"
|
||||
"Creates a string by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. "
|
||||
"Returns the new string.")
|
||||
},
|
||||
{
|
||||
"symbol", janet_core_symbol,
|
||||
JDOC("(symbol & xs)\n\n"
|
||||
"Creates a symbol by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new symbol.")
|
||||
},
|
||||
{
|
||||
"keyword", janet_core_keyword,
|
||||
JDOC("(keyword & xs)\n\n"
|
||||
"Creates a keyword by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new keyword.")
|
||||
},
|
||||
{
|
||||
"buffer", janet_core_buffer,
|
||||
JDOC("(buffer & xs)\n\n"
|
||||
"Creates a new buffer by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new buffer.")
|
||||
},
|
||||
{
|
||||
"abstract?", janet_core_is_abstract,
|
||||
JDOC("(abstract? x)\n\n"
|
||||
"Check if x is an abstract type.")
|
||||
},
|
||||
{
|
||||
"table", janet_core_table,
|
||||
JDOC("(table & kvs)\n\n"
|
||||
"Creates a new table from a variadic number of keys and values. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new table.")
|
||||
},
|
||||
{
|
||||
"array", janet_core_array,
|
||||
JDOC("(array & items)\n\n"
|
||||
"Create a new array that contains items. Returns the new array.")
|
||||
},
|
||||
{
|
||||
"scan-number", janet_core_scannumber,
|
||||
JDOC("(scan-number str)\n\n"
|
||||
"Parse a number from a byte sequence an return that number, either and integer "
|
||||
"or a real. The number "
|
||||
"must be in the same format as numbers in janet source code. Will return nil "
|
||||
"on an invalid number.")
|
||||
},
|
||||
{
|
||||
"tuple", janet_core_tuple,
|
||||
JDOC("(tuple & items)\n\n"
|
||||
"Creates a new tuple that contains items. Returns the new tuple.")
|
||||
},
|
||||
{
|
||||
"struct", janet_core_struct,
|
||||
JDOC("(struct & kvs)\n\n"
|
||||
"Create a new struct from a sequence of key value pairs. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new struct.")
|
||||
},
|
||||
{
|
||||
"gensym", janet_core_gensym,
|
||||
JDOC("(gensym)\n\n"
|
||||
"Returns a new symbol that is unique across the runtime. This means it "
|
||||
"will not collide with any already created symbols during compilation, so "
|
||||
"it can be used in macros to generate automatic bindings.")
|
||||
},
|
||||
{
|
||||
"gccollect", janet_core_gccollect,
|
||||
JDOC("(gccollect)\n\n"
|
||||
"Run garbage collection. You should probably not call this manually.")
|
||||
},
|
||||
{
|
||||
"gcsetinterval", janet_core_gcsetinterval,
|
||||
JDOC("(gcsetinterval interval)\n\n"
|
||||
"Set an integer number of bytes to allocate before running garbage collection. "
|
||||
"Low values for interval will be slower but use less memory. "
|
||||
"High values will be faster but use more memory.")
|
||||
},
|
||||
{
|
||||
"gcinterval", janet_core_gcinterval,
|
||||
JDOC("(gcinterval)\n\n"
|
||||
"Returns the integer number of bytes to allocate before running an iteration "
|
||||
"of garbage collection.")
|
||||
},
|
||||
{
|
||||
"type", janet_core_type,
|
||||
JDOC("(type x)\n\n"
|
||||
"Returns the type of x as a keyword. x is one of\n"
|
||||
"\t:nil\n"
|
||||
"\t:boolean\n"
|
||||
"\t:number\n"
|
||||
"\t:array\n"
|
||||
"\t:tuple\n"
|
||||
"\t:table\n"
|
||||
"\t:struct\n"
|
||||
"\t:string\n"
|
||||
"\t:buffer\n"
|
||||
"\t:symbol\n"
|
||||
"\t:keyword\n"
|
||||
"\t:function\n"
|
||||
"\t:cfunction\n\n"
|
||||
"or another keyword for an abstract type.")
|
||||
},
|
||||
{
|
||||
"hash", janet_core_hash,
|
||||
JDOC("(hash value)\n\n"
|
||||
"Gets a hash value for any janet value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
||||
"then they will have the same hash value.")
|
||||
},
|
||||
{
|
||||
"getline", janet_core_getline,
|
||||
JDOC("(getline &opt prompt buf env)\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. "
|
||||
"An optional environment table can be provided for autocomplete. "
|
||||
"Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
{
|
||||
"dyn", janet_core_dyn,
|
||||
JDOC("(dyn key &opt default)\n\n"
|
||||
"Get a dynamic binding. Returns the default value (or nil) if no binding found.")
|
||||
},
|
||||
{
|
||||
"setdyn", janet_core_setdyn,
|
||||
JDOC("(setdyn key value)\n\n"
|
||||
"Set a dynamic binding. Returns value.")
|
||||
},
|
||||
{
|
||||
"trace", janet_core_trace,
|
||||
JDOC("(trace func)\n\n"
|
||||
"Enable tracing on a function. Returns the function.")
|
||||
},
|
||||
{
|
||||
"untrace", janet_core_untrace,
|
||||
JDOC("(untrace func)\n\n"
|
||||
"Disables tracing on a function. Returns the function.")
|
||||
},
|
||||
{
|
||||
"module/expand-path", janet_core_expand_path,
|
||||
JDOC("(module/expand-path path template)\n\n"
|
||||
"Expands a path template as found in module/paths for module/find. "
|
||||
"This takes in a path (the argument to require) and a template string, template, "
|
||||
"to expand the path to a path that can be "
|
||||
"used for importing files. The replacements are as follows:\n\n"
|
||||
"\t:all:\tthe value of path verbatim\n"
|
||||
"\t:cur:\tthe current file, or (dyn :current-file)\n"
|
||||
"\t:dir:\tthe directory containing the current file\n"
|
||||
"\t:name:\tthe filename component of path, with extenion if given\n"
|
||||
"\t:native:\tthe extension used to load natives, .so or .dll\n"
|
||||
"\t:sys:\tthe system path, or (syn :syspath)")
|
||||
},
|
||||
{
|
||||
"int?", janet_core_check_int,
|
||||
JDOC("(int? x)\n\n"
|
||||
"Check if x can be exactly represented as a 32 bit signed two's complement integer.")
|
||||
},
|
||||
{
|
||||
"nat?", janet_core_check_nat,
|
||||
JDOC("(nat? x)\n\n"
|
||||
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.")
|
||||
},
|
||||
{
|
||||
"slice", janet_core_slice,
|
||||
JDOC("(slice x &opt start end)\n\n"
|
||||
"Extract a sub-range of an indexed data strutrue or byte sequence.")
|
||||
},
|
||||
{
|
||||
"signal", janet_core_signal,
|
||||
JDOC("(signal what x)\n\n"
|
||||
"Raise a signal with payload x. ")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
|
||||
/* Utility for inline assembly */
|
||||
@@ -657,18 +727,17 @@ static void janet_quick_asm(
|
||||
def->max_arity = max_arity;
|
||||
def->flags = flags;
|
||||
def->slotcount = slots;
|
||||
def->bytecode = janet_malloc(bytecode_size);
|
||||
def->bytecode = malloc(bytecode_size);
|
||||
def->bytecode_length = (int32_t)(bytecode_size / sizeof(uint32_t));
|
||||
def->name = janet_cstring(name);
|
||||
if (!def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(def->bytecode, bytecode, bytecode_size);
|
||||
janet_def_addflags(def);
|
||||
janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc);
|
||||
}
|
||||
|
||||
/* Macros for easier inline assembly */
|
||||
/* Macros for easier inline janet assembly */
|
||||
#define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24))
|
||||
#define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16))
|
||||
#define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24))
|
||||
@@ -850,10 +919,6 @@ static const uint32_t resume_asm[] = {
|
||||
JOP_RESUME | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t cancel_asm[] = {
|
||||
JOP_CANCEL | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t in_asm[] = {
|
||||
JOP_IN | (1 << 24),
|
||||
JOP_LOAD_NIL | (3 << 8),
|
||||
@@ -898,10 +963,6 @@ static const uint32_t remainder_asm[] = {
|
||||
JOP_REMAINDER | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t cmp_asm[] = {
|
||||
JOP_COMPARE | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
#endif /* ifdef JANET_BOOTSTRAP */
|
||||
|
||||
/*
|
||||
@@ -909,46 +970,13 @@ static const uint32_t cmp_asm[] = {
|
||||
*/
|
||||
|
||||
static void janet_load_libs(JanetTable *env) {
|
||||
JanetRegExt corelib_cfuns[] = {
|
||||
JANET_CORE_REG("native", janet_core_native),
|
||||
JANET_CORE_REG("describe", janet_core_describe),
|
||||
JANET_CORE_REG("string", janet_core_string),
|
||||
JANET_CORE_REG("symbol", janet_core_symbol),
|
||||
JANET_CORE_REG("keyword", janet_core_keyword),
|
||||
JANET_CORE_REG("buffer", janet_core_buffer),
|
||||
JANET_CORE_REG("abstract?", janet_core_is_abstract),
|
||||
JANET_CORE_REG("table", janet_core_table),
|
||||
JANET_CORE_REG("array", janet_core_array),
|
||||
JANET_CORE_REG("scan-number", janet_core_scannumber),
|
||||
JANET_CORE_REG("tuple", janet_core_tuple),
|
||||
JANET_CORE_REG("struct", janet_core_struct),
|
||||
JANET_CORE_REG("gensym", janet_core_gensym),
|
||||
JANET_CORE_REG("gccollect", janet_core_gccollect),
|
||||
JANET_CORE_REG("gcsetinterval", janet_core_gcsetinterval),
|
||||
JANET_CORE_REG("gcinterval", janet_core_gcinterval),
|
||||
JANET_CORE_REG("type", janet_core_type),
|
||||
JANET_CORE_REG("hash", janet_core_hash),
|
||||
JANET_CORE_REG("getline", janet_core_getline),
|
||||
JANET_CORE_REG("dyn", janet_core_dyn),
|
||||
JANET_CORE_REG("setdyn", janet_core_setdyn),
|
||||
JANET_CORE_REG("trace", janet_core_trace),
|
||||
JANET_CORE_REG("untrace", janet_core_untrace),
|
||||
JANET_CORE_REG("module/expand-path", janet_core_expand_path),
|
||||
JANET_CORE_REG("int?", janet_core_check_int),
|
||||
JANET_CORE_REG("nat?", janet_core_check_nat),
|
||||
JANET_CORE_REG("slice", janet_core_slice),
|
||||
JANET_CORE_REG("signal", janet_core_signal),
|
||||
JANET_CORE_REG("getproto", janet_core_getproto),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, corelib_cfuns);
|
||||
janet_core_cfuns(env, NULL, corelib_cfuns);
|
||||
janet_lib_io(env);
|
||||
janet_lib_math(env);
|
||||
janet_lib_array(env);
|
||||
janet_lib_tuple(env);
|
||||
janet_lib_buffer(env);
|
||||
janet_lib_table(env);
|
||||
janet_lib_struct(env);
|
||||
janet_lib_fiber(env);
|
||||
janet_lib_os(env);
|
||||
janet_lib_parse(env);
|
||||
@@ -962,17 +990,14 @@ static void janet_load_libs(JanetTable *env) {
|
||||
#ifdef JANET_ASSEMBLER
|
||||
janet_lib_asm(env);
|
||||
#endif
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
janet_lib_typed_array(env);
|
||||
#endif
|
||||
#ifdef JANET_INT_TYPES
|
||||
janet_lib_inttypes(env);
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
janet_lib_ev(env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_lib_net(env);
|
||||
#endif
|
||||
#ifdef JANET_FFI
|
||||
janet_lib_ffi(env);
|
||||
#ifdef JANET_THREADS
|
||||
janet_lib_thread(env);
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -988,15 +1013,10 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_CMP,
|
||||
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
|
||||
JDOC("(cmp x y)\n\n"
|
||||
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
|
||||
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
|
||||
janet_quick_asm(env, JANET_FUN_NEXT,
|
||||
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
|
||||
JDOC("(next ds &opt key)\n\n"
|
||||
"Gets the next key in a data structure. Can be used to iterate through "
|
||||
"Gets the next key in a datastructure. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
@@ -1007,8 +1027,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"Propagate a signal from a fiber to the current fiber. The resulting "
|
||||
"stack trace from the current fiber will include frames from fiber. If "
|
||||
"fiber is in a state that can be resumed, resuming the current fiber will "
|
||||
"first resume fiber. This function can be used to re-raise an error without "
|
||||
"losing the original stack trace."));
|
||||
"first resume fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
||||
JDOC("(debug &opt x)\n\n"
|
||||
@@ -1024,11 +1043,6 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
janet_quick_asm(env, JANET_FUN_CANCEL,
|
||||
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
|
||||
JDOC("(cancel fiber err)\n\n"
|
||||
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
|
||||
"Returns the same result as resume."));
|
||||
janet_quick_asm(env, JANET_FUN_RESUME,
|
||||
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
|
||||
JDOC("(resume fiber &opt x)\n\n"
|
||||
@@ -1085,7 +1099,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JDOC("(/ & xs)\n\n"
|
||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values."));
|
||||
"values. Division by two integers uses truncating division."));
|
||||
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
||||
JDOC("(band & xs)\n\n"
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
@@ -1139,8 +1153,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"if native modules are compatible with the host program."));
|
||||
|
||||
/* Allow references to the environment */
|
||||
janet_def(env, "root-env", janet_wrap_table(env),
|
||||
JDOC("The root environment used to create environments with (make-env)."));
|
||||
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
||||
|
||||
janet_load_libs(env);
|
||||
janet_gcroot(janet_wrap_table(env));
|
||||
@@ -1151,11 +1164,26 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Memoize core env, ignoring replacements the second time around. */
|
||||
if (NULL != janet_vm.core_env) {
|
||||
return janet_vm.core_env;
|
||||
if (NULL != janet_vm_core_env) {
|
||||
return janet_vm_core_env;
|
||||
}
|
||||
|
||||
JanetTable *dict = janet_core_lookup_table(replacements);
|
||||
/* Load core cfunctions (and some built in janet assembly functions) */
|
||||
JanetTable *dict = janet_table(300);
|
||||
janet_load_libs(dict);
|
||||
|
||||
/* Add replacements */
|
||||
if (replacements != NULL) {
|
||||
for (int32_t i = 0; i < replacements->capacity; i++) {
|
||||
JanetKV kv = replacements->data[i];
|
||||
if (!janet_checktype(kv.key, JANET_NIL)) {
|
||||
janet_table_put(dict, kv.key, kv.value);
|
||||
if (janet_checktype(kv.value, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, kv.value, kv.key);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Unmarshal bytecode */
|
||||
Janet marsh_out = janet_unmarshal(
|
||||
@@ -1168,42 +1196,9 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Memoize */
|
||||
janet_gcroot(marsh_out);
|
||||
JanetTable *env = janet_unwrap_table(marsh_out);
|
||||
janet_vm.core_env = env;
|
||||
|
||||
/* Invert image dict manually here. We can't do this in boot.janet as it
|
||||
* breaks deterministic builds */
|
||||
Janet lidv, midv;
|
||||
lidv = midv = janet_wrap_nil();
|
||||
janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
|
||||
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
|
||||
JanetTable *lid = janet_unwrap_table(lidv);
|
||||
JanetTable *mid = janet_unwrap_table(midv);
|
||||
for (int32_t i = 0; i < lid->capacity; i++) {
|
||||
const JanetKV *kv = lid->data + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_table_put(mid, kv->value, kv->key);
|
||||
}
|
||||
}
|
||||
janet_vm_core_env = env;
|
||||
|
||||
return env;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
JanetTable *janet_core_lookup_table(JanetTable *replacements) {
|
||||
JanetTable *dict = janet_table(512);
|
||||
janet_load_libs(dict);
|
||||
|
||||
/* Add replacements */
|
||||
if (replacements != NULL) {
|
||||
for (int32_t i = 0; i < replacements->capacity; i++) {
|
||||
JanetKV kv = replacements->data[i];
|
||||
if (!janet_checktype(kv.key, JANET_NIL)) {
|
||||
janet_table_put(dict, kv.key, kv.value);
|
||||
/* Add replacement functions to registry? */
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return dict;
|
||||
}
|
||||
|
||||
219
src/core/debug.c
219
src/core/debug.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -55,7 +55,7 @@ void janet_debug_find(
|
||||
JanetFuncDef **def_out, int32_t *pc_out,
|
||||
const uint8_t *source, int32_t sourceLine, int32_t sourceColumn) {
|
||||
/* 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 */
|
||||
int32_t besti = -1;
|
||||
int32_t best_line = -1;
|
||||
@@ -86,7 +86,7 @@ void janet_debug_find(
|
||||
}
|
||||
}
|
||||
}
|
||||
current = current->data.next;
|
||||
current = current->next;
|
||||
}
|
||||
if (best_def) {
|
||||
*def_out = best_def;
|
||||
@@ -96,19 +96,13 @@ 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
|
||||
* 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;
|
||||
const char *errstr = (const char *)janet_to_string(err);
|
||||
JanetFiber **fibers = NULL;
|
||||
int wrote_error = !prefix;
|
||||
int wrote_error = 0;
|
||||
|
||||
int print_color = janet_truthy(janet_dyn("err-color"));
|
||||
if (print_color) janet_eprintf("\x1b[31m");
|
||||
@@ -122,7 +116,6 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||
fiber = fibers[fi];
|
||||
int32_t i = fiber->frame;
|
||||
while (i > 0) {
|
||||
JanetCFunRegistry *reg = NULL;
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
JanetFuncDef *def = NULL;
|
||||
i = frame->prevframe;
|
||||
@@ -130,6 +123,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||
/* Print prelude to stack frame */
|
||||
if (!wrote_error) {
|
||||
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
|
||||
janet_eprintf("%s%s: %s\n",
|
||||
prefix,
|
||||
janet_status_names[status],
|
||||
@@ -148,19 +142,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||
} else {
|
||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||
if (cfun) {
|
||||
reg = janet_registry_get(cfun);
|
||||
if (NULL != reg && NULL != reg->name) {
|
||||
if (reg->name_prefix) {
|
||||
janet_eprintf(" %s/%s", reg->name_prefix, reg->name);
|
||||
} else {
|
||||
janet_eprintf(" %s", reg->name);
|
||||
}
|
||||
if (NULL != reg->source_file) {
|
||||
janet_eprintf(" [%s]", reg->source_file);
|
||||
}
|
||||
} else {
|
||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||
if (!janet_checktype(name, JANET_NIL))
|
||||
janet_eprintf(" %s", (const char *)janet_to_string(name));
|
||||
else
|
||||
janet_eprintf(" <cfunction>");
|
||||
}
|
||||
}
|
||||
}
|
||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||
@@ -173,11 +159,6 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||
} else {
|
||||
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");
|
||||
}
|
||||
@@ -212,13 +193,7 @@ static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32
|
||||
*bytecode_offset = offset;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_debug_break,
|
||||
"(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.") {
|
||||
static Janet cfun_debug_break(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
helper_find(argc, argv, &def, &offset);
|
||||
@@ -226,11 +201,7 @@ JANET_CORE_FN(cfun_debug_break,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_debug_unbreak,
|
||||
"(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.") {
|
||||
static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset = 0;
|
||||
helper_find(argc, argv, &def, &offset);
|
||||
@@ -238,11 +209,7 @@ JANET_CORE_FN(cfun_debug_unbreak,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_debug_fbreak,
|
||||
"(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.") {
|
||||
static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset = 0;
|
||||
helper_find_fun(argc, argv, &def, &offset);
|
||||
@@ -250,9 +217,7 @@ JANET_CORE_FN(cfun_debug_fbreak,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_debug_unfbreak,
|
||||
"(debug/unfbreak fun &opt pc)",
|
||||
"Unset a breakpoint set with debug/fbreak.") {
|
||||
static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
helper_find_fun(argc, argv, &def, &offset);
|
||||
@@ -260,12 +225,7 @@ JANET_CORE_FN(cfun_debug_unfbreak,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_debug_lineage,
|
||||
"(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.") {
|
||||
static Janet cfun_debug_lineage(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(0);
|
||||
@@ -290,20 +250,9 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
} else {
|
||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||
if (cfun) {
|
||||
JanetCFunRegistry *reg = janet_registry_get(cfun);
|
||||
if (NULL != reg->name) {
|
||||
if (NULL != reg->name_prefix) {
|
||||
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 name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||
if (!janet_checktype(name, JANET_NIL)) {
|
||||
janet_table_put(t, janet_ckeywordv("name"), name);
|
||||
}
|
||||
}
|
||||
janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());
|
||||
@@ -333,21 +282,7 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_debug_stack,
|
||||
"(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") {
|
||||
static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(0);
|
||||
@@ -363,24 +298,14 @@ JANET_CORE_FN(cfun_debug_stack,
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_debug_stacktrace,
|
||||
"(debug/stacktrace fiber &opt err prefix)",
|
||||
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
|
||||
"an error value to print the stack trace with. If `err` is nil or not "
|
||||
"provided, and no prefix is given, will skip the error line. Returns the fiber.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
|
||||
const char *prefix = janet_optcstring(argv, argc, 2, NULL);
|
||||
janet_stacktrace_ext(fiber, x, prefix);
|
||||
janet_stacktrace(fiber, argv[1]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_debug_argstack,
|
||||
"(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.") {
|
||||
static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
|
||||
@@ -389,11 +314,7 @@ JANET_CORE_FN(cfun_debug_argstack,
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_debug_step,
|
||||
"(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.") {
|
||||
static Janet cfun_debug_step(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet out = janet_wrap_nil();
|
||||
@@ -401,19 +322,85 @@ JANET_CORE_FN(cfun_debug_step,
|
||||
return out;
|
||||
}
|
||||
|
||||
static const JanetReg debug_cfuns[] = {
|
||||
{
|
||||
"debug/break", cfun_debug_break,
|
||||
JDOC("(debug/break source byte-offset)\n\n"
|
||||
"Sets a breakpoint with source a key 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\" 1000)\n\n"
|
||||
"wil set a breakpoint at the 1000th byte 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"
|
||||
"\t:c - true if the stack frame is a c function invocation\n"
|
||||
"\t:column - the current source column of the stack frame\n"
|
||||
"\t:function - the function that the stack frame represents\n"
|
||||
"\t:line - the current source line of the stack frame\n"
|
||||
"\t:name - the human friendly name of the function\n"
|
||||
"\t:pc - integer indicating the location of the program counter\n"
|
||||
"\t:source - string with the file path or other identifier for the source code\n"
|
||||
"\t:slots - array of all values in each slot\n"
|
||||
"\t:tail - boolean indicating a tail call")
|
||||
},
|
||||
{
|
||||
"debug/stacktrace", cfun_debug_stacktrace,
|
||||
JDOC("(debug/stacktrace fiber err)\n\n"
|
||||
"Prints a nice looking stacktrace for a fiber. The error message "
|
||||
"err must be passed to the function as fiber's do not keep track of "
|
||||
"the last error they have thrown. 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 */
|
||||
void janet_lib_debug(JanetTable *env) {
|
||||
JanetRegExt 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);
|
||||
janet_core_cfuns(env, NULL, debug_cfuns);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -37,7 +37,7 @@ int32_t janetc_allocfar(JanetCompiler *c) {
|
||||
return reg;
|
||||
}
|
||||
|
||||
/* Get a register less than 256 for temporary use. */
|
||||
/* Get a register less than 256 */
|
||||
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
|
||||
return janetc_regalloc_temp(&c->scope->ra, tag);
|
||||
}
|
||||
@@ -205,7 +205,7 @@ static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp
|
||||
}
|
||||
|
||||
/* Check if two slots are equal */
|
||||
int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
|
||||
static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
|
||||
if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
|
||||
lhs.index == rhs.index &&
|
||||
lhs.envindex == rhs.envindex) {
|
||||
@@ -245,8 +245,8 @@ void janetc_copy(
|
||||
janetc_moveback(c, dest, nearreg);
|
||||
/* Cleanup */
|
||||
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
|
||||
}
|
||||
|
||||
}
|
||||
/* Instruction templated emitters */
|
||||
|
||||
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -42,9 +42,6 @@ int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
|
||||
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr);
|
||||
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr);
|
||||
|
||||
/* Check if two slots are equivalent */
|
||||
int janetc_sequal(JanetSlot x, JanetSlot y);
|
||||
|
||||
/* Move value from one slot to another. Cannot copy to constant slots. */
|
||||
void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src);
|
||||
|
||||
|
||||
3160
src/core/ev.c
3160
src/core/ev.c
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -25,40 +25,13 @@
|
||||
#ifndef JANET_FEATURES_H_defined
|
||||
#define JANET_FEATURES_H_defined
|
||||
|
||||
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|
||||
|| defined(__bsdi__) || defined(__DragonFly__)
|
||||
/* Use BSD source on any BSD systems, include OSX */
|
||||
# define _BSD_SOURCE
|
||||
#else
|
||||
/* Use POSIX feature flags */
|
||||
# ifndef _POSIX_C_SOURCE
|
||||
# define _POSIX_C_SOURCE 200809L
|
||||
# endif
|
||||
#ifndef _POSIX_C_SOURCE
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
/* Needed for sched.h for cpu count */
|
||||
#ifdef __linux__
|
||||
#define _GNU_SOURCE
|
||||
#endif
|
||||
|
||||
#if defined(WIN32) || defined(_WIN32)
|
||||
#define WIN32_LEAN_AND_MEAN
|
||||
#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
|
||||
|
||||
/* Needed for timegm and other extensions when building with -std=c99.
|
||||
* It also defines realpath, etc, which would normally require
|
||||
* _XOPEN_SOURCE >= 500. */
|
||||
#if !defined(_NETBSD_SOURCE) && defined(__NetBSD__)
|
||||
#define _NETBSD_SOURCE
|
||||
/* Needed for realpath on linux */
|
||||
#if !defined(_XOPEN_SOURCE) && defined(__linux__)
|
||||
#define _XOPEN_SOURCE 500
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
1161
src/core/ffi.c
1161
src/core/ffi.c
File diff suppressed because it is too large
Load Diff
278
src/core/fiber.c
278
src/core/fiber.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -37,12 +37,6 @@ static void fiber_reset(JanetFiber *fiber) {
|
||||
fiber->child = NULL;
|
||||
fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
fiber->env = NULL;
|
||||
fiber->last_value = janet_wrap_nil();
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
fiber->supervisor_channel = NULL;
|
||||
#endif
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
}
|
||||
|
||||
@@ -53,11 +47,11 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
|
||||
capacity = 32;
|
||||
}
|
||||
fiber->capacity = capacity;
|
||||
data = janet_malloc(sizeof(Janet) * (size_t) capacity);
|
||||
data = malloc(sizeof(Janet) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm.next_collection += sizeof(Janet) * capacity;
|
||||
janet_vm_next_collection += sizeof(Janet) * capacity;
|
||||
fiber->data = data;
|
||||
return fiber;
|
||||
}
|
||||
@@ -83,10 +77,6 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
||||
}
|
||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->supervisor_channel = NULL;
|
||||
#endif
|
||||
return fiber;
|
||||
}
|
||||
|
||||
@@ -95,33 +85,14 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
|
||||
return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
|
||||
}
|
||||
|
||||
#ifdef JANET_DEBUG
|
||||
/* Test for memory issues by reallocating fiber every time we push a stack frame */
|
||||
static void janet_fiber_refresh_memory(JanetFiber *fiber) {
|
||||
int32_t n = fiber->capacity;
|
||||
if (n) {
|
||||
Janet *newData = janet_malloc(sizeof(Janet) * n);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
|
||||
janet_free(fiber->data);
|
||||
fiber->data = newData;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Ensure that the fiber has enough extra capacity */
|
||||
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||
int32_t old_size = fiber->capacity;
|
||||
int32_t diff = n - old_size;
|
||||
Janet *newData = janet_realloc(fiber->data, sizeof(Janet) * n);
|
||||
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
fiber->data = newData;
|
||||
fiber->capacity = n;
|
||||
janet_vm.next_collection += sizeof(Janet) * diff;
|
||||
}
|
||||
|
||||
/* Grow fiber if needed */
|
||||
@@ -202,10 +173,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
#ifdef JANET_DEBUG
|
||||
} else {
|
||||
janet_fiber_refresh_memory(fiber);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Nil unset stack arguments (Needed for gc correctness) */
|
||||
@@ -251,11 +218,10 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
static void janet_env_detach(JanetFuncEnv *env) {
|
||||
/* Check for closure environment */
|
||||
if (env) {
|
||||
janet_env_valid(env);
|
||||
int32_t len = env->length;
|
||||
size_t s = sizeof(Janet) * (size_t) len;
|
||||
Janet *vmem = janet_malloc(s);
|
||||
janet_vm.next_collection += (uint32_t) s;
|
||||
Janet *vmem = malloc(s);
|
||||
janet_vm_next_collection += (uint32_t) s;
|
||||
if (NULL == vmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -278,38 +244,10 @@ static void janet_env_detach(JanetFuncEnv *env) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Validate potentially untrusted func env (unmarshalled envs are difficult to verify) */
|
||||
int janet_env_valid(JanetFuncEnv *env) {
|
||||
if (env->offset < 0) {
|
||||
int32_t real_offset = -(env->offset);
|
||||
JanetFiber *fiber = env->as.fiber;
|
||||
int32_t i = fiber->frame;
|
||||
while (i > 0) {
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
if (real_offset == i &&
|
||||
frame->env == env &&
|
||||
frame->func &&
|
||||
frame->func->def->slotcount == env->length) {
|
||||
env->offset = real_offset;
|
||||
return 1;
|
||||
}
|
||||
i = frame->prevframe;
|
||||
}
|
||||
/* Invalid, set to empty off-stack variant. */
|
||||
env->offset = 0;
|
||||
env->length = 0;
|
||||
env->as.values = NULL;
|
||||
return 0;
|
||||
} else {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Detach a fiber from the env if the target fiber has stopped mutating */
|
||||
void janet_env_maybe_detach(JanetFuncEnv *env) {
|
||||
/* Check for detachable closure envs */
|
||||
janet_env_valid(env);
|
||||
if (env->offset > 0) {
|
||||
if (env->offset) {
|
||||
JanetFiberStatus s = janet_fiber_status(env->as.fiber);
|
||||
int isFinished = s == JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
@@ -338,10 +276,6 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
#ifdef JANET_DEBUG
|
||||
} else {
|
||||
janet_fiber_refresh_memory(fiber);
|
||||
#endif
|
||||
}
|
||||
|
||||
Janet *stack = fiber->data + fiber->frame;
|
||||
@@ -404,10 +338,6 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
#ifdef JANET_DEBUG
|
||||
} else {
|
||||
janet_fiber_refresh_memory(fiber);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Set the next frame */
|
||||
@@ -423,7 +353,8 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
|
||||
newframe->flags = 0;
|
||||
}
|
||||
|
||||
/* Pop a stack frame from the fiber. */
|
||||
/* Pop a stack frame from the fiber. Returns the new stack frame, or
|
||||
* NULL if there are no more frames */
|
||||
void janet_fiber_popframe(JanetFiber *fiber) {
|
||||
JanetStackFrame *frame = janet_fiber_frame(fiber);
|
||||
if (fiber->frame == 0) return;
|
||||
@@ -442,19 +373,12 @@ JanetFiberStatus janet_fiber_status(JanetFiber *f) {
|
||||
}
|
||||
|
||||
JanetFiber *janet_current_fiber(void) {
|
||||
return janet_vm.fiber;
|
||||
}
|
||||
|
||||
JanetFiber *janet_root_fiber(void) {
|
||||
return janet_vm.root_fiber;
|
||||
return janet_vm_fiber;
|
||||
}
|
||||
|
||||
/* CFuns */
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_getenv,
|
||||
"(fiber/getenv fiber)",
|
||||
"Gets the environment for a fiber. Returns nil if no such table is "
|
||||
"set yet.") {
|
||||
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return fiber->env ?
|
||||
@@ -462,10 +386,7 @@ JANET_CORE_FN(cfun_fiber_getenv,
|
||||
janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_setenv,
|
||||
"(fiber/setenv fiber table)",
|
||||
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||
"environment.") {
|
||||
static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
if (janet_checktype(argv[1], JANET_NIL)) {
|
||||
@@ -476,30 +397,7 @@ JANET_CORE_FN(cfun_fiber_setenv,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_new,
|
||||
"(fiber/new func &opt sigmask)",
|
||||
"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") {
|
||||
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
JanetFiber *fiber;
|
||||
@@ -518,7 +416,7 @@ JANET_CORE_FN(cfun_fiber_new,
|
||||
} else {
|
||||
switch (view.bytes[i]) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
|
||||
janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]);
|
||||
break;
|
||||
case 'a':
|
||||
fiber->flags |=
|
||||
@@ -549,17 +447,17 @@ JANET_CORE_FN(cfun_fiber_new,
|
||||
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
||||
break;
|
||||
case 'i':
|
||||
if (!janet_vm.fiber->env) {
|
||||
janet_vm.fiber->env = janet_table(0);
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(0);
|
||||
}
|
||||
fiber->env = janet_vm.fiber->env;
|
||||
fiber->env = janet_vm_fiber->env;
|
||||
break;
|
||||
case 'p':
|
||||
if (!janet_vm.fiber->env) {
|
||||
janet_vm.fiber->env = janet_table(0);
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_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;
|
||||
}
|
||||
}
|
||||
@@ -568,53 +466,26 @@ JANET_CORE_FN(cfun_fiber_new,
|
||||
return janet_wrap_fiber(fiber);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_status,
|
||||
"(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-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") {
|
||||
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
uint32_t s = janet_fiber_status(fiber);
|
||||
return janet_ckeywordv(janet_status_names[s]);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_current,
|
||||
"(fiber/current)",
|
||||
"Returns the currently running fiber.") {
|
||||
static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm.fiber);
|
||||
return janet_wrap_fiber(janet_vm_fiber);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_root,
|
||||
"(fiber/root)",
|
||||
"Returns the current root fiber. The root fiber is the oldest ancestor "
|
||||
"that does not have a parent.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm.root_fiber);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_maxstack,
|
||||
"(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. ") {
|
||||
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return janet_wrap_integer(fiber->maxstack);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_setmaxstack,
|
||||
"(fiber/setmaxstack fib maxstack)",
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stack size is usually 8192.") {
|
||||
static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
int32_t maxs = janet_getinteger(argv, 1);
|
||||
@@ -625,9 +496,7 @@ JANET_CORE_FN(cfun_fiber_setmaxstack,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_can_resume,
|
||||
"(fiber/can-resume? fiber)",
|
||||
"Check if a fiber is finished and cannot be resumed.") {
|
||||
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);
|
||||
@@ -641,28 +510,81 @@ JANET_CORE_FN(cfun_fiber_can_resume,
|
||||
return janet_wrap_boolean(!isFinished);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_last_value,
|
||||
"(fiber/last-value)",
|
||||
"Get the last value returned or signaled from the fiber.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
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. The default sigmask is :y. "
|
||||
"For example, \n\n"
|
||||
"\t(fiber/new myfun :e123)\n\n"
|
||||
"blocks error signals and user signals 1, 2 and 3. The signals are "
|
||||
"as follows: \n\n"
|
||||
"\ta - block all signals\n"
|
||||
"\td - block debug signals\n"
|
||||
"\te - block error signals\n"
|
||||
"\tt - block termination signals: error + user[0-4]\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-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"
|
||||
"\ti - inherit the environment from the current fiber\n"
|
||||
"\tp - 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"
|
||||
"\t:dead - the fiber has finished\n"
|
||||
"\t:error - the fiber has errored out\n"
|
||||
"\t:debug - the fiber is suspended in debug mode\n"
|
||||
"\t:pending - the fiber has been yielded\n"
|
||||
"\t:user(0-9) - the fiber is suspended by a user signal\n"
|
||||
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
||||
"\t:new - the fiber has just been created and not yet run")
|
||||
},
|
||||
{
|
||||
"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.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_fiber(JanetTable *env) {
|
||||
JanetRegExt 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);
|
||||
janet_core_cfuns(env, NULL, fiber_cfuns);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -46,8 +46,7 @@
|
||||
#define JANET_FIBER_MASK_USERN(N) (16 << (N))
|
||||
#define JANET_FIBER_MASK_USER 0x3FF0
|
||||
|
||||
#define JANET_FIBER_STATUS_MASK 0x3F0000
|
||||
#define JANET_FIBER_RESUME_SIGNAL 0x400000
|
||||
#define JANET_FIBER_STATUS_MASK 0xFF0000
|
||||
#define JANET_FIBER_STATUS_OFFSET 16
|
||||
|
||||
#define JANET_FIBER_BREAKPOINT 0x1000000
|
||||
@@ -56,9 +55,7 @@
|
||||
#define JANET_FIBER_DID_LONGJUMP 0x8000000
|
||||
#define JANET_FIBER_FLAG_MASK 0xF000000
|
||||
|
||||
#define JANET_FIBER_EV_FLAG_CANCELED 0x10000
|
||||
#define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
|
||||
#define JANET_FIBER_FLAG_ROOT 0x40000
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
|
||||
#define janet_fiber_set_status(f, s) do {\
|
||||
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\
|
||||
@@ -77,10 +74,5 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
|
||||
void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
|
||||
void janet_fiber_popframe(JanetFiber *fiber);
|
||||
void janet_env_maybe_detach(JanetFuncEnv *env);
|
||||
int janet_env_valid(JanetFuncEnv *env);
|
||||
|
||||
#ifdef JANET_EV
|
||||
void janet_fiber_did_resume(JanetFiber *fiber);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
261
src/core/gc.c
261
src/core/gc.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -28,9 +28,29 @@
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "fiber.h"
|
||||
#include "vector.h"
|
||||
#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 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 */
|
||||
static void janet_mark_funcenv(JanetFuncEnv *env);
|
||||
static void janet_mark_funcdef(JanetFuncDef *def);
|
||||
@@ -50,7 +70,7 @@ static JANET_THREAD_LOCAL size_t orig_rootcount;
|
||||
|
||||
/* Hint to the GC that we may need to collect */
|
||||
void janet_gcpressure(size_t s) {
|
||||
janet_vm.next_collection += s;
|
||||
janet_vm_next_collection += s;
|
||||
}
|
||||
|
||||
/* Mark a value */
|
||||
@@ -105,14 +125,6 @@ static void janet_mark_buffer(JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
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)))
|
||||
return;
|
||||
janet_gc_mark(janet_abstract_head(adata));
|
||||
@@ -123,8 +135,6 @@ static void janet_mark_abstract(void *adata) {
|
||||
|
||||
/* Mark a bunch of items in memory */
|
||||
static void janet_mark_many(const Janet *values, int32_t n) {
|
||||
if (values == NULL)
|
||||
return;
|
||||
const Janet *end = values + n;
|
||||
while (values < end) {
|
||||
janet_mark(*values);
|
||||
@@ -162,13 +172,10 @@ recur: /* Manual tail recursion */
|
||||
}
|
||||
|
||||
static void janet_mark_struct(const JanetKV *st) {
|
||||
recur:
|
||||
if (janet_gc_reachable(janet_struct_head(st)))
|
||||
return;
|
||||
janet_gc_mark(janet_struct_head(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) {
|
||||
@@ -186,7 +193,7 @@ static void janet_mark_funcenv(JanetFuncEnv *env) {
|
||||
/* If closure env references a dead fiber, we can just copy out the stack frame we need so
|
||||
* we don't need to keep around the whole dead fiber. */
|
||||
janet_env_maybe_detach(env);
|
||||
if (env->offset > 0) {
|
||||
if (env->offset) {
|
||||
/* On stack */
|
||||
janet_mark_fiber(env->as.fiber);
|
||||
} else {
|
||||
@@ -217,14 +224,11 @@ static void janet_mark_function(JanetFunction *func) {
|
||||
if (janet_gc_reachable(func))
|
||||
return;
|
||||
janet_gc_mark(func);
|
||||
if (NULL != func->def) {
|
||||
/* this should always be true, except if function is only partially constructed */
|
||||
numenvs = func->def->environments_length;
|
||||
for (i = 0; i < numenvs; ++i) {
|
||||
janet_mark_funcenv(func->envs[i]);
|
||||
}
|
||||
janet_mark_funcdef(func->def);
|
||||
numenvs = func->def->environments_length;
|
||||
for (i = 0; i < numenvs; ++i) {
|
||||
janet_mark_funcenv(func->envs[i]);
|
||||
}
|
||||
janet_mark_funcdef(func->def);
|
||||
}
|
||||
|
||||
static void janet_mark_fiber(JanetFiber *fiber) {
|
||||
@@ -235,8 +239,6 @@ recur:
|
||||
return;
|
||||
janet_gc_mark(fiber);
|
||||
|
||||
janet_mark(fiber->last_value);
|
||||
|
||||
/* Mark values on the argument stack */
|
||||
janet_mark_many(fiber->data + fiber->stackstart,
|
||||
fiber->stacktop - fiber->stackstart);
|
||||
@@ -258,12 +260,6 @@ recur:
|
||||
if (fiber->env)
|
||||
janet_mark_table(fiber->env);
|
||||
|
||||
#ifdef JANET_EV
|
||||
if (fiber->supervisor_channel) {
|
||||
janet_mark_abstract(fiber->supervisor_channel);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Explicit tail recursion */
|
||||
if (fiber->child) {
|
||||
fiber = fiber->child;
|
||||
@@ -281,13 +277,13 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_ARRAY:
|
||||
janet_free(((JanetArray *) mem)->data);
|
||||
free(((JanetArray *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_TABLE:
|
||||
janet_free(((JanetTable *) mem)->data);
|
||||
free(((JanetTable *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_FIBER:
|
||||
janet_free(((JanetFiber *)mem)->data);
|
||||
free(((JanetFiber *)mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_BUFFER:
|
||||
janet_buffer_deinit((JanetBuffer *) mem);
|
||||
@@ -302,18 +298,18 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
case JANET_MEMORY_FUNCENV: {
|
||||
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
||||
if (0 == env->offset)
|
||||
janet_free(env->as.values);
|
||||
free(env->as.values);
|
||||
}
|
||||
break;
|
||||
case JANET_MEMORY_FUNCDEF: {
|
||||
JanetFuncDef *def = (JanetFuncDef *)mem;
|
||||
/* TODO - get this all with one alloc and one free */
|
||||
janet_free(def->defs);
|
||||
janet_free(def->environments);
|
||||
janet_free(def->constants);
|
||||
janet_free(def->bytecode);
|
||||
janet_free(def->sourcemap);
|
||||
janet_free(def->closure_bitset);
|
||||
free(def->defs);
|
||||
free(def->environments);
|
||||
free(def->constants);
|
||||
free(def->bytecode);
|
||||
free(def->sourcemap);
|
||||
free(def->closure_bitset);
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -323,61 +319,24 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
* marked as reachable. Flip the gc color flag for next sweep. */
|
||||
void janet_sweep() {
|
||||
JanetGCObject *previous = NULL;
|
||||
JanetGCObject *current = janet_vm.blocks;
|
||||
JanetGCObject *current = janet_vm_blocks;
|
||||
JanetGCObject *next;
|
||||
while (NULL != current) {
|
||||
next = current->data.next;
|
||||
next = current->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;
|
||||
previous->next = next;
|
||||
} else {
|
||||
janet_vm.blocks = next;
|
||||
janet_vm_blocks = next;
|
||||
}
|
||||
janet_free(current);
|
||||
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");
|
||||
}
|
||||
/* Mark as tombstone in place */
|
||||
items[i].key = janet_wrap_nil();
|
||||
items[i].value = janet_wrap_false();
|
||||
janet_vm.threaded_abstracts.deleted++;
|
||||
janet_vm.threaded_abstracts.count--;
|
||||
/* Free memory */
|
||||
janet_free(janet_abstract_head(abst));
|
||||
}
|
||||
}
|
||||
|
||||
/* Reset for next sweep */
|
||||
items[i].value = janet_wrap_false();
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Allocate some memory that is tracked for garbage collection */
|
||||
@@ -385,8 +344,8 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
JanetGCObject *mem;
|
||||
|
||||
/* Make sure everything is inited */
|
||||
janet_assert(NULL != janet_vm.cache, "please initialize janet before use");
|
||||
mem = janet_malloc(size);
|
||||
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
||||
mem = malloc(size);
|
||||
|
||||
/* Check for bad malloc */
|
||||
if (NULL == mem) {
|
||||
@@ -397,10 +356,9 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
mem->flags = type;
|
||||
|
||||
/* Prepend block to heap list */
|
||||
janet_vm.next_collection += size;
|
||||
mem->data.next = janet_vm.blocks;
|
||||
janet_vm.blocks = mem;
|
||||
janet_vm.block_count++;
|
||||
janet_vm_next_collection += size;
|
||||
mem->next = janet_vm_blocks;
|
||||
janet_vm_blocks = mem;
|
||||
|
||||
return (void *)mem;
|
||||
}
|
||||
@@ -409,15 +367,15 @@ static void free_one_scratch(JanetScratch *s) {
|
||||
if (NULL != s->finalize) {
|
||||
s->finalize((char *) s->mem);
|
||||
}
|
||||
janet_free(s);
|
||||
free(s);
|
||||
}
|
||||
|
||||
/* Free all allocated scratch memory */
|
||||
static void janet_free_all_scratch(void) {
|
||||
for (size_t i = 0; i < janet_vm.scratch_len; i++) {
|
||||
free_one_scratch(janet_vm.scratch_mem[i]);
|
||||
for (size_t i = 0; i < janet_scratch_len; i++) {
|
||||
free_one_scratch(janet_scratch_mem[i]);
|
||||
}
|
||||
janet_vm.scratch_len = 0;
|
||||
janet_scratch_len = 0;
|
||||
}
|
||||
|
||||
static JanetScratch *janet_mem2scratch(void *mem) {
|
||||
@@ -428,29 +386,17 @@ static JanetScratch *janet_mem2scratch(void *mem) {
|
||||
/* Run garbage collection */
|
||||
void janet_collect(void) {
|
||||
uint32_t i;
|
||||
if (janet_vm.gc_suspend) return;
|
||||
if (janet_vm_gc_suspend) return;
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
/* Try and prevent many major collections back to back.
|
||||
* A full collection will take O(janet_vm.block_count) time.
|
||||
* If we have a large heap, make sure our interval is not too
|
||||
* small so we won't make many collections over it. This is just a
|
||||
* heuristic for automatically changing the gc interval */
|
||||
if (janet_vm.block_count * 8 > janet_vm.gc_interval) {
|
||||
janet_vm.gc_interval = janet_vm.block_count * sizeof(JanetGCObject);
|
||||
}
|
||||
orig_rootcount = janet_vm.root_count;
|
||||
#ifdef JANET_EV
|
||||
janet_ev_mark();
|
||||
#endif
|
||||
janet_mark_fiber(janet_vm.root_fiber);
|
||||
orig_rootcount = janet_vm_root_count;
|
||||
for (i = 0; i < orig_rootcount; i++)
|
||||
janet_mark(janet_vm.roots[i]);
|
||||
while (orig_rootcount < janet_vm.root_count) {
|
||||
Janet x = janet_vm.roots[--janet_vm.root_count];
|
||||
janet_mark(janet_vm_roots[i]);
|
||||
while (orig_rootcount < janet_vm_root_count) {
|
||||
Janet x = janet_vm_roots[--janet_vm_root_count];
|
||||
janet_mark(x);
|
||||
}
|
||||
janet_sweep();
|
||||
janet_vm.next_collection = 0;
|
||||
janet_vm_next_collection = 0;
|
||||
janet_free_all_scratch();
|
||||
}
|
||||
|
||||
@@ -458,17 +404,17 @@ void janet_collect(void) {
|
||||
* 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. */
|
||||
void janet_gcroot(Janet root) {
|
||||
size_t newcount = janet_vm.root_count + 1;
|
||||
if (newcount > janet_vm.root_capacity) {
|
||||
size_t newcount = janet_vm_root_count + 1;
|
||||
if (newcount > janet_vm_root_capacity) {
|
||||
size_t newcap = 2 * newcount;
|
||||
janet_vm.roots = janet_realloc(janet_vm.roots, sizeof(Janet) * newcap);
|
||||
if (NULL == janet_vm.roots) {
|
||||
janet_vm_roots = realloc(janet_vm_roots, sizeof(Janet) * newcap);
|
||||
if (NULL == janet_vm_roots) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm.root_capacity = newcap;
|
||||
janet_vm_root_capacity = newcap;
|
||||
}
|
||||
janet_vm.roots[janet_vm.root_count] = root;
|
||||
janet_vm.root_count = newcount;
|
||||
janet_vm_roots[janet_vm_root_count] = root;
|
||||
janet_vm_root_count = newcount;
|
||||
}
|
||||
|
||||
/* Identity equality for GC purposes */
|
||||
@@ -489,11 +435,11 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
||||
/* Remove a root value from the GC. This allows the gc to potentially reclaim
|
||||
* a value and all its children. */
|
||||
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 */
|
||||
for (Janet *v = janet_vm.roots; v < vtop; v++) {
|
||||
for (Janet *v = janet_vm_roots; v < vtop; 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;
|
||||
}
|
||||
}
|
||||
@@ -502,12 +448,12 @@ int janet_gcunroot(Janet root) {
|
||||
|
||||
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
||||
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;
|
||||
/* 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)) {
|
||||
*v = janet_vm.roots[--janet_vm.root_count];
|
||||
*v = janet_vm_roots[--janet_vm_root_count];
|
||||
vtop--;
|
||||
ret = 1;
|
||||
}
|
||||
@@ -517,59 +463,44 @@ int janet_gcunrootall(Janet root) {
|
||||
|
||||
/* Free all allocated memory */
|
||||
void janet_clear_memory(void) {
|
||||
#ifdef JANET_EV
|
||||
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;
|
||||
JanetGCObject *current = janet_vm_blocks;
|
||||
while (NULL != current) {
|
||||
janet_deinit_block(current);
|
||||
JanetGCObject *next = current->data.next;
|
||||
janet_free(current);
|
||||
JanetGCObject *next = current->next;
|
||||
free(current);
|
||||
current = next;
|
||||
}
|
||||
janet_vm.blocks = NULL;
|
||||
janet_vm_blocks = NULL;
|
||||
janet_free_all_scratch();
|
||||
janet_free(janet_vm.scratch_mem);
|
||||
free(janet_scratch_mem);
|
||||
}
|
||||
|
||||
/* Primitives for suspending GC. */
|
||||
int janet_gclock(void) {
|
||||
return janet_vm.gc_suspend++;
|
||||
return janet_vm_gc_suspend++;
|
||||
}
|
||||
void janet_gcunlock(int handle) {
|
||||
janet_vm.gc_suspend = handle;
|
||||
janet_vm_gc_suspend = handle;
|
||||
}
|
||||
|
||||
/* Scratch memory API */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);
|
||||
JanetScratch *s = malloc(sizeof(JanetScratch) + size);
|
||||
if (NULL == s) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
s->finalize = NULL;
|
||||
if (janet_vm.scratch_len == janet_vm.scratch_cap) {
|
||||
size_t newcap = 2 * janet_vm.scratch_cap + 2;
|
||||
JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_vm.scratch_mem, newcap * sizeof(JanetScratch));
|
||||
if (janet_scratch_len == janet_scratch_cap) {
|
||||
size_t newcap = 2 * janet_scratch_cap + 2;
|
||||
JanetScratch **newmem = (JanetScratch **) realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm.scratch_cap = newcap;
|
||||
janet_vm.scratch_mem = newmem;
|
||||
janet_scratch_cap = newcap;
|
||||
janet_scratch_mem = newmem;
|
||||
}
|
||||
janet_vm.scratch_mem[janet_vm.scratch_len++] = s;
|
||||
janet_scratch_mem[janet_scratch_len++] = s;
|
||||
return (char *)(s->mem);
|
||||
}
|
||||
|
||||
@@ -586,20 +517,20 @@ void *janet_scalloc(size_t nmemb, size_t size) {
|
||||
void *janet_srealloc(void *mem, size_t size) {
|
||||
if (NULL == mem) return janet_smalloc(size);
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_vm.scratch_len) {
|
||||
for (size_t i = janet_vm.scratch_len - 1; ; i--) {
|
||||
if (janet_vm.scratch_mem[i] == s) {
|
||||
JanetScratch *news = janet_realloc(s, size + sizeof(JanetScratch));
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
JanetScratch *news = realloc(s, size + sizeof(JanetScratch));
|
||||
if (NULL == news) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm.scratch_mem[i] = news;
|
||||
janet_scratch_mem[i] = news;
|
||||
return (char *)(news->mem);
|
||||
}
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
JANET_EXIT("invalid janet_srealloc");
|
||||
janet_exit("invalid janet_srealloc");
|
||||
}
|
||||
|
||||
void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
|
||||
@@ -610,15 +541,15 @@ void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
|
||||
void janet_sfree(void *mem) {
|
||||
if (NULL == mem) return;
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_vm.scratch_len) {
|
||||
for (size_t i = janet_vm.scratch_len - 1; ; i--) {
|
||||
if (janet_vm.scratch_mem[i] == s) {
|
||||
janet_vm.scratch_mem[i] = janet_vm.scratch_mem[--janet_vm.scratch_len];
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
|
||||
free_one_scratch(s);
|
||||
return;
|
||||
}
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
JANET_EXIT("invalid janet_sfree");
|
||||
janet_exit("invalid janet_sfree");
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -55,11 +55,10 @@ enum JanetMemoryType {
|
||||
JANET_MEMORY_FUNCTION,
|
||||
JANET_MEMORY_ABSTRACT,
|
||||
JANET_MEMORY_FUNCENV,
|
||||
JANET_MEMORY_FUNCDEF,
|
||||
JANET_MEMORY_THREADED_ABSTRACT,
|
||||
JANET_MEMORY_FUNCDEF
|
||||
};
|
||||
|
||||
/* 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 initailize and reachable by the gc (on the JANET stack) */
|
||||
void *janet_gcalloc(enum JanetMemoryType type, size_t size);
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose & contributors
|
||||
* Copyright (c) 2020 Calvin Rose & contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,18 +20,18 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <limits.h>
|
||||
#include <inttypes.h>
|
||||
#include <math.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Conditional compilation */
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
@@ -39,8 +39,6 @@
|
||||
|
||||
static int it_s64_get(void *p, Janet key, Janet *out);
|
||||
static int it_u64_get(void *p, Janet key, Janet *out);
|
||||
static Janet janet_int64_next(void *p, Janet key);
|
||||
static Janet janet_uint64_next(void *p, Janet key);
|
||||
|
||||
static int32_t janet_int64_hash(void *p1, size_t size) {
|
||||
(void) size;
|
||||
@@ -94,8 +92,7 @@ const JanetAbstractType janet_s64_type = {
|
||||
it_s64_tostring,
|
||||
janet_int64_compare,
|
||||
janet_int64_hash,
|
||||
janet_int64_next,
|
||||
JANET_ATEND_NEXT
|
||||
JANET_ATEND_HASH
|
||||
};
|
||||
|
||||
const JanetAbstractType janet_u64_type = {
|
||||
@@ -109,8 +106,7 @@ const JanetAbstractType janet_u64_type = {
|
||||
it_u64_tostring,
|
||||
janet_uint64_compare,
|
||||
janet_int64_hash,
|
||||
janet_uint64_next,
|
||||
JANET_ATEND_NEXT
|
||||
JANET_ATEND_HASH
|
||||
};
|
||||
|
||||
int64_t janet_unwrap_s64(Janet x) {
|
||||
@@ -138,7 +134,7 @@ int64_t janet_unwrap_s64(Janet x) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
janet_panicf("bad s64 initializer: %t", x);
|
||||
janet_panic("bad s64 initializer");
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -148,9 +144,7 @@ uint64_t janet_unwrap_u64(Janet x) {
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
/* Allow negative values to be cast to "wrap around".
|
||||
* This let's addition and subtraction work as expected. */
|
||||
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||
if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL))
|
||||
return (uint64_t)dbl;
|
||||
break;
|
||||
}
|
||||
@@ -169,7 +163,7 @@ uint64_t janet_unwrap_u64(Janet x) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
janet_panicf("bad u64 initializer: %t", x);
|
||||
janet_panic("bad u64 initializer");
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -193,220 +187,16 @@ Janet janet_wrap_u64(uint64_t x) {
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_it_s64_new,
|
||||
"(int/s64 value)",
|
||||
"Create a boxed signed 64 bit integer from a string value.") {
|
||||
static Janet cfun_it_s64_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_it_u64_new,
|
||||
"(int/u64 value)",
|
||||
"Create a boxed unsigned 64 bit integer from a string value.") {
|
||||
static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_to_number,
|
||||
"(int/to-number value)",
|
||||
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
|
||||
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` paramater indicates the byte order:\n"
|
||||
"- `nil` (unset): system byte order\n"
|
||||
"- `:le`: little-endian, least significant byte first\n"
|
||||
"- `:be`: big-endian, most significant byte first\n") {
|
||||
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.
|
||||
* int/u64 and int/s64 support a "compare" method that allows
|
||||
* comparison to each other, and to Janet numbers, using the
|
||||
* "compare" "compare<" ... functions.
|
||||
* In the following code explicit casts are sometimes used to help
|
||||
* make it clear when int/float conversions are happening.
|
||||
*/
|
||||
static int compare_double_double(double x, double y) {
|
||||
return (x < y) ? -1 : ((x > y) ? 1 : 0);
|
||||
}
|
||||
|
||||
static int compare_int64_double(int64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) INT64_MAX)) {
|
||||
return -1;
|
||||
} else if (y < ((double) INT64_MIN)) {
|
||||
return 1;
|
||||
} else {
|
||||
int64_t yi = (int64_t) y;
|
||||
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
|
||||
}
|
||||
}
|
||||
|
||||
static int compare_uint64_double(uint64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if (y < 0) {
|
||||
return 1;
|
||||
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) UINT64_MAX)) {
|
||||
return -1;
|
||||
} else {
|
||||
uint64_t yi = (uint64_t) y;
|
||||
return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64)
|
||||
janet_panic("compare method requires int/s64 as first argument");
|
||||
int64_t x = janet_unwrap_s64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double y = janet_unwrap_number(argv[1]);
|
||||
return janet_wrap_number(compare_int64_double(x, y));
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(argv[1]);
|
||||
if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
int64_t y = *(int64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
// comparing signed to unsigned -- be careful!
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
if (x < 0) {
|
||||
return janet_wrap_number(-1);
|
||||
} else if (y > INT64_MAX) {
|
||||
return janet_wrap_number(-1);
|
||||
} else {
|
||||
int64_t y2 = (int64_t) y;
|
||||
return janet_wrap_number((x < y2) ? -1 : (x > y2 ? 1 : 0));
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
|
||||
janet_panic("compare method requires int/u64 as first argument");
|
||||
uint64_t x = janet_unwrap_u64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double y = janet_unwrap_number(argv[1]);
|
||||
return janet_wrap_number(compare_uint64_double(x, y));
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(argv[1]);
|
||||
if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
// comparing unsigned to signed -- be careful!
|
||||
int64_t y = *(int64_t *)abst;
|
||||
if (y < 0) {
|
||||
return janet_wrap_number(1);
|
||||
} else if (x > INT64_MAX) {
|
||||
return janet_wrap_number(1);
|
||||
} else {
|
||||
int64_t x2 = (int64_t) x;
|
||||
return janet_wrap_number((x2 < y) ? -1 : (x2 > y ? 1 : 0));
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
@@ -476,15 +266,40 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define COMPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T v1 = janet_unwrap_##type(argv[0]); \
|
||||
T v2 = janet_unwrap_##type(argv[1]); \
|
||||
return janet_wrap_boolean(v1 oper v2); \
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
*box = janet_unwrap_s64(argv[0]);
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
int64_t value = janet_unwrap_s64(argv[i]);
|
||||
if (value == 0) janet_panic("division by zero");
|
||||
int64_t x = *box % value;
|
||||
if (x < 0) {
|
||||
x = (*box < 0) ? x - *box : x + *box;
|
||||
}
|
||||
*box = x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
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 op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
*box = (op1 > 0)
|
||||
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||
if (x < 0) {
|
||||
x = (op1 < 0) ? x - op1 : x + op1;
|
||||
}
|
||||
*box = x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
@@ -495,11 +310,19 @@ OPMETHOD(int64_t, s64, mul, *)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
OPMETHOD(int64_t, s64, lshift, <<)
|
||||
OPMETHOD(int64_t, s64, rshift, >>)
|
||||
COMPMETHOD(int64_t, s64, lt, <)
|
||||
COMPMETHOD(int64_t, s64, gt, >)
|
||||
COMPMETHOD(int64_t, s64, le, <=)
|
||||
COMPMETHOD(int64_t, s64, ge, >=)
|
||||
COMPMETHOD(int64_t, s64, eq, ==)
|
||||
COMPMETHOD(int64_t, s64, ne, !=)
|
||||
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
@@ -507,18 +330,24 @@ OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, modi, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
COMPMETHOD(uint64_t, u64, lt, <)
|
||||
COMPMETHOD(uint64_t, u64, gt, >)
|
||||
COMPMETHOD(uint64_t, u64, le, <=)
|
||||
COMPMETHOD(uint64_t, u64, ge, >=)
|
||||
COMPMETHOD(uint64_t, u64, eq, ==)
|
||||
COMPMETHOD(uint64_t, u64, ne, !=)
|
||||
|
||||
#undef OPMETHOD
|
||||
#undef DIVMETHOD
|
||||
#undef DIVMETHOD_SIGNED
|
||||
#undef COMPMETHOD
|
||||
|
||||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"r+", cfun_it_s64_add},
|
||||
@@ -529,9 +358,15 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"/", cfun_it_s64_div},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"mod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"%", cfun_it_s64_rem},
|
||||
{"r%", cfun_it_s64_rem},
|
||||
{"r%", cfun_it_s64_remi},
|
||||
{"<", cfun_it_s64_lt},
|
||||
{">", cfun_it_s64_gt},
|
||||
{"<=", cfun_it_s64_le},
|
||||
{">=", cfun_it_s64_ge},
|
||||
{"=", cfun_it_s64_eq},
|
||||
{"!=", cfun_it_s64_ne},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"r&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
@@ -540,7 +375,6 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
{"compare", cfun_it_s64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
@@ -555,9 +389,15 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"mod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"<", cfun_it_u64_lt},
|
||||
{">", cfun_it_u64_gt},
|
||||
{"<=", cfun_it_u64_le},
|
||||
{">=", cfun_it_u64_ge},
|
||||
{"=", cfun_it_u64_eq},
|
||||
{"!=", cfun_it_u64_ne},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
@@ -566,21 +406,10 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
{"compare", cfun_it_u64_compare},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet janet_int64_next(void *p, Janet key) {
|
||||
(void) p;
|
||||
return janet_nextmethod(it_s64_methods, key);
|
||||
}
|
||||
|
||||
static Janet janet_uint64_next(void *p, Janet key) {
|
||||
(void) p;
|
||||
return janet_nextmethod(it_u64_methods, key);
|
||||
}
|
||||
|
||||
static int it_s64_get(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD))
|
||||
@@ -595,16 +424,23 @@ static int it_u64_get(void *p, Janet key, Janet *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 */
|
||||
void janet_lib_inttypes(JanetTable *env) {
|
||||
JanetRegExt 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_core_cfuns(env, NULL, it_cfuns);
|
||||
janet_register_abstract_type(&janet_s64_type);
|
||||
janet_register_abstract_type(&janet_u64_type);
|
||||
}
|
||||
|
||||
558
src/core/io.c
558
src/core/io.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -30,39 +30,27 @@
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <fcntl.h>
|
||||
#include <sys/wait.h>
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
static int cfun_io_gc(void *p, size_t len);
|
||||
static int io_file_get(void *p, Janet key, Janet *out);
|
||||
static void io_file_marshal(void *p, JanetMarshalContext *ctx);
|
||||
static void *io_file_unmarshal(JanetMarshalContext *ctx);
|
||||
static Janet io_file_next(void *p, Janet key);
|
||||
|
||||
const JanetAbstractType janet_file_type = {
|
||||
"core/file",
|
||||
cfun_io_gc,
|
||||
NULL,
|
||||
io_file_get,
|
||||
NULL,
|
||||
io_file_marshal,
|
||||
io_file_unmarshal,
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
io_file_next,
|
||||
JANET_ATEND_NEXT
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
/* Check arguments to fopen */
|
||||
static int32_t checkflags(const uint8_t *str) {
|
||||
int32_t flags = 0;
|
||||
static int checkflags(const uint8_t *str) {
|
||||
int flags = 0;
|
||||
int32_t i;
|
||||
int32_t len = janet_string_length(str);
|
||||
if (!len || len > 10)
|
||||
janet_panic("file mode must have a length between 1 and 10");
|
||||
if (!len || len > 3)
|
||||
janet_panic("file mode must have a length between 1 and 3");
|
||||
switch (*str) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected w, a, or r", *str);
|
||||
@@ -80,7 +68,7 @@ static int32_t checkflags(const uint8_t *str) {
|
||||
for (i = 1; i < len; i++) {
|
||||
switch (str[i]) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected +, b, or n", str[i]);
|
||||
janet_panicf("invalid flag %c, expected + or b", str[i]);
|
||||
break;
|
||||
case '+':
|
||||
if (flags & JANET_FILE_UPDATE) return -1;
|
||||
@@ -90,59 +78,68 @@ static int32_t checkflags(const uint8_t *str) {
|
||||
if (flags & JANET_FILE_BINARY) return -1;
|
||||
flags |= JANET_FILE_BINARY;
|
||||
break;
|
||||
case 'n':
|
||||
if (flags & JANET_FILE_NONIL) return -1;
|
||||
flags |= JANET_FILE_NONIL;
|
||||
break;
|
||||
}
|
||||
}
|
||||
return flags;
|
||||
}
|
||||
|
||||
static void *makef(FILE *f, int32_t flags) {
|
||||
static Janet makef(FILE *f, int flags) {
|
||||
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
|
||||
iof->file = f;
|
||||
iof->flags = flags;
|
||||
#ifndef JANET_WINDOWS
|
||||
/* While we would like fopen to set cloexec by default (like O_CLOEXEC) with the e flag, that is
|
||||
* not standard. */
|
||||
if (!(flags & JANET_FILE_NOT_CLOSEABLE))
|
||||
fcntl(fileno(f), F_SETFD, FD_CLOEXEC);
|
||||
#endif
|
||||
return iof;
|
||||
return janet_wrap_abstract(iof);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_temp,
|
||||
"(file/temp)",
|
||||
"Open an anonymous temporary file that is removed on close. "
|
||||
"Raises an error on failure.") {
|
||||
/* Open a process */
|
||||
#ifdef __EMSCRIPTEN__
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not implemented on this platform");
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
#else
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode = NULL;
|
||||
int flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
if (janet_string_length(fmode) != 1 ||
|
||||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
|
||||
}
|
||||
flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE);
|
||||
} 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) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
return makef(f, flags);
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
|
||||
(void)argv;
|
||||
janet_fixarity(argc, 0);
|
||||
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
||||
FILE *tmp = tmpfile();
|
||||
if (!tmp)
|
||||
janet_panicf("unable to create temporary file - %s", strerror(errno));
|
||||
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_fopen,
|
||||
"(file/open path &opt mode)",
|
||||
"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") {
|
||||
static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int32_t flags;
|
||||
int flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = checkflags(fmode);
|
||||
@@ -151,9 +148,7 @@ JANET_CORE_FN(cfun_io_fopen,
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
return f ? janet_makefile(f, flags)
|
||||
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
|
||||
: janet_wrap_nil();
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. */
|
||||
@@ -169,16 +164,7 @@ static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
}
|
||||
|
||||
/* Read a certain number of bytes into memory */
|
||||
JANET_CORE_FN(cfun_io_fread,
|
||||
"(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") {
|
||||
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
|
||||
@@ -218,10 +204,7 @@ JANET_CORE_FN(cfun_io_fread,
|
||||
}
|
||||
|
||||
/* Write bytes to a file */
|
||||
JANET_CORE_FN(cfun_io_fwrite,
|
||||
"(file/write f bytes)",
|
||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||
"file.") {
|
||||
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
@@ -244,10 +227,7 @@ JANET_CORE_FN(cfun_io_fwrite,
|
||||
}
|
||||
|
||||
/* 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.") {
|
||||
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)
|
||||
@@ -259,59 +239,42 @@ JANET_CORE_FN(cfun_io_fflush,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
|
||||
/* For closing files from C API */
|
||||
int janet_file_close(JanetFile *file) {
|
||||
int ret = 0;
|
||||
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
ret = fclose(file->file);
|
||||
file->flags |= JANET_FILE_CLOSED;
|
||||
return ret;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Cleanup a file */
|
||||
static int cfun_io_gc(void *p, size_t len) {
|
||||
(void) len;
|
||||
JanetFile *iof = (JanetFile *)p;
|
||||
janet_file_close(iof);
|
||||
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
return fclose(iof->file);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Close a file */
|
||||
JANET_CORE_FN(cfun_io_fclose,
|
||||
"(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.") {
|
||||
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
return janet_wrap_nil();
|
||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||
janet_panic("file not closable");
|
||||
if (fclose(iof->file)) {
|
||||
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
|
||||
janet_panic("could not close file");
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
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 {
|
||||
if (fclose(iof->file)) janet_panic("could not close file");
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Seek a file */
|
||||
JANET_CORE_FN(cfun_io_fseek,
|
||||
"(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.") {
|
||||
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
@@ -353,55 +316,6 @@ static int io_file_get(void *p, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods, out);
|
||||
}
|
||||
|
||||
static Janet io_file_next(void *p, Janet key) {
|
||||
(void) p;
|
||||
return janet_nextmethod(io_file_methods, key);
|
||||
}
|
||||
|
||||
static void io_file_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetFile *iof = (JanetFile *)p;
|
||||
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
|
||||
janet_marshal_abstract(ctx, p);
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_marshal_int(ctx, _fileno(iof->file));
|
||||
#else
|
||||
janet_marshal_int(ctx, fileno(iof->file));
|
||||
#endif
|
||||
janet_marshal_int(ctx, iof->flags);
|
||||
} else {
|
||||
janet_panic("cannot marshal file in safe mode");
|
||||
}
|
||||
}
|
||||
|
||||
static void *io_file_unmarshal(JanetMarshalContext *ctx) {
|
||||
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
|
||||
JanetFile *iof = janet_unmarshal_abstract(ctx, sizeof(JanetFile));
|
||||
int32_t fd = janet_unmarshal_int(ctx);
|
||||
int32_t flags = janet_unmarshal_int(ctx);
|
||||
char fmt[4] = {0};
|
||||
int index = 0;
|
||||
if (flags & JANET_FILE_READ) fmt[index++] = 'r';
|
||||
if (flags & JANET_FILE_APPEND) {
|
||||
fmt[index++] = 'a';
|
||||
} else if (flags & JANET_FILE_WRITE) {
|
||||
fmt[index++] = 'w';
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
iof->file = _fdopen(fd, fmt);
|
||||
#else
|
||||
iof->file = fdopen(fd, fmt);
|
||||
#endif
|
||||
if (iof->file == NULL) {
|
||||
iof->flags = JANET_FILE_CLOSED;
|
||||
} else {
|
||||
iof->flags = flags;
|
||||
}
|
||||
return iof;
|
||||
} else {
|
||||
janet_panic("cannot unmarshal file in safe mode");
|
||||
}
|
||||
}
|
||||
|
||||
FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
Janet x = janet_dyn(name);
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
|
||||
@@ -411,38 +325,26 @@ FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
return iofile->file;
|
||||
}
|
||||
|
||||
static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
FILE *dflt_file, int32_t offset, Janet x) {
|
||||
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
int newline, const char *name, FILE *dflt_file) {
|
||||
FILE *f;
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
janet_panicf("cannot print to %v", x);
|
||||
/* Other values simply do nothing */
|
||||
return janet_wrap_nil();
|
||||
case JANET_BUFFER: {
|
||||
/* Special case buffer */
|
||||
JanetBuffer *buf = janet_unwrap_buffer(x);
|
||||
for (int32_t i = offset; i < argc; ++i) {
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
janet_to_string_b(buf, argv[i]);
|
||||
}
|
||||
if (newline)
|
||||
janet_buffer_push_u8(buf, '\n');
|
||||
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:
|
||||
f = dflt_file;
|
||||
if (f == NULL) janet_panic("cannot print to nil");
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
@@ -453,7 +355,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (int32_t i = offset; i < argc; ++i) {
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
int32_t len;
|
||||
const uint8_t *vstr;
|
||||
if (janet_checktype(argv[i], JANET_BUFFER)) {
|
||||
@@ -466,11 +368,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
}
|
||||
if (len) {
|
||||
if (1 != fwrite(vstr, len, 1, f)) {
|
||||
if (f == dflt_file) {
|
||||
janet_panicf("cannot print %d bytes", len);
|
||||
} else {
|
||||
janet_panicf("cannot print %d bytes to %v", len, x);
|
||||
}
|
||||
janet_panicf("could not print %d bytes to (dyn :%s)", len, name);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -479,75 +377,41 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
int newline, const char *name, FILE *dflt_file) {
|
||||
Janet x = janet_dyn(name);
|
||||
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_print,
|
||||
"(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.") {
|
||||
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_prin,
|
||||
"(prin & xs)",
|
||||
"Same as `print`, but does not add trailing newline.") {
|
||||
static Janet cfun_io_prin(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 0, "out", stdout);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_eprint,
|
||||
"(eprint & xs)",
|
||||
"Same as `print`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
|
||||
static Janet cfun_io_eprint(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 1, "err", stderr);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_eprin,
|
||||
"(eprin & xs)",
|
||||
"Same as `prin`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
|
||||
static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_xprint,
|
||||
"(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);
|
||||
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_xprin,
|
||||
"(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);
|
||||
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
FILE *dflt_file, int32_t offset, Janet x) {
|
||||
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
const char *name, FILE *dflt_file) {
|
||||
FILE *f;
|
||||
const char *fmt = janet_getcstring(argv, offset);
|
||||
janet_arity(argc, 1, -1);
|
||||
const char *fmt = janet_getcstring(argv, 0);
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
janet_panicf("cannot print to %v", x);
|
||||
/* Other values simply do nothing */
|
||||
return janet_wrap_nil();
|
||||
case JANET_BUFFER: {
|
||||
/* Special case buffer */
|
||||
JanetBuffer *buf = janet_unwrap_buffer(x);
|
||||
janet_buffer_format(buf, fmt, offset, argc, argv);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_NIL:
|
||||
f = dflt_file;
|
||||
if (f == NULL) janet_panic("cannot print to nil");
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
@@ -559,67 +423,37 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
}
|
||||
}
|
||||
JanetBuffer *buf = janet_buffer(10);
|
||||
janet_buffer_format(buf, fmt, offset, argc, argv);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
if (buf->count) {
|
||||
if (1 != fwrite(buf->data, buf->count, 1, f)) {
|
||||
janet_panicf("could not print %d bytes to file", buf->count);
|
||||
janet_panicf("could not print %d bytes to file", buf->count, name);
|
||||
}
|
||||
}
|
||||
/* Clear buffer to make things easier for GC */
|
||||
buf->count = 0;
|
||||
buf->capacity = 0;
|
||||
janet_free(buf->data);
|
||||
free(buf->data);
|
||||
buf->data = NULL;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
const char *name, FILE *dflt_file) {
|
||||
janet_arity(argc, 1, -1);
|
||||
Janet x = janet_dyn(name);
|
||||
return cfun_io_printf_impl_x(argc, argv, newline, dflt_file, 0, x);
|
||||
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_printf,
|
||||
"(printf fmt & xs)",
|
||||
"Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :out stdout)` with a trailing newline.") {
|
||||
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_prinf,
|
||||
"(prinf fmt & xs)",
|
||||
"Like `printf` but with no trailing newline.") {
|
||||
static Janet cfun_io_prinf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_eprintf,
|
||||
"(eprintf fmt & xs)",
|
||||
"Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :err stderr)` with a trailing newline.") {
|
||||
static Janet cfun_io_eprintf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 1, "err", stderr);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_eprinf,
|
||||
"(eprinf fmt & xs)",
|
||||
"Like `eprintf` but with no trailing newline.") {
|
||||
static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_xprintf,
|
||||
"(xprintf to fmt & xs)",
|
||||
"Like `printf` but prints to an explicit file or value `to`. Returns nil.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_xprinf,
|
||||
"(xprinf to fmt & xs)",
|
||||
"Like `prinf` but prints to an explicit file or value `to`. Returns nil.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static void janet_flusher(const char *name, FILE *dflt_file) {
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
@@ -638,18 +472,14 @@ static void janet_flusher(const char *name, FILE *dflt_file) {
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_flush,
|
||||
"(flush)",
|
||||
"Flush `(dyn :out stdout)` if it is a file, otherwise do nothing.") {
|
||||
static Janet cfun_io_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("out", stdout);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_eflush,
|
||||
"(eflush)",
|
||||
"Flush `(dyn :err stderr)` if it is a file, otherwise do nothing.") {
|
||||
static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("err", stderr);
|
||||
@@ -672,7 +502,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
janet_formatb(&buffer, format, args);
|
||||
if (xtype == JANET_ABSTRACT) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
@@ -685,18 +515,143 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
||||
janet_formatb(janet_unwrap_buffer(x), format, args);
|
||||
break;
|
||||
}
|
||||
va_end(args);
|
||||
return;
|
||||
}
|
||||
|
||||
/* C API */
|
||||
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.")
|
||||
},
|
||||
{
|
||||
"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"
|
||||
"\tr - allow reading from the file\n"
|
||||
"\tw - allow writing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{
|
||||
"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 into a buffer. A buffer can "
|
||||
"be provided as an optional fourth 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"
|
||||
"\t:all - read the whole file\n"
|
||||
"\t:line - read up to and including the next newline character\n"
|
||||
"\tn (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. 'whence' must be one of\n\n"
|
||||
"\t:cur - jump relative to the current file location\n"
|
||||
"\t:set - jump relative to the beginning of the file\n"
|
||||
"\t: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 the 4GB. Returns the file handle.")
|
||||
},
|
||||
{
|
||||
"file/popen", cfun_io_popen,
|
||||
JDOC("(file/popen path &opt mode)\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.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &janet_file_type);
|
||||
}
|
||||
/* C API */
|
||||
|
||||
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
|
||||
@@ -704,12 +659,8 @@ FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||
return iof->file;
|
||||
}
|
||||
|
||||
JanetFile *janet_makejfile(FILE *f, int flags) {
|
||||
return makef(f, flags);
|
||||
}
|
||||
|
||||
Janet janet_makefile(FILE *f, int flags) {
|
||||
return janet_wrap_abstract(makef(f, flags));
|
||||
return makef(f, flags);
|
||||
}
|
||||
|
||||
JanetAbstract janet_checkfile(Janet j) {
|
||||
@@ -724,44 +675,19 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_io(JanetTable *env) {
|
||||
JanetRegExt 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_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, io_cfuns);
|
||||
janet_register_abstract_type(&janet_file_type);
|
||||
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
|
||||
janet_core_cfuns(env, NULL, io_cfuns);
|
||||
|
||||
/* stdout */
|
||||
JANET_CORE_DEF(env, "stdout",
|
||||
janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
|
||||
"The standard output file.");
|
||||
janet_core_def(env, "stdout",
|
||||
makef(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
JDOC("The standard output file."));
|
||||
/* stderr */
|
||||
JANET_CORE_DEF(env, "stderr",
|
||||
janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
|
||||
"The standard error file.");
|
||||
janet_core_def(env, "stderr",
|
||||
makef(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
JDOC("The standard error file."));
|
||||
/* stdin */
|
||||
JANET_CORE_DEF(env, "stdin",
|
||||
janet_makefile(stdin, JANET_FILE_READ | default_flags),
|
||||
"The standard input file.");
|
||||
janet_core_def(env, "stdin",
|
||||
makef(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
JDOC("The standard input file."));
|
||||
|
||||
}
|
||||
|
||||
441
src/core/marsh.c
441
src/core/marsh.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -42,32 +42,26 @@ typedef struct {
|
||||
/* Lead bytes in marshaling protocol */
|
||||
enum {
|
||||
LB_REAL = 200,
|
||||
LB_NIL, /* 201 */
|
||||
LB_FALSE, /* 202 */
|
||||
LB_TRUE, /* 203 */
|
||||
LB_FIBER, /* 204 */
|
||||
LB_INTEGER, /* 205 */
|
||||
LB_STRING, /* 206 */
|
||||
LB_SYMBOL, /* 207 */
|
||||
LB_KEYWORD, /* 208 */
|
||||
LB_ARRAY, /* 209 */
|
||||
LB_TUPLE, /* 210 */
|
||||
LB_TABLE, /* 211 */
|
||||
LB_TABLE_PROTO, /* 212 */
|
||||
LB_STRUCT, /* 213 */
|
||||
LB_BUFFER, /* 214 */
|
||||
LB_FUNCTION, /* 215 */
|
||||
LB_REGISTRY, /* 216 */
|
||||
LB_ABSTRACT, /* 217 */
|
||||
LB_REFERENCE, /* 218 */
|
||||
LB_FUNCENV_REF, /* 219 */
|
||||
LB_FUNCDEF_REF, /* 220 */
|
||||
LB_UNSAFE_CFUNCTION, /* 221 */
|
||||
LB_UNSAFE_POINTER, /* 222 */
|
||||
LB_STRUCT_PROTO, /* 223 */
|
||||
#ifdef JANET_EV
|
||||
LB_THREADED_ABSTRACT/* 224 */
|
||||
#endif
|
||||
LB_NIL,
|
||||
LB_FALSE,
|
||||
LB_TRUE,
|
||||
LB_FIBER,
|
||||
LB_INTEGER,
|
||||
LB_STRING,
|
||||
LB_SYMBOL,
|
||||
LB_KEYWORD,
|
||||
LB_ARRAY,
|
||||
LB_TUPLE,
|
||||
LB_TABLE,
|
||||
LB_TABLE_PROTO,
|
||||
LB_STRUCT,
|
||||
LB_BUFFER,
|
||||
LB_FUNCTION,
|
||||
LB_REGISTRY,
|
||||
LB_ABSTRACT,
|
||||
LB_REFERENCE,
|
||||
LB_FUNCENV_REF,
|
||||
LB_FUNCDEF_REF
|
||||
} LeadBytes;
|
||||
|
||||
/* Helper to look inside an entry in an environment */
|
||||
@@ -189,9 +183,8 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
janet_env_valid(env);
|
||||
janet_v_push(st->seen_envs, env);
|
||||
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
|
||||
if (env->offset && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
|
||||
pushint(st, 0);
|
||||
pushint(st, env->length);
|
||||
Janet *values = env->as.fiber->data + env->offset;
|
||||
@@ -207,7 +200,7 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
janet_env_maybe_detach(env);
|
||||
pushint(st, env->offset);
|
||||
pushint(st, env->length);
|
||||
if (env->offset > 0) {
|
||||
if (env->offset) {
|
||||
/* On stack variant */
|
||||
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
|
||||
} else {
|
||||
@@ -218,6 +211,15 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Add function flags to janet functions */
|
||||
static void janet_func_addflags(JanetFuncDef *def) {
|
||||
if (def->name) def->flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (def->source) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (def->defs) def->flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (def->environments) def->flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
}
|
||||
|
||||
/* Marshal a sequence of u32s */
|
||||
static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
|
||||
for (int32_t i = 0; i < n; i++) {
|
||||
@@ -238,6 +240,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
janet_func_addflags(def);
|
||||
/* Add to lookup */
|
||||
janet_v_push(st->seen_defs, def);
|
||||
pushint(st, def->flags);
|
||||
@@ -289,8 +292,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
}
|
||||
|
||||
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 30)
|
||||
#define JANET_STACKFRAME_HASENV (INT32_MIN)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 28)
|
||||
#define JANET_STACKFRAME_HASENV (1 << 30)
|
||||
|
||||
/* Marshal a fiber */
|
||||
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
@@ -329,7 +332,6 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
}
|
||||
if (fiber->child)
|
||||
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) {
|
||||
@@ -374,21 +376,6 @@ void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||
|
||||
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
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);
|
||||
if (at->marshal) {
|
||||
pushbyte(st, LB_ABSTRACT);
|
||||
@@ -396,7 +383,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
JanetMarshalContext context = {st, NULL, flags, NULL, at};
|
||||
at->marshal(abstract, &context);
|
||||
} else {
|
||||
janet_panicf("cannot marshal %p", x);
|
||||
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -543,10 +530,8 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
int32_t count;
|
||||
const JanetKV *struct_ = janet_unwrap_struct(x);
|
||||
count = janet_struct_length(struct_);
|
||||
pushbyte(st, janet_struct_proto(struct_) ? LB_STRUCT_PROTO : LB_STRUCT);
|
||||
pushbyte(st, LB_STRUCT);
|
||||
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++) {
|
||||
if (janet_checktype(struct_[i].key, JANET_NIL))
|
||||
continue;
|
||||
@@ -564,10 +549,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
case JANET_FUNCTION: {
|
||||
pushbyte(st, LB_FUNCTION);
|
||||
JanetFunction *func = janet_unwrap_function(x);
|
||||
pushint(st, func->def->environments_length);
|
||||
/* Mark seen before reading def */
|
||||
MARK_SEEN();
|
||||
marshal_one_def(st, func->def, flags);
|
||||
/* Mark seen after reading def, but before envs */
|
||||
MARK_SEEN();
|
||||
for (int32_t i = 0; i < func->def->environments_length; i++)
|
||||
marshal_one_env(st, func->envs[i], flags + 1);
|
||||
return;
|
||||
@@ -578,25 +562,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
|
||||
return;
|
||||
}
|
||||
case JANET_CFUNCTION: {
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_UNSAFE_CFUNCTION);
|
||||
JanetCFunction cfn = janet_unwrap_cfunction(x);
|
||||
pushbytes(st, (uint8_t *) &cfn, sizeof(JanetCFunction));
|
||||
return;
|
||||
}
|
||||
case JANET_POINTER: {
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_UNSAFE_POINTER);
|
||||
void *ptr = janet_unwrap_pointer(x);
|
||||
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
|
||||
return;
|
||||
}
|
||||
no_registry:
|
||||
default: {
|
||||
janet_panicf("no registry value and cannot marshal %p", x);
|
||||
return;
|
||||
}
|
||||
}
|
||||
#undef MARK_SEEN
|
||||
@@ -666,15 +634,6 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Helper to read a natural number (int >= 0). */
|
||||
static int32_t readnat(UnmarshalState *st, const uint8_t **atdata) {
|
||||
int32_t ret = readint(st, atdata);
|
||||
if (ret < 0) {
|
||||
janet_panicf("expected integer >= 0, got %d", ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Helper to read a size_t (up to 8 bytes unsigned). */
|
||||
static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
|
||||
uint64_t ret;
|
||||
@@ -743,31 +702,30 @@ static const uint8_t *unmarshal_one_env(
|
||||
JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv));
|
||||
env->length = 0;
|
||||
env->offset = 0;
|
||||
env->as.values = NULL;
|
||||
janet_v_push(st->lookup_envs, env);
|
||||
int32_t offset = readnat(st, &data);
|
||||
int32_t length = readnat(st, &data);
|
||||
if (offset > 0) {
|
||||
int32_t offset = readint(st, &data);
|
||||
int32_t length = readint(st, &data);
|
||||
if (offset) {
|
||||
Janet fiberv;
|
||||
/* On stack variant */
|
||||
data = unmarshal_one(st, data, &fiberv, flags);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||
/* Negative offset indicates untrusted input */
|
||||
env->offset = -offset;
|
||||
/* Unmarshalling fiber may set values */
|
||||
if (env->offset != 0 && env->offset != offset)
|
||||
janet_panic("invalid funcenv offset");
|
||||
if (env->length != 0 && env->length != length)
|
||||
janet_panic("invalid funcenv length");
|
||||
} else {
|
||||
/* Off stack variant */
|
||||
if (length == 0) {
|
||||
janet_panic("invalid funcenv length");
|
||||
}
|
||||
env->as.values = janet_malloc(sizeof(Janet) * (size_t) length);
|
||||
env->as.values = malloc(sizeof(Janet) * (size_t) length);
|
||||
if (!env->as.values) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
env->offset = 0;
|
||||
for (int32_t i = 0; i < length; i++)
|
||||
data = unmarshal_one(st, data, env->as.values + i, flags);
|
||||
}
|
||||
env->offset = offset;
|
||||
env->length = length;
|
||||
*out = env;
|
||||
}
|
||||
@@ -812,11 +770,6 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->name = NULL;
|
||||
def->source = NULL;
|
||||
def->closure_bitset = NULL;
|
||||
def->defs = NULL;
|
||||
def->environments = NULL;
|
||||
def->constants = NULL;
|
||||
def->bytecode = NULL;
|
||||
def->sourcemap = NULL;
|
||||
janet_v_push(st->lookup_defs, def);
|
||||
|
||||
/* Set default lengths to zero */
|
||||
@@ -827,18 +780,18 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Read flags and other fixed values */
|
||||
def->flags = readint(st, &data);
|
||||
def->slotcount = readnat(st, &data);
|
||||
def->arity = readnat(st, &data);
|
||||
def->min_arity = readnat(st, &data);
|
||||
def->max_arity = readnat(st, &data);
|
||||
def->slotcount = readint(st, &data);
|
||||
def->arity = readint(st, &data);
|
||||
def->min_arity = readint(st, &data);
|
||||
def->max_arity = readint(st, &data);
|
||||
|
||||
/* Read some lengths */
|
||||
constants_length = readnat(st, &data);
|
||||
bytecode_length = readnat(st, &data);
|
||||
constants_length = readint(st, &data);
|
||||
bytecode_length = readint(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
||||
environments_length = readnat(st, &data);
|
||||
environments_length = readint(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
defs_length = readnat(st, &data);
|
||||
defs_length = readint(st, &data);
|
||||
|
||||
/* Check name and source (optional) */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||
@@ -856,7 +809,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal constants */
|
||||
if (constants_length) {
|
||||
def->constants = janet_malloc(sizeof(Janet) * constants_length);
|
||||
def->constants = malloc(sizeof(Janet) * constants_length);
|
||||
if (!def->constants) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -868,7 +821,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->constants_length = constants_length;
|
||||
|
||||
/* Unmarshal bytecode */
|
||||
def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
|
||||
def->bytecode = malloc(sizeof(uint32_t) * bytecode_length);
|
||||
if (!def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -877,7 +830,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal environments */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
|
||||
def->environments = janet_calloc(1, sizeof(int32_t) * (size_t) environments_length);
|
||||
def->environments = calloc(1, sizeof(int32_t) * (size_t) environments_length);
|
||||
if (!def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -891,7 +844,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal sub funcdefs */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
|
||||
def->defs = janet_calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
|
||||
def->defs = calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
|
||||
if (!def->defs) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -906,7 +859,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
/* Unmarshal source maps if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
|
||||
int32_t current = 0;
|
||||
def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
|
||||
if (!def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -921,12 +874,11 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal closure bitset if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
|
||||
int32_t n = (def->slotcount + 31) >> 5;
|
||||
def->closure_bitset = janet_malloc(sizeof(uint32_t) * (size_t) n);
|
||||
def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount);
|
||||
if (NULL == def->closure_bitset) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
data = janet_unmarshal_u32s(st, data, def->closure_bitset, n);
|
||||
data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5);
|
||||
}
|
||||
|
||||
/* Validate */
|
||||
@@ -946,7 +898,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
JanetFiber **out,
|
||||
int flags) {
|
||||
|
||||
/* Initialize a new fiber with gc friendly defaults */
|
||||
/* Initialize a new fiber */
|
||||
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
||||
fiber->flags = 0;
|
||||
fiber->frame = 0;
|
||||
@@ -957,51 +909,46 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
fiber->env = NULL;
|
||||
fiber->last_value = janet_wrap_nil();
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
fiber->supervisor_channel = NULL;
|
||||
#endif
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
|
||||
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
||||
int32_t frame = 0;
|
||||
int32_t stack = 0;
|
||||
int32_t stacktop = 0;
|
||||
|
||||
/* Read ints */
|
||||
int32_t fiber_flags = readint(st, &data);
|
||||
int32_t frame = readnat(st, &data);
|
||||
int32_t fiber_stackstart = readnat(st, &data);
|
||||
int32_t fiber_stacktop = readnat(st, &data);
|
||||
int32_t fiber_maxstack = readnat(st, &data);
|
||||
JanetTable *fiber_env = NULL;
|
||||
fiber->flags = readint(st, &data);
|
||||
frame = readint(st, &data);
|
||||
fiber->stackstart = readint(st, &data);
|
||||
fiber->stacktop = readint(st, &data);
|
||||
fiber->maxstack = readint(st, &data);
|
||||
|
||||
/* Check for bad flags and ints */
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart ||
|
||||
fiber_stackstart > fiber_stacktop ||
|
||||
fiber_stacktop > fiber_maxstack) {
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
|
||||
fiber->stackstart > fiber->stacktop ||
|
||||
fiber->stacktop > fiber->maxstack) {
|
||||
janet_panic("fiber has incorrect stack setup");
|
||||
}
|
||||
|
||||
/* Allocate stack memory */
|
||||
fiber->capacity = fiber_stacktop + 10;
|
||||
fiber->data = janet_malloc(sizeof(Janet) * fiber->capacity);
|
||||
fiber->capacity = fiber->stacktop + 10;
|
||||
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
|
||||
if (!fiber->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < fiber->capacity; i++) {
|
||||
fiber->data[i] = janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* get frames */
|
||||
int32_t stack = frame;
|
||||
int32_t stacktop = fiber_stackstart - JANET_FRAME_SIZE;
|
||||
stack = frame;
|
||||
stacktop = fiber->stackstart - JANET_FRAME_SIZE;
|
||||
while (stack > 0) {
|
||||
JanetFunction *func = NULL;
|
||||
JanetFuncDef *def = NULL;
|
||||
JanetFuncEnv *env = NULL;
|
||||
int32_t frameflags = readint(st, &data);
|
||||
int32_t prevframe = readnat(st, &data);
|
||||
int32_t pcdiff = readnat(st, &data);
|
||||
int32_t prevframe = readint(st, &data);
|
||||
int32_t pcdiff = readint(st, &data);
|
||||
|
||||
/* Get frame items */
|
||||
Janet *framestack = fiber->data + stack;
|
||||
@@ -1017,7 +964,15 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
/* Check env */
|
||||
if (frameflags & JANET_STACKFRAME_HASENV) {
|
||||
frameflags &= ~JANET_STACKFRAME_HASENV;
|
||||
int32_t offset = stack;
|
||||
int32_t length = stacktop - stack;
|
||||
data = unmarshal_one_env(st, data, &env, flags + 1);
|
||||
if (env->offset != 0 && env->offset != offset)
|
||||
janet_panic("funcenv offset does not match fiber frame");
|
||||
if (env->length != 0 && env->length != length)
|
||||
janet_panic("funcenv length does not match fiber frame");
|
||||
env->offset = offset;
|
||||
env->length = length;
|
||||
}
|
||||
|
||||
/* Error checking */
|
||||
@@ -1025,11 +980,11 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
if (expected_framesize != stacktop - stack) {
|
||||
janet_panic("fiber stackframe size mismatch");
|
||||
}
|
||||
if (pcdiff >= def->bytecode_length) {
|
||||
if (pcdiff < 0 || pcdiff >= def->bytecode_length) {
|
||||
janet_panic("fiber stackframe has invalid pc");
|
||||
}
|
||||
if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) {
|
||||
janet_panic("fiber stackframe does not align with previous frame");
|
||||
janet_panic("fibre stackframe does not align with previous frame");
|
||||
}
|
||||
|
||||
/* Get stack items */
|
||||
@@ -1052,40 +1007,25 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
}
|
||||
|
||||
/* Check for fiber env */
|
||||
if (fiber_flags & JANET_FIBER_FLAG_HASENV) {
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
|
||||
Janet envv;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
fiber_env = janet_unwrap_table(envv);
|
||||
fiber->env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
/* Check for child fiber */
|
||||
if (fiber_flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
Janet fiberv;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
data = unmarshal_one(st, data, &fiberv, flags + 1);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
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. */
|
||||
fiber->frame = frame;
|
||||
fiber->flags = fiber_flags;
|
||||
fiber->stackstart = fiber_stackstart;
|
||||
fiber->stacktop = fiber_stacktop;
|
||||
fiber->maxstack = fiber_maxstack;
|
||||
fiber->env = fiber_env;
|
||||
|
||||
int status = janet_fiber_status(fiber);
|
||||
if (status < 0 || status > JANET_STATUS_ALIVE) {
|
||||
janet_panic("invalid fiber status");
|
||||
}
|
||||
|
||||
/* Return data */
|
||||
fiber->frame = frame;
|
||||
*out = fiber;
|
||||
return data;
|
||||
}
|
||||
@@ -1129,18 +1069,14 @@ Janet janet_unmarshal_janet(JanetMarshalContext *ctx) {
|
||||
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);
|
||||
if (ctx->at == NULL) {
|
||||
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));
|
||||
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;
|
||||
}
|
||||
|
||||
@@ -1148,16 +1084,16 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
Janet key;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
const JanetAbstractType *at = janet_get_abstract_type(key);
|
||||
if (at == NULL) janet_panic("unknown abstract type");
|
||||
if (at == NULL) return NULL;
|
||||
if (at->unmarshal) {
|
||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||
if (context.at != NULL) {
|
||||
janet_panic("janet_unmarshal_abstract not called");
|
||||
janet_panicf("janet_unmarshal_abstract not called");
|
||||
}
|
||||
return context.data;
|
||||
}
|
||||
janet_panic("invalid abstract type - no unmarshal function pointer");
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static const uint8_t *unmarshal_one(
|
||||
@@ -1169,7 +1105,7 @@ static const uint8_t *unmarshal_one(
|
||||
MARSH_STACKCHECK;
|
||||
MARSH_EOS(st, data);
|
||||
lead = data[0];
|
||||
if (lead < LB_REAL) {
|
||||
if (lead < 200) {
|
||||
*out = janet_wrap_integer(readint(st, &data));
|
||||
return data;
|
||||
}
|
||||
@@ -1223,7 +1159,7 @@ static const uint8_t *unmarshal_one(
|
||||
case LB_KEYWORD:
|
||||
case LB_REGISTRY: {
|
||||
data++;
|
||||
int32_t len = readnat(st, &data);
|
||||
int32_t len = readint(st, &data);
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
if (lead == LB_STRING) {
|
||||
const uint8_t *str = janet_string(data, len);
|
||||
@@ -1259,19 +1195,13 @@ static const uint8_t *unmarshal_one(
|
||||
case LB_FUNCTION: {
|
||||
JanetFunction *func;
|
||||
JanetFuncDef *def;
|
||||
data++;
|
||||
int32_t len = readnat(st, &data);
|
||||
if (len > 255) {
|
||||
janet_panicf("invalid function - too many environments (%d)", len);
|
||||
}
|
||||
data = unmarshal_one_def(st, data + 1, &def, flags + 1);
|
||||
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
|
||||
len * sizeof(JanetFuncEnv));
|
||||
func->def = NULL;
|
||||
def->environments_length * sizeof(JanetFuncEnv));
|
||||
func->def = def;
|
||||
*out = janet_wrap_function(func);
|
||||
janet_v_push(st->lookup, *out);
|
||||
data = unmarshal_one_def(st, data, &def, flags + 1);
|
||||
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);
|
||||
}
|
||||
return data;
|
||||
@@ -1284,17 +1214,12 @@ static const uint8_t *unmarshal_one(
|
||||
case LB_ARRAY:
|
||||
case LB_TUPLE:
|
||||
case LB_STRUCT:
|
||||
case LB_STRUCT_PROTO:
|
||||
case LB_TABLE:
|
||||
case LB_TABLE_PROTO:
|
||||
/* Things that open with integers */
|
||||
{
|
||||
data++;
|
||||
int32_t len = readnat(st, &data);
|
||||
/* DOS check */
|
||||
if (lead != LB_REFERENCE) {
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
}
|
||||
int32_t len = readint(st, &data);
|
||||
if (lead == LB_ARRAY) {
|
||||
/* Array */
|
||||
JanetArray *array = janet_array(len);
|
||||
@@ -1314,15 +1239,9 @@ static const uint8_t *unmarshal_one(
|
||||
}
|
||||
*out = janet_wrap_tuple(janet_tuple_end(tup));
|
||||
janet_v_push(st->lookup, *out);
|
||||
} else if (lead == LB_STRUCT || lead == LB_STRUCT_PROTO) {
|
||||
} else if (lead == LB_STRUCT) {
|
||||
/* Struct */
|
||||
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);
|
||||
janet_struct_proto(struct_) = janet_unwrap_struct(proto);
|
||||
}
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
Janet key, value;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
@@ -1332,7 +1251,7 @@ static const uint8_t *unmarshal_one(
|
||||
*out = janet_wrap_struct(janet_struct_end(struct_));
|
||||
janet_v_push(st->lookup, *out);
|
||||
} else if (lead == LB_REFERENCE) {
|
||||
if (len >= janet_v_count(st->lookup))
|
||||
if (len < 0 || len >= janet_v_count(st->lookup))
|
||||
janet_panicf("invalid reference %d", len);
|
||||
*out = st->lookup[len];
|
||||
} else {
|
||||
@@ -1355,78 +1274,6 @@ static const uint8_t *unmarshal_one(
|
||||
}
|
||||
return data;
|
||||
}
|
||||
case LB_UNSAFE_POINTER: {
|
||||
MARSH_EOS(st, data + sizeof(void *));
|
||||
data++;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal raw 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 *);
|
||||
*out = janet_wrap_pointer(u.ptr);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
case LB_UNSAFE_CFUNCTION: {
|
||||
MARSH_EOS(st, data + sizeof(JanetCFunction));
|
||||
data++;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal function pointer at index %d",
|
||||
(int)(data - st->start));
|
||||
}
|
||||
union {
|
||||
JanetCFunction ptr;
|
||||
uint8_t bytes[sizeof(JanetCFunction)];
|
||||
} u;
|
||||
memcpy(u.bytes, data, sizeof(JanetCFunction));
|
||||
data += sizeof(JanetCFunction);
|
||||
*out = janet_wrap_cfunction(u.ptr);
|
||||
janet_v_push(st->lookup, *out);
|
||||
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: {
|
||||
janet_panicf("unknown byte %x at index %d",
|
||||
*data,
|
||||
@@ -1434,6 +1281,7 @@ static const uint8_t *unmarshal_one(
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
#undef EXTRA
|
||||
}
|
||||
|
||||
Janet janet_unmarshal(
|
||||
@@ -1460,24 +1308,13 @@ Janet janet_unmarshal(
|
||||
|
||||
/* C functions */
|
||||
|
||||
JANET_CORE_FN(cfun_env_lookup,
|
||||
"(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.") {
|
||||
static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *env = janet_gettable(argv, 0);
|
||||
return janet_wrap_table(janet_env_lookup(env));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_marshal,
|
||||
"(marshal x &opt reverse-lookup buffer)",
|
||||
"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.") {
|
||||
static Janet cfun_marshal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetBuffer *buffer;
|
||||
JanetTable *rreg = NULL;
|
||||
@@ -1493,11 +1330,7 @@ JANET_CORE_FN(cfun_marshal,
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_unmarshal,
|
||||
"(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.") {
|
||||
static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetTable *reg = NULL;
|
||||
@@ -1507,13 +1340,35 @@ JANET_CORE_FN(cfun_unmarshal,
|
||||
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 janet value into a buffer and return the buffer. The buffer "
|
||||
"can the 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 janet value when "
|
||||
"unmarshalling.")
|
||||
},
|
||||
{
|
||||
"unmarshal", cfun_unmarshal,
|
||||
JDOC("(unmarshal buffer &opt lookup)\n\n"
|
||||
"Unmarshal a janet 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 */
|
||||
void janet_lib_marsh(JanetTable *env) {
|
||||
JanetRegExt 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);
|
||||
janet_core_cfuns(env, NULL, marsh_cfuns);
|
||||
}
|
||||
|
||||
428
src/core/math.c
428
src/core/math.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,14 +23,14 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#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 Janet janet_rng_next(void *p, Janet key);
|
||||
|
||||
static void janet_rng_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetRNG *rng = (JanetRNG *)p;
|
||||
@@ -60,15 +60,11 @@ const JanetAbstractType janet_rng_type = {
|
||||
NULL,
|
||||
janet_rng_marshal,
|
||||
janet_rng_unmarshal,
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
janet_rng_next,
|
||||
JANET_ATEND_NEXT
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
JanetRNG *janet_default_rng(void) {
|
||||
return &janet_vm.rng;
|
||||
return &janet_vm_rng;
|
||||
}
|
||||
|
||||
void janet_rng_seed(JanetRNG *rng, uint32_t seed) {
|
||||
@@ -117,12 +113,7 @@ double janet_rng_double(JanetRNG *rng) {
|
||||
return ldexp((double)(big >> (64 - 52)), -52);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_rng_make,
|
||||
"(math/rng &opt seed)",
|
||||
"Creates a Psuedo-Random number generator, with an optional seed. "
|
||||
"The seed should be an unsigned 32 bit integer or a buffer. "
|
||||
"Do not use this for cryptography. Returns a core/rng abstract type."
|
||||
) {
|
||||
static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
|
||||
if (argc == 1) {
|
||||
@@ -139,20 +130,13 @@ JANET_CORE_FN(cfun_rng_make,
|
||||
return janet_wrap_abstract(rng);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_rng_uniform,
|
||||
"(math/rng-uniform rng)",
|
||||
"Extract a random number in the range [0, 1) from the RNG."
|
||||
) {
|
||||
static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
return janet_wrap_number(janet_rng_double(rng));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_rng_int,
|
||||
"(math/rng-int rng &opt max)",
|
||||
"Extract a random random integer in the range [0, max] from the RNG. If "
|
||||
"no max is given, the default is 2^31 - 1."
|
||||
) {
|
||||
static Janet cfun_rng_int(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
if (argc == 1) {
|
||||
@@ -180,11 +164,7 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
|
||||
buf[3] = (word >> 24) & 0xFF;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_rng_buffer,
|
||||
"(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."
|
||||
) {
|
||||
static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
@@ -223,201 +203,271 @@ static int janet_rng_get(void *p, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), rng_methods, out);
|
||||
}
|
||||
|
||||
static Janet janet_rng_next(void *p, Janet key) {
|
||||
(void) p;
|
||||
return janet_nextmethod(rng_methods, key);
|
||||
}
|
||||
|
||||
/* Get a random number */
|
||||
JANET_CORE_FN(janet_rand,
|
||||
"(math/random)",
|
||||
"Returns a uniformly distributed random number between 0 and 1.") {
|
||||
static Janet janet_rand(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
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 */
|
||||
JANET_CORE_FN(janet_srand,
|
||||
"(math/seedrandom seed)",
|
||||
"Set the seed for the random number generator. `seed` should be "
|
||||
"an integer or a buffer."
|
||||
) {
|
||||
static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (janet_checkint(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 {
|
||||
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();
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop, doc)\
|
||||
JANET_CORE_FN(janet_##name, "(math/" #name " x)", doc) {\
|
||||
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
double x = janet_getnumber(argv, 0); \
|
||||
return janet_wrap_number(fop(x)); \
|
||||
}
|
||||
|
||||
JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(asin, asin, "Returns the arcsin of x.")
|
||||
JANET_DEFINE_MATHOP(atan, atan, "Returns the arctangent of x.")
|
||||
JANET_DEFINE_MATHOP(cos, cos, "Returns the cosine of x.")
|
||||
JANET_DEFINE_MATHOP(cosh, cosh, "Returns the hyperbolic cosine of x.")
|
||||
JANET_DEFINE_MATHOP(acosh, acosh, "Returns the hyperbolic arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(sin, sin, "Returns the sine of x.")
|
||||
JANET_DEFINE_MATHOP(sinh, sinh, "Returns the hyperbolic sine of x.")
|
||||
JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hypberbolic arcsine of x.")
|
||||
JANET_DEFINE_MATHOP(tan, tan, "Returns the tangent of x.")
|
||||
JANET_DEFINE_MATHOP(tanh, tanh, "Returns the hyperbolic tangent of x.")
|
||||
JANET_DEFINE_MATHOP(atanh, atanh, "Returns the hyperbolic arctangent of x.")
|
||||
JANET_DEFINE_MATHOP(exp, exp, "Returns e to the power of x.")
|
||||
JANET_DEFINE_MATHOP(exp2, exp2, "Returns 2 to the power of x.")
|
||||
JANET_DEFINE_MATHOP(expm1, expm1, "Returns e to the power of x minus 1.")
|
||||
JANET_DEFINE_MATHOP(log, log, "Returns the natural logarithm of x.")
|
||||
JANET_DEFINE_MATHOP(log10, log10, "Returns the log base 10 of x.")
|
||||
JANET_DEFINE_MATHOP(log2, log2, "Returns the log base 2 of x.")
|
||||
JANET_DEFINE_MATHOP(sqrt, sqrt, "Returns the square root of x.")
|
||||
JANET_DEFINE_MATHOP(cbrt, cbrt, "Returns the cube root of x.")
|
||||
JANET_DEFINE_MATHOP(ceil, ceil, "Returns the smallest integer value number that is not less than x.")
|
||||
JANET_DEFINE_MATHOP(fabs, fabs, "Return the absolute value of x.")
|
||||
JANET_DEFINE_MATHOP(floor, floor, "Returns the largest integer value number that is not greater than x.")
|
||||
JANET_DEFINE_MATHOP(trunc, trunc, "Returns the integer between x and 0 nearest to x.")
|
||||
JANET_DEFINE_MATHOP(round, round, "Returns the integer nearest to x.")
|
||||
JANET_DEFINE_MATHOP(gamma, tgamma, "Returns gamma(x).")
|
||||
JANET_DEFINE_MATHOP(lgamma, lgamma, "Returns log-gamma(x).")
|
||||
JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||
JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
|
||||
JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
|
||||
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)
|
||||
|
||||
#define JANET_DEFINE_MATH2OP(name, fop, signature, doc)\
|
||||
JANET_CORE_FN(janet_##name, signature, doc) {\
|
||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
janet_fixarity(argc, 2); \
|
||||
double lhs = janet_getnumber(argv, 0); \
|
||||
double rhs = janet_getnumber(argv, 1); \
|
||||
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(pow, pow, "(math/pow a x)", "Returns a to the power of x.")
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot, "(math/hypot a b)", "Returns c from the equation c^2 = a^2 + b^2.")
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point vaue after x in the direction of y.")
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||
JANET_DEFINE_MATH2OP(pow, pow)
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot)
|
||||
|
||||
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);
|
||||
return janet_wrap_boolean(!janet_truthy(argv[0]));
|
||||
}
|
||||
|
||||
static double janet_gcd(double x, double y) {
|
||||
if (isnan(x) || isnan(y)) {
|
||||
#ifdef NAN
|
||||
return NAN;
|
||||
#else
|
||||
return 0.0 \ 0.0;
|
||||
#endif
|
||||
}
|
||||
if (isinf(x) || isinf(y)) return INFINITY;
|
||||
while (y != 0) {
|
||||
double temp = y;
|
||||
y = fmod(x, y);
|
||||
x = temp;
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
||||
static double janet_lcm(double x, double y) {
|
||||
return (x / janet_gcd(x, y)) * y;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_gcd, "(math/gcd x y)",
|
||||
"Returns the greatest common divisor between x and y.") {
|
||||
janet_fixarity(argc, 2);
|
||||
double x = janet_getnumber(argv, 0);
|
||||
double y = janet_getnumber(argv, 1);
|
||||
return janet_wrap_number(janet_gcd(x, y));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
|
||||
"Returns the least common multiple of x and y.") {
|
||||
janet_fixarity(argc, 2);
|
||||
double x = janet_getnumber(argv, 0);
|
||||
double y = janet_getnumber(argv, 1);
|
||||
return janet_wrap_number(janet_lcm(x, y));
|
||||
}
|
||||
static const JanetReg math_cfuns[] = {
|
||||
{
|
||||
"not", janet_not,
|
||||
JDOC("(not x)\n\nReturns the boolean inverse of x.")
|
||||
},
|
||||
{
|
||||
"math/random", janet_rand,
|
||||
JDOC("(math/random)\n\n"
|
||||
"Returns a uniformly distributed random number between 0 and 1.")
|
||||
},
|
||||
{
|
||||
"math/seedrandom", janet_srand,
|
||||
JDOC("(math/seedrandom seed)\n\n"
|
||||
"Set the seed for the random number generator. seed should be "
|
||||
"an integer or a buffer.")
|
||||
},
|
||||
{
|
||||
"math/cos", janet_cos,
|
||||
JDOC("(math/cos x)\n\n"
|
||||
"Returns the cosine of x.")
|
||||
},
|
||||
{
|
||||
"math/sin", janet_sin,
|
||||
JDOC("(math/sin x)\n\n"
|
||||
"Returns the sine of x.")
|
||||
},
|
||||
{
|
||||
"math/tan", janet_tan,
|
||||
JDOC("(math/tan x)\n\n"
|
||||
"Returns the tangent of x.")
|
||||
},
|
||||
{
|
||||
"math/acos", janet_acos,
|
||||
JDOC("(math/acos x)\n\n"
|
||||
"Returns the arccosine of x.")
|
||||
},
|
||||
{
|
||||
"math/asin", janet_asin,
|
||||
JDOC("(math/asin x)\n\n"
|
||||
"Returns the arcsine of x.")
|
||||
},
|
||||
{
|
||||
"math/atan", janet_atan,
|
||||
JDOC("(math/atan x)\n\n"
|
||||
"Returns the arctangent of x.")
|
||||
},
|
||||
{
|
||||
"math/exp", janet_exp,
|
||||
JDOC("(math/exp x)\n\n"
|
||||
"Returns e to the power of x.")
|
||||
},
|
||||
{
|
||||
"math/log", janet_log,
|
||||
JDOC("(math/log x)\n\n"
|
||||
"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. "
|
||||
"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/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.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_math(JanetTable *env) {
|
||||
JanetRegExt 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_gamma),
|
||||
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_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, math_cfuns);
|
||||
janet_core_cfuns(env, NULL, math_cfuns);
|
||||
janet_register_abstract_type(&janet_rng_type);
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
JANET_CORE_DEF(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||
"The value pi.");
|
||||
JANET_CORE_DEF(env, "math/e", janet_wrap_number(2.7182818284590451),
|
||||
"The base of the natural log.");
|
||||
JANET_CORE_DEF(env, "math/inf", janet_wrap_number(INFINITY),
|
||||
"The number representing positive infinity");
|
||||
JANET_CORE_DEF(env, "math/-inf", janet_wrap_number(-INFINITY),
|
||||
"The number representing negative infinity");
|
||||
JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN),
|
||||
"The minimum contiguous integer representable by a 32 bit signed integer");
|
||||
JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
|
||||
"The maximum contiguous integer represtenable by a 32 bit signed integer");
|
||||
JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
|
||||
"The minimum contiguous integer representable by a double (2^53)");
|
||||
JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
|
||||
"The maximum contiguous integer represtenable by a double (-(2^53))");
|
||||
#ifdef NAN
|
||||
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
|
||||
#else
|
||||
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(0.0 / 0.0), "Not a number (IEEE-754 NaN)");
|
||||
#endif
|
||||
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||
JDOC("The value pi."));
|
||||
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
|
||||
JDOC("The base of the natural log."));
|
||||
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
|
||||
JDOC("The number representing positive infinity"));
|
||||
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
|
||||
JDOC("The number representing negative infinity"));
|
||||
#endif
|
||||
}
|
||||
|
||||
923
src/core/net.c
923
src/core/net.c
@@ -1,923 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose and contributors.
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in 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_NET
|
||||
|
||||
#include <math.h>
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <winsock2.h>
|
||||
#include <windows.h>
|
||||
#include <ws2tcpip.h>
|
||||
#include <mswsock.h>
|
||||
#pragma comment (lib, "Ws2_32.lib")
|
||||
#pragma comment (lib, "Mswsock.lib")
|
||||
#pragma comment (lib, "Advapi32.lib")
|
||||
#else
|
||||
#include <arpa/inet.h>
|
||||
#include <unistd.h>
|
||||
#include <signal.h>
|
||||
#include <sys/ioctl.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/socket.h>
|
||||
#include <sys/un.h>
|
||||
#include <netinet/in.h>
|
||||
#include <netinet/tcp.h>
|
||||
#include <netdb.h>
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
|
||||
const JanetAbstractType janet_address_type = {
|
||||
"core/socket-address",
|
||||
JANET_ATEND_NAME
|
||||
};
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JSOCKCLOSE(x) closesocket((SOCKET) x)
|
||||
#define JSOCKDEFAULT INVALID_SOCKET
|
||||
#define JSOCKVALID(x) ((x) != INVALID_SOCKET)
|
||||
#define JSock SOCKET
|
||||
#define JSOCKFLAGS 0
|
||||
#else
|
||||
#define JSOCKCLOSE(x) close(x)
|
||||
#define JSOCKDEFAULT 0
|
||||
#define JSOCKVALID(x) ((x) >= 0)
|
||||
#define JSock int
|
||||
#ifdef SOCK_CLOEXEC
|
||||
#define JSOCKFLAGS SOCK_CLOEXEC
|
||||
#else
|
||||
#define JSOCKFLAGS 0
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* maximum number of bytes in a socket address host (post name resolution) */
|
||||
#ifdef JANET_WINDOWS
|
||||
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
|
||||
typedef unsigned short in_port_t;
|
||||
#else
|
||||
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
|
||||
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
|
||||
#endif
|
||||
|
||||
static JanetStream *make_stream(JSock handle, uint32_t flags);
|
||||
|
||||
/* We pass this flag to all send calls to prevent sigpipe */
|
||||
#ifndef MSG_NOSIGNAL
|
||||
#define MSG_NOSIGNAL 0
|
||||
#endif
|
||||
|
||||
/* Make sure a socket doesn't block */
|
||||
static void janet_net_socknoblock(JSock s) {
|
||||
#ifdef JANET_WINDOWS
|
||||
unsigned long arg = 1;
|
||||
ioctlsocket(s, FIONBIO, &arg);
|
||||
#else
|
||||
#if !defined(SOCK_CLOEXEC) && defined(O_CLOEXEC)
|
||||
int extra = O_CLOEXEC;
|
||||
#else
|
||||
int extra = 0;
|
||||
#endif
|
||||
fcntl(s, F_SETFL, fcntl(s, F_GETFL, 0) | O_NONBLOCK | extra);
|
||||
#ifdef SO_NOSIGPIPE
|
||||
int enable = 1;
|
||||
setsockopt(s, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int));
|
||||
#endif
|
||||
#endif
|
||||
}
|
||||
|
||||
/* State machine for accepting connections. */
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
WSAOVERLAPPED overlapped;
|
||||
JanetFunction *function;
|
||||
JanetStream *lstream;
|
||||
JanetStream *astream;
|
||||
char buf[1024];
|
||||
} NetStateAccept;
|
||||
|
||||
static int net_sched_accept_impl(NetStateAccept *state, Janet *err);
|
||||
|
||||
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_MARK: {
|
||||
if (state->lstream) janet_mark(janet_wrap_abstract(state->lstream));
|
||||
if (state->astream) janet_mark(janet_wrap_abstract(state->astream));
|
||||
if (state->function) janet_mark(janet_wrap_function(state->function));
|
||||
break;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
if (state->astream->flags & JANET_STREAM_CLOSED) {
|
||||
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
SOCKET lsock = (SOCKET) state->lstream->handle;
|
||||
if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
|
||||
(char *) &lsock, sizeof(lsock))) {
|
||||
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
|
||||
Janet streamv = janet_wrap_abstract(state->astream);
|
||||
if (state->function) {
|
||||
/* Schedule worker */
|
||||
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
fiber->supervisor_channel = s->fiber->supervisor_channel;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
/* Now listen again for next connection */
|
||||
Janet err;
|
||||
if (net_sched_accept_impl(state, &err)) {
|
||||
janet_cancel(s->fiber, err);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
} else {
|
||||
janet_schedule(s->fiber, streamv);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
}
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||
Janet err;
|
||||
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->buf, 0, 1024);
|
||||
state->function = fun;
|
||||
state->lstream = stream;
|
||||
s->tag = &state->overlapped;
|
||||
if (net_sched_accept_impl(state, &err)) janet_panicv(err);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
|
||||
SOCKET lsock = (SOCKET) state->lstream->handle;
|
||||
SOCKET asock = WSASocketW(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED);
|
||||
if (asock == INVALID_SOCKET) {
|
||||
*err = janet_ev_lasterr();
|
||||
return 1;
|
||||
}
|
||||
JanetStream *astream = make_stream(asock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
state->astream = astream;
|
||||
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
|
||||
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
|
||||
int code = WSAGetLastError();
|
||||
if (code == WSA_IO_PENDING) return 0; /* indicates io is happening async */
|
||||
*err = janet_ev_lasterr();
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
JanetFunction *function;
|
||||
} NetStateAccept;
|
||||
|
||||
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_MARK: {
|
||||
if (state->function) janet_mark(janet_wrap_function(state->function));
|
||||
break;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
JSock connfd = accept(s->stream->handle, NULL, NULL);
|
||||
if (JSOCKVALID(connfd)) {
|
||||
janet_net_socknoblock(connfd);
|
||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
Janet streamv = janet_wrap_abstract(stream);
|
||||
if (state->function) {
|
||||
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
fiber->supervisor_channel = s->fiber->supervisor_channel;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
} else {
|
||||
janet_schedule(s->fiber, streamv);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||
NetStateAccept *state = (NetStateAccept *) janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||
state->function = fun;
|
||||
janet_await();
|
||||
}
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
/* Adress info */
|
||||
|
||||
static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
|
||||
JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL);
|
||||
int socktype = SOCK_DGRAM;
|
||||
if ((NULL == stype) || !janet_cstrcmp(stype, "stream")) {
|
||||
socktype = SOCK_STREAM;
|
||||
} else if (janet_cstrcmp(stype, "datagram")) {
|
||||
janet_panicf("expected socket type as :stream or :datagram, got %v", argv[n]);
|
||||
}
|
||||
return socktype;
|
||||
}
|
||||
|
||||
/* Needs argc >= offset + 2 */
|
||||
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1,
|
||||
* 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) {
|
||||
/* Unix socket support - not yet supported on windows. */
|
||||
#ifndef JANET_WINDOWS
|
||||
if (janet_keyeq(argv[offset], "unix")) {
|
||||
const char *path = janet_getcstring(argv, offset + 1);
|
||||
struct sockaddr_un *saddr = janet_calloc(1, sizeof(struct sockaddr_un));
|
||||
if (saddr == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
saddr->sun_family = AF_UNIX;
|
||||
size_t path_size = sizeof(saddr->sun_path);
|
||||
#ifdef JANET_LINUX
|
||||
if (path[0] == '@') {
|
||||
saddr->sun_path[0] = '\0';
|
||||
snprintf(saddr->sun_path + 1, path_size - 1, "%s", path + 1);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
snprintf(saddr->sun_path, path_size, "%s", path);
|
||||
}
|
||||
*is_unix = 1;
|
||||
return (struct addrinfo *) saddr;
|
||||
}
|
||||
#endif
|
||||
/* Get host and port */
|
||||
char *host = (char *)janet_getcstring(argv, offset);
|
||||
char *port = NULL;
|
||||
if (janet_checkint(argv[offset + 1])) {
|
||||
port = (char *)janet_to_string(argv[offset + 1]);
|
||||
} else {
|
||||
port = (char *)janet_optcstring(argv, offset + 2, offset + 1, NULL);
|
||||
}
|
||||
/* getaddrinfo */
|
||||
struct addrinfo *ai = NULL;
|
||||
struct addrinfo hints;
|
||||
memset(&hints, 0, sizeof(hints));
|
||||
hints.ai_family = AF_UNSPEC;
|
||||
hints.ai_socktype = socktype;
|
||||
hints.ai_flags = passive ? AI_PASSIVE : 0;
|
||||
int status = getaddrinfo(host, port, &hints, &ai);
|
||||
if (status) {
|
||||
janet_panicf("could not get address info: %s", gai_strerror(status));
|
||||
}
|
||||
*is_unix = 0;
|
||||
return ai;
|
||||
}
|
||||
|
||||
/*
|
||||
* C Funs
|
||||
*/
|
||||
|
||||
JANET_CORE_FN(cfun_net_sockaddr,
|
||||
"(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_arity(argc, 2, 4);
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
int make_arr = (argc >= 3 && janet_truthy(argv[3]));
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
|
||||
#ifndef JANET_WINDOWS
|
||||
/* no unix domain socket support on windows yet */
|
||||
if (is_unix) {
|
||||
void *abst = janet_abstract(&janet_address_type, sizeof(struct sockaddr_un));
|
||||
memcpy(abst, ai, sizeof(struct sockaddr_un));
|
||||
Janet ret = janet_wrap_abstract(abst);
|
||||
return make_arr ? janet_wrap_array(janet_array_n(&ret, 1)) : ret;
|
||||
}
|
||||
#endif
|
||||
if (make_arr) {
|
||||
/* Select all */
|
||||
JanetArray *arr = janet_array(10);
|
||||
struct addrinfo *iter = ai;
|
||||
while (NULL != iter) {
|
||||
void *abst = janet_abstract(&janet_address_type, iter->ai_addrlen);
|
||||
memcpy(abst, iter->ai_addr, iter->ai_addrlen);
|
||||
janet_array_push(arr, janet_wrap_abstract(abst));
|
||||
iter = iter->ai_next;
|
||||
}
|
||||
freeaddrinfo(ai);
|
||||
return janet_wrap_array(arr);
|
||||
} else {
|
||||
/* Select first */
|
||||
if (NULL == ai) {
|
||||
janet_panic("no data for given address");
|
||||
}
|
||||
void *abst = janet_abstract(&janet_address_type, ai->ai_addrlen);
|
||||
memcpy(abst, ai->ai_addr, ai->ai_addrlen);
|
||||
freeaddrinfo(ai);
|
||||
return janet_wrap_abstract(abst);
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_connect,
|
||||
"(net/connect host port &opt type bindhost bindport)",
|
||||
"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_arity(argc, 2, 5);
|
||||
|
||||
/* Check arguments */
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
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);
|
||||
|
||||
/* 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 */
|
||||
JSock sock = JSOCKDEFAULT;
|
||||
void *addr = NULL;
|
||||
socklen_t addrlen = 0;
|
||||
#ifndef JANET_WINDOWS
|
||||
if (is_unix) {
|
||||
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||
if (!JSOCKVALID(sock)) {
|
||||
Janet v = janet_ev_lasterr();
|
||||
janet_free(ai);
|
||||
janet_panicf("could not create socket: %V", v);
|
||||
}
|
||||
addr = (void *) ai;
|
||||
addrlen = sizeof(struct sockaddr_un);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
struct addrinfo *rp = NULL;
|
||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
||||
#ifdef JANET_WINDOWS
|
||||
sock = WSASocketW(rp->ai_family, rp->ai_socktype, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
|
||||
#else
|
||||
sock = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||
#endif
|
||||
if (JSOCKVALID(sock)) {
|
||||
addr = rp->ai_addr;
|
||||
addrlen = (socklen_t) rp->ai_addrlen;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (NULL == addr) {
|
||||
Janet v = janet_ev_lasterr();
|
||||
if (binding) freeaddrinfo(binding);
|
||||
freeaddrinfo(ai);
|
||||
janet_panicf("could not create socket: %V", v);
|
||||
}
|
||||
}
|
||||
|
||||
/* Bind to bindhost and bindport if given */
|
||||
if (binding) {
|
||||
struct addrinfo *rp = NULL;
|
||||
int did_bind = 0;
|
||||
for (rp = ai; 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);
|
||||
}
|
||||
}
|
||||
|
||||
/* Connect to socket */
|
||||
#ifdef JANET_WINDOWS
|
||||
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
|
||||
Janet lasterr = janet_ev_lasterr();
|
||||
freeaddrinfo(ai);
|
||||
#else
|
||||
int status = connect(sock, addr, addrlen);
|
||||
Janet lasterr = janet_ev_lasterr();
|
||||
if (is_unix) {
|
||||
janet_free(ai);
|
||||
} else {
|
||||
freeaddrinfo(ai);
|
||||
}
|
||||
#endif
|
||||
|
||||
if (status == -1) {
|
||||
JSOCKCLOSE(sock);
|
||||
janet_panicf("could not connect socket: %V", lasterr);
|
||||
}
|
||||
|
||||
/* 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) {
|
||||
/* Set various socket options */
|
||||
int enable = 1;
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEADDR) failed";
|
||||
}
|
||||
#ifdef SO_REUSEPORT
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
|
||||
return "setsockopt(SO_REUSEPORT) failed";
|
||||
}
|
||||
#endif
|
||||
janet_net_socknoblock(sfd);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JANET_SHUTDOWN_RW SD_BOTH
|
||||
#define JANET_SHUTDOWN_R SD_RECEIVE
|
||||
#define JANET_SHUTDOWN_W SD_SEND
|
||||
#else
|
||||
#define JANET_SHUTDOWN_RW SHUT_RDWR
|
||||
#define JANET_SHUTDOWN_R SHUT_RD
|
||||
#define JANET_SHUTDOWN_W SHUT_WR
|
||||
#endif
|
||||
|
||||
JANET_CORE_FN(cfun_net_shutdown,
|
||||
"(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);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_SOCKET);
|
||||
int shutdown_type = JANET_SHUTDOWN_RW;
|
||||
if (argc == 2) {
|
||||
const uint8_t *kw = janet_getkeyword(argv, 1);
|
||||
if (0 == janet_cstrcmp(kw, "rw")) {
|
||||
shutdown_type = JANET_SHUTDOWN_RW;
|
||||
} else if (0 == janet_cstrcmp(kw, "r")) {
|
||||
shutdown_type = JANET_SHUTDOWN_R;
|
||||
} else if (0 == janet_cstrcmp(kw, "w")) {
|
||||
shutdown_type = JANET_SHUTDOWN_W;
|
||||
} else {
|
||||
janet_panicf("unexpected keyword %v", argv[1]);
|
||||
}
|
||||
}
|
||||
int status;
|
||||
#ifdef JANET_WINDOWS
|
||||
status = shutdown((SOCKET) stream->handle, shutdown_type);
|
||||
#else
|
||||
do {
|
||||
status = shutdown(stream->handle, shutdown_type);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
#endif
|
||||
if (status) {
|
||||
janet_panicf("could not shutdown socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_net_listen,
|
||||
"(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_arity(argc, 2, 3);
|
||||
|
||||
/* Get host, port, and handler*/
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix);
|
||||
|
||||
JSock sfd = JSOCKDEFAULT;
|
||||
#ifndef JANET_WINDOWS
|
||||
if (is_unix) {
|
||||
sfd = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||
if (!JSOCKVALID(sfd)) {
|
||||
janet_free(ai);
|
||||
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
const char *err = serverify_socket(sfd);
|
||||
if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_free(ai);
|
||||
if (err) {
|
||||
janet_panic(err);
|
||||
} else {
|
||||
janet_panicf("could not bind socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
}
|
||||
janet_free(ai);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
/* Check all addrinfos in a loop for the first that we can bind to. */
|
||||
struct addrinfo *rp = NULL;
|
||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
||||
#ifdef JANET_WINDOWS
|
||||
sfd = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
|
||||
#else
|
||||
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||
#endif
|
||||
if (!JSOCKVALID(sfd)) continue;
|
||||
const char *err = serverify_socket(sfd);
|
||||
if (NULL != err) {
|
||||
JSOCKCLOSE(sfd);
|
||||
continue;
|
||||
}
|
||||
/* Bind */
|
||||
if (bind(sfd, rp->ai_addr, (int) rp->ai_addrlen) == 0) break;
|
||||
JSOCKCLOSE(sfd);
|
||||
}
|
||||
freeaddrinfo(ai);
|
||||
if (NULL == rp) {
|
||||
janet_panic("could not bind to any sockets");
|
||||
}
|
||||
}
|
||||
|
||||
if (socktype == SOCK_DGRAM) {
|
||||
/* Datagram server (UDP) */
|
||||
JanetStream *stream = make_stream(sfd, JANET_STREAM_UDPSERVER | JANET_STREAM_READABLE);
|
||||
return janet_wrap_abstract(stream);
|
||||
} else {
|
||||
/* Stream server (TCP) */
|
||||
|
||||
/* listen */
|
||||
int status = listen(sfd, 1024);
|
||||
if (status) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panicf("could not listen on file descriptor: %V", janet_ev_lasterr());
|
||||
}
|
||||
|
||||
/* Put sfd on our loop */
|
||||
JanetStream *stream = make_stream(sfd, JANET_STREAM_ACCEPTABLE);
|
||||
return janet_wrap_abstract(stream);
|
||||
}
|
||||
}
|
||||
|
||||
/* Types of socket's we need to deal with - relevant type puns below.
|
||||
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));
|
||||
}
|
||||
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));
|
||||
}
|
||||
#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 <= 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 <= 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/adress, 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);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
|
||||
JanetFunction *fun = janet_getfunction(argv, 1);
|
||||
janet_sched_accept(stream, fun);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_accept,
|
||||
"(net/accept stream &opt timeout)",
|
||||
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
|
||||
"Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Returns a new duplex stream which represents a connection to the client.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
|
||||
double to = janet_optnumber(argv, argc, 1, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_sched_accept(stream, NULL);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_read,
|
||||
"(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);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (janet_keyeq(argv[1], "all")) {
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recvchunk(stream, buffer, INT32_MAX, MSG_NOSIGNAL);
|
||||
} else {
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_chunk,
|
||||
"(net/chunk stream nbytes &opt buf timeout)",
|
||||
"Same a net/read, but will wait for all n bytes to arrive rather than return early. "
|
||||
"Takes an optional timeout in seconds, after which will return nil.") {
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_recv_from,
|
||||
"(net/recv-from stream nbytes buf &opt timoeut)",
|
||||
"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);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 2);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_write,
|
||||
"(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);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
|
||||
double to = janet_optnumber(argv, argc, 2, INFINITY);
|
||||
if (janet_checktype(argv[1], JANET_BUFFER)) {
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_send_buffer(stream, janet_getbuffer(argv, 1), MSG_NOSIGNAL);
|
||||
} else {
|
||||
JanetByteView bytes = janet_getbytes(argv, 1);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_send_to,
|
||||
"(net/send-to stream dest data &opt timeout)",
|
||||
"Writes a datagram to a server stream. dest is a the destination address of the packet. "
|
||||
"Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Returns stream.") {
|
||||
janet_arity(argc, 3, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
|
||||
void *dest = janet_getabstract(argv, 1, &janet_address_type);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (janet_checktype(argv[2], JANET_BUFFER)) {
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_sendto_buffer(stream, janet_getbuffer(argv, 2), dest, MSG_NOSIGNAL);
|
||||
} else {
|
||||
JanetByteView bytes = janet_getbytes(argv, 2);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_flush,
|
||||
"(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);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
|
||||
/* Toggle no delay flag */
|
||||
int flag = 1;
|
||||
setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
|
||||
flag = 0;
|
||||
setsockopt((JSock) stream->handle, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetMethod net_stream_methods[] = {
|
||||
{"chunk", cfun_stream_chunk},
|
||||
{"close", janet_cfun_stream_close},
|
||||
{"read", cfun_stream_read},
|
||||
{"write", cfun_stream_write},
|
||||
{"flush", cfun_stream_flush},
|
||||
{"accept", cfun_stream_accept},
|
||||
{"accept-loop", cfun_stream_accept_loop},
|
||||
{"send-to", cfun_stream_send_to},
|
||||
{"recv-from", cfun_stream_recv_from},
|
||||
{"evread", janet_cfun_stream_read},
|
||||
{"evchunk", janet_cfun_stream_chunk},
|
||||
{"evwrite", janet_cfun_stream_write},
|
||||
{"shutdown", cfun_net_shutdown},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static JanetStream *make_stream(JSock handle, uint32_t flags) {
|
||||
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
|
||||
}
|
||||
|
||||
|
||||
void janet_lib_net(JanetTable *env) {
|
||||
JanetRegExt 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_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, net_cfuns);
|
||||
}
|
||||
|
||||
void janet_net_init(void) {
|
||||
#ifdef JANET_WINDOWS
|
||||
WSADATA wsaData;
|
||||
janet_assert(!WSAStartup(MAKEWORD(2, 2), &wsaData), "could not start winsock");
|
||||
#endif
|
||||
}
|
||||
|
||||
void janet_net_deinit(void) {
|
||||
#ifdef JANET_WINDOWS
|
||||
WSACleanup();
|
||||
#endif
|
||||
}
|
||||
|
||||
#endif
|
||||
1855
src/core/os.c
1855
src/core/os.c
File diff suppressed because it is too large
Load Diff
505
src/core/parse.c
505
src/core/parse.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -26,9 +26,6 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#define JANET_PARSER_DEAD 0x1
|
||||
#define JANET_PARSER_GENERATED_ERROR 0x2
|
||||
|
||||
/* Check if a character is whitespace */
|
||||
static int is_whitespace(uint8_t c) {
|
||||
return c == ' '
|
||||
@@ -51,15 +48,15 @@ static const uint32_t symchars[8] = {
|
||||
};
|
||||
|
||||
/* Check if a character is a valid symbol character
|
||||
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_| */
|
||||
int janet_is_symbol_char(uint8_t c) {
|
||||
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
|
||||
static int is_symbol_char(uint8_t c) {
|
||||
return symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||
}
|
||||
|
||||
/* Validate some utf8. Useful for identifiers. Only validates
|
||||
* the encoding, does not check for valid code points (they
|
||||
* 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 j;
|
||||
while (i < len) {
|
||||
@@ -115,6 +112,8 @@ struct JanetParseState {
|
||||
Consumer consumer;
|
||||
};
|
||||
|
||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
/* Define a stack on the main parser struct */
|
||||
#define DEF_PARSER_STACK(NAME, T, STACK, STACKCOUNT, STACKCAP) \
|
||||
static void NAME(JanetParser *p, T x) { \
|
||||
@@ -123,7 +122,7 @@ static void NAME(JanetParser *p, T x) { \
|
||||
if (newcount > p->STACKCAP) { \
|
||||
T *next; \
|
||||
size_t newcap = 2 * newcount; \
|
||||
next = janet_realloc(p->STACK, sizeof(T) * newcap); \
|
||||
next = realloc(p->STACK, sizeof(T) * newcap); \
|
||||
if (NULL == next) { \
|
||||
JANET_OUT_OF_MEMORY; \
|
||||
} \
|
||||
@@ -167,22 +166,15 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
for (;;) {
|
||||
JanetParseState top = p->states[--p->statecount];
|
||||
JanetParseState *newtop = p->states + p->statecount - 1;
|
||||
/* Source mapping info */
|
||||
if (janet_checktype(val, JANET_TUPLE)) {
|
||||
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line;
|
||||
janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column;
|
||||
}
|
||||
if (newtop->flags & PFLAG_CONTAINER) {
|
||||
/* Source mapping info */
|
||||
if (janet_checktype(val, JANET_TUPLE)) {
|
||||
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line;
|
||||
janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column;
|
||||
}
|
||||
newtop->argn++;
|
||||
/* Keep track of number of values in the root state */
|
||||
if (p->statecount == 1) {
|
||||
p->pending++;
|
||||
/* Root items are always wrapped in a tuple for source map info. */
|
||||
const Janet *tup = janet_tuple_n(&val, 1);
|
||||
janet_tuple_sm_line(tup) = (int32_t) top.line;
|
||||
janet_tuple_sm_column(tup) = (int32_t) top.column;
|
||||
val = janet_wrap_tuple(tup);
|
||||
}
|
||||
if (p->statecount == 1) p->pending++;
|
||||
push_arg(p, val);
|
||||
return;
|
||||
} else if (newtop->flags & PFLAG_READERMAC) {
|
||||
@@ -193,8 +185,12 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
(c == ',') ? "unquote" :
|
||||
(c == ';') ? "splice" :
|
||||
(c == '|') ? "short-fn" :
|
||||
(c == '~') ? "quasiquote" : "<unknown>";
|
||||
t[0] = janet_csymbolv(which);
|
||||
(c == '~') ? "quasiquote" : NULL;
|
||||
if (!which) {
|
||||
t[0] = p->args[--p->argcount];
|
||||
} else {
|
||||
t[0] = janet_csymbolv(which);
|
||||
}
|
||||
t[1] = val;
|
||||
/* Quote source mapping info */
|
||||
janet_tuple_sm_line(t) = (int32_t) newtop->line;
|
||||
@@ -211,8 +207,6 @@ static int checkescape(uint8_t c) {
|
||||
default:
|
||||
return -1;
|
||||
case 'x':
|
||||
case 'u':
|
||||
case 'U':
|
||||
return 1;
|
||||
case 'n':
|
||||
return '\n';
|
||||
@@ -240,24 +234,6 @@ static int checkescape(uint8_t c) {
|
||||
/* Forward declare */
|
||||
static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static void write_codepoint(JanetParser *p, int32_t codepoint) {
|
||||
if (codepoint <= 0x7F) {
|
||||
push_buf(p, (uint8_t) codepoint);
|
||||
} else if (codepoint <= 0x7FF) {
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x1F) | 0xC0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else if (codepoint <= 0xFFFF) {
|
||||
push_buf(p, (uint8_t)((codepoint >> 12) & 0x0F) | 0xE0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else {
|
||||
push_buf(p, (uint8_t)((codepoint >> 18) & 0x07) | 0xF0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 12) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
}
|
||||
}
|
||||
|
||||
static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int digit = to_hex(c);
|
||||
if (digit < 0) {
|
||||
@@ -267,27 +243,7 @@ static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
state->argn = (state->argn << 4) + digit;
|
||||
state->counter--;
|
||||
if (!state->counter) {
|
||||
push_buf(p, (uint8_t)(state->argn & 0xFF));
|
||||
state->argn = 0;
|
||||
state->consumer = stringchar;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int escapeu(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int digit = to_hex(c);
|
||||
if (digit < 0) {
|
||||
p->error = "invalid hex digit in unicode escape";
|
||||
return 1;
|
||||
}
|
||||
state->argn = (state->argn << 4) + digit;
|
||||
state->counter--;
|
||||
if (!state->counter) {
|
||||
if (state->argn > 0x10FFFF) {
|
||||
p->error = "invalid unicode codepoint";
|
||||
return 1;
|
||||
}
|
||||
write_codepoint(p, state->argn);
|
||||
push_buf(p, (state->argn & 0xFF));
|
||||
state->argn = 0;
|
||||
state->consumer = stringchar;
|
||||
}
|
||||
@@ -304,10 +260,6 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
state->counter = 2;
|
||||
state->argn = 0;
|
||||
state->consumer = escapeh;
|
||||
} else if (c == 'u' || c == 'U') {
|
||||
state->counter = c == 'u' ? 4 : 6;
|
||||
state->argn = 0;
|
||||
state->consumer = escapeu;
|
||||
} else {
|
||||
push_buf(p, (uint8_t) e);
|
||||
state->consumer = stringchar;
|
||||
@@ -320,48 +272,11 @@ static int stringend(JanetParser *p, JanetParseState *state) {
|
||||
uint8_t *bufstart = p->buf;
|
||||
int32_t buflen = (int32_t) p->bufcount;
|
||||
if (state->flags & PFLAG_LONGSTRING) {
|
||||
/* Post process to remove leading whitespace */
|
||||
JanetParseState top = p->states[p->statecount - 1];
|
||||
int32_t indent_col = (int32_t) top.column - 1;
|
||||
uint8_t *r = bufstart, *end = r + buflen;
|
||||
/* Check if there are any characters before the start column -
|
||||
* if so, do not reindent. */
|
||||
int reindent = 1;
|
||||
while (reindent && (r < end)) {
|
||||
if (*r++ == '\n') {
|
||||
for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++) {
|
||||
if (*r != ' ') {
|
||||
reindent = 0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
/* Check for leading newline character so we can remove it */
|
||||
if (bufstart[0] == '\n') {
|
||||
bufstart++;
|
||||
buflen--;
|
||||
}
|
||||
/* Now reindent if able to, otherwise just drop leading newline. */
|
||||
if (!reindent) {
|
||||
if (buflen > 0 && bufstart[0] == '\n') {
|
||||
buflen--;
|
||||
bufstart++;
|
||||
}
|
||||
} else {
|
||||
uint8_t *w = bufstart;
|
||||
r = bufstart;
|
||||
while (r < end) {
|
||||
if (*r == '\n') {
|
||||
if (r == bufstart) {
|
||||
/* Skip leading newline */
|
||||
r++;
|
||||
} else {
|
||||
*w++ = *r++;
|
||||
}
|
||||
for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++);
|
||||
} else {
|
||||
*w++ = *r++;
|
||||
}
|
||||
}
|
||||
buflen = (int32_t)(w - bufstart);
|
||||
}
|
||||
/* Check for trailing newline character so we can remove it */
|
||||
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
|
||||
buflen--;
|
||||
}
|
||||
@@ -411,7 +326,8 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
Janet ret;
|
||||
double numval;
|
||||
int32_t blen;
|
||||
if (janet_is_symbol_char(c)) {
|
||||
int prefix_symbol = 0;
|
||||
if (is_symbol_char(c)) {
|
||||
push_buf(p, (uint8_t) c);
|
||||
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
|
||||
return 1;
|
||||
@@ -422,7 +338,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
|
||||
if (p->buf[0] == ':') {
|
||||
/* 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) {
|
||||
p->error = "invalid utf-8 in keyword";
|
||||
return 0;
|
||||
@@ -442,16 +358,26 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
return 0;
|
||||
} else {
|
||||
/* 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) {
|
||||
p->error = "invalid utf-8 in symbol";
|
||||
return 0;
|
||||
}
|
||||
ret = janet_symbolv(p->buf, blen);
|
||||
prefix_symbol = c == '"' || c == '`' || c == '[' || c == '(' || c == '{';
|
||||
}
|
||||
}
|
||||
p->bufcount = 0;
|
||||
popstate(p, ret);
|
||||
if (prefix_symbol) {
|
||||
push_arg(p, ret);
|
||||
/* Set current state to a different state */
|
||||
JanetParseState newState = {0};
|
||||
newState.flags = PFLAG_READERMAC;
|
||||
newState.consumer = root;
|
||||
*state = newState;
|
||||
} else {
|
||||
popstate(p, ret);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -484,23 +410,21 @@ static Janet close_array(JanetParser *p, JanetParseState *state) {
|
||||
|
||||
static Janet close_struct(JanetParser *p, JanetParseState *state) {
|
||||
JanetKV *st = janet_struct_begin(state->argn >> 1);
|
||||
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
|
||||
Janet key = p->args[i];
|
||||
Janet value = p->args[i + 1];
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_struct_put(st, key, value);
|
||||
}
|
||||
p->argcount -= state->argn;
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static Janet close_table(JanetParser *p, JanetParseState *state) {
|
||||
JanetTable *table = janet_table(state->argn >> 1);
|
||||
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
|
||||
Janet key = p->args[i];
|
||||
Janet value = p->args[i + 1];
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_table_put(table, key, value);
|
||||
}
|
||||
p->argcount -= state->argn;
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
@@ -548,8 +472,6 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
}
|
||||
}
|
||||
|
||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
(void) state;
|
||||
p->statecount--;
|
||||
@@ -582,7 +504,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
switch (c) {
|
||||
default:
|
||||
if (is_whitespace(c)) return 1;
|
||||
if (!janet_is_symbol_char(c)) {
|
||||
if (!is_symbol_char(c)) {
|
||||
p->error = "unexpected character";
|
||||
return 1;
|
||||
}
|
||||
@@ -684,30 +606,11 @@ void janet_parser_eof(JanetParser *parser) {
|
||||
size_t oldline = parser->line;
|
||||
janet_parser_consume(parser, '\n');
|
||||
if (parser->statecount > 1) {
|
||||
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->error = "unexpected end of source";
|
||||
}
|
||||
parser->line = oldline;
|
||||
parser->column = oldcolumn;
|
||||
parser->flag |= JANET_PARSER_DEAD;
|
||||
parser->flag = 1;
|
||||
}
|
||||
|
||||
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
||||
@@ -729,7 +632,6 @@ const char *janet_parser_error(JanetParser *parser) {
|
||||
if (status == JANET_PARSE_ERROR) {
|
||||
const char *e = parser->error;
|
||||
parser->error = NULL;
|
||||
parser->flag &= ~JANET_PARSER_GENERATED_ERROR;
|
||||
janet_parser_flush(parser);
|
||||
return e;
|
||||
}
|
||||
@@ -737,20 +639,6 @@ const char *janet_parser_error(JanetParser *parser) {
|
||||
}
|
||||
|
||||
Janet janet_parser_produce(JanetParser *parser) {
|
||||
Janet ret;
|
||||
size_t i;
|
||||
if (parser->pending == 0) return janet_wrap_nil();
|
||||
ret = janet_unwrap_tuple(parser->args[0])[0];
|
||||
for (i = 1; i < parser->argcount; i++) {
|
||||
parser->args[i - 1] = parser->args[i];
|
||||
}
|
||||
parser->pending--;
|
||||
parser->argcount--;
|
||||
parser->states[0].argn--;
|
||||
return ret;
|
||||
}
|
||||
|
||||
Janet janet_parser_produce_wrapped(JanetParser *parser) {
|
||||
Janet ret;
|
||||
size_t i;
|
||||
if (parser->pending == 0) return janet_wrap_nil();
|
||||
@@ -760,7 +648,6 @@ Janet janet_parser_produce_wrapped(JanetParser *parser) {
|
||||
}
|
||||
parser->pending--;
|
||||
parser->argcount--;
|
||||
parser->states[0].argn--;
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -785,9 +672,9 @@ void janet_parser_init(JanetParser *parser) {
|
||||
}
|
||||
|
||||
void janet_parser_deinit(JanetParser *parser) {
|
||||
janet_free(parser->args);
|
||||
janet_free(parser->buf);
|
||||
janet_free(parser->states);
|
||||
free(parser->args);
|
||||
free(parser->buf);
|
||||
free(parser->states);
|
||||
}
|
||||
|
||||
void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
@@ -814,17 +701,17 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
dest->states = NULL;
|
||||
dest->buf = NULL;
|
||||
if (dest->bufcap) {
|
||||
dest->buf = janet_malloc(dest->bufcap);
|
||||
dest->buf = malloc(dest->bufcap);
|
||||
if (!dest->buf) goto nomem;
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
}
|
||||
if (dest->argcap) {
|
||||
dest->args = janet_malloc(sizeof(Janet) * dest->argcap);
|
||||
dest->args = malloc(sizeof(Janet) * dest->argcap);
|
||||
if (!dest->args) goto nomem;
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
}
|
||||
if (dest->statecap) {
|
||||
dest->states = janet_malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
if (!dest->states) goto nomem;
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
}
|
||||
@@ -848,9 +735,6 @@ static int parsermark(void *p, size_t size) {
|
||||
for (i = 0; i < parser->argcount; i++) {
|
||||
janet_mark(parser->args[i]);
|
||||
}
|
||||
if (parser->flag & JANET_PARSER_GENERATED_ERROR) {
|
||||
janet_mark(janet_wrap_string((const uint8_t *) parser->error));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -862,28 +746,17 @@ static int parsergc(void *p, size_t size) {
|
||||
}
|
||||
|
||||
static int parserget(void *p, Janet key, Janet *out);
|
||||
static Janet parsernext(void *p, Janet key);
|
||||
|
||||
const JanetAbstractType janet_parser_type = {
|
||||
"core/parser",
|
||||
parsergc,
|
||||
parsermark,
|
||||
parserget,
|
||||
NULL, /* put */
|
||||
NULL, /* marshal */
|
||||
NULL, /* unmarshal */
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
parsernext,
|
||||
JANET_ATEND_NEXT
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
/* C Function parser */
|
||||
JANET_CORE_FN(cfun_parse_parser,
|
||||
"(parser/new)",
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes and generate a stream of values.") {
|
||||
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
@@ -891,11 +764,7 @@ JANET_CORE_FN(cfun_parse_parser,
|
||||
return janet_wrap_abstract(p);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_consume,
|
||||
"(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.") {
|
||||
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
@@ -920,20 +789,14 @@ JANET_CORE_FN(cfun_parse_consume,
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_eof,
|
||||
"(parser/eof parser)",
|
||||
"Indicate to the parser that the end of file was reached. This puts the parser in the :dead state.") {
|
||||
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
janet_parser_eof(p);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_insert,
|
||||
"(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.") {
|
||||
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetParseState *s = p->states + p->statecount - 1;
|
||||
@@ -945,20 +808,15 @@ JANET_CORE_FN(cfun_parse_insert,
|
||||
if (s->flags & PFLAG_COMMENT) s--;
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
s->argn++;
|
||||
if (p->statecount == 1) {
|
||||
p->pending++;
|
||||
Janet tup = janet_wrap_tuple(janet_tuple_n(argv + 1, 1));
|
||||
push_arg(p, tup);
|
||||
} else {
|
||||
push_arg(p, argv[1]);
|
||||
}
|
||||
if (p->statecount == 1) p->pending++;
|
||||
push_arg(p, argv[1]);
|
||||
} else if (s->flags & (PFLAG_STRING | PFLAG_LONGSTRING)) {
|
||||
const uint8_t *str = janet_to_string(argv[1]);
|
||||
int32_t slen = janet_string_length(str);
|
||||
size_t newcount = p->bufcount + slen;
|
||||
if (p->bufcap < newcount) {
|
||||
size_t newcap = 2 * newcount;
|
||||
p->buf = janet_realloc(p->buf, newcap);
|
||||
p->buf = realloc(p->buf, newcap);
|
||||
if (p->buf == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -972,17 +830,13 @@ JANET_CORE_FN(cfun_parse_insert,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_has_more,
|
||||
"(parser/has-more parser)",
|
||||
"Check if the parser has more values in the value queue.") {
|
||||
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
return janet_wrap_boolean(janet_parser_has_more(p));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_byte,
|
||||
"(parser/byte parser b)",
|
||||
"Input a single byte `b` into the parser byte stream. Returns the parser.") {
|
||||
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
int32_t i = janet_getinteger(argv, 1);
|
||||
@@ -990,13 +844,7 @@ JANET_CORE_FN(cfun_parse_byte,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_status,
|
||||
"(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.") {
|
||||
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *stat = NULL;
|
||||
@@ -1017,69 +865,30 @@ JANET_CORE_FN(cfun_parse_status,
|
||||
return janet_ckeywordv(stat);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_error,
|
||||
"(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`.") {
|
||||
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *err = janet_parser_error(p);
|
||||
if (err) {
|
||||
return (p->flag & JANET_PARSER_GENERATED_ERROR)
|
||||
? janet_wrap_string((const uint8_t *) err)
|
||||
: janet_cstringv(err);
|
||||
}
|
||||
if (err) return janet_cstringv(err);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_produce,
|
||||
"(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);
|
||||
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
if (argc == 2 && janet_truthy(argv[1])) {
|
||||
return janet_parser_produce_wrapped(p);
|
||||
} else {
|
||||
return janet_parser_produce(p);
|
||||
}
|
||||
return janet_parser_produce(p);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_flush,
|
||||
"(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.") {
|
||||
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
janet_parser_flush(p);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_where,
|
||||
"(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);
|
||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
if (argc > 1) {
|
||||
int32_t line = janet_getinteger(argv, 1);
|
||||
if (line < 1)
|
||||
janet_panicf("invalid line number %d", line);
|
||||
p->line = (size_t) line;
|
||||
}
|
||||
if (argc > 2) {
|
||||
int32_t column = janet_getinteger(argv, 2);
|
||||
if (column < 0)
|
||||
janet_panicf("invalid column number %d", column);
|
||||
p->column = (size_t) column;
|
||||
}
|
||||
Janet *tup = janet_tuple_begin(2);
|
||||
tup[0] = janet_wrap_integer(p->line);
|
||||
tup[1] = janet_wrap_integer(p->column);
|
||||
@@ -1095,9 +904,8 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
||||
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
JanetArray *container_args = janet_array(s->argn);
|
||||
for (int32_t i = 0; i < s->argn; i++) {
|
||||
janet_array_push(container_args, args[i]);
|
||||
}
|
||||
container_args->count = s->argn;
|
||||
safe_memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||
janet_table_put(state, janet_ckeywordv("args"),
|
||||
janet_wrap_array(container_args));
|
||||
}
|
||||
@@ -1134,6 +942,7 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
||||
type = (c == '\'') ? "quote" :
|
||||
(c == ',') ? "unquote" :
|
||||
(c == ';') ? "splice" :
|
||||
(c == '|') ? "short-fn" :
|
||||
(c == '~') ? "quasiquote" : "<reader>";
|
||||
} else {
|
||||
type = "root";
|
||||
@@ -1160,30 +969,31 @@ struct ParserStateGetter {
|
||||
};
|
||||
|
||||
static Janet parser_state_delimiters(const JanetParser *_p) {
|
||||
JanetParser *p = (JanetParser *)_p;
|
||||
JanetParser *clone = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
janet_parser_clone(_p, clone);
|
||||
size_t i;
|
||||
const uint8_t *str;
|
||||
size_t oldcount;
|
||||
oldcount = p->bufcount;
|
||||
for (i = 0; i < p->statecount; i++) {
|
||||
JanetParseState *s = p->states + i;
|
||||
oldcount = clone->bufcount;
|
||||
for (i = 0; i < clone->statecount; i++) {
|
||||
JanetParseState *s = clone->states + i;
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
push_buf(p, '(');
|
||||
push_buf(clone, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
push_buf(p, '[');
|
||||
push_buf(clone, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
push_buf(p, '{');
|
||||
push_buf(clone, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
push_buf(p, '"');
|
||||
push_buf(clone, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
push_buf(p, '`');
|
||||
push_buf(clone, '`');
|
||||
}
|
||||
}
|
||||
}
|
||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||
p->bufcount = oldcount;
|
||||
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
|
||||
clone->bufcount = oldcount;
|
||||
return janet_wrap_string(str);
|
||||
}
|
||||
|
||||
@@ -1192,14 +1002,11 @@ static Janet parser_state_frames(const JanetParser *p) {
|
||||
JanetArray *states = janet_array(count);
|
||||
states->count = count;
|
||||
uint8_t *buf = p->buf;
|
||||
/* Iterate arg stack backwards */
|
||||
Janet *args = p->args + p->argcount;
|
||||
Janet *args = p->args;
|
||||
for (int32_t i = count - 1; i >= 0; --i) {
|
||||
JanetParseState *s = p->states + i;
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
args -= s->argn;
|
||||
}
|
||||
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
|
||||
args -= s->argn;
|
||||
}
|
||||
return janet_wrap_array(states);
|
||||
}
|
||||
@@ -1210,16 +1017,7 @@ static const struct ParserStateGetter parser_state_getters[] = {
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_CORE_FN(cfun_parse_state,
|
||||
"(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.") {
|
||||
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *key = NULL;
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
@@ -1247,11 +1045,7 @@ JANET_CORE_FN(cfun_parse_state,
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_clone,
|
||||
"(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.") {
|
||||
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
@@ -1281,28 +1075,101 @@ static int parserget(void *p, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), parser_methods, out);
|
||||
}
|
||||
|
||||
static Janet parsernext(void *p, Janet key) {
|
||||
(void) p;
|
||||
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 janet 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)\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.")
|
||||
},
|
||||
{
|
||||
"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"
|
||||
"\t:pending - a value is being parsed.\n"
|
||||
"\t:error - a parsing error was encountered.\n"
|
||||
"\t: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"
|
||||
"\t: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."
|
||||
"\t: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)\n\n"
|
||||
"Returns the current line number and column of the parser's internal state.")
|
||||
},
|
||||
{
|
||||
"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 */
|
||||
void janet_lib_parse(JanetTable *env) {
|
||||
JanetRegExt 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);
|
||||
janet_core_cfuns(env, NULL, parse_cfuns);
|
||||
}
|
||||
|
||||
618
src/core/peg.c
618
src/core/peg.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -44,13 +44,9 @@ typedef struct {
|
||||
JanetArray *captures;
|
||||
JanetBuffer *scratch;
|
||||
JanetBuffer *tags;
|
||||
JanetArray *tagged_captures;
|
||||
const Janet *extrav;
|
||||
int32_t *linemap;
|
||||
int32_t extrac;
|
||||
int32_t depth;
|
||||
int32_t linemaplen;
|
||||
int32_t has_backref;
|
||||
enum {
|
||||
PEG_MODE_NORMAL,
|
||||
PEG_MODE_ACCUMULATE
|
||||
@@ -62,7 +58,6 @@ typedef struct {
|
||||
* if one branch fails and try a new branch. */
|
||||
typedef struct {
|
||||
int32_t cap;
|
||||
int32_t tcap;
|
||||
int32_t scratch;
|
||||
} CapState;
|
||||
|
||||
@@ -71,7 +66,6 @@ static CapState cap_save(PegState *s) {
|
||||
CapState cs;
|
||||
cs.scratch = s->scratch->count;
|
||||
cs.cap = s->captures->count;
|
||||
cs.tcap = s->tagged_captures->count;
|
||||
return cs;
|
||||
}
|
||||
|
||||
@@ -79,15 +73,7 @@ static CapState cap_save(PegState *s) {
|
||||
static void cap_load(PegState *s, CapState cs) {
|
||||
s->scratch->count = cs.scratch;
|
||||
s->captures->count = cs.cap;
|
||||
s->tags->count = cs.tcap;
|
||||
s->tagged_captures->count = cs.tcap;
|
||||
}
|
||||
|
||||
/* Load a saved capture state in the case of success. Keeps
|
||||
* tagged captures around for backref. */
|
||||
static void cap_load_keept(PegState *s, CapState cs) {
|
||||
s->scratch->count = cs.scratch;
|
||||
s->captures->count = cs.cap;
|
||||
s->tags->count = cs.cap;
|
||||
}
|
||||
|
||||
/* Add a capture */
|
||||
@@ -95,72 +81,12 @@ static void pushcap(PegState *s, Janet capture, uint32_t tag) {
|
||||
if (s->mode == PEG_MODE_ACCUMULATE) {
|
||||
janet_to_string_b(s->scratch, capture);
|
||||
}
|
||||
if (s->mode == PEG_MODE_NORMAL) {
|
||||
if (tag || s->mode == PEG_MODE_NORMAL) {
|
||||
janet_array_push(s->captures, capture);
|
||||
}
|
||||
if (s->has_backref) {
|
||||
janet_array_push(s->tagged_captures, capture);
|
||||
janet_buffer_push_u8(s->tags, tag);
|
||||
}
|
||||
}
|
||||
|
||||
/* Lazily generate line map to get line and column information for PegState.
|
||||
* line and column are 1-indexed. */
|
||||
typedef struct {
|
||||
int32_t line;
|
||||
int32_t col;
|
||||
} LineCol;
|
||||
static LineCol get_linecol_from_position(PegState *s, int32_t position) {
|
||||
/* Generate if not made yet */
|
||||
if (s->linemaplen < 0) {
|
||||
int32_t newline_count = 0;
|
||||
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
|
||||
if (*c == '\n') newline_count++;
|
||||
}
|
||||
int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count);
|
||||
size_t index = 0;
|
||||
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
|
||||
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
|
||||
}
|
||||
s->linemaplen = newline_count;
|
||||
s->linemap = mem;
|
||||
}
|
||||
/* Do binary search for line. Slightly modified from classic binary search:
|
||||
* - if we find that our current character is a line break, just return immediately.
|
||||
* a newline character is consider to be on the same line as the character before
|
||||
* (\n is line terminator, not line separator).
|
||||
* - in the not-found case, we still want to find the greatest-indexed newline that
|
||||
* is before position. we use that to calcuate the line and column.
|
||||
* - in the case that lo = 0 and s->linemap[0] is still greater than position, we
|
||||
* are on the first line and our column is position + 1. */
|
||||
int32_t hi = s->linemaplen; /* hi is greater than the actual line */
|
||||
int32_t lo = 0; /* lo is less than or equal to the actual line */
|
||||
LineCol ret;
|
||||
while (lo + 1 < hi) {
|
||||
int32_t mid = lo + (hi - lo) / 2;
|
||||
if (s->linemap[mid] >= position) {
|
||||
hi = mid;
|
||||
} else {
|
||||
lo = mid;
|
||||
}
|
||||
}
|
||||
/* first line case */
|
||||
if (s->linemaplen == 0 || (lo == 0 && s->linemap[0] >= position)) {
|
||||
ret.line = 1;
|
||||
ret.col = position + 1;
|
||||
} else {
|
||||
ret.line = lo + 2;
|
||||
ret.col = position - s->linemap[lo];
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Convert a uint64_t to a int64_t by wrapping to a maximum number of bytes */
|
||||
static int64_t peg_convert_u64_s64(uint64_t from, int width) {
|
||||
int shift = 8 * (8 - width);
|
||||
return ((int64_t)(from << shift)) >> shift;
|
||||
}
|
||||
|
||||
/* Prevent stack overflow */
|
||||
#define down1(s) do { \
|
||||
if (0 == --((s)->depth)) janet_panic("peg/match recursed too deeply"); \
|
||||
@@ -224,7 +150,6 @@ tail:
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
|
||||
up1(s);
|
||||
text -= ((int32_t *)rule)[1];
|
||||
return result ? text : NULL;
|
||||
}
|
||||
|
||||
@@ -280,30 +205,6 @@ tail:
|
||||
return (result) ? NULL : text;
|
||||
}
|
||||
|
||||
case RULE_THRU:
|
||||
case RULE_TO: {
|
||||
const uint32_t *rule_a = s->bytecode + rule[1];
|
||||
const uint8_t *next_text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text <= s->text_end) {
|
||||
CapState cs2 = cap_save(s);
|
||||
next_text = peg_rule(s, rule_a, text);
|
||||
if (next_text) {
|
||||
if (rule[0] == RULE_TO) cap_load(s, cs2);
|
||||
break;
|
||||
}
|
||||
cap_load(s, cs2);
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
if (text > s->text_end) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
return rule[0] == RULE_TO ? text : next_text;
|
||||
}
|
||||
|
||||
case RULE_BETWEEN: {
|
||||
uint32_t lo = rule[1];
|
||||
uint32_t hi = rule[2];
|
||||
@@ -337,7 +238,7 @@ tail:
|
||||
uint32_t tag = rule[2];
|
||||
for (int32_t i = s->tags->count - 1; i >= 0; i--) {
|
||||
if (s->tags->data[i] == search) {
|
||||
pushcap(s, s->tagged_captures->data[i], tag);
|
||||
pushcap(s, s->captures->data[i], tag);
|
||||
return text;
|
||||
}
|
||||
}
|
||||
@@ -349,18 +250,6 @@ tail:
|
||||
return text;
|
||||
}
|
||||
|
||||
case RULE_LINE: {
|
||||
LineCol lc = get_linecol_from_position(s, (int32_t)(text - s->text_start));
|
||||
pushcap(s, janet_wrap_number((double)(lc.line)), rule[1]);
|
||||
return text;
|
||||
}
|
||||
|
||||
case RULE_COLUMN: {
|
||||
LineCol lc = get_linecol_from_position(s, (int32_t)(text - s->text_start));
|
||||
pushcap(s, janet_wrap_number((double)(lc.col)), rule[1]);
|
||||
return text;
|
||||
}
|
||||
|
||||
case RULE_ARGUMENT: {
|
||||
int32_t index = ((int32_t *)rule)[1];
|
||||
Janet capture = (index >= s->extrac) ? janet_wrap_nil() : s->extrav[index];
|
||||
@@ -374,39 +263,20 @@ tail:
|
||||
}
|
||||
|
||||
case RULE_CAPTURE: {
|
||||
uint32_t tag = rule[2];
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
||||
up1(s);
|
||||
if (!result) return NULL;
|
||||
/* Specialized pushcap - avoid intermediate string creation */
|
||||
if (!s->has_backref && s->mode == PEG_MODE_ACCUMULATE) {
|
||||
if (!tag && s->mode == PEG_MODE_ACCUMULATE) {
|
||||
janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text));
|
||||
} else {
|
||||
uint32_t tag = rule[2];
|
||||
pushcap(s, janet_stringv(text, (int32_t)(result - text)), tag);
|
||||
}
|
||||
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: {
|
||||
uint32_t tag = rule[2];
|
||||
int oldmode = s->mode;
|
||||
@@ -423,7 +293,7 @@ tail:
|
||||
if (!result) return NULL;
|
||||
Janet cap = janet_stringv(s->scratch->data + cs.scratch,
|
||||
s->scratch->count - cs.scratch);
|
||||
cap_load_keept(s, cs);
|
||||
cap_load(s, cs);
|
||||
pushcap(s, cap, tag);
|
||||
return result;
|
||||
}
|
||||
@@ -454,7 +324,7 @@ tail:
|
||||
s->captures->data + cs.cap,
|
||||
sizeof(Janet) * num_sub_captures);
|
||||
sub_captures->count = num_sub_captures;
|
||||
cap_load_keept(s, cs);
|
||||
cap_load(s, cs);
|
||||
pushcap(s, janet_wrap_array(sub_captures), tag);
|
||||
return result;
|
||||
}
|
||||
@@ -499,7 +369,7 @@ tail:
|
||||
s->captures->data + cs.cap);
|
||||
break;
|
||||
}
|
||||
cap_load_keept(s, cs);
|
||||
cap_load(s, cs);
|
||||
if (rule[0] == RULE_MATCHTIME && !janet_truthy(cap)) return NULL;
|
||||
pushcap(s, cap, tag);
|
||||
return result;
|
||||
@@ -520,8 +390,8 @@ tail:
|
||||
} else {
|
||||
/* Throw generic error */
|
||||
int32_t start = (int32_t)(text - s->text_start);
|
||||
LineCol lc = get_linecol_from_position(s, start);
|
||||
janet_panicf("match error at line %d, column %d", lc.line, lc.col);
|
||||
int32_t end = (int32_t)(result - s->text_start);
|
||||
janet_panicf("match error in range (%d:%d)", start, end);
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
@@ -530,7 +400,7 @@ tail:
|
||||
uint32_t search = rule[1];
|
||||
for (int32_t i = s->tags->count - 1; i >= 0; i--) {
|
||||
if (s->tags->data[i] == search) {
|
||||
Janet capture = s->tagged_captures->data[i];
|
||||
Janet capture = s->captures->data[i];
|
||||
if (!janet_checktype(capture, JANET_STRING))
|
||||
return NULL;
|
||||
const uint8_t *bytes = janet_unwrap_string(capture);
|
||||
@@ -543,103 +413,6 @@ tail:
|
||||
return NULL;
|
||||
}
|
||||
|
||||
case RULE_LENPREFIX: {
|
||||
int oldmode = s->mode;
|
||||
s->mode = PEG_MODE_NORMAL;
|
||||
const uint8_t *next_text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
next_text = peg_rule(s, s->bytecode + rule[1], text);
|
||||
up1(s);
|
||||
if (NULL == next_text) return NULL;
|
||||
s->mode = oldmode;
|
||||
int32_t num_sub_captures = s->captures->count - cs.cap;
|
||||
Janet lencap;
|
||||
if (num_sub_captures <= 0 ||
|
||||
(lencap = s->captures->data[cs.cap], !janet_checkint(lencap))) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
int32_t nrep = janet_unwrap_integer(lencap);
|
||||
/* drop captures from len pattern */
|
||||
cap_load(s, cs);
|
||||
for (int32_t i = 0; i < nrep; i++) {
|
||||
down1(s);
|
||||
next_text = peg_rule(s, s->bytecode + rule[2], next_text);
|
||||
up1(s);
|
||||
if (NULL == next_text) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
return next_text;
|
||||
}
|
||||
|
||||
case RULE_READINT: {
|
||||
uint32_t tag = rule[2];
|
||||
uint32_t signedness = rule[1] & 0x10;
|
||||
uint32_t endianess = rule[1] & 0x20;
|
||||
int width = (int)(rule[1] & 0xF);
|
||||
if (text + width > s->text_end) return NULL;
|
||||
uint64_t accum = 0;
|
||||
if (endianess) {
|
||||
/* BE */
|
||||
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
|
||||
} else {
|
||||
/* LE */
|
||||
for (int i = width - 1; i >= 0; i--) accum = (accum << 8) | text[i];
|
||||
}
|
||||
|
||||
Janet capture_value;
|
||||
/* We can only parse integeres of greater than 6 bytes reliable if int-types are enabled.
|
||||
* Otherwise, we may lose precision, so 6 is the maximum size when int-types are disabled. */
|
||||
#ifdef JANET_INT_TYPES
|
||||
if (width > 6) {
|
||||
if (signedness) {
|
||||
capture_value = janet_wrap_s64(peg_convert_u64_s64(accum, width));
|
||||
} else {
|
||||
capture_value = janet_wrap_u64(accum);
|
||||
}
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
double double_value;
|
||||
if (signedness) {
|
||||
double_value = (double)(peg_convert_u64_s64(accum, width));
|
||||
} else {
|
||||
double_value = (double)accum;
|
||||
}
|
||||
capture_value = janet_wrap_number(double_value);
|
||||
}
|
||||
|
||||
pushcap(s, capture_value, tag);
|
||||
return text + width;
|
||||
}
|
||||
|
||||
case RULE_UNREF: {
|
||||
int32_t tcap = s->tags->count;
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
||||
up1(s);
|
||||
if (!result) return NULL;
|
||||
int32_t final_tcap = s->tags->count;
|
||||
/* Truncate tagged captures to not include items of the given tag */
|
||||
int32_t w = tcap;
|
||||
/* If no tag is given, drop ALL tagged captures */
|
||||
if (rule[2]) {
|
||||
for (int32_t i = tcap; i < final_tcap; i++) {
|
||||
if (s->tags->data[i] != (0xFF & rule[2])) {
|
||||
s->tags->data[w] = s->tags->data[i];
|
||||
s->tagged_captures->data[w] = s->tagged_captures->data[i];
|
||||
w++;
|
||||
}
|
||||
}
|
||||
}
|
||||
s->tags->count = w;
|
||||
s->tagged_captures->count = w;
|
||||
return result;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@@ -656,7 +429,6 @@ typedef struct {
|
||||
Janet form;
|
||||
int depth;
|
||||
uint32_t nexttag;
|
||||
int has_backref;
|
||||
} Builder;
|
||||
|
||||
/* Forward declaration to allow recursion */
|
||||
@@ -885,9 +657,6 @@ static void spec_if(Builder *b, int32_t argc, const Janet *argv) {
|
||||
static void spec_ifnot(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_branch(b, argc, argv, RULE_IFNOT);
|
||||
}
|
||||
static void spec_lenprefix(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_branch(b, argc, argv, RULE_LENPREFIX);
|
||||
}
|
||||
|
||||
static void spec_between(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 3);
|
||||
@@ -955,19 +724,7 @@ static void spec_not(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_NOT);
|
||||
}
|
||||
static void spec_error(Builder *b, int32_t argc, const Janet *argv) {
|
||||
if (argc == 0) {
|
||||
Reserve r = reserve(b, 2);
|
||||
uint32_t rule = peg_compile1(b, janet_wrap_number(0));
|
||||
emit_1(r, RULE_ERROR, rule);
|
||||
} else {
|
||||
spec_onerule(b, argc, argv, RULE_ERROR);
|
||||
}
|
||||
}
|
||||
static void spec_to(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_TO);
|
||||
}
|
||||
static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_THRU);
|
||||
spec_onerule(b, argc, argv, RULE_ERROR);
|
||||
}
|
||||
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_DROP);
|
||||
@@ -991,35 +748,12 @@ static void spec_accumulate(Builder *b, int32_t argc, const Janet *argv) {
|
||||
static void spec_group(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_cap1(b, argc, argv, RULE_GROUP);
|
||||
}
|
||||
static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_cap1(b, argc, argv, RULE_UNREF);
|
||||
}
|
||||
|
||||
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[2]);
|
||||
}
|
||||
|
||||
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_arity(b, argc, 1, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
uint32_t search = emit_tag(b, argv[0]);
|
||||
uint32_t tag = (argc == 2) ? emit_tag(b, argv[1]) : 0;
|
||||
b->has_backref = 1;
|
||||
emit_2(r, RULE_GETTAG, search, tag);
|
||||
}
|
||||
|
||||
@@ -1034,15 +768,8 @@ static void spec_tag1(Builder *b, int32_t argc, const Janet *argv, uint32_t op)
|
||||
static void spec_position(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_tag1(b, argc, argv, RULE_POSITION);
|
||||
}
|
||||
static void spec_line(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_tag1(b, argc, argv, RULE_LINE);
|
||||
}
|
||||
static void spec_column(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_tag1(b, argc, argv, RULE_COLUMN);
|
||||
}
|
||||
|
||||
static void spec_backmatch(Builder *b, int32_t argc, const Janet *argv) {
|
||||
b->has_backref = 1;
|
||||
spec_tag1(b, argc, argv, RULE_BACKMATCH);
|
||||
}
|
||||
|
||||
@@ -1084,36 +811,6 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
|
||||
}
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
#define JANET_MAX_READINT_WIDTH 8
|
||||
#else
|
||||
#define JANET_MAX_READINT_WIDTH 6
|
||||
#endif
|
||||
|
||||
static void spec_readint(Builder *b, int32_t argc, const Janet *argv, uint32_t mask) {
|
||||
peg_arity(b, argc, 1, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
uint32_t tag = (argc == 2) ? emit_tag(b, argv[1]) : 0;
|
||||
int32_t width = peg_getnat(b, argv[0]);
|
||||
if ((width < 0) || (width > JANET_MAX_READINT_WIDTH)) {
|
||||
peg_panicf(b, "width must be between 0 and %d, got %d", JANET_MAX_READINT_WIDTH, width);
|
||||
}
|
||||
emit_2(r, RULE_READINT, mask | ((uint32_t) width), tag);
|
||||
}
|
||||
|
||||
static void spec_uint_le(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x0u);
|
||||
}
|
||||
static void spec_int_le(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x10u);
|
||||
}
|
||||
static void spec_uint_be(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x20u);
|
||||
}
|
||||
static void spec_int_be(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x30u);
|
||||
}
|
||||
|
||||
/* Special compiler form */
|
||||
typedef void (*Special)(Builder *b, int32_t argc, const Janet *argv);
|
||||
typedef struct {
|
||||
@@ -1144,20 +841,14 @@ static const SpecialPair peg_specials[] = {
|
||||
{"capture", spec_capture},
|
||||
{"choice", spec_choice},
|
||||
{"cmt", spec_matchtime},
|
||||
{"column", spec_column},
|
||||
{"constant", spec_constant},
|
||||
{"drop", spec_drop},
|
||||
{"error", spec_error},
|
||||
{"group", spec_group},
|
||||
{"if", spec_if},
|
||||
{"if-not", spec_ifnot},
|
||||
{"int", spec_int_le},
|
||||
{"int-be", spec_int_be},
|
||||
{"lenprefix", spec_lenprefix},
|
||||
{"line", spec_line},
|
||||
{"look", spec_look},
|
||||
{"not", spec_not},
|
||||
{"number", spec_capture_number},
|
||||
{"opt", spec_opt},
|
||||
{"position", spec_position},
|
||||
{"quote", spec_capture},
|
||||
@@ -1167,11 +858,6 @@ static const SpecialPair peg_specials[] = {
|
||||
{"sequence", spec_sequence},
|
||||
{"set", spec_set},
|
||||
{"some", spec_some},
|
||||
{"thru", spec_thru},
|
||||
{"to", spec_to},
|
||||
{"uint", spec_uint_le},
|
||||
{"uint-be", spec_uint_be},
|
||||
{"unref", spec_unref},
|
||||
};
|
||||
|
||||
/* Compile a janet value into a rule and return the rule index. */
|
||||
@@ -1188,9 +874,7 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
|
||||
Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
|
||||
if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
|
||||
nextPeg = (b->default_grammar == NULL)
|
||||
? janet_wrap_nil()
|
||||
: janet_table_get(b->default_grammar, peg);
|
||||
nextPeg = janet_table_get(b->default_grammar, peg);
|
||||
if (janet_checktype(nextPeg, JANET_NIL)) {
|
||||
peg_panic(b, "unknown rule");
|
||||
}
|
||||
@@ -1254,18 +938,6 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
emit_bytes(b, RULE_LITERAL, len, str);
|
||||
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: {
|
||||
/* Build grammar table */
|
||||
const JanetKV *st = janet_unwrap_struct(peg);
|
||||
@@ -1288,14 +960,6 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
const Janet *tup = janet_unwrap_tuple(peg);
|
||||
int32_t len = janet_tuple_length(tup);
|
||||
if (len == 0) peg_panic(b, "tuple in grammar must have non-zero length");
|
||||
if (janet_checkint(tup[0])) {
|
||||
int32_t n = janet_unwrap_integer(tup[0]);
|
||||
if (n < 0) {
|
||||
peg_panicf(b, "expected non-negative integer, got %d", n);
|
||||
}
|
||||
spec_repeat(b, len, tup);
|
||||
break;
|
||||
}
|
||||
if (!janet_checktype(tup[0], JANET_SYMBOL))
|
||||
peg_panicf(b, "expected grammar command, found %v", tup[0]);
|
||||
const uint8_t *sym = janet_unwrap_symbol(tup[0]);
|
||||
@@ -1389,13 +1053,12 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
* bytecode. */
|
||||
uint32_t blen = (int32_t) peg->bytecode_len;
|
||||
uint32_t clen = peg->num_constants;
|
||||
uint8_t *op_flags = janet_calloc(1, blen);
|
||||
uint8_t *op_flags = calloc(1, blen);
|
||||
if (NULL == op_flags) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
/* verify peg bytecode */
|
||||
int32_t has_backref = 0;
|
||||
uint32_t i = 0;
|
||||
while (i < blen) {
|
||||
uint32_t instr = bytecode[i];
|
||||
@@ -1409,15 +1072,9 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
case RULE_NOTNCHAR:
|
||||
case RULE_RANGE:
|
||||
case RULE_POSITION:
|
||||
case RULE_LINE:
|
||||
case RULE_COLUMN:
|
||||
/* [1 word] */
|
||||
i += 2;
|
||||
break;
|
||||
case RULE_BACKMATCH:
|
||||
/* [1 word] */
|
||||
i += 2;
|
||||
has_backref = 1;
|
||||
break;
|
||||
case RULE_SET:
|
||||
/* [8 words] */
|
||||
@@ -1443,7 +1100,6 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
break;
|
||||
case RULE_IF:
|
||||
case RULE_IFNOT:
|
||||
case RULE_LENPREFIX:
|
||||
/* [rule_a, rule_b (b if not a)] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
if (rule[2] >= blen) goto bad;
|
||||
@@ -1458,29 +1114,18 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
i += 4;
|
||||
break;
|
||||
case RULE_ARGUMENT:
|
||||
/* [searchtag, tag] */
|
||||
i += 3;
|
||||
break;
|
||||
case RULE_GETTAG:
|
||||
/* [searchtag, tag] */
|
||||
i += 3;
|
||||
has_backref = 1;
|
||||
break;
|
||||
case RULE_CONSTANT:
|
||||
/* [constant, tag] */
|
||||
if (rule[1] >= clen) goto bad;
|
||||
i += 3;
|
||||
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_GROUP:
|
||||
case RULE_CAPTURE:
|
||||
case RULE_UNREF:
|
||||
/* [rule, tag] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
@@ -1497,18 +1142,11 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
case RULE_ERROR:
|
||||
case RULE_DROP:
|
||||
case RULE_NOT:
|
||||
case RULE_TO:
|
||||
case RULE_THRU:
|
||||
/* [rule] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
i += 2;
|
||||
break;
|
||||
case RULE_READINT:
|
||||
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
|
||||
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
|
||||
i += 3;
|
||||
break;
|
||||
default:
|
||||
goto bad;
|
||||
}
|
||||
@@ -1525,31 +1163,25 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
/* Good return */
|
||||
peg->bytecode = bytecode;
|
||||
peg->constants = constants;
|
||||
peg->has_backref = has_backref;
|
||||
janet_free(op_flags);
|
||||
free(op_flags);
|
||||
return peg;
|
||||
|
||||
bad:
|
||||
janet_free(op_flags);
|
||||
free(op_flags);
|
||||
janet_panic("invalid peg bytecode");
|
||||
}
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
|
||||
static Janet peg_next(void *p, Janet key);
|
||||
|
||||
const JanetAbstractType janet_peg_type = {
|
||||
"core/peg",
|
||||
NULL,
|
||||
peg_mark,
|
||||
cfun_peg_getter,
|
||||
NULL, /* put */
|
||||
NULL,
|
||||
peg_marshal,
|
||||
peg_unmarshal,
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
peg_next,
|
||||
JANET_ATEND_NEXT
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
/* Convert Builder to JanetPeg (Janet Abstract Value) */
|
||||
@@ -1567,7 +1199,6 @@ static JanetPeg *make_peg(Builder *b) {
|
||||
safe_memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||
safe_memcpy(peg->constants, b->constants, constants_size);
|
||||
peg->bytecode_len = janet_v_count(b->bytecode);
|
||||
peg->has_backref = b->has_backref;
|
||||
return peg;
|
||||
}
|
||||
|
||||
@@ -1575,20 +1206,13 @@ static JanetPeg *make_peg(Builder *b) {
|
||||
static JanetPeg *compile_peg(Janet x) {
|
||||
Builder builder;
|
||||
builder.grammar = janet_table(0);
|
||||
builder.default_grammar = NULL;
|
||||
{
|
||||
Janet default_grammarv = janet_dyn("peg-grammar");
|
||||
if (janet_checktype(default_grammarv, JANET_TABLE)) {
|
||||
builder.default_grammar = janet_unwrap_table(default_grammarv);
|
||||
}
|
||||
}
|
||||
builder.default_grammar = janet_get_core_table("default-peg-grammar");
|
||||
builder.tags = janet_table(0);
|
||||
builder.constants = NULL;
|
||||
builder.bytecode = NULL;
|
||||
builder.nexttag = 1;
|
||||
builder.form = x;
|
||||
builder.depth = JANET_RECURSION_GUARD;
|
||||
builder.has_backref = 0;
|
||||
peg_compile1(&builder, x);
|
||||
JanetPeg *peg = make_peg(&builder);
|
||||
builder_cleanup(&builder);
|
||||
@@ -1599,181 +1223,75 @@ static JanetPeg *compile_peg(Janet x) {
|
||||
* C Functions
|
||||
*/
|
||||
|
||||
JANET_CORE_FN(cfun_peg_compile,
|
||||
"(peg/compile peg)",
|
||||
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
|
||||
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment "
|
||||
"the grammar of the peg for otherwise undefined peg keywords.") {
|
||||
static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetPeg *peg = compile_peg(argv[0]);
|
||||
return janet_wrap_abstract(peg);
|
||||
}
|
||||
|
||||
/* Common data for peg cfunctions */
|
||||
typedef struct {
|
||||
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetPeg *peg;
|
||||
PegState s;
|
||||
JanetByteView bytes;
|
||||
JanetByteView repl;
|
||||
int32_t start;
|
||||
} PegCall;
|
||||
|
||||
/* Initialize state for peg cfunctions */
|
||||
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
PegCall ret;
|
||||
int32_t min = get_replace ? 3 : 2;
|
||||
janet_arity(argc, get_replace, -1);
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
||||
ret.peg = janet_unwrap_abstract(argv[0]);
|
||||
peg = janet_unwrap_abstract(argv[0]);
|
||||
} else {
|
||||
ret.peg = compile_peg(argv[0]);
|
||||
peg = compile_peg(argv[0]);
|
||||
}
|
||||
if (get_replace) {
|
||||
ret.repl = janet_getbytes(argv, 1);
|
||||
ret.bytes = janet_getbytes(argv, 2);
|
||||
JanetByteView bytes = janet_getbytes(argv, 1);
|
||||
int32_t start;
|
||||
PegState s;
|
||||
if (argc > 2) {
|
||||
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
|
||||
s.extrac = argc - 3;
|
||||
s.extrav = janet_tuple_n(argv + 3, argc - 3);
|
||||
} else {
|
||||
ret.bytes = janet_getbytes(argv, 1);
|
||||
start = 0;
|
||||
s.extrac = 0;
|
||||
s.extrav = NULL;
|
||||
}
|
||||
if (argc > min) {
|
||||
ret.start = janet_gethalfrange(argv, min, ret.bytes.len, "offset");
|
||||
ret.s.extrac = argc - min - 1;
|
||||
ret.s.extrav = janet_tuple_n(argv + min + 1, argc - min - 1);
|
||||
} else {
|
||||
ret.start = 0;
|
||||
ret.s.extrac = 0;
|
||||
ret.s.extrav = NULL;
|
||||
}
|
||||
ret.s.mode = PEG_MODE_NORMAL;
|
||||
ret.s.text_start = ret.bytes.bytes;
|
||||
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
|
||||
ret.s.depth = JANET_RECURSION_GUARD;
|
||||
ret.s.captures = janet_array(0);
|
||||
ret.s.tagged_captures = janet_array(0);
|
||||
ret.s.scratch = janet_buffer(10);
|
||||
ret.s.tags = janet_buffer(10);
|
||||
ret.s.constants = ret.peg->constants;
|
||||
ret.s.bytecode = ret.peg->bytecode;
|
||||
ret.s.linemap = NULL;
|
||||
ret.s.linemaplen = -1;
|
||||
ret.s.has_backref = ret.peg->has_backref;
|
||||
return ret;
|
||||
s.mode = PEG_MODE_NORMAL;
|
||||
s.text_start = bytes.bytes;
|
||||
s.text_end = bytes.bytes + bytes.len;
|
||||
s.depth = JANET_RECURSION_GUARD;
|
||||
s.captures = janet_array(0);
|
||||
s.scratch = janet_buffer(10);
|
||||
s.tags = janet_buffer(10);
|
||||
s.constants = peg->constants;
|
||||
s.bytecode = peg->bytecode;
|
||||
const uint8_t *result = peg_rule(&s, s.bytecode, bytes.bytes + start);
|
||||
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static void peg_call_reset(PegCall *c) {
|
||||
c->s.captures->count = 0;
|
||||
c->s.scratch->count = 0;
|
||||
c->s.tags->count = 0;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_peg_match,
|
||||
"(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);
|
||||
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();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_peg_find,
|
||||
"(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);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
peg_call_reset(&c);
|
||||
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_peg_find_all,
|
||||
"(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);
|
||||
JanetArray *ret = janet_array(0);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
peg_call_reset(&c);
|
||||
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||
janet_array_push(ret, janet_wrap_integer(i));
|
||||
}
|
||||
return janet_wrap_array(ret);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 1);
|
||||
JanetBuffer *ret = janet_buffer(0);
|
||||
int32_t trail = 0;
|
||||
for (int32_t i = c.start; i < c.bytes.len;) {
|
||||
peg_call_reset(&c);
|
||||
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i);
|
||||
if (NULL != result) {
|
||||
if (trail < i) {
|
||||
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (i - trail));
|
||||
trail = i;
|
||||
}
|
||||
int32_t nexti = (int32_t)(result - c.bytes.bytes);
|
||||
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
|
||||
trail = nexti;
|
||||
if (nexti == i) nexti++;
|
||||
i = nexti;
|
||||
if (only_one) break;
|
||||
} else {
|
||||
i++;
|
||||
}
|
||||
}
|
||||
if (trail < c.bytes.len) {
|
||||
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (c.bytes.len - trail));
|
||||
}
|
||||
return janet_wrap_buffer(ret);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_peg_replace_all,
|
||||
"(peg/replace-all peg repl text &opt start & args)",
|
||||
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.") {
|
||||
return cfun_peg_replace_generic(argc, argv, 0);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_peg_replace,
|
||||
"(peg/replace peg repl text &opt start & args)",
|
||||
"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.") {
|
||||
return cfun_peg_replace_generic(argc, argv, 1);
|
||||
}
|
||||
|
||||
static JanetMethod peg_methods[] = {
|
||||
{"match", cfun_peg_match},
|
||||
{"find", cfun_peg_find},
|
||||
{"find-all", cfun_peg_find_all},
|
||||
{"replace", cfun_peg_replace},
|
||||
{"replace-all", cfun_peg_replace_all},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
|
||||
(void) a;
|
||||
if (!janet_checktype(key, JANET_KEYWORD))
|
||||
return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), peg_methods, out);
|
||||
if (janet_keyeq(key, "match")) {
|
||||
*out = janet_wrap_cfunction(cfun_peg_match);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static Janet peg_next(void *p, Janet key) {
|
||||
(void) p;
|
||||
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.")
|
||||
},
|
||||
{
|
||||
"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 are very "
|
||||
"similar to those defined by LPeg, and have similar capabilities.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the peg module */
|
||||
void janet_lib_peg(JanetTable *env) {
|
||||
JanetRegExt 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_core_cfuns(env, NULL, peg_cfuns);
|
||||
janet_register_abstract_type(&janet_peg_type);
|
||||
}
|
||||
|
||||
|
||||
216
src/core/pp.c
216
src/core/pp.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -39,17 +39,12 @@
|
||||
|
||||
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||
/* Use int32_t range for valid integers because that is the
|
||||
* range most integer-expecting functions in the C api use. */
|
||||
const char *fmt = (x == floor(x) &&
|
||||
x <= JANET_INTMAX_DOUBLE &&
|
||||
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
|
||||
int count;
|
||||
if (x == 0.0) {
|
||||
/* Prevent printing of '-0' */
|
||||
count = 1;
|
||||
buffer->data[buffer->count] = '0';
|
||||
} else {
|
||||
count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
|
||||
}
|
||||
x <= ((double) INT32_MAX) &&
|
||||
x >= ((double) INT32_MIN)) ? "%.0f" : "%g";
|
||||
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
|
||||
buffer->count += count;
|
||||
}
|
||||
|
||||
@@ -128,6 +123,9 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
|
||||
#undef POINTSIZE
|
||||
}
|
||||
|
||||
#undef HEX
|
||||
#undef BUFSIZE
|
||||
|
||||
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
for (int32_t i = 0; i < len; ++i) {
|
||||
@@ -157,11 +155,8 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
||||
case '\\':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
||||
break;
|
||||
case '\t':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
|
||||
break;
|
||||
default:
|
||||
if (c < 32 || c > 126) {
|
||||
if (c < 32 || c > 127) {
|
||||
uint8_t buf[4];
|
||||
buf[0] = '\\';
|
||||
buf[1] = 'x';
|
||||
@@ -193,7 +188,7 @@ static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
|
||||
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
janet_buffer_push_cstring(buffer, "");
|
||||
janet_buffer_push_cstring(buffer, "nil");
|
||||
break;
|
||||
case JANET_BOOLEAN:
|
||||
janet_buffer_push_cstring(buffer,
|
||||
@@ -227,14 +222,12 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
}
|
||||
return;
|
||||
case JANET_CFUNCTION: {
|
||||
JanetCFunRegistry *reg = janet_registry_get(janet_unwrap_cfunction(x));
|
||||
if (NULL != reg) {
|
||||
Janet check = janet_table_get(janet_vm_registry, x);
|
||||
if (janet_checktype(check, JANET_SYMBOL)) {
|
||||
janet_buffer_push_cstring(buffer, "<cfunction ");
|
||||
if (NULL != reg->name_prefix) {
|
||||
janet_buffer_push_cstring(buffer, reg->name_prefix);
|
||||
janet_buffer_push_u8(buffer, '/');
|
||||
}
|
||||
janet_buffer_push_cstring(buffer, reg->name);
|
||||
janet_buffer_push_bytes(buffer,
|
||||
janet_unwrap_symbol(check),
|
||||
janet_string_length(janet_unwrap_symbol(check)));
|
||||
janet_buffer_push_u8(buffer, '>');
|
||||
break;
|
||||
}
|
||||
@@ -261,13 +254,21 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
|
||||
/* 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 */
|
||||
static int contains_bad_chars(const uint8_t *sym, int issym) {
|
||||
int32_t len = janet_string_length(sym);
|
||||
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++) {
|
||||
if (!janet_is_symbol_char(sym[i])) return 1;
|
||||
if (!pp_is_symbol_char(sym[i])) return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -276,9 +277,6 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NIL:
|
||||
janet_buffer_push_cstring(buffer, "nil");
|
||||
return;
|
||||
case JANET_KEYWORD:
|
||||
janet_buffer_push_u8(buffer, ':');
|
||||
break;
|
||||
@@ -345,9 +343,6 @@ struct pretty {
|
||||
int indent;
|
||||
int flags;
|
||||
int32_t bufstartlen;
|
||||
int32_t *keysort_buffer;
|
||||
int32_t keysort_capacity;
|
||||
int32_t keysort_start;
|
||||
JanetTable seen;
|
||||
};
|
||||
|
||||
@@ -356,16 +351,12 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
if (depth == 0) return 1;
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
case JANET_NUMBER:
|
||||
case JANET_BOOLEAN:
|
||||
case JANET_BUFFER:
|
||||
case JANET_STRING:
|
||||
janet_description_b(S->buffer, x);
|
||||
break;
|
||||
case JANET_NUMBER:
|
||||
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
|
||||
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
|
||||
S->buffer->count += count;
|
||||
break;
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
|
||||
@@ -458,7 +449,7 @@ static const char *janet_pretty_colors[] = {
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m"
|
||||
"\x1B[35m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
@@ -468,8 +459,8 @@ static const char *janet_pretty_colors[] = {
|
||||
|
||||
#define JANET_PRETTY_DICT_ONELINE 4
|
||||
#define JANET_PRETTY_IND_ONELINE 10
|
||||
#define JANET_PRETTY_DICT_LIMIT 30
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 160
|
||||
#define JANET_PRETTY_DICT_LIMIT 16
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 16
|
||||
|
||||
/* Helper for pretty printing */
|
||||
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
@@ -536,7 +527,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||
if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
|
||||
if (len > JANET_PRETTY_ARRAY_LIMIT) {
|
||||
for (i = 0; i < 3; i++) {
|
||||
if (i) print_newline(S, 0);
|
||||
janet_pretty_one(S, arr[i], 0);
|
||||
@@ -562,31 +553,14 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
case JANET_STRUCT:
|
||||
case JANET_TABLE: {
|
||||
int istable = janet_checktype(x, JANET_TABLE);
|
||||
janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
|
||||
|
||||
/* For object-like tables, print class name */
|
||||
if (istable) {
|
||||
JanetTable *t = janet_unwrap_table(x);
|
||||
JanetTable *proto = t->proto;
|
||||
janet_buffer_push_cstring(S->buffer, "@");
|
||||
if (NULL != proto) {
|
||||
Janet name = janet_table_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");
|
||||
}
|
||||
}
|
||||
}
|
||||
} 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"));
|
||||
Janet name = janet_table_get(proto, janet_ckeywordv("name"));
|
||||
const uint8_t *n;
|
||||
int32_t len;
|
||||
if (janet_bytes_view(name, &n, &len)) {
|
||||
@@ -599,8 +573,8 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
}
|
||||
}
|
||||
}
|
||||
janet_buffer_push_cstring(S->buffer, "{");
|
||||
}
|
||||
janet_buffer_push_cstring(S->buffer, "{");
|
||||
|
||||
S->depth--;
|
||||
S->indent += 2;
|
||||
@@ -608,55 +582,31 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
} else {
|
||||
int32_t i = 0, len = 0, cap = 0;
|
||||
int first_kv_pair = 1;
|
||||
const JanetKV *kvs = NULL;
|
||||
int counter = 0;
|
||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||
int32_t ks_start = S->keysort_start;
|
||||
|
||||
/* Ensure buffer is large enough to sort keys. */
|
||||
int truncated = 0;
|
||||
int64_t mincap = (int64_t) len + (int64_t) ks_start;
|
||||
if (mincap > INT32_MAX) {
|
||||
truncated = 1;
|
||||
len = 0;
|
||||
mincap = ks_start;
|
||||
}
|
||||
|
||||
if (S->keysort_capacity < mincap) {
|
||||
if (mincap >= INT32_MAX / 2) {
|
||||
S->keysort_capacity = INT32_MAX;
|
||||
} else {
|
||||
S->keysort_capacity = (int32_t)(mincap * 2);
|
||||
}
|
||||
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
|
||||
if (NULL == S->keysort_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
for (i = 0; i < cap; i++) {
|
||||
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
||||
if (first_kv_pair) {
|
||||
first_kv_pair = 0;
|
||||
} else {
|
||||
print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
||||
}
|
||||
janet_pretty_one(S, kvs[i].key, 0);
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
janet_pretty_one(S, kvs[i].value, 1);
|
||||
counter++;
|
||||
if (counter == 10) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
janet_sorted_keys(kvs, cap, S->keysort_buffer + ks_start);
|
||||
S->keysort_start += len;
|
||||
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
|
||||
len = JANET_PRETTY_DICT_LIMIT;
|
||||
truncated = 1;
|
||||
}
|
||||
|
||||
for (i = 0; i < len; i++) {
|
||||
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
||||
int32_t j = S->keysort_buffer[i + ks_start];
|
||||
janet_pretty_one(S, kvs[j].key, 0);
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
janet_pretty_one(S, kvs[j].value, 1);
|
||||
}
|
||||
|
||||
if (truncated) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
}
|
||||
|
||||
S->keysort_start = ks_start;
|
||||
}
|
||||
S->indent -= 2;
|
||||
S->depth++;
|
||||
@@ -679,9 +629,6 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
|
||||
S.indent = 0;
|
||||
S.flags = flags;
|
||||
S.bufstartlen = startlen;
|
||||
S.keysort_capacity = 0;
|
||||
S.keysort_buffer = NULL;
|
||||
S.keysort_start = 0;
|
||||
janet_table_init(&S.seen, 10);
|
||||
janet_pretty_one(&S, x, 0);
|
||||
janet_table_deinit(&S.seen);
|
||||
@@ -704,9 +651,6 @@ static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t
|
||||
S.indent = 0;
|
||||
S.flags = 0;
|
||||
S.bufstartlen = startlen;
|
||||
S.keysort_capacity = 0;
|
||||
S.keysort_buffer = NULL;
|
||||
S.keysort_start = 0;
|
||||
janet_table_init(&S.seen, 10);
|
||||
int res = print_jdn_one(&S, x, depth);
|
||||
janet_table_deinit(&S.seen);
|
||||
@@ -784,7 +728,7 @@ static const char *scanformat(
|
||||
return p;
|
||||
}
|
||||
|
||||
void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
void janet_formatb(JanetBuffer *b, const char *format, va_list args) {
|
||||
const char *format_end = format + strlen(format);
|
||||
const char *c = format;
|
||||
int32_t startlen = b->count;
|
||||
@@ -807,6 +751,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = va_arg(args, long);
|
||||
@@ -857,24 +802,18 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
pushtypes(b, types);
|
||||
break;
|
||||
}
|
||||
case 'M':
|
||||
case 'm':
|
||||
case 'N':
|
||||
case 'n':
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1) depth = JANET_RECURSION_GUARD;
|
||||
if (depth < 1) depth = 4;
|
||||
char d = c[-1];
|
||||
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
int has_color = (d == 'P') || (d == 'Q');
|
||||
int has_oneline = (d == 'Q') || (d == 'q');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
|
||||
break;
|
||||
}
|
||||
@@ -892,7 +831,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
}
|
||||
}
|
||||
if (nb >= MAX_ITEM)
|
||||
janet_panic("format buffer overflow");
|
||||
janet_panicf("format buffer overflow", form);
|
||||
if (nb > 0)
|
||||
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
||||
}
|
||||
@@ -914,7 +853,7 @@ const uint8_t *janet_formatc(const char *format, ...) {
|
||||
va_start(args, format);
|
||||
|
||||
/* Run format */
|
||||
janet_formatbv(&buffer, format, args);
|
||||
janet_formatb(&buffer, format, args);
|
||||
|
||||
/* Iterate length */
|
||||
va_end(args);
|
||||
@@ -924,14 +863,6 @@ const uint8_t *janet_formatc(const char *format, ...) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
JanetBuffer *janet_formatb(JanetBuffer *buffer, const char *format, ...) {
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
janet_formatbv(buffer, format, args);
|
||||
va_end(args);
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Shared implementation between string/format and
|
||||
* buffer/format */
|
||||
void janet_buffer_format(
|
||||
@@ -965,6 +896,7 @@ void janet_buffer_format(
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = janet_getinteger(argv, arg);
|
||||
@@ -983,9 +915,8 @@ void janet_buffer_format(
|
||||
break;
|
||||
}
|
||||
case 's': {
|
||||
JanetByteView bytes = janet_getbytes(argv, arg);
|
||||
const uint8_t *s = bytes.bytes;
|
||||
int32_t l = bytes.len;
|
||||
const uint8_t *s = janet_getstring(argv, arg);
|
||||
int32_t l = janet_string_length(s);
|
||||
if (form[2] == '\0')
|
||||
janet_buffer_push_bytes(b, s, l);
|
||||
else {
|
||||
@@ -1007,27 +938,19 @@ void janet_buffer_format(
|
||||
janet_description_b(b, argv[arg]);
|
||||
break;
|
||||
}
|
||||
case 't':
|
||||
janet_buffer_push_cstring(b, typestr(argv[arg]));
|
||||
break;
|
||||
case 'M':
|
||||
case 'm':
|
||||
case 'N':
|
||||
case 'n':
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1) depth = JANET_RECURSION_GUARD;
|
||||
char d = strfrmt[-1];
|
||||
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
if (depth < 1)
|
||||
depth = 4;
|
||||
char c = strfrmt[-1];
|
||||
int has_color = (c == 'P') || (c == 'Q');
|
||||
int has_oneline = (c == 'Q') || (c == 'q');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
@@ -1045,12 +968,9 @@ void janet_buffer_format(
|
||||
}
|
||||
}
|
||||
if (nb >= MAX_ITEM)
|
||||
janet_panic("format buffer overflow");
|
||||
janet_panicf("format buffer overflow", form);
|
||||
if (nb > 0)
|
||||
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#undef HEX
|
||||
#undef BUFSIZE
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -36,7 +36,7 @@ void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||
}
|
||||
|
||||
void janetc_regalloc_deinit(JanetcRegisterAllocator *ra) {
|
||||
janet_free(ra->chunks);
|
||||
free(ra->chunks);
|
||||
}
|
||||
|
||||
/* Fallbacks for when ctz not available */
|
||||
@@ -70,7 +70,7 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato
|
||||
size = sizeof(uint32_t) * (size_t) dest->capacity;
|
||||
dest->regtemps = 0;
|
||||
if (size) {
|
||||
dest->chunks = janet_malloc(size);
|
||||
dest->chunks = malloc(size);
|
||||
if (!dest->chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -87,7 +87,7 @@ static void pushchunk(JanetcRegisterAllocator *ra) {
|
||||
int32_t newcount = ra->count + 1;
|
||||
if (newcount > ra->capacity) {
|
||||
int32_t newcapacity = newcount * 2;
|
||||
ra->chunks = janet_realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
|
||||
ra->chunks = realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
|
||||
if (!ra->chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -145,7 +145,7 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
|
||||
int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth) {
|
||||
int32_t oldmax = ra->max;
|
||||
if (ra->regtemps & (1 << nth)) {
|
||||
JANET_EXIT("regtemp already allocated");
|
||||
janet_exit("regtemp already allocated");
|
||||
}
|
||||
ra->regtemps |= 1 << nth;
|
||||
int32_t reg = janetc_regalloc_1(ra);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -50,16 +50,15 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber->env = env;
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace_ext(fiber, ret, "");
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, ret);
|
||||
errflags |= 0x01;
|
||||
done = 1;
|
||||
}
|
||||
} else {
|
||||
ret = janet_wrap_string(cres.error);
|
||||
if (cres.macrofiber) {
|
||||
janet_eprintf("compile error in %s: ", sourcePath);
|
||||
janet_stacktrace_ext(cres.macrofiber, ret, "");
|
||||
janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
|
||||
} else {
|
||||
janet_eprintf("compile error in %s: %s\n", sourcePath,
|
||||
(const char *)cres.error);
|
||||
@@ -69,25 +68,25 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
}
|
||||
}
|
||||
|
||||
if (done) break;
|
||||
|
||||
/* Dispatch based on parse state */
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_DEAD:
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_ERROR: {
|
||||
const char *e = janet_parser_error(&parser);
|
||||
case JANET_PARSE_ERROR:
|
||||
errflags |= 0x04;
|
||||
ret = janet_cstringv(e);
|
||||
size_t line = parser.line;
|
||||
size_t col = parser.column;
|
||||
janet_eprintf("%s:%lu:%lu: parse error: %s\n", sourcePath, line, col, e);
|
||||
janet_eprintf("parse error in %s: %s\n",
|
||||
sourcePath, janet_parser_error(&parser));
|
||||
done = 1;
|
||||
break;
|
||||
}
|
||||
case JANET_PARSE_ROOT:
|
||||
case JANET_PARSE_PENDING:
|
||||
if (index == len) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, bytes[index++]);
|
||||
}
|
||||
break;
|
||||
case JANET_PARSE_ROOT:
|
||||
if (index >= len) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
@@ -101,14 +100,6 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
/* Clean up and return errors */
|
||||
janet_parser_deinit(&parser);
|
||||
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) {
|
||||
janet_gcroot(ret);
|
||||
janet_loop();
|
||||
janet_gcunroot(ret);
|
||||
}
|
||||
#endif
|
||||
if (out) *out = ret;
|
||||
return errflags;
|
||||
}
|
||||
@@ -119,19 +110,3 @@ int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Jan
|
||||
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) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -62,8 +62,6 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
JanetSlot *slots = NULL;
|
||||
JanetFopts subopts = opts;
|
||||
subopts.flags &= ~JANET_FOPTS_HINT;
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
return janetc_cslot(x);
|
||||
@@ -84,7 +82,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
||||
}
|
||||
}
|
||||
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)
|
||||
? JOP_MAKE_BRACKET_TUPLE
|
||||
: JOP_MAKE_TUPLE);
|
||||
@@ -93,7 +91,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
||||
int32_t i;
|
||||
JanetArray *array = janet_unwrap_array(x);
|
||||
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);
|
||||
}
|
||||
case JANET_TABLE:
|
||||
@@ -102,8 +100,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
||||
int32_t len, cap = 0;
|
||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
||||
JanetSlot key = quasiquote(subopts, kv->key, depth - 1, level);
|
||||
JanetSlot value = quasiquote(subopts, kv->value, depth - 1, level);
|
||||
JanetSlot key = quasiquote(opts, kv->key, depth - 1, level);
|
||||
JanetSlot value = quasiquote(opts, kv->value, depth - 1, level);
|
||||
key.flags &= ~JANET_SLOT_SPLICED;
|
||||
value.flags &= ~JANET_SLOT_SPLICED;
|
||||
janet_v_push(slots, key);
|
||||
@@ -156,67 +154,6 @@ static int destructure(JanetCompiler *c,
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
JanetSlot nextright = janetc_farslot(c);
|
||||
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);
|
||||
|
||||
c->buffer[label_loop_cond_jump] |= (label_loop_exit - label_loop_cond_jump) << 16;
|
||||
c->buffer[label_loop_loop] |= (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) {
|
||||
janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
|
||||
} else {
|
||||
@@ -305,9 +242,6 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
|
||||
for (i = 1; i < argn - 1; i++) {
|
||||
Janet attr = argv[i];
|
||||
switch (janet_type(attr)) {
|
||||
case JANET_TUPLE:
|
||||
janetc_cerror(c, "unexpected form - did you intend to use defn?");
|
||||
break;
|
||||
default:
|
||||
janetc_cerror(c, "could not add metadata to binding");
|
||||
break;
|
||||
@@ -317,9 +251,6 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
|
||||
case JANET_STRING:
|
||||
janet_table_put(tab, janet_ckeywordv("doc"), attr);
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
janet_table_merge_struct(tab, janet_unwrap_struct(attr));
|
||||
break;
|
||||
}
|
||||
}
|
||||
return tab;
|
||||
@@ -364,20 +295,8 @@ static int varleaf(
|
||||
/* Global var, generate var */
|
||||
JanetSlot refslot;
|
||||
JanetTable *entry = janet_table_clone(reftab);
|
||||
|
||||
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());
|
||||
}
|
||||
|
||||
JanetArray *ref = janet_array(1);
|
||||
janet_array_push(ref, janet_wrap_nil());
|
||||
janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||
@@ -393,11 +312,10 @@ static int varleaf(
|
||||
static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
Janet head;
|
||||
JanetTable *attr_table = handleattr(c, argn, argv);
|
||||
JanetSlot ret = dohead(c, opts, &head, argn, argv);
|
||||
if (c->result.status == JANET_COMPILE_ERROR)
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
destructure(c, argv[0], ret, varleaf, attr_table);
|
||||
destructure(c, argv[0], ret, varleaf, handleattr(c, argn, argv));
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -410,44 +328,28 @@ static int defleaf(
|
||||
JanetTable *entry = janet_table_clone(tab);
|
||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
||||
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 tabslot = janetc_cslot(janet_wrap_table(entry));
|
||||
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
|
||||
}
|
||||
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
|
||||
|
||||
/* Add env entry to env */
|
||||
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 1;
|
||||
} else {
|
||||
return namelocal(c, sym, 0, s);
|
||||
}
|
||||
return namelocal(c, sym, 0, s);
|
||||
}
|
||||
|
||||
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
Janet head;
|
||||
opts.flags &= ~JANET_FOPTS_HINT;
|
||||
JanetTable *attr_table = handleattr(c, argn, argv);
|
||||
JanetSlot ret = dohead(c, opts, &head, argn, argv);
|
||||
if (c->result.status == JANET_COMPILE_ERROR)
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
destructure(c, argv[0], ret, defleaf, attr_table);
|
||||
destructure(c, argv[0], ret, defleaf, handleattr(c, argn, argv));
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -507,9 +409,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
right = janetc_value(bodyopts, truebody);
|
||||
if (!drop && !tail) janetc_copy(c, target, right);
|
||||
janetc_popscope(c);
|
||||
if (!janet_checktype(falsebody, JANET_NIL)) {
|
||||
janetc_throwaway(bodyopts, falsebody);
|
||||
}
|
||||
janetc_throwaway(bodyopts, falsebody);
|
||||
janetc_popscope(c);
|
||||
return target;
|
||||
}
|
||||
@@ -570,28 +470,6 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/* Compile an upscope form. Upscope forms execute their body sequentially and
|
||||
* evaluate to the last expression in the body, but without lexical scope. */
|
||||
static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
int32_t i;
|
||||
JanetSlot ret = janetc_cslot(janet_wrap_nil());
|
||||
JanetCompiler *c = opts.compiler;
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
for (i = 0; i < argn; i++) {
|
||||
if (i != argn - 1) {
|
||||
subopts.flags = JANET_FOPTS_DROP;
|
||||
} else {
|
||||
subopts = opts;
|
||||
}
|
||||
ret = janetc_value(subopts, argv[i]);
|
||||
if (i != argn - 1) {
|
||||
janetc_freeslot(c, ret);
|
||||
}
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Add a funcdef to the top most function scope */
|
||||
static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) {
|
||||
JanetScope *scope = c->scope;
|
||||
@@ -744,11 +622,10 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Check if closure created in while scope. If so,
|
||||
* recompile in a function scope. */
|
||||
if (tempscope.flags & JANET_SCOPE_CLOSURE) {
|
||||
subopts = janetc_fopts_default(c);
|
||||
tempscope.flags |= JANET_SCOPE_UNUSED;
|
||||
janetc_popscope(c);
|
||||
if (c->buffer) janet_v__cnt(c->buffer) = labelwt;
|
||||
if (c->mapbuffer) janet_v__cnt(c->mapbuffer) = labelwt;
|
||||
janet_v__cnt(c->buffer) = labelwt;
|
||||
janet_v__cnt(c->mapbuffer) = labelwt;
|
||||
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife");
|
||||
|
||||
@@ -771,7 +648,6 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Compile function */
|
||||
JanetFuncDef *def = janetc_pop_funcdef(c);
|
||||
def->name = janet_cstring("_while");
|
||||
janet_def_addflags(def);
|
||||
int32_t defindex = janetc_addfuncdef(c, def);
|
||||
/* And then load the closure and call it. */
|
||||
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
|
||||
@@ -822,7 +698,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
int selfref = 0;
|
||||
int seenamp = 0;
|
||||
int seenopt = 0;
|
||||
int namedargs = 0;
|
||||
|
||||
/* Begin function */
|
||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||
@@ -847,9 +722,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
|
||||
/* Keep track of destructured parameters */
|
||||
JanetSlot *destructed_params = NULL;
|
||||
JanetSlot *named_params = NULL;
|
||||
JanetTable *named_table = NULL;
|
||||
JanetSlot named_slot;
|
||||
|
||||
/* Compile function parameters */
|
||||
params = janet_unwrap_tuple(argv[parami]);
|
||||
@@ -857,74 +729,49 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
arity = paramcount;
|
||||
for (i = 0; i < paramcount; i++) {
|
||||
Janet param = params[i];
|
||||
if (namedargs) {
|
||||
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)) {
|
||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||
/* Check for varargs and unfixed arity */
|
||||
const uint8_t *sym = janet_unwrap_symbol(param);
|
||||
if (sym[0] == '&') {
|
||||
if (!janet_cstrcmp(sym, "&")) {
|
||||
if (seenamp) {
|
||||
errmsg = "& in unexpected location";
|
||||
goto error;
|
||||
} else if (i == paramcount - 1) {
|
||||
allow_extra = 1;
|
||||
arity--;
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
arity -= 2;
|
||||
} else {
|
||||
errmsg = "& in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
seenamp = 1;
|
||||
} else if (!janet_cstrcmp(sym, "&opt")) {
|
||||
if (seenopt) {
|
||||
errmsg = "only one &opt allowed";
|
||||
goto error;
|
||||
} else if (i == paramcount - 1) {
|
||||
errmsg = "&opt cannot be last item in parameter list";
|
||||
goto error;
|
||||
}
|
||||
min_arity = i;
|
||||
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
|
||||
if (seenamp) {
|
||||
errmsg = "& in unexpected location";
|
||||
goto error;
|
||||
} else if (i == paramcount - 1) {
|
||||
allow_extra = 1;
|
||||
arity--;
|
||||
seenopt = 1;
|
||||
} else if (!janet_cstrcmp(sym, "&keys")) {
|
||||
if (seenamp) {
|
||||
errmsg = "&keys in unexpected location";
|
||||
goto error;
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
structarg = 1;
|
||||
arity -= 2;
|
||||
} else {
|
||||
errmsg = "&keys in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
seenamp = 1;
|
||||
} else if (!janet_cstrcmp(sym, "&named")) {
|
||||
if (seenamp) {
|
||||
errmsg = "&named in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
arity -= 2;
|
||||
} else {
|
||||
errmsg = "& in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
seenamp = 1;
|
||||
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
|
||||
if (seenopt) {
|
||||
errmsg = "only one &opt allowed";
|
||||
goto error;
|
||||
} else if (i == paramcount - 1) {
|
||||
errmsg = "&opt cannot be last item in parameter list";
|
||||
goto error;
|
||||
}
|
||||
min_arity = i;
|
||||
arity--;
|
||||
seenopt = 1;
|
||||
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) {
|
||||
if (seenamp) {
|
||||
errmsg = "&keys in unexpected location";
|
||||
goto error;
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
structarg = 1;
|
||||
arity = i;
|
||||
seenamp = 1;
|
||||
namedargs = 1;
|
||||
named_table = janet_table(10);
|
||||
named_slot = janetc_farslot(c);
|
||||
arity -= 2;
|
||||
} else {
|
||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||
errmsg = "&keys in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
seenamp = 1;
|
||||
} else {
|
||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||
}
|
||||
} else {
|
||||
janet_v_push(destructed_params, janetc_farslot(c));
|
||||
@@ -943,14 +790,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
}
|
||||
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;
|
||||
if (!seenopt) min_arity = arity;
|
||||
|
||||
@@ -983,7 +822,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
|
||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||
janet_def_addflags(def);
|
||||
defindex = janetc_addfuncdef(c, def);
|
||||
|
||||
/* Ensure enough slots for vararg function. */
|
||||
@@ -1013,7 +851,6 @@ static const JanetSpecial janetc_specials[] = {
|
||||
{"set", janetc_varset},
|
||||
{"splice", janetc_splice},
|
||||
{"unquote", janetc_unquote},
|
||||
{"upscope", janetc_upscope},
|
||||
{"var", janetc_var},
|
||||
{"while", janetc_while}
|
||||
};
|
||||
|
||||
190
src/core/state.h
190
src/core/state.h
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -25,160 +25,64 @@
|
||||
|
||||
#include <stdint.h>
|
||||
|
||||
typedef int64_t JanetTimestamp;
|
||||
/* The VM state. Rather than a struct that is passed
|
||||
* around, the vm state is global for simplicity. If
|
||||
* at some point a global state object, or context,
|
||||
* is required to be passed around, this is what would
|
||||
* be in it. However, thread local global variables for interpreter
|
||||
* state should allow easy multi-threading. */
|
||||
|
||||
typedef struct JanetScratch {
|
||||
JanetScratchFinalizer finalize;
|
||||
long long mem[]; /* for proper alignment */
|
||||
} JanetScratch;
|
||||
typedef struct JanetScratch JanetScratch;
|
||||
|
||||
typedef struct {
|
||||
JanetGCObject *self;
|
||||
JanetGCObject *other;
|
||||
int32_t index;
|
||||
int32_t index2;
|
||||
} JanetTraversalNode;
|
||||
/* Cache the core environment */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
|
||||
typedef struct {
|
||||
int32_t capacity;
|
||||
int32_t head;
|
||||
int32_t tail;
|
||||
void *data;
|
||||
} JanetQueue;
|
||||
/* How many VM stacks have been entered */
|
||||
extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||
|
||||
typedef struct {
|
||||
JanetTimestamp when;
|
||||
JanetFiber *fiber;
|
||||
JanetFiber *curr_fiber;
|
||||
uint32_t sched_id;
|
||||
int is_error;
|
||||
} JanetTimeout;
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by janet_run. */
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
|
||||
/* Registry table for C functions - containts metadata that can
|
||||
* be looked up by cfunction pointer. All strings here are pointing to
|
||||
* static memory not managed by Janet. */
|
||||
typedef struct {
|
||||
JanetCFunction cfun;
|
||||
const char *name;
|
||||
const char *name_prefix;
|
||||
const char *source_file;
|
||||
int32_t source_line;
|
||||
/* int32_t min_arity; */
|
||||
/* int32_t max_arity; */
|
||||
} JanetCFunRegistry;
|
||||
/* The current pointer to the inner most jmp_buf. The current
|
||||
* return point for panics. */
|
||||
extern JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf;
|
||||
extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
|
||||
|
||||
struct JanetVM {
|
||||
/* Place for user data */
|
||||
void *user;
|
||||
/* The global registry for c functions. Used to store meta-data
|
||||
* along with otherwise bare c function pointers. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
|
||||
/* Top level dynamic bindings */
|
||||
JanetTable *top_dyns;
|
||||
/* Registry for abstract abstract types that can be marshalled.
|
||||
* We need this to look up the constructors when unmarshalling. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
|
||||
|
||||
/* Cache the core environment */
|
||||
JanetTable *core_env;
|
||||
/* Immutable value cache */
|
||||
extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_count;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
|
||||
|
||||
/* How many VM stacks have been entered */
|
||||
int stackn;
|
||||
/* Garbage collection */
|
||||
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
|
||||
|
||||
/* If this flag is true, suspend on function calls and backwards jumps.
|
||||
* When this occurs, this flag will be reset to 0. */
|
||||
int auto_suspend;
|
||||
/* GC roots */
|
||||
extern JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by janet_run. */
|
||||
JanetFiber *fiber;
|
||||
JanetFiber *root_fiber;
|
||||
/* Scratch memory */
|
||||
extern JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
/* The current pointer to the inner most jmp_buf. The current
|
||||
* return point for panics. */
|
||||
jmp_buf *signal_buf;
|
||||
Janet *return_reg;
|
||||
|
||||
/* The global registry for c functions. Used to store meta-data
|
||||
* along with otherwise bare c function pointers. */
|
||||
JanetCFunRegistry *registry;
|
||||
size_t registry_cap;
|
||||
size_t registry_count;
|
||||
int registry_dirty;
|
||||
|
||||
/* Registry for abstract abstract types that can be marshalled.
|
||||
* We need this to look up the constructors when unmarshalling. */
|
||||
JanetTable *abstract_registry;
|
||||
|
||||
/* Immutable value cache */
|
||||
const uint8_t **cache;
|
||||
uint32_t cache_capacity;
|
||||
uint32_t cache_count;
|
||||
uint32_t cache_deleted;
|
||||
uint8_t gensym_counter[8];
|
||||
|
||||
/* Garbage collection */
|
||||
void *blocks;
|
||||
size_t gc_interval;
|
||||
size_t next_collection;
|
||||
size_t block_count;
|
||||
int gc_suspend;
|
||||
|
||||
/* GC roots */
|
||||
Janet *roots;
|
||||
size_t root_count;
|
||||
size_t root_capacity;
|
||||
|
||||
/* Scratch memory */
|
||||
JanetScratch **scratch_mem;
|
||||
size_t scratch_cap;
|
||||
size_t scratch_len;
|
||||
|
||||
/* Random number generator */
|
||||
JanetRNG rng;
|
||||
|
||||
/* Traversal pointers */
|
||||
JanetTraversalNode *traversal;
|
||||
JanetTraversalNode *traversal_top;
|
||||
JanetTraversalNode *traversal_base;
|
||||
|
||||
/* Event loop and scheduler globals */
|
||||
#ifdef JANET_EV
|
||||
size_t tq_count;
|
||||
size_t tq_capacity;
|
||||
JanetQueue spawn;
|
||||
JanetTimeout *tq;
|
||||
JanetRNG ev_rng;
|
||||
JanetListenerState **listeners;
|
||||
size_t listener_count;
|
||||
size_t listener_cap;
|
||||
size_t extra_listeners;
|
||||
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
|
||||
#ifdef JANET_WINDOWS
|
||||
void **iocp;
|
||||
#elif defined(JANET_EV_EPOLL)
|
||||
JanetHandle selfpipe[2];
|
||||
int epoll;
|
||||
int timerfd;
|
||||
int timer_enabled;
|
||||
#elif defined(JANET_EV_KQUEUE)
|
||||
JanetHandle selfpipe[2];
|
||||
int kq;
|
||||
int timer;
|
||||
int timer_enabled;
|
||||
#else
|
||||
JanetHandle selfpipe[2];
|
||||
struct pollfd *fds;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
};
|
||||
|
||||
extern JANET_THREAD_LOCAL JanetVM janet_vm;
|
||||
|
||||
#ifdef JANET_NET
|
||||
void janet_net_init(void);
|
||||
void janet_net_deinit(void);
|
||||
#endif
|
||||
|
||||
#ifdef JANET_EV
|
||||
void janet_ev_init(void);
|
||||
void janet_ev_deinit(void);
|
||||
/* Setup / teardown */
|
||||
#ifdef JANET_THREADS
|
||||
void janet_threads_init(void);
|
||||
void janet_threads_deinit(void);
|
||||
#endif
|
||||
|
||||
#endif /* JANET_STATE_H_defined */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -62,7 +62,7 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
|
||||
int32_t ylen = janet_string_length(rhs);
|
||||
int32_t len = xlen > ylen ? ylen : xlen;
|
||||
int res = memcmp(lhs, rhs, len);
|
||||
if (res) return res > 0 ? 1 : -1;
|
||||
if (res) return res;
|
||||
if (xlen == ylen) return 0;
|
||||
return xlen < ylen ? -1 : 1;
|
||||
}
|
||||
@@ -108,7 +108,7 @@ static void kmp_init(
|
||||
if (patlen == 0) {
|
||||
janet_panic("expected non-empty pattern");
|
||||
}
|
||||
int32_t *lookup = janet_calloc(patlen, sizeof(int32_t));
|
||||
int32_t *lookup = calloc(patlen, sizeof(int32_t));
|
||||
if (!lookup) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -131,7 +131,7 @@ static void kmp_init(
|
||||
}
|
||||
|
||||
static void kmp_deinit(struct kmp_state *state) {
|
||||
janet_free(state->lookup);
|
||||
free(state->lookup);
|
||||
}
|
||||
|
||||
static void kmp_seti(struct kmp_state *state, int32_t i) {
|
||||
@@ -170,37 +170,13 @@ static int32_t kmp_next(struct kmp_state *state) {
|
||||
|
||||
/* CFuns */
|
||||
|
||||
JANET_CORE_FN(cfun_string_slice,
|
||||
"(string/slice bytes &opt start end)",
|
||||
"Returns a substring from a byte sequence. The substring is from "
|
||||
"index `start` inclusive to index `end`, exclusive. All indexing "
|
||||
"is from 0. `start` and `end` can also be negative to indicate indexing "
|
||||
"from the end of the string. Note that index -1 is synonymous with "
|
||||
"index `(length bytes)` to allow a full negative slice range. ") {
|
||||
static Janet cfun_string_slice(int32_t argc, Janet *argv) {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_symbol_slice,
|
||||
"(symbol/slice bytes &opt start end)",
|
||||
"Same as string/slice, but returns a symbol.") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_symbolv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_keyword_slice,
|
||||
"(keyword/slice bytes &opt start end)",
|
||||
"Same as string/slice, but returns a keyword.") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_keywordv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_repeat,
|
||||
"(string/repeat bytes n)",
|
||||
"Returns a string that is `n` copies of `bytes` concatenated.") {
|
||||
static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
int32_t rep = janet_getinteger(argv, 1);
|
||||
@@ -216,9 +192,7 @@ JANET_CORE_FN(cfun_string_repeat,
|
||||
return janet_wrap_string(janet_string_end(newbuf));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_bytes,
|
||||
"(string/bytes str)",
|
||||
"Returns a tuple of integers that are the byte values of the string.") {
|
||||
static Janet cfun_string_bytes(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
Janet *tup = janet_tuple_begin(view.len);
|
||||
@@ -229,10 +203,7 @@ JANET_CORE_FN(cfun_string_bytes,
|
||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_frombytes,
|
||||
"(string/from-bytes & byte-vals)",
|
||||
"Creates a string from integer parameters with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.") {
|
||||
static Janet cfun_string_frombytes(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
uint8_t *buf = janet_string_begin(argc);
|
||||
for (i = 0; i < argc; i++) {
|
||||
@@ -242,11 +213,7 @@ JANET_CORE_FN(cfun_string_frombytes,
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_asciilower,
|
||||
"(string/ascii-lower str)",
|
||||
"Returns a new string where all bytes are replaced with the "
|
||||
"lowercase version of themselves in ASCII. Does only a very simple "
|
||||
"case check, meaning no unicode support.") {
|
||||
static Janet cfun_string_asciilower(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
@@ -261,11 +228,7 @@ JANET_CORE_FN(cfun_string_asciilower,
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_asciiupper,
|
||||
"(string/ascii-upper str)",
|
||||
"Returns a new string where all bytes are replaced with the "
|
||||
"uppercase version of themselves in ASCII. Does only a very simple "
|
||||
"case check, meaning no unicode support.") {
|
||||
static Janet cfun_string_asciiupper(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
@@ -280,9 +243,7 @@ JANET_CORE_FN(cfun_string_asciiupper,
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_reverse,
|
||||
"(string/reverse str)",
|
||||
"Returns a string that is the reversed version of `str`.") {
|
||||
static Janet cfun_string_reverse(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
@@ -306,11 +267,7 @@ static void findsetup(int32_t argc, Janet *argv, struct kmp_state *s, int32_t ex
|
||||
s->i = start;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_find,
|
||||
"(string/find patt str &opt start-index)",
|
||||
"Searches for the first instance of pattern `patt` in string "
|
||||
"`str`. Returns the index of the first character in `patt` if found, "
|
||||
"otherwise returns nil.") {
|
||||
static Janet cfun_string_find(int32_t argc, Janet *argv) {
|
||||
int32_t result;
|
||||
struct kmp_state state;
|
||||
findsetup(argc, argv, &state, 0);
|
||||
@@ -321,9 +278,7 @@ JANET_CORE_FN(cfun_string_find,
|
||||
: janet_wrap_integer(result);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_hasprefix,
|
||||
"(string/has-prefix? pfx str)",
|
||||
"Tests whether `str` starts with `pfx`.") {
|
||||
static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView prefix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
@@ -332,9 +287,7 @@ JANET_CORE_FN(cfun_string_hasprefix,
|
||||
: janet_wrap_boolean(memcmp(prefix.bytes, str.bytes, prefix.len) == 0);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_hassuffix,
|
||||
"(string/has-suffix? sfx str)",
|
||||
"Tests whether `str` ends with `sfx`.") {
|
||||
static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView suffix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
@@ -345,12 +298,7 @@ JANET_CORE_FN(cfun_string_hassuffix,
|
||||
suffix.len) == 0);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_findall,
|
||||
"(string/find-all patt str &opt start-index)",
|
||||
"Searches for all instances of pattern `patt` in string "
|
||||
"`str`. Returns an array of all indices of found patterns. Overlapping "
|
||||
"instances of the pattern are counted individually, meaning a byte in `str` "
|
||||
"may contribute to multiple found patterns.") {
|
||||
static Janet cfun_string_findall(int32_t argc, Janet *argv) {
|
||||
int32_t result;
|
||||
struct kmp_state state;
|
||||
findsetup(argc, argv, &state, 0);
|
||||
@@ -384,10 +332,7 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
|
||||
s->substlen = subst.len;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_replace,
|
||||
"(string/replace patt subst str)",
|
||||
"Replace the first occurrence of `patt` with `subst` in the string `str`. "
|
||||
"Will return the new string if `patt` is found, otherwise returns `str`.") {
|
||||
static Janet cfun_string_replace(int32_t argc, Janet *argv) {
|
||||
int32_t result;
|
||||
struct replace_state s;
|
||||
uint8_t *buf;
|
||||
@@ -407,11 +352,7 @@ JANET_CORE_FN(cfun_string_replace,
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_replaceall,
|
||||
"(string/replace-all patt subst str)",
|
||||
"Replace all instances of `patt` with `subst` in the string `str`. Overlapping "
|
||||
"matches will not be counted, only the first match in such a span will be replaced. "
|
||||
"Will return the new string if `patt` is found, otherwise returns `str`.") {
|
||||
static Janet cfun_string_replaceall(int32_t argc, Janet *argv) {
|
||||
int32_t result;
|
||||
struct replace_state s;
|
||||
JanetBuffer b;
|
||||
@@ -431,13 +372,7 @@ JANET_CORE_FN(cfun_string_replaceall,
|
||||
return janet_wrap_string(ret);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_split,
|
||||
"(string/split delim str &opt start limit)",
|
||||
"Splits a string `str` with delimiter `delim` and returns an array of "
|
||||
"substrings. The substrings will not contain the delimiter `delim`. If `delim` "
|
||||
"is not found, the returned array will have one element. Will start searching "
|
||||
"for `delim` at the index `start` (if provided), and return up to a maximum "
|
||||
"of `limit` results (if provided).") {
|
||||
static Janet cfun_string_split(int32_t argc, Janet *argv) {
|
||||
int32_t result;
|
||||
JanetArray *array;
|
||||
struct kmp_state state;
|
||||
@@ -451,7 +386,6 @@ JANET_CORE_FN(cfun_string_split,
|
||||
const uint8_t *slice = janet_string(state.text + lastindex, result - lastindex);
|
||||
janet_array_push(array, janet_wrap_string(slice));
|
||||
lastindex = result + state.patlen;
|
||||
kmp_seti(&state, lastindex);
|
||||
}
|
||||
const uint8_t *slice = janet_string(state.text + lastindex, state.textlen - lastindex);
|
||||
janet_array_push(array, janet_wrap_string(slice));
|
||||
@@ -459,11 +393,7 @@ JANET_CORE_FN(cfun_string_split,
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_checkset,
|
||||
"(string/check-set set str)",
|
||||
"Checks that the string `str` only contains bytes that appear in the string `set`. "
|
||||
"Returns true if all bytes in `str` appear in `set`, false if some bytes in `str` do "
|
||||
"not appear in `set`.") {
|
||||
static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
|
||||
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView set = janet_getbytes(argv, 0);
|
||||
@@ -485,10 +415,7 @@ JANET_CORE_FN(cfun_string_checkset,
|
||||
return janet_wrap_true();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_join,
|
||||
"(string/join parts &opt sep)",
|
||||
"Joins an array of strings into one string, optionally separated by "
|
||||
"a separator string `sep`.") {
|
||||
static Janet cfun_string_join(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetView parts = janet_getindexed(argv, 0);
|
||||
JanetByteView joiner;
|
||||
@@ -528,10 +455,7 @@ JANET_CORE_FN(cfun_string_join,
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_format,
|
||||
"(string/format format & values)",
|
||||
"Similar to `snprintf`, but specialized for operating with Janet values. Returns "
|
||||
"a new string.") {
|
||||
static Janet cfun_string_format(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_buffer(0);
|
||||
const char *strfrmt = (const char *) janet_getstring(argv, 0);
|
||||
@@ -571,10 +495,7 @@ static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetB
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_trim,
|
||||
"(string/trim str &opt set)",
|
||||
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
||||
"`set` is provided, consider only characters in `set` to be whitespace.") {
|
||||
static Janet cfun_string_trim(int32_t argc, Janet *argv) {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
@@ -584,52 +505,153 @@ JANET_CORE_FN(cfun_string_trim,
|
||||
return janet_stringv(str.bytes + left_edge, right_edge - left_edge);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_triml,
|
||||
"(string/triml str &opt set)",
|
||||
"Trim leading whitespace from a byte sequence. If the argument "
|
||||
"`set` is provided, consider only characters in `set` to be whitespace.") {
|
||||
static Janet cfun_string_triml(int32_t argc, Janet *argv) {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
return janet_stringv(str.bytes + left_edge, str.len - left_edge);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_trimr,
|
||||
"(string/trimr str &opt set)",
|
||||
"Trim trailing whitespace from a byte sequence. If the argument "
|
||||
"`set` is provided, consider only characters in `set` to be whitespace.") {
|
||||
static Janet cfun_string_trimr(int32_t argc, Janet *argv) {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t right_edge = trim_help_rightedge(str, set);
|
||||
return janet_stringv(str.bytes, right_edge);
|
||||
}
|
||||
|
||||
static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/slice", cfun_string_slice,
|
||||
JDOC("(string/slice bytes &opt start end)\n\n"
|
||||
"Returns a substring from a byte sequence. The substring is from "
|
||||
"index start inclusive to index end exclusive. All indexing "
|
||||
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
||||
"from the end of the string. Note that index -1 is synonymous with "
|
||||
"index (length bytes) to allow a full negative slice range. ")
|
||||
},
|
||||
{
|
||||
"string/repeat", cfun_string_repeat,
|
||||
JDOC("(string/repeat bytes n)\n\n"
|
||||
"Returns a string that is n copies of bytes concatenated.")
|
||||
},
|
||||
{
|
||||
"string/bytes", cfun_string_bytes,
|
||||
JDOC("(string/bytes str)\n\n"
|
||||
"Returns an array of integers that are the byte values of the string.")
|
||||
},
|
||||
{
|
||||
"string/from-bytes", cfun_string_frombytes,
|
||||
JDOC("(string/from-bytes & byte-vals)\n\n"
|
||||
"Creates a string from integer params with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.")
|
||||
},
|
||||
{
|
||||
"string/ascii-lower", cfun_string_asciilower,
|
||||
JDOC("(string/ascii-lower str)\n\n"
|
||||
"Returns a new string where all bytes are replaced with the "
|
||||
"lowercase version of themselves in ASCII. Does only a very simple "
|
||||
"case check, meaning no unicode support.")
|
||||
},
|
||||
{
|
||||
"string/ascii-upper", cfun_string_asciiupper,
|
||||
JDOC("(string/ascii-upper str)\n\n"
|
||||
"Returns a new string where all bytes are replaced with the "
|
||||
"uppercase version of themselves in ASCII. Does only a very simple "
|
||||
"case check, meaning no unicode support.")
|
||||
},
|
||||
{
|
||||
"string/reverse", cfun_string_reverse,
|
||||
JDOC("(string/reverse str)\n\n"
|
||||
"Returns a string that is the reversed version of str.")
|
||||
},
|
||||
{
|
||||
"string/find", cfun_string_find,
|
||||
JDOC("(string/find patt str)\n\n"
|
||||
"Searches for the first instance of pattern patt in string "
|
||||
"str. Returns the index of the first character in patt if found, "
|
||||
"otherwise returns nil.")
|
||||
},
|
||||
{
|
||||
"string/find-all", cfun_string_findall,
|
||||
JDOC("(string/find patt str)\n\n"
|
||||
"Searches for all instances of pattern patt in string "
|
||||
"str. Returns an array of all indices of found patterns. Overlapping "
|
||||
"instances of the pattern are not counted, meaning a byte in string "
|
||||
"will only contribute to finding at most on occurrence of pattern. If no "
|
||||
"occurrences are found, will return an empty array.")
|
||||
},
|
||||
{
|
||||
"string/has-prefix?", cfun_string_hasprefix,
|
||||
JDOC("(string/has-prefix? pfx str)\n\n"
|
||||
"Tests whether str starts with pfx.")
|
||||
},
|
||||
{
|
||||
"string/has-suffix?", cfun_string_hassuffix,
|
||||
JDOC("(string/has-suffix? sfx str)\n\n"
|
||||
"Tests whether str ends with sfx.")
|
||||
},
|
||||
{
|
||||
"string/replace", cfun_string_replace,
|
||||
JDOC("(string/replace patt subst str)\n\n"
|
||||
"Replace the first occurrence of patt with subst in the string str. "
|
||||
"Will return the new string if patt is found, otherwise returns str.")
|
||||
},
|
||||
{
|
||||
"string/replace-all", cfun_string_replaceall,
|
||||
JDOC("(string/replace-all patt subst str)\n\n"
|
||||
"Replace all instances of patt with subst in the string str. "
|
||||
"Will return the new string if patt is found, otherwise returns str.")
|
||||
},
|
||||
{
|
||||
"string/split", cfun_string_split,
|
||||
JDOC("(string/split delim str &opt start limit)\n\n"
|
||||
"Splits a string str with delimiter delim and returns an array of "
|
||||
"substrings. The substrings will not contain the delimiter delim. If delim "
|
||||
"is not found, the returned array will have one element. Will start searching "
|
||||
"for delim at the index start (if provided), and return up to a maximum "
|
||||
"of limit results (if provided).")
|
||||
},
|
||||
{
|
||||
"string/check-set", cfun_string_checkset,
|
||||
JDOC("(string/check-set set str)\n\n"
|
||||
"Checks that the string str only contains bytes that appear in the string set. "
|
||||
"Returns true if all bytes in str appear in set, false if some bytes in str do "
|
||||
"not appear in set.")
|
||||
},
|
||||
{
|
||||
"string/join", cfun_string_join,
|
||||
JDOC("(string/join parts &opt sep)\n\n"
|
||||
"Joins an array of strings into one string, optionally separated by "
|
||||
"a separator string sep.")
|
||||
},
|
||||
{
|
||||
"string/format", cfun_string_format,
|
||||
JDOC("(string/format format & values)\n\n"
|
||||
"Similar to snprintf, but specialized for operating with janet. Returns "
|
||||
"a new string.")
|
||||
},
|
||||
{
|
||||
"string/trim", cfun_string_trim,
|
||||
JDOC("(string/trim str &opt set)\n\n"
|
||||
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{
|
||||
"string/triml", cfun_string_triml,
|
||||
JDOC("(string/triml str &opt set)\n\n"
|
||||
"Trim leading whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{
|
||||
"string/trimr", cfun_string_trimr,
|
||||
JDOC("(string/trimr str &opt set)\n\n"
|
||||
"Trim trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_string(JanetTable *env) {
|
||||
JanetRegExt string_cfuns[] = {
|
||||
JANET_CORE_REG("string/slice", cfun_string_slice),
|
||||
JANET_CORE_REG("keyword/slice", cfun_keyword_slice),
|
||||
JANET_CORE_REG("symbol/slice", cfun_symbol_slice),
|
||||
JANET_CORE_REG("string/repeat", cfun_string_repeat),
|
||||
JANET_CORE_REG("string/bytes", cfun_string_bytes),
|
||||
JANET_CORE_REG("string/from-bytes", cfun_string_frombytes),
|
||||
JANET_CORE_REG("string/ascii-lower", cfun_string_asciilower),
|
||||
JANET_CORE_REG("string/ascii-upper", cfun_string_asciiupper),
|
||||
JANET_CORE_REG("string/reverse", cfun_string_reverse),
|
||||
JANET_CORE_REG("string/find", cfun_string_find),
|
||||
JANET_CORE_REG("string/find-all", cfun_string_findall),
|
||||
JANET_CORE_REG("string/has-prefix?", cfun_string_hasprefix),
|
||||
JANET_CORE_REG("string/has-suffix?", cfun_string_hassuffix),
|
||||
JANET_CORE_REG("string/replace", cfun_string_replace),
|
||||
JANET_CORE_REG("string/replace-all", cfun_string_replaceall),
|
||||
JANET_CORE_REG("string/split", cfun_string_split),
|
||||
JANET_CORE_REG("string/check-set", cfun_string_checkset),
|
||||
JANET_CORE_REG("string/join", cfun_string_join),
|
||||
JANET_CORE_REG("string/format", cfun_string_format),
|
||||
JANET_CORE_REG("string/trim", cfun_string_trim),
|
||||
JANET_CORE_REG("string/triml", cfun_string_triml),
|
||||
JANET_CORE_REG("string/trimr", cfun_string_trimr),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, string_cfuns);
|
||||
janet_core_cfuns(env, NULL, string_cfuns);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -87,7 +87,7 @@ static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) {
|
||||
int32_t newn = oldn + n;
|
||||
if (mant->cap < newn) {
|
||||
int32_t newcap = 2 * newn;
|
||||
uint32_t *mem = janet_realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
|
||||
uint32_t *mem = realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -208,9 +208,9 @@ static double convert(
|
||||
|
||||
/* Approximate exponent in base 2 of mant and exponent. This should get us a good estimate of the final size of the
|
||||
* number, within * 2^32 or so. */
|
||||
int64_t mant_exp2_approx = mant->n * 32 + 16;
|
||||
int64_t exp_exp2_approx = (int64_t)(floor(log2(base) * exponent));
|
||||
int64_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
|
||||
int32_t mant_exp2_approx = mant->n * 32 + 16;
|
||||
int32_t exp_exp2_approx = (int32_t)(floor(log2(base) * exponent));
|
||||
int32_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
|
||||
|
||||
/* Short circuit zero, huge, and small numbers. We use the exponent range of valid IEEE754 doubles (-1022, 1023)
|
||||
* with a healthy buffer to allow for inaccuracies in the approximation and denormailzed numbers. */
|
||||
@@ -246,15 +246,15 @@ static double convert(
|
||||
}
|
||||
|
||||
/* Scan a real (double) from a string. If the string cannot be converted into
|
||||
* and integer, return 0. */
|
||||
int janet_scan_number_base(
|
||||
* and integer, set *err to 1 and return 0. */
|
||||
int janet_scan_number(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
int32_t base,
|
||||
double *out) {
|
||||
const uint8_t *end = str + len;
|
||||
int seenadigit = 0;
|
||||
int ex = 0;
|
||||
int base = 10;
|
||||
int seenpoint = 0;
|
||||
int foundexp = 0;
|
||||
int neg = 0;
|
||||
@@ -278,28 +278,21 @@ int janet_scan_number_base(
|
||||
}
|
||||
|
||||
/* Check for leading 0x or digit digit r */
|
||||
if (base == 0) {
|
||||
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||
base = 16;
|
||||
str += 2;
|
||||
} else if (str + 1 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] == 'r') {
|
||||
base = str[0] - '0';
|
||||
str += 2;
|
||||
} else if (str + 2 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] >= '0' && str[1] <= '9' &&
|
||||
str[2] == 'r') {
|
||||
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||
if (base < 2 || base > 36) goto error;
|
||||
str += 3;
|
||||
}
|
||||
}
|
||||
|
||||
/* If still base is 0, set to default (10) */
|
||||
if (base == 0) {
|
||||
base = 10;
|
||||
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||
base = 16;
|
||||
str += 2;
|
||||
} else if (str + 1 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] == 'r') {
|
||||
base = str[0] - '0';
|
||||
str += 2;
|
||||
} else if (str + 2 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] >= '0' && str[1] <= '9' &&
|
||||
str[2] == 'r') {
|
||||
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||
if (base < 2 || base > 36) goto error;
|
||||
str += 3;
|
||||
}
|
||||
|
||||
/* Skip leading zeros */
|
||||
@@ -375,21 +368,14 @@ int janet_scan_number_base(
|
||||
goto error;
|
||||
|
||||
*out = convert(neg, &mant, base, ex);
|
||||
janet_free(mant.digits);
|
||||
free(mant.digits);
|
||||
return 0;
|
||||
|
||||
error:
|
||||
janet_free(mant.digits);
|
||||
free(mant.digits);
|
||||
return 1;
|
||||
}
|
||||
|
||||
int janet_scan_number(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
double *out) {
|
||||
return janet_scan_number_base(str, len, 0, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
static int scan_uint64(
|
||||
@@ -461,7 +447,7 @@ int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
|
||||
int neg;
|
||||
uint64_t bi;
|
||||
if (scan_uint64(str, len, &bi, &neg)) {
|
||||
if (neg && bi <= ((UINT64_MAX / 2) + 1)) {
|
||||
if (neg && bi <= (UINT64_MAX / 2)) {
|
||||
if (bi > INT64_MAX) {
|
||||
*out = INT64_MIN;
|
||||
} else {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -39,14 +39,13 @@ JanetKV *janet_struct_begin(int32_t count) {
|
||||
head->length = count;
|
||||
head->capacity = capacity;
|
||||
head->hash = 0;
|
||||
head->proto = NULL;
|
||||
|
||||
JanetKV *st = (JanetKV *)(head->data);
|
||||
janet_memempty(st, capacity);
|
||||
return st;
|
||||
}
|
||||
|
||||
/* Find an item in a struct without looking for prototypes. Should be similar to janet_dict_find, but
|
||||
/* Find an item in a struct. Should be similar to janet_dict_find, but
|
||||
* specialized to structs (slightly more compact). */
|
||||
const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
|
||||
int32_t cap = janet_struct_capacity(st);
|
||||
@@ -69,7 +68,7 @@ const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
|
||||
* preforms an in-place insertion sort. This ensures the internal structure of the
|
||||
* hash map is independent of insertion order.
|
||||
*/
|
||||
void janet_struct_put_ext(JanetKV *st, Janet key, Janet value, int replace) {
|
||||
void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
int32_t cap = janet_struct_capacity(st);
|
||||
int32_t hash = janet_hash(key);
|
||||
int32_t index = janet_maphash(cap, hash);
|
||||
@@ -124,19 +123,12 @@ void janet_struct_put_ext(JanetKV *st, Janet key, Janet value, int replace) {
|
||||
dist = otherdist;
|
||||
hash = otherhash;
|
||||
} else if (status == 0) {
|
||||
if (replace) {
|
||||
/* A key was added to the struct more than once - replace old value */
|
||||
kv->value = value;
|
||||
}
|
||||
/* A key was added to the struct more than once */
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
janet_struct_put_ext(st, key, value, 1);
|
||||
}
|
||||
|
||||
/* Finish building a struct */
|
||||
const JanetKV *janet_struct_end(JanetKV *st) {
|
||||
if (janet_struct_hash(st) != janet_struct_length(st)) {
|
||||
@@ -150,43 +142,16 @@ const JanetKV *janet_struct_end(JanetKV *st) {
|
||||
janet_struct_put(newst, kv->key, kv->value);
|
||||
}
|
||||
}
|
||||
janet_struct_proto(newst) = janet_struct_proto(st);
|
||||
st = newst;
|
||||
}
|
||||
janet_struct_hash(st) = janet_kv_calchash(st, janet_struct_capacity(st));
|
||||
if (janet_struct_proto(st)) {
|
||||
janet_struct_hash(st) += 2654435761u * janet_struct_hash(janet_struct_proto(st));
|
||||
}
|
||||
return (const JanetKV *)st;
|
||||
}
|
||||
|
||||
/* Get an item from a struct without looking into prototypes. */
|
||||
Janet janet_struct_rawget(const JanetKV *st, Janet key) {
|
||||
const JanetKV *kv = janet_struct_find(st, key);
|
||||
return kv ? kv->value : janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Get an item from a struct */
|
||||
Janet janet_struct_get(const JanetKV *st, Janet key) {
|
||||
for (int i = JANET_MAX_PROTO_DEPTH; st && i; --i, st = janet_struct_proto(st)) {
|
||||
const JanetKV *kv = janet_struct_find(st, key);
|
||||
if (NULL != kv && !janet_checktype(kv->key, JANET_NIL)) {
|
||||
return kv->value;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Get an item from a struct, and record which prototype the item came from. */
|
||||
Janet janet_struct_get_ex(const JanetKV *st, Janet key, JanetStruct *which) {
|
||||
for (int i = JANET_MAX_PROTO_DEPTH; st && i; --i, st = janet_struct_proto(st)) {
|
||||
const JanetKV *kv = janet_struct_find(st, key);
|
||||
if (NULL != kv && !janet_checktype(kv->key, JANET_NIL)) {
|
||||
*which = st;
|
||||
return kv->value;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
const JanetKV *kv = janet_struct_find(st, key);
|
||||
return kv ? kv->value : janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Convert struct to table */
|
||||
@@ -202,106 +167,50 @@ JanetTable *janet_struct_to_table(const JanetKV *st) {
|
||||
return table;
|
||||
}
|
||||
|
||||
/* C Functions */
|
||||
|
||||
JANET_CORE_FN(cfun_struct_with_proto,
|
||||
"(struct/with-proto proto & kvs)",
|
||||
"Create a structure, as with the usual struct constructor but set the "
|
||||
"struct prototype as well.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetStruct proto = janet_optstruct(argv, argc, 0, NULL);
|
||||
if (!(argc & 1))
|
||||
janet_panic("expected odd number of arguments");
|
||||
JanetKV *st = janet_struct_begin(argc / 2);
|
||||
for (int32_t i = 1; i < argc; i += 2) {
|
||||
janet_struct_put(st, argv[i], argv[i + 1]);
|
||||
/* Check if two structs are equal */
|
||||
int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs) {
|
||||
int32_t index;
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
if (llen != rlen)
|
||||
return 0;
|
||||
if (lhash != rhash)
|
||||
return 0;
|
||||
for (index = 0; index < llen; index++) {
|
||||
const JanetKV *l = lhs + index;
|
||||
const JanetKV *r = rhs + index;
|
||||
if (!janet_equals(l->key, r->key))
|
||||
return 0;
|
||||
if (!janet_equals(l->value, r->value))
|
||||
return 0;
|
||||
}
|
||||
janet_struct_proto(st) = proto;
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
return 1;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_struct_getproto,
|
||||
"(struct/getproto st)",
|
||||
"Return the prototype of a struct, or nil if it doesn't have one.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStruct st = janet_getstruct(argv, 0);
|
||||
return janet_struct_proto(st)
|
||||
? janet_wrap_struct(janet_struct_proto(st))
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_struct_flatten,
|
||||
"(struct/proto-flatten st)",
|
||||
"Convert a struct with prototypes to a struct with no prototypes by merging "
|
||||
"all key value pairs from recursive prototypes into one new struct.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStruct st = janet_getstruct(argv, 0);
|
||||
|
||||
/* get an upper bounds on the number of items in the final struct */
|
||||
int64_t pair_count = 0;
|
||||
JanetStruct cursor = st;
|
||||
while (cursor) {
|
||||
pair_count += janet_struct_length(cursor);
|
||||
cursor = janet_struct_proto(cursor);
|
||||
/* Compare structs */
|
||||
int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
|
||||
int32_t i;
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
if (llen < rlen)
|
||||
return -1;
|
||||
if (llen > rlen)
|
||||
return 1;
|
||||
if (lhash < rhash)
|
||||
return -1;
|
||||
if (lhash > rhash)
|
||||
return 1;
|
||||
for (i = 0; i < llen; ++i) {
|
||||
const JanetKV *l = lhs + i;
|
||||
const JanetKV *r = rhs + i;
|
||||
int comp = janet_compare(l->key, r->key);
|
||||
if (comp != 0) return comp;
|
||||
comp = janet_compare(l->value, r->value);
|
||||
if (comp != 0) return comp;
|
||||
}
|
||||
|
||||
if (pair_count > INT32_MAX) {
|
||||
janet_panic("struct too large");
|
||||
}
|
||||
|
||||
JanetKV *accum = janet_struct_begin((int32_t) pair_count);
|
||||
cursor = st;
|
||||
while (cursor) {
|
||||
for (int32_t i = 0; i < janet_struct_capacity(cursor); i++) {
|
||||
const JanetKV *kv = cursor + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_struct_put_ext(accum, kv->key, kv->value, 0);
|
||||
}
|
||||
}
|
||||
cursor = janet_struct_proto(cursor);
|
||||
}
|
||||
return janet_wrap_struct(janet_struct_end(accum));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_struct_to_table,
|
||||
"(struct/to-table st &opt recursive)",
|
||||
"Convert a struct to a table. If recursive is true, also convert the "
|
||||
"table's prototypes into the new struct's prototypes as well.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetStruct st = janet_getstruct(argv, 0);
|
||||
int recursive = argc > 1 && janet_truthy(argv[1]);
|
||||
JanetTable *tab = NULL;
|
||||
JanetStruct cursor = st;
|
||||
JanetTable *tab_cursor = tab;
|
||||
do {
|
||||
if (tab) {
|
||||
tab_cursor->proto = janet_table(janet_struct_length(cursor));
|
||||
tab_cursor = tab_cursor->proto;
|
||||
} else {
|
||||
tab = janet_table(janet_struct_length(cursor));
|
||||
tab_cursor = tab;
|
||||
}
|
||||
/* TODO - implement as memcpy since struct memory should be compatible
|
||||
* with table memory */
|
||||
for (int32_t i = 0; i < janet_struct_capacity(cursor); i++) {
|
||||
const JanetKV *kv = cursor + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_table_put(tab_cursor, kv->key, kv->value);
|
||||
}
|
||||
}
|
||||
cursor = janet_struct_proto(cursor);
|
||||
} while (recursive && cursor);
|
||||
return janet_wrap_table(tab);
|
||||
}
|
||||
|
||||
/* Load the struct module */
|
||||
void janet_lib_struct(JanetTable *env) {
|
||||
JanetRegExt struct_cfuns[] = {
|
||||
JANET_CORE_REG("struct/with-proto", cfun_struct_with_proto),
|
||||
JANET_CORE_REG("struct/getproto", cfun_struct_getproto),
|
||||
JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten),
|
||||
JANET_CORE_REG("struct/to-table", cfun_struct_to_table),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, struct_cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -36,26 +36,30 @@
|
||||
|
||||
#include <string.h>
|
||||
|
||||
/* Cache state */
|
||||
JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity = 0;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_cache_count = 0;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
|
||||
|
||||
/* Initialize the cache (allocate cache memory) */
|
||||
void janet_symcache_init() {
|
||||
janet_vm.cache_capacity = 1024;
|
||||
janet_vm.cache = janet_calloc(1, (size_t) janet_vm.cache_capacity * sizeof(const uint8_t *));
|
||||
if (NULL == janet_vm.cache) {
|
||||
janet_vm_cache_capacity = 1024;
|
||||
janet_vm_cache = calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||
if (NULL == janet_vm_cache) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memset(&janet_vm.gensym_counter, '0', sizeof(janet_vm.gensym_counter));
|
||||
janet_vm.gensym_counter[0] = '_';
|
||||
janet_vm.cache_count = 0;
|
||||
janet_vm.cache_deleted = 0;
|
||||
janet_vm_cache_count = 0;
|
||||
janet_vm_cache_deleted = 0;
|
||||
}
|
||||
|
||||
/* Deinitialize the cache (free the cache memory) */
|
||||
void janet_symcache_deinit() {
|
||||
janet_free((void *)janet_vm.cache);
|
||||
janet_vm.cache = NULL;
|
||||
janet_vm.cache_capacity = 0;
|
||||
janet_vm.cache_count = 0;
|
||||
janet_vm.cache_deleted = 0;
|
||||
free((void *)janet_vm_cache);
|
||||
janet_vm_cache = NULL;
|
||||
janet_vm_cache_capacity = 0;
|
||||
janet_vm_cache_count = 0;
|
||||
janet_vm_cache_deleted = 0;
|
||||
}
|
||||
|
||||
/* Mark an entry in the table as deleted. */
|
||||
@@ -75,24 +79,24 @@ static const uint8_t **janet_symcache_findmem(
|
||||
|
||||
/* We will search two ranges - index to the end,
|
||||
* and 0 to the index. */
|
||||
index = (uint32_t)hash & (janet_vm.cache_capacity - 1);
|
||||
index = (uint32_t)hash & (janet_vm_cache_capacity - 1);
|
||||
bounds[0] = index;
|
||||
bounds[1] = janet_vm.cache_capacity;
|
||||
bounds[1] = janet_vm_cache_capacity;
|
||||
bounds[2] = 0;
|
||||
bounds[3] = index;
|
||||
for (j = 0; j < 4; j += 2)
|
||||
for (i = bounds[j]; i < bounds[j + 1]; ++i) {
|
||||
const uint8_t *test = janet_vm.cache[i];
|
||||
const uint8_t *test = janet_vm_cache[i];
|
||||
/* Check empty spots */
|
||||
if (NULL == test) {
|
||||
if (NULL == firstEmpty)
|
||||
firstEmpty = janet_vm.cache + i;
|
||||
firstEmpty = janet_vm_cache + i;
|
||||
goto notfound;
|
||||
}
|
||||
/* Check for marked deleted */
|
||||
if (JANET_SYMCACHE_DELETED == test) {
|
||||
if (firstEmpty == NULL)
|
||||
firstEmpty = janet_vm.cache + i;
|
||||
firstEmpty = janet_vm_cache + i;
|
||||
continue;
|
||||
}
|
||||
if (janet_string_equalconst(test, str, len, hash)) {
|
||||
@@ -100,10 +104,10 @@ static const uint8_t **janet_symcache_findmem(
|
||||
*success = 1;
|
||||
if (firstEmpty != NULL) {
|
||||
*firstEmpty = test;
|
||||
janet_vm.cache[i] = JANET_SYMCACHE_DELETED;
|
||||
janet_vm_cache[i] = JANET_SYMCACHE_DELETED;
|
||||
return firstEmpty;
|
||||
}
|
||||
return janet_vm.cache + i;
|
||||
return janet_vm_cache + i;
|
||||
}
|
||||
}
|
||||
notfound:
|
||||
@@ -117,15 +121,15 @@ notfound:
|
||||
/* Resize the cache. */
|
||||
static void janet_cache_resize(uint32_t newCapacity) {
|
||||
uint32_t i, oldCapacity;
|
||||
const uint8_t **oldCache = janet_vm.cache;
|
||||
const uint8_t **newCache = janet_calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
|
||||
const uint8_t **oldCache = janet_vm_cache;
|
||||
const uint8_t **newCache = calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
|
||||
if (newCache == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
oldCapacity = janet_vm.cache_capacity;
|
||||
janet_vm.cache = newCache;
|
||||
janet_vm.cache_capacity = newCapacity;
|
||||
janet_vm.cache_deleted = 0;
|
||||
oldCapacity = janet_vm_cache_capacity;
|
||||
janet_vm_cache = newCache;
|
||||
janet_vm_cache_capacity = newCapacity;
|
||||
janet_vm_cache_deleted = 0;
|
||||
/* Add all of the old cache entries back */
|
||||
for (i = 0; i < oldCapacity; ++i) {
|
||||
int status;
|
||||
@@ -141,18 +145,18 @@ static void janet_cache_resize(uint32_t newCapacity) {
|
||||
}
|
||||
}
|
||||
/* Free the old cache */
|
||||
janet_free((void *)oldCache);
|
||||
free((void *)oldCache);
|
||||
}
|
||||
|
||||
/* Add an item to the cache */
|
||||
static void janet_symcache_put(const uint8_t *x, const uint8_t **bucket) {
|
||||
if ((janet_vm.cache_count + janet_vm.cache_deleted) * 2 > janet_vm.cache_capacity) {
|
||||
if ((janet_vm_cache_count + janet_vm_cache_deleted) * 2 > janet_vm_cache_capacity) {
|
||||
int status;
|
||||
janet_cache_resize(janet_tablen((2 * janet_vm.cache_count + 1)));
|
||||
janet_cache_resize(janet_tablen((2 * janet_vm_cache_count + 1)));
|
||||
bucket = janet_symcache_find(x, &status);
|
||||
}
|
||||
/* Add x to the cache */
|
||||
janet_vm.cache_count++;
|
||||
janet_vm_cache_count++;
|
||||
*bucket = x;
|
||||
}
|
||||
|
||||
@@ -161,8 +165,8 @@ void janet_symbol_deinit(const uint8_t *sym) {
|
||||
int status = 0;
|
||||
const uint8_t **bucket = janet_symcache_find(sym, &status);
|
||||
if (status) {
|
||||
janet_vm.cache_count--;
|
||||
janet_vm.cache_deleted++;
|
||||
janet_vm_cache_count--;
|
||||
janet_vm_cache_deleted++;
|
||||
*bucket = JANET_SYMCACHE_DELETED;
|
||||
}
|
||||
}
|
||||
@@ -190,19 +194,22 @@ const uint8_t *janet_csymbol(const char *cstr) {
|
||||
return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
|
||||
}
|
||||
|
||||
/* Store counter for genysm to avoid quadratic behavior */
|
||||
JANET_THREAD_LOCAL uint8_t gensym_counter[8] = {'_', '0', '0', '0', '0', '0', '0', 0};
|
||||
|
||||
/* Increment the gensym buffer */
|
||||
static void inc_gensym(void) {
|
||||
for (int i = sizeof(janet_vm.gensym_counter) - 2; i; i--) {
|
||||
if (janet_vm.gensym_counter[i] == '9') {
|
||||
janet_vm.gensym_counter[i] = 'a';
|
||||
for (int i = sizeof(gensym_counter) - 2; i; i--) {
|
||||
if (gensym_counter[i] == '9') {
|
||||
gensym_counter[i] = 'a';
|
||||
break;
|
||||
} else if (janet_vm.gensym_counter[i] == 'z') {
|
||||
janet_vm.gensym_counter[i] = 'A';
|
||||
} else if (gensym_counter[i] == 'z') {
|
||||
gensym_counter[i] = 'A';
|
||||
break;
|
||||
} else if (janet_vm.gensym_counter[i] == 'Z') {
|
||||
janet_vm.gensym_counter[i] = '0';
|
||||
} else if (gensym_counter[i] == 'Z') {
|
||||
gensym_counter[i] = '0';
|
||||
} else {
|
||||
janet_vm.gensym_counter[i]++;
|
||||
gensym_counter[i]++;
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -220,19 +227,19 @@ const uint8_t *janet_symbol_gen(void) {
|
||||
* is enough for resolving collisions. */
|
||||
do {
|
||||
hash = janet_string_calchash(
|
||||
janet_vm.gensym_counter,
|
||||
sizeof(janet_vm.gensym_counter) - 1);
|
||||
gensym_counter,
|
||||
sizeof(gensym_counter) - 1);
|
||||
bucket = janet_symcache_findmem(
|
||||
janet_vm.gensym_counter,
|
||||
sizeof(janet_vm.gensym_counter) - 1,
|
||||
gensym_counter,
|
||||
sizeof(gensym_counter) - 1,
|
||||
hash,
|
||||
&status);
|
||||
} while (status && (inc_gensym(), 1));
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(janet_vm.gensym_counter));
|
||||
head->length = sizeof(janet_vm.gensym_counter) - 1;
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(gensym_counter));
|
||||
head->length = sizeof(gensym_counter) - 1;
|
||||
head->hash = hash;
|
||||
sym = (uint8_t *)(head->data);
|
||||
memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
|
||||
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
||||
janet_symcache_put((const uint8_t *)sym, bucket);
|
||||
return (const uint8_t *)sym;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
|
||||
219
src/core/table.c
219
src/core/table.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -67,23 +67,14 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in
|
||||
return table;
|
||||
}
|
||||
|
||||
/* Initialize a table (for use withs scratch memory) */
|
||||
/* Initialize a table */
|
||||
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||
return janet_table_init_impl(table, capacity, 1);
|
||||
}
|
||||
|
||||
/* Initialize a table without using scratch memory */
|
||||
JanetTable *janet_table_init_raw(JanetTable *table, int32_t capacity) {
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
/* Deinitialize a table */
|
||||
void janet_table_deinit(JanetTable *table) {
|
||||
if (table->gc.flags & JANET_TABLE_FLAG_STACK) {
|
||||
janet_sfree(table->data);
|
||||
} else {
|
||||
janet_free(table->data);
|
||||
}
|
||||
janet_sfree(table->data);
|
||||
}
|
||||
|
||||
/* Create a new table */
|
||||
@@ -126,27 +117,43 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
|
||||
if (islocal) {
|
||||
janet_sfree(olddata);
|
||||
} else {
|
||||
janet_free(olddata);
|
||||
free(olddata);
|
||||
}
|
||||
}
|
||||
|
||||
/* Get a value out of the table */
|
||||
Janet janet_table_get(JanetTable *t, Janet key) {
|
||||
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
|
||||
return bucket->value;
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
|
||||
return bucket->value;
|
||||
/* Check prototypes */
|
||||
{
|
||||
int i;
|
||||
for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
|
||||
bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
|
||||
return bucket->value;
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Get a value out of the table, and record which prototype it was from. */
|
||||
Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
|
||||
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
||||
*which = t;
|
||||
return bucket->value;
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
||||
*which = t;
|
||||
return bucket->value;
|
||||
}
|
||||
/* Check prototypes */
|
||||
{
|
||||
int i;
|
||||
for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
|
||||
bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
||||
*which = t;
|
||||
return bucket->value;
|
||||
}
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
@@ -166,7 +173,7 @@ Janet janet_table_rawget(JanetTable *t, Janet key) {
|
||||
Janet janet_table_remove(JanetTable *t, Janet key) {
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
||||
Janet ret = bucket->value;
|
||||
Janet ret = bucket->key;
|
||||
t->count--;
|
||||
t->deleted++;
|
||||
bucket->key = janet_wrap_nil();
|
||||
@@ -201,23 +208,6 @@ void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Used internally so don't check arguments
|
||||
* Put into a table, but if the key already exists do nothing. */
|
||||
static void janet_table_put_no_overwrite(JanetTable *t, Janet key, Janet value) {
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
|
||||
return;
|
||||
if (NULL == bucket || 2 * (t->count + t->deleted + 1) > t->capacity) {
|
||||
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
|
||||
}
|
||||
bucket = janet_table_find(t, key);
|
||||
if (janet_checktype(bucket->value, JANET_BOOLEAN))
|
||||
--t->deleted;
|
||||
bucket->key = key;
|
||||
bucket->value = value;
|
||||
++t->count;
|
||||
}
|
||||
|
||||
/* Clear a table */
|
||||
void janet_table_clear(JanetTable *t) {
|
||||
int32_t capacity = t->capacity;
|
||||
@@ -227,6 +217,19 @@ void janet_table_clear(JanetTable *t) {
|
||||
t->deleted = 0;
|
||||
}
|
||||
|
||||
/* Convert table to struct */
|
||||
const JanetKV *janet_table_to_struct(JanetTable *t) {
|
||||
JanetKV *st = janet_struct_begin(t->count);
|
||||
JanetKV *kv = t->data;
|
||||
JanetKV *end = t->data + t->capacity;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL))
|
||||
janet_struct_put(st, kv->key, kv->value);
|
||||
kv++;
|
||||
}
|
||||
return janet_struct_end(st);
|
||||
}
|
||||
|
||||
/* Clone a table. */
|
||||
JanetTable *janet_table_clone(JanetTable *table) {
|
||||
JanetTable *newTable = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
||||
@@ -234,7 +237,7 @@ JanetTable *janet_table_clone(JanetTable *table) {
|
||||
newTable->capacity = table->capacity;
|
||||
newTable->deleted = table->deleted;
|
||||
newTable->proto = table->proto;
|
||||
newTable->data = janet_malloc(newTable->capacity * sizeof(JanetKV));
|
||||
newTable->data = malloc(newTable->capacity * sizeof(JanetKV));
|
||||
if (NULL == newTable->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -253,7 +256,7 @@ static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t c
|
||||
}
|
||||
}
|
||||
|
||||
/* Merge a table into another table */
|
||||
/* Merge a table other into another table */
|
||||
void janet_table_merge_table(JanetTable *table, JanetTable *other) {
|
||||
janet_table_mergekv(table, other->data, other->capacity);
|
||||
}
|
||||
@@ -263,51 +266,15 @@ void janet_table_merge_struct(JanetTable *table, const JanetKV *other) {
|
||||
janet_table_mergekv(table, other, janet_struct_capacity(other));
|
||||
}
|
||||
|
||||
/* Convert table to struct */
|
||||
const JanetKV *janet_table_to_struct(JanetTable *t) {
|
||||
JanetKV *st = janet_struct_begin(t->count);
|
||||
JanetKV *kv = t->data;
|
||||
JanetKV *end = t->data + t->capacity;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL))
|
||||
janet_struct_put(st, kv->key, kv->value);
|
||||
kv++;
|
||||
}
|
||||
return janet_struct_end(st);
|
||||
}
|
||||
|
||||
JanetTable *janet_table_proto_flatten(JanetTable *t) {
|
||||
JanetTable *newTable = janet_table(0);
|
||||
while (t) {
|
||||
JanetKV *kv = t->data;
|
||||
JanetKV *end = t->data + t->capacity;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL))
|
||||
janet_table_put_no_overwrite(newTable, kv->key, kv->value);
|
||||
kv++;
|
||||
}
|
||||
t = t->proto;
|
||||
}
|
||||
return newTable;
|
||||
}
|
||||
|
||||
/* C Functions */
|
||||
|
||||
JANET_CORE_FN(cfun_table_new,
|
||||
"(table/new capacity)",
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for `capacity` entries. This means that if one knows the number of "
|
||||
"entries going into a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table.") {
|
||||
static Janet cfun_table_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getnat(argv, 0);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
return janet_wrap_table(janet_table(cap));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_getproto,
|
||||
"(table/getproto tab)",
|
||||
"Get the prototype table of a table. Returns nil if the table "
|
||||
"has no prototype, otherwise returns the prototype.") {
|
||||
static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
return t->proto
|
||||
@@ -315,9 +282,7 @@ JANET_CORE_FN(cfun_table_getproto,
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_setproto,
|
||||
"(table/setproto tab proto)",
|
||||
"Set the prototype of a table. Returns the original table `tab`.") {
|
||||
static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
JanetTable *proto = NULL;
|
||||
@@ -328,63 +293,67 @@ JANET_CORE_FN(cfun_table_setproto,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_tostruct,
|
||||
"(table/to-struct tab)",
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables.") {
|
||||
static Janet cfun_table_tostruct(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
return janet_wrap_struct(janet_table_to_struct(t));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_rawget,
|
||||
"(table/rawget tab key)",
|
||||
"Gets a value from a table `tab` without looking at the prototype table. "
|
||||
"If `tab` does not contain the key directly, the function will return "
|
||||
"nil without checking the prototype. Returns the value in the table.") {
|
||||
static Janet cfun_table_rawget(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
return janet_table_rawget(table, argv[1]);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_clone,
|
||||
"(table/clone tab)",
|
||||
"Create a copy of a table. Updates to the new table will not change the old table, "
|
||||
"and vice versa.") {
|
||||
static Janet cfun_table_clone(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
return janet_wrap_table(janet_table_clone(table));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_clear,
|
||||
"(table/clear tab)",
|
||||
"Remove all key-value pairs in a table and return the modified table `tab`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
janet_table_clear(table);
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_proto_flatten,
|
||||
"(table/proto-flatten tab)",
|
||||
"Create a new table that is the result of merging all prototypes into a new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
return janet_wrap_table(janet_table_proto_flatten(table));
|
||||
}
|
||||
static const JanetReg table_cfuns[] = {
|
||||
{
|
||||
"table/new", cfun_table_new,
|
||||
JDOC("(table/new capacity)\n\n"
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for capacity entries. This means that if one knows the number of "
|
||||
"entries going to go in a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table.")
|
||||
},
|
||||
{
|
||||
"table/to-struct", cfun_table_tostruct,
|
||||
JDOC("(table/to-struct tab)\n\n"
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables.")
|
||||
},
|
||||
{
|
||||
"table/getproto", cfun_table_getproto,
|
||||
JDOC("(table/getproto tab)\n\n"
|
||||
"Get the prototype table of a table. Returns nil if a table "
|
||||
"has no prototype, otherwise returns the prototype.")
|
||||
},
|
||||
{
|
||||
"table/setproto", cfun_table_setproto,
|
||||
JDOC("(table/setproto tab proto)\n\n"
|
||||
"Set the prototype of a table. Returns the original table tab.")
|
||||
},
|
||||
{
|
||||
"table/rawget", cfun_table_rawget,
|
||||
JDOC("(table/rawget tab key)\n\n"
|
||||
"Gets a value from a table without looking at the prototype table. "
|
||||
"If a table tab does not contain t directly, the function will return "
|
||||
"nil without checking the prototype. Returns the value in the table.")
|
||||
},
|
||||
{
|
||||
"table/clone", cfun_table_clone,
|
||||
JDOC("(table/clone tab)\n\n"
|
||||
"Create a copy of a table. Updates to the new table will not change the old table, "
|
||||
"and vice versa.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the table module */
|
||||
void janet_lib_table(JanetTable *env) {
|
||||
JanetRegExt table_cfuns[] = {
|
||||
JANET_CORE_REG("table/new", cfun_table_new),
|
||||
JANET_CORE_REG("table/to-struct", cfun_table_tostruct),
|
||||
JANET_CORE_REG("table/getproto", cfun_table_getproto),
|
||||
JANET_CORE_REG("table/setproto", cfun_table_setproto),
|
||||
JANET_CORE_REG("table/rawget", cfun_table_rawget),
|
||||
JANET_CORE_REG("table/clone", cfun_table_clone),
|
||||
JANET_CORE_REG("table/clear", cfun_table_clear),
|
||||
JANET_CORE_REG("table/proto-flatten", cfun_table_proto_flatten),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, table_cfuns);
|
||||
janet_core_cfuns(env, NULL, table_cfuns);
|
||||
}
|
||||
|
||||
670
src/core/thread.c
Normal file
670
src/core/thread.c
Normal file
@@ -0,0 +1,670 @@
|
||||
/*
|
||||
* Copyright (c) 2020 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 "gc.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_THREADS
|
||||
|
||||
#include <math.h>
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <setjmp.h>
|
||||
#include <time.h>
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
|
||||
/* typedefed in janet.h */
|
||||
struct JanetMailbox {
|
||||
|
||||
/* Synchronization */
|
||||
#ifdef JANET_WINDOWS
|
||||
CRITICAL_SECTION lock;
|
||||
CONDITION_VARIABLE cond;
|
||||
#else
|
||||
pthread_mutex_t lock;
|
||||
pthread_cond_t cond;
|
||||
#endif
|
||||
|
||||
/* Memory management - reference counting */
|
||||
int refCount;
|
||||
int closed;
|
||||
|
||||
/* Store messages */
|
||||
uint16_t messageCapacity;
|
||||
uint16_t messageCount;
|
||||
uint16_t messageFirst;
|
||||
uint16_t messageNext;
|
||||
|
||||
/* Buffers to store messages. These buffers are manually allocated, so
|
||||
* are not owned by any thread's GC. */
|
||||
JanetBuffer messages[];
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
JanetMailbox *original;
|
||||
JanetMailbox *newbox;
|
||||
} JanetMailboxPair;
|
||||
|
||||
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
|
||||
static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
|
||||
static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
|
||||
|
||||
static JanetTable *janet_thread_get_decode(void) {
|
||||
if (janet_vm_thread_decode == NULL) {
|
||||
janet_vm_thread_decode = janet_get_core_table("load-image-dict");
|
||||
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
|
||||
}
|
||||
return janet_vm_thread_decode;
|
||||
}
|
||||
|
||||
static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
|
||||
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
|
||||
if (NULL == mailbox) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
InitializeCriticalSection(&mailbox->lock);
|
||||
InitializeConditionVariable(&mailbox->cond);
|
||||
#else
|
||||
pthread_mutex_init(&mailbox->lock, NULL);
|
||||
pthread_cond_init(&mailbox->cond, NULL);
|
||||
#endif
|
||||
mailbox->refCount = refCount;
|
||||
mailbox->closed = 0;
|
||||
mailbox->messageCount = 0;
|
||||
mailbox->messageCapacity = capacity;
|
||||
mailbox->messageFirst = 0;
|
||||
mailbox->messageNext = 0;
|
||||
for (uint16_t i = 0; i < capacity; i++) {
|
||||
janet_buffer_init(mailbox->messages + i, 0);
|
||||
}
|
||||
return mailbox;
|
||||
}
|
||||
|
||||
static void janet_mailbox_destroy(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
DeleteCriticalSection(&mailbox->lock);
|
||||
#else
|
||||
pthread_mutex_destroy(&mailbox->lock);
|
||||
pthread_cond_destroy(&mailbox->cond);
|
||||
#endif
|
||||
for (uint16_t i = 0; i < mailbox->messageCapacity; i++) {
|
||||
janet_buffer_deinit(mailbox->messages + i);
|
||||
}
|
||||
free(mailbox);
|
||||
}
|
||||
|
||||
static void janet_mailbox_lock(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
EnterCriticalSection(&mailbox->lock);
|
||||
#else
|
||||
pthread_mutex_lock(&mailbox->lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
static void janet_mailbox_unlock(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
LeaveCriticalSection(&mailbox->lock);
|
||||
#else
|
||||
pthread_mutex_unlock(&mailbox->lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Assumes you have the mailbox lock already */
|
||||
static void janet_mailbox_ref_with_lock(JanetMailbox *mailbox, int delta) {
|
||||
mailbox->refCount += delta;
|
||||
if (mailbox->refCount <= 0) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
janet_mailbox_destroy(mailbox);
|
||||
} else {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
}
|
||||
}
|
||||
|
||||
static void janet_mailbox_ref(JanetMailbox *mailbox, int delta) {
|
||||
janet_mailbox_lock(mailbox);
|
||||
janet_mailbox_ref_with_lock(mailbox, delta);
|
||||
}
|
||||
|
||||
static void janet_close_thread(JanetThread *thread) {
|
||||
if (thread->mailbox) {
|
||||
janet_mailbox_ref(thread->mailbox, -1);
|
||||
thread->mailbox = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
static int thread_gc(void *p, size_t size) {
|
||||
(void) size;
|
||||
JanetThread *thread = (JanetThread *)p;
|
||||
janet_close_thread(thread);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int thread_mark(void *p, size_t size) {
|
||||
(void) size;
|
||||
JanetThread *thread = (JanetThread *)p;
|
||||
if (thread->encode) {
|
||||
janet_mark(janet_wrap_table(thread->encode));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
|
||||
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
|
||||
if (NULL == pair) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
pair->original = original;
|
||||
janet_mailbox_ref(original, 1);
|
||||
pair->newbox = janet_mailbox_create(1, 16);
|
||||
return pair;
|
||||
}
|
||||
|
||||
static void destroy_mailbox_pair(JanetMailboxPair *pair) {
|
||||
janet_mailbox_ref(pair->original, -1);
|
||||
janet_mailbox_ref(pair->newbox, -1);
|
||||
free(pair);
|
||||
}
|
||||
|
||||
/* Abstract waiting for timeout across windows/posix */
|
||||
typedef struct {
|
||||
int timedwait;
|
||||
int nowait;
|
||||
#ifdef JANET_WINDOWS
|
||||
DWORD interval;
|
||||
DWORD ticksLeft;
|
||||
#else
|
||||
struct timespec ts;
|
||||
#endif
|
||||
} JanetWaiter;
|
||||
|
||||
static void janet_waiter_init(JanetWaiter *waiter, double sec) {
|
||||
waiter->timedwait = 0;
|
||||
waiter->nowait = 0;
|
||||
|
||||
if (sec <= 0.0 || isnan(sec)) {
|
||||
waiter->nowait = 1;
|
||||
return;
|
||||
}
|
||||
waiter->timedwait = sec > 0.0 && !isinf(sec);
|
||||
|
||||
/* Set maximum wait time to 30 days */
|
||||
if (sec > (60.0 * 60.0 * 24.0 * 30.0)) {
|
||||
sec = 60.0 * 60.0 * 24.0 * 30.0;
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
if (waiter->timedwait) {
|
||||
waiter->ticksLeft = waiter->interval = (DWORD) floor(1000.0 * sec);
|
||||
}
|
||||
#else
|
||||
if (waiter->timedwait) {
|
||||
/* N seconds -> timespec of (now + sec) */
|
||||
struct timespec now;
|
||||
clock_gettime(CLOCK_REALTIME, &now);
|
||||
time_t tvsec = (time_t) floor(sec);
|
||||
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
|
||||
tvsec += now.tv_sec;
|
||||
tvnsec += now.tv_nsec;
|
||||
if (tvnsec >= 1000000000L) {
|
||||
tvnsec -= 1000000000L;
|
||||
tvsec += 1;
|
||||
}
|
||||
waiter->ts.tv_sec = tvsec;
|
||||
waiter->ts.tv_nsec = tvnsec;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
static int janet_waiter_wait(JanetWaiter *wait, JanetMailbox *mailbox) {
|
||||
if (wait->nowait) return 1;
|
||||
#ifdef JANET_WINDOWS
|
||||
if (wait->timedwait) {
|
||||
if (wait->ticksLeft == 0) return 1;
|
||||
DWORD startTime = GetTickCount();
|
||||
int status = !SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, wait->ticksLeft);
|
||||
DWORD dTick = GetTickCount() - startTime;
|
||||
/* Be careful about underflow */
|
||||
wait->ticksLeft = dTick > wait->ticksLeft ? 0 : dTick;
|
||||
return status;
|
||||
} else {
|
||||
SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, INFINITE);
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
if (wait->timedwait) {
|
||||
return pthread_cond_timedwait(&mailbox->cond, &mailbox->lock, &wait->ts);
|
||||
} else {
|
||||
pthread_cond_wait(&mailbox->cond, &mailbox->lock);
|
||||
return 0;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
static void janet_mailbox_wakeup(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
WakeConditionVariable(&mailbox->cond);
|
||||
#else
|
||||
pthread_cond_signal(&mailbox->cond);
|
||||
#endif
|
||||
}
|
||||
|
||||
static int mailbox_at_capacity(JanetMailbox *mailbox) {
|
||||
return mailbox->messageCount >= mailbox->messageCapacity;
|
||||
}
|
||||
|
||||
/* Returns 1 if could not send (encode error or timeout), 2 for mailbox closed, and
|
||||
* 0 otherwise. Will not panic. */
|
||||
int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
|
||||
|
||||
/* Ensure mailbox is not closed. */
|
||||
JanetMailbox *mailbox = thread->mailbox;
|
||||
if (NULL == mailbox) return 2;
|
||||
janet_mailbox_lock(mailbox);
|
||||
if (mailbox->closed) {
|
||||
janet_mailbox_ref_with_lock(mailbox, -1);
|
||||
thread->mailbox = NULL;
|
||||
return 2;
|
||||
}
|
||||
|
||||
/* Back pressure */
|
||||
if (mailbox_at_capacity(mailbox)) {
|
||||
JanetWaiter wait;
|
||||
janet_waiter_init(&wait, timeout);
|
||||
|
||||
if (wait.nowait) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Retry loop, as there can be multiple writers */
|
||||
while (mailbox_at_capacity(mailbox)) {
|
||||
if (janet_waiter_wait(&wait, mailbox)) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
janet_mailbox_wakeup(mailbox);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Hack to capture all panics from marshalling. This works because
|
||||
* we know janet_marshal won't mess with other essential global state. */
|
||||
jmp_buf buf;
|
||||
jmp_buf *old_buf = janet_vm_jmp_buf;
|
||||
janet_vm_jmp_buf = &buf;
|
||||
int32_t oldmcount = mailbox->messageCount;
|
||||
|
||||
int ret = 0;
|
||||
if (setjmp(buf)) {
|
||||
ret = 1;
|
||||
mailbox->messageCount = oldmcount;
|
||||
} else {
|
||||
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageNext;
|
||||
msgbuf->count = 0;
|
||||
|
||||
/* Start panic zone */
|
||||
janet_marshal(msgbuf, msg, thread->encode, 0);
|
||||
/* End panic zone */
|
||||
|
||||
mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
|
||||
mailbox->messageCount++;
|
||||
}
|
||||
|
||||
/* Cleanup */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
janet_mailbox_unlock(mailbox);
|
||||
|
||||
/* Potentially wake up a blocked thread */
|
||||
janet_mailbox_wakeup(mailbox);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Returns 0 on successful message. Returns 1 if timedout */
|
||||
int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
JanetMailbox *mailbox = janet_vm_mailbox;
|
||||
janet_mailbox_lock(mailbox);
|
||||
|
||||
/* For timeouts */
|
||||
JanetWaiter wait;
|
||||
janet_waiter_init(&wait, timeout);
|
||||
|
||||
for (;;) {
|
||||
|
||||
/* Check for messages waiting for us */
|
||||
if (mailbox->messageCount > 0) {
|
||||
|
||||
/* Hack to capture all panics from marshalling. This works because
|
||||
* we know janet_marshal won't mess with other essential global state. */
|
||||
jmp_buf buf;
|
||||
jmp_buf *old_buf = janet_vm_jmp_buf;
|
||||
janet_vm_jmp_buf = &buf;
|
||||
|
||||
/* Handle errors */
|
||||
if (setjmp(buf)) {
|
||||
/* Cleanup jmp_buf, keep lock */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
} else {
|
||||
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst;
|
||||
mailbox->messageCount--;
|
||||
mailbox->messageFirst = (mailbox->messageFirst + 1) % mailbox->messageCapacity;
|
||||
|
||||
/* Read from beginning of channel */
|
||||
const uint8_t *nextItem = NULL;
|
||||
Janet item = janet_unmarshal(
|
||||
msgbuf->data, msgbuf->count,
|
||||
0, janet_thread_get_decode(), &nextItem);
|
||||
*msg_out = item;
|
||||
|
||||
/* Cleanup */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
janet_mailbox_unlock(mailbox);
|
||||
|
||||
/* Potentially wake up pending threads */
|
||||
janet_mailbox_wakeup(mailbox);
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
if (wait.nowait) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Wait for next message */
|
||||
if (janet_waiter_wait(&wait, mailbox)) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static int janet_thread_getter(void *p, Janet key, Janet *out);
|
||||
|
||||
const JanetAbstractType janet_thread_type = {
|
||||
"core/thread",
|
||||
thread_gc,
|
||||
thread_mark,
|
||||
janet_thread_getter,
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
|
||||
JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread));
|
||||
janet_mailbox_ref(mailbox, 1);
|
||||
thread->mailbox = mailbox;
|
||||
thread->encode = encode;
|
||||
return thread;
|
||||
}
|
||||
|
||||
JanetThread *janet_getthread(const Janet *argv, int32_t n) {
|
||||
return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type);
|
||||
}
|
||||
|
||||
/* Runs in new thread */
|
||||
static int thread_worker(JanetMailboxPair *pair) {
|
||||
JanetFiber *fiber = NULL;
|
||||
Janet out;
|
||||
|
||||
/* Use the mailbox we were given */
|
||||
janet_vm_mailbox = pair->newbox;
|
||||
janet_mailbox_ref(pair->newbox, 1);
|
||||
|
||||
/* Init VM */
|
||||
janet_init();
|
||||
|
||||
/* Get dictionaries for default encode/decode */
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
|
||||
/* Create parent thread */
|
||||
JanetThread *parent = janet_make_thread(pair->original, encode);
|
||||
Janet parentv = janet_wrap_abstract(parent);
|
||||
|
||||
/* Unmarshal the function */
|
||||
Janet funcv;
|
||||
int status = janet_thread_receive(&funcv, INFINITY);
|
||||
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
|
||||
JanetFunction *func = janet_unwrap_function(funcv);
|
||||
|
||||
/* Arity check */
|
||||
if (func->def->min_arity > 1 || func->def->max_arity < 1) {
|
||||
goto error;
|
||||
}
|
||||
|
||||
/* Call function */
|
||||
Janet argv[1] = { parentv };
|
||||
fiber = janet_fiber(func, 64, 1, argv);
|
||||
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (sig != JANET_SIGNAL_OK) {
|
||||
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
/* Normal exit */
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_deinit();
|
||||
return 0;
|
||||
|
||||
/* Fail to set something up */
|
||||
error:
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_eprintf("\nthread failed to start\n");
|
||||
janet_deinit();
|
||||
return 1;
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
|
||||
thread_worker((JanetMailboxPair *)param);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetMailboxPair *pair) {
|
||||
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL);
|
||||
int ret = NULL == handle;
|
||||
/* Does not kill thread, simply detatches */
|
||||
if (!ret) CloseHandle(handle);
|
||||
return ret;
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
static void *janet_pthread_wrapper(void *param) {
|
||||
thread_worker((JanetMailboxPair *)param);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetMailboxPair *pair) {
|
||||
pthread_t handle;
|
||||
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair);
|
||||
if (error) {
|
||||
return 1;
|
||||
} else {
|
||||
pthread_detach(handle);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Setup/Teardown
|
||||
*/
|
||||
|
||||
void janet_threads_init(void) {
|
||||
if (NULL == janet_vm_mailbox) {
|
||||
janet_vm_mailbox = janet_mailbox_create(1, 10);
|
||||
}
|
||||
janet_vm_thread_decode = NULL;
|
||||
janet_vm_thread_current = NULL;
|
||||
}
|
||||
|
||||
void janet_threads_deinit(void) {
|
||||
janet_mailbox_lock(janet_vm_mailbox);
|
||||
janet_vm_mailbox->closed = 1;
|
||||
janet_mailbox_ref_with_lock(janet_vm_mailbox, -1);
|
||||
janet_vm_mailbox = NULL;
|
||||
janet_vm_thread_current = NULL;
|
||||
janet_vm_thread_decode = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Cfuns
|
||||
*/
|
||||
|
||||
static Janet cfun_thread_current(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
if (NULL == janet_vm_thread_current) {
|
||||
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
|
||||
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
|
||||
}
|
||||
return janet_wrap_abstract(janet_vm_thread_current);
|
||||
}
|
||||
|
||||
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
/* Just type checking */
|
||||
janet_getfunction(argv, 0);
|
||||
int32_t cap = janet_optinteger(argv, argc, 1, 10);
|
||||
if (cap < 1 || cap > UINT16_MAX) {
|
||||
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
|
||||
}
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
|
||||
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
|
||||
JanetThread *thread = janet_make_thread(pair->newbox, encode);
|
||||
if (janet_thread_start_child(pair)) {
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_panic("could not start thread");
|
||||
}
|
||||
|
||||
/* If thread started, send the worker function. */
|
||||
if (janet_thread_send(thread, argv[0], INFINITY)) {
|
||||
janet_panicf("could not send worker function %v to thread", argv[0]);
|
||||
}
|
||||
|
||||
return janet_wrap_abstract(thread);
|
||||
}
|
||||
|
||||
static Janet cfun_thread_send(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetThread *thread = janet_getthread(argv, 0);
|
||||
int status = janet_thread_send(thread, argv[1], janet_optnumber(argv, argc, 2, 1.0));
|
||||
switch (status) {
|
||||
default:
|
||||
break;
|
||||
case 1:
|
||||
janet_panicf("failed to send message %v", argv[1]);
|
||||
case 2:
|
||||
janet_panic("thread mailbox is closed");
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
double wait = janet_optnumber(argv, argc, 0, 1.0);
|
||||
Janet out;
|
||||
int status = janet_thread_receive(&out, wait);
|
||||
switch (status) {
|
||||
default:
|
||||
break;
|
||||
case 1:
|
||||
janet_panicf("timeout after %f seconds", wait);
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
static Janet cfun_thread_close(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetThread *thread = janet_getthread(argv, 0);
|
||||
janet_close_thread(thread);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static const JanetMethod janet_thread_methods[] = {
|
||||
{"send", cfun_thread_send},
|
||||
{"close", cfun_thread_close},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int janet_thread_getter(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), janet_thread_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg threadlib_cfuns[] = {
|
||||
{
|
||||
"thread/current", cfun_thread_current,
|
||||
JDOC("(thread/current)\n\n"
|
||||
"Get the current running thread.")
|
||||
},
|
||||
{
|
||||
"thread/new", cfun_thread_new,
|
||||
JDOC("(thread/new func &opt capacity)\n\n"
|
||||
"Start a new thread that will start immediately. "
|
||||
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
|
||||
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
|
||||
"Returns a handle to the new thread.")
|
||||
},
|
||||
{
|
||||
"thread/send", cfun_thread_send,
|
||||
JDOC("(thread/send thread msg)\n\n"
|
||||
"Send a message to the thread. This will never block and returns thread immediately. "
|
||||
"Will throw an error if there is a problem sending the message.")
|
||||
},
|
||||
{
|
||||
"thread/receive", cfun_thread_receive,
|
||||
JDOC("(thread/receive &opt timeout)\n\n"
|
||||
"Get a message sent to this thread. If timeout is provided, an error will be thrown after the timeout has elapsed but "
|
||||
"no messages are received.")
|
||||
},
|
||||
{
|
||||
"thread/close", cfun_thread_close,
|
||||
JDOC("(thread/close thread)\n\n"
|
||||
"Close a thread, unblocking it and ending communication with it. Note that closing "
|
||||
"a thread is idempotent and does not cancel the thread's operation. Returns nil.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_thread(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, threadlib_cfuns);
|
||||
janet_register_abstract_type(&janet_thread_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
124
src/core/tuple.c
124
src/core/tuple.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 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
|
||||
@@ -53,37 +53,60 @@ const Janet *janet_tuple_n(const Janet *values, int32_t n) {
|
||||
return janet_tuple_end(t);
|
||||
}
|
||||
|
||||
/* Check if two tuples are equal */
|
||||
int janet_tuple_equal(const Janet *lhs, const Janet *rhs) {
|
||||
int32_t index;
|
||||
int32_t llen = janet_tuple_length(lhs);
|
||||
int32_t rlen = janet_tuple_length(rhs);
|
||||
int32_t lhash = janet_tuple_hash(lhs);
|
||||
int32_t rhash = janet_tuple_hash(rhs);
|
||||
if (lhash == 0)
|
||||
lhash = janet_tuple_hash(lhs) = janet_array_calchash(lhs, llen);
|
||||
if (rhash == 0)
|
||||
rhash = janet_tuple_hash(rhs) = janet_array_calchash(rhs, rlen);
|
||||
if (lhash != rhash)
|
||||
return 0;
|
||||
if (llen != rlen)
|
||||
return 0;
|
||||
for (index = 0; index < llen; index++) {
|
||||
if (!janet_equals(lhs[index], rhs[index]))
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Compare tuples */
|
||||
int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
|
||||
int32_t i;
|
||||
int32_t llen = janet_tuple_length(lhs);
|
||||
int32_t rlen = janet_tuple_length(rhs);
|
||||
int32_t count = llen < rlen ? llen : rlen;
|
||||
for (i = 0; i < count; ++i) {
|
||||
int comp = janet_compare(lhs[i], rhs[i]);
|
||||
if (comp != 0) return comp;
|
||||
}
|
||||
if (llen < rlen)
|
||||
return -1;
|
||||
else if (llen > rlen)
|
||||
return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* C Functions */
|
||||
|
||||
JANET_CORE_FN(cfun_tuple_brackets,
|
||||
"(tuple/brackets & xs)",
|
||||
"Creates a new bracketed tuple containing the elements xs.") {
|
||||
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
|
||||
const Janet *tup = janet_tuple_n(argv, argc);
|
||||
janet_tuple_flag(tup) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||
return janet_wrap_tuple(tup);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_tuple_slice,
|
||||
"(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])",
|
||||
"Take a sub-sequence of an array or tuple from index `start` "
|
||||
"inclusive to index `end` exclusive. If `start` or `end` are not provided, "
|
||||
"they default to 0 and the length of `arrtup`, respectively. "
|
||||
"`start` and `end` can also be negative to indicate indexing "
|
||||
"from the end of the input. Note that index -1 is synonymous with "
|
||||
"index `(length arrtup)` to allow a full negative slice range. "
|
||||
"Returns the new tuple.") {
|
||||
static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_tuple_type,
|
||||
"(tuple/type tup)",
|
||||
"Checks how the tuple was constructed. Will return the keyword "
|
||||
":brackets if the tuple was parsed with brackets, and :parens "
|
||||
"otherwise. The two types of tuples will behave the same most of "
|
||||
"the time, but will print differently and be treated differently by "
|
||||
"the compiler.") {
|
||||
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) {
|
||||
@@ -93,10 +116,7 @@ JANET_CORE_FN(cfun_tuple_type,
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_tuple_sourcemap,
|
||||
"(tuple/sourcemap tup)",
|
||||
"Returns the sourcemap metadata attached to a tuple, "
|
||||
"which is another tuple (line, column).") {
|
||||
static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
Janet contents[2];
|
||||
@@ -105,10 +125,7 @@ JANET_CORE_FN(cfun_tuple_sourcemap,
|
||||
return janet_wrap_tuple(janet_tuple_n(contents, 2));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_tuple_setmap,
|
||||
"(tuple/setmap tup line column)",
|
||||
"Set the sourcemap metadata on a tuple. line and column indicate "
|
||||
"should be integers.") {
|
||||
static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 3);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
janet_tuple_head(tup)->sm_line = janet_getinteger(argv, 1);
|
||||
@@ -116,15 +133,48 @@ JANET_CORE_FN(cfun_tuple_setmap,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg tuple_cfuns[] = {
|
||||
{
|
||||
"tuple/brackets", cfun_tuple_brackets,
|
||||
JDOC("(tuple/brackets & xs)\n\n"
|
||||
"Creates a new bracketed tuple containing the elements xs.")
|
||||
},
|
||||
{
|
||||
"tuple/slice", cfun_tuple_slice,
|
||||
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
||||
"Take a sub sequence of an array or tuple from index start "
|
||||
"inclusive to index end exclusive. If start or end are not provided, "
|
||||
"they default to 0 and the length of arrtup respectively. "
|
||||
"'start' and 'end' can also be negative to indicate indexing "
|
||||
"from the end of the input. Note that index -1 is synonymous with "
|
||||
"index '(length arrtup)' to allow a full negative slice range. "
|
||||
"Returns the new tuple.")
|
||||
},
|
||||
{
|
||||
"tuple/type", cfun_tuple_type,
|
||||
JDOC("(tuple/type tup)\n\n"
|
||||
"Checks how the tuple was constructed. Will return the keyword "
|
||||
":brackets if the tuple was parsed with brackets, and :parens "
|
||||
"otherwise. The two types of tuples will behave the same most of "
|
||||
"the time, but will print differently and be treated differently by "
|
||||
"the compiler.")
|
||||
},
|
||||
{
|
||||
"tuple/sourcemap", cfun_tuple_sourcemap,
|
||||
JDOC("(tuple/sourcemap tup)\n\n"
|
||||
"Returns the sourcemap metadata attached to a tuple, "
|
||||
" which is another tuple (line, column).")
|
||||
},
|
||||
{
|
||||
"tuple/setmap", cfun_tuple_setmap,
|
||||
JDOC("(tuple/setmap tup line column)\n\n"
|
||||
"Set the sourcemap metadata on a tuple. line and column indicate "
|
||||
"should be integers.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the tuple module */
|
||||
void janet_lib_tuple(JanetTable *env) {
|
||||
JanetRegExt tuple_cfuns[] = {
|
||||
JANET_CORE_REG("tuple/brackets", cfun_tuple_brackets),
|
||||
JANET_CORE_REG("tuple/slice", cfun_tuple_slice),
|
||||
JANET_CORE_REG("tuple/type", cfun_tuple_type),
|
||||
JANET_CORE_REG("tuple/sourcemap", cfun_tuple_sourcemap),
|
||||
JANET_CORE_REG("tuple/setmap", cfun_tuple_setmap),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, tuple_cfuns);
|
||||
janet_core_cfuns(env, NULL, tuple_cfuns);
|
||||
}
|
||||
|
||||
581
src/core/typedarray.c
Normal file
581
src/core/typedarray.c
Normal file
@@ -0,0 +1,581 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose & contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
|
||||
static char *ta_type_names[] = {
|
||||
"uint8",
|
||||
"int8",
|
||||
"uint16",
|
||||
"int16",
|
||||
"uint32",
|
||||
"int32",
|
||||
"uint64",
|
||||
"int64",
|
||||
"float32",
|
||||
"float64",
|
||||
"?"
|
||||
};
|
||||
|
||||
static size_t ta_type_sizes[] = {
|
||||
sizeof(uint8_t),
|
||||
sizeof(int8_t),
|
||||
sizeof(uint16_t),
|
||||
sizeof(int16_t),
|
||||
sizeof(uint32_t),
|
||||
sizeof(int32_t),
|
||||
sizeof(uint64_t),
|
||||
sizeof(int64_t),
|
||||
sizeof(float),
|
||||
sizeof(double),
|
||||
0
|
||||
};
|
||||
|
||||
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1)
|
||||
#define TA_ATOM_MAXSIZE 8
|
||||
#define TA_FLAG_BIG_ENDIAN 1
|
||||
|
||||
static JanetTArrayType get_ta_type_by_name(const uint8_t *name) {
|
||||
for (int i = 0; i < TA_COUNT_TYPES; i++) {
|
||||
if (!janet_cstrcmp(name, ta_type_names[i]))
|
||||
return i;
|
||||
}
|
||||
janet_panicf("invalid typed array type %S", name);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) {
|
||||
buf->data = NULL;
|
||||
if (size > 0) {
|
||||
buf->data = (uint8_t *)calloc(size, sizeof(uint8_t));
|
||||
if (buf->data == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
buf->size = size;
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
buf->flags = TA_FLAG_BIG_ENDIAN;
|
||||
#else
|
||||
buf->flags = 0;
|
||||
#endif
|
||||
return buf;
|
||||
}
|
||||
|
||||
static int ta_buffer_gc(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||
free(buf->data);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||
janet_marshal_abstract(ctx, p);
|
||||
janet_marshal_size(ctx, buf->size);
|
||||
janet_marshal_int(ctx, buf->flags);
|
||||
janet_marshal_bytes(ctx, buf->data, buf->size);
|
||||
}
|
||||
|
||||
static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) {
|
||||
JanetTArrayBuffer *buf = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayBuffer));
|
||||
size_t size = janet_unmarshal_size(ctx);
|
||||
int32_t flags = janet_unmarshal_int(ctx);
|
||||
ta_buffer_init(buf, size);
|
||||
buf->flags = flags;
|
||||
janet_unmarshal_bytes(ctx, buf->data, size);
|
||||
return buf;
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_ta_buffer_type = {
|
||||
"ta/buffer",
|
||||
ta_buffer_gc,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
ta_buffer_marshal,
|
||||
ta_buffer_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
static int ta_mark(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
janet_mark(janet_wrap_abstract(view->buffer));
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
size_t offset = (view->buffer->data - view->as.u8);
|
||||
janet_marshal_abstract(ctx, p);
|
||||
janet_marshal_size(ctx, view->size);
|
||||
janet_marshal_size(ctx, view->stride);
|
||||
janet_marshal_int(ctx, view->type);
|
||||
janet_marshal_size(ctx, offset);
|
||||
janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer));
|
||||
}
|
||||
|
||||
static void *ta_view_unmarshal(JanetMarshalContext *ctx) {
|
||||
size_t offset;
|
||||
int32_t atype;
|
||||
Janet buffer;
|
||||
JanetTArrayView *view = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayView));
|
||||
view->size = janet_unmarshal_size(ctx);
|
||||
view->stride = janet_unmarshal_size(ctx);
|
||||
atype = janet_unmarshal_int(ctx);
|
||||
if (atype < 0 || atype >= TA_COUNT_TYPES)
|
||||
janet_panic("bad typed array type");
|
||||
view->type = atype;
|
||||
offset = janet_unmarshal_size(ctx);
|
||||
buffer = janet_unmarshal_janet(ctx);
|
||||
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
|
||||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) {
|
||||
janet_panicf("expected typed array buffer");
|
||||
}
|
||||
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
|
||||
size_t buf_need_size = offset + (ta_type_sizes[view->type]) * ((view->size - 1) * view->stride + 1);
|
||||
if (view->buffer->size < buf_need_size)
|
||||
janet_panic("bad typed array offset in marshalled data");
|
||||
view->as.u8 = view->buffer->data + offset;
|
||||
return view;
|
||||
}
|
||||
|
||||
static JanetMethod tarray_view_methods[6];
|
||||
|
||||
static int ta_getter(void *p, Janet key, Janet *out) {
|
||||
size_t index, i;
|
||||
JanetTArrayView *array = p;
|
||||
if (janet_checktype(key, JANET_KEYWORD)) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), tarray_view_methods, out);
|
||||
}
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
index = (size_t) janet_unwrap_number(key);
|
||||
i = index * array->stride;
|
||||
if (index >= array->size) {
|
||||
return 0;
|
||||
} else {
|
||||
switch (array->type) {
|
||||
case JANET_TARRAY_TYPE_U8:
|
||||
*out = janet_wrap_number(array->as.u8[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S8:
|
||||
*out = janet_wrap_number(array->as.s8[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U16:
|
||||
*out = janet_wrap_number(array->as.u16[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S16:
|
||||
*out = janet_wrap_number(array->as.s16[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U32:
|
||||
*out = janet_wrap_number(array->as.u32[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S32:
|
||||
*out = janet_wrap_number(array->as.s32[i]);
|
||||
break;
|
||||
#ifdef JANET_INT_TYPES
|
||||
case JANET_TARRAY_TYPE_U64:
|
||||
*out = janet_wrap_u64(array->as.u64[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S64:
|
||||
*out = janet_wrap_s64(array->as.s64[i]);
|
||||
break;
|
||||
#endif
|
||||
case JANET_TARRAY_TYPE_F32:
|
||||
*out = janet_wrap_number_safe(array->as.f32[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_F64:
|
||||
*out = janet_wrap_number_safe(array->as.f64[i]);
|
||||
break;
|
||||
default:
|
||||
janet_panicf("cannot get from typed array of type %s",
|
||||
ta_type_names[array->type]);
|
||||
break;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static void ta_setter(void *p, Janet key, Janet value) {
|
||||
size_t index, i;
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
index = (size_t) janet_unwrap_number(key);
|
||||
JanetTArrayView *array = p;
|
||||
i = index * array->stride;
|
||||
if (index >= array->size) {
|
||||
janet_panic("index out of bounds");
|
||||
}
|
||||
if (!janet_checktype(value, JANET_NUMBER) &&
|
||||
array->type != JANET_TARRAY_TYPE_U64 &&
|
||||
array->type != JANET_TARRAY_TYPE_S64) {
|
||||
janet_panic("expected number value");
|
||||
}
|
||||
switch (array->type) {
|
||||
case JANET_TARRAY_TYPE_U8:
|
||||
array->as.u8[i] = (uint8_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S8:
|
||||
array->as.s8[i] = (int8_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U16:
|
||||
array->as.u16[i] = (uint16_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S16:
|
||||
array->as.s16[i] = (int16_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U32:
|
||||
array->as.u32[i] = (uint32_t) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S32:
|
||||
array->as.s32[i] = (int32_t) janet_unwrap_number(value);
|
||||
break;
|
||||
#ifdef JANET_INT_TYPES
|
||||
case JANET_TARRAY_TYPE_U64:
|
||||
array->as.u64[i] = janet_unwrap_u64(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S64:
|
||||
array->as.s64[i] = janet_unwrap_s64(value);
|
||||
break;
|
||||
#endif
|
||||
case JANET_TARRAY_TYPE_F32:
|
||||
array->as.f32[i] = (float) janet_unwrap_number(value);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_F64:
|
||||
array->as.f64[i] = janet_unwrap_number(value);
|
||||
break;
|
||||
default:
|
||||
janet_panicf("cannot set typed array of type %s",
|
||||
ta_type_names[array->type]);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_ta_view_type = {
|
||||
"ta/view",
|
||||
NULL,
|
||||
ta_mark,
|
||||
ta_getter,
|
||||
ta_setter,
|
||||
ta_view_marshal,
|
||||
ta_view_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||
JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buf, size);
|
||||
return buf;
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_tarray_view(
|
||||
JanetTArrayType type,
|
||||
size_t size,
|
||||
size_t stride,
|
||||
size_t offset,
|
||||
JanetTArrayBuffer *buffer) {
|
||||
|
||||
JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView));
|
||||
|
||||
if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
|
||||
size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
|
||||
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buffer, buf_size);
|
||||
}
|
||||
|
||||
if (buffer->size < buf_size) {
|
||||
janet_panicf("bad buffer size, %i bytes allocated < %i required",
|
||||
buffer->size,
|
||||
buf_size);
|
||||
}
|
||||
|
||||
view->buffer = buffer;
|
||||
view->stride = stride;
|
||||
view->size = size;
|
||||
view->as.u8 = buffer->data + offset;
|
||||
view->type = type;
|
||||
|
||||
return view;
|
||||
}
|
||||
|
||||
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &janet_ta_buffer_type);
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &janet_ta_view_type);
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
|
||||
JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type);
|
||||
if (view->type != type) {
|
||||
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
|
||||
n, ta_type_names[type], argv[n]);
|
||||
}
|
||||
return view;
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 5);
|
||||
size_t offset = 0;
|
||||
size_t stride = 1;
|
||||
JanetTArrayBuffer *buffer = NULL;
|
||||
const uint8_t *keyw = janet_getkeyword(argv, 0);
|
||||
JanetTArrayType type = get_ta_type_by_name(keyw);
|
||||
size_t size = janet_getsize(argv, 1);
|
||||
if (argc > 2)
|
||||
stride = janet_getsize(argv, 2);
|
||||
if (argc > 3)
|
||||
offset = janet_getsize(argv, 3);
|
||||
if (argc > 4) {
|
||||
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
void *p = janet_unwrap_abstract(argv[4]);
|
||||
if (janet_abstract_type(p) == &janet_ta_view_type) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
|
||||
stride *= view->stride;
|
||||
buffer = view->buffer;
|
||||
} else {
|
||||
buffer = p;
|
||||
}
|
||||
}
|
||||
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
|
||||
return janet_wrap_abstract(view);
|
||||
}
|
||||
|
||||
static JanetTArrayView *ta_is_view(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL;
|
||||
return (JanetTArrayView *)abst;
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTArrayView *view;
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
return janet_wrap_abstract(view->buffer);
|
||||
}
|
||||
size_t size = janet_getsize(argv, 0);
|
||||
JanetTArrayBuffer *buf = janet_tarray_buffer(size);
|
||||
return janet_wrap_abstract(buf);
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTArrayView *view;
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
return janet_wrap_number((double) view->size);
|
||||
}
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type);
|
||||
return janet_wrap_number((double) buf->size);
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTArrayView *view;
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
JanetTArrayView *view = janet_unwrap_abstract(argv[0]);
|
||||
JanetKV *props = janet_struct_begin(6);
|
||||
ptrdiff_t boffset = view->as.u8 - view->buffer->data;
|
||||
janet_struct_put(props, janet_ckeywordv("size"),
|
||||
janet_wrap_number((double) view->size));
|
||||
janet_struct_put(props, janet_ckeywordv("byte-offset"),
|
||||
janet_wrap_number((double) boffset));
|
||||
janet_struct_put(props, janet_ckeywordv("stride"),
|
||||
janet_wrap_number((double) view->stride));
|
||||
janet_struct_put(props, janet_ckeywordv("type"),
|
||||
janet_ckeywordv(ta_type_names[view->type]));
|
||||
janet_struct_put(props, janet_ckeywordv("type-size"),
|
||||
janet_wrap_number((double) ta_type_sizes[view->type]));
|
||||
janet_struct_put(props, janet_ckeywordv("buffer"),
|
||||
janet_wrap_abstract(view->buffer));
|
||||
return janet_wrap_struct(janet_struct_end(props));
|
||||
} else {
|
||||
JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0);
|
||||
JanetKV *props = janet_struct_begin(2);
|
||||
janet_struct_put(props, janet_ckeywordv("size"),
|
||||
janet_wrap_number((double) buffer->size));
|
||||
janet_struct_put(props, janet_ckeywordv("big-endian"),
|
||||
janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN));
|
||||
return janet_wrap_struct(janet_struct_end(props));
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
JanetRange range;
|
||||
int32_t length = (int32_t)src->size;
|
||||
if (argc == 1) {
|
||||
range.start = 0;
|
||||
range.end = length;
|
||||
} else if (argc == 2) {
|
||||
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||
range.end = length;
|
||||
} else {
|
||||
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||
range.end = janet_gethalfrange(argv, 2, length, "end");
|
||||
if (range.end < range.start)
|
||||
range.end = range.start;
|
||||
}
|
||||
JanetArray *array = janet_array(range.end - range.start);
|
||||
if (array->data) {
|
||||
for (int32_t i = range.start; i < range.end; i++) {
|
||||
if (!ta_getter(src, janet_wrap_number(i), &array->data[i - range.start]))
|
||||
array->data[i - range.start] = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
array->count = range.end - range.start;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||
size_t step_src = src->stride * src_atom_size;
|
||||
size_t step_dst = dst->stride * dst_atom_size;
|
||||
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||
for (size_t i = 0; i < count; i++) {
|
||||
memmove(pd, ps, src_atom_size);
|
||||
pd += step_dst;
|
||||
ps += step_src;
|
||||
}
|
||||
} else {
|
||||
janet_panic("typed array copy out of bounds");
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||
size_t step_src = src->stride * src_atom_size;
|
||||
size_t step_dst = dst->stride * dst_atom_size;
|
||||
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
|
||||
size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
|
||||
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||
uint8_t temp[TA_ATOM_MAXSIZE];
|
||||
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||
for (size_t i = 0; i < count; i++) {
|
||||
memcpy(temp, ps, src_atom_size);
|
||||
memcpy(ps, pd, src_atom_size);
|
||||
memcpy(pd, temp, src_atom_size);
|
||||
pd += step_dst;
|
||||
ps += step_src;
|
||||
}
|
||||
} else {
|
||||
janet_panic("typed array swap out of bounds");
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static const JanetReg ta_cfuns[] = {
|
||||
{
|
||||
"tarray/new", cfun_typed_array_new,
|
||||
JDOC("(tarray/new type size &opt stride offset tarray|buffer)\n\n"
|
||||
"Create new typed array.")
|
||||
},
|
||||
{
|
||||
"tarray/buffer", cfun_typed_array_buffer,
|
||||
JDOC("(tarray/buffer array|size)\n\n"
|
||||
"Return typed array buffer or create a new buffer.")
|
||||
},
|
||||
{
|
||||
"tarray/length", cfun_typed_array_size,
|
||||
JDOC("(tarray/length array|buffer)\n\n"
|
||||
"Return typed array or buffer size.")
|
||||
},
|
||||
{
|
||||
"tarray/properties", cfun_typed_array_properties,
|
||||
JDOC("(tarray/properties array)\n\n"
|
||||
"Return typed array properties as a struct.")
|
||||
},
|
||||
{
|
||||
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
|
||||
JDOC("(tarray/copy-bytes src sindex dst dindex &opt count)\n\n"
|
||||
"Copy count elements (default 1) of src array from index sindex "
|
||||
"to dst array at position dindex "
|
||||
"memory can overlap.")
|
||||
},
|
||||
{
|
||||
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
|
||||
JDOC("(tarray/swap-bytes src sindex dst dindex &opt count)\n\n"
|
||||
"Swap count elements (default 1) between src array from index sindex "
|
||||
"and dst array at position dindex "
|
||||
"memory can overlap.")
|
||||
},
|
||||
{
|
||||
"tarray/slice", cfun_typed_array_slice,
|
||||
JDOC("(tarray/slice tarr &opt start end)\n\n"
|
||||
"Takes a slice of a typed array 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 typed array. By default, start is 0 and end is "
|
||||
"the size of the typed array. Returns a new janet array.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
static JanetMethod tarray_view_methods[] = {
|
||||
{"length", cfun_typed_array_size},
|
||||
{"properties", cfun_typed_array_properties},
|
||||
{"copy-bytes", cfun_typed_array_copy_bytes},
|
||||
{"swap-bytes", cfun_typed_array_swap_bytes},
|
||||
{"slice", cfun_typed_array_slice},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_typed_array(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, ta_cfuns);
|
||||
janet_register_abstract_type(&janet_ta_buffer_type);
|
||||
janet_register_abstract_type(&janet_ta_view_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
518
src/core/util.c
518
src/core/util.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -26,18 +26,6 @@
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef JANET_APPLE
|
||||
#include <AvailabilityMacros.h>
|
||||
#endif
|
||||
|
||||
#include <inttypes.h>
|
||||
@@ -106,7 +94,7 @@ const char *const janet_status_names[16] = {
|
||||
"alive"
|
||||
};
|
||||
|
||||
#ifndef JANET_PRF
|
||||
#ifdef JANET_NO_PRF
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
const uint8_t *end = str + len;
|
||||
@@ -228,28 +216,22 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
|
||||
#endif
|
||||
|
||||
uint32_t janet_hash_mix(uint32_t input, uint32_t more) {
|
||||
uint32_t mix1 = (more + 0x9e3779b9 + (input << 6) + (input >> 2));
|
||||
return input ^ (0x9e3779b9 + (mix1 << 6) + (mix1 >> 2));
|
||||
}
|
||||
|
||||
/* Computes hash of an array of values */
|
||||
int32_t janet_array_calchash(const Janet *array, int32_t len) {
|
||||
const Janet *end = array + len;
|
||||
uint32_t hash = 33;
|
||||
while (array < end) {
|
||||
hash = janet_hash_mix(hash, janet_hash(*array++));
|
||||
}
|
||||
uint32_t hash = 5381;
|
||||
while (array < end)
|
||||
hash = (hash << 5) + hash + janet_hash(*array++);
|
||||
return (int32_t) hash;
|
||||
}
|
||||
|
||||
/* Computes hash of an array of values */
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
|
||||
const JanetKV *end = kvs + len;
|
||||
uint32_t hash = 33;
|
||||
uint32_t hash = 5381;
|
||||
while (kvs < end) {
|
||||
hash = janet_hash_mix(hash, janet_hash(kvs->key));
|
||||
hash = janet_hash_mix(hash, janet_hash(kvs->value));
|
||||
hash = (hash << 5) + hash + janet_hash(kvs->key);
|
||||
hash = (hash << 5) + hash + janet_hash(kvs->value);
|
||||
kvs++;
|
||||
}
|
||||
return (int32_t) hash;
|
||||
@@ -258,7 +240,6 @@ int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
|
||||
/* Calculate next power of 2. May overflow. If n is 0,
|
||||
* will return 0. */
|
||||
int32_t janet_tablen(int32_t n) {
|
||||
if (n < 0) return 0;
|
||||
n |= n >> 1;
|
||||
n |= n >> 2;
|
||||
n |= n >> 4;
|
||||
@@ -371,208 +352,88 @@ const void *janet_strbinsearch(
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Add sourcemapping and documentation to a binding table */
|
||||
static void janet_add_meta(JanetTable *table, const char *doc, const char *source_file, int32_t source_line) {
|
||||
if (doc) {
|
||||
janet_table_put(table, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
}
|
||||
if (source_file && source_line) {
|
||||
Janet triple[3];
|
||||
triple[0] = janet_cstringv(source_file);
|
||||
triple[1] = janet_wrap_integer(source_line);
|
||||
triple[2] = janet_wrap_integer(1);
|
||||
Janet value = janet_wrap_tuple(janet_tuple_n(triple, 3));
|
||||
janet_table_put(table, janet_ckeywordv("source-map"), value);
|
||||
}
|
||||
/* Register a value in the global registry */
|
||||
void janet_register(const char *name, JanetCFunction cfun) {
|
||||
Janet key = janet_wrap_cfunction(cfun);
|
||||
Janet value = janet_csymbolv(name);
|
||||
janet_table_put(janet_vm_registry, key, value);
|
||||
}
|
||||
|
||||
/* Add a def to an environment */
|
||||
void janet_def_sm(JanetTable *env, const char *name, Janet val, const char *doc, const char *source_file, int32_t source_line) {
|
||||
void janet_def(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_table_put(subt, janet_ckeywordv("value"), val);
|
||||
janet_add_meta(subt, doc, source_file, source_line);
|
||||
if (doc)
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||
}
|
||||
void janet_def(JanetTable *env, const char *name, Janet value, const char *doc) {
|
||||
janet_def_sm(env, name, value, doc, NULL, 0);
|
||||
}
|
||||
|
||||
/* Add a var to the environment */
|
||||
void janet_var_sm(JanetTable *env, const char *name, Janet val, const char *doc, const char *source_file, int32_t source_line) {
|
||||
void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
JanetArray *array = janet_array(1);
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_array_push(array, val);
|
||||
janet_table_put(subt, janet_ckeywordv("ref"), janet_wrap_array(array));
|
||||
janet_add_meta(subt, doc, source_file, source_line);
|
||||
if (doc)
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||
}
|
||||
void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
janet_var_sm(env, name, val, doc, NULL, 0);
|
||||
}
|
||||
|
||||
/* Registry functions */
|
||||
|
||||
/* Put the registry in sorted order. */
|
||||
static void janet_registry_sort(void) {
|
||||
for (size_t i = 1; i < janet_vm.registry_count; i++) {
|
||||
JanetCFunRegistry reg = janet_vm.registry[i];
|
||||
size_t j;
|
||||
for (j = i; j > 0; j--) {
|
||||
if ((void *)(janet_vm.registry[j - 1].cfun) < (void *)(reg.cfun)) break;
|
||||
janet_vm.registry[j] = janet_vm.registry[j - 1];
|
||||
}
|
||||
janet_vm.registry[j] = reg;
|
||||
}
|
||||
janet_vm.registry_dirty = 0;
|
||||
}
|
||||
|
||||
void janet_registry_put(
|
||||
JanetCFunction key,
|
||||
const char *name,
|
||||
const char *name_prefix,
|
||||
const char *source_file,
|
||||
int32_t source_line) {
|
||||
if (janet_vm.registry_count == janet_vm.registry_cap) {
|
||||
size_t newcap = (janet_vm.registry_count + 1) * 2;
|
||||
/* Size it nicely with core by default */
|
||||
if (newcap < 512) {
|
||||
newcap = 512;
|
||||
}
|
||||
void *newmem = janet_realloc(janet_vm.registry, newcap * sizeof(JanetCFunRegistry));
|
||||
if (NULL == newmem) {
|
||||
/* Load many cfunctions at once */
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
uint8_t *longname_buffer = NULL;
|
||||
size_t prefixlen = 0;
|
||||
size_t bufsize = 0;
|
||||
if (NULL != regprefix) {
|
||||
prefixlen = strlen(regprefix);
|
||||
bufsize = prefixlen + 256;
|
||||
longname_buffer = malloc(bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm.registry = newmem;
|
||||
janet_vm.registry_cap = newcap;
|
||||
safe_memcpy(longname_buffer, regprefix, prefixlen);
|
||||
longname_buffer[prefixlen] = '/';
|
||||
prefixlen++;
|
||||
}
|
||||
JanetCFunRegistry value = {
|
||||
key,
|
||||
name,
|
||||
name_prefix,
|
||||
source_file,
|
||||
source_line
|
||||
};
|
||||
janet_vm.registry[janet_vm.registry_count++] = value;
|
||||
janet_vm.registry_dirty = 1;
|
||||
}
|
||||
|
||||
JanetCFunRegistry *janet_registry_get(JanetCFunction key) {
|
||||
if (janet_vm.registry_dirty) {
|
||||
janet_registry_sort();
|
||||
}
|
||||
for (size_t i = 0; i < janet_vm.registry_count; i++) {
|
||||
if (janet_vm.registry[i].cfun == key) {
|
||||
return janet_vm.registry + i;
|
||||
}
|
||||
}
|
||||
JanetCFunRegistry *lo = janet_vm.registry;
|
||||
JanetCFunRegistry *hi = lo + janet_vm.registry_count;
|
||||
while (lo < hi) {
|
||||
JanetCFunRegistry *mid = lo + (hi - lo) / 2;
|
||||
if (mid->cfun == key) {
|
||||
return mid;
|
||||
}
|
||||
if ((void *)(mid->cfun) > (void *)(key)) {
|
||||
hi = mid;
|
||||
while (cfuns->name) {
|
||||
Janet name;
|
||||
if (NULL != regprefix) {
|
||||
int32_t nmlen = 0;
|
||||
while (cfuns->name[nmlen]) nmlen++;
|
||||
int32_t totallen = (int32_t) prefixlen + nmlen;
|
||||
if ((size_t) totallen > bufsize) {
|
||||
bufsize = (size_t)(totallen) + 128;
|
||||
longname_buffer = realloc(longname_buffer, bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
safe_memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
|
||||
name = janet_wrap_symbol(janet_symbol(longname_buffer, totallen));
|
||||
} else {
|
||||
lo = mid + 1;
|
||||
name = janet_csymbolv(cfuns->name);
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
char *buf;
|
||||
size_t plen;
|
||||
} NameBuf;
|
||||
|
||||
static void namebuf_init(NameBuf *namebuf, const char *prefix) {
|
||||
size_t plen = strlen(prefix);
|
||||
namebuf->plen = plen;
|
||||
namebuf->buf = janet_malloc(namebuf->plen + 256);
|
||||
if (NULL == namebuf->buf) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(namebuf->buf, prefix, plen);
|
||||
namebuf->buf[plen] = '/';
|
||||
}
|
||||
|
||||
static void namebuf_deinit(NameBuf *namebuf) {
|
||||
janet_free(namebuf->buf);
|
||||
}
|
||||
|
||||
static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
|
||||
size_t slen = strlen(suffix);
|
||||
namebuf->buf = janet_realloc(namebuf->buf, namebuf->plen + 2 + slen);
|
||||
if (NULL == namebuf->buf) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(namebuf->buf + namebuf->plen + 1, suffix, slen);
|
||||
namebuf->buf[namebuf->plen + 1 + slen] = '\0';
|
||||
return (char *)(namebuf->buf);
|
||||
}
|
||||
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
|
||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
janet_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
}
|
||||
|
||||
void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
cfuns++;
|
||||
}
|
||||
}
|
||||
|
||||
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
NameBuf nb;
|
||||
if (env) namebuf_init(&nb, regprefix);
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
|
||||
cfuns++;
|
||||
}
|
||||
if (env) namebuf_deinit(&nb);
|
||||
}
|
||||
|
||||
void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
NameBuf nb;
|
||||
if (env) namebuf_init(&nb, regprefix);
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def_sm(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
cfuns++;
|
||||
}
|
||||
if (env) namebuf_deinit(&nb);
|
||||
}
|
||||
|
||||
/* Register a value in the global registry */
|
||||
void janet_register(const char *name, JanetCFunction cfun) {
|
||||
janet_registry_put(cfun, name, NULL, NULL, 0);
|
||||
free(longname_buffer);
|
||||
}
|
||||
|
||||
/* Abstract type introspection */
|
||||
|
||||
void janet_register_abstract_type(const JanetAbstractType *at) {
|
||||
Janet sym = janet_csymbolv(at->name);
|
||||
Janet check = janet_table_get(janet_vm.abstract_registry, sym);
|
||||
if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
|
||||
if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) {
|
||||
janet_panicf("cannot register abstract type %s, "
|
||||
"a type with the same name exists", at->name);
|
||||
}
|
||||
janet_table_put(janet_vm.abstract_registry, sym, janet_wrap_pointer((void *) at));
|
||||
janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at));
|
||||
}
|
||||
|
||||
const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||
Janet wrapped = janet_table_get(janet_vm.abstract_registry, key);
|
||||
Janet wrapped = janet_table_get(janet_vm_abstract_registry, key);
|
||||
if (janet_checktype(wrapped, JANET_NIL)) {
|
||||
return NULL;
|
||||
}
|
||||
@@ -580,92 +441,46 @@ const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||
}
|
||||
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl) {
|
||||
(void) sf;
|
||||
(void) sl;
|
||||
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
||||
(void) p;
|
||||
Janet key = janet_csymbolv(name);
|
||||
janet_table_put(env, key, x);
|
||||
if (janet_checktype(x, JANET_CFUNCTION)) {
|
||||
janet_registry_put(janet_unwrap_cfunction(x), name, NULL, NULL, 0);
|
||||
janet_table_put(janet_vm_registry, x, key);
|
||||
}
|
||||
}
|
||||
|
||||
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
(void) regprefix;
|
||||
while (cfuns->name) {
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_table_put(env, janet_csymbolv(cfuns->name), fun);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
cfuns++;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
JanetBinding janet_binding_from_entry(Janet entry) {
|
||||
JanetTable *entry_table;
|
||||
JanetBinding binding = {
|
||||
JANET_BINDING_NONE,
|
||||
janet_wrap_nil(),
|
||||
JANET_BINDING_DEP_NONE
|
||||
};
|
||||
|
||||
/* Check environment for entry */
|
||||
if (!janet_checktype(entry, JANET_TABLE))
|
||||
return binding;
|
||||
entry_table = janet_unwrap_table(entry);
|
||||
|
||||
/* deprecation check */
|
||||
Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
|
||||
if (janet_checktype(deprecate, JANET_KEYWORD)) {
|
||||
JanetKeyword depkw = janet_unwrap_keyword(deprecate);
|
||||
if (!janet_cstrcmp(depkw, "relaxed")) {
|
||||
binding.deprecation = JANET_BINDING_DEP_RELAXED;
|
||||
} else if (!janet_cstrcmp(depkw, "normal")) {
|
||||
binding.deprecation = JANET_BINDING_DEP_NORMAL;
|
||||
} else if (!janet_cstrcmp(depkw, "strict")) {
|
||||
binding.deprecation = JANET_BINDING_DEP_STRICT;
|
||||
}
|
||||
} else if (!janet_checktype(deprecate, JANET_NIL)) {
|
||||
binding.deprecation = JANET_BINDING_DEP_NORMAL;
|
||||
}
|
||||
|
||||
int macro = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("macro")));
|
||||
Janet value = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
Janet ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
||||
int ref_is_valid = janet_checktype(ref, JANET_ARRAY);
|
||||
int redef = ref_is_valid && janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef")));
|
||||
|
||||
if (macro) {
|
||||
binding.value = redef ? ref : value;
|
||||
binding.type = redef ? JANET_BINDING_DYNAMIC_MACRO : JANET_BINDING_MACRO;
|
||||
return binding;
|
||||
}
|
||||
|
||||
if (ref_is_valid) {
|
||||
binding.value = ref;
|
||||
binding.type = redef ? JANET_BINDING_DYNAMIC_DEF : JANET_BINDING_VAR;
|
||||
} else {
|
||||
binding.value = value;
|
||||
binding.type = JANET_BINDING_DEF;
|
||||
}
|
||||
|
||||
return binding;
|
||||
}
|
||||
|
||||
JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
|
||||
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
|
||||
return janet_binding_from_entry(entry);
|
||||
}
|
||||
|
||||
/* Resolve a symbol in the environment */
|
||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||
JanetBinding binding = janet_resolve_ext(env, sym);
|
||||
if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
|
||||
*out = janet_array_peek(janet_unwrap_array(binding.value));
|
||||
} else {
|
||||
*out = binding.value;
|
||||
Janet ref;
|
||||
JanetTable *entry_table;
|
||||
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
|
||||
if (!janet_checktype(entry, JANET_TABLE))
|
||||
return JANET_BINDING_NONE;
|
||||
entry_table = janet_unwrap_table(entry);
|
||||
if (!janet_checktype(
|
||||
janet_table_get(entry_table, janet_ckeywordv("macro")),
|
||||
JANET_NIL)) {
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_MACRO;
|
||||
}
|
||||
return binding.type;
|
||||
ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
||||
if (janet_checktype(ref, JANET_ARRAY)) {
|
||||
*out = ref;
|
||||
return JANET_BINDING_VAR;
|
||||
}
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_DEF;
|
||||
}
|
||||
|
||||
/* Resolve a symbol in the core environment. */
|
||||
@@ -739,23 +554,12 @@ int janet_checkint64(Janet x) {
|
||||
return janet_checkint64range(dval);
|
||||
}
|
||||
|
||||
int janet_checkuint64(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
|
||||
}
|
||||
|
||||
int janet_checksize(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
if (dval != (double)((size_t) dval)) return 0;
|
||||
if (SIZE_MAX > JANET_INTMAX_INT64) {
|
||||
return dval <= JANET_INTMAX_INT64;
|
||||
} else {
|
||||
return dval <= SIZE_MAX;
|
||||
}
|
||||
return dval == (double)((size_t) dval) &&
|
||||
dval <= SIZE_MAX;
|
||||
}
|
||||
|
||||
JanetTable *janet_get_core_table(const char *name) {
|
||||
@@ -766,167 +570,3 @@ JanetTable *janet_get_core_table(const char *name) {
|
||||
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
||||
return janet_unwrap_table(out);
|
||||
}
|
||||
|
||||
/* Sort keys of a dictionary type */
|
||||
int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer) {
|
||||
|
||||
/* First, put populated indices into index_buffer */
|
||||
int32_t next_index = 0;
|
||||
for (int32_t i = 0; i < cap; i++) {
|
||||
if (!janet_checktype(dict[i].key, JANET_NIL)) {
|
||||
index_buffer[next_index++] = i;
|
||||
}
|
||||
}
|
||||
|
||||
/* Next, sort those (simple insertion sort here for now) */
|
||||
for (int32_t i = 1; i < next_index; i++) {
|
||||
int32_t index_to_insert = index_buffer[i];
|
||||
Janet lhs = dict[index_to_insert].key;
|
||||
for (int32_t j = i - 1; j >= 0; j--) {
|
||||
index_buffer[j + 1] = index_buffer[j];
|
||||
Janet rhs = dict[index_buffer[j]].key;
|
||||
if (janet_compare(lhs, rhs) >= 0) {
|
||||
index_buffer[j + 1] = index_to_insert;
|
||||
break;
|
||||
} else if (j == 0) {
|
||||
index_buffer[0] = index_to_insert;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Return number of indices found */
|
||||
return next_index;
|
||||
|
||||
}
|
||||
|
||||
/* Clock shims for various platforms */
|
||||
#ifdef JANET_GETTIME
|
||||
#ifdef JANET_WINDOWS
|
||||
int janet_gettime(struct timespec *spec) {
|
||||
FILETIME ftime;
|
||||
GetSystemTimeAsFileTime(&ftime);
|
||||
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
|
||||
/* Windows epoch is January 1, 1601 apparently */
|
||||
wintime -= 116444736000000000LL;
|
||||
spec->tv_sec = wintime / 10000000LL;
|
||||
/* Resolution is 100 nanoseconds. */
|
||||
spec->tv_nsec = wintime % 10000000LL * 100;
|
||||
return 0;
|
||||
}
|
||||
/* clock_gettime() wasn't available on Mac until 10.12. */
|
||||
#elif defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_12)
|
||||
#include <mach/clock.h>
|
||||
#include <mach/mach.h>
|
||||
int janet_gettime(struct timespec *spec) {
|
||||
clock_serv_t cclock;
|
||||
mach_timespec_t mts;
|
||||
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
|
||||
clock_get_time(cclock, &mts);
|
||||
mach_port_deallocate(mach_task_self(), cclock);
|
||||
spec->tv_sec = mts.tv_sec;
|
||||
spec->tv_nsec = mts.tv_nsec;
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
int janet_gettime(struct timespec *spec) {
|
||||
return clock_gettime(CLOCK_REALTIME, spec);
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Setting C99 standard makes this not available, but it should
|
||||
* work/link properly if we detect a BSD */
|
||||
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
void arc4random_buf(void *buf, size_t nbytes);
|
||||
#endif
|
||||
|
||||
int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
#ifdef JANET_WINDOWS
|
||||
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
|
||||
unsigned int v;
|
||||
if (rand_s(&v))
|
||||
return -1;
|
||||
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
|
||||
out[i + j] = v & 0xff;
|
||||
v = v >> 8;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros.
|
||||
On Mac, arc4random_buf wasn't available on until 10.7.
|
||||
In these cases, use this fallback path for now... */
|
||||
int rc;
|
||||
int randfd;
|
||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
|
||||
if (randfd < 0)
|
||||
return -1;
|
||||
while (n > 0) {
|
||||
ssize_t nread;
|
||||
RETRY_EINTR(nread, read(randfd, out, n));
|
||||
if (nread <= 0) {
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
return -1;
|
||||
}
|
||||
out += nread;
|
||||
n -= nread;
|
||||
}
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
return 0;
|
||||
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
arc4random_buf(out, n);
|
||||
return 0;
|
||||
#else
|
||||
(void) n;
|
||||
(void) out;
|
||||
return -1;
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Dynamic library loading */
|
||||
|
||||
char *get_processed_name(const char *name) {
|
||||
if (name[0] == '.') return (char *) name;
|
||||
const char *c;
|
||||
for (c = name; *c; c++) {
|
||||
if (*c == '/') return (char *) name;
|
||||
}
|
||||
size_t l = (size_t)(c - name);
|
||||
char *ret = janet_malloc(l + 3);
|
||||
if (NULL == ret) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
ret[0] = '.';
|
||||
ret[1] = '/';
|
||||
memcpy(ret + 2, name, l + 1);
|
||||
return ret;
|
||||
}
|
||||
|
||||
#if defined(JANET_WINDOWS)
|
||||
static char error_clib_buf[256];
|
||||
char *error_clib(void) {
|
||||
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
||||
error_clib_buf, sizeof(error_clib_buf), NULL);
|
||||
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
|
||||
return error_clib_buf;
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Alloc function macro fills */
|
||||
void *(janet_malloc)(size_t size) {
|
||||
return janet_malloc(size);
|
||||
}
|
||||
|
||||
void (janet_free)(void *ptr) {
|
||||
janet_free(ptr);
|
||||
}
|
||||
|
||||
void *(janet_calloc)(size_t nmemb, size_t size) {
|
||||
return janet_calloc(nmemb, size);
|
||||
}
|
||||
|
||||
void *(janet_realloc)(void *ptr, size_t size) {
|
||||
return janet_realloc(ptr, size);
|
||||
}
|
||||
|
||||
123
src/core/util.h
123
src/core/util.h
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2022 Calvin Rose
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -26,32 +26,16 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
#include <stddef.h>
|
||||
#include <stdbool.h>
|
||||
|
||||
#ifdef JANET_EV
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
|
||||
#ifndef _MSC_VER
|
||||
#include <alloca.h>
|
||||
#endif
|
||||
|
||||
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
|
||||
#include <time.h>
|
||||
#define JANET_GETTIME
|
||||
#endif
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef JANET_EXIT
|
||||
#ifndef janet_exit
|
||||
#include <stdio.h>
|
||||
#define JANET_EXIT(m) do { \
|
||||
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
|
||||
#define janet_exit(m) do { \
|
||||
printf("C runtime error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
@@ -59,17 +43,26 @@
|
||||
} while (0)
|
||||
#endif
|
||||
|
||||
#define JANET_MARSHAL_DECREF 0x40000
|
||||
|
||||
#define janet_assert(c, m) do { \
|
||||
if (!(c)) JANET_EXIT((m)); \
|
||||
if (!(c)) janet_exit((m)); \
|
||||
} while (0)
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
#define JDOC(x) NULL
|
||||
#define JANET_NO_BOOTSTRAP
|
||||
#else
|
||||
#define JDOC(x) x
|
||||
#endif
|
||||
|
||||
/* Utils */
|
||||
uint32_t janet_hash_mix(uint32_t input, uint32_t more);
|
||||
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
||||
int janet_valid_utf8(const uint8_t *str, int32_t len);
|
||||
int janet_is_symbol_char(uint8_t c);
|
||||
extern const char janet_base64[65];
|
||||
int32_t janet_array_calchash(const Janet *array, int32_t len);
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
|
||||
@@ -78,10 +71,10 @@ int32_t janet_tablen(int32_t n);
|
||||
void safe_memcpy(void *dest, const void *src, size_t len);
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
JanetTable *janet_get_core_table(const char *name);
|
||||
void janet_def_addflags(JanetFuncDef *def);
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
@@ -93,71 +86,17 @@ void janet_buffer_format(
|
||||
int32_t argstart,
|
||||
int32_t argc,
|
||||
Janet *argv);
|
||||
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
|
||||
JanetBinding janet_binding_from_entry(Janet entry);
|
||||
|
||||
/* Registry functions */
|
||||
void janet_registry_put(
|
||||
JanetCFunction key,
|
||||
const char *name,
|
||||
const char *name_prefix,
|
||||
const char *source_file,
|
||||
int32_t source_line);
|
||||
JanetCFunRegistry *janet_registry_get(JanetCFunction key);
|
||||
|
||||
/* Inside the janet core, defining globals is different
|
||||
* at bootstrap time and normal runtime */
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
#define JANET_CORE_REG JANET_REG
|
||||
#define JANET_CORE_FN JANET_FN
|
||||
#define JANET_CORE_DEF JANET_DEF
|
||||
#define janet_core_def_sm janet_def_sm
|
||||
#define janet_core_cfuns_ext janet_cfuns_ext
|
||||
#define janet_core_def janet_def
|
||||
#define janet_core_cfuns janet_cfuns
|
||||
#else
|
||||
#define JANET_CORE_REG JANET_REG_S
|
||||
#define JANET_CORE_FN JANET_FN_S
|
||||
#define JANET_CORE_DEF(ENV, NAME, X, DOC) janet_core_def_sm(ENV, NAME, X, DOC, NULL, 0)
|
||||
void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl);
|
||||
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns);
|
||||
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
|
||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
#endif
|
||||
|
||||
/* Clock gettime */
|
||||
#ifdef JANET_GETTIME
|
||||
int janet_gettime(struct timespec *spec);
|
||||
#endif
|
||||
|
||||
/* strdup */
|
||||
#ifdef JANET_WINDOWS
|
||||
#define strdup(x) _strdup(x)
|
||||
#endif
|
||||
|
||||
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
|
||||
* with native code. */
|
||||
#if defined(JANET_NO_DYNAMIC_MODULES)
|
||||
typedef int Clib;
|
||||
#define load_clib(name) ((void) name, 0)
|
||||
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
|
||||
#define error_clib() "dynamic libraries not supported"
|
||||
#define free_clib(c) ((void) (c), 0)
|
||||
#elif defined(JANET_WINDOWS)
|
||||
#include <windows.h>
|
||||
typedef HINSTANCE Clib;
|
||||
#define load_clib(name) LoadLibrary((name))
|
||||
#define free_clib(c) FreeLibrary((c))
|
||||
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
|
||||
char *error_clib(void);
|
||||
#else
|
||||
#include <dlfcn.h>
|
||||
typedef void *Clib;
|
||||
#define load_clib(name) dlopen((name), RTLD_NOW)
|
||||
#define free_clib(lib) dlclose((lib))
|
||||
#define symbol_clib(lib, sym) dlsym((lib), (sym))
|
||||
#define error_clib() dlerror()
|
||||
#endif
|
||||
char *get_processed_name(const char *name);
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
|
||||
/* Initialize builtin libraries */
|
||||
void janet_lib_io(JanetTable *env);
|
||||
void janet_lib_math(JanetTable *env);
|
||||
@@ -165,7 +104,6 @@ void janet_lib_array(JanetTable *env);
|
||||
void janet_lib_tuple(JanetTable *env);
|
||||
void janet_lib_buffer(JanetTable *env);
|
||||
void janet_lib_table(JanetTable *env);
|
||||
void janet_lib_struct(JanetTable *env);
|
||||
void janet_lib_fiber(JanetTable *env);
|
||||
void janet_lib_os(JanetTable *env);
|
||||
void janet_lib_string(JanetTable *env);
|
||||
@@ -185,17 +123,8 @@ void janet_lib_typed_array(JanetTable *env);
|
||||
#ifdef JANET_INT_TYPES
|
||||
void janet_lib_inttypes(JanetTable *env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
void janet_lib_net(JanetTable *env);
|
||||
extern const JanetAbstractType janet_address_type;
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
void janet_lib_ev(JanetTable *env);
|
||||
void janet_ev_mark(void);
|
||||
int janet_make_pipe(JanetHandle handles[2], int mode);
|
||||
#endif
|
||||
#ifdef JANET_FFI
|
||||
void janet_lib_ffi(JanetTable *env);
|
||||
#ifdef JANET_THREADS
|
||||
void janet_lib_thread(JanetTable *env);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user