mirror of
https://github.com/janet-lang/janet
synced 2025-11-09 03:53:06 +00:00
Compare commits
255 Commits
ev_execute
...
v1.16.1
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
87f8fe14dd | ||
|
|
2eadb21eb7 | ||
|
|
8b97a0dbbf | ||
|
|
69afa2a7a3 | ||
|
|
da5328bae5 | ||
|
|
a4325372e2 | ||
|
|
4b96b73858 | ||
|
|
bbae43f259 | ||
|
|
14fedbf063 | ||
|
|
ab974c409d | ||
|
|
2040709585 | ||
|
|
60214dc659 | ||
|
|
b990d77f16 | ||
|
|
d204e06e11 | ||
|
|
f6b37dbc77 | ||
|
|
ff4d49f556 | ||
|
|
dfa5fa1187 | ||
|
|
1f4f69a5b6 | ||
|
|
84f82f5465 | ||
|
|
c911f7c47e | ||
|
|
33c000daea | ||
|
|
7ff204ec44 | ||
|
|
7c757ef3bf | ||
|
|
2db7945d6f | ||
|
|
81186bf262 | ||
|
|
eeef5b0896 | ||
|
|
8189b6fc11 | ||
|
|
e5a2df93ab | ||
|
|
c3f770da27 | ||
|
|
49f66a936c | ||
|
|
83dda98240 | ||
|
|
b4ddbd0097 | ||
|
|
cbe92bb985 | ||
|
|
60c6a0d334 | ||
|
|
1baab5eb61 | ||
|
|
8fc8974b60 | ||
|
|
ecb49c2e5e | ||
|
|
29797b9eb0 | ||
|
|
e181ee586b | ||
|
|
7b7d742bec | ||
|
|
612eaff9ff | ||
|
|
d76ef187e8 | ||
|
|
e01ab86a89 | ||
|
|
89b59b4ffc | ||
|
|
e367ecf806 | ||
|
|
effc9e0f33 | ||
|
|
da06e6c6e3 | ||
|
|
c258bee54f | ||
|
|
cde4a505cf | ||
|
|
2802e66259 | ||
|
|
3a3003029a | ||
|
|
08bca8fb63 | ||
|
|
7c7ff802fa | ||
|
|
0945acc780 | ||
|
|
64ec9f9cb6 | ||
|
|
83f7de33c0 | ||
|
|
ec2d7bf349 | ||
|
|
f4c9064b79 | ||
|
|
8ede16dc26 | ||
|
|
27e400fba3 | ||
|
|
37d6cb469b | ||
|
|
100a82feb2 | ||
|
|
90e5828d5d | ||
|
|
b3e80308d4 | ||
|
|
a7abe11105 | ||
|
|
3c63a48df4 | ||
|
|
fcb88e5a98 | ||
|
|
a467b34de4 | ||
|
|
a24cc77ff8 | ||
|
|
d6675d9909 | ||
|
|
fa163093d2 | ||
|
|
e70f64e23d | ||
|
|
6f605f8141 | ||
|
|
d9419ef994 | ||
|
|
7e8639a682 | ||
|
|
452b303b4c | ||
|
|
b0f1a4967d | ||
|
|
9eb4c59c04 | ||
|
|
0d42506cde | ||
|
|
c8a13ce475 | ||
|
|
05e3467d09 | ||
|
|
90639e5068 | ||
|
|
73c7711c78 | ||
|
|
78f6b6a507 | ||
|
|
84f0ab5356 | ||
|
|
546437d799 | ||
|
|
0f05aec563 | ||
|
|
c9097623d6 | ||
|
|
6392b37c47 | ||
|
|
4fcc8075d4 | ||
|
|
b2d6a55335 | ||
|
|
1fea5f8fe7 | ||
|
|
d3e52a2afb | ||
|
|
d6ea1989cc | ||
|
|
96513665d6 | ||
|
|
b795d13f61 | ||
|
|
970f9b3981 | ||
|
|
be7dab4d17 | ||
|
|
0e44ce5cba | ||
|
|
1f8c2781dd | ||
|
|
f381a9c773 | ||
|
|
855a9a01fc | ||
|
|
a5f237993d | ||
|
|
c68264802a | ||
|
|
742469a8bc | ||
|
|
92928d5c4f | ||
|
|
8320e25d64 | ||
|
|
c16a9d8463 | ||
|
|
f1819c916a | ||
|
|
dd14b24d2a | ||
|
|
050d7c12a3 | ||
|
|
7e2c433abc | ||
|
|
6713b23a65 | ||
|
|
60078e7950 | ||
|
|
69095fbb48 | ||
|
|
c88a3c64e3 | ||
|
|
771b0d0ab1 | ||
|
|
c85310578b | ||
|
|
60e2992158 | ||
|
|
2795e8a8b7 | ||
|
|
bdf14170a4 | ||
|
|
10dcbc639a | ||
|
|
6a9bb0f4e4 | ||
|
|
c941e5a8f4 | ||
|
|
be91414c7a | ||
|
|
6839b603c8 | ||
|
|
926b68d62e | ||
|
|
d374e90033 | ||
|
|
b168b0758a | ||
|
|
54c66ecfc0 | ||
|
|
1c158bd4ff | ||
|
|
ff24143f54 | ||
|
|
dd117e81c2 | ||
|
|
f4744a18c6 | ||
|
|
259d5fabd9 | ||
|
|
d122a75efd | ||
|
|
c9ea3ac304 | ||
|
|
c63fe6ef8a | ||
|
|
72ec89dfe9 | ||
|
|
04805d106e | ||
|
|
9aed578466 | ||
|
|
77c5279296 | ||
|
|
af75bf3b64 | ||
|
|
a5157e868b | ||
|
|
01a3d8f932 | ||
|
|
f22472a644 | ||
|
|
5cac8bcf9f | ||
|
|
a2801fbef9 | ||
|
|
0b14e913da | ||
|
|
85155bb2b4 | ||
|
|
dd8de1e9ac | ||
|
|
c909835b0a | ||
|
|
a18aafedfd | ||
|
|
317ab6df6b | ||
|
|
1fcaffe6b0 | ||
|
|
3ae5c410dc | ||
|
|
381128364e | ||
|
|
0acf167e84 | ||
|
|
f7ca6deeb0 | ||
|
|
251486e4aa | ||
|
|
c6467be60d | ||
|
|
4dd512ad28 | ||
|
|
28076b9385 | ||
|
|
49dcc816ae | ||
|
|
fa61c70103 | ||
|
|
5ee6dbcdf4 | ||
|
|
634219da2c | ||
|
|
fbe3849b4b | ||
|
|
bd2e335063 | ||
|
|
96262e7d87 | ||
|
|
c5da87b860 | ||
|
|
848d4a1498 | ||
|
|
70e23df6f8 | ||
|
|
95af205681 | ||
|
|
6dfb689d1f | ||
|
|
462e74ef87 | ||
|
|
c6aa536590 | ||
|
|
c79480342b | ||
|
|
a1cc5ca045 | ||
|
|
7f74ff3dd7 | ||
|
|
c4a95e9a1e | ||
|
|
71f9e2b1d7 | ||
|
|
16fe32215b | ||
|
|
dd7342a6cf | ||
|
|
35c88d10cd | ||
|
|
42532de0eb | ||
|
|
122e2a9378 | ||
|
|
33c9395d79 | ||
|
|
fc49aa359c | ||
|
|
fcf37942a7 | ||
|
|
9b42d5a5e9 | ||
|
|
ba92dfcbe9 | ||
|
|
fd03603adb | ||
|
|
2008ddf8a8 | ||
|
|
c56b876bfe | ||
|
|
c4957d5dfb | ||
|
|
068bd33afb | ||
|
|
e9bd108be9 | ||
|
|
4f2d1cdc00 | ||
|
|
61cca10cf6 | ||
|
|
dfbdd17dce | ||
|
|
9078d3bd37 | ||
|
|
5e1a8c86f9 | ||
|
|
bf01bf631d | ||
|
|
80c5ba32b5 | ||
|
|
874cc79443 | ||
|
|
3883460202 | ||
|
|
f0dbc2e404 | ||
|
|
4df1ac5b23 | ||
|
|
1f6d0d342b | ||
|
|
4625c28e6a | ||
|
|
5536ba20a8 | ||
|
|
ef398e9036 | ||
|
|
0c73c3f1cd | ||
|
|
7ae7984f3c | ||
|
|
8286b33c52 | ||
|
|
475775cc9d | ||
|
|
11067d7a56 | ||
|
|
5b05da65f0 | ||
|
|
444e630783 | ||
|
|
8951b8de7a | ||
|
|
2abb87eb63 | ||
|
|
32e8ac912d | ||
|
|
e403fb4652 | ||
|
|
daa37c22f5 | ||
|
|
5a2a134c95 | ||
|
|
b9acb6dfa5 | ||
|
|
4e7ad3c7ce | ||
|
|
ee0e1a2342 | ||
|
|
f206b476d1 | ||
|
|
dd2595c53f | ||
|
|
545df28d71 | ||
|
|
16f80b78cf | ||
|
|
147bcce01b | ||
|
|
f5877ac6d1 | ||
|
|
adc41e31f4 | ||
|
|
2e555a930f | ||
|
|
bcba0c0279 | ||
|
|
c7f382add6 | ||
|
|
665b1e68d5 | ||
|
|
2ca9300bf7 | ||
|
|
81f62b246c | ||
|
|
87badc71d2 | ||
|
|
e5242c67ff | ||
|
|
4355420994 | ||
|
|
c357af02c2 | ||
|
|
19576effbe | ||
|
|
ecc6eb7497 | ||
|
|
d0ac318980 | ||
|
|
7b030fe70d | ||
|
|
115556fcf2 | ||
|
|
9760cf1f4e | ||
|
|
6b268c5df4 | ||
|
|
62f783f1dc | ||
|
|
25ded775ad |
@@ -4,12 +4,20 @@ sources:
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
- with-epoll: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
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
|
||||
sudo jpm --verbose install circlet
|
||||
sudo jpm --verbose install spork
|
||||
|
||||
6
.gitignore
vendored
6
.gitignore
vendored
@@ -32,8 +32,9 @@ lockfile.janet
|
||||
# Local directory for testing
|
||||
local
|
||||
|
||||
# Common test file I use.
|
||||
# Common test files I use.
|
||||
temp.janet
|
||||
scratch.janet
|
||||
|
||||
# Emscripten
|
||||
*.bc
|
||||
@@ -140,3 +141,6 @@ compile_commands.json
|
||||
CTestTestfile.cmake
|
||||
|
||||
# End of https://www.gitignore.io/api/cmake
|
||||
|
||||
# Astyle
|
||||
*.orig
|
||||
|
||||
@@ -4,7 +4,7 @@ script:
|
||||
- make test
|
||||
- sudo make install
|
||||
- make test-install
|
||||
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
- JANET_DIST_DIR=janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME} make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
compiler:
|
||||
- clang
|
||||
- gcc
|
||||
|
||||
97
CHANGELOG.md
97
CHANGELOG.md
@@ -1,16 +1,109 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
## 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 `decalre-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.
|
||||
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`
|
||||
|
||||
@@ -14,7 +14,6 @@ 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
|
||||
|
||||
@@ -30,8 +29,7 @@ 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.
|
||||
|
||||
@@ -75,4 +73,3 @@ timely manner. In short, if you want extra functionality now, then build it.
|
||||
|
||||
* Include a good description of the problem that is being solved
|
||||
* Include descriptions of potential solutions if you have some in mind.
|
||||
* Add the appropriate tags to the issue. For new features, add the `enhancement` tag.
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
||||
Copyright (c) 2020 Calvin Rose and contributors
|
||||
Copyright (c) 2021 Calvin Rose and contributors
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||||
this software and associated documentation files (the "Software"), to deal in
|
||||
|
||||
41
Makefile
41
Makefile
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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,7 +27,7 @@ PREFIX?=/usr/local
|
||||
INCLUDEDIR?=$(PREFIX)/include
|
||||
BINDIR?=$(PREFIX)/bin
|
||||
LIBDIR?=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || echo local)\""
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
|
||||
CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
@@ -35,6 +35,7 @@ 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
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
|
||||
@@ -66,7 +67,7 @@ ifeq ($(UNAME), Haiku)
|
||||
LDFLAGS=-Wl,--export-dynamic
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
||||
$(shell mkdir -p build/core build/c build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
|
||||
######################
|
||||
@@ -119,7 +120,6 @@ JANET_CORE_SOURCES=src/core/abstract.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,7 +149,7 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
|
||||
cksum $@
|
||||
|
||||
@@ -157,9 +157,9 @@ build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.13
|
||||
SONAME=libjanet.so.1.16
|
||||
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
|
||||
@@ -168,11 +168,11 @@ build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
|
||||
build/janetconf.h: src/conf/janetconf.h
|
||||
cp $< $@
|
||||
|
||||
build/janet.o: build/janet.c src/include/janet.h src/conf/janetconf.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
|
||||
build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
|
||||
build/shell.o: build/shell.c src/include/janet.h src/conf/janetconf.h
|
||||
$(HOSTCC) $(BUILD_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 $@
|
||||
|
||||
$(JANET_TARGET): build/janet.o build/shell.o
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||
@@ -224,11 +224,20 @@ dist: build/janet-dist.tar.gz
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
build/janet.h \
|
||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/janet.c build/shell.c 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)
|
||||
README.md build/c/janet.c build/c/shell.c jpm
|
||||
mkdir -p build/$(JANET_DIST_DIR)/bin
|
||||
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
|
||||
cp jpm 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 jpm.1 build/$(JANET_DIST_DIR)/man/man1/
|
||||
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)
|
||||
|
||||
#########################
|
||||
##### Documentation #####
|
||||
|
||||
44
README.md
44
README.md
@@ -17,6 +17,9 @@ 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
|
||||
[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
|
||||
@@ -58,9 +61,9 @@ 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 doc)
|
||||
(doc apply)
|
||||
```
|
||||
Shows documentation for the doc macro.
|
||||
Shows documentation for the `apply` function.
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-bindings)` function. You
|
||||
@@ -170,7 +173,7 @@ Emacs, and Atom will have syntax packages for the Janet language, though.
|
||||
|
||||
## Installation
|
||||
|
||||
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
|
||||
See the [Introduction](https://janet-lang.org/docs/index.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
|
||||
@@ -231,7 +234,7 @@ 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).
|
||||
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
||||
Gitter provides Matrix and irc bridges as well.
|
||||
|
||||
## FAQ
|
||||
|
||||
@@ -243,8 +246,35 @@ 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 Janet
|
||||
### Where is (favorite feature from other language)?
|
||||
|
||||
It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
|
||||
they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
|
||||
of 5 others by making the language more complicated.
|
||||
|
||||
### Where is the example code?
|
||||
|
||||
In the examples directory.
|
||||
|
||||
### Is this a Clojure port?
|
||||
|
||||
No. It's similar to Clojure superficially because I like Lisps and I like the asthetics.
|
||||
Internally, Janet is not at all like Clojure.
|
||||
|
||||
### Are the immutable data structures (tuples and structs) implemented as hash tries?
|
||||
|
||||
No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
|
||||
and maps, instead they work well as table keys or other identifiers.
|
||||
|
||||
### Why can't we add (feature from Clojure) into the core?
|
||||
|
||||
Usually, one of a few reasons:
|
||||
- Often, it already exists in a different form and the Clojure port would be redundant.
|
||||
- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
|
||||
Janet does not run on the JVM. We admittedly have a much more primitive GC.
|
||||
- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
|
||||
without feeling "bolted on", especially when compared to ALGOL like languages.
|
||||
|
||||
## Why is it called "Janet"?
|
||||
|
||||
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">
|
||||
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 109 KiB |
@@ -30,7 +30,7 @@ if not "%JANET_BUILD%" == "" (
|
||||
|
||||
if not exist build mkdir build
|
||||
if not exist build\core mkdir build\core
|
||||
if not exist build\mainclient mkdir build\mainclient
|
||||
if not exist build\c mkdir build\c
|
||||
if not exist build\boot mkdir build\boot
|
||||
|
||||
@rem Build the bootstrap interpreter
|
||||
@@ -44,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\janet.c
|
||||
build\janet_boot . > build\c\janet.c
|
||||
|
||||
@rem Build the sources
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@@ -102,9 +102,9 @@ 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\janet.c
|
||||
janet.exe tools\removecr.janet build\c\janet.c
|
||||
|
||||
copy build\janet.c dist\janet.c
|
||||
copy build\c\janet.c dist\janet.c
|
||||
copy src\mainclient\shell.c dist\shell.c
|
||||
copy janet.exe dist\janet.exe
|
||||
copy LICENSE dist\LICENSE
|
||||
@@ -118,7 +118,6 @@ copy build\janet.h dist\janet.h
|
||||
copy build\libjanet.lib dist\libjanet.lib
|
||||
|
||||
copy .\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
|
||||
|
||||
19
examples/iterate-fiber.janet
Normal file
19
examples/iterate-fiber.janet
Normal file
@@ -0,0 +1,19 @@
|
||||
(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))
|
||||
@@ -7,13 +7,13 @@ typedef struct {
|
||||
} num_array;
|
||||
|
||||
static num_array *num_array_init(num_array *array, size_t size) {
|
||||
array->data = (double *)calloc(size, sizeof(double));
|
||||
array->data = (double *)janet_calloc(size, sizeof(double));
|
||||
array->size = size;
|
||||
return array;
|
||||
}
|
||||
|
||||
static void num_array_deinit(num_array *array) {
|
||||
free(array->data);
|
||||
janet_free(array->data);
|
||||
}
|
||||
|
||||
static int num_array_gc(void *p, size_t s) {
|
||||
|
||||
@@ -1,73 +0,0 @@
|
||||
# naive matrix implementation for testing typed array
|
||||
|
||||
(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
|
||||
|
||||
(defn matrix/row [mat i]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(tarray/new :float64 ncol 1 (* i ncol) array))
|
||||
|
||||
(defn matrix/column [mat j]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(tarray/new :float64 nrow ncol j array))
|
||||
|
||||
(defn matrix/set [mat i j value]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(set (array (+ (* i ncol) j)) value))
|
||||
|
||||
(defn matrix/get [mat i j value]
|
||||
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||
(array (+ (* i ncol) j)))
|
||||
|
||||
|
||||
# other variants to test rows and cols views
|
||||
|
||||
(defn matrix/set* [mat i j value]
|
||||
(set ((matrix/row mat i) j) value))
|
||||
|
||||
(defn matrix/set** [mat i j value]
|
||||
(set ((matrix/column mat j) i) value))
|
||||
|
||||
|
||||
(defn matrix/get* [mat i j value]
|
||||
((matrix/row mat i) j))
|
||||
|
||||
(defn matrix/get** [mat i j value]
|
||||
((matrix/column mat j) i))
|
||||
|
||||
|
||||
(defn tarray/print [arr]
|
||||
(def size (tarray/length arr))
|
||||
(prinf "[%2i]" size)
|
||||
(for i 0 size
|
||||
(prinf " %+6.3f " (arr i)))
|
||||
(print))
|
||||
|
||||
(defn matrix/print [mat]
|
||||
(def {:nrow nrow :ncol ncol :array tarray} mat)
|
||||
(printf "matrix %iX%i %p" nrow ncol tarray)
|
||||
(for i 0 nrow
|
||||
(tarray/print (matrix/row mat i))))
|
||||
|
||||
|
||||
(def nr 5)
|
||||
(def nc 4)
|
||||
(def A (matrix nr nc))
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set* A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set** A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
|
||||
(printf "properties:\n%p" (tarray/properties (A :array)))
|
||||
(for i 0 nr
|
||||
(printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i))))
|
||||
(for i 0 nc
|
||||
(printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))
|
||||
@@ -1,4 +1,4 @@
|
||||
(def server (net/server "127.0.0.1" "8009" nil :datagram))
|
||||
(def server (net/listen "127.0.0.1" "8009" :datagram))
|
||||
(while true
|
||||
(def buf @"")
|
||||
(def who (:recv-from server 1024 buf))
|
||||
|
||||
25
janet.1
25
janet.1
@@ -8,6 +8,8 @@ janet \- run the Janet language abstract machine
|
||||
[\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 ...
|
||||
@@ -175,6 +177,10 @@ 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,
|
||||
@@ -206,7 +212,18 @@ resulting image. Output should usually end with the .jimage extension.
|
||||
Import a Janet module 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
|
||||
@@ -221,6 +238,12 @@ 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
|
||||
|
||||
276
jpm
276
jpm
@@ -6,14 +6,21 @@
|
||||
# Basic Path Settings
|
||||
#
|
||||
|
||||
# Windows is the OS outlier
|
||||
(def- is-win (= (os/which) :windows))
|
||||
(def- is-mac (= (os/which) :macos))
|
||||
(def- sep (if is-win "\\" "/"))
|
||||
(def- objext (if is-win ".obj" ".o"))
|
||||
(def- modext (if is-win ".dll" ".so"))
|
||||
(def- statext (if is-win ".static.lib" ".a"))
|
||||
(def- absprefix (if is-win "C:\\" "/"))
|
||||
# Allow changing the behavior via an environment variable
|
||||
(def- host-os (keyword (string/ascii-lower (os/getenv "JPM_OS_WHICH" (os/which)))))
|
||||
(defn- define-utils
|
||||
[]
|
||||
(def is-win (= host-os :windows))
|
||||
(defglobal 'is-win is-win)
|
||||
(defglobal 'is-mac (= host-os :macos))
|
||||
(def sep (if is-win "\\" "/"))
|
||||
(defglobal 'sep sep)
|
||||
(defglobal 'objext (if is-win ".obj" ".o"))
|
||||
(defglobal 'modext (if is-win ".dll" ".so"))
|
||||
(defglobal 'statext (if is-win ".static.lib" ".a"))
|
||||
(defglobal 'absprefix (if is-win "C:\\" "/")))
|
||||
|
||||
(define-utils)
|
||||
|
||||
#
|
||||
# Defaults
|
||||
@@ -22,6 +29,19 @@
|
||||
###START###
|
||||
|
||||
# Overriden on some installs.
|
||||
# To configure this script, replace the code between
|
||||
# the START and END comments and define a function
|
||||
# (install-paths) that gives the the default paths
|
||||
# to use. Trailing directory separator not expected.
|
||||
#
|
||||
# Example.
|
||||
#
|
||||
# (defn- install-paths []
|
||||
# {:headerpath "/usr/local/include/janet"
|
||||
# :libpath "/usr/local/lib/janet"
|
||||
# :binpath "/usr/local/bin"
|
||||
#
|
||||
|
||||
(def- exe-dir
|
||||
"Directory containing jpm script"
|
||||
(do
|
||||
@@ -29,13 +49,28 @@
|
||||
(def i (last (string/find-all sep exe)))
|
||||
(slice exe 0 i)))
|
||||
|
||||
(defn- try-real [path]
|
||||
"If os/realpath fails just use normal path."
|
||||
(try (os/realpath path) ([_] path)))
|
||||
|
||||
(defn- install-paths []
|
||||
{:headerpath (os/realpath (string exe-dir "/../include/janet"))
|
||||
:libpath (os/realpath (string exe-dir "/../lib"))
|
||||
{:headerpath (try-real (string exe-dir "/../include/janet"))
|
||||
:libpath (try-real (string exe-dir "/../lib"))
|
||||
:binpath exe-dir})
|
||||
|
||||
# If janetconf.h has been modified such that core janet functions and macros require
|
||||
# linking to external libraries, modify this.
|
||||
#
|
||||
# Example - (def- extra-lflags ["-lmimalloc"])
|
||||
|
||||
###END###
|
||||
|
||||
# Redefine utils in case the above section is overriden on some installs.
|
||||
(define-utils)
|
||||
|
||||
(compwhen (not (dyn 'extra-lflags))
|
||||
(def- extra-lflags []))
|
||||
|
||||
# Default based on janet binary location
|
||||
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
|
||||
(get (install-paths) :headerpath)))
|
||||
@@ -152,9 +187,7 @@
|
||||
[& args]
|
||||
(if (dyn :verbose)
|
||||
(print ;(interpose " " args)))
|
||||
(def res (os/execute args :p))
|
||||
(unless (zero? res)
|
||||
(error (string "command exited with status " res))))
|
||||
(os/execute args :px))
|
||||
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
@@ -347,11 +380,11 @@
|
||||
# flags needed for the janet binary and compiling standalone
|
||||
# executables.
|
||||
(def janet-lflags
|
||||
(case (os/which)
|
||||
:macos ["-ldl" "-lm" ;thread-flags]
|
||||
:windows [;thread-flags]
|
||||
:linux ["-lm" "-ldl" "-lrt" ;thread-flags]
|
||||
["-lm" ;thread-flags]))
|
||||
(case host-os
|
||||
:macos ["-ldl" "-lm" ;thread-flags ;extra-lflags]
|
||||
:windows [;thread-flags ;extra-lflags]
|
||||
:linux ["-lm" "-ldl" "-lrt" ;thread-flags ;extra-lflags]
|
||||
["-lm" ;thread-flags ;extra-lflags]))
|
||||
(def janet-ldflags [])
|
||||
(def janet-cflags [])
|
||||
|
||||
@@ -437,6 +470,7 @@
|
||||
[opts]
|
||||
@[;(opt opts :cflags default-cflags)
|
||||
(string "-I" (dyn :headerpath JANET_HEADERPATH))
|
||||
(string "-I" (dyn :modpath JANET_MODPATH))
|
||||
(string "-O" (opt opts :optimize 2))])
|
||||
|
||||
(defn- getcppflags
|
||||
@@ -444,6 +478,7 @@
|
||||
[opts]
|
||||
@[;(opt opts :cppflags default-cppflags)
|
||||
(string "-I" (dyn :headerpath JANET_HEADERPATH))
|
||||
(string "-I" (dyn :modpath JANET_MODPATH))
|
||||
(string "-O" (opt opts :optimize 2))])
|
||||
|
||||
(defn- entry-name
|
||||
@@ -506,35 +541,26 @@
|
||||
(string hpath `\\janet.lib`))
|
||||
|
||||
(defn- link-c
|
||||
"Link C object files together to make a native module."
|
||||
[opts target & objects]
|
||||
(def linker (opt opts (if is-win :linker :compiler) default-linker))
|
||||
(def cflags (getcflags opts))
|
||||
"Link C or C++ object files together to make a native module."
|
||||
[has-cpp opts target & objects]
|
||||
(def linker
|
||||
(if has-cpp
|
||||
(opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker)
|
||||
(opt opts (if is-win :linker :compiler) default-linker)))
|
||||
(def cflags ((if has-cpp getcppflags getcflags) opts))
|
||||
(def lflags [;(opt opts :lflags default-lflags)
|
||||
;(if (opts :static) [] dynamic-lflags)])
|
||||
(def ldflags [;(opt opts :ldflags [])])
|
||||
(def deplibs (get opts :native-deps []))
|
||||
(def dep-ldflags (seq [x :in deplibs] (string (dyn :modpath JANET_MODPATH) sep x modext)))
|
||||
# Use import libs on windows - we need an import lib to link natives to other natives.
|
||||
(def dep-importlibs (seq [x :in deplibs] (string (dyn :modpath JANET_MODPATH) sep x ".lib")))
|
||||
(def ldflags [;(opt opts :ldflags []) ;dep-ldflags])
|
||||
(rule target objects
|
||||
(check-cc)
|
||||
(print "linking " target "...")
|
||||
(create-dirs target)
|
||||
(if is-win
|
||||
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
|
||||
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- link-cpp
|
||||
"Link C++ object files together to make a native module."
|
||||
[opts target & objects]
|
||||
(def linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker))
|
||||
(def cflags (getcppflags opts))
|
||||
(def lflags [;(opt opts :lflags default-lflags)
|
||||
;(if (opts :static) [] dynamic-lflags)])
|
||||
(def ldflags [;(opt opts :ldflags [])])
|
||||
(rule target objects
|
||||
(check-cc)
|
||||
(print "linking " target "...")
|
||||
(create-dirs target)
|
||||
(if is-win
|
||||
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
|
||||
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;dep-importlibs ;lflags)
|
||||
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- archive-c
|
||||
@@ -585,7 +611,7 @@
|
||||
(string (string/slice path 0 (- -1 (length modext))) statext))
|
||||
|
||||
(defn- make-bin-source
|
||||
[declarations lookup-into-invocations]
|
||||
[declarations lookup-into-invocations no-core]
|
||||
(string
|
||||
declarations
|
||||
```
|
||||
@@ -610,15 +636,22 @@ int main(int argc, const char **argv) {
|
||||
|
||||
janet_init();
|
||||
|
||||
```
|
||||
(if no-core
|
||||
```
|
||||
/* Get core env */
|
||||
JanetTable *env = janet_table(8);
|
||||
JanetTable *lookup = janet_core_lookup_table(NULL);
|
||||
JanetTable *temptab;
|
||||
int handle = janet_gclock();
|
||||
```
|
||||
```
|
||||
/* Get core env */
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
JanetTable *lookup = janet_env_lookup(env);
|
||||
JanetTable *temptab;
|
||||
int handle = janet_gclock();
|
||||
|
||||
/* Load natives into unmarshalling dictionary */
|
||||
|
||||
```
|
||||
```)
|
||||
lookup-into-invocations
|
||||
```
|
||||
/* Unmarshal bytecode */
|
||||
@@ -646,7 +679,6 @@ int main(int argc, const char **argv) {
|
||||
}
|
||||
|
||||
/* Create enviornment */
|
||||
temptab = janet_table(0);
|
||||
temptab = env;
|
||||
janet_table_put(temptab, janet_ckeywordv("args"), janet_wrap_array(args));
|
||||
janet_gcroot(janet_wrap_table(temptab));
|
||||
@@ -657,6 +689,14 @@ int main(int argc, const char **argv) {
|
||||
/* Run everything */
|
||||
JanetFiber *fiber = janet_fiber(jfunc, 64, argc, argc ? args->data : NULL);
|
||||
fiber->env = temptab;
|
||||
#ifdef JANET_EV
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_loop();
|
||||
int status = janet_fiber_status(fiber);
|
||||
janet_deinit();
|
||||
return status;
|
||||
#else
|
||||
Janet out;
|
||||
JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (result != JANET_SIGNAL_OK && result != JANET_SIGNAL_EVENT) {
|
||||
@@ -664,11 +704,9 @@ int main(int argc, const char **argv) {
|
||||
janet_deinit();
|
||||
return result;
|
||||
}
|
||||
#ifdef JANET_NET
|
||||
janet_loop();
|
||||
#endif
|
||||
janet_deinit();
|
||||
return 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
```))
|
||||
@@ -677,7 +715,7 @@ int main(int argc, const char **argv) {
|
||||
"Links an image with libjanet.a (or .lib) to produce an
|
||||
executable. Also will try to link native modules into the
|
||||
final executable as well."
|
||||
[opts source dest]
|
||||
[opts source dest no-core]
|
||||
|
||||
# Create executable's janet image
|
||||
(def cimage_dest (string dest ".c"))
|
||||
@@ -693,7 +731,16 @@ int main(int argc, const char **argv) {
|
||||
(def dep-ldflags @[])
|
||||
|
||||
# Create marshalling dictionary
|
||||
(def mdict (invert (env-lookup root-env)))
|
||||
(def mdict1 (invert (env-lookup root-env)))
|
||||
(def mdict
|
||||
(if no-core
|
||||
(let [temp @{}]
|
||||
(eachp [k v] mdict1
|
||||
(if (or (cfunction? k) (abstract? k))
|
||||
(put temp k v)))
|
||||
temp)
|
||||
mdict1))
|
||||
|
||||
# Load all native modules
|
||||
(def prefixes @{})
|
||||
(def static-libs @[])
|
||||
@@ -738,7 +785,7 @@ int main(int argc, const char **argv) {
|
||||
# Make image byte buffer
|
||||
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
||||
# Append main function
|
||||
(spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
|
||||
(spit cimage_dest (make-bin-source declarations lookup-into-invocations no-core) :ab)
|
||||
(def oimage_dest (out-path cimage_dest ".c" ".o"))
|
||||
# Compile and link final exectable
|
||||
(unless no-compile
|
||||
@@ -932,17 +979,18 @@ int main(int argc, const char **argv) {
|
||||
(var has-cpp false)
|
||||
(def objects
|
||||
(seq [src :in sources]
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src)
|
||||
(let [op (out-path src ".cpp" objext)]
|
||||
(compile-cpp opts src op)
|
||||
(set has-cpp true)
|
||||
op)
|
||||
(string/has-suffix? ".c" src)
|
||||
(let [op (out-path src ".c" objext)]
|
||||
(compile-c opts src op)
|
||||
op)
|
||||
(errorf "unknown source file type: %s, expected .c or .cpp"))))
|
||||
(def suffix
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src) ".cpp"
|
||||
(string/has-suffix? ".cc" src) ".cc"
|
||||
(string/has-suffix? ".c" src) ".c"
|
||||
(errorf "unknown source file type: %s, expected .c, .cc, or .cpp" src)))
|
||||
(def op (out-path src suffix objext))
|
||||
(if (= suffix ".c")
|
||||
(compile-c opts src op)
|
||||
(do (compile-cpp opts src op)
|
||||
(set has-cpp true)))
|
||||
op))
|
||||
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
@@ -951,7 +999,7 @@ int main(int argc, const char **argv) {
|
||||
(array/push objects o-src)
|
||||
(create-buffer-c src c-src (embed-name src))
|
||||
(compile-c opts c-src o-src)))
|
||||
((if has-cpp link-cpp link-c) opts lname ;objects)
|
||||
(link-c has-cpp opts lname ;objects)
|
||||
(add-dep "build" lname)
|
||||
(install-rule lname path)
|
||||
|
||||
@@ -980,16 +1028,17 @@ int main(int argc, const char **argv) {
|
||||
# Get static objects
|
||||
(def sobjects
|
||||
(seq [src :in sources]
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src)
|
||||
(let [op (out-path src ".cpp" sobjext)]
|
||||
(compile-cpp opts src op true)
|
||||
op)
|
||||
(string/has-suffix? ".c" src)
|
||||
(let [op (out-path src ".c" sobjext)]
|
||||
(compile-c opts src op true)
|
||||
op)
|
||||
(errorf "unknown source file type: %s, expected .c or .cpp"))))
|
||||
(def suffix
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src) ".cpp"
|
||||
(string/has-suffix? ".cc" src) ".cc"
|
||||
(string/has-suffix? ".c" src) ".c"
|
||||
(errorf "unknown source file type: %s, expected .c, .cc, or .cpp" src)))
|
||||
(def op (out-path src suffix sobjext))
|
||||
(if (= suffix ".c")
|
||||
(compile-c opts src op true)
|
||||
(compile-cpp opts src op true))
|
||||
op))
|
||||
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
@@ -1015,6 +1064,16 @@ int main(int argc, const char **argv) {
|
||||
(each s sources
|
||||
(install-rule s path))))
|
||||
|
||||
(defn declare-headers
|
||||
"Declare headers for a library installation. Installed headers can be used by other native
|
||||
libraries."
|
||||
[&keys {:headers headers :prefix prefix}]
|
||||
(def path (string (dyn :modpath JANET_MODPATH) (or prefix "")))
|
||||
(if (bytes? headers)
|
||||
(install-rule headers path)
|
||||
(each h headers
|
||||
(install-rule h path))))
|
||||
|
||||
(defn declare-bin
|
||||
"Declare a generic file to be installed as an executable."
|
||||
[&keys {:main main}]
|
||||
@@ -1027,10 +1086,10 @@ int main(int argc, const char **argv) {
|
||||
This executable can be installed as well to the --binpath given."
|
||||
[&keys {:install install :name name :entry entry :headers headers
|
||||
:cflags cflags :lflags lflags :deps deps :ldflags ldflags
|
||||
:no-compile no-compile}]
|
||||
:no-compile no-compile :no-core no-core}]
|
||||
(def name (if is-win (string name ".exe") name))
|
||||
(def dest (string "build" sep name))
|
||||
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest)
|
||||
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest no-core)
|
||||
(if no-compile
|
||||
(let [cdest (string dest ".c")]
|
||||
(add-dep "build" cdest))
|
||||
@@ -1044,12 +1103,15 @@ int main(int argc, const char **argv) {
|
||||
(install-rule dest (dyn :binpath JANET_BINPATH))))))
|
||||
|
||||
(defn declare-binscript
|
||||
"Declare a janet file to be installed as an executable script. Creates
|
||||
``Declare a janet file to be installed as an executable script. Creates
|
||||
a shim on windows. If hardcode is true, will insert code into the script
|
||||
such that it will run correctly even when JANET_PATH is changed."
|
||||
[&keys {:main main :hardcode-syspath hardcode}]
|
||||
such that it will run correctly even when JANET_PATH is changed. if auto-shebang
|
||||
is truthy, will also automatically insert a correct shebang line.
|
||||
``
|
||||
[&keys {:main main :hardcode-syspath hardcode :is-janet is-janet}]
|
||||
(def binpath (dyn :binpath JANET_BINPATH))
|
||||
(if hardcode
|
||||
(def auto-shebang (and is-janet (dyn :auto-shebang)))
|
||||
(if (or auto-shebang hardcode)
|
||||
(let [syspath (dyn :modpath JANET_MODPATH)]
|
||||
(def parts (peg/match path-splitter main))
|
||||
(def name (last parts))
|
||||
@@ -1061,7 +1123,9 @@ int main(int argc, const char **argv) {
|
||||
(def first-line (:read f :line))
|
||||
(def second-line (string/format "(put root-env :syspath %v)\n" syspath))
|
||||
(def rest (:read f :all))
|
||||
(string first-line second-line rest)))
|
||||
(string (if auto-shebang
|
||||
(string "#!" (dyn :binpath JANET_BINPATH) "/janet\n"))
|
||||
first-line (if hardcode second-line) rest)))
|
||||
(create-dirs path)
|
||||
(spit path contents)
|
||||
(unless is-win (shell "chmod" "+x" path))))
|
||||
@@ -1337,7 +1401,9 @@ Flags are:
|
||||
|
||||
(defn quickbin
|
||||
[input output]
|
||||
(create-executable @{} input output)
|
||||
(if (= (os/stat output :mode) :file)
|
||||
(print "output " output " exists."))
|
||||
(create-executable @{:no-compile (dyn :no-compile)} input output (dyn :no-core))
|
||||
(do-rule output))
|
||||
|
||||
(defn jpm-debug-repl
|
||||
@@ -1384,26 +1450,30 @@ Flags are:
|
||||
"load-lockfile" load-lockfile
|
||||
"quickbin" quickbin})
|
||||
|
||||
(def- args (tuple/slice (dyn :args) 1))
|
||||
(def- len (length args))
|
||||
(var i :private 0)
|
||||
(defn- main
|
||||
"Script entry."
|
||||
[& argv]
|
||||
|
||||
# Get flags
|
||||
(while (< i len)
|
||||
(if-let [m (peg/match argpeg (args i))]
|
||||
(if (= 2 (length m))
|
||||
(let [[key value] m]
|
||||
(setdyn (keyword key) value))
|
||||
(setdyn (keyword (m 0)) true))
|
||||
(break))
|
||||
(++ i))
|
||||
(def- args (tuple/slice argv 1))
|
||||
(def- len (length args))
|
||||
(var i :private 0)
|
||||
|
||||
# Run subcommand
|
||||
(if (= i len)
|
||||
(help)
|
||||
(do
|
||||
(if-let [com (subcommands (args i))]
|
||||
(com ;(tuple/slice args (+ i 1)))
|
||||
(do
|
||||
(print "invalid command " (args i))
|
||||
(help)))))
|
||||
# Get flags
|
||||
(while (< i len)
|
||||
(if-let [m (peg/match argpeg (args i))]
|
||||
(if (= 2 (length m))
|
||||
(let [[key value] m]
|
||||
(setdyn (keyword key) value))
|
||||
(setdyn (keyword (m 0)) true))
|
||||
(break))
|
||||
(++ i))
|
||||
|
||||
# Run subcommand
|
||||
(if (= i len)
|
||||
(help)
|
||||
(do
|
||||
(if-let [com (subcommands (args i))]
|
||||
(com ;(tuple/slice args (+ i 1)))
|
||||
(do
|
||||
(print "invalid command " (args i))
|
||||
(help))))))
|
||||
|
||||
29
jpm.1
29
jpm.1
@@ -42,6 +42,10 @@ Prevents jpm from going to network to get dependencies - all dependencies should
|
||||
Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing
|
||||
the network, for example, a build script that invokes curl will still have network access.
|
||||
|
||||
.TP
|
||||
.BR \-\-auto\-shebang
|
||||
Prepends installed scripts with a generated shebang line, such that they will use a janet binary located in JANET_BINPATH.
|
||||
|
||||
.SH OPTIONS
|
||||
|
||||
.TP
|
||||
@@ -265,5 +269,30 @@ An optional path to a git executable to use to clone git dependencies. By defaul
|
||||
if you have a normal install of git.
|
||||
.RE
|
||||
|
||||
.B JPM_OS_WHICH
|
||||
.RS
|
||||
Use this option to override the C compiler and build system auto-detection for the host operating system. For example, set this
|
||||
environment variable to "posix" to make sure that on platforms like MinGW, you will use GCC instead of MSVC. On most platforms, users will not need to
|
||||
set this environment variable. Set this to one of the following
|
||||
strings:
|
||||
.IP
|
||||
\- windows
|
||||
.IP
|
||||
\- macos
|
||||
.IP
|
||||
\- linux
|
||||
.IP
|
||||
\- freebsd
|
||||
.IP
|
||||
\- openbsd
|
||||
.IP
|
||||
\- netbsd
|
||||
.IP
|
||||
\- bsd
|
||||
.IP
|
||||
\- posix
|
||||
.RE
|
||||
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
|
||||
24
meson.build
24
meson.build
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose and contributors
|
||||
# Copyright (c) 2021 Calvin Rose and contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -19,8 +19,8 @@
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.13.1')
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.16.1')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -33,7 +33,7 @@ dl_dep = cc.find_library('dl', required : false)
|
||||
thread_dep = dependency('threads')
|
||||
|
||||
# Link options
|
||||
if build_machine.system() != 'windows'
|
||||
if get_option('default_library') != 'static' and build_machine.system() != 'windows'
|
||||
add_project_link_arguments('-rdynamic', language : 'c')
|
||||
endif
|
||||
|
||||
@@ -60,9 +60,8 @@ 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'))
|
||||
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_RECURSION_GUARD', get_option('recursion_guard'))
|
||||
@@ -135,7 +134,6 @@ core_src = [
|
||||
'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',
|
||||
@@ -173,9 +171,14 @@ janetc = custom_target('janetc',
|
||||
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
|
||||
])
|
||||
|
||||
janet_dependencies = [m_dep, dl_dep]
|
||||
if not get_option('single_threaded')
|
||||
janet_dependencies += thread_dep
|
||||
endif
|
||||
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
dependencies : janet_dependencies,
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
install : true)
|
||||
@@ -189,7 +192,7 @@ else
|
||||
endif
|
||||
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
dependencies : janet_dependencies,
|
||||
c_args : extra_cflags,
|
||||
install : true)
|
||||
|
||||
@@ -202,7 +205,7 @@ if meson.is_cross_build()
|
||||
endif
|
||||
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
dependencies : janet_dependencies,
|
||||
c_args : extra_native_cflags,
|
||||
native : true)
|
||||
else
|
||||
@@ -244,6 +247,7 @@ janet_dep = declare_dependency(include_directories : incdir,
|
||||
# pkgconfig
|
||||
pkg = import('pkgconfig')
|
||||
pkg.generate(libjanet,
|
||||
subdirs: 'janet',
|
||||
description: 'Library for the Janet programming language.')
|
||||
|
||||
# Installation
|
||||
|
||||
@@ -8,7 +8,6 @@ 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)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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 = malloc(boot_size);
|
||||
unsigned char *boot_buffer = janet_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);
|
||||
free(boot_buffer);
|
||||
janet_free(boot_buffer);
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
||||
1669
src/boot/boot.janet
1669
src/boot/boot.janet
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
||||
@@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 13
|
||||
#define JANET_VERSION_PATCH 2
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.13.2-dev"
|
||||
#define JANET_VERSION_MINOR 16
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.16.1"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -27,7 +27,6 @@
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_NET */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
/* #define JANET_NO_EV */
|
||||
/* #define JANET_NO_REALPATH */
|
||||
@@ -49,6 +48,13 @@
|
||||
/* #define JANET_ARCH_NAME pdp-8 */
|
||||
/* #define JANET_EV_EPOLL */
|
||||
|
||||
/* 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 */
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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 @@ JanetArray *janet_array(int32_t capacity) {
|
||||
Janet *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm_next_collection += capacity * sizeof(Janet);
|
||||
data = (Janet *) malloc(sizeof(Janet) * (size_t) capacity);
|
||||
data = (Janet *) 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 = malloc(sizeof(Janet) * (size_t) n);
|
||||
array->data = janet_malloc(sizeof(Janet) * (size_t) n);
|
||||
if (!array->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -68,7 +68,7 @@ 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 = realloc(old, capacity * sizeof(Janet));
|
||||
newData = janet_realloc(old, capacity * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -275,7 +275,7 @@ static Janet cfun_array_trim(int32_t argc, Janet *argv) {
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (array->count) {
|
||||
if (array->count < array->capacity) {
|
||||
Janet *newData = realloc(array->data, array->count * sizeof(Janet));
|
||||
Janet *newData = janet_realloc(array->data, array->count * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -284,12 +284,19 @@ static Janet cfun_array_trim(int32_t argc, Janet *argv) {
|
||||
}
|
||||
} else {
|
||||
array->capacity = 0;
|
||||
free(array->data);
|
||||
janet_free(array->data);
|
||||
array->data = NULL;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_clear(int32_t argc, Janet *argv) {
|
||||
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,
|
||||
@@ -370,6 +377,12 @@ static const JanetReg array_cfuns[] = {
|
||||
JDOC("(array/trim arr)\n\n"
|
||||
"Set the backing capacity of an array to its current length. Returns the modified array.")
|
||||
},
|
||||
{
|
||||
"array/clear", cfun_array_clear,
|
||||
JDOC("(array/clear arr)\n\n"
|
||||
"Empties an array, setting it's count to 0 but does not free the backing capacity. "
|
||||
"Returns the modified array.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -224,7 +224,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 = realloc(def->environments, newcap * sizeof(int32_t));
|
||||
def->environments = janet_realloc(def->environments, newcap * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -582,7 +582,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_ckeywordv("constants"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->constants_length = count;
|
||||
def->constants = malloc(sizeof(Janet) * (size_t) count);
|
||||
def->constants = janet_malloc(sizeof(Janet) * (size_t) count);
|
||||
if (NULL == def->constants) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -614,7 +614,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
newlen = def->defs_length + 1;
|
||||
if (a.defs_capacity < newlen) {
|
||||
int32_t newcap = newlen;
|
||||
def->defs = realloc(def->defs, newcap * sizeof(JanetFuncDef *));
|
||||
def->defs = janet_realloc(def->defs, newcap * sizeof(JanetFuncDef *));
|
||||
if (NULL == def->defs) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -643,7 +643,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
/* Allocate bytecode array */
|
||||
def->bytecode_length = blength;
|
||||
def->bytecode = malloc(sizeof(uint32_t) * (size_t) blength);
|
||||
def->bytecode = janet_malloc(sizeof(uint32_t) * (size_t) blength);
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -685,7 +685,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_ckeywordv("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 = malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -711,7 +711,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
|
||||
/* Set environments */
|
||||
def->environments =
|
||||
realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -992,18 +992,18 @@ static const JanetReg asm_cfuns[] = {
|
||||
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||
"typed argument. If given a field name, will only return that part of the function assembly.\n"
|
||||
"Possible fields are:\n\n"
|
||||
"\t:arity - number of required and optional arguments.\n"
|
||||
"\t:min-arity - minimum number of arguments function can be called with.\n"
|
||||
"\t:max-arity - maximum number of arguments function can be called with.\n"
|
||||
"\t:vararg - true if function can take a variable number of arguments.\n"
|
||||
"\t:bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
|
||||
"\t:source - name of source file that this function was compiled from.\n"
|
||||
"\t:name - name of function.\n"
|
||||
"\t:slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
|
||||
"\t:constants - an array of constants referenced by this function.\n"
|
||||
"\t:sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
||||
"\t:environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
||||
"\t:defs - other function definitions that this function may instantiate.\n")
|
||||
"* :arity - number of required and optional arguments.\n\n"
|
||||
"* :min-arity - minimum number of arguments function can be called with.\n\n"
|
||||
"* :max-arity - maximum number of arguments function can be called with.\n\n"
|
||||
"* :vararg - true if function can take a variable number of arguments.\n\n"
|
||||
"* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n\n"
|
||||
"* :source - name of source file that this function was compiled from.\n\n"
|
||||
"* :name - name of function.\n\n"
|
||||
"* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n\n"
|
||||
"* :constants - an array of constants referenced by this function.\n\n"
|
||||
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n\n"
|
||||
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n\n"
|
||||
"* :defs - other function definitions that this function may instantiate.\n")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,7 +33,7 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity < 4) capacity = 4;
|
||||
janet_gcpressure(capacity);
|
||||
data = malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
data = janet_malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -45,7 +45,7 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
|
||||
/* Deinitialize a buffer (free data memory) */
|
||||
void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||
free(buffer->data);
|
||||
janet_free(buffer->data);
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
@@ -62,7 +62,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 = realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
new_data = janet_realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -91,8 +91,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 * 2;
|
||||
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
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));
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -201,7 +201,7 @@ static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
if (buffer->count < buffer->capacity) {
|
||||
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
|
||||
uint8_t *newData = realloc(buffer->data, newcap);
|
||||
uint8_t *newData = janet_realloc(buffer->data, newcap);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,7 +53,9 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
void janet_signalv(JanetSignal sig, Janet message) {
|
||||
if (janet_vm_return_reg != NULL) {
|
||||
*janet_vm_return_reg = message;
|
||||
janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
|
||||
if (NULL != janet_vm_fiber) {
|
||||
janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
|
||||
}
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
_longjmp(*janet_vm_jmp_buf, sig);
|
||||
#else
|
||||
@@ -147,6 +149,23 @@ 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 *)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,36 @@ 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;
|
||||
@@ -199,24 +229,41 @@ JanetSlot janetc_resolve(
|
||||
|
||||
/* Symbol not found - check for global */
|
||||
{
|
||||
Janet check;
|
||||
JanetBindingType btype = janet_resolve(c->env, sym, &check);
|
||||
switch (btype) {
|
||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||
switch (binding.type) {
|
||||
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 */
|
||||
return janetc_cslot(check);
|
||||
ret = janetc_cslot(binding.value);
|
||||
break;
|
||||
case JANET_BINDING_VAR: {
|
||||
JanetSlot ret = janetc_cslot(check);
|
||||
/* TODO save type info */
|
||||
ret = janetc_cslot(binding.value);
|
||||
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
||||
ret.flags &= ~JANET_SLOT_CONSTANT;
|
||||
return ret;
|
||||
break;
|
||||
}
|
||||
}
|
||||
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 */
|
||||
@@ -399,6 +446,7 @@ 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;
|
||||
@@ -439,22 +487,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, got at least %d",
|
||||
fun.constant, max, min_arity);
|
||||
"%v expects at most %d argument%s, got at least %d",
|
||||
fun.constant, max, max == 1 ? "" : "s", 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, got %d",
|
||||
fun.constant, max, min_arity);
|
||||
"%v expects at most %d argument%s, got %d",
|
||||
fun.constant, max, max == 1 ? "" : "s", min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
if (min_arity < min) {
|
||||
const uint8_t *es = janet_formatc(
|
||||
"%v expects at least %d argument, got %d",
|
||||
fun.constant, min, min_arity);
|
||||
"%v expects at least %d argument%s, got %d",
|
||||
fun.constant, min, min == 1 ? "" : "s", min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
}
|
||||
@@ -504,10 +552,40 @@ 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;
|
||||
janetc_pushslots(c, slots);
|
||||
janetc_freeslots(c, slots);
|
||||
retslot = janetc_gettarget(opts);
|
||||
janetc_emit_s(c, op, retslot, 1);
|
||||
|
||||
/* 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);
|
||||
}
|
||||
|
||||
return retslot;
|
||||
}
|
||||
|
||||
@@ -601,6 +679,9 @@ static int macroexpand1(
|
||||
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);
|
||||
@@ -745,7 +826,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 = malloc(s);
|
||||
def->bytecode = janet_malloc(s);
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -753,7 +834,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 = malloc(s);
|
||||
def->sourcemap = janet_malloc(s);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -778,7 +859,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
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 = calloc(sizeof(uint32_t), slotchunks);
|
||||
uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
|
||||
if (NULL == chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -795,7 +876,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
/* Initialize a compiler */
|
||||
static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where) {
|
||||
static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where, JanetArray *lints) {
|
||||
c->scope = NULL;
|
||||
c->buffer = NULL;
|
||||
c->mapbuffer = NULL;
|
||||
@@ -804,6 +885,7 @@ 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;
|
||||
@@ -821,12 +903,13 @@ static void janetc_deinit(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
/* Compile a form. */
|
||||
JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
|
||||
JanetCompileResult janet_compile_lint(Janet source,
|
||||
JanetTable *env, const uint8_t *where, JanetArray *lints) {
|
||||
JanetCompiler c;
|
||||
JanetScope rootscope;
|
||||
JanetFopts fopts;
|
||||
|
||||
janetc_init(&c, env, where);
|
||||
janetc_init(&c, env, where, lints);
|
||||
|
||||
/* Push a function scope */
|
||||
janetc_scope(&rootscope, &c, JANET_SCOPE_FUNCTION | JANET_SCOPE_TOP, "root");
|
||||
@@ -854,26 +937,35 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
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 */
|
||||
static Janet cfun(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
janet_arity(argc, 1, 4);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
|
||||
if (NULL == env) {
|
||||
env = janet_table(0);
|
||||
janet_vm_fiber->env = env;
|
||||
}
|
||||
const uint8_t *source = NULL;
|
||||
if (argc == 3) {
|
||||
if (argc >= 3) {
|
||||
source = janet_getstring(argv, 2);
|
||||
}
|
||||
JanetCompileResult res = janet_compile(argv[0], env, source);
|
||||
JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
|
||||
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
|
||||
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));
|
||||
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.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));
|
||||
}
|
||||
if (res.macrofiber) {
|
||||
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
|
||||
}
|
||||
@@ -884,11 +976,13 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
||||
static const JanetReg compile_cfuns[] = {
|
||||
{
|
||||
"compile", cfun,
|
||||
JDOC("(compile ast &opt env source)\n\n"
|
||||
JDOC("(compile ast &opt env source lints)\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a new function and does not modify ast. Returns an error "
|
||||
"struct with keys :line, :column, and :error if compilation fails.")
|
||||
"struct with keys :line, :column, and :error if compilation fails. "
|
||||
"If a `lints` array is given, linting messages will be appended to the array. "
|
||||
"Each message will be a tuple of the form `(level line col message)`.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,6 +29,13 @@
|
||||
#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
|
||||
@@ -78,10 +85,10 @@ typedef struct JanetSpecial JanetSpecial;
|
||||
#define JANET_SLOT_MUTABLE 0x40000
|
||||
#define JANET_SLOT_REF 0x80000
|
||||
#define JANET_SLOT_RETURNED 0x100000
|
||||
/* Needed for handling single element arrays as global vars. */
|
||||
|
||||
/* Used for unquote-splicing */
|
||||
#define JANET_SLOT_SPLICED 0x200000
|
||||
#define JANET_SLOT_DEP_NOTE 0x200000
|
||||
#define JANET_SLOT_DEP_WARN 0x400000
|
||||
#define JANET_SLOT_DEP_ERROR 0x800000
|
||||
#define JANET_SLOT_SPLICED 0x1000000
|
||||
|
||||
#define JANET_SLOTTYPE_ANY 0xFFFF
|
||||
|
||||
@@ -164,6 +171,9 @@ struct JanetCompiler {
|
||||
|
||||
/* Prevent unbounded recursion */
|
||||
int recursion_guard;
|
||||
|
||||
/* Collect linting results */
|
||||
JanetArray *lints;
|
||||
};
|
||||
|
||||
#define JANET_FOPTS_TAIL 0x10000
|
||||
@@ -230,6 +240,9 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s);
|
||||
void janetc_error(JanetCompiler *c, const uint8_t *m);
|
||||
void janetc_cerror(JanetCompiler *c, const char *m);
|
||||
|
||||
/* Linting */
|
||||
void janetc_lintf(JanetCompiler *C, JanetCompileLintLevel level, const char *format, ...);
|
||||
|
||||
/* Dispatch to correct form compiler */
|
||||
JanetSlot janetc_value(JanetFopts opts, Janet x);
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -70,7 +70,7 @@ static char *get_processed_name(const char *name) {
|
||||
if (*c == '/') return (char *) name;
|
||||
}
|
||||
size_t l = (size_t)(c - name);
|
||||
char *ret = malloc(l + 3);
|
||||
char *ret = janet_malloc(l + 3);
|
||||
if (NULL == ret) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -85,7 +85,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
Clib lib = load_clib(processed_name);
|
||||
JanetModule init;
|
||||
JanetModconf getter;
|
||||
if (name != processed_name) free(processed_name);
|
||||
if (name != processed_name) janet_free(processed_name);
|
||||
if (!lib) {
|
||||
*error = janet_cstring(error_clib());
|
||||
return NULL;
|
||||
@@ -645,20 +645,21 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"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"
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
@@ -699,16 +700,16 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"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, "
|
||||
"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"
|
||||
"\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 name component of path, with extension if given\n"
|
||||
"\t:native:\tthe extension used to load natives, .so or .dll\n"
|
||||
"\t:sys:\tthe system path, or (dyn :syspath)")
|
||||
"* :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)")
|
||||
},
|
||||
{
|
||||
"int?", janet_core_check_int,
|
||||
@@ -753,7 +754,7 @@ static void janet_quick_asm(
|
||||
def->max_arity = max_arity;
|
||||
def->flags = flags;
|
||||
def->slotcount = slots;
|
||||
def->bytecode = malloc(bytecode_size);
|
||||
def->bytecode = janet_malloc(bytecode_size);
|
||||
def->bytecode_length = (int32_t)(bytecode_size / sizeof(uint32_t));
|
||||
def->name = janet_cstring(name);
|
||||
if (!def->bytecode) {
|
||||
@@ -1025,9 +1026,6 @@ 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
|
||||
@@ -1205,7 +1203,8 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"if native modules are compatible with the host program."));
|
||||
|
||||
/* Allow references to the environment */
|
||||
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
||||
janet_def(env, "root-env", janet_wrap_table(env),
|
||||
JDOC("The root environment used to create environments with (make-env)."));
|
||||
|
||||
janet_load_libs(env);
|
||||
janet_gcroot(janet_wrap_table(env));
|
||||
@@ -1220,22 +1219,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
return janet_vm_core_env;
|
||||
}
|
||||
|
||||
/* Load core cfunctions (and some built in janet assembly functions) */
|
||||
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);
|
||||
if (janet_checktype(kv.value, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, kv.value, kv.key);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
JanetTable *dict = janet_core_lookup_table(replacements);
|
||||
|
||||
/* Unmarshal bytecode */
|
||||
Janet marsh_out = janet_unmarshal(
|
||||
@@ -1269,3 +1253,23 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
}
|
||||
|
||||
#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);
|
||||
if (janet_checktype(kv.value, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, kv.value, kv.key);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return dict;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -102,7 +102,9 @@ 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 = 0;
|
||||
|
||||
/* Don't print error line if it is nil. */
|
||||
int wrote_error = janet_checktype(err, JANET_NIL);
|
||||
|
||||
int print_color = janet_truthy(janet_dyn("err-color"));
|
||||
if (print_color) janet_eprintf("\x1b[31m");
|
||||
@@ -299,9 +301,10 @@ static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
janet_stacktrace(fiber, argv[1]);
|
||||
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
|
||||
janet_stacktrace(fiber, x);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -325,12 +328,12 @@ static Janet cfun_debug_step(int32_t argc, Janet *argv) {
|
||||
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. "
|
||||
JDOC("(debug/break source line col)\n\n"
|
||||
"Sets a breakpoint in `source` at a given line and column. "
|
||||
"Will throw an error if the breakpoint location "
|
||||
"cannot be found. For example\n\n"
|
||||
"\t(debug/break \"core.janet\" 1000)\n\n"
|
||||
"wil set a breakpoint at the 1000th byte of the file core.janet.")
|
||||
"\t(debug/break \"core.janet\" 10 4)\n\n"
|
||||
"wil set a breakpoint at line 10, 4th column of the file core.janet.")
|
||||
},
|
||||
{
|
||||
"debug/unbreak", cfun_debug_unbreak,
|
||||
@@ -362,25 +365,25 @@ static const JanetReg debug_cfuns[] = {
|
||||
"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 "
|
||||
"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")
|
||||
"* :c - true if the stack frame is a c function invocation\n\n"
|
||||
"* :column - the current source column of the stack frame\n\n"
|
||||
"* :function - the function that the stack frame represents\n\n"
|
||||
"* :line - the current source line of the stack frame\n\n"
|
||||
"* :name - the human-friendly name of the function\n\n"
|
||||
"* :pc - integer indicating the location of the program counter\n\n"
|
||||
"* :source - string with the file path or other identifier for the source code\n\n"
|
||||
"* :slots - array of all values in each slot\n\n"
|
||||
"* :tail - boolean indicating a tail call")
|
||||
},
|
||||
{
|
||||
"debug/stacktrace", cfun_debug_stacktrace,
|
||||
JDOC("(debug/stacktrace fiber 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.")
|
||||
JDOC("(debug/stacktrace fiber &opt err)\n\n"
|
||||
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
|
||||
"an error value to print the stack trace with. If `err` is nil or not "
|
||||
"provided, will skipp the error line. Returns the fiber.")
|
||||
},
|
||||
{
|
||||
"debug/lineage", cfun_debug_lineage,
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
||||
437
src/core/ev.c
437
src/core/ev.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -63,6 +63,23 @@ typedef struct {
|
||||
void *data;
|
||||
} JanetQueue;
|
||||
|
||||
typedef struct {
|
||||
JanetFiber *fiber;
|
||||
uint32_t sched_id;
|
||||
enum {
|
||||
JANET_CP_MODE_ITEM,
|
||||
JANET_CP_MODE_CHOICE_READ,
|
||||
JANET_CP_MODE_CHOICE_WRITE
|
||||
} mode;
|
||||
} JanetChannelPending;
|
||||
|
||||
typedef struct {
|
||||
JanetQueue items;
|
||||
JanetQueue read_pending;
|
||||
JanetQueue write_pending;
|
||||
int32_t limit;
|
||||
} JanetChannel;
|
||||
|
||||
#define JANET_MAX_Q_CAPACITY 0x7FFFFFF
|
||||
|
||||
static void janet_q_init(JanetQueue *q) {
|
||||
@@ -73,7 +90,7 @@ static void janet_q_init(JanetQueue *q) {
|
||||
}
|
||||
|
||||
static void janet_q_deinit(JanetQueue *q) {
|
||||
free(q->data);
|
||||
janet_free(q->data);
|
||||
}
|
||||
|
||||
static int32_t janet_q_count(JanetQueue *q) {
|
||||
@@ -89,7 +106,7 @@ static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) {
|
||||
if (count + 1 >= JANET_MAX_Q_CAPACITY) return 1;
|
||||
int32_t newcap = (count + 2) * 2;
|
||||
if (newcap > JANET_MAX_Q_CAPACITY) newcap = JANET_MAX_Q_CAPACITY;
|
||||
q->data = realloc(q->data, itemsize * newcap);
|
||||
q->data = janet_realloc(q->data, itemsize * newcap);
|
||||
if (NULL == q->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -196,7 +213,7 @@ static void add_timeout(JanetTimeout to) {
|
||||
size_t newcount = oldcount + 1;
|
||||
if (newcount > janet_vm_tq_capacity) {
|
||||
size_t newcap = 2 * newcount;
|
||||
JanetTimeout *tq = realloc(janet_vm_tq, newcap * sizeof(JanetTimeout));
|
||||
JanetTimeout *tq = janet_realloc(janet_vm_tq, newcap * sizeof(JanetTimeout));
|
||||
if (NULL == tq) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -230,7 +247,7 @@ static JanetListenerState *janet_listen_impl(JanetStream *stream, JanetListener
|
||||
}
|
||||
if (size < sizeof(JanetListenerState))
|
||||
size = sizeof(JanetListenerState);
|
||||
JanetListenerState *state = malloc(size);
|
||||
JanetListenerState *state = janet_malloc(size);
|
||||
if (NULL == state) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -247,7 +264,7 @@ static JanetListenerState *janet_listen_impl(JanetStream *stream, JanetListener
|
||||
int resize = janet_vm_listener_cap == janet_vm_listener_count;
|
||||
if (resize) {
|
||||
size_t newcap = janet_vm_listener_count ? janet_vm_listener_cap * 2 : 16;
|
||||
janet_vm_listeners = realloc(janet_vm_listeners, newcap * sizeof(JanetListenerState *));
|
||||
janet_vm_listeners = janet_realloc(janet_vm_listeners, newcap * sizeof(JanetListenerState *));
|
||||
if (NULL == janet_vm_listeners) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -284,7 +301,7 @@ static void janet_unlisten_impl(JanetListenerState *state) {
|
||||
size_t index = state->_index;
|
||||
janet_vm_listeners[index] = janet_vm_listeners[--janet_vm_listener_count];
|
||||
janet_vm_listeners[index]->_index = index;
|
||||
free(state);
|
||||
janet_free(state);
|
||||
}
|
||||
|
||||
static const JanetMethod ev_default_stream_methods[] = {
|
||||
@@ -304,21 +321,6 @@ JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod
|
||||
stream->_mask = 0;
|
||||
if (methods == NULL) methods = ev_default_stream_methods;
|
||||
stream->methods = methods;
|
||||
#ifdef JANET_NET
|
||||
if (flags & JANET_STREAM_SOCKET) {
|
||||
#ifdef JANET_WINDOWS
|
||||
u_long iMode = 0;
|
||||
ioctlsocket((SOCKET) handle, FIONBIO, &iMode);
|
||||
#else
|
||||
#if !defined(SOCK_CLOEXEC) && defined(O_CLOEXEC)
|
||||
int extra = O_CLOEXEC;
|
||||
#else
|
||||
int extra = 0;
|
||||
#endif
|
||||
fcntl(handle, F_SETFL, fcntl(handle, F_GETFL, 0) | O_NONBLOCK | extra);
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
return stream;
|
||||
}
|
||||
|
||||
@@ -376,7 +378,6 @@ static int janet_stream_getter(void *p, Janet key, Janet *out) {
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
const JanetMethod *stream_methods = stream->methods;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), stream_methods, out);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
@@ -392,7 +393,20 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
* while in transit, and it's value gets reused. DuplicateHandle does not work
|
||||
* for network sockets, and in general for winsock it is better to nipt duplicate
|
||||
* unless there is a need to. */
|
||||
janet_marshal_int64(ctx, (int64_t)(s->handle));
|
||||
HANDLE duph = INVALID_HANDLE_VALUE;
|
||||
if (s->flags & JANET_STREAM_SOCKET) {
|
||||
duph = s->handle;
|
||||
} else {
|
||||
DuplicateHandle(
|
||||
GetCurrentProcess(),
|
||||
s->handle,
|
||||
GetCurrentProcess(),
|
||||
&duph,
|
||||
0,
|
||||
FALSE,
|
||||
DUPLICATE_SAME_ACCESS);
|
||||
}
|
||||
janet_marshal_int64(ctx, (int64_t)(duph));
|
||||
#else
|
||||
/* Marshal after dup becuse it is easier than maintaining our own ref counting. */
|
||||
int duph = dup(s->handle);
|
||||
@@ -419,6 +433,10 @@ static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
|
||||
return p;
|
||||
}
|
||||
|
||||
static Janet janet_stream_next(void *p, Janet key) {
|
||||
JanetStream *stream = (JanetStream *)p;
|
||||
return janet_nextmethod(stream->methods, key);
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_stream_type = {
|
||||
"core/stream",
|
||||
@@ -428,7 +446,11 @@ const JanetAbstractType janet_stream_type = {
|
||||
NULL,
|
||||
janet_stream_marshal,
|
||||
janet_stream_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
janet_stream_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
/* Register a fiber to resume with value */
|
||||
@@ -496,13 +518,27 @@ void janet_ev_mark(void) {
|
||||
}
|
||||
}
|
||||
|
||||
static int janet_channel_push(JanetChannel *channel, Janet x, int mode);
|
||||
|
||||
static Janet make_supervisor_event(const char *name, JanetFiber *fiber) {
|
||||
Janet tup[2];
|
||||
tup[0] = janet_ckeywordv(name);
|
||||
tup[1] = janet_wrap_fiber(fiber);
|
||||
return janet_wrap_tuple(janet_tuple_n(tup, 2));
|
||||
}
|
||||
|
||||
/* Run a top level task */
|
||||
static void run_one(JanetFiber *fiber, Janet value, JanetSignal sigin) {
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_SCHEDULED;
|
||||
Janet res;
|
||||
JanetSignal sig = janet_continue_signal(fiber, value, &res, sigin);
|
||||
if (sig != JANET_SIGNAL_OK && sig != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(fiber, res);
|
||||
JanetChannel *chan = (JanetChannel *)(fiber->supervisor_channel);
|
||||
if (NULL == chan) {
|
||||
if (sig != JANET_SIGNAL_EVENT && sig != JANET_SIGNAL_YIELD) {
|
||||
janet_stacktrace(fiber, res);
|
||||
}
|
||||
} else if (sig == JANET_SIGNAL_OK || (fiber->flags & (1 << sig))) {
|
||||
janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig], fiber), 2);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -521,8 +557,8 @@ void janet_ev_init_common(void) {
|
||||
/* Common deinit code */
|
||||
void janet_ev_deinit_common(void) {
|
||||
janet_q_deinit(&janet_vm_spawn);
|
||||
free(janet_vm_tq);
|
||||
free(janet_vm_listeners);
|
||||
janet_free(janet_vm_tq);
|
||||
janet_free(janet_vm_listeners);
|
||||
janet_vm_listeners = NULL;
|
||||
}
|
||||
|
||||
@@ -553,23 +589,6 @@ void janet_ev_dec_refcount(void) {
|
||||
|
||||
/* Channels */
|
||||
|
||||
typedef struct {
|
||||
JanetFiber *fiber;
|
||||
uint32_t sched_id;
|
||||
enum {
|
||||
JANET_CP_MODE_ITEM,
|
||||
JANET_CP_MODE_CHOICE_READ,
|
||||
JANET_CP_MODE_CHOICE_WRITE
|
||||
} mode;
|
||||
} JanetChannelPending;
|
||||
|
||||
typedef struct {
|
||||
JanetQueue items;
|
||||
JanetQueue read_pending;
|
||||
JanetQueue write_pending;
|
||||
int32_t limit;
|
||||
} JanetChannel;
|
||||
|
||||
#define JANET_MAX_CHANNEL_CAPACITY 0xFFFFFF
|
||||
|
||||
static void janet_chan_init(JanetChannel *chan, int32_t limit) {
|
||||
@@ -589,16 +608,24 @@ static void janet_chan_deinit(JanetChannel *chan) {
|
||||
* Janet Channel abstract type
|
||||
*/
|
||||
|
||||
/*static int janet_chanat_get(void *p, Janet key, Janet *out);*/
|
||||
static int janet_chanat_mark(void *p, size_t s);
|
||||
static int janet_chanat_gc(void *p, size_t s);
|
||||
static Janet janet_chanat_next(void *p, Janet key);
|
||||
static int janet_chanat_get(void *p, Janet key, Janet *out);
|
||||
|
||||
static const JanetAbstractType ChannelAT = {
|
||||
"core/channel",
|
||||
janet_chanat_gc,
|
||||
janet_chanat_mark,
|
||||
NULL, /* janet_chanat_get */
|
||||
JANET_ATEND_GET
|
||||
janet_chanat_get,
|
||||
NULL, /* put */
|
||||
NULL, /* marshal */
|
||||
NULL, /* unmarshal */
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
janet_chanat_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
static int janet_chanat_gc(void *p, size_t s) {
|
||||
@@ -657,7 +684,7 @@ static Janet make_read_result(JanetChannel *channel, Janet x) {
|
||||
|
||||
/* Push a value to a channel, and return 1 if channel should block, zero otherwise.
|
||||
* If the push would block, will add to the write_pending queue in the channel. */
|
||||
static int janet_channel_push(JanetChannel *channel, Janet x, int is_choice) {
|
||||
static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
|
||||
JanetChannelPending reader;
|
||||
int is_empty;
|
||||
do {
|
||||
@@ -668,11 +695,13 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int is_choice) {
|
||||
if (janet_q_push(&channel->items, &x, sizeof(Janet))) {
|
||||
janet_panicf("channel overflow: %v", x);
|
||||
} else if (janet_q_count(&channel->items) > channel->limit) {
|
||||
/* No root fiber, we are in completion on a root fiber. Don't block. */
|
||||
if (mode == 2) return 0;
|
||||
/* Pushed successfully, but should block. */
|
||||
JanetChannelPending pending;
|
||||
pending.fiber = janet_vm_root_fiber,
|
||||
pending.sched_id = janet_vm_root_fiber->sched_id,
|
||||
pending.mode = is_choice ? JANET_CP_MODE_CHOICE_WRITE : JANET_CP_MODE_ITEM;
|
||||
pending.mode = mode ? JANET_CP_MODE_CHOICE_WRITE : JANET_CP_MODE_ITEM;
|
||||
janet_q_push(&channel->write_pending, &pending, sizeof(pending));
|
||||
return 1;
|
||||
}
|
||||
@@ -816,6 +845,28 @@ static Janet cfun_channel_new(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(channel);
|
||||
}
|
||||
|
||||
static const JanetMethod ev_chanat_methods[] = {
|
||||
{"select", cfun_channel_choice},
|
||||
{"rselect", cfun_channel_rchoice},
|
||||
{"count", cfun_channel_count},
|
||||
{"take", cfun_channel_pop},
|
||||
{"give", cfun_channel_push},
|
||||
{"capacity", cfun_channel_capacity},
|
||||
{"full", cfun_channel_full},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int janet_chanat_get(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), ev_chanat_methods, out);
|
||||
}
|
||||
|
||||
static Janet janet_chanat_next(void *p, Janet key) {
|
||||
(void) p;
|
||||
return janet_nextmethod(ev_chanat_methods, key);
|
||||
}
|
||||
|
||||
/* Main event loop */
|
||||
|
||||
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout);
|
||||
@@ -910,7 +961,7 @@ typedef struct {
|
||||
static JANET_THREAD_LOCAL JanetHandle janet_vm_selfpipe[2];
|
||||
|
||||
static void janet_ev_setup_selfpipe(void) {
|
||||
if (janet_make_pipe(janet_vm_selfpipe)) {
|
||||
if (janet_make_pipe(janet_vm_selfpipe, 0)) {
|
||||
JANET_EXIT("failed to initialize self pipe in event loop");
|
||||
}
|
||||
}
|
||||
@@ -955,7 +1006,7 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
|
||||
JanetListenerState *state = janet_listen_impl(stream, behavior, mask, size, user);
|
||||
if (!(stream->flags & JANET_STREAM_IOCP)) {
|
||||
if (NULL == CreateIoCompletionPort(stream->handle, janet_vm_iocp, (ULONG_PTR) stream, 0)) {
|
||||
janet_panic("failed to listen for events");
|
||||
janet_panicf("failed to listen for events: %V", janet_ev_lasterr());
|
||||
}
|
||||
stream->flags |= JANET_STREAM_IOCP;
|
||||
}
|
||||
@@ -970,7 +1021,7 @@ static void janet_unlisten(JanetListenerState *state) {
|
||||
void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
|
||||
ULONG_PTR completionKey = 0;
|
||||
DWORD num_bytes_transfered = 0;
|
||||
LPOVERLAPPED overlapped;
|
||||
LPOVERLAPPED overlapped = NULL;
|
||||
|
||||
/* Calculate how long to wait before timeout */
|
||||
uint64_t waittime;
|
||||
@@ -986,31 +1037,29 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
|
||||
}
|
||||
BOOL result = GetQueuedCompletionStatus(janet_vm_iocp, &num_bytes_transfered, &completionKey, &overlapped, (DWORD) waittime);
|
||||
|
||||
if (!result) {
|
||||
if (!has_timeout) {
|
||||
/* queue emptied */
|
||||
}
|
||||
} else if (0 == completionKey) {
|
||||
/* Custom event */
|
||||
JanetSelfPipeEvent *response = (JanetSelfPipeEvent *)(overlapped);
|
||||
response->cb(response->msg);
|
||||
free(response);
|
||||
janet_ev_dec_refcount();
|
||||
} else {
|
||||
/* Normal event */
|
||||
JanetStream *stream = (JanetStream *) completionKey;
|
||||
JanetListenerState *state = stream->state;
|
||||
while (state != NULL) {
|
||||
if (state->tag == overlapped) {
|
||||
state->event = overlapped;
|
||||
state->bytes = num_bytes_transfered;
|
||||
JanetAsyncStatus status = state->machine(state, JANET_ASYNC_EVENT_COMPLETE);
|
||||
if (status == JANET_ASYNC_STATUS_DONE) {
|
||||
janet_unlisten(state);
|
||||
if (result || overlapped) {
|
||||
if (0 == completionKey) {
|
||||
/* Custom event */
|
||||
JanetSelfPipeEvent *response = (JanetSelfPipeEvent *)(overlapped);
|
||||
response->cb(response->msg);
|
||||
janet_free(response);
|
||||
janet_ev_dec_refcount();
|
||||
} else {
|
||||
/* Normal event */
|
||||
JanetStream *stream = (JanetStream *) completionKey;
|
||||
JanetListenerState *state = stream->state;
|
||||
while (state != NULL) {
|
||||
if (state->tag == overlapped) {
|
||||
state->event = overlapped;
|
||||
state->bytes = num_bytes_transfered;
|
||||
JanetAsyncStatus status = state->machine(state, JANET_ASYNC_EVENT_COMPLETE);
|
||||
if (status == JANET_ASYNC_STATUS_DONE) {
|
||||
janet_unlisten(state);
|
||||
}
|
||||
break;
|
||||
} else {
|
||||
state = state->_next;
|
||||
}
|
||||
break;
|
||||
} else {
|
||||
state = state->_next;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1031,7 +1080,7 @@ static JanetTimestamp ts_now(void) {
|
||||
}
|
||||
|
||||
static int make_epoll_events(int mask) {
|
||||
int events = EPOLLET;
|
||||
int events = 0;
|
||||
if (mask & JANET_ASYNC_LISTEN_READ)
|
||||
events |= EPOLLIN;
|
||||
if (mask & JANET_ASYNC_LISTEN_WRITE)
|
||||
@@ -1127,7 +1176,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
|
||||
if (mask & EPOLLERR)
|
||||
status3 = state->machine(state, JANET_ASYNC_EVENT_ERR);
|
||||
if (mask & EPOLLHUP)
|
||||
if ((mask & EPOLLHUP) && !(mask & (EPOLLOUT | EPOLLIN)))
|
||||
status4 = state->machine(state, JANET_ASYNC_EVENT_HUP);
|
||||
if (status1 == JANET_ASYNC_STATUS_DONE ||
|
||||
status2 == JANET_ASYNC_STATUS_DONE ||
|
||||
@@ -1200,7 +1249,7 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
|
||||
JanetListenerState *state = janet_listen_impl(stream, behavior, mask, size, user);
|
||||
size_t newsize = janet_vm_listener_cap;
|
||||
if (newsize > oldsize) {
|
||||
janet_vm_fds = realloc(janet_vm_fds, (newsize + 1) * sizeof(struct pollfd));
|
||||
janet_vm_fds = janet_realloc(janet_vm_fds, (newsize + 1) * sizeof(struct pollfd));
|
||||
if (NULL == janet_vm_fds) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1256,9 +1305,9 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
if (mask & POLLIN)
|
||||
status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
|
||||
if (mask & POLLERR)
|
||||
status2 = state->machine(state, JANET_ASYNC_EVENT_ERR);
|
||||
if (mask & POLLHUP)
|
||||
status2 = state->machine(state, JANET_ASYNC_EVENT_HUP);
|
||||
status3 = state->machine(state, JANET_ASYNC_EVENT_ERR);
|
||||
if ((mask & POLLHUP) && !(mask & (POLLIN | POLLOUT)))
|
||||
status4 = state->machine(state, JANET_ASYNC_EVENT_HUP);
|
||||
if (status1 == JANET_ASYNC_STATUS_DONE ||
|
||||
status2 == JANET_ASYNC_STATUS_DONE ||
|
||||
status3 == JANET_ASYNC_STATUS_DONE ||
|
||||
@@ -1271,7 +1320,7 @@ void janet_ev_init(void) {
|
||||
janet_ev_init_common();
|
||||
janet_vm_fds = NULL;
|
||||
janet_ev_setup_selfpipe();
|
||||
janet_vm_fds = malloc(sizeof(struct pollfd));
|
||||
janet_vm_fds = janet_malloc(sizeof(struct pollfd));
|
||||
if (NULL == janet_vm_fds) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1284,7 +1333,7 @@ void janet_ev_init(void) {
|
||||
void janet_ev_deinit(void) {
|
||||
janet_ev_deinit_common();
|
||||
janet_ev_cleanup_selfpipe();
|
||||
free(janet_vm_fds);
|
||||
janet_free(janet_vm_fds);
|
||||
janet_vm_fds = NULL;
|
||||
}
|
||||
|
||||
@@ -1322,7 +1371,7 @@ static void *janet_thread_body(void *ptr) {
|
||||
JanetThreadedSubroutine subr = init->subr;
|
||||
JanetThreadedCallback cb = init->cb;
|
||||
int fd = init->write_pipe;
|
||||
free(init);
|
||||
janet_free(init);
|
||||
JanetSelfPipeEvent response;
|
||||
response.msg = subr(msg);
|
||||
response.cb = cb;
|
||||
@@ -1342,7 +1391,7 @@ static void *janet_thread_body(void *ptr) {
|
||||
#endif
|
||||
|
||||
void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb) {
|
||||
JanetEVThreadInit *init = malloc(sizeof(JanetEVThreadInit));
|
||||
JanetEVThreadInit *init = janet_malloc(sizeof(JanetEVThreadInit));
|
||||
if (NULL == init) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1354,7 +1403,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
|
||||
init->write_pipe = janet_vm_iocp;
|
||||
HANDLE thread_handle = CreateThread(NULL, 0, janet_thread_body, init, 0, NULL);
|
||||
if (NULL == thread_handle) {
|
||||
free(init);
|
||||
janet_free(init);
|
||||
janet_panic("failed to create thread");
|
||||
}
|
||||
CloseHandle(thread_handle); /* detach from thread */
|
||||
@@ -1363,7 +1412,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
|
||||
pthread_t waiter_thread;
|
||||
int err = pthread_create(&waiter_thread, NULL, janet_thread_body, init);
|
||||
if (err) {
|
||||
free(init);
|
||||
janet_free(init);
|
||||
janet_panicf("%s", strerror(err));
|
||||
}
|
||||
pthread_detach(waiter_thread);
|
||||
@@ -1386,7 +1435,7 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
|
||||
case JANET_EV_TCTAG_STRING:
|
||||
case JANET_EV_TCTAG_STRINGF:
|
||||
janet_schedule(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) free(return_value.argp);
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
|
||||
break;
|
||||
case JANET_EV_TCTAG_KEYWORD:
|
||||
janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
||||
@@ -1394,17 +1443,21 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
|
||||
case JANET_EV_TCTAG_ERR_STRING:
|
||||
case JANET_EV_TCTAG_ERR_STRINGF:
|
||||
janet_cancel(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) free(return_value.argp);
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
|
||||
break;
|
||||
case JANET_EV_TCTAG_ERR_KEYWORD:
|
||||
janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
||||
break;
|
||||
case JANET_EV_TCTAG_BOOLEAN:
|
||||
janet_schedule(return_value.fiber, janet_wrap_boolean(return_value.argi));
|
||||
break;
|
||||
}
|
||||
janet_gcunroot(janet_wrap_fiber(return_value.fiber));
|
||||
}
|
||||
|
||||
|
||||
/* Convenience method for common case */
|
||||
JANET_NO_RETURN
|
||||
void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp) {
|
||||
JanetEVGenericMessage arguments;
|
||||
arguments.tag = tag;
|
||||
@@ -1507,7 +1560,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
janet_mark(janet_wrap_buffer(state->buf));
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_cancel(s->fiber, janet_cstringv("stream closed"));
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
#ifdef JANET_WINDOWS
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
@@ -1545,16 +1598,11 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
memset(&(state->overlapped), 0, sizeof(OVERLAPPED));
|
||||
int status;
|
||||
#ifdef JANET_NET
|
||||
if (state->mode != JANET_ASYNC_READMODE_READ) {
|
||||
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
|
||||
state->wbuf.len = (ULONG) chunk_size;
|
||||
state->wbuf.buf = state->chunk_buf;
|
||||
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
|
||||
status = WSARecvFrom((SOCKET) s->stream->handle, &state->wbuf, 1,
|
||||
NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped, NULL);
|
||||
} else {
|
||||
status = WSARecv((SOCKET) s->stream->handle, &state->wbuf, 1,
|
||||
NULL, &state->flags, &state->overlapped, NULL);
|
||||
}
|
||||
status = WSARecvFrom((SOCKET) s->stream->handle, &state->wbuf, 1,
|
||||
NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped, NULL);
|
||||
if (status && (WSA_IO_PENDING != WSAGetLastError())) {
|
||||
janet_cancel(s->fiber, janet_ev_lasterr());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
@@ -1565,7 +1613,11 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
status = ReadFile(s->stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped);
|
||||
if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
|
||||
if (WSAGetLastError() == ERROR_BROKEN_PIPE) {
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
if (state->bytes_read) {
|
||||
janet_schedule(s->fiber, janet_wrap_buffer(state->buf));
|
||||
} else {
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
}
|
||||
} else {
|
||||
janet_cancel(s->fiber, janet_ev_lasterr());
|
||||
}
|
||||
@@ -1575,8 +1627,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
}
|
||||
break;
|
||||
#else
|
||||
case JANET_ASYNC_EVENT_ERR:
|
||||
case JANET_ASYNC_EVENT_HUP: {
|
||||
case JANET_ASYNC_EVENT_ERR: {
|
||||
if (state->bytes_read) {
|
||||
janet_schedule(s->fiber, janet_wrap_buffer(state->buf));
|
||||
} else {
|
||||
@@ -1584,10 +1635,11 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
}
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_HUP:
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
JanetBuffer *buffer = state->buf;
|
||||
int32_t bytes_left = state->bytes_left;
|
||||
int32_t read_limit = bytes_left < 0 ? 4096 : bytes_left;
|
||||
int32_t read_limit = bytes_left > 4096 ? 4096 : bytes_left;
|
||||
janet_buffer_extra(buffer, read_limit);
|
||||
ssize_t nread;
|
||||
#ifdef JANET_NET
|
||||
@@ -1772,17 +1824,13 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event)
|
||||
|
||||
int status;
|
||||
#ifdef JANET_NET
|
||||
if (state->mode != JANET_ASYNC_WRITEMODE_WRITE) {
|
||||
if (state->mode == JANET_ASYNC_WRITEMODE_SENDTO) {
|
||||
SOCKET sock = (SOCKET) s->stream->handle;
|
||||
state->wbuf.buf = (char *) bytes;
|
||||
state->wbuf.len = len;
|
||||
if (state->mode == JANET_ASYNC_WRITEMODE_SENDTO) {
|
||||
const struct sockaddr *to = state->dest_abst;
|
||||
int tolen = (int) janet_abstract_size((void *) to);
|
||||
status = WSASendTo(sock, &state->wbuf, 1, NULL, state->flags, to, tolen, &state->overlapped, NULL);
|
||||
} else {
|
||||
status = WSASend(sock, &state->wbuf, 1, NULL, state->flags, &state->overlapped, NULL);
|
||||
}
|
||||
const struct sockaddr *to = state->dest_abst;
|
||||
int tolen = (int) janet_abstract_size((void *) to);
|
||||
status = WSASendTo(sock, &state->wbuf, 1, NULL, state->flags, to, tolen, &state->overlapped, NULL);
|
||||
if (status && (WSA_IO_PENDING != WSAGetLastError())) {
|
||||
janet_cancel(s->fiber, janet_ev_lasterr());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
@@ -1915,44 +1963,65 @@ void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, in
|
||||
static volatile long PipeSerialNumber;
|
||||
#endif
|
||||
|
||||
int janet_make_pipe(JanetHandle handles[2]) {
|
||||
int janet_make_pipe(JanetHandle handles[2], int mode) {
|
||||
#ifdef JANET_WINDOWS
|
||||
/*
|
||||
* On windows, the built in CreatePipe function doesn't support overlapped IO
|
||||
* so we lift from the windows source code and modify for our own version.
|
||||
*
|
||||
* mode = 0: both sides non-blocking.
|
||||
* mode = 1: only read side non-blocking: write side sent to subprocess
|
||||
* mode = 2: only write side non-blocking: read side sent to subprocess
|
||||
*/
|
||||
JanetHandle rhandle, whandle;
|
||||
JanetHandle shandle, chandle;
|
||||
UCHAR PipeNameBuffer[MAX_PATH];
|
||||
SECURITY_ATTRIBUTES saAttr;
|
||||
memset(&saAttr, 0, sizeof(saAttr));
|
||||
saAttr.nLength = sizeof(saAttr);
|
||||
saAttr.bInheritHandle = TRUE;
|
||||
sprintf(PipeNameBuffer,
|
||||
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
|
||||
GetCurrentProcessId(),
|
||||
InterlockedIncrement(&PipeSerialNumber));
|
||||
rhandle = CreateNamedPipeA(
|
||||
|
||||
/* server handle goes to subprocess */
|
||||
shandle = CreateNamedPipeA(
|
||||
PipeNameBuffer,
|
||||
PIPE_ACCESS_INBOUND | FILE_FLAG_OVERLAPPED,
|
||||
PIPE_TYPE_BYTE | PIPE_NOWAIT,
|
||||
1, /* Number of pipes */
|
||||
(mode == 2 ? PIPE_ACCESS_INBOUND : PIPE_ACCESS_OUTBOUND) | FILE_FLAG_OVERLAPPED,
|
||||
PIPE_TYPE_BYTE | PIPE_WAIT,
|
||||
255, /* Max number of pipes for duplication. */
|
||||
4096, /* Out buffer size */
|
||||
4096, /* In buffer size */
|
||||
120 * 1000, /* Timeout in ms */
|
||||
NULL);
|
||||
if (!rhandle) return -1;
|
||||
whandle = CreateFileA(
|
||||
&saAttr);
|
||||
if (shandle == INVALID_HANDLE_VALUE) {
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* we keep client handle */
|
||||
chandle = CreateFileA(
|
||||
PipeNameBuffer,
|
||||
GENERIC_WRITE,
|
||||
(mode == 2 ? GENERIC_WRITE : GENERIC_READ),
|
||||
0,
|
||||
NULL,
|
||||
&saAttr,
|
||||
OPEN_EXISTING,
|
||||
FILE_ATTRIBUTE_NORMAL | FILE_FLAG_OVERLAPPED,
|
||||
NULL);
|
||||
if (whandle == INVALID_HANDLE_VALUE) {
|
||||
CloseHandle(rhandle);
|
||||
|
||||
if (chandle == INVALID_HANDLE_VALUE) {
|
||||
CloseHandle(shandle);
|
||||
return -1;
|
||||
}
|
||||
handles[0] = rhandle;
|
||||
handles[1] = whandle;
|
||||
if (mode == 2) {
|
||||
handles[0] = shandle;
|
||||
handles[1] = chandle;
|
||||
} else {
|
||||
handles[0] = chandle;
|
||||
handles[1] = shandle;
|
||||
}
|
||||
return 0;
|
||||
#else
|
||||
(void) mode;
|
||||
if (pipe(handles)) return -1;
|
||||
if (fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
|
||||
if (fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
|
||||
@@ -1967,22 +2036,83 @@ error:
|
||||
/* C functions */
|
||||
|
||||
static Janet cfun_ev_go(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet value = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
JanetChannel *supervisor_channel = janet_optabstract(argv, argc, 2, &ChannelAT,
|
||||
janet_vm_root_fiber->supervisor_channel);
|
||||
fiber->supervisor_channel = supervisor_channel;
|
||||
janet_schedule(fiber, value);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_ev_call(int32_t argc, Janet *argv) {
|
||||
/* For ev/thread - Run an interpreter in the new thread. */
|
||||
static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
JanetBuffer *buffer = (JanetBuffer *) args.argp;
|
||||
const uint8_t *nextbytes = buffer->data;
|
||||
const uint8_t *endbytes = nextbytes + buffer->count;
|
||||
janet_init();
|
||||
JanetTryState tstate;
|
||||
JanetSignal signal = janet_try(&tstate);
|
||||
if (!signal) {
|
||||
Janet aregv = janet_unmarshal(nextbytes, endbytes - nextbytes,
|
||||
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
|
||||
if (!janet_checktype(aregv, JANET_TABLE)) janet_panic("expected table for abstract registry");
|
||||
janet_vm_abstract_registry = janet_unwrap_table(aregv);
|
||||
Janet regv = janet_unmarshal(nextbytes, endbytes - nextbytes,
|
||||
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
|
||||
if (!janet_checktype(regv, JANET_TABLE)) janet_panic("expected table for cfunction registry");
|
||||
janet_vm_registry = janet_unwrap_table(regv);
|
||||
Janet fiberv = janet_unmarshal(nextbytes, endbytes - nextbytes,
|
||||
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
|
||||
Janet value = janet_unmarshal(nextbytes, endbytes - nextbytes,
|
||||
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
|
||||
if (!janet_checktype(fiberv, JANET_FIBER)) janet_panic("expected fiber");
|
||||
JanetFiber *fiber = janet_unwrap_fiber(fiberv);
|
||||
janet_schedule(fiber, value);
|
||||
janet_loop();
|
||||
args.tag = JANET_EV_TCTAG_NIL;
|
||||
} else {
|
||||
if (janet_checktype(tstate.payload, JANET_STRING)) {
|
||||
args.tag = JANET_EV_TCTAG_ERR_STRINGF;
|
||||
args.argp = strdup((const char *) janet_unwrap_string(tstate.payload));
|
||||
} else {
|
||||
args.tag = JANET_EV_TCTAG_ERR_STRING;
|
||||
args.argp = "failed to start thread";
|
||||
}
|
||||
}
|
||||
janet_buffer_deinit(buffer);
|
||||
janet_restore(&tstate);
|
||||
janet_deinit();
|
||||
return args;
|
||||
}
|
||||
|
||||
static Janet cfun_ev_thread(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
janet_getfiber(argv, 0);
|
||||
Janet value = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
/* Marshal arguments for the new thread. */
|
||||
JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
|
||||
if (NULL == buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_buffer_init(buffer, 0);
|
||||
janet_marshal(buffer, janet_wrap_table(janet_vm_abstract_registry), NULL, JANET_MARSHAL_UNSAFE);
|
||||
janet_marshal(buffer, janet_wrap_table(janet_vm_registry), NULL, JANET_MARSHAL_UNSAFE);
|
||||
janet_marshal(buffer, argv[0], NULL, JANET_MARSHAL_UNSAFE);
|
||||
janet_marshal(buffer, value, NULL, JANET_MARSHAL_UNSAFE);
|
||||
janet_ev_threaded_await(janet_go_thread_subr, 0, argc, buffer);
|
||||
}
|
||||
|
||||
static Janet cfun_ev_give_supervisor(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetFunction *fn = janet_getfunction(argv, 0);
|
||||
JanetFiber *fiber = janet_fiber(fn, 64, argc - 1, argv + 1);
|
||||
if (NULL == fiber) janet_panicf("invalid arity to function %v", argv[0]);
|
||||
fiber->env = janet_table(0);
|
||||
fiber->env->proto = janet_current_fiber()->env;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
return janet_wrap_fiber(fiber);
|
||||
JanetChannel *chan = janet_vm_root_fiber->supervisor_channel;
|
||||
if (NULL != chan) {
|
||||
if (janet_channel_push(chan, janet_wrap_tuple(janet_tuple_n(argv, argc)), 0)) {
|
||||
janet_await();
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_NO_RETURN void janet_sleep_await(double sec) {
|
||||
@@ -2040,7 +2170,7 @@ Janet janet_cfun_stream_read(int32_t argc, Janet *argv) {
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (janet_keyeq(argv[1], "all")) {
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_readchunk(stream, buffer, -1);
|
||||
janet_ev_readchunk(stream, buffer, INT32_MAX);
|
||||
} else {
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
@@ -2079,16 +2209,28 @@ Janet janet_cfun_stream_write(int32_t argc, Janet *argv) {
|
||||
|
||||
static const JanetReg ev_cfuns[] = {
|
||||
{
|
||||
"ev/call", cfun_ev_call,
|
||||
JDOC("(ev/call fn & args)\n\n"
|
||||
"Call a function asynchronously. Returns a fiber that is scheduled to "
|
||||
"run the function.")
|
||||
"ev/go", cfun_ev_go,
|
||||
JDOC("(ev/go fiber &opt value supervisor)\n\n"
|
||||
"Put a fiber on the event loop to be resumed later. Optionally pass "
|
||||
"a value to resume with, otherwise resumes with nil. Returns the fiber. "
|
||||
"An optional `core/channel` can be provided as well as a supervisor. When various "
|
||||
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
|
||||
"If not provided, the new fiber will inherit the current supervisor.")
|
||||
},
|
||||
{
|
||||
"ev/go", cfun_ev_go,
|
||||
JDOC("(ev/go fiber &opt value)\n\n"
|
||||
"Put a fiber on the event loop to be resumed later. Optionally pass "
|
||||
"a value to resume with, otherwise resumes with nil.")
|
||||
"ev/thread", cfun_ev_thread,
|
||||
JDOC("(ev/thread fiber &opt value flags)\n\n"
|
||||
"Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` "
|
||||
"to resume with. "
|
||||
"Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. "
|
||||
"The the final result.")
|
||||
},
|
||||
{
|
||||
"ev/give-supervisor", cfun_ev_give_supervisor,
|
||||
JDOC("(ev/give-supervsior tag & payload)\n\n"
|
||||
"Send a message to the current supervior channel if there is one. The message will be a "
|
||||
"tuple of all of the arguments combined into a single message, where the first element is tag. "
|
||||
"By convention, tag should be a keyword indicating the type of message. Returns nil.")
|
||||
},
|
||||
{
|
||||
"ev/sleep", cfun_ev_sleep,
|
||||
@@ -2150,7 +2292,7 @@ static const JanetReg ev_cfuns[] = {
|
||||
{
|
||||
"ev/rselect", cfun_channel_rchoice,
|
||||
JDOC("(ev/rselect & clauses)\n\n"
|
||||
"Similar to ev/choice, but will try clauses in a random order for fairness.")
|
||||
"Similar to ev/select, but will try clauses in a random order for fairness.")
|
||||
},
|
||||
{
|
||||
"ev/close", janet_cfun_stream_close,
|
||||
@@ -2185,6 +2327,7 @@ static const JanetReg ev_cfuns[] = {
|
||||
|
||||
void janet_lib_ev(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, ev_cfuns);
|
||||
janet_register_abstract_type(&janet_stream_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,9 +37,11 @@ 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);
|
||||
}
|
||||
@@ -51,7 +53,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
|
||||
capacity = 32;
|
||||
}
|
||||
fiber->capacity = capacity;
|
||||
data = malloc(sizeof(Janet) * (size_t) capacity);
|
||||
data = janet_malloc(sizeof(Janet) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -83,6 +85,7 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->supervisor_channel = NULL;
|
||||
#endif
|
||||
return fiber;
|
||||
}
|
||||
@@ -97,12 +100,12 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
|
||||
static void janet_fiber_refresh_memory(JanetFiber *fiber) {
|
||||
int32_t n = fiber->capacity;
|
||||
if (n) {
|
||||
Janet *newData = malloc(sizeof(Janet) * n);
|
||||
Janet *newData = janet_malloc(sizeof(Janet) * n);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
|
||||
free(fiber->data);
|
||||
janet_free(fiber->data);
|
||||
fiber->data = newData;
|
||||
}
|
||||
}
|
||||
@@ -112,7 +115,7 @@ static void janet_fiber_refresh_memory(JanetFiber *fiber) {
|
||||
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||
int32_t old_size = fiber->capacity;
|
||||
int32_t diff = n - old_size;
|
||||
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
||||
Janet *newData = janet_realloc(fiber->data, sizeof(Janet) * n);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -251,7 +254,7 @@ static void janet_env_detach(JanetFuncEnv *env) {
|
||||
janet_env_valid(env);
|
||||
int32_t len = env->length;
|
||||
size_t s = sizeof(Janet) * (size_t) len;
|
||||
Janet *vmem = malloc(s);
|
||||
Janet *vmem = janet_malloc(s);
|
||||
janet_vm_next_collection += (uint32_t) s;
|
||||
if (NULL == vmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -586,6 +589,12 @@ static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_boolean(!isFinished);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_last_value(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return fiber->last_value;
|
||||
}
|
||||
|
||||
static const JanetReg fiber_cfuns[] = {
|
||||
{
|
||||
"fiber/new", cfun_fiber_new,
|
||||
@@ -593,34 +602,37 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"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"
|
||||
"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"
|
||||
"\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"
|
||||
"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"
|
||||
"\ti - inherit the environment from the current fiber\n"
|
||||
"\tp - the environment table's prototype is the current environment table")
|
||||
"* :i - inherit the environment from the current fiber\n"
|
||||
"* :p - the environment table's prototype is the current environment table")
|
||||
},
|
||||
{
|
||||
"fiber/status", cfun_fiber_status,
|
||||
JDOC("(fiber/status fib)\n\n"
|
||||
"Get the status of a fiber. The status will be one of:\n\n"
|
||||
"\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")
|
||||
"* :dead - the fiber has finished\n"
|
||||
"* :error - the fiber has errored out\n"
|
||||
"* :debug - the fiber is suspended in debug mode\n"
|
||||
"* :pending - the fiber has been yielded\n"
|
||||
"* :user(0-9) - the fiber is suspended by a user signal\n"
|
||||
"* :alive - the fiber is currently running and cannot be resumed\n"
|
||||
"* :new - the fiber has just been created and not yet run")
|
||||
},
|
||||
{
|
||||
"fiber/root", cfun_fiber_root,
|
||||
@@ -663,6 +675,11 @@ static const JanetReg fiber_cfuns[] = {
|
||||
JDOC("(fiber/can-resume? fiber)\n\n"
|
||||
"Check if a fiber is finished and cannot be resumed.")
|
||||
},
|
||||
{
|
||||
"fiber/last-value", cfun_fiber_last_value,
|
||||
JDOC("(fiber/last-value\n\n"
|
||||
"Get the last value returned or signaled from the fiber.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -244,6 +244,8 @@ 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);
|
||||
@@ -265,6 +267,12 @@ 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;
|
||||
@@ -282,13 +290,13 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_ARRAY:
|
||||
free(((JanetArray *) mem)->data);
|
||||
janet_free(((JanetArray *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_TABLE:
|
||||
free(((JanetTable *) mem)->data);
|
||||
janet_free(((JanetTable *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_FIBER:
|
||||
free(((JanetFiber *)mem)->data);
|
||||
janet_free(((JanetFiber *)mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_BUFFER:
|
||||
janet_buffer_deinit((JanetBuffer *) mem);
|
||||
@@ -303,18 +311,18 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
case JANET_MEMORY_FUNCENV: {
|
||||
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
||||
if (0 == env->offset)
|
||||
free(env->as.values);
|
||||
janet_free(env->as.values);
|
||||
}
|
||||
break;
|
||||
case JANET_MEMORY_FUNCDEF: {
|
||||
JanetFuncDef *def = (JanetFuncDef *)mem;
|
||||
/* TODO - get this all with one alloc and one free */
|
||||
free(def->defs);
|
||||
free(def->environments);
|
||||
free(def->constants);
|
||||
free(def->bytecode);
|
||||
free(def->sourcemap);
|
||||
free(def->closure_bitset);
|
||||
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);
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -339,7 +347,7 @@ void janet_sweep() {
|
||||
} else {
|
||||
janet_vm_blocks = next;
|
||||
}
|
||||
free(current);
|
||||
janet_free(current);
|
||||
}
|
||||
current = next;
|
||||
}
|
||||
@@ -351,7 +359,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
|
||||
/* Make sure everything is inited */
|
||||
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
||||
mem = malloc(size);
|
||||
mem = janet_malloc(size);
|
||||
|
||||
/* Check for bad malloc */
|
||||
if (NULL == mem) {
|
||||
@@ -374,7 +382,7 @@ static void free_one_scratch(JanetScratch *s) {
|
||||
if (NULL != s->finalize) {
|
||||
s->finalize((char *) s->mem);
|
||||
}
|
||||
free(s);
|
||||
janet_free(s);
|
||||
}
|
||||
|
||||
/* Free all allocated scratch memory */
|
||||
@@ -426,7 +434,7 @@ void janet_gcroot(Janet root) {
|
||||
size_t newcount = janet_vm_root_count + 1;
|
||||
if (newcount > janet_vm_root_capacity) {
|
||||
size_t newcap = 2 * newcount;
|
||||
janet_vm_roots = realloc(janet_vm_roots, sizeof(Janet) * newcap);
|
||||
janet_vm_roots = janet_realloc(janet_vm_roots, sizeof(Janet) * newcap);
|
||||
if (NULL == janet_vm_roots) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -486,12 +494,12 @@ void janet_clear_memory(void) {
|
||||
while (NULL != current) {
|
||||
janet_deinit_block(current);
|
||||
JanetGCObject *next = current->next;
|
||||
free(current);
|
||||
janet_free(current);
|
||||
current = next;
|
||||
}
|
||||
janet_vm_blocks = NULL;
|
||||
janet_free_all_scratch();
|
||||
free(janet_scratch_mem);
|
||||
janet_free(janet_scratch_mem);
|
||||
}
|
||||
|
||||
/* Primitives for suspending GC. */
|
||||
@@ -505,14 +513,14 @@ void janet_gcunlock(int handle) {
|
||||
/* Scratch memory API */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
JanetScratch *s = malloc(sizeof(JanetScratch) + size);
|
||||
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);
|
||||
if (NULL == s) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
s->finalize = NULL;
|
||||
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));
|
||||
JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -539,7 +547,7 @@ void *janet_srealloc(void *mem, size_t size) {
|
||||
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));
|
||||
JanetScratch *news = janet_realloc(s, size + sizeof(JanetScratch));
|
||||
if (NULL == news) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose & contributors
|
||||
* Copyright (c) 2021 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
|
||||
@@ -39,6 +39,8 @@
|
||||
|
||||
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;
|
||||
@@ -92,7 +94,8 @@ const JanetAbstractType janet_s64_type = {
|
||||
it_s64_tostring,
|
||||
janet_int64_compare,
|
||||
janet_int64_hash,
|
||||
JANET_ATEND_HASH
|
||||
janet_int64_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
const JanetAbstractType janet_u64_type = {
|
||||
@@ -106,7 +109,8 @@ const JanetAbstractType janet_u64_type = {
|
||||
it_u64_tostring,
|
||||
janet_uint64_compare,
|
||||
janet_int64_hash,
|
||||
JANET_ATEND_HASH
|
||||
janet_uint64_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
int64_t janet_unwrap_s64(Janet x) {
|
||||
@@ -134,7 +138,7 @@ int64_t janet_unwrap_s64(Janet x) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
janet_panic("bad s64 initializer");
|
||||
janet_panicf("bad s64 initializer: %t", x);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -144,7 +148,9 @@ uint64_t janet_unwrap_u64(Janet x) {
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL))
|
||||
/* Allow negative values to be cast to "wrap around".
|
||||
* This let's addition and subtraction work as expected. */
|
||||
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||
return (uint64_t)dbl;
|
||||
break;
|
||||
}
|
||||
@@ -163,7 +169,7 @@ uint64_t janet_unwrap_u64(Janet x) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
janet_panic("bad u64 initializer");
|
||||
janet_panicf("bad u64 initializer: %t", x);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -197,15 +203,14 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
|
||||
}
|
||||
|
||||
// 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.
|
||||
//
|
||||
/*
|
||||
* 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);
|
||||
}
|
||||
@@ -242,7 +247,6 @@ static int compare_uint64_double(uint64_t x, double y) {
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64)
|
||||
@@ -383,31 +387,14 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
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;
|
||||
if (x < 0) {
|
||||
x = (op1 < 0) ? x - op1 : x + op1;
|
||||
}
|
||||
*box = x;
|
||||
*box = (op1 > 0)
|
||||
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
@@ -418,7 +405,6 @@ 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, ^)
|
||||
@@ -431,7 +417,6 @@ 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, ^)
|
||||
@@ -454,9 +439,9 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"/", cfun_it_s64_div},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"mod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"rmod", cfun_it_s64_mod},
|
||||
{"%", cfun_it_s64_rem},
|
||||
{"r%", cfun_it_s64_remi},
|
||||
{"r%", cfun_it_s64_rem},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"r&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
@@ -480,9 +465,9 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"mod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"rmod", cfun_it_u64_mod},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"r%", cfun_it_u64_mod},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
@@ -496,6 +481,16 @@ static JanetMethod it_u64_methods[] = {
|
||||
{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))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,6 +39,7 @@ 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",
|
||||
@@ -48,7 +49,11 @@ const JanetAbstractType janet_file_type = {
|
||||
NULL,
|
||||
io_file_marshal,
|
||||
io_file_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
io_file_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
/* Check arguments to fopen */
|
||||
@@ -259,20 +264,29 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
#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))) {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
if (file->flags & JANET_FILE_PIPED) {
|
||||
ret = pclose(file->file);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
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;
|
||||
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
/* We can't panic inside a gc, so just ignore bad statuses here */
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
pclose(iof->file);
|
||||
#endif
|
||||
} else {
|
||||
fclose(iof->file);
|
||||
}
|
||||
}
|
||||
janet_file_close(iof);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -346,6 +360,11 @@ 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) {
|
||||
@@ -525,7 +544,7 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
/* Clear buffer to make things easier for GC */
|
||||
buf->count = 0;
|
||||
buf->capacity = 0;
|
||||
free(buf->data);
|
||||
janet_free(buf->data);
|
||||
buf->data = NULL;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
@@ -713,23 +732,24 @@ static const JanetReg io_cfuns[] = {
|
||||
{
|
||||
"file/temp", cfun_io_temp,
|
||||
JDOC("(file/temp)\n\n"
|
||||
"Open an anonymous temporary file that is removed on close."
|
||||
"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 "
|
||||
"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\n"
|
||||
"\tn - error if the file cannot be opened instead of returning nil")
|
||||
"* r - allow reading from the file\n\n"
|
||||
"* w - allow writing to the file\n\n"
|
||||
"* a - append to the file\n\n"
|
||||
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
|
||||
"* b - open the file in binary mode (rather than text mode)\n\n"
|
||||
"* + - append to the file instead of overwriting it\n\n"
|
||||
"* n - error if the file cannot be opened instead of returning nil")
|
||||
},
|
||||
{
|
||||
"file/close", cfun_io_fclose,
|
||||
@@ -742,14 +762,14 @@ static const JanetReg io_cfuns[] = {
|
||||
{
|
||||
"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 "
|
||||
"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"
|
||||
"\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")
|
||||
"Values for `what`:\n\n"
|
||||
"* :all - read the whole file\n\n"
|
||||
"* :line - read up to and including the next newline character\n\n"
|
||||
"* n (integer) - read up to n bytes from the file")
|
||||
},
|
||||
{
|
||||
"file/write", cfun_io_fwrite,
|
||||
@@ -766,13 +786,13 @@ static const JanetReg io_cfuns[] = {
|
||||
{
|
||||
"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.")
|
||||
"Jump to a relative location in the file `f`. `whence` must be one of:\n\n"
|
||||
"* :cur - jump relative to the current file location\n\n"
|
||||
"* :set - jump relative to the beginning of the file\n\n"
|
||||
"* :end - jump relative to the end of the file\n\n"
|
||||
"By default, `whence` is :cur. Optionally a value `n` may be passed "
|
||||
"for the relative number of bytes to seek in the file. `n` may be a real "
|
||||
"number to handle large files of more than 4GB. Returns the file handle.")
|
||||
},
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -738,7 +738,7 @@ static const uint8_t *unmarshal_one_env(
|
||||
if (length == 0) {
|
||||
janet_panic("invalid funcenv length");
|
||||
}
|
||||
env->as.values = malloc(sizeof(Janet) * (size_t) length);
|
||||
env->as.values = janet_malloc(sizeof(Janet) * (size_t) length);
|
||||
if (!env->as.values) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -834,7 +834,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal constants */
|
||||
if (constants_length) {
|
||||
def->constants = malloc(sizeof(Janet) * constants_length);
|
||||
def->constants = janet_malloc(sizeof(Janet) * constants_length);
|
||||
if (!def->constants) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -846,7 +846,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->constants_length = constants_length;
|
||||
|
||||
/* Unmarshal bytecode */
|
||||
def->bytecode = malloc(sizeof(uint32_t) * bytecode_length);
|
||||
def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
|
||||
if (!def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -855,7 +855,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal environments */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
|
||||
def->environments = calloc(1, sizeof(int32_t) * (size_t) environments_length);
|
||||
def->environments = janet_calloc(1, sizeof(int32_t) * (size_t) environments_length);
|
||||
if (!def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -869,7 +869,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal sub funcdefs */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
|
||||
def->defs = calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
|
||||
def->defs = janet_calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
|
||||
if (!def->defs) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -884,7 +884,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 = malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
|
||||
def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
|
||||
if (!def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -900,7 +900,7 @@ 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 = malloc(sizeof(uint32_t) * (size_t) n);
|
||||
def->closure_bitset = janet_malloc(sizeof(uint32_t) * (size_t) n);
|
||||
if (NULL == def->closure_bitset) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -938,6 +938,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
fiber->supervisor_channel = NULL;
|
||||
#endif
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
@@ -960,7 +961,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
|
||||
/* Allocate stack memory */
|
||||
fiber->capacity = fiber_stacktop + 10;
|
||||
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
|
||||
fiber->data = janet_malloc(sizeof(Janet) * fiber->capacity);
|
||||
if (!fiber->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1427,9 +1428,9 @@ static const JanetReg marsh_cfuns[] = {
|
||||
"marshal", cfun_marshal,
|
||||
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
|
||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"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"
|
||||
"aliased values that are found in the table. Then a forward "
|
||||
"lookup table can be used to recover the original value when "
|
||||
"unmarshalling.")
|
||||
},
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,6 +31,7 @@
|
||||
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,7 +61,11 @@ const JanetAbstractType janet_rng_type = {
|
||||
NULL,
|
||||
janet_rng_marshal,
|
||||
janet_rng_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
janet_rng_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
JanetRNG *janet_default_rng(void) {
|
||||
@@ -203,6 +208,11 @@ 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 */
|
||||
static Janet janet_rand(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
@@ -500,13 +510,13 @@ void janet_lib_math(JanetTable *env) {
|
||||
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
|
||||
JDOC("The number representing negative infinity"));
|
||||
janet_def(env, "math/int32-min", janet_wrap_number(INT32_MIN),
|
||||
JDOC("The maximum contiguous integer representable by a 32 bit signed integer"));
|
||||
JDOC("The minimum contiguous integer representable by a 32 bit signed integer"));
|
||||
janet_def(env, "math/int32-max", janet_wrap_number(INT32_MAX),
|
||||
JDOC("The minimum contiguous integer represtenable by a 32 bit signed integer"));
|
||||
JDOC("The maximum contiguous integer represtenable by a 32 bit signed integer"));
|
||||
janet_def(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
|
||||
JDOC("The maximum contiguous integer representable by a double (2^53)"));
|
||||
JDOC("The minimum contiguous integer representable by a double (2^53)"));
|
||||
janet_def(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
|
||||
JDOC("The minimum contiguous integer represtenable by a double (-(2^53))"));
|
||||
JDOC("The maximum contiguous integer represtenable by a double (-(2^53))"));
|
||||
#ifdef NAN
|
||||
janet_def(env, "math/nan", janet_wrap_number(NAN),
|
||||
#else
|
||||
|
||||
130
src/core/net.c
130
src/core/net.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -80,15 +80,22 @@ static JanetStream *make_stream(JSock handle, uint32_t flags);
|
||||
#define MSG_NOSIGNAL 0
|
||||
#endif
|
||||
|
||||
static void nosigpipe(JSock s) {
|
||||
/* 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;
|
||||
if (setsockopt(s, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int)) < 0) {
|
||||
JSOCKCLOSE(s);
|
||||
janet_panic("setsockopt(SO_NOSIGPIPE) failed");
|
||||
}
|
||||
#else
|
||||
(void) s;
|
||||
setsockopt(s, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int));
|
||||
#endif
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -139,6 +146,7 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
||||
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;
|
||||
@@ -210,11 +218,12 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
JSock connfd = accept(s->stream->handle, NULL, NULL);
|
||||
if (JSOCKVALID(connfd)) {
|
||||
nosigpipe(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);
|
||||
@@ -256,20 +265,20 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
|
||||
#ifndef JANET_WINDOWS
|
||||
if (janet_keyeq(argv[offset], "unix")) {
|
||||
const char *path = janet_getcstring(argv, offset + 1);
|
||||
struct sockaddr_un *saddr = malloc(sizeof(struct sockaddr_un));
|
||||
struct sockaddr_un *saddr = janet_calloc(1, sizeof(struct sockaddr_un));
|
||||
if (saddr == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
saddr->sun_family = AF_UNIX;
|
||||
memset(&saddr->sun_path, 0, 108);
|
||||
size_t path_size = sizeof(saddr->sun_path);
|
||||
#ifdef JANET_LINUX
|
||||
if (path[0] == '@') {
|
||||
saddr->sun_path[0] = '\0';
|
||||
snprintf(saddr->sun_path + 1, 107, "%s", path + 1);
|
||||
snprintf(saddr->sun_path + 1, path_size - 1, "%s", path + 1);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
snprintf(saddr->sun_path, 108, "%s", path);
|
||||
snprintf(saddr->sun_path, path_size, "%s", path);
|
||||
}
|
||||
*is_unix = 1;
|
||||
return (struct addrinfo *) saddr;
|
||||
@@ -351,12 +360,12 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
/* Create socket */
|
||||
JSock sock = JSOCKDEFAULT;
|
||||
void *addr = NULL;
|
||||
socklen_t addrlen;
|
||||
socklen_t addrlen = 0;
|
||||
#ifndef JANET_WINDOWS
|
||||
if (is_unix) {
|
||||
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||
if (!JSOCKVALID(sock)) {
|
||||
janet_panic("could not create socket");
|
||||
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
addr = (void *) ai;
|
||||
addrlen = sizeof(struct sockaddr_un);
|
||||
@@ -378,24 +387,30 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
}
|
||||
if (NULL == addr) {
|
||||
freeaddrinfo(ai);
|
||||
janet_panic("could not create socket");
|
||||
janet_panicf("could not create socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
}
|
||||
|
||||
/* Connect to socket */
|
||||
#ifdef JANET_WINDOWS
|
||||
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
|
||||
freeaddrinfo(ai);
|
||||
#else
|
||||
int status = connect(sock, addr, addrlen);
|
||||
if (is_unix) {
|
||||
free(ai);
|
||||
janet_free(ai);
|
||||
} else {
|
||||
freeaddrinfo(ai);
|
||||
}
|
||||
#endif
|
||||
|
||||
if (status == -1) {
|
||||
JSOCKCLOSE(sock);
|
||||
janet_panic("could not connect to socket");
|
||||
janet_panicf("could not connect to socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
|
||||
nosigpipe(sock);
|
||||
/* 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);
|
||||
@@ -413,9 +428,51 @@ static const char *serverify_socket(JSock sfd) {
|
||||
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
|
||||
|
||||
static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
|
||||
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];
|
||||
}
|
||||
|
||||
static Janet cfun_net_listen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
|
||||
@@ -429,16 +486,20 @@ static Janet cfun_net_listen(int32_t argc, Janet *argv) {
|
||||
if (is_unix) {
|
||||
sfd = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
|
||||
if (!JSOCKVALID(sfd)) {
|
||||
free(ai);
|
||||
janet_panic("could not create socket");
|
||||
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);
|
||||
free(ai);
|
||||
janet_panic(err ? err : "could not bind socket");
|
||||
janet_free(ai);
|
||||
if (err) {
|
||||
janet_panic(err);
|
||||
} else {
|
||||
janet_panicf("could not bind socket: %V", janet_ev_lasterr());
|
||||
}
|
||||
}
|
||||
free(ai);
|
||||
janet_free(ai);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
@@ -466,8 +527,6 @@ static Janet cfun_net_listen(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
nosigpipe(sfd);
|
||||
|
||||
if (socktype == SOCK_DGRAM) {
|
||||
/* Datagram server (UDP) */
|
||||
JanetStream *stream = make_stream(sfd, JANET_STREAM_UDPSERVER | JANET_STREAM_READABLE);
|
||||
@@ -479,7 +538,7 @@ static Janet cfun_net_listen(int32_t argc, Janet *argv) {
|
||||
int status = listen(sfd, 1024);
|
||||
if (status) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("could not listen on file descriptor");
|
||||
janet_panicf("could not listen on file descriptor: %V", janet_ev_lasterr());
|
||||
}
|
||||
|
||||
/* Put sfd on our loop */
|
||||
@@ -513,7 +572,7 @@ static Janet cfun_stream_read(int32_t argc, Janet *argv) {
|
||||
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, -1, MSG_NOSIGNAL);
|
||||
janet_ev_recvchunk(stream, buffer, INT32_MAX, MSG_NOSIGNAL);
|
||||
} else {
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
@@ -580,7 +639,7 @@ static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_stream_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
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 */
|
||||
@@ -605,6 +664,7 @@ static const JanetMethod net_stream_methods[] = {
|
||||
{"evread", janet_cfun_stream_read},
|
||||
{"evchunk", janet_cfun_stream_chunk},
|
||||
{"evwrite", janet_cfun_stream_write},
|
||||
{"shutdown", cfun_net_shutdown},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -641,7 +701,7 @@ static const JanetReg net_cfuns[] = {
|
||||
{
|
||||
"net/accept-loop", cfun_stream_accept_loop,
|
||||
JDOC("(net/accept-loop stream handler)\n\n"
|
||||
"Shorthand for running a server stream that will continuously accept new connections."
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
@@ -692,6 +752,16 @@ static const JanetReg net_cfuns[] = {
|
||||
"that can be used to communicate with the server. Type is an optional keyword "
|
||||
"to specify a connection type, either :stream or :datagram. The default is :stream. ")
|
||||
},
|
||||
{
|
||||
"net/shutdown", cfun_net_shutdown,
|
||||
JDOC("(net/shutdown stream &opt mode)\n\n"
|
||||
"Stop communication on this socket in a graceful manner, either in both directions or just "
|
||||
"reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
|
||||
"\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
|
||||
"* `:r` disables reading new data from the socket.\n"
|
||||
"* `:w` disable writing data to the socket.\n\n"
|
||||
"Returns the original socket.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
381
src/core/os.c
381
src/core/os.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -56,7 +56,12 @@
|
||||
#include <dirent.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/wait.h>
|
||||
#ifdef JANET_APPLE
|
||||
#include <crt_externs.h>
|
||||
#define environ (*_NSGetEnviron())
|
||||
#else
|
||||
extern char **environ;
|
||||
#endif
|
||||
#ifdef JANET_THREADS
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
@@ -187,49 +192,71 @@ static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
|
||||
/* Get env for os_execute */
|
||||
static char **os_execute_env(int32_t argc, const Janet *argv) {
|
||||
char **envp = NULL;
|
||||
if (argc > 2) {
|
||||
JanetDictView dict = janet_getdictionary(argv, 2);
|
||||
envp = janet_smalloc(sizeof(char *) * ((size_t)dict.len + 1));
|
||||
int32_t j = 0;
|
||||
for (int32_t i = 0; i < dict.cap; i++) {
|
||||
const JanetKV *kv = dict.kvs + i;
|
||||
if (!janet_checktype(kv->key, JANET_STRING)) continue;
|
||||
if (!janet_checktype(kv->value, JANET_STRING)) continue;
|
||||
const uint8_t *keys = janet_unwrap_string(kv->key);
|
||||
const uint8_t *vals = janet_unwrap_string(kv->value);
|
||||
int32_t klen = janet_string_length(keys);
|
||||
int32_t vlen = janet_string_length(vals);
|
||||
/* Check keys has no embedded 0s or =s. */
|
||||
int skip = 0;
|
||||
for (int32_t k = 0; k < klen; k++) {
|
||||
if (keys[k] == '\0' || keys[k] == '=') {
|
||||
skip = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (skip) continue;
|
||||
char *envitem = janet_smalloc((size_t) klen + (size_t) vlen + 2);
|
||||
memcpy(envitem, keys, klen);
|
||||
envitem[klen] = '=';
|
||||
memcpy(envitem + klen + 1, vals, vlen);
|
||||
envitem[klen + vlen + 1] = 0;
|
||||
envp[j++] = envitem;
|
||||
}
|
||||
envp[j] = NULL;
|
||||
#ifdef JANET_WINDOWS
|
||||
typedef char *EnvBlock;
|
||||
#else
|
||||
typedef char **EnvBlock;
|
||||
#endif
|
||||
|
||||
/* Get env for os_execute */
|
||||
static EnvBlock os_execute_env(int32_t argc, const Janet *argv) {
|
||||
if (argc <= 2) return NULL;
|
||||
JanetDictView dict = janet_getdictionary(argv, 2);
|
||||
#ifdef JANET_WINDOWS
|
||||
JanetBuffer *temp = janet_buffer(10);
|
||||
for (int32_t i = 0; i < dict.cap; i++) {
|
||||
const JanetKV *kv = dict.kvs + i;
|
||||
if (!janet_checktype(kv->key, JANET_STRING)) continue;
|
||||
if (!janet_checktype(kv->value, JANET_STRING)) continue;
|
||||
const uint8_t *keys = janet_unwrap_string(kv->key);
|
||||
const uint8_t *vals = janet_unwrap_string(kv->value);
|
||||
janet_buffer_push_bytes(temp, keys, janet_string_length(keys));
|
||||
janet_buffer_push_u8(temp, '=');
|
||||
janet_buffer_push_bytes(temp, vals, janet_string_length(vals));
|
||||
janet_buffer_push_u8(temp, '\0');
|
||||
}
|
||||
janet_buffer_push_u8(temp, '\0');
|
||||
char *ret = janet_smalloc(temp->count);
|
||||
memcpy(ret, temp->data, temp->count);
|
||||
return ret;
|
||||
#else
|
||||
char **envp = janet_smalloc(sizeof(char *) * ((size_t)dict.len + 1));
|
||||
int32_t j = 0;
|
||||
for (int32_t i = 0; i < dict.cap; i++) {
|
||||
const JanetKV *kv = dict.kvs + i;
|
||||
if (!janet_checktype(kv->key, JANET_STRING)) continue;
|
||||
if (!janet_checktype(kv->value, JANET_STRING)) continue;
|
||||
const uint8_t *keys = janet_unwrap_string(kv->key);
|
||||
const uint8_t *vals = janet_unwrap_string(kv->value);
|
||||
int32_t klen = janet_string_length(keys);
|
||||
int32_t vlen = janet_string_length(vals);
|
||||
/* Check keys has no embedded 0s or =s. */
|
||||
int skip = 0;
|
||||
for (int32_t k = 0; k < klen; k++) {
|
||||
if (keys[k] == '\0' || keys[k] == '=') {
|
||||
skip = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (skip) continue;
|
||||
char *envitem = janet_smalloc((size_t) klen + (size_t) vlen + 2);
|
||||
memcpy(envitem, keys, klen);
|
||||
envitem[klen] = '=';
|
||||
memcpy(envitem + klen + 1, vals, vlen);
|
||||
envitem[klen + vlen + 1] = 0;
|
||||
envp[j++] = envitem;
|
||||
}
|
||||
envp[j] = NULL;
|
||||
return envp;
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Free memory from os_execute. Not actually needed, but doesn't pressure the GC
|
||||
in the happy path. */
|
||||
static void os_execute_cleanup(char **envp, const char **child_argv) {
|
||||
static void os_execute_cleanup(EnvBlock envp, const char **child_argv) {
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) child_argv;
|
||||
if (NULL != envp) janet_sfree(envp);
|
||||
#else
|
||||
janet_sfree((void *)child_argv);
|
||||
#endif
|
||||
if (NULL != envp) {
|
||||
char **envitem = envp;
|
||||
while (*envitem != NULL) {
|
||||
@@ -238,6 +265,7 @@ static void os_execute_cleanup(char **envp, const char **child_argv) {
|
||||
}
|
||||
}
|
||||
janet_sfree(envp);
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -322,6 +350,9 @@ static const JanetAbstractType ProcAT;
|
||||
#define JANET_PROC_WAITED 2
|
||||
#define JANET_PROC_WAITING 4
|
||||
#define JANET_PROC_ERROR_NONZERO 8
|
||||
#define JANET_PROC_OWNS_STDIN 16
|
||||
#define JANET_PROC_OWNS_STDOUT 32
|
||||
#define JANET_PROC_OWNS_STDERR 64
|
||||
typedef struct {
|
||||
int flags;
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -427,9 +458,11 @@ static int janet_proc_mark(void *p, size_t s) {
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
JANET_NO_RETURN
|
||||
static JANET_NO_RETURN void
|
||||
#else
|
||||
static Janet
|
||||
#endif
|
||||
static Janet os_proc_wait_impl(JanetProc *proc) {
|
||||
os_proc_wait_impl(JanetProc *proc) {
|
||||
if (proc->flags & (JANET_PROC_WAITED | JANET_PROC_WAITING)) {
|
||||
janet_panicf("cannot wait twice on a process");
|
||||
}
|
||||
@@ -467,7 +500,12 @@ static Janet os_proc_wait_impl(JanetProc *proc) {
|
||||
static Janet os_proc_wait(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_proc_kill(int32_t argc, Janet *argv) {
|
||||
@@ -491,12 +529,41 @@ static Janet os_proc_kill(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
/* After killing process we wait on it. */
|
||||
if (argc > 1 && janet_truthy(argv[1])) {
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
} else {
|
||||
return argv[0];
|
||||
}
|
||||
}
|
||||
|
||||
static Janet os_proc_close(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
if (proc->flags & JANET_PROC_OWNS_STDIN) janet_stream_close(proc->in);
|
||||
if (proc->flags & JANET_PROC_OWNS_STDOUT) janet_stream_close(proc->out);
|
||||
if (proc->flags & JANET_PROC_OWNS_STDERR) janet_stream_close(proc->err);
|
||||
#else
|
||||
if (proc->flags & JANET_PROC_OWNS_STDIN) janet_file_close(proc->in);
|
||||
if (proc->flags & JANET_PROC_OWNS_STDOUT) janet_file_close(proc->out);
|
||||
if (proc->flags & JANET_PROC_OWNS_STDERR) janet_file_close(proc->err);
|
||||
#endif
|
||||
proc->flags &= ~(JANET_PROC_OWNS_STDIN | JANET_PROC_OWNS_STDOUT | JANET_PROC_OWNS_STDERR);
|
||||
if (proc->flags & (JANET_PROC_WAITED | JANET_PROC_WAITING)) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
}
|
||||
|
||||
static void swap_handles(JanetHandle *handles) {
|
||||
JanetHandle temp = handles[0];
|
||||
handles[0] = handles[1];
|
||||
@@ -514,10 +581,24 @@ static void close_handle(JanetHandle handle) {
|
||||
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
|
||||
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
|
||||
up by the calling function. If everything goes well, *handle is owned by the calling function,
|
||||
(if it is set) and the returned JanetFile owns the other end of the pipe, which will be closed
|
||||
(if it is set) and the returned handle owns the other end of the pipe, which will be closed
|
||||
on GC or fclose. */
|
||||
static JanetHandle make_pipes(JanetHandle *handle, int reverse, int *errflag) {
|
||||
JanetHandle handles[2];
|
||||
#ifdef JANET_EV
|
||||
|
||||
/* non-blocking pipes */
|
||||
if (janet_make_pipe(handles, reverse ? 2 : 1)) goto error;
|
||||
if (reverse) swap_handles(handles);
|
||||
#ifdef JANET_WINDOWS
|
||||
if (!SetHandleInformation(handles[0], HANDLE_FLAG_INHERIT, 0)) goto error;
|
||||
#endif
|
||||
*handle = handles[1];
|
||||
return handles[0];
|
||||
|
||||
#else
|
||||
|
||||
/* Normal blocking pipes */
|
||||
#ifdef JANET_WINDOWS
|
||||
SECURITY_ATTRIBUTES saAttr;
|
||||
memset(&saAttr, 0, sizeof(saAttr));
|
||||
@@ -535,6 +616,8 @@ static JanetHandle make_pipes(JanetHandle *handle, int reverse, int *errflag) {
|
||||
*handle = handles[1];
|
||||
return handles[0];
|
||||
#endif
|
||||
|
||||
#endif
|
||||
error:
|
||||
*errflag = 1;
|
||||
return JANET_HANDLE_NONE;
|
||||
@@ -543,6 +626,11 @@ error:
|
||||
static const JanetMethod proc_methods[] = {
|
||||
{"wait", os_proc_wait},
|
||||
{"kill", os_proc_kill},
|
||||
{"close", os_proc_close},
|
||||
/* dud methods for janet_proc_next */
|
||||
{"in", NULL},
|
||||
{"out", NULL},
|
||||
{"err", NULL},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -568,17 +656,29 @@ static int janet_proc_get(void *p, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), proc_methods, out);
|
||||
}
|
||||
|
||||
static Janet janet_proc_next(void *p, Janet key) {
|
||||
(void) p;
|
||||
return janet_nextmethod(proc_methods, key);
|
||||
}
|
||||
|
||||
static const JanetAbstractType ProcAT = {
|
||||
"core/process",
|
||||
janet_proc_gc,
|
||||
janet_proc_mark,
|
||||
janet_proc_get,
|
||||
JANET_ATEND_GET
|
||||
NULL, /* put */
|
||||
NULL, /* marshal */
|
||||
NULL, /* unmarshal */
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
janet_proc_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
static JanetHandle janet_getjstream(Janet *argv, int32_t n, void **orig) {
|
||||
#ifdef JANET_EV
|
||||
JanetStream *stream = janet_checkabstract(argv[0], &janet_stream_type);
|
||||
JanetStream *stream = janet_checkabstract(argv[n], &janet_stream_type);
|
||||
if (stream != NULL) {
|
||||
if (stream->flags & JANET_STREAM_CLOSED)
|
||||
janet_panic("stream is closed");
|
||||
@@ -586,7 +686,7 @@ static JanetHandle janet_getjstream(Janet *argv, int32_t n, void **orig) {
|
||||
return stream->handle;
|
||||
}
|
||||
#endif
|
||||
JanetFile *f = janet_checkabstract(argv[0], &janet_file_type);
|
||||
JanetFile *f = janet_checkabstract(argv[n], &janet_file_type);
|
||||
if (f != NULL) {
|
||||
if (f->flags & JANET_FILE_CLOSED) {
|
||||
janet_panic("file is closed");
|
||||
@@ -662,7 +762,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
|
||||
/* Get environment */
|
||||
int use_environ = !janet_flag_at(flags, 0);
|
||||
char **envp = os_execute_env(argc, argv);
|
||||
EnvBlock envp = os_execute_env(argc, argv);
|
||||
|
||||
/* Get arguments */
|
||||
JanetView exargs = janet_getindexed(argv, 0);
|
||||
@@ -675,6 +775,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
JanetHandle new_in = JANET_HANDLE_NONE, new_out = JANET_HANDLE_NONE, new_err = JANET_HANDLE_NONE;
|
||||
JanetHandle pipe_in = JANET_HANDLE_NONE, pipe_out = JANET_HANDLE_NONE, pipe_err = JANET_HANDLE_NONE;
|
||||
int pipe_errflag = 0; /* Track errors setting up pipes */
|
||||
int pipe_owner_flags = 0;
|
||||
|
||||
/* Get optional redirections */
|
||||
if (argc > 2) {
|
||||
@@ -684,16 +785,19 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
Janet maybe_stderr = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("err"));
|
||||
if (janet_keyeq(maybe_stdin, "pipe")) {
|
||||
new_in = make_pipes(&pipe_in, 1, &pipe_errflag);
|
||||
pipe_owner_flags |= JANET_PROC_OWNS_STDIN;
|
||||
} else if (!janet_checktype(maybe_stdin, JANET_NIL)) {
|
||||
new_in = janet_getjstream(&maybe_stdin, 0, &orig_in);
|
||||
}
|
||||
if (janet_keyeq(maybe_stdout, "pipe")) {
|
||||
new_out = make_pipes(&pipe_out, 0, &pipe_errflag);
|
||||
pipe_owner_flags |= JANET_PROC_OWNS_STDOUT;
|
||||
} else if (!janet_checktype(maybe_stdout, JANET_NIL)) {
|
||||
new_out = janet_getjstream(&maybe_stdout, 0, &orig_out);
|
||||
}
|
||||
if (janet_keyeq(maybe_stderr, "err")) {
|
||||
if (janet_keyeq(maybe_stderr, "pipe")) {
|
||||
new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
|
||||
pipe_owner_flags |= JANET_PROC_OWNS_STDERR;
|
||||
} else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
|
||||
new_err = janet_getjstream(&maybe_stderr, 0, &orig_err);
|
||||
}
|
||||
@@ -722,10 +826,12 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
startupInfo.cb = sizeof(startupInfo);
|
||||
startupInfo.dwFlags |= STARTF_USESTDHANDLES;
|
||||
saAttr.nLength = sizeof(saAttr);
|
||||
saAttr.bInheritHandle = TRUE;
|
||||
|
||||
JanetBuffer *buf = os_exec_escape(exargs);
|
||||
if (buf->count > 8191) {
|
||||
if (pipe_in != JANET_HANDLE_NONE) CloseHandle(pipe_in);
|
||||
if (pipe_out != JANET_HANDLE_NONE) CloseHandle(pipe_out);
|
||||
if (pipe_err != JANET_HANDLE_NONE) CloseHandle(pipe_err);
|
||||
janet_panic("command line string too long (max 8191 characters)");
|
||||
}
|
||||
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
|
||||
@@ -757,10 +863,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
startupInfo.hStdError = (HANDLE) _get_osfhandle(2);
|
||||
}
|
||||
|
||||
/* Use _spawn family of functions. */
|
||||
/* Windows docs say do this before any spawns. */
|
||||
_flushall();
|
||||
|
||||
int cp_failed = 0;
|
||||
if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path,
|
||||
(char *) buf->data, /* Single CLI argument */
|
||||
@@ -788,15 +890,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
pHandle = processInfo.hProcess;
|
||||
tHandle = processInfo.hThread;
|
||||
|
||||
/* Wait and cleanup immedaitely */
|
||||
if (!is_spawn) {
|
||||
DWORD code;
|
||||
WaitForSingleObject(pHandle, INFINITE);
|
||||
GetExitCodeProcess(pHandle, &code);
|
||||
status = (int) code;
|
||||
CloseHandle(pHandle);
|
||||
CloseHandle(tHandle);
|
||||
}
|
||||
#else
|
||||
|
||||
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
|
||||
@@ -853,16 +946,9 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
janet_unlock_environ();
|
||||
}
|
||||
|
||||
/* Wait for child */
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
if (status) {
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
} else if (is_spawn) {
|
||||
/* Get process handle */
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
} else {
|
||||
/* Wait to complete */
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -877,24 +963,24 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
proc->in = NULL;
|
||||
proc->out = NULL;
|
||||
proc->err = NULL;
|
||||
if (new_in != JANET_HANDLE_NONE) {
|
||||
proc->in = get_stdio_for_handle(new_in, orig_in, 0);
|
||||
if (NULL == proc->in) janet_panic("failed to construct proc");
|
||||
}
|
||||
if (new_out != JANET_HANDLE_NONE) {
|
||||
proc->out = get_stdio_for_handle(new_out, orig_out, 1);
|
||||
if (NULL == proc->out) janet_panic("failed to construct proc");
|
||||
}
|
||||
if (new_err != JANET_HANDLE_NONE) {
|
||||
proc->err = get_stdio_for_handle(new_err, orig_err, 1);
|
||||
if (NULL == proc->err) janet_panic("failed to construct proc");
|
||||
}
|
||||
proc->flags = 0;
|
||||
proc->flags = pipe_owner_flags;
|
||||
if (janet_flag_at(flags, 2)) {
|
||||
proc->flags |= JANET_PROC_ERROR_NONZERO;
|
||||
}
|
||||
|
||||
if (is_spawn) {
|
||||
/* Only set up pointers to stdin, stdout, and stderr if os/spawn. */
|
||||
if (new_in != JANET_HANDLE_NONE) {
|
||||
proc->in = get_stdio_for_handle(new_in, orig_in, 1);
|
||||
if (NULL == proc->in) janet_panic("failed to construct proc");
|
||||
}
|
||||
if (new_out != JANET_HANDLE_NONE) {
|
||||
proc->out = get_stdio_for_handle(new_out, orig_out, 0);
|
||||
if (NULL == proc->out) janet_panic("failed to construct proc");
|
||||
}
|
||||
if (new_err != JANET_HANDLE_NONE) {
|
||||
proc->err = get_stdio_for_handle(new_err, orig_err, 0);
|
||||
if (NULL == proc->err) janet_panic("failed to construct proc");
|
||||
}
|
||||
return janet_wrap_abstract(proc);
|
||||
} else {
|
||||
#ifdef JANET_EV
|
||||
@@ -913,15 +999,34 @@ static Janet os_spawn(int32_t argc, Janet *argv) {
|
||||
return os_execute_impl(argc, argv, 1);
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
/* Runs in a separate thread */
|
||||
static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
|
||||
int stat = system((const char *) args.argp);
|
||||
janet_free(args.argp);
|
||||
if (args.argi) {
|
||||
args.tag = JANET_EV_TCTAG_INTEGER;
|
||||
} else {
|
||||
args.tag = JANET_EV_TCTAG_BOOLEAN;
|
||||
}
|
||||
args.argi = stat;
|
||||
return args;
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *cmd = argc
|
||||
? janet_getcstring(argv, 0)
|
||||
: NULL;
|
||||
#ifdef JANET_EV
|
||||
janet_ev_threaded_await(os_shell_subr, 0, argc, cmd ? strdup(cmd) : NULL);
|
||||
#else
|
||||
int stat = system(cmd);
|
||||
return argc
|
||||
? janet_wrap_integer(stat)
|
||||
: janet_wrap_boolean(stat);
|
||||
#endif
|
||||
}
|
||||
|
||||
#endif /* JANET_NO_PROCESSES */
|
||||
@@ -1661,7 +1766,7 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
|
||||
Janet ret = janet_cstringv(dest);
|
||||
free(dest);
|
||||
janet_free(dest);
|
||||
return ret;
|
||||
#endif
|
||||
}
|
||||
@@ -1833,7 +1938,7 @@ static Janet os_pipe(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
JanetHandle fds[2];
|
||||
if (janet_make_pipe(fds)) janet_panicv(janet_ev_lasterr());
|
||||
if (janet_make_pipe(fds, 0)) janet_panicv(janet_ev_lasterr());
|
||||
JanetStream *reader = janet_stream(fds[0], JANET_STREAM_READABLE, NULL);
|
||||
JanetStream *writer = janet_stream(fds[1], JANET_STREAM_WRITABLE, NULL);
|
||||
Janet tup[2] = {janet_wrap_abstract(reader), janet_wrap_abstract(writer)};
|
||||
@@ -1855,27 +1960,27 @@ static const JanetReg os_cfuns[] = {
|
||||
"os/which", os_which,
|
||||
JDOC("(os/which)\n\n"
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"\t:windows\n"
|
||||
"\t:macos\n"
|
||||
"\t:web - Web assembly (emscripten)\n"
|
||||
"\t:linux\n"
|
||||
"\t:freebsd\n"
|
||||
"\t:openbsd\n"
|
||||
"\t:netbsd\n"
|
||||
"\t:posix - A POSIX compatible system (default)\n\n"
|
||||
"* :windows\n\n"
|
||||
"* :macos\n\n"
|
||||
"* :web - Web assembly (emscripten)\n\n"
|
||||
"* :linux\n\n"
|
||||
"* :freebsd\n\n"
|
||||
"* :openbsd\n\n"
|
||||
"* :netbsd\n\n"
|
||||
"* :posix - A POSIX compatible system (default)\n\n"
|
||||
"May also return a custom keyword specified at build time.")
|
||||
},
|
||||
{
|
||||
"os/arch", os_arch,
|
||||
JDOC("(os/arch)\n\n"
|
||||
"Check the ISA that janet was compiled for. Returns one of:\n\n"
|
||||
"\t:x86\n"
|
||||
"\t:x86-64\n"
|
||||
"\t:arm\n"
|
||||
"\t:aarch64\n"
|
||||
"\t:sparc\n"
|
||||
"\t:wasm\n"
|
||||
"\t:unknown\n")
|
||||
"* :x86\n\n"
|
||||
"* :x86-64\n\n"
|
||||
"* :arm\n\n"
|
||||
"* :aarch64\n\n"
|
||||
"* :sparc\n\n"
|
||||
"* :wasm\n\n"
|
||||
"* :unknown\n")
|
||||
},
|
||||
#ifndef JANET_REDUCED_OS
|
||||
{
|
||||
@@ -1897,22 +2002,22 @@ static const JanetReg os_cfuns[] = {
|
||||
{
|
||||
"os/stat", os_stat,
|
||||
JDOC("(os/stat path &opt tab|key)\n\n"
|
||||
"Gets information about a file or directory. Returns a table If the third argument is a keyword, returns "
|
||||
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
|
||||
"\t:dev - the device that the file is on\n"
|
||||
"\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n"
|
||||
"\t:int-permissions - A Unix permission integer like 8r744\n"
|
||||
"\t:permissions - A Unix permission string like \"rwxr--r--\"\n"
|
||||
"\t:uid - File uid\n"
|
||||
"\t:gid - File gid\n"
|
||||
"\t:nlink - number of links to file\n"
|
||||
"\t:rdev - Real device of file. 0 on windows.\n"
|
||||
"\t:size - size of file in bytes\n"
|
||||
"\t:blocks - number of blocks in file. 0 on windows\n"
|
||||
"\t:blocksize - size of blocks in file. 0 on windows\n"
|
||||
"\t:accessed - timestamp when file last accessed\n"
|
||||
"\t:changed - timestamp when file last changed (permissions changed)\n"
|
||||
"\t:modified - timestamp when file last modified (content changed)\n")
|
||||
"Gets information about a file or directory. Returns a table if the second argument is a keyword, returns "
|
||||
" only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
|
||||
"* :dev - the device that the file is on\n\n"
|
||||
"* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
|
||||
"* :int-permissions - A Unix permission integer like 8r744\n\n"
|
||||
"* :permissions - A Unix permission string like \"rwxr--r--\"\n\n"
|
||||
"* :uid - File uid\n\n"
|
||||
"* :gid - File gid\n\n"
|
||||
"* :nlink - number of links to file\n\n"
|
||||
"* :rdev - Real device of file. 0 on windows.\n\n"
|
||||
"* :size - size of file in bytes\n\n"
|
||||
"* :blocks - number of blocks in file. 0 on windows\n\n"
|
||||
"* :blocksize - size of blocks in file. 0 on windows\n\n"
|
||||
"* :accessed - timestamp when file last accessed\n\n"
|
||||
"* :changed - timestamp when file last changed (permissions changed)\n\n"
|
||||
"* :modified - timestamp when file last modified (content changed)\n")
|
||||
},
|
||||
{
|
||||
"os/lstat", os_lstat,
|
||||
@@ -1985,27 +2090,27 @@ static const JanetReg os_cfuns[] = {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"os/execute", os_execute,
|
||||
JDOC("(os/execute args &opts flags env)\n\n"
|
||||
"Execute a program on the system and pass it string arguments. Flags "
|
||||
JDOC("(os/execute args &opt flags env)\n\n"
|
||||
"Execute a program on the system and pass it string arguments. `flags` "
|
||||
"is a keyword that modifies how the program will execute.\n\n"
|
||||
"\t:e - enables passing an environment to the program. Without :e, the "
|
||||
"current environment is inherited.\n"
|
||||
"\t:p - allows searching the current PATH for the binary to execute. "
|
||||
"Without this flag, binaries must use absolute paths.\n"
|
||||
"\t:x - raise error if exit code is non-zero.\n"
|
||||
"env is a table or struct mapping environment variables to values. It can also "
|
||||
"* :e - enables passing an environment to the program. Without :e, the "
|
||||
"current environment is inherited.\n\n"
|
||||
"* :p - allows searching the current PATH for the binary to execute. "
|
||||
"Without this flag, binaries must use absolute paths.\n\n"
|
||||
"* :x - raise error if exit code is non-zero.\n\n"
|
||||
"`env` is a table or struct mapping environment variables to values. It can also "
|
||||
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
|
||||
"These arguments should be core/file values. "
|
||||
"One can also pass in the :pipe keyword "
|
||||
"for these arguments to create files that will read (for :err and :out) or write (for :in) "
|
||||
"to the file descriptor of the subprocess. This is only useful in os/spawn, which takes "
|
||||
"the same parameters as os/execute, but will return an object that contains references to these "
|
||||
"to the file descriptor of the subprocess. This is only useful in `os/spawn`, which takes "
|
||||
"the same parameters as `os/execute`, but will return an object that contains references to these "
|
||||
"files via (return-value :in), (return-value :out), and (return-value :err). "
|
||||
"Returns the exit status of the program.")
|
||||
},
|
||||
{
|
||||
"os/spawn", os_spawn,
|
||||
JDOC("(os/spawn args &opts flags env)\n\n"
|
||||
JDOC("(os/spawn args &opt flags env)\n\n"
|
||||
"Execute a program on the system and return a handle to the process. Otherwise, the "
|
||||
"same arguments as os/execute. Does not wait for the process.")
|
||||
},
|
||||
@@ -2026,6 +2131,12 @@ static const JanetReg os_cfuns[] = {
|
||||
"handle on windows. If wait is truthy, will wait for the process to finsih and "
|
||||
"returns the exit code. Otherwise, returns proc.")
|
||||
},
|
||||
{
|
||||
"os/proc-close", os_proc_close,
|
||||
JDOC("(os/proc-close proc)\n\n"
|
||||
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
|
||||
"if they have not been closed. Returns nil.")
|
||||
},
|
||||
#endif
|
||||
{
|
||||
"os/setenv", os_setenv,
|
||||
@@ -2073,19 +2184,19 @@ static const JanetReg os_cfuns[] = {
|
||||
{
|
||||
"os/date", os_date,
|
||||
JDOC("(os/date &opt time local)\n\n"
|
||||
"Returns the given time as a date struct, or the current time if no time is given. "
|
||||
"Returns the given time as a date struct, or the current time if `time` is not given. "
|
||||
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
|
||||
"Date is given in UTC unless local is truthy, in which case the date is formatted for "
|
||||
"Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
|
||||
"the local timezone.\n\n"
|
||||
"\t:seconds - number of seconds [0-61]\n"
|
||||
"\t:minutes - number of minutes [0-59]\n"
|
||||
"\t:hours - number of hours [0-23]\n"
|
||||
"\t:month-day - day of month [0-30]\n"
|
||||
"\t:month - month of year [0, 11]\n"
|
||||
"\t:year - years since year 0 (e.g. 2019)\n"
|
||||
"\t:week-day - day of the week [0-6]\n"
|
||||
"\t:year-day - day of the year [0-365]\n"
|
||||
"\t:dst - If Day Light Savings is in effect")
|
||||
"* :seconds - number of seconds [0-61]\n\n"
|
||||
"* :minutes - number of minutes [0-59]\n\n"
|
||||
"* :hours - number of hours [0-23]\n\n"
|
||||
"* :month-day - day of month [0-30]\n\n"
|
||||
"* :month - month of year [0, 11]\n\n"
|
||||
"* :year - years since year 0 (e.g. 2019)\n\n"
|
||||
"* :week-day - day of the week [0-6]\n\n"
|
||||
"* :year-day - day of the year [0-365]\n\n"
|
||||
"* :dst - if Day Light Savings is in effect")
|
||||
},
|
||||
{
|
||||
"os/rename", os_rename,
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -123,7 +123,7 @@ static void NAME(JanetParser *p, T x) { \
|
||||
if (newcount > p->STACKCAP) { \
|
||||
T *next; \
|
||||
size_t newcap = 2 * newcount; \
|
||||
next = realloc(p->STACK, sizeof(T) * newcap); \
|
||||
next = janet_realloc(p->STACK, sizeof(T) * newcap); \
|
||||
if (NULL == next) { \
|
||||
JANET_OUT_OF_MEMORY; \
|
||||
} \
|
||||
@@ -175,7 +175,14 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
if (newtop->flags & PFLAG_CONTAINER) {
|
||||
newtop->argn++;
|
||||
/* Keep track of number of values in the root state */
|
||||
if (p->statecount == 1) p->pending++;
|
||||
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);
|
||||
}
|
||||
push_arg(p, val);
|
||||
return;
|
||||
} else if (newtop->flags & PFLAG_READERMAC) {
|
||||
@@ -730,6 +737,19 @@ 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--;
|
||||
return ret;
|
||||
}
|
||||
|
||||
Janet janet_parser_produce_wrapped(JanetParser *parser) {
|
||||
Janet ret;
|
||||
size_t i;
|
||||
if (parser->pending == 0) return janet_wrap_nil();
|
||||
@@ -763,9 +783,9 @@ void janet_parser_init(JanetParser *parser) {
|
||||
}
|
||||
|
||||
void janet_parser_deinit(JanetParser *parser) {
|
||||
free(parser->args);
|
||||
free(parser->buf);
|
||||
free(parser->states);
|
||||
janet_free(parser->args);
|
||||
janet_free(parser->buf);
|
||||
janet_free(parser->states);
|
||||
}
|
||||
|
||||
void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
@@ -792,17 +812,17 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
dest->states = NULL;
|
||||
dest->buf = NULL;
|
||||
if (dest->bufcap) {
|
||||
dest->buf = malloc(dest->bufcap);
|
||||
dest->buf = janet_malloc(dest->bufcap);
|
||||
if (!dest->buf) goto nomem;
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
}
|
||||
if (dest->argcap) {
|
||||
dest->args = malloc(sizeof(Janet) * dest->argcap);
|
||||
dest->args = janet_malloc(sizeof(Janet) * dest->argcap);
|
||||
if (!dest->args) goto nomem;
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
}
|
||||
if (dest->statecap) {
|
||||
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
dest->states = janet_malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
if (!dest->states) goto nomem;
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
}
|
||||
@@ -840,13 +860,21 @@ 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,
|
||||
JANET_ATEND_GET
|
||||
NULL, /* put */
|
||||
NULL, /* marshal */
|
||||
NULL, /* unmarshal */
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
parsernext,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
/* C Function parser */
|
||||
@@ -902,15 +930,20 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
if (s->flags & PFLAG_COMMENT) s--;
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
s->argn++;
|
||||
if (p->statecount == 1) p->pending++;
|
||||
push_arg(p, argv[1]);
|
||||
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]);
|
||||
}
|
||||
} 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 = realloc(p->buf, newcap);
|
||||
p->buf = janet_realloc(p->buf, newcap);
|
||||
if (p->buf == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -972,9 +1005,13 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
return janet_parser_produce(p);
|
||||
if (argc == 2 && janet_truthy(argv[1])) {
|
||||
return janet_parser_produce_wrapped(p);
|
||||
} else {
|
||||
return janet_parser_produce(p);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
@@ -1183,6 +1220,11 @@ 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,
|
||||
@@ -1204,10 +1246,12 @@ static const JanetReg parse_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"parser/produce", cfun_parse_produce,
|
||||
JDOC("(parser/produce parser)\n\n"
|
||||
JDOC("(parser/produce parser &opt wrap)\n\n"
|
||||
"Dequeue the next value in the parse queue. Will return nil if "
|
||||
"no parsed values are in the queue, otherwise will dequeue the "
|
||||
"next value.")
|
||||
"next value. If `wrap` is truthy, will return a 1-element tuple that "
|
||||
"wraps the result. This tuple can be used for source-mapping "
|
||||
"purposes.")
|
||||
},
|
||||
{
|
||||
"parser/consume", cfun_parse_consume,
|
||||
@@ -1234,9 +1278,9 @@ static const JanetReg parse_cfuns[] = {
|
||||
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.")
|
||||
"* :pending - a value is being parsed.\n\n"
|
||||
"* :error - a parsing error was encountered.\n\n"
|
||||
"* :root - the parser can either read more values or safely terminate.")
|
||||
},
|
||||
{
|
||||
"parser/flush", cfun_parse_flush,
|
||||
@@ -1250,10 +1294,10 @@ static const JanetReg parse_cfuns[] = {
|
||||
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, "
|
||||
"* :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 "
|
||||
"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.")
|
||||
},
|
||||
|
||||
128
src/core/peg.c
128
src/core/peg.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,11 +44,13 @@ 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
|
||||
@@ -60,6 +62,7 @@ typedef struct {
|
||||
* if one branch fails and try a new branch. */
|
||||
typedef struct {
|
||||
int32_t cap;
|
||||
int32_t tcap;
|
||||
int32_t scratch;
|
||||
} CapState;
|
||||
|
||||
@@ -68,6 +71,7 @@ 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;
|
||||
}
|
||||
|
||||
@@ -75,7 +79,15 @@ 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.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;
|
||||
}
|
||||
|
||||
/* Add a capture */
|
||||
@@ -83,8 +95,11 @@ static void pushcap(PegState *s, Janet capture, uint32_t tag) {
|
||||
if (s->mode == PEG_MODE_ACCUMULATE) {
|
||||
janet_to_string_b(s->scratch, capture);
|
||||
}
|
||||
if (tag || s->mode == PEG_MODE_NORMAL) {
|
||||
if (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);
|
||||
}
|
||||
}
|
||||
@@ -271,7 +286,7 @@ tail:
|
||||
const uint8_t *next_text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text < s->text_end) {
|
||||
while (text <= s->text_end) {
|
||||
CapState cs2 = cap_save(s);
|
||||
next_text = peg_rule(s, rule_a, text);
|
||||
if (next_text) {
|
||||
@@ -281,7 +296,7 @@ tail:
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
if (text >= s->text_end) {
|
||||
if (text > s->text_end) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
@@ -321,7 +336,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->captures->data[i], tag);
|
||||
pushcap(s, s->tagged_captures->data[i], tag);
|
||||
return text;
|
||||
}
|
||||
}
|
||||
@@ -358,15 +373,15 @@ 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 (!tag && s->mode == PEG_MODE_ACCUMULATE) {
|
||||
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[2];
|
||||
pushcap(s, janet_stringv(text, (int32_t)(result - text)), tag);
|
||||
}
|
||||
return result;
|
||||
@@ -388,7 +403,7 @@ tail:
|
||||
if (!result) return NULL;
|
||||
Janet cap = janet_stringv(s->scratch->data + cs.scratch,
|
||||
s->scratch->count - cs.scratch);
|
||||
cap_load(s, cs);
|
||||
cap_load_keept(s, cs);
|
||||
pushcap(s, cap, tag);
|
||||
return result;
|
||||
}
|
||||
@@ -419,7 +434,7 @@ tail:
|
||||
s->captures->data + cs.cap,
|
||||
sizeof(Janet) * num_sub_captures);
|
||||
sub_captures->count = num_sub_captures;
|
||||
cap_load(s, cs);
|
||||
cap_load_keept(s, cs);
|
||||
pushcap(s, janet_wrap_array(sub_captures), tag);
|
||||
return result;
|
||||
}
|
||||
@@ -464,7 +479,7 @@ tail:
|
||||
s->captures->data + cs.cap);
|
||||
break;
|
||||
}
|
||||
cap_load(s, cs);
|
||||
cap_load_keept(s, cs);
|
||||
if (rule[0] == RULE_MATCHTIME && !janet_truthy(cap)) return NULL;
|
||||
pushcap(s, cap, tag);
|
||||
return result;
|
||||
@@ -495,7 +510,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->captures->data[i];
|
||||
Janet capture = s->tagged_captures->data[i];
|
||||
if (!janet_checktype(capture, JANET_STRING))
|
||||
return NULL;
|
||||
const uint8_t *bytes = janet_unwrap_string(capture);
|
||||
@@ -581,6 +596,30 @@ tail:
|
||||
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;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@@ -597,6 +636,7 @@ typedef struct {
|
||||
Janet form;
|
||||
int depth;
|
||||
uint32_t nexttag;
|
||||
int has_backref;
|
||||
} Builder;
|
||||
|
||||
/* Forward declaration to allow recursion */
|
||||
@@ -903,15 +943,15 @@ static void spec_error(Builder *b, int32_t argc, const Janet *argv) {
|
||||
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);
|
||||
}
|
||||
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);
|
||||
}
|
||||
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_onerule(b, argc, argv, RULE_DROP);
|
||||
}
|
||||
|
||||
/* Rule of the form [rule, tag] */
|
||||
static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
||||
@@ -931,12 +971,16 @@ 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_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);
|
||||
}
|
||||
|
||||
@@ -959,6 +1003,7 @@ static void spec_column(Builder *b, int32_t argc, const Janet *argv) {
|
||||
}
|
||||
|
||||
static void spec_backmatch(Builder *b, int32_t argc, const Janet *argv) {
|
||||
b->has_backref = 1;
|
||||
spec_tag1(b, argc, argv, RULE_BACKMATCH);
|
||||
}
|
||||
|
||||
@@ -1009,7 +1054,7 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
||||
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[3]) : 0;
|
||||
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);
|
||||
@@ -1086,6 +1131,7 @@ static const SpecialPair peg_specials[] = {
|
||||
{"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. */
|
||||
@@ -1102,7 +1148,9 @@ 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 = janet_table_get(b->default_grammar, peg);
|
||||
nextPeg = (b->default_grammar == NULL)
|
||||
? janet_wrap_nil()
|
||||
: janet_table_get(b->default_grammar, peg);
|
||||
if (janet_checktype(nextPeg, JANET_NIL)) {
|
||||
peg_panic(b, "unknown rule");
|
||||
}
|
||||
@@ -1289,12 +1337,13 @@ 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 = calloc(1, blen);
|
||||
uint8_t *op_flags = janet_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];
|
||||
@@ -1310,9 +1359,13 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
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] */
|
||||
@@ -1353,9 +1406,13 @@ 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] */
|
||||
@@ -1365,6 +1422,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
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;
|
||||
@@ -1409,25 +1467,31 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
/* Good return */
|
||||
peg->bytecode = bytecode;
|
||||
peg->constants = constants;
|
||||
free(op_flags);
|
||||
peg->has_backref = has_backref;
|
||||
janet_free(op_flags);
|
||||
return peg;
|
||||
|
||||
bad:
|
||||
free(op_flags);
|
||||
janet_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,
|
||||
NULL, /* put */
|
||||
peg_marshal,
|
||||
peg_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
peg_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
/* Convert Builder to JanetPeg (Janet Abstract Value) */
|
||||
@@ -1445,6 +1509,7 @@ 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;
|
||||
}
|
||||
|
||||
@@ -1452,13 +1517,20 @@ static JanetPeg *make_peg(Builder *b) {
|
||||
static JanetPeg *compile_peg(Janet x) {
|
||||
Builder builder;
|
||||
builder.grammar = janet_table(0);
|
||||
builder.default_grammar = janet_get_core_table("default-peg-grammar");
|
||||
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.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);
|
||||
@@ -1515,12 +1587,14 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
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;
|
||||
}
|
||||
|
||||
@@ -1609,12 +1683,18 @@ static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), peg_methods, out);
|
||||
}
|
||||
|
||||
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.")
|
||||
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment "
|
||||
"the grammar of the peg for otherwise undefined peg keywords.")
|
||||
},
|
||||
{
|
||||
"peg/match", cfun_peg_match,
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,7 +42,14 @@ static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||
const char *fmt = (x == floor(x) &&
|
||||
x <= JANET_INTMAX_DOUBLE &&
|
||||
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
|
||||
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
|
||||
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);
|
||||
}
|
||||
buffer->count += count;
|
||||
}
|
||||
|
||||
@@ -344,6 +351,9 @@ struct pretty {
|
||||
int indent;
|
||||
int flags;
|
||||
int32_t bufstartlen;
|
||||
int32_t *keysort_buffer;
|
||||
int32_t keysort_capacity;
|
||||
int32_t keysort_start;
|
||||
JanetTable seen;
|
||||
};
|
||||
|
||||
@@ -587,31 +597,55 @@ 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);
|
||||
for (i = 0; i < cap; i++) {
|
||||
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
||||
if (counter == JANET_PRETTY_DICT_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
}
|
||||
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++;
|
||||
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;
|
||||
}
|
||||
}
|
||||
|
||||
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++;
|
||||
@@ -634,6 +668,9 @@ 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);
|
||||
@@ -656,6 +693,9 @@ 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);
|
||||
@@ -815,7 +855,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1) depth = 4;
|
||||
if (depth < 1) depth = JANET_RECURSION_GUARD;
|
||||
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');
|
||||
@@ -967,7 +1007,7 @@ void janet_buffer_format(
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1) depth = 4;
|
||||
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');
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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) {
|
||||
free(ra->chunks);
|
||||
janet_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 = malloc(size);
|
||||
dest->chunks = janet_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 = realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
|
||||
ra->chunks = janet_realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
|
||||
if (!ra->chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -251,6 +251,9 @@ 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;
|
||||
@@ -407,7 +410,9 @@ 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);
|
||||
janetc_throwaway(bodyopts, falsebody);
|
||||
if (!janet_checktype(falsebody, JANET_NIL)) {
|
||||
janetc_throwaway(bodyopts, falsebody);
|
||||
}
|
||||
janetc_popscope(c);
|
||||
return target;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -108,7 +108,7 @@ static void kmp_init(
|
||||
if (patlen == 0) {
|
||||
janet_panic("expected non-empty pattern");
|
||||
}
|
||||
int32_t *lookup = calloc(patlen, sizeof(int32_t));
|
||||
int32_t *lookup = janet_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) {
|
||||
free(state->lookup);
|
||||
janet_free(state->lookup);
|
||||
}
|
||||
|
||||
static void kmp_seti(struct kmp_state *state, int32_t i) {
|
||||
@@ -398,6 +398,7 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
|
||||
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));
|
||||
@@ -588,19 +589,18 @@ static const JanetReg string_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"string/find", cfun_string_find,
|
||||
JDOC("(string/find patt str)\n\n"
|
||||
JDOC("(string/find patt str &opt start-index)\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-all patt str)\n\n"
|
||||
JDOC("(string/find-all patt str &opt start-index)\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.")
|
||||
"instances of the pattern are counted individually, meaning a byte in str "
|
||||
"may contribute to multiple found patterns.")
|
||||
},
|
||||
{
|
||||
"string/has-prefix?", cfun_string_hasprefix,
|
||||
@@ -621,7 +621,8 @@ static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"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. "
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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 = realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
|
||||
uint32_t *mem = janet_realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -368,11 +368,11 @@ int janet_scan_number(
|
||||
goto error;
|
||||
|
||||
*out = convert(neg, &mant, base, ex);
|
||||
free(mant.digits);
|
||||
janet_free(mant.digits);
|
||||
return 0;
|
||||
|
||||
error:
|
||||
free(mant.digits);
|
||||
janet_free(mant.digits);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -45,7 +45,7 @@ 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 = calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||
janet_vm_cache = janet_calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||
if (NULL == janet_vm_cache) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -55,7 +55,7 @@ void janet_symcache_init() {
|
||||
|
||||
/* Deinitialize the cache (free the cache memory) */
|
||||
void janet_symcache_deinit() {
|
||||
free((void *)janet_vm_cache);
|
||||
janet_free((void *)janet_vm_cache);
|
||||
janet_vm_cache = NULL;
|
||||
janet_vm_cache_capacity = 0;
|
||||
janet_vm_cache_count = 0;
|
||||
@@ -122,7 +122,7 @@ notfound:
|
||||
static void janet_cache_resize(uint32_t newCapacity) {
|
||||
uint32_t i, oldCapacity;
|
||||
const uint8_t **oldCache = janet_vm_cache;
|
||||
const uint8_t **newCache = calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
|
||||
const uint8_t **newCache = janet_calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
|
||||
if (newCache == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -145,7 +145,7 @@ static void janet_cache_resize(uint32_t newCapacity) {
|
||||
}
|
||||
}
|
||||
/* Free the old cache */
|
||||
free((void *)oldCache);
|
||||
janet_free((void *)oldCache);
|
||||
}
|
||||
|
||||
/* Add an item to the cache */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -117,7 +117,7 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
|
||||
if (islocal) {
|
||||
janet_sfree(olddata);
|
||||
} else {
|
||||
free(olddata);
|
||||
janet_free(olddata);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -237,7 +237,7 @@ JanetTable *janet_table_clone(JanetTable *table) {
|
||||
newTable->capacity = table->capacity;
|
||||
newTable->deleted = table->deleted;
|
||||
newTable->proto = table->proto;
|
||||
newTable->data = malloc(newTable->capacity * sizeof(JanetKV));
|
||||
newTable->data = janet_malloc(newTable->capacity * sizeof(JanetKV));
|
||||
if (NULL == newTable->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -84,13 +84,16 @@ 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");
|
||||
if (NULL == janet_vm_thread_decode) {
|
||||
janet_vm_thread_decode = janet_table(0);
|
||||
}
|
||||
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);
|
||||
JanetMailbox *mailbox = janet_malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
|
||||
if (NULL == mailbox) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -123,7 +126,7 @@ static void janet_mailbox_destroy(JanetMailbox *mailbox) {
|
||||
for (uint16_t i = 0; i < mailbox->messageCapacity; i++) {
|
||||
janet_buffer_deinit(mailbox->messages + i);
|
||||
}
|
||||
free(mailbox);
|
||||
janet_free(mailbox);
|
||||
}
|
||||
|
||||
static void janet_mailbox_lock(JanetMailbox *mailbox) {
|
||||
@@ -182,7 +185,7 @@ static int thread_mark(void *p, size_t size) {
|
||||
}
|
||||
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
|
||||
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
|
||||
JanetMailboxPair *pair = janet_malloc(sizeof(JanetMailboxPair));
|
||||
if (NULL == pair) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -196,7 +199,7 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flag
|
||||
static void destroy_mailbox_pair(JanetMailboxPair *pair) {
|
||||
janet_mailbox_ref(pair->original, -1);
|
||||
janet_mailbox_ref(pair->newbox, -1);
|
||||
free(pair);
|
||||
janet_free(pair);
|
||||
}
|
||||
|
||||
/* Abstract waiting for timeout across windows/posix */
|
||||
@@ -418,13 +421,21 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
}
|
||||
|
||||
static int janet_thread_getter(void *p, Janet key, Janet *out);
|
||||
static Janet janet_thread_next(void *p, Janet key);
|
||||
|
||||
const JanetAbstractType janet_thread_type = {
|
||||
"core/thread",
|
||||
thread_gc,
|
||||
thread_mark,
|
||||
janet_thread_getter,
|
||||
JANET_ATEND_GET
|
||||
NULL, /* put */
|
||||
NULL, /* marshal */
|
||||
NULL, /* unmarshal */
|
||||
NULL, /* tostring */
|
||||
NULL, /* compare */
|
||||
NULL, /* hash */
|
||||
janet_thread_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
|
||||
@@ -512,7 +523,7 @@ static int thread_worker(JanetMailboxPair *pair) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_NET
|
||||
#ifdef JANET_EV
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
@@ -708,6 +719,11 @@ static int janet_thread_getter(void *p, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), janet_thread_methods, out);
|
||||
}
|
||||
|
||||
static Janet janet_thread_next(void *p, Janet key) {
|
||||
(void) p;
|
||||
return janet_nextmethod(janet_thread_methods, key);
|
||||
}
|
||||
|
||||
static const JanetReg threadlib_cfuns[] = {
|
||||
{
|
||||
"thread/current", cfun_thread_current,
|
||||
@@ -720,10 +736,10 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
"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. "
|
||||
"Can optionally provide flags to the new thread - supported flags are:\n"
|
||||
"\t:h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n"
|
||||
"\t:a - Allow sending over registered abstract types to the new thread\n"
|
||||
"\t:c - Send over cfunction information to the new thread.\n"
|
||||
"Can optionally provide flags to the new thread - supported flags are:\n\n"
|
||||
"* :h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n\n"
|
||||
"* :a - Allow sending over registered abstract types to the new thread\n\n"
|
||||
"* :c - Send over cfunction information to the new thread.\n\n"
|
||||
"Returns a handle to the new thread.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,614 +0,0 @@
|
||||
/*
|
||||
* 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;
|
||||
}
|
||||
}
|
||||
|
||||
static Janet ta_view_next(void *p, Janet key) {
|
||||
JanetTArrayView *view = p;
|
||||
if (janet_checktype(key, JANET_NIL)) {
|
||||
if (view->size > 0) {
|
||||
return janet_wrap_number(0);
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
size_t index = (size_t) janet_unwrap_number(key);
|
||||
index++;
|
||||
if (index < view->size) {
|
||||
return janet_wrap_number((double) index);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
const JanetAbstractType janet_ta_view_type = {
|
||||
"ta/view",
|
||||
NULL,
|
||||
ta_mark,
|
||||
ta_getter,
|
||||
ta_setter,
|
||||
ta_view_marshal,
|
||||
ta_view_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
ta_view_next,
|
||||
JANET_ATEND_NEXT
|
||||
};
|
||||
|
||||
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) {
|
||||
int32_t blen;
|
||||
const uint8_t *bytes;
|
||||
if (janet_bytes_view(argv[4], &bytes, &blen)) {
|
||||
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buffer, (size_t) blen);
|
||||
memcpy(buffer->data, bytes, blen);
|
||||
} else {
|
||||
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 if (janet_abstract_type(p) == &janet_ta_buffer_type) {
|
||||
buffer = p;
|
||||
} else {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
}
|
||||
}
|
||||
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
|
||||
109
src/core/util.c
109
src/core/util.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -397,7 +397,7 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
|
||||
if (NULL != regprefix) {
|
||||
prefixlen = strlen(regprefix);
|
||||
bufsize = prefixlen + 256;
|
||||
longname_buffer = malloc(bufsize);
|
||||
longname_buffer = janet_malloc(bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -413,7 +413,7 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
|
||||
int32_t totallen = (int32_t) prefixlen + nmlen;
|
||||
if ((size_t) totallen > bufsize) {
|
||||
bufsize = (size_t)(totallen) + 128;
|
||||
longname_buffer = realloc(longname_buffer, bufsize);
|
||||
longname_buffer = janet_realloc(longname_buffer, bufsize);
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -436,7 +436,7 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
|
||||
janet_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
free(longname_buffer);
|
||||
(janet_free)(longname_buffer);
|
||||
}
|
||||
|
||||
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
@@ -487,27 +487,60 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Resolve a symbol in the environment */
|
||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||
JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
|
||||
Janet ref;
|
||||
JanetTable *entry_table;
|
||||
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
|
||||
JanetBinding binding = {
|
||||
JANET_BINDING_NONE,
|
||||
janet_wrap_nil(),
|
||||
JANET_BINDING_DEP_NONE
|
||||
};
|
||||
|
||||
/* Check environment for entry */
|
||||
if (!janet_checktype(entry, JANET_TABLE))
|
||||
return JANET_BINDING_NONE;
|
||||
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;
|
||||
}
|
||||
|
||||
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;
|
||||
binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
binding.type = JANET_BINDING_MACRO;
|
||||
return binding;
|
||||
}
|
||||
|
||||
ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
||||
if (janet_checktype(ref, JANET_ARRAY)) {
|
||||
*out = ref;
|
||||
return JANET_BINDING_VAR;
|
||||
binding.value = ref;
|
||||
binding.type = JANET_BINDING_VAR;
|
||||
return binding;
|
||||
}
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_DEF;
|
||||
|
||||
binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
binding.type = JANET_BINDING_DEF;
|
||||
return binding;
|
||||
}
|
||||
|
||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||
JanetBinding binding = janet_resolve_ext(env, sym);
|
||||
*out = binding.value;
|
||||
return binding.type;
|
||||
}
|
||||
|
||||
/* Resolve a symbol in the core environment. */
|
||||
@@ -602,6 +635,38 @@ JanetTable *janet_get_core_table(const char *name) {
|
||||
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
|
||||
/* For macos */
|
||||
@@ -688,3 +753,21 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
return -1;
|
||||
#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);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -52,12 +52,6 @@
|
||||
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 { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
#define JDOC(x) NULL
|
||||
@@ -91,6 +85,7 @@ void janet_buffer_format(
|
||||
int32_t argstart,
|
||||
int32_t argc,
|
||||
Janet *argv);
|
||||
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
|
||||
|
||||
/* Inside the janet core, defining globals is different
|
||||
* at bootstrap time and normal runtime */
|
||||
@@ -107,6 +102,11 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf
|
||||
int janet_gettime(struct timespec *spec);
|
||||
#endif
|
||||
|
||||
/* strdup */
|
||||
#ifdef JANET_WINDOWS
|
||||
#define strdup(x) _strdup(x)
|
||||
#endif
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
|
||||
/* Initialize builtin libraries */
|
||||
@@ -145,7 +145,7 @@ extern const JanetAbstractType janet_address_type;
|
||||
#ifdef JANET_EV
|
||||
void janet_lib_ev(JanetTable *env);
|
||||
void janet_ev_mark(void);
|
||||
int janet_make_pipe(JanetHandle handles[2]);
|
||||
int janet_make_pipe(JanetHandle handles[2], int mode);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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,6 +25,7 @@
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#include "fiber.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
@@ -46,7 +47,7 @@ static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
|
||||
if (newsize < 128) {
|
||||
newsize = 128;
|
||||
}
|
||||
JanetTraversalNode *tn = realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
|
||||
JanetTraversalNode *tn = janet_realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
|
||||
if (tn == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -115,6 +116,10 @@ static int traversal_next(Janet *x, Janet *y) {
|
||||
*/
|
||||
|
||||
Janet janet_next(Janet ds, Janet key) {
|
||||
return janet_next_impl(ds, key, 0);
|
||||
}
|
||||
|
||||
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) {
|
||||
JanetType t = janet_type(ds);
|
||||
switch (t) {
|
||||
default:
|
||||
@@ -177,6 +182,44 @@ Janet janet_next(Janet ds, Janet key) {
|
||||
if (NULL == at->next) break;
|
||||
return at->next(abst, key);
|
||||
}
|
||||
case JANET_FIBER: {
|
||||
JanetFiber *child = janet_unwrap_fiber(ds);
|
||||
Janet retreg;
|
||||
JanetFiberStatus status = janet_fiber_status(child);
|
||||
if (status == JANET_STATUS_ALIVE ||
|
||||
status == JANET_STATUS_DEAD ||
|
||||
status == JANET_STATUS_ERROR ||
|
||||
status == JANET_STATUS_USER0 ||
|
||||
status == JANET_STATUS_USER1 ||
|
||||
status == JANET_STATUS_USER2 ||
|
||||
status == JANET_STATUS_USER3 ||
|
||||
status == JANET_STATUS_USER4) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
janet_vm_fiber->child = child;
|
||||
JanetSignal sig = janet_continue(child, janet_wrap_nil(), &retreg);
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
if (is_interpreter) {
|
||||
janet_signalv(sig, retreg);
|
||||
} else {
|
||||
janet_vm_fiber->child = NULL;
|
||||
janet_panicv(retreg);
|
||||
}
|
||||
}
|
||||
janet_vm_fiber->child = NULL;
|
||||
if (sig == JANET_SIGNAL_OK ||
|
||||
sig == JANET_SIGNAL_ERROR ||
|
||||
sig == JANET_SIGNAL_USER0 ||
|
||||
sig == JANET_SIGNAL_USER1 ||
|
||||
sig == JANET_SIGNAL_USER2 ||
|
||||
sig == JANET_SIGNAL_USER3 ||
|
||||
sig == JANET_SIGNAL_USER4) {
|
||||
/* Fiber cannot be resumed, so discard last value. */
|
||||
return janet_wrap_nil();
|
||||
} else {
|
||||
return janet_wrap_integer(0);
|
||||
}
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
@@ -264,18 +307,14 @@ int32_t janet_hash(Janet x) {
|
||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||
break;
|
||||
case JANET_NUMBER: {
|
||||
double num = janet_unwrap_number(x);
|
||||
if (isnan(num) || isinf(num) || num == 0) {
|
||||
hash = 0;
|
||||
} else {
|
||||
hash = (int32_t)num;
|
||||
hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
|
||||
hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
|
||||
hash = (hash >> 16) ^ hash;
|
||||
|
||||
uint32_t lo = (uint32_t)(janet_u64(x) & 0xFFFFFFFF);
|
||||
hash ^= lo + 0x9e3779b9 + (hash << 6) + (hash >> 2);
|
||||
}
|
||||
union {
|
||||
double d;
|
||||
uint64_t u;
|
||||
} as;
|
||||
as.d = janet_unwrap_number(x);
|
||||
uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
|
||||
uint32_t hi = (uint32_t)(as.u >> 32);
|
||||
hash = (int32_t)(hi ^ (lo >> 3));
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
@@ -434,6 +473,14 @@ Janet janet_in(Janet ds, Janet key) {
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_FIBER: {
|
||||
/* Bit of a hack to allow iterating over fibers. */
|
||||
if (janet_equals(key, janet_wrap_integer(0))) {
|
||||
return janet_unwrap_fiber(ds)->last_value;
|
||||
} else {
|
||||
janet_panicf("expected key 0, got %v", key);
|
||||
}
|
||||
}
|
||||
}
|
||||
return value;
|
||||
}
|
||||
@@ -489,6 +536,14 @@ Janet janet_get(Janet ds, Janet key) {
|
||||
const JanetKV *st = janet_unwrap_struct(ds);
|
||||
return janet_struct_get(st, key);
|
||||
}
|
||||
case JANET_FIBER: {
|
||||
/* Bit of a hack to allow iterating over fibers. */
|
||||
if (janet_equals(key, janet_wrap_integer(0))) {
|
||||
return janet_unwrap_fiber(ds)->last_value;
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -545,6 +600,14 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_FIBER: {
|
||||
if (index == 0) {
|
||||
value = janet_unwrap_fiber(ds)->last_value;
|
||||
} else {
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return value;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -43,7 +43,7 @@ void *janet_v_flattenmem(void *v, int32_t itemsize) {
|
||||
int32_t *p;
|
||||
if (NULL == v) return NULL;
|
||||
size_t size = (size_t) itemsize * janet_v__cnt(v);
|
||||
p = malloc(size);
|
||||
p = janet_malloc(size);
|
||||
if (NULL != p) {
|
||||
safe_memcpy(p, v, size);
|
||||
return p;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -202,6 +202,20 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_compop_imm(op) \
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
if (janet_checktype(op1, JANET_NUMBER)) {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = (double) CS; \
|
||||
stack[A] = janet_wrap_boolean(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_wrap_boolean(janet_compare(op1, janet_wrap_integer(CS)) op 0);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
|
||||
/* Trace a function call */
|
||||
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
|
||||
@@ -261,11 +275,16 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
|
||||
}
|
||||
|
||||
/* Method lookup could potentially handle tables specially... */
|
||||
static Janet method_to_fun(Janet method, Janet obj) {
|
||||
return janet_get(obj, method);
|
||||
}
|
||||
|
||||
/* Get a callable from a keyword method name and ensure that it is valid. */
|
||||
static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
|
||||
Janet callee = janet_get(fiber->data[fiber->stackstart], name);
|
||||
Janet callee = method_to_fun(name, fiber->data[fiber->stackstart]);
|
||||
if (janet_checktype(callee, JANET_NIL))
|
||||
janet_panicf("unknown method %v invoked on %v", name, fiber->data[fiber->stackstart]);
|
||||
return callee;
|
||||
@@ -273,8 +292,7 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
|
||||
/* Lookup method on value x */
|
||||
static Janet janet_method_lookup(Janet x, const char *name) {
|
||||
Janet kname = janet_ckeywordv(name);
|
||||
return janet_get(x, kname);
|
||||
return method_to_fun(janet_ckeywordv(name), x);
|
||||
}
|
||||
|
||||
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
|
||||
@@ -780,8 +798,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_compop( <=);
|
||||
|
||||
VM_OP(JOP_LESS_THAN_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) < CS);
|
||||
vm_pcnext();
|
||||
vm_compop_imm( <);
|
||||
|
||||
VM_OP(JOP_GREATER_THAN)
|
||||
vm_compop( >);
|
||||
@@ -790,15 +807,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_compop( >=);
|
||||
|
||||
VM_OP(JOP_GREATER_THAN_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) > CS);
|
||||
vm_pcnext();
|
||||
vm_compop_imm( >);
|
||||
|
||||
VM_OP(JOP_EQUALS)
|
||||
stack[A] = janet_wrap_boolean(janet_equals(stack[B], stack[C]));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS)
|
||||
@@ -806,7 +822,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) != CS);
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_COMPARE)
|
||||
@@ -815,7 +831,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
VM_OP(JOP_NEXT)
|
||||
vm_commit();
|
||||
stack[A] = janet_next(stack[B], stack[C]);
|
||||
{
|
||||
Janet temp = janet_next_impl(stack[B], stack[C], 1);
|
||||
vm_restore();
|
||||
stack[A] = temp;
|
||||
}
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_LOAD_NIL)
|
||||
@@ -1272,7 +1292,14 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
/* Push frame */
|
||||
janet_fiber_pushn(janet_vm_fiber, argv, argc);
|
||||
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
|
||||
janet_panicf("arity mismatch in %v", janet_wrap_function(fun));
|
||||
int32_t min = fun->def->min_arity;
|
||||
int32_t max = fun->def->max_arity;
|
||||
Janet funv = janet_wrap_function(fun);
|
||||
if (min == max && min != argc)
|
||||
janet_panicf("arity mismatch in %v, expected %d, got %d", funv, min, argc);
|
||||
if (min >= 0 && argc < min)
|
||||
janet_panicf("arity mismatch in %v, expected at least %d, got %d", funv, min, argc);
|
||||
janet_panicf("arity mismatch in %v, expected at most %d, got %d", funv, max, argc);
|
||||
}
|
||||
janet_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
|
||||
@@ -1341,18 +1368,42 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
|
||||
janet_fiber_did_resume(fiber);
|
||||
#endif
|
||||
|
||||
/* Clear last value */
|
||||
fiber->last_value = janet_wrap_nil();
|
||||
|
||||
/* Continue child fiber if it exists */
|
||||
if (fiber->child) {
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
JanetFiber *child = fiber->child;
|
||||
uint32_t instr = (janet_stack_frame(fiber->data + fiber->frame)->pc)[0];
|
||||
janet_vm_stackn++;
|
||||
JanetSignal sig = janet_continue(child, in, &in);
|
||||
janet_vm_stackn--;
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
*out = in;
|
||||
janet_fiber_set_status(fiber, sig);
|
||||
return sig;
|
||||
}
|
||||
/* Check if we need any special handling for certain opcodes */
|
||||
switch (instr & 0x7F) {
|
||||
default:
|
||||
break;
|
||||
case JOP_NEXT: {
|
||||
if (sig == JANET_SIGNAL_OK ||
|
||||
sig == JANET_SIGNAL_ERROR ||
|
||||
sig == JANET_SIGNAL_USER0 ||
|
||||
sig == JANET_SIGNAL_USER1 ||
|
||||
sig == JANET_SIGNAL_USER2 ||
|
||||
sig == JANET_SIGNAL_USER3 ||
|
||||
sig == JANET_SIGNAL_USER4) {
|
||||
in = janet_wrap_nil();
|
||||
} else {
|
||||
in = janet_wrap_integer(0);
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
fiber->child = NULL;
|
||||
}
|
||||
|
||||
@@ -1371,22 +1422,23 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
|
||||
|
||||
/* Save global state */
|
||||
JanetTryState tstate;
|
||||
JanetSignal signal = janet_try(&tstate);
|
||||
if (!signal) {
|
||||
JanetSignal sig = janet_try(&tstate);
|
||||
if (!sig) {
|
||||
/* Normal setup */
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
janet_vm_fiber = fiber;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
|
||||
signal = run_vm(fiber, in);
|
||||
sig = run_vm(fiber, in);
|
||||
}
|
||||
|
||||
/* Restore */
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
janet_fiber_set_status(fiber, signal);
|
||||
janet_fiber_set_status(fiber, sig);
|
||||
janet_restore(&tstate);
|
||||
fiber->last_value = tstate.payload;
|
||||
*out = tstate.payload;
|
||||
|
||||
return signal;
|
||||
return sig;
|
||||
}
|
||||
|
||||
/* Enter the main vm loop */
|
||||
@@ -1494,7 +1546,7 @@ int janet_init(void) {
|
||||
void janet_deinit(void) {
|
||||
janet_clear_memory();
|
||||
janet_symcache_deinit();
|
||||
free(janet_vm_roots);
|
||||
janet_free(janet_vm_roots);
|
||||
janet_vm_roots = NULL;
|
||||
janet_vm_root_count = 0;
|
||||
janet_vm_root_capacity = 0;
|
||||
@@ -1502,7 +1554,7 @@ void janet_deinit(void) {
|
||||
janet_vm_abstract_registry = NULL;
|
||||
janet_vm_core_env = NULL;
|
||||
janet_vm_top_dyns = NULL;
|
||||
free(janet_vm_traversal_base);
|
||||
janet_free(janet_vm_traversal_base);
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
#ifdef JANET_THREADS
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -162,7 +162,7 @@ Janet(janet_wrap_number)(double x) {
|
||||
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc((size_t) count * sizeof(JanetKV));
|
||||
void *mem = janet_malloc((size_t) count * sizeof(JanetKV));
|
||||
janet_vm_next_collection += (size_t) count * sizeof(JanetKV);
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -172,11 +172,6 @@ extern "C" {
|
||||
#define JANET_PEG
|
||||
#endif
|
||||
|
||||
/* Enable or disable the typedarray module */
|
||||
#ifndef JANET_NO_TYPED_ARRAY
|
||||
#define JANET_TYPED_ARRAY
|
||||
#endif
|
||||
|
||||
/* Enable or disable event loop */
|
||||
#if !defined(JANET_NO_EV) && !defined(__EMSCRIPTEN__)
|
||||
#define JANET_EV
|
||||
@@ -288,15 +283,21 @@ typedef struct {
|
||||
JANET_CURRENT_CONFIG_BITS })
|
||||
#endif
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/***** END SECTION CONFIG *****/
|
||||
|
||||
/***** START SECTION TYPES *****/
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
// Must be defined before including stdlib.h
|
||||
/* Must be defined before including stdlib.h */
|
||||
#define _CRT_RAND_S
|
||||
#endif
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
@@ -838,9 +839,15 @@ struct JanetFiber {
|
||||
JanetTable *env; /* Dynamic bindings table (usually current environment). */
|
||||
Janet *data; /* Dynamically resized stack memory */
|
||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||
Janet last_value; /* Last returned value from a fiber */
|
||||
#ifdef JANET_EV
|
||||
/* These fields are only relevant for fibers that are used as "root fibers" -
|
||||
* that is, fibers that are scheduled on the event loop and behave much like threads
|
||||
* in a multi-tasking system. It would be possible to move these fields to a new
|
||||
* type, say "JanetTask", that as separate from fibers to save a bit of space. */
|
||||
JanetListenerState *waiting;
|
||||
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
|
||||
void *supervisor_channel; /* Channel to push self to when complete */
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -1318,6 +1325,7 @@ typedef struct {
|
||||
#define JANET_EV_TCTAG_ERR_STRING 5 /* cancel with janet_cstringv((const char *) argp) */
|
||||
#define JANET_EV_TCTAG_ERR_STRINGF 6 /* cancel with janet_cstringv((const char *) argp), then call free on argp. */
|
||||
#define JANET_EV_TCTAG_ERR_KEYWORD 7 /* cancel with janet_ckeywordv((const char *) argp) */
|
||||
#define JANET_EV_TCTAG_BOOLEAN 8 /* resume with janet_wrap_boolean(argi) */
|
||||
|
||||
/* Function pointer that is run in the thread pool */
|
||||
typedef JanetEVGenericMessage(*JanetThreadedSubroutine)(JanetEVGenericMessage arguments);
|
||||
@@ -1327,7 +1335,7 @@ typedef void (*JanetThreadedCallback)(JanetEVGenericMessage return_value);
|
||||
|
||||
/* API calls for quickly offloading some work in C to a new thread or thread pool. */
|
||||
JANET_API void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb);
|
||||
JANET_API void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp);
|
||||
|
||||
/* Callback used by janet_ev_threaded_await */
|
||||
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
|
||||
@@ -1360,6 +1368,7 @@ JANET_API void janet_parser_deinit(JanetParser *parser);
|
||||
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
|
||||
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
|
||||
JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||
JANET_API Janet janet_parser_produce_wrapped(JanetParser *parser);
|
||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||
JANET_API void janet_parser_eof(JanetParser *parser);
|
||||
@@ -1396,9 +1405,15 @@ struct JanetCompileResult {
|
||||
enum JanetCompileStatus status;
|
||||
};
|
||||
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, JanetString where);
|
||||
JANET_API JanetCompileResult janet_compile_lint(
|
||||
Janet source,
|
||||
JanetTable *env,
|
||||
JanetString where,
|
||||
JanetArray *lints);
|
||||
|
||||
/* Get the default environment for janet */
|
||||
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
|
||||
|
||||
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
|
||||
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
||||
@@ -1621,6 +1636,7 @@ JANET_API Janet janet_wrap_number_safe(double x);
|
||||
JANET_API int janet_keyeq(Janet x, const char *cstring);
|
||||
JANET_API int janet_streq(Janet x, const char *cstring);
|
||||
JANET_API int janet_symeq(Janet x, const char *cstring);
|
||||
JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer);
|
||||
|
||||
/* VM functions */
|
||||
JANET_API int janet_init(void);
|
||||
@@ -1649,11 +1665,24 @@ typedef enum {
|
||||
JANET_BINDING_VAR,
|
||||
JANET_BINDING_MACRO
|
||||
} JanetBindingType;
|
||||
|
||||
typedef struct {
|
||||
JanetBindingType type;
|
||||
Janet value;
|
||||
enum {
|
||||
JANET_BINDING_DEP_NONE,
|
||||
JANET_BINDING_DEP_RELAXED,
|
||||
JANET_BINDING_DEP_NORMAL,
|
||||
JANET_BINDING_DEP_STRICT,
|
||||
} deprecation;
|
||||
} JanetBinding;
|
||||
|
||||
JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation);
|
||||
JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
|
||||
JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
|
||||
JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym);
|
||||
JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
/* Get values from the core environment. */
|
||||
@@ -1694,6 +1723,7 @@ JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max);
|
||||
JANET_API void janet_fixarity(int32_t arity, int32_t fix);
|
||||
|
||||
JANET_API int janet_getmethod(JanetKeyword method, const JanetMethod *methods, Janet *out);
|
||||
JANET_API Janet janet_nextmethod(const JanetMethod *methods, Janet key);
|
||||
|
||||
JANET_API double janet_getnumber(const Janet *argv, int32_t n);
|
||||
JANET_API JanetArray *janet_getarray(const Janet *argv, int32_t n);
|
||||
@@ -1771,6 +1801,7 @@ JANET_API FILE *janet_dynfile(const char *name, FILE *def);
|
||||
JANET_API JanetFile *janet_getjfile(const Janet *argv, int32_t n);
|
||||
JANET_API JanetAbstract janet_checkfile(Janet j);
|
||||
JANET_API FILE *janet_unwrapfile(Janet j, int32_t *flags);
|
||||
JANET_API int janet_file_close(JanetFile *file);
|
||||
|
||||
JANET_API int janet_cryptorand(uint8_t *out, size_t n);
|
||||
|
||||
@@ -1830,7 +1861,8 @@ typedef enum {
|
||||
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
|
||||
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
|
||||
RULE_LINE, /* [tag] */
|
||||
RULE_COLUMN /* [tag] */
|
||||
RULE_COLUMN, /* [tag] */
|
||||
RULE_UNREF /* [rule, tag] */
|
||||
} JanetPegOpcod;
|
||||
|
||||
typedef struct {
|
||||
@@ -1838,63 +1870,11 @@ typedef struct {
|
||||
Janet *constants;
|
||||
size_t bytecode_len;
|
||||
uint32_t num_constants;
|
||||
int has_backref;
|
||||
} JanetPeg;
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_ta_view_type;
|
||||
extern JANET_API const JanetAbstractType janet_ta_buffer_type;
|
||||
|
||||
typedef enum {
|
||||
JANET_TARRAY_TYPE_U8,
|
||||
JANET_TARRAY_TYPE_S8,
|
||||
JANET_TARRAY_TYPE_U16,
|
||||
JANET_TARRAY_TYPE_S16,
|
||||
JANET_TARRAY_TYPE_U32,
|
||||
JANET_TARRAY_TYPE_S32,
|
||||
JANET_TARRAY_TYPE_U64,
|
||||
JANET_TARRAY_TYPE_S64,
|
||||
JANET_TARRAY_TYPE_F32,
|
||||
JANET_TARRAY_TYPE_F64
|
||||
} JanetTArrayType;
|
||||
|
||||
typedef struct {
|
||||
uint8_t *data;
|
||||
size_t size;
|
||||
int32_t flags;
|
||||
} JanetTArrayBuffer;
|
||||
|
||||
typedef struct {
|
||||
union {
|
||||
void *pointer;
|
||||
uint8_t *u8;
|
||||
int8_t *s8;
|
||||
uint16_t *u16;
|
||||
int16_t *s16;
|
||||
uint32_t *u32;
|
||||
int32_t *s32;
|
||||
uint64_t *u64;
|
||||
int64_t *s64;
|
||||
float *f32;
|
||||
double *f64;
|
||||
} as;
|
||||
JanetTArrayBuffer *buffer;
|
||||
size_t size;
|
||||
size_t stride;
|
||||
JanetTArrayType type;
|
||||
} JanetTArrayView;
|
||||
|
||||
JANET_API JanetTArrayBuffer *janet_tarray_buffer(size_t size);
|
||||
JANET_API JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer);
|
||||
JANET_API int janet_is_tarray_view(Janet x, JanetTArrayType type);
|
||||
JANET_API JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n);
|
||||
JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type);
|
||||
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_s64_type;
|
||||
@@ -1926,6 +1906,24 @@ JANET_API JanetThread *janet_thread_current(void);
|
||||
|
||||
#endif
|
||||
|
||||
/* Custom allocator support */
|
||||
JANET_API void *(janet_malloc)(size_t);
|
||||
JANET_API void *(janet_realloc)(void *, size_t);
|
||||
JANET_API void *(janet_calloc)(size_t, size_t);
|
||||
JANET_API void (janet_free)(void *);
|
||||
#ifndef janet_malloc
|
||||
#define janet_malloc(X) malloc((X))
|
||||
#endif
|
||||
#ifndef janet_realloc
|
||||
#define janet_realloc(X, Y) realloc((X), (Y))
|
||||
#endif
|
||||
#ifndef janet_calloc
|
||||
#define janet_calloc(X, Y) calloc((X), (Y))
|
||||
#endif
|
||||
#ifndef janet_free
|
||||
#define janet_free(X) free((X))
|
||||
#endif
|
||||
|
||||
/***** END SECTION MAIN *****/
|
||||
|
||||
/* Re-enable popped variable length array warnings */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
@@ -152,7 +152,7 @@ static const char *badterms[] = {
|
||||
|
||||
static char *sdup(const char *s) {
|
||||
size_t len = strlen(s) + 1;
|
||||
char *mem = malloc(len);
|
||||
char *mem = janet_malloc(len);
|
||||
if (!mem) {
|
||||
return NULL;
|
||||
}
|
||||
@@ -300,7 +300,7 @@ static int insert(char c, int draw) {
|
||||
|
||||
static void historymove(int delta) {
|
||||
if (gbl_history_count > 1) {
|
||||
free(gbl_history[gbl_historyi]);
|
||||
janet_free(gbl_history[gbl_historyi]);
|
||||
gbl_history[gbl_historyi] = sdup(gbl_buf);
|
||||
|
||||
gbl_historyi += delta;
|
||||
@@ -326,7 +326,7 @@ static void addhistory(void) {
|
||||
gbl_history[gbl_history_count++] = newline;
|
||||
len++;
|
||||
} else {
|
||||
free(gbl_history[JANET_HISTORY_MAX - 1]);
|
||||
janet_free(gbl_history[JANET_HISTORY_MAX - 1]);
|
||||
}
|
||||
for (i = len - 1; i > 0; i--) {
|
||||
gbl_history[i] = gbl_history[i - 1];
|
||||
@@ -338,7 +338,7 @@ static void replacehistory(void) {
|
||||
/* History count is always > 0 here */
|
||||
if (gbl_len == 0 || (gbl_history_count > 1 && !strcmp(gbl_buf, gbl_history[1]))) {
|
||||
/* Delete history */
|
||||
free(gbl_history[0]);
|
||||
janet_free(gbl_history[0]);
|
||||
for (int i = 1; i < gbl_history_count; i++) {
|
||||
gbl_history[i - 1] = gbl_history[i];
|
||||
}
|
||||
@@ -346,7 +346,7 @@ static void replacehistory(void) {
|
||||
} else {
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
free(gbl_history[0]);
|
||||
janet_free(gbl_history[0]);
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
}
|
||||
@@ -934,7 +934,7 @@ void janet_line_deinit() {
|
||||
int i;
|
||||
norawmode();
|
||||
for (i = 0; i < gbl_history_count; i++)
|
||||
free(gbl_history[i]);
|
||||
janet_free(gbl_history[i]);
|
||||
gbl_historyi = 0;
|
||||
}
|
||||
|
||||
@@ -1042,19 +1042,23 @@ int main(int argc, char **argv) {
|
||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
||||
|
||||
/* Run startup script */
|
||||
Janet mainfun, out;
|
||||
Janet mainfun;
|
||||
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
|
||||
Janet mainargs[1] = { janet_wrap_array(args) };
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
|
||||
fiber->env = env;
|
||||
|
||||
#ifdef JANET_EV
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
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(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
status = JANET_SIGNAL_OK;
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
/* Deinitialize vm */
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
||||
@@ -2,20 +2,24 @@
|
||||
:name "testmod")
|
||||
|
||||
(declare-native
|
||||
:name "testmod"
|
||||
:source @["testmod.c"])
|
||||
:name "testmod"
|
||||
:source @["testmod.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod2"
|
||||
:source @["testmod2.c"])
|
||||
:name "testmod2"
|
||||
:source @["testmod2.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod3"
|
||||
:source @["testmod3.cpp"])
|
||||
:name "testmod3"
|
||||
:source @["testmod3.cpp"])
|
||||
|
||||
(declare-native
|
||||
:name "test-mod-4"
|
||||
:source @["testmod4.c"])
|
||||
:name "test-mod-4"
|
||||
:source @["testmod4.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod5"
|
||||
:source @["testmod5.cc"])
|
||||
|
||||
(declare-executable
|
||||
:name "testexec"
|
||||
|
||||
@@ -2,7 +2,8 @@
|
||||
(use /build/testmod2)
|
||||
(use /build/testmod3)
|
||||
(use /build/test-mod-4)
|
||||
(use /build/testmod5)
|
||||
|
||||
(defn main [&]
|
||||
(print "Hello from executable!")
|
||||
(print (+ (get5) (get6) (get7) (get8))))
|
||||
(print (+ (get5) (get6) (get7) (get8) (get9))))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
* Copyright (c) 2021 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
* Copyright (c) 2021 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
* Copyright (c) 2021 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
* Copyright (c) 2021 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
42
test/install/testmod5.cc
Normal file
42
test/install/testmod5.cc
Normal file
@@ -0,0 +1,42 @@
|
||||
/*
|
||||
* Copyright (c) 2021 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.
|
||||
*/
|
||||
|
||||
/* A very simple native module */
|
||||
|
||||
#include <janet.h>
|
||||
#include <iostream>
|
||||
|
||||
static Janet cfun_get_nine(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
std::cout << "Hello!" << std::endl;
|
||||
return janet_wrap_number(9.0);
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get9", cfun_get_nine, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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
|
||||
@@ -281,4 +281,38 @@
|
||||
(assert (not (even? -10.1)) "even? 8")
|
||||
(assert (not (even? -10.6)) "even? 9")
|
||||
|
||||
# Map arities
|
||||
(assert (deep= (map inc [1 2 3]) @[2 3 4]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30]) @[11 22 33]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]) @[1111 2222 3333]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000]) @[11111 22222 33333]))
|
||||
|
||||
# Sort function
|
||||
(assert (deep=
|
||||
(range 99)
|
||||
(sort (mapcat (fn [[x y z]] [z y x]) (partition 3 (range 99))))) "sort 5")
|
||||
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
|
||||
|
||||
# And and or
|
||||
|
||||
(assert (= (and true true) true) "and true true")
|
||||
(assert (= (and true false) false) "and true false")
|
||||
(assert (= (and false true) false) "and false true")
|
||||
(assert (= (and true true true) true) "and true true true")
|
||||
(assert (= (and 0 1 2) 2) "and 0 1 2")
|
||||
(assert (= (and 0 1 nil) nil) "and 0 1 nil")
|
||||
(assert (= (and 1) 1) "and 1")
|
||||
(assert (= (and) true) "and with no arguments")
|
||||
|
||||
(assert (= (or true true) true) "or true true")
|
||||
(assert (= (or true false) true) "or true false")
|
||||
(assert (= (or false true) true) "or false true")
|
||||
(assert (= (or false false) false) "or false true")
|
||||
(assert (= (or true true false) true) "or true true false")
|
||||
(assert (= (or 0 1 2) 0) "or 0 1 2")
|
||||
(assert (= (or nil 1 2) 1) "or nil 1 2")
|
||||
(assert (= (or 1) 1) "or 1")
|
||||
(assert (= (or) nil) "or with no arguments")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
#' Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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
|
||||
@@ -49,7 +49,7 @@
|
||||
# Generators
|
||||
(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
|
||||
(var gencount 0)
|
||||
(loop [x :generate gen]
|
||||
(loop [x :in gen]
|
||||
(++ gencount)
|
||||
(assert (pos? (% x 4)) "generate in loop"))
|
||||
(assert (= gencount 75) "generate loop count")
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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
|
||||
@@ -473,4 +473,24 @@
|
||||
|
||||
(check-deep '(* (int 2) -1) "123" nil)
|
||||
|
||||
# to/thru bug
|
||||
(check-deep '(to -1) "aaaa" @[])
|
||||
(check-deep '(thru -1) "aaaa" @[])
|
||||
(check-deep ''(to -1) "aaaa" @["aaaa"])
|
||||
(check-deep ''(thru -1) "aaaa" @["aaaa"])
|
||||
(check-deep '(to "b") "aaaa" nil)
|
||||
(check-deep '(thru "b") "aaaa" nil)
|
||||
|
||||
# unref
|
||||
(def grammar
|
||||
(peg/compile
|
||||
~{:main (* :tagged -1)
|
||||
:tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
|
||||
:open-tag (* (constant :tag) "<" (capture :w+ :tag-name) ">")
|
||||
:value (* (constant :value) (group (any (+ :tagged :untagged))))
|
||||
:close-tag (* "</" (backmatch :tag-name) ">")
|
||||
:untagged (capture (any (if-not "<" 1)))}))
|
||||
(check-deep grammar "<p><em>foobar</em></p>" @[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
|
||||
(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose
|
||||
# Copyright (c) 2021 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
|
||||
@@ -70,5 +70,17 @@
|
||||
(assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
|
||||
(assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
|
||||
|
||||
# Metadata
|
||||
|
||||
(def foo-with-tags :a-tag :bar)
|
||||
(assert (get (dyn 'foo-with-tags) :a-tag) "extra keywords in def are metadata tags")
|
||||
|
||||
(def foo-with-meta {:baz :quux} :bar)
|
||||
(assert (= :quux (get (dyn 'foo-with-meta) :baz)) "extra struct in def is metadata")
|
||||
|
||||
(defn foo-fn-with-meta {:baz :quux} "This is a function" [x] (identity x))
|
||||
(assert (= :quux (get (dyn 'foo-fn-with-meta) :baz)) "extra struct in defn is metadata")
|
||||
(assert (= "(foo-fn-with-meta x)\n\nThis is a function" (get (dyn 'foo-fn-with-meta) :doc)) "extra string in defn is docstring")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# Copyright (c) 2021 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
|
||||
@@ -21,54 +21,6 @@
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 5)
|
||||
|
||||
# some tests typed array
|
||||
|
||||
(defn inspect-tarray
|
||||
[x]
|
||||
(def a @[])
|
||||
(for i 0 (tarray/length x) (array/push a (x i)))
|
||||
(pp a))
|
||||
|
||||
(assert-no-error
|
||||
"create some typed arrays"
|
||||
(do
|
||||
(def a (tarray/new :float64 10))
|
||||
(def b (tarray/new :float64 5 2 0 a))
|
||||
(def c (tarray/new :uint32 20))))
|
||||
|
||||
(assert-no-error
|
||||
"create some typed arrays from a buffer"
|
||||
(do
|
||||
(def buf (tarray/buffer (+ 64 (* (+ 1 (* (- 10 1) 2)) 8))))
|
||||
(def b (tarray/new :float64 10 2 64 buf))))
|
||||
|
||||
(def a (tarray/new :float64 10))
|
||||
(def b (tarray/new :float64 5 2 0 a))
|
||||
|
||||
(assert-no-error
|
||||
"fill tarray"
|
||||
(for i 0 (tarray/length a)
|
||||
(set (a i) i)))
|
||||
|
||||
(assert (= (tarray/buffer a) (tarray/buffer b)) "tarray views pointing same buffer")
|
||||
(assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
|
||||
(assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
|
||||
(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
|
||||
(assert (= (:length a) (length a)) "length method and function")
|
||||
|
||||
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
|
||||
|
||||
# Issue 408
|
||||
(assert-error :invalid-type (tarray/new :int32 10 1 0 (int/u64 7)) "tarray/new should only allow tarray or buffer for last argument")
|
||||
(def ta (tarray/new :int32 10))
|
||||
(assert (= (next a nil) 0) "tarray next 1")
|
||||
(assert (= (next a 0) 1) "tarray next 2")
|
||||
(assert (= (next a 8) 9) "tarray next 3")
|
||||
(assert (nil? (next a 9)) "tarray next 4")
|
||||
(put ta 3 7)
|
||||
(put ta 9 7)
|
||||
(assert (= 2 (count |(= $ 7) ta)) "tarray count")
|
||||
|
||||
# Array remove
|
||||
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# Copyright (c) 2021 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
|
||||
@@ -72,22 +72,6 @@
|
||||
"trap INT64_MIN / -1"
|
||||
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
|
||||
|
||||
# int64 typed arrays
|
||||
(assert (let [t (tarray/new :int64 10)
|
||||
b (i64 1000)]
|
||||
(set (t 0) 1000)
|
||||
(set (t 1) b)
|
||||
(set (t 2) "1000")
|
||||
(set (t 3) (t 0))
|
||||
(set (t 4) (u64 1000))
|
||||
(and
|
||||
(= (t 0) (t 1))
|
||||
(= (t 1) (t 2))
|
||||
(= (t 2) (t 3))
|
||||
(= (t 3) (t 4))
|
||||
))
|
||||
"int64 typed arrays")
|
||||
|
||||
# Dynamic bindings
|
||||
(setdyn :a 10)
|
||||
(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")
|
||||
@@ -190,4 +174,39 @@
|
||||
(assert (= (test-expand "../def.txt" ":all:") "../def.txt") "module/expand-path 7")
|
||||
(assert (= (test-expand "../././././abcd/../def.txt" ":all:") "../def.txt") "module/expand-path 8")
|
||||
|
||||
# Integer type checks
|
||||
(assert (compare= 0 (- (int/u64 "1000") 1000)) "subtract from int/u64")
|
||||
|
||||
(assert (odd? (int/u64 "1001")) "odd? 1")
|
||||
(assert (not (odd? (int/u64 "1000"))) "odd? 2")
|
||||
(assert (odd? (int/s64 "1001")) "odd? 3")
|
||||
(assert (not (odd? (int/s64 "1000"))) "odd? 4")
|
||||
(assert (odd? (int/s64 "-1001")) "odd? 5")
|
||||
(assert (not (odd? (int/s64 "-1000"))) "odd? 6")
|
||||
|
||||
(assert (even? (int/u64 "1000")) "even? 1")
|
||||
(assert (not (even? (int/u64 "1001"))) "even? 2")
|
||||
(assert (even? (int/s64 "1000")) "even? 3")
|
||||
(assert (not (even? (int/s64 "1001"))) "even? 4")
|
||||
(assert (even? (int/s64 "-1000")) "even? 5")
|
||||
(assert (not (even? (int/s64 "-1001"))) "even? 6")
|
||||
|
||||
# integer type operations
|
||||
(defn modcheck [x y]
|
||||
(assert (= (string (mod x y)) (string (mod (int/s64 x) y)))
|
||||
(string "int/s64 (mod " x " " y ") expected " (mod x y) ", got "
|
||||
(mod (int/s64 x) y)))
|
||||
(assert (= (string (% x y)) (string (% (int/s64 x) y)))
|
||||
(string "int/s64 (% " x " " y ") expected " (% x y) ", got "
|
||||
(% (int/s64 x) y))))
|
||||
|
||||
(modcheck 1 2)
|
||||
(modcheck 1 3)
|
||||
(modcheck 4 2)
|
||||
(modcheck 4 1)
|
||||
(modcheck 10 3)
|
||||
(modcheck 10 -3)
|
||||
(modcheck -10 3)
|
||||
(modcheck -10 -3)
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# Copyright (c) 2021 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
|
||||
@@ -112,19 +112,6 @@
|
||||
(check-table-clone @{:a 123 :b 34 :c :hello : 945 0 1 2 3 4 5} "table/clone 1")
|
||||
(check-table-clone @{} "table/clone 1")
|
||||
|
||||
# Issue #142
|
||||
|
||||
(def buffer (tarray/buffer 8))
|
||||
(def buffer-float64-view (tarray/new :float64 1 1 0 buffer))
|
||||
(def buffer-uint32-view (tarray/new :uint32 2 1 0 buffer))
|
||||
|
||||
(set (buffer-uint32-view 1) 0xfffe9234)
|
||||
(set (buffer-uint32-view 0) 0x56789abc)
|
||||
|
||||
(assert (buffer-float64-view 0) "issue #142 nanbox hijack 1")
|
||||
(assert (= (type (buffer-float64-view 0)) :number) "issue #142 nanbox hijack 2")
|
||||
(assert (= (type (unmarshal @"\xC8\xbc\x9axV4\x92\xfe\xff")) :number) "issue #142 nanbox hijack 3")
|
||||
|
||||
# Make sure Carriage Returns don't end up in doc strings.
|
||||
|
||||
(assert (not (string/find "\r" (get ((fiber/getenv (fiber/current)) 'cond) :doc ""))) "no \\r in doc strings")
|
||||
@@ -320,4 +307,8 @@
|
||||
(array/push a x))
|
||||
(assert (deep= (range 4) a) "eachk 1")
|
||||
|
||||
|
||||
(tracev (def my-unique-var-name true))
|
||||
(assert my-unique-var-name "tracev upscopes")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# Copyright (c) 2021 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
|
||||
@@ -309,7 +309,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
# Issue 428
|
||||
(var result nil)
|
||||
(defn f [] (yield {:a :ok}))
|
||||
(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x)))
|
||||
(assert-no-error "issue 428 1" (loop [{:a x} :in (fiber/new f)] (set result x)))
|
||||
(assert (= result :ok) "issue 428 2")
|
||||
|
||||
# Inline 3 argument get
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# Copyright (c) 2021 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
|
||||
@@ -21,45 +21,125 @@
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 9)
|
||||
|
||||
# Subprocess
|
||||
|
||||
(def janet (dyn :executable))
|
||||
|
||||
(repeat 10
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(os/proc-wait p)
|
||||
(def x (:read (p :out) :all))
|
||||
(assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn pre close."))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(def x (:read (p :out) 1024))
|
||||
(os/proc-wait p)
|
||||
(assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn post close."))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px {:in :pipe})]
|
||||
(:write (p :in) "hello!\n")
|
||||
(assert-no-error "pipe stdin to process" (os/proc-wait p))))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px {:in :pipe :out :pipe})]
|
||||
(:write (p :in) "hello!\n")
|
||||
(def x (:read (p :out) 1024))
|
||||
(assert-no-error "pipe stdin to process 2" (os/proc-wait p))
|
||||
(assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
|
||||
|
||||
# Parallel subprocesses
|
||||
|
||||
(defn calc-1
|
||||
"Run subprocess, read from stdout, then wait on subprocess."
|
||||
[code]
|
||||
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
|
||||
(os/proc-wait p)
|
||||
(def output (:read (p :out) :all))
|
||||
(parse output)))
|
||||
|
||||
(assert
|
||||
(deep=
|
||||
(ev/gather
|
||||
(calc-1 "(+ 1 2 3 4)")
|
||||
(calc-1 "(+ 5 6 7 8)")
|
||||
(calc-1 "(+ 9 10 11 12)"))
|
||||
@[10 26 42]) "parallel subprocesses 1")
|
||||
|
||||
(defn calc-2
|
||||
"Run subprocess, wait on subprocess, then read from stdout. Read only up to 10 bytes instead of :all"
|
||||
[code]
|
||||
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
|
||||
(def output (:read (p :out) 10))
|
||||
(os/proc-wait p)
|
||||
(parse output)))
|
||||
|
||||
(assert
|
||||
(deep=
|
||||
(ev/gather
|
||||
(calc-2 "(+ 1 2 3 4)")
|
||||
(calc-2 "(+ 5 6 7 8)")
|
||||
(calc-2 "(+ 9 10 11 12)"))
|
||||
@[10 26 42]) "parallel subprocesses 2")
|
||||
|
||||
# File piping
|
||||
|
||||
(assert-no-error "file writing 1"
|
||||
(with [f (file/temp)]
|
||||
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
|
||||
|
||||
(assert-no-error "file writing 2"
|
||||
(with [f (file/open "unique.txt" :w)]
|
||||
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
|
||||
(file/flush f)))
|
||||
|
||||
# Issue #593
|
||||
(assert-no-error "file writing 3"
|
||||
(def outfile (file/open "unique.txt" :w))
|
||||
(os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p {:out outfile})
|
||||
(file/flush outfile)
|
||||
(file/close outfile)
|
||||
(os/rm "unique.txt"))
|
||||
|
||||
# ev/gather
|
||||
|
||||
(assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1")
|
||||
(assert (deep= @[] (ev/gather)) "ev/gather 2")
|
||||
(assert-error "ev/gather 3" (ev/gather 1 2 (error 3)))
|
||||
|
||||
# Net testing
|
||||
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(:read stream 1024 b)
|
||||
(:write stream b)
|
||||
(buffer/clear b)))
|
||||
(repeat 10
|
||||
|
||||
(def s (net/server "127.0.0.1" "8000" handler))
|
||||
(assert s "made server 1")
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(net/read stream 1024 b)
|
||||
(net/write stream b)
|
||||
(buffer/clear b)))
|
||||
|
||||
# We need some sleep for windows to let the server stabilize
|
||||
# or else the first read can fail. Might be a strange windows
|
||||
# "bug", but needs further investigating. Otherwise, `build_win test`
|
||||
# can sometimes fail on windows, leading to flaky testing.
|
||||
(ev/sleep 0.3)
|
||||
(def s (net/server "127.0.0.1" "8000" handler))
|
||||
(assert s "made server 1")
|
||||
|
||||
(defn test-echo [msg]
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(:write conn msg)
|
||||
(def res (:read conn 1024))
|
||||
(assert (= (string res) msg) (string "echo " msg))))
|
||||
(defn test-echo [msg]
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(net/write conn msg)
|
||||
(def res (net/read conn 1024))
|
||||
(assert (= (string res) msg) (string "echo " msg))))
|
||||
|
||||
(test-echo "hello")
|
||||
(test-echo "world")
|
||||
(test-echo (string/repeat "abcd" 200))
|
||||
(test-echo "hello")
|
||||
(test-echo "world")
|
||||
(test-echo (string/repeat "abcd" 200))
|
||||
|
||||
(:close s)
|
||||
(:close s))
|
||||
|
||||
# Create pipe
|
||||
|
||||
(var pipe-counter 0)
|
||||
(def chan (ev/chan 10))
|
||||
(let [[reader writer] (os/pipe)]
|
||||
(ev/sleep 0.3)
|
||||
(ev/spawn
|
||||
(while (ev/read reader 3)
|
||||
(++ pipe-counter))
|
||||
@@ -73,14 +153,14 @@
|
||||
(ev/take chan))
|
||||
|
||||
(var result nil)
|
||||
(def fiber
|
||||
(ev/spawn
|
||||
(set result (protect (ev/sleep 0.4)))
|
||||
(var fiber nil)
|
||||
(set fiber
|
||||
(ev/spawn
|
||||
(set result (protect (ev/sleep 10)))
|
||||
(assert (= result '(false "boop")) "ev/cancel 1")))
|
||||
(ev/sleep 0.1)
|
||||
(ev/sleep 0)
|
||||
(ev/cancel fiber "boop")
|
||||
(ev/sleep 0.1)
|
||||
|
||||
(assert-error "bad arity to ev/call" (ev/call inc 1 2 3))
|
||||
(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
# Copyright (c) 2021 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
|
||||
@@ -131,5 +131,34 @@
|
||||
(check-indent "\n Hello, world!\n dedented text\n " 4)
|
||||
(check-indent "\n Hello, world!\n indented text\n " 4)
|
||||
|
||||
# String bugs
|
||||
(assert (deep= (string/find-all "qq" "qqq") @[0 1]) "string/find-all 1")
|
||||
(assert (deep= (string/find-all "q" "qqq") @[0 1 2]) "string/find-all 2")
|
||||
(assert (deep= (string/split "qq" "1qqqqz") @["1" "" "z"]) "string/split 1")
|
||||
(assert (deep= (string/split "aa" "aaa") @["" "a"]) "string/split 2")
|
||||
|
||||
# Comparisons
|
||||
(assert (> 1e23 100) "less than immediate 1")
|
||||
(assert (> 1e23 1000) "less than immediate 2")
|
||||
(assert (< 100 1e23) "greater than immediate 1")
|
||||
(assert (< 1000 1e23) "greater than immediate 2")
|
||||
|
||||
# os/execute with environment variables
|
||||
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe {"HELLO" "WORLD"})) "os/execute with env")
|
||||
|
||||
# Regression #638
|
||||
(compwhen
|
||||
(dyn 'ev/go)
|
||||
(assert
|
||||
(= [true :caught]
|
||||
(protect
|
||||
(try
|
||||
(do
|
||||
(ev/sleep 0)
|
||||
(with-dyns []
|
||||
(ev/sleep 0)
|
||||
(error "oops")))
|
||||
([err] :caught))))
|
||||
"regression #638"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
Binary file not shown.
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 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
|
||||
|
||||
Reference in New Issue
Block a user