1
0
mirror of https://github.com/janet-lang/janet synced 2025-10-28 14:17:42 +00:00

Compare commits

..

1 Commits

Author SHA1 Message Date
Calvin Rose
2739605184 Add support for cuddled symbol shorthand. 2020-03-31 20:39:02 -05:00
144 changed files with 8181 additions and 19134 deletions

View File

@@ -9,3 +9,4 @@ tasks:
gmake
gmake test
sudo gmake install
gmake test-install

View File

@@ -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

View File

@@ -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
View File

@@ -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

View File

@@ -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

View File

@@ -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
View File

@@ -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
View 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"

View File

@@ -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

View File

@@ -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.

View File

@@ -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
View File

@@ -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
View File

@@ -1,24 +1,22 @@
[![Join the chat](https://badges.gitter.im/janet-language/community.svg)](https://gitter.im/janet-language/community)
&nbsp;
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
[![Actions Status](https://github.com/janet-lang/janet/actions/workflows/test.yml/badge.svg)](https://github.com/janet-lang/janet/actions/workflows/test.yml)
[![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
[![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yml.svg)](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
View 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

Binary file not shown.

After

Width:  |  Height:  |  Size: 109 KiB

1063
auxbin/jpm Executable file

File diff suppressed because it is too large Load Diff

View File

@@ -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

View File

@@ -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

View File

@@ -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")

View File

@@ -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))

View File

@@ -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

View File

@@ -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)))

View File

@@ -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)

View File

@@ -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)

View File

@@ -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)

View File

@@ -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))

View File

@@ -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);
}

View File

@@ -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.")

View File

@@ -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))

View File

@@ -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))

View File

@@ -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}
};

View File

@@ -1,7 +0,0 @@
(declare-project
:name "numarray"
:description "Example c lib with abstract type")
(declare-native
:name "numarray"
:source @["numarray.c"])

View File

@@ -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))

View File

@@ -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
View 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))))

View File

@@ -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))

View File

@@ -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"))))

View File

@@ -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
View 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")))

View File

@@ -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)

View File

@@ -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))

View File

@@ -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
View 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
View File

@@ -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
View 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>

View File

@@ -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

View File

@@ -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)

View File

@@ -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

View File

@@ -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();

File diff suppressed because it is too large Load Diff

View File

@@ -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

View File

@@ -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

View File

@@ -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;
}

View File

@@ -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;
}

View File

@@ -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 */

View File

@@ -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

View File

@@ -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);
}

View File

@@ -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

View File

@@ -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);
}

View File

@@ -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;

View File

@@ -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) {

View File

@@ -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) {

View File

@@ -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, &macroval);
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);
}

View File

@@ -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);

View File

@@ -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;
}

View File

@@ -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);
}

View File

@@ -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) {

View File

@@ -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);

File diff suppressed because it is too large Load Diff

View File

@@ -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

File diff suppressed because it is too large Load Diff

View File

@@ -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);
}

View File

@@ -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

View File

@@ -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");
}

View File

@@ -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);

View File

@@ -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);
}

View File

@@ -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."));
}

View File

@@ -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);
}

View File

@@ -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
}

View File

@@ -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

File diff suppressed because it is too large Load Diff

View File

@@ -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);
}

View File

@@ -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);
}

View File

@@ -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

View File

@@ -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);

View File

@@ -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

View File

@@ -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;
}

View File

@@ -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}
};

View File

@@ -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 */

View File

@@ -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);
}

View File

@@ -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 {

View File

@@ -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;
}

View File

@@ -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;
}

View File

@@ -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

View File

@@ -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
View 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

View File

@@ -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
View 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

View File

@@ -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);
}

View File

@@ -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