mirror of
https://github.com/janet-lang/janet
synced 2025-11-07 02:53:02 +00:00
Compare commits
149 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
da93a73dbd | ||
|
|
31f8778aa3 | ||
|
|
0ecd74d01d | ||
|
|
bd20b16a32 | ||
|
|
933f4b9111 | ||
|
|
3492ed6d88 | ||
|
|
e28262f5ab | ||
|
|
94246f7574 | ||
|
|
07b0ef1648 | ||
|
|
6a39c4b91d | ||
|
|
b9f0f14e31 | ||
|
|
4238379552 | ||
|
|
8cc43ad2d1 | ||
|
|
94b472df64 | ||
|
|
2b2c1ff917 | ||
|
|
c7912249b2 | ||
|
|
b8004555ea | ||
|
|
58ff7f0788 | ||
|
|
f1afc5b0b4 | ||
|
|
bc8ee207d5 | ||
|
|
76342540dc | ||
|
|
56784a34a1 | ||
|
|
eca42e98f6 | ||
|
|
c3f1b54171 | ||
|
|
9b7d642c38 | ||
|
|
f24e2f8706 | ||
|
|
aa7f3411f5 | ||
|
|
5b9eda5e87 | ||
|
|
7c2ae45809 | ||
|
|
36b2f27873 | ||
|
|
b8e02afd1a | ||
|
|
0fc36aa5d0 | ||
|
|
38f7e256d0 | ||
|
|
4187c972a3 | ||
|
|
2d5af32660 | ||
|
|
e592b24333 | ||
|
|
8700a407ce | ||
|
|
8ecf359bbe | ||
|
|
eb1988a5ae | ||
|
|
5b6dffe93d | ||
|
|
1a6eb52f11 | ||
|
|
57ccfb692c | ||
|
|
eb1c21b0da | ||
|
|
66d82c4513 | ||
|
|
c9c4424261 | ||
|
|
131733549d | ||
|
|
ee646dadf2 | ||
|
|
73f5314141 | ||
|
|
4c5734c2ee | ||
|
|
546669082f | ||
|
|
4a0ee5df7d | ||
|
|
4de6c2ad61 | ||
|
|
1fa7e73c58 | ||
|
|
0e690b4fa0 | ||
|
|
c804ae9f7c | ||
|
|
dbcceefc20 | ||
|
|
1a4035b02c | ||
|
|
e908029392 | ||
|
|
fd4220f254 | ||
|
|
de6c3d6d70 | ||
|
|
77cb823719 | ||
|
|
49954c7a30 | ||
|
|
11a7a7069a | ||
|
|
2487162ccf | ||
|
|
8ca10f37bd | ||
|
|
4199c42fe2 | ||
|
|
f39cf702db | ||
|
|
db9e431bf7 | ||
|
|
328454729e | ||
|
|
73a4c395d2 | ||
|
|
70328437f1 | ||
|
|
600bed9f6d | ||
|
|
55eca44c54 | ||
|
|
0ac5b243c7 | ||
|
|
9911c90b1d | ||
|
|
a1f35e21c7 | ||
|
|
9ccdab0bc7 | ||
|
|
a20e956f6d | ||
|
|
59668133a2 | ||
|
|
73db8584e0 | ||
|
|
cecc7e6b9d | ||
|
|
3a14aad615 | ||
|
|
8368e55151 | ||
|
|
ac85fca8a1 | ||
|
|
e5fbe5c557 | ||
|
|
474bcd50a1 | ||
|
|
70c8b6838d | ||
|
|
212479188a | ||
|
|
5b1e59b535 | ||
|
|
779d788efa | ||
|
|
6233d804c8 | ||
|
|
8f31a53276 | ||
|
|
6a763aac95 | ||
|
|
5cd6580c2d | ||
|
|
81a2af700a | ||
|
|
8a58be81ba | ||
|
|
fc53445d08 | ||
|
|
db261aabf4 | ||
|
|
36ef1c4749 | ||
|
|
5ae520a2c9 | ||
|
|
8e31bda8f6 | ||
|
|
474aed8cfe | ||
|
|
0509376aea | ||
|
|
570f04ca05 | ||
|
|
ded08b6e1e | ||
|
|
f3c0d9115f | ||
|
|
bf609445c1 | ||
|
|
13ef2bd905 | ||
|
|
4e4cdb6356 | ||
|
|
688d297a18 | ||
|
|
9e1c3e0f41 | ||
|
|
4acc63e325 | ||
|
|
967a8b5a70 | ||
|
|
92b7d91697 | ||
|
|
07db4c530e | ||
|
|
a3fb2d6e0a | ||
|
|
5b9e37e2cc | ||
|
|
88f28773da | ||
|
|
66e6979812 | ||
|
|
8a91c52fa2 | ||
|
|
e542ba7e4d | ||
|
|
bca0392738 | ||
|
|
74d51ab08b | ||
|
|
6bc400eb8c | ||
|
|
7df0ec6aed | ||
|
|
a0a980e0ef | ||
|
|
6988fd3cab | ||
|
|
c3273e8751 | ||
|
|
d37c43716a | ||
|
|
1bf751367b | ||
|
|
976dfc7195 | ||
|
|
8372d1e499 | ||
|
|
e65716f6ee | ||
|
|
4b24d77b2c | ||
|
|
02fc4ae27b | ||
|
|
624f5f428e | ||
|
|
5171dfd2a8 | ||
|
|
8ff5e49d1f | ||
|
|
134163708a | ||
|
|
40e6616df0 | ||
|
|
bcd2089f71 | ||
|
|
7553b277db | ||
|
|
d71cf093bb | ||
|
|
86d21816b6 | ||
|
|
c9521e093e | ||
|
|
16f6261b44 | ||
|
|
6b76ac3d18 | ||
|
|
5681e02e0f | ||
|
|
41a22f258e |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -13,6 +13,9 @@ janet
|
||||
janet-*.tar.gz
|
||||
dist
|
||||
|
||||
# Kakoune (fzf via fd)
|
||||
.fdignore
|
||||
|
||||
# VSCode
|
||||
.vscode
|
||||
|
||||
|
||||
51
CHANGELOG.md
51
CHANGELOG.md
@@ -1,11 +1,56 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
### 1.6.0 - 2019-12-22
|
||||
- Add `thread/` module to the core.
|
||||
- Allow seeding RNGs with any sequence of bytes. This provides
|
||||
a wider key space for the RNG. Exposed in C as `janet_rng_longseed`.
|
||||
- Fix issue in `resume` and similar functions that could cause breakpoints to be skipped.
|
||||
- Add a number of new math functions.
|
||||
- Improve debugger experience and capabilities. See examples/debugger.janet
|
||||
for what an interactive debugger could look like.
|
||||
- Add `debug/step` (janet\_step in the C API) for single stepping Janet bytecode.
|
||||
- The built in repl now can enter the debugger on any signal (errors, yields,
|
||||
user signals, and debug signals). To enable this, type (setdyn :debug true)
|
||||
in the repl environment.
|
||||
- When exiting the debugger, the fiber being debugged is resumed with the exit value
|
||||
of the debug session (the value returned by `(quit return-value)`, or nil if user typed Ctrl-D).
|
||||
- `(quit)` can take an optional argument that is the return value. If a module
|
||||
contains `(quit some-value)`, the value of that module returned to `(require "somemod")`
|
||||
is the return value. This lets module writers completely customize a module without writing
|
||||
a loader.
|
||||
- Add nested quasiquotation.
|
||||
- Add `os/cryptorand`
|
||||
- Add `prinf` and `eprinf` to be have like `printf` and `eprintf`. The latter two functions
|
||||
now including a trailing newline, like the other print functions.
|
||||
- Add nan?
|
||||
- Add `janet_in` to C API.
|
||||
- Add `truthy?`
|
||||
- Add `os/environ`
|
||||
- Add `buffer/fill` and `array/fill`
|
||||
- Add `array/new-filled`
|
||||
- Use `(doc)` with no arguments to see available bindings and dynamic bindings.
|
||||
- `jpm` will use `CC` and `AR` environment variables when compiling programs.
|
||||
- Add `comptime` macro for compile time evaluation.
|
||||
- Run `main` functions in scripts if they exist, just like jpm standalone binaries.
|
||||
- Add `protect` macro.
|
||||
- Add `root-env` to get the root environment table.
|
||||
- Change marshalling protocol with regard to abstract types.
|
||||
- Add `show-paths` to `jpm`.
|
||||
- Add several default patterns, like `:d` and `:s+`, to PEGs.
|
||||
- Update `jpm` path settings to make using `jpm` easier on non-global module trees.
|
||||
- Numerous small bug fixes and usability improvements.
|
||||
|
||||
### 1.5.1 - 2019-11-16
|
||||
- Fix bug when printing buffer to self in some edge cases.
|
||||
- Fix bug with `jpm` on windows.
|
||||
- Fix `update` return value.
|
||||
|
||||
## 1.5.0 - 2019-11-10
|
||||
- `os/date` now defaults to UTC.
|
||||
- Add `--test` flag to jpm to test libraries on installation.
|
||||
- Add `math/rng`, `math/rng-int`, and `math/rng-uniform`.
|
||||
- Add `in` function to index in a stricter manner. Opposingly, `get` will
|
||||
- Add `in` function to index in a stricter manner. Conversely, `get` will
|
||||
now not throw errors on bad keys.
|
||||
- Indexed types and byte sequences will now error when indexed out of range or
|
||||
with bad keys.
|
||||
@@ -13,11 +58,11 @@ All notable changes to this project will be documented in this file.
|
||||
and `math/seedrandom` with a consistent, platform independent RNG.
|
||||
- Add `with-vars` macro.
|
||||
- Add the `quickbin` command to jpm.
|
||||
- Create shell.c when making the amlagamated source. This can be compiled with
|
||||
- Create shell.c when making the amalgamated source. This can be compiled with
|
||||
janet.c to make the janet interpreter.
|
||||
- Add `cli-main` function to the core, which invokes Janet's CLI interface.
|
||||
This basically moves what was init.janet into boot.janet.
|
||||
- Improve flychecking, and fix flyching bugs introduced in 1.4.0.
|
||||
- Improve flychecking, and fix flychecking bugs introduced in 1.4.0.
|
||||
- Add `prin`, `eprint`, `eprintf` and `eprin` functions. The
|
||||
functions prefix with e print to `(dyn :err stderr)`
|
||||
- Print family of functions can now also print to buffers
|
||||
|
||||
9
Makefile
9
Makefile
@@ -27,8 +27,8 @@ PREFIX?=/usr/local
|
||||
INCLUDEDIR?=$(PREFIX)/include
|
||||
BINDIR?=$(PREFIX)/bin
|
||||
LIBDIR?=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
||||
CLIBS=-lm
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || 'local')\""
|
||||
CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
@@ -106,6 +106,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/struct.c \
|
||||
src/core/symcache.c \
|
||||
src/core/table.c \
|
||||
src/core/thread.c \
|
||||
src/core/tuple.c \
|
||||
src/core/typedarray.c \
|
||||
src/core/util.c \
|
||||
@@ -248,10 +249,12 @@ valgrind: $(JANET_TARGET)
|
||||
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
$(JANET_TARGET) -k auxbin/jpm
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
./$(JANET_TARGET) -k auxbin/jpm
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k auxbin/jpm
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
|
||||
@@ -155,7 +155,8 @@ ninja -C build install
|
||||
Janet can be hacked on with pretty much any environment you like, but for IDE
|
||||
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
|
||||
best option, as it has excellent meson integration. It also offers code completion
|
||||
for Janet's C API right out of the box, which is very useful for exploring.
|
||||
for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim,
|
||||
Emacs, and Atom will have syntax packages for the Janet language, though.
|
||||
|
||||
## Installation
|
||||
|
||||
|
||||
@@ -30,7 +30,7 @@ install:
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||
- build_win test-install
|
||||
- set janet_outname=%appveyor_repo_tag_name%
|
||||
- if "%janet_outname%"=="" set janet_outname=v1.5.0
|
||||
- if "%janet_outname%"=="" set janet_outname=v1.6.0
|
||||
build: off
|
||||
|
||||
artifacts:
|
||||
@@ -49,8 +49,8 @@ artifacts:
|
||||
- name: "janet-$(janet_outname)-windows-%platform%"
|
||||
path: dist
|
||||
type: Zip
|
||||
- path: "janet-$(janet_outname)-windows-%platform%-installer.exe"
|
||||
name: "janet-$(janet_outname)-windows-installer.exe"
|
||||
- path: "janet-$(janet_outname)-windows-installer.exe"
|
||||
name: "janet-$(janet_outname)-windows-%platform%-installer.exe"
|
||||
type: File
|
||||
|
||||
deploy:
|
||||
@@ -58,7 +58,7 @@ deploy:
|
||||
provider: GitHub
|
||||
auth_token:
|
||||
secure: lwEXy09qhj2jSH9s1C/KvCkAUqJSma8phFR+0kbsfUc3rVxpNK5uD3z9Md0SjYRx
|
||||
artifact: /janet.*/
|
||||
artifact: /(janet|shell).*/
|
||||
draft: true
|
||||
on:
|
||||
APPVEYOR_REPO_TAG: true
|
||||
|
||||
135
auxbin/jpm
135
auxbin/jpm
@@ -93,24 +93,35 @@
|
||||
# Configuration
|
||||
#
|
||||
|
||||
(def- exe-dir
|
||||
"Directory containing jpm script"
|
||||
(do
|
||||
(def exe (dyn :current-file))
|
||||
(def i (last (string/find-all sep exe)))
|
||||
(slice exe 0 i)))
|
||||
|
||||
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
|
||||
|
||||
# Default based on janet binary location
|
||||
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
|
||||
(if-let [j (dyn :syspath)]
|
||||
(string j "/../../include/janet"))))
|
||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
|
||||
(if-let [j (dyn :syspath)]
|
||||
(string j "/../../bin"))))
|
||||
(string exe-dir "/../include/janet")))
|
||||
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
|
||||
(if-let [j (dyn :syspath)]
|
||||
(string j "/.."))))
|
||||
(string exe-dir "/../lib")))
|
||||
|
||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
|
||||
(string (dyn :syspath) "/bin")))
|
||||
|
||||
#
|
||||
# Compilation Defaults
|
||||
#
|
||||
|
||||
(def default-compiler (if is-win "cl" "cc"))
|
||||
(def default-linker (if is-win "link" "cc"))
|
||||
(def default-archiver (if is-win "lib" "ar"))
|
||||
(def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc")))
|
||||
(def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc")))
|
||||
(def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar")))
|
||||
|
||||
# Detect threads
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def threads? (not (not (env 'thread/new))))
|
||||
|
||||
# Default flags for natives, but not required
|
||||
(def default-lflags (if is-win ["/nologo"] []))
|
||||
@@ -119,6 +130,10 @@
|
||||
["/nologo" "/MD"]
|
||||
["-std=c99" "-Wall" "-Wextra"]))
|
||||
|
||||
|
||||
# Link to pthreads
|
||||
(def- thread-flags (if is-win [] (if threads? ["-lpthread"] [])))
|
||||
|
||||
# Required flags for dynamic libraries. These
|
||||
# are used no matter what for dynamic libraries.
|
||||
(def- dynamic-cflags
|
||||
@@ -127,10 +142,10 @@
|
||||
["-fPIC"]))
|
||||
(def- dynamic-lflags
|
||||
(if is-win
|
||||
["/DLL"]
|
||||
["/DLL" ;thread-flags]
|
||||
(if is-mac
|
||||
["-shared" "-undefined" "dynamic_lookup"]
|
||||
["-shared"])))
|
||||
["-shared" "-undefined" "dynamic_lookup" ;thread-flags]
|
||||
["-shared" ;thread-flags])))
|
||||
|
||||
(defn- opt
|
||||
"Get an option, allowing overrides via dynamic bindings AND some
|
||||
@@ -211,21 +226,37 @@
|
||||
(defn rm
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(if (= (os/stat path :mode) :directory)
|
||||
(do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path)))
|
||||
(try
|
||||
(if (= (os/stat path :mode) :directory)
|
||||
(do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path))
|
||||
([err f] (unless (string/has-prefix? "No such file or directory" err)
|
||||
(propagate err f)))))
|
||||
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
[src dest]
|
||||
(print "copying " src " to " dest "...")
|
||||
(if is-win
|
||||
(shell "xcopy" src dest "/y" "/s" "/e")
|
||||
(let [end (last (peg/match path-splitter src))
|
||||
isdir (= (os/stat src :mode) :directory)]
|
||||
(shell "xcopy" src (if isdir (string dest "\\" end) dest) "/y" "/s" "/e" "/i"))
|
||||
(shell "cp" "-rf" src dest)))
|
||||
|
||||
(defn mkdir
|
||||
"Create a directory if it doesn't exist. If it does exist, do nothing.
|
||||
If we can't create it, give a friendly error. Return true if created, false if
|
||||
existing. Throw an error if we can't create it."
|
||||
[dir]
|
||||
(if (os/mkdir dir)
|
||||
true
|
||||
(if (os/stat dir :mode)
|
||||
false
|
||||
(error (string "Could not create " dir " - this could be a permission issue.")))))
|
||||
|
||||
#
|
||||
# C Compilation
|
||||
#
|
||||
@@ -310,7 +341,7 @@
|
||||
(defn- link-c
|
||||
"Link object files together to make a native module."
|
||||
[opts target & objects]
|
||||
(def ld (opt opts :linker default-linker))
|
||||
(def linker (opt opts (if is-win :linker :compiler) default-linker))
|
||||
(def cflags (getcflags opts))
|
||||
(def lflags [;(opt opts :lflags default-lflags)
|
||||
;(if (opts :static) [] dynamic-lflags)])
|
||||
@@ -318,8 +349,8 @@
|
||||
(check-cc)
|
||||
(print "linking " target "...")
|
||||
(if is-win
|
||||
(shell ld ;lflags (string "/OUT:" target) ;objects (win-import-library))
|
||||
(shell ld ;cflags `-o` target ;objects ;lflags))))
|
||||
(shell linker ;lflags (string "/OUT:" target) ;objects (win-import-library))
|
||||
(shell linker ;cflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- archive-c
|
||||
"Link object files together to make a static library."
|
||||
@@ -456,6 +487,10 @@ int main(int argc, const char **argv) {
|
||||
fprintf(stderr, "invalid bytecode image - expected function.");
|
||||
return 1;
|
||||
}
|
||||
JanetFunction *jfunc = janet_unwrap_function(marsh_out);
|
||||
|
||||
/* Check arity */
|
||||
janet_arity(argc, jfunc->def->min_arity, jfunc->def->max_arity);
|
||||
|
||||
/* Collect command line arguments */
|
||||
JanetArray *args = janet_array(argc);
|
||||
@@ -473,7 +508,7 @@ int main(int argc, const char **argv) {
|
||||
janet_gcunlock(handle);
|
||||
|
||||
/* Run everything */
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(marsh_out), 64, argc, args->data);
|
||||
JanetFiber *fiber = janet_fiber(jfunc, 64, argc, argc ? args->data : NULL);
|
||||
fiber->env = temptab;
|
||||
Janet out;
|
||||
JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
@@ -491,11 +526,11 @@ int main(int argc, const char **argv) {
|
||||
# Compile and link final exectable
|
||||
(do
|
||||
(def extra-lflags (case (os/which)
|
||||
:macos ["-ldl" "-lm"]
|
||||
:windows []
|
||||
:linux ["-lm" "-ldl" "-lrt"]
|
||||
:macos ["-ldl" "-lm" ;thread-flags]
|
||||
:windows [;thread-flags]
|
||||
:linux ["-lm" "-ldl" "-lrt" ;thread-flags]
|
||||
#default
|
||||
["-lm"]))
|
||||
["-lm" ;thread-flags]))
|
||||
(def cc (opt opts :compiler default-compiler))
|
||||
(def lflags [;dep-lflags ;(opt opts :lflags default-lflags) ;extra-lflags])
|
||||
(def cflags (getcflags opts))
|
||||
@@ -546,9 +581,7 @@ int main(int argc, const char **argv) {
|
||||
(def path ((string/split "\n" line) 0))
|
||||
(def path ((string/split "\r" path) 0))
|
||||
(print "removing " path)
|
||||
(try (rm path) ([err]
|
||||
(unless (= err "No such file or directory")
|
||||
(error err)))))
|
||||
(rm path))
|
||||
(:close f)
|
||||
(print "removing " manifest)
|
||||
(rm manifest)
|
||||
@@ -569,17 +602,17 @@ int main(int argc, const char **argv) {
|
||||
|
||||
(defn install-git
|
||||
"Install a bundle from git. If the bundle is already installed, the bundle
|
||||
is reinistalled (but not rebuilt if artifacts are cached)."
|
||||
is reinistalled (but not rebuilt if artifacts are cached)."
|
||||
[repotab &opt recurse]
|
||||
(def repo (if (string? repotab) repotab (repotab :repo)))
|
||||
(def tag (unless (string? repotab) (repotab :tag)))
|
||||
# prevent infinite recursion (very unlikely, but consider
|
||||
# prevent infinite recursion (very unlikely, but consider
|
||||
# 'my-package "my-package" in the package listing)
|
||||
(when (> (or recurse 0) 100)
|
||||
(error "too many references resolving package url"))
|
||||
# Handle short names
|
||||
(unless (string/find ":" repo)
|
||||
(def pkgs
|
||||
(def pkgs
|
||||
(try (require "pkgs")
|
||||
([err f]
|
||||
(install-git (dyn :pkglist default-pkglist))
|
||||
@@ -591,13 +624,14 @@ int main(int argc, const char **argv) {
|
||||
(error (string "expected string or table for repository, got " next-repo)))
|
||||
(break (install-git next-repo (if recurse (inc recurse) 0))))
|
||||
(def cache (find-cache))
|
||||
(os/mkdir cache)
|
||||
(mkdir cache)
|
||||
(def id (filepath-replace repo))
|
||||
(def module-dir (string cache sep id))
|
||||
(var fresh false)
|
||||
(when (os/mkdir module-dir)
|
||||
(set fresh true)
|
||||
(os/execute ["git" "clone" repo module-dir] :p))
|
||||
(when (mkdir module-dir)
|
||||
(set fresh true)
|
||||
(print "cloning repository " repo " to " module-dir)
|
||||
(os/execute ["git" "clone" repo module-dir] :p))
|
||||
(def olddir (os/cwd))
|
||||
(try
|
||||
(with-dyns [:rules @{}
|
||||
@@ -626,7 +660,7 @@ int main(int argc, const char **argv) {
|
||||
(def path (string destdir sep name))
|
||||
(array/push (dyn :installed-files) path)
|
||||
(add-body "install"
|
||||
(os/mkdir destdir)
|
||||
(mkdir destdir)
|
||||
(copy src destdir)))
|
||||
|
||||
#
|
||||
@@ -668,7 +702,7 @@ int main(int argc, const char **argv) {
|
||||
"# Metadata for static library %s\n\n%.20p"
|
||||
(string name statext)
|
||||
{:static-entry ename
|
||||
:lflags (opts :lflags)})))
|
||||
:lflags ~',(opts :lflags)})))
|
||||
(add-dep "build" metaname)
|
||||
(install-rule metaname path)
|
||||
|
||||
@@ -767,12 +801,12 @@ int main(int argc, const char **argv) {
|
||||
(setdyn :manifest-dir manifests)
|
||||
(setdyn :installed-files installed-files)
|
||||
|
||||
(rule "./build" [] (os/mkdir "build"))
|
||||
(rule "./build" [] (mkdir "build"))
|
||||
(phony "build" ["./build"])
|
||||
|
||||
(phony "manifest" []
|
||||
(print "generating " manifest "...")
|
||||
(os/mkdir manifests)
|
||||
(mkdir manifests)
|
||||
(spit manifest (string (string/join installed-files "\n") "\n")))
|
||||
(phony "install" ["uninstall" "build" "manifest"]
|
||||
(when (dyn :test)
|
||||
@@ -837,6 +871,7 @@ Subcommands are:
|
||||
and install the current project.
|
||||
uninstall (module) : uninstall a module. If no module is given, uninstall the module
|
||||
defined by the current directory.
|
||||
show-paths : prints the paths that will be used to install things.
|
||||
clean : remove any generated files or artifacts
|
||||
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
|
||||
deps : install dependencies for the current project.
|
||||
@@ -852,9 +887,10 @@ Keys are:
|
||||
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH.
|
||||
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
|
||||
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
|
||||
--compiler : C compiler to use for natives. Defaults to cc (cl on windows).
|
||||
--archiver : C compiler to use for static libraries. Defaults to ar (lib on windows).
|
||||
--linker : C linker to use for linking natives. Defaults to cc (link on windows).
|
||||
--compiler : C compiler to use for natives. Defaults to $CC or cc (cl.exe on windows).
|
||||
--archiver : C compiler to use for static libraries. Defaults to $AR ar (lib.exe on windows).
|
||||
--linker : C linker to use for linking natives. Defaults to link.exe on windows, not used on
|
||||
other platforms.
|
||||
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git
|
||||
|
||||
Flags are:
|
||||
@@ -866,6 +902,14 @@ Flags are:
|
||||
[]
|
||||
(print help))
|
||||
|
||||
(defn- show-paths
|
||||
[]
|
||||
(print "binpath: " (dyn :binpath JANET_BINPATH))
|
||||
(print "modpath: " (dyn :modpath JANET_MODPATH))
|
||||
(print "libpath: " (dyn :libpath JANET_LIBPATH))
|
||||
(print "headerpath: " (dyn :headerpath JANET_HEADERPATH))
|
||||
(print "syspath: " (dyn :syspath)))
|
||||
|
||||
(defn- build
|
||||
[]
|
||||
(local-rule "build"))
|
||||
@@ -917,6 +961,7 @@ Flags are:
|
||||
"test" test
|
||||
"help" help
|
||||
"deps" deps
|
||||
"show-paths" show-paths
|
||||
"clear-cache" clear-cache
|
||||
"run" local-rule
|
||||
"rules" list-rules
|
||||
|
||||
@@ -157,7 +157,12 @@ copy auxbin\jpm dist\jpm
|
||||
copy tools\jpm.bat dist\jpm.bat
|
||||
|
||||
@rem Create installer
|
||||
"C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
||||
janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt
|
||||
janet.exe -e "(print (= (os/arch) :x64))" > build\64bit.txt
|
||||
set /p JANET_VERSION= < build\version.txt
|
||||
set /p SIXTYFOUR= < build\64bit.txt
|
||||
echo "JANET_VERSION is %JANET_VERSION%"
|
||||
"C:\Program Files (x86)\NSIS\makensis.exe" /DVERSION=%JANET_VERSION% /DSIXTYFOUR=%SIXTYFOUR% janet-installer.nsi
|
||||
exit /b 0
|
||||
|
||||
@rem Run the installer. (Installs to the local user with default settings)
|
||||
|
||||
11
examples/debug.janet
Normal file
11
examples/debug.janet
Normal file
@@ -0,0 +1,11 @@
|
||||
# Load this file and run (myfn) to see the debugger
|
||||
|
||||
(defn myfn
|
||||
[]
|
||||
(debug)
|
||||
(for i 0 10 (print i)))
|
||||
|
||||
(debug/fbreak myfn 3)
|
||||
|
||||
# Enable debugging in repl with
|
||||
# (setdyn :debug true)
|
||||
153
examples/debugger.janet
Normal file
153
examples/debugger.janet
Normal file
@@ -0,0 +1,153 @@
|
||||
###
|
||||
### A useful debugger library for Janet. Should be used
|
||||
### inside a debug repl.
|
||||
###
|
||||
|
||||
(defn .fiber
|
||||
"Get the current fiber being debugged."
|
||||
[]
|
||||
(if-let [entry (dyn '_fiber)]
|
||||
(entry :value)
|
||||
(dyn :fiber)))
|
||||
|
||||
(defn .stack
|
||||
"Print the current fiber stack"
|
||||
[]
|
||||
(print)
|
||||
(debug/stacktrace (.fiber) "")
|
||||
(print))
|
||||
|
||||
(defn .frame
|
||||
"Show a stack frame"
|
||||
[&opt n]
|
||||
(def stack (debug/stack (.fiber)))
|
||||
(in stack (or n 0)))
|
||||
|
||||
(defn .fn
|
||||
"Get the current function"
|
||||
[&opt n]
|
||||
(in (.frame n) :function))
|
||||
|
||||
(defn .slots
|
||||
"Get an array of slots in a stack frame"
|
||||
[&opt n]
|
||||
(in (.frame n) :slots))
|
||||
|
||||
(defn .slot
|
||||
"Get the value of the nth slot."
|
||||
[&opt nth frame-idx]
|
||||
(in (.slots frame-idx) (or nth 0)))
|
||||
|
||||
(defn .quit
|
||||
"Resume (dyn :fiber) with the value passed to it after exiting the debugger."
|
||||
[&opt val]
|
||||
(setdyn :exit true)
|
||||
(setdyn :resume-value val)
|
||||
nil)
|
||||
|
||||
(defn .disasm
|
||||
"Gets the assembly for the current function."
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(disasm func))
|
||||
|
||||
(defn .bytecode
|
||||
"Get the bytecode for the current function."
|
||||
[&opt n]
|
||||
((.disasm n) 'bytecode))
|
||||
|
||||
(defn .ppasm
|
||||
"Pretty prints the assembly for the current function"
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(def dasm (disasm func))
|
||||
(def bytecode (dasm 'bytecode))
|
||||
(def pc (frame :pc))
|
||||
(def sourcemap (dasm 'sourcemap))
|
||||
(var last-loc [-2 -2])
|
||||
(print "\n function: " (dasm 'name) " [" (in dasm 'source "") "]")
|
||||
(when-let [constants (dasm 'constants)]
|
||||
(printf " constants: %.4Q" constants))
|
||||
(printf " slots: %.4Q\n" (frame :slots))
|
||||
(def padding (string/repeat " " 20))
|
||||
(loop [i :range [0 (length bytecode)]
|
||||
:let [instr (bytecode i)]]
|
||||
(prin (if (= (tuple/type instr) :brackets) "*" " "))
|
||||
(prin (if (= i pc) "> " " "))
|
||||
(prinf "\e[33m%.20s\e[0m" (string (string/join (map string instr) " ") padding))
|
||||
(when sourcemap
|
||||
(let [[sl sc] (sourcemap i)
|
||||
loc [sl sc]]
|
||||
(when (not= loc last-loc)
|
||||
(set last-loc loc)
|
||||
(prin " # line " sl ", column " sc))))
|
||||
(print))
|
||||
(print))
|
||||
|
||||
(defn .source
|
||||
"Show the source code for the function being debugged."
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def s (frame :source))
|
||||
(def all-source (slurp s))
|
||||
(print "\n\e[33m" all-source "\e[0m\n"))
|
||||
|
||||
(defn .breakall
|
||||
"Set breakpoints on all instructions in the current function."
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(for i 0 (length bytecode)
|
||||
(debug/fbreak fun i))
|
||||
(print "Set " (length bytecode) " breakpoints in " fun))
|
||||
|
||||
(defn .clearall
|
||||
"Clear all breakpoints on the current function."
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(for i 0 (length bytecode)
|
||||
(debug/unfbreak fun i))
|
||||
(print "Cleared " (length bytecode) " breakpoints in " fun))
|
||||
|
||||
(defn .break
|
||||
"Set breakpoint at the current pc."
|
||||
[]
|
||||
(def frame (.frame))
|
||||
(def fun (frame :function))
|
||||
(def pc (frame :pc))
|
||||
(debug/fbreak fun pc)
|
||||
(print "Set breakpoint in " fun " at pc=" pc))
|
||||
|
||||
(defn .clear
|
||||
"Clear the current breakpoint"
|
||||
[]
|
||||
(def frame (.frame))
|
||||
(def fun (frame :function))
|
||||
(def pc (frame :pc))
|
||||
(debug/unfbreak fun pc)
|
||||
(print "Cleared breakpoint in " fun " at pc=" pc))
|
||||
|
||||
(defn .next
|
||||
"Go to the next breakpoint."
|
||||
[&opt n]
|
||||
(var res nil)
|
||||
(for i 0 (or n 1)
|
||||
(set res (resume (.fiber))))
|
||||
res)
|
||||
|
||||
(defn .nextc
|
||||
"Go to the next breakpoint, clearing the current breakpoint."
|
||||
[&opt n]
|
||||
(.clear)
|
||||
(.next n))
|
||||
|
||||
(defn .step
|
||||
"Execute the next n instructions."
|
||||
[&opt n]
|
||||
(var res nil)
|
||||
(for i 0 (or n 1)
|
||||
(set res (debug/step (.fiber))))
|
||||
res)
|
||||
11
examples/rtest.janet
Normal file
11
examples/rtest.janet
Normal file
@@ -0,0 +1,11 @@
|
||||
# How random is the RNG really?
|
||||
|
||||
(def counts (seq [_ :range [0 100]] 0))
|
||||
|
||||
(for i 0 1000000
|
||||
(let [x (math/random)
|
||||
intrange (math/floor (* 100 x))
|
||||
oldcount (counts intrange)]
|
||||
(put counts intrange (if oldcount (+ 1 oldcount) 1))))
|
||||
|
||||
(pp counts)
|
||||
@@ -1,7 +1,5 @@
|
||||
# naive matrix implementation for testing typed array
|
||||
|
||||
(defmacro printf [& xs] ['print ['string/format (splice xs)]])
|
||||
|
||||
(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
|
||||
|
||||
(defn matrix/row [mat i]
|
||||
@@ -34,22 +32,21 @@
|
||||
((matrix/row mat i) j))
|
||||
|
||||
(defn matrix/get** [mat i j value]
|
||||
((matrix/column j) i))
|
||||
((matrix/column mat j) i))
|
||||
|
||||
|
||||
(defn tarray/print [array]
|
||||
(def size (tarray/length array))
|
||||
(def buf @"")
|
||||
(buffer/format buf "[%2i]" size)
|
||||
(defn tarray/print [arr]
|
||||
(def size (tarray/length arr))
|
||||
(prinf "[%2i]" size)
|
||||
(for i 0 size
|
||||
(buffer/format buf " %+6.3f " (array i)))
|
||||
(print buf))
|
||||
|
||||
(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))))
|
||||
(tarray/print (matrix/row mat i))))
|
||||
|
||||
|
||||
(def nr 5)
|
||||
@@ -57,27 +54,20 @@
|
||||
(def A (matrix nr nc))
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set A i j i))
|
||||
(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/set* A i j i))
|
||||
(matrix/print A)
|
||||
|
||||
(loop (i :range (0 nr) j :range (0 nc))
|
||||
(matrix/set** A i j i))
|
||||
(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))))
|
||||
(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))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))
|
||||
|
||||
68
examples/threads.janet
Normal file
68
examples/threads.janet
Normal file
@@ -0,0 +1,68 @@
|
||||
(defn worker-main
|
||||
"Sends 11 messages back to parent"
|
||||
[parent]
|
||||
(def name (thread/receive))
|
||||
(def interval (thread/receive))
|
||||
(for i 0 10
|
||||
(os/sleep interval)
|
||||
(:send parent (string/format "thread %s wakeup no. %d" name i)))
|
||||
(:send parent name))
|
||||
|
||||
(defn make-worker
|
||||
[name interval]
|
||||
(-> (thread/new worker-main)
|
||||
(:send name)
|
||||
(:send interval)))
|
||||
|
||||
(def bob (make-worker "bob" 0.02))
|
||||
(def joe (make-worker "joe" 0.03))
|
||||
(def sam (make-worker "sam" 0.05))
|
||||
|
||||
# Receive out of order
|
||||
(for i 0 33
|
||||
(print (thread/receive)))
|
||||
|
||||
#
|
||||
# Recursive Thread Tree - should pause for a bit, and then print a cool zigzag.
|
||||
#
|
||||
|
||||
(def rng (math/rng (os/cryptorand 16)))
|
||||
|
||||
(defn choose [& xs]
|
||||
(in xs (:int rng (length xs))))
|
||||
|
||||
(defn worker-tree
|
||||
[parent]
|
||||
(def name (thread/receive))
|
||||
(def depth (thread/receive))
|
||||
(if (< depth 5)
|
||||
(do
|
||||
(defn subtree []
|
||||
(-> (thread/new worker-tree)
|
||||
(:send (string name "/" (choose "bob" "marley" "harry" "suki" "anna" "yu")))
|
||||
(:send (inc depth))))
|
||||
(let [l (subtree)
|
||||
r (subtree)
|
||||
lrep (thread/receive)
|
||||
rrep (thread/receive)]
|
||||
(:send parent [name ;lrep ;rrep])))
|
||||
(do
|
||||
(:send parent [name]))))
|
||||
|
||||
(-> (thread/new worker-tree) (:send "adam") (:send 0))
|
||||
(def lines (thread/receive))
|
||||
(map print lines)
|
||||
|
||||
#
|
||||
# Receive timeout
|
||||
#
|
||||
|
||||
(def slow (make-worker "slow-loras" 0.5))
|
||||
(for i 0 50
|
||||
(try
|
||||
(let [msg (thread/receive 0.1)]
|
||||
(print "\n" msg))
|
||||
([err] (prin ".") (:flush stdout))))
|
||||
|
||||
(print "\ndone timing, timeouts ending.")
|
||||
(try (while true (print (thread/receive))) ([err] (print "done")))
|
||||
@@ -1,5 +1,4 @@
|
||||
# Version
|
||||
!define VERSION "1.5.0"
|
||||
!define PRODUCT_VERSION "${VERSION}.0"
|
||||
VIProductVersion "${PRODUCT_VERSION}"
|
||||
VIFileVersion "${PRODUCT_VERSION}"
|
||||
@@ -14,8 +13,9 @@ VIFileVersion "${PRODUCT_VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
|
||||
|
||||
# For now, use 32 bit folder as build is 32 bit
|
||||
# !define MULTIUSER_USE_PROGRAMFILES64
|
||||
!if ${SIXTYFOUR} == "true"
|
||||
!define MULTIUSER_USE_PROGRAMFILES64
|
||||
!endif
|
||||
|
||||
# Includes
|
||||
!include "MultiUser.nsh"
|
||||
|
||||
26
jpm.1
26
jpm.1
@@ -36,7 +36,7 @@ If passed to jpm install, runs tests before installing. Will run tests recursive
|
||||
|
||||
.TP
|
||||
.BR \-\-modpath=/some/path
|
||||
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order.
|
||||
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order. You most likely don't need this.
|
||||
|
||||
.TP
|
||||
.BR \-\-headerpath=/some/path
|
||||
@@ -60,23 +60,24 @@ Linking statically might be a better idea, even in that case. Defaults to
|
||||
$JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
|
||||
|
||||
.TP
|
||||
.BR \-\-compiler=cc
|
||||
.BR \-\-compiler=$CC
|
||||
Sets the compiler used for compiling native modules and standalone executables. Defaults
|
||||
to cc.
|
||||
|
||||
.TP
|
||||
.BR \-\-linker=ld
|
||||
Sets the linker used to create native modules and executables.
|
||||
.BR \-\-linker
|
||||
Sets the linker used to create native modules and executables. Only used on windows, where
|
||||
it defaults to link.exe.
|
||||
|
||||
.TP
|
||||
.BR \-\-pkglist=https://github.com/janet-lang/pkgs.git
|
||||
Sets the git repository for the package listing used to resolve shorthand package names.
|
||||
|
||||
.TP
|
||||
.BR \-\-archiver=ar
|
||||
.BR \-\-archiver=$AR
|
||||
Sets the command used for creating static libraries, use for linking into the standalone executable.
|
||||
Native modules are compiled twice, once a normal native module (shared object), and once as an
|
||||
archive.
|
||||
archive. Defaults to ar.
|
||||
|
||||
.SH COMMANDS
|
||||
.TP
|
||||
@@ -138,6 +139,10 @@ like make. run will run a single rule or build a single file.
|
||||
.BR rules
|
||||
List all rules that can be run via run. This is useful for exploring rules in the project.
|
||||
|
||||
.TP
|
||||
.BR show-paths
|
||||
Show all of the paths used when installing and building artifacts.
|
||||
|
||||
.TP
|
||||
.BR update-pkgs
|
||||
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
|
||||
@@ -171,7 +176,8 @@ This variable is overwritten by the --modpath=/some/path if it is provided.
|
||||
The location that jpm will look for janet header files (janet.h and janetconf.h) that are used
|
||||
to build native modules and standalone executables. If janet.h and janetconf.h are available as
|
||||
default includes on your system, this value is not required. If not provided, will default to
|
||||
(dyn :syspath)/../../include/janet. The --headerpath=/some/path will override this variable.
|
||||
<jpm script location>/../include/janet. The --headerpath=/some/path option will override this
|
||||
variable.
|
||||
.RE
|
||||
|
||||
.B JANET_LIBPATH
|
||||
@@ -179,15 +185,15 @@ default includes on your system, this value is not required. If not provided, wi
|
||||
Similar to JANET_HEADERPATH, this path is where jpm will look for
|
||||
libjanet.a for creating standalong executables. This does not need to be
|
||||
set on a normal install.
|
||||
If not provided, this will default to (dyn :syspath)/../../lib.
|
||||
The --libpath=/some/path will override this variable.
|
||||
If not provided, this will default to <jpm script location>/../lib.
|
||||
The --libpath=/some/path option will override this variable.
|
||||
.RE
|
||||
|
||||
.B JANET_BINPATH
|
||||
.RS
|
||||
The directory where jpm will install binary scripts and executables to.
|
||||
Defaults to
|
||||
(dyn :syspath)/../../lib.
|
||||
(dyn :syspath)/bin
|
||||
The --binpath=/some/path will override this variable.
|
||||
.RE
|
||||
|
||||
|
||||
14
meson.build
14
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.5.0')
|
||||
version : '1.6.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -30,6 +30,7 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet'
|
||||
cc = meson.get_compiler('c')
|
||||
m_dep = cc.find_library('m', required : false)
|
||||
dl_dep = cc.find_library('dl', required : false)
|
||||
thread_dep = dependency('threads')
|
||||
|
||||
# Link options
|
||||
if build_machine.system() != 'windows'
|
||||
@@ -128,6 +129,7 @@ core_src = [
|
||||
'src/core/struct.c',
|
||||
'src/core/symcache.c',
|
||||
'src/core/table.c',
|
||||
'src/core/thread.c',
|
||||
'src/core/tuple.c',
|
||||
'src/core/typedarray.c',
|
||||
'src/core/util.c',
|
||||
@@ -155,7 +157,7 @@ mainclient_src = [
|
||||
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
||||
include_directories : incdir,
|
||||
c_args : '-DJANET_BOOTSTRAP',
|
||||
dependencies : [m_dep, dl_dep],
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
native : true)
|
||||
|
||||
# Build core image
|
||||
@@ -166,7 +168,7 @@ core_image = custom_target('core_image',
|
||||
|
||||
libjanet = library('janet', core_src, core_image,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
install : true)
|
||||
|
||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||
@@ -186,14 +188,14 @@ endif
|
||||
|
||||
janet_mainclient = executable('janet', core_src, core_image, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_native_cflags,
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
janet_nativeclient = executable('janet-native', core_src, core_image, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_cross_cflags,
|
||||
native : true)
|
||||
else
|
||||
@@ -223,7 +225,7 @@ amalg_shell = custom_target('amalg-shell',
|
||||
# Amalgamated client
|
||||
janet_amalgclient = executable('janet-amalg', amalg, amalg_shell,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
build_by_default : false)
|
||||
|
||||
# Tests
|
||||
|
||||
@@ -73,6 +73,7 @@
|
||||
nil)
|
||||
|
||||
# Basic predicates
|
||||
(defn nan? "Check if x is NaN" [x] (not= x x))
|
||||
(defn even? "Check if x is even." [x] (== 0 (% x 2)))
|
||||
(defn odd? "Check if x is odd." [x] (not= 0 (% x 2)))
|
||||
(defn zero? "Check if x is zero." [x] (== x 0))
|
||||
@@ -102,6 +103,7 @@
|
||||
(defn indexed? "Check if x is an array or tuple." [x]
|
||||
(def t (type x))
|
||||
(if (= t :array) true (= t :tuple)))
|
||||
(defn truthy? "Check if x is truthy." [x] (if x true false))
|
||||
(defn true? "Check if x is true." [x] (= x true))
|
||||
(defn false? "Check if x is false." [x] (= x false))
|
||||
(defn nil? "Check if x is nil." [x] (= x nil))
|
||||
@@ -216,11 +218,21 @@
|
||||
f (gensym)
|
||||
r (gensym)]
|
||||
~(let [,f (,fiber/new (fn [] ,body) :ie)
|
||||
,r (resume ,f)]
|
||||
,r (,resume ,f)]
|
||||
(if (= (,fiber/status ,f) :error)
|
||||
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
|
||||
,r))))
|
||||
|
||||
(defmacro protect
|
||||
"Evaluate expressions, while capturing any errors. Evaluates to a tuple
|
||||
of two elements. The first element is true if successful, false if an
|
||||
error, and the second is the return value or error."
|
||||
[& body]
|
||||
(let [f (gensym) r (gensym)]
|
||||
~(let [,f (,fiber/new (fn [] ,;body) :ie)
|
||||
,r (,resume ,f)]
|
||||
[(,not= :error (,fiber/status ,f)) ,r])))
|
||||
|
||||
(defmacro and
|
||||
"Evaluates to the last argument if all preceding elements are true, otherwise
|
||||
evaluates to false."
|
||||
@@ -324,6 +336,11 @@
|
||||
(def ,binding ,i)
|
||||
,body))))
|
||||
|
||||
(defn- check-indexed [x]
|
||||
(if (indexed? x)
|
||||
x
|
||||
(error (string "expected tuple for range, got " x))))
|
||||
|
||||
(defn- loop1
|
||||
[body head i]
|
||||
|
||||
@@ -353,11 +370,11 @@
|
||||
(def {(+ i 2) object} head)
|
||||
(let [rest (loop1 body head (+ i 3))]
|
||||
(case verb
|
||||
:range (let [[start stop step] object]
|
||||
:range (let [[start stop step] (check-indexed object)]
|
||||
(for-template binding start stop (or step 1) < + [rest]))
|
||||
:keys (keys-template binding object false [rest])
|
||||
:pairs (keys-template binding object true [rest])
|
||||
:down (let [[start stop step] object]
|
||||
:down (let [[start stop step] (check-indexed object)]
|
||||
(for-template binding start stop (or step 1) > - [rest]))
|
||||
:in (each-template binding object [rest])
|
||||
:iterate (iterate-template binding object rest)
|
||||
@@ -414,6 +431,7 @@
|
||||
(loop1 body head 0))
|
||||
|
||||
(put _env 'loop1 nil)
|
||||
(put _env 'check-indexed nil)
|
||||
(put _env 'for-template nil)
|
||||
(put _env 'iterate-template nil)
|
||||
(put _env 'each-template nil)
|
||||
@@ -847,7 +865,7 @@
|
||||
|
||||
(defn walk
|
||||
"Iterate over the values in ast and apply f
|
||||
to them. Collect the results in a data structure . If ast is not a
|
||||
to them. Collect the results in a data structure. If ast is not a
|
||||
table, struct, array, or tuple,
|
||||
returns form."
|
||||
[f form]
|
||||
@@ -966,13 +984,13 @@
|
||||
(defn zipcoll
|
||||
"Creates a table from two arrays/tuples.
|
||||
Returns a new table."
|
||||
[keys vals]
|
||||
[ks vs]
|
||||
(def res @{})
|
||||
(def lk (length keys))
|
||||
(def lv (length vals))
|
||||
(def lk (length ks))
|
||||
(def lv (length vs))
|
||||
(def len (if (< lk lv) lk lv))
|
||||
(for i 0 len
|
||||
(put res (in keys i) (in vals i)))
|
||||
(put res (in ks i) (in vs i)))
|
||||
res)
|
||||
|
||||
(defn get-in
|
||||
@@ -981,7 +999,7 @@
|
||||
[ds ks &opt dflt]
|
||||
(var d ds)
|
||||
(loop [k :in ks :while d] (set d (get d k)))
|
||||
(or d dflt))
|
||||
(if (= nil d) dflt d))
|
||||
|
||||
(defn update-in
|
||||
"Update a value in a nested data structure by applying f to the current value.
|
||||
@@ -1033,7 +1051,7 @@
|
||||
data structure ds."
|
||||
[ds key func & args]
|
||||
(def old (get ds key))
|
||||
(set (ds key) (func old ;args)))
|
||||
(put ds key (func old ;args)))
|
||||
|
||||
(defn merge-into
|
||||
"Merges multiple tables/structs into a table. If a key appears in more than one
|
||||
@@ -1308,6 +1326,30 @@
|
||||
###
|
||||
###
|
||||
|
||||
(defn- env-walk
|
||||
[pred &opt env]
|
||||
(default env (fiber/getenv (fiber/current)))
|
||||
(def envs @[])
|
||||
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
|
||||
(def ret-set @{})
|
||||
(loop [envi :in envs
|
||||
k :keys envi
|
||||
:when (pred k)]
|
||||
(put ret-set k true))
|
||||
(sort (keys ret-set)))
|
||||
|
||||
(defn all-bindings
|
||||
"Get all symbols available in an enviroment. Defaults to the current
|
||||
fiber's environment."
|
||||
[&opt env]
|
||||
(env-walk symbol? env))
|
||||
|
||||
(defn all-dynamics
|
||||
"Get all dynamic bindings in an environment. Defaults to the current
|
||||
fiber's environment."
|
||||
[&opt env]
|
||||
(env-walk keyword? env))
|
||||
|
||||
(defn doc-format
|
||||
"Reformat text to wrap at a given line."
|
||||
[text]
|
||||
@@ -1346,35 +1388,59 @@
|
||||
|
||||
buf)
|
||||
|
||||
(defn- print-index
|
||||
"Print bindings in the current environment given a filter function"
|
||||
[fltr]
|
||||
(def bindings (filter fltr (all-bindings)))
|
||||
(def dynamics (map describe (filter fltr (all-dynamics))))
|
||||
(print)
|
||||
(print (doc-format (string "Bindings:\n\n" (string/join bindings " "))))
|
||||
(print)
|
||||
(print (doc-format (string "Dynamics:\n\n" (string/join dynamics " "))))
|
||||
(print))
|
||||
|
||||
(defn doc*
|
||||
"Get the documentation for a symbol in a given environment."
|
||||
[sym]
|
||||
(def x (dyn sym))
|
||||
(if (not x)
|
||||
(print "symbol " sym " not found.")
|
||||
[&opt sym]
|
||||
|
||||
(cond
|
||||
(string? sym)
|
||||
(print-index (fn [x] (string/find sym x)))
|
||||
|
||||
sym
|
||||
(do
|
||||
(def bind-type
|
||||
(string " "
|
||||
(cond
|
||||
(x :ref) (string :var " (" (type (in (x :ref) 0)) ")")
|
||||
(x :macro) :macro
|
||||
(type (x :value)))
|
||||
"\n"))
|
||||
(def sm (x :source-map))
|
||||
(def d (x :doc))
|
||||
(print "\n\n"
|
||||
(if d bind-type "")
|
||||
(if-let [[path line col] sm]
|
||||
(string " " path " on line " line ", column " col "\n") "")
|
||||
(if (or d sm) "\n" "")
|
||||
(if d (doc-format d) "no documentation found.")
|
||||
"\n\n"))))
|
||||
(def x (dyn sym))
|
||||
(if (not x)
|
||||
(print "symbol " sym " not found.")
|
||||
(do
|
||||
(def bind-type
|
||||
(string " "
|
||||
(cond
|
||||
(x :ref) (string :var " (" (type (in (x :ref) 0)) ")")
|
||||
(x :macro) :macro
|
||||
(type (x :value)))
|
||||
"\n"))
|
||||
(def sm (x :source-map))
|
||||
(def d (x :doc))
|
||||
(print "\n\n"
|
||||
(if d bind-type "")
|
||||
(if-let [[path line col] sm]
|
||||
(string " " path " on line " line ", column " col "\n") "")
|
||||
(if (or d sm) "\n" "")
|
||||
(if d (doc-format d) "no documentation found.")
|
||||
"\n\n"))))
|
||||
|
||||
# else
|
||||
(print-index identity)))
|
||||
|
||||
(defmacro doc
|
||||
"Shows documentation for the given symbol."
|
||||
[sym]
|
||||
[&opt sym]
|
||||
~(,doc* ',sym))
|
||||
|
||||
(put _env 'env-walk nil)
|
||||
(put _env 'print-index nil)
|
||||
|
||||
###
|
||||
###
|
||||
### Macro Expansion
|
||||
@@ -1611,6 +1677,32 @@
|
||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
|
||||
~(fn [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
||||
|
||||
###
|
||||
###
|
||||
### Default PEG patterns
|
||||
###
|
||||
###
|
||||
|
||||
(def default-peg-grammar
|
||||
"The default grammar used for pegs. This grammar defines several common patterns
|
||||
that should make it easier to write more complex patterns."
|
||||
~@{:d (range "09")
|
||||
:a (range "az" "AZ")
|
||||
:s (set " \t\r\n\0\f")
|
||||
:w (range "az" "AZ" "09")
|
||||
:S (if-not :s 1)
|
||||
:W (if-not :w 1)
|
||||
:A (if-not :a 1)
|
||||
:D (if-not :d 1)
|
||||
:d+ (some :d)
|
||||
:a+ (some :a)
|
||||
:s+ (some :s)
|
||||
:w+ (some :w)
|
||||
:d* (any :d)
|
||||
:a* (any :a)
|
||||
:w* (any :w)
|
||||
:s* (any :s)})
|
||||
|
||||
###
|
||||
###
|
||||
### Evaluation and Compilation
|
||||
@@ -1703,6 +1795,7 @@
|
||||
(defn eval1 [source]
|
||||
(def source (if expand (expand source) source))
|
||||
(var good true)
|
||||
(var resumeval nil)
|
||||
(def f
|
||||
(fiber/new
|
||||
(fn []
|
||||
@@ -1719,8 +1812,10 @@
|
||||
(on-compile-error msg errf where))))
|
||||
(or guard :a)))
|
||||
(fiber/setenv f env)
|
||||
(def res (resume f nil))
|
||||
(when good (if going (onstatus f res))))
|
||||
(while (let [fs (fiber/status f)]
|
||||
(and (not= :dead fs) (not= :error fs)))
|
||||
(def res (resume f resumeval))
|
||||
(when good (when going (set resumeval (onstatus f res))))))
|
||||
|
||||
# Loop
|
||||
(def buf @"")
|
||||
@@ -1746,14 +1841,16 @@
|
||||
(when (= (parser/status p) :error)
|
||||
(on-parse-error p where))
|
||||
|
||||
env)
|
||||
(in env :exit-value env))
|
||||
|
||||
(defn quit
|
||||
"Tries to exit from the current repl or context. Does not always exit the application.
|
||||
Works by setting the :exit dynamic binding to true."
|
||||
[]
|
||||
Works by setting the :exit dynamic binding to true. Passing a non-nil value here will cause the outer
|
||||
run-context to return that value."
|
||||
[&opt value]
|
||||
(setdyn :exit true)
|
||||
"Bye!")
|
||||
(setdyn :exit-value value)
|
||||
nil)
|
||||
|
||||
(defn eval-string
|
||||
"Evaluates a string in the current environment. If more control over the
|
||||
@@ -1789,18 +1886,32 @@
|
||||
(res)
|
||||
(error (res :error))))
|
||||
|
||||
(def make-image-dict
|
||||
"A table used in combination with marshal to marshal code (images), such that
|
||||
(make-image x) is the same as (marshal x make-image-dict)."
|
||||
@{})
|
||||
|
||||
(def load-image-dict
|
||||
"A table used in combination with unmarshal to unmarshal byte sequences created
|
||||
by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict)."
|
||||
@{})
|
||||
|
||||
(def comptime
|
||||
"(comptime x)\n\n
|
||||
Evals x at compile time and returns the result. Similar to a top level unquote."
|
||||
:macro eval)
|
||||
|
||||
(defn make-image
|
||||
"Create an image from an environment returned by require.
|
||||
Returns the image source as a string."
|
||||
[env]
|
||||
(marshal env (invert (env-lookup _env))))
|
||||
(marshal env make-image-dict))
|
||||
|
||||
(defn load-image
|
||||
"The inverse operation to make-image. Returns an environment."
|
||||
[image]
|
||||
(unmarshal image (env-lookup _env)))
|
||||
(unmarshal image load-image-dict))
|
||||
|
||||
(def- nati (if (= :windows (os/which)) ".dll" ".so"))
|
||||
(defn- check-. [x] (if (string/has-prefix? "." x) x))
|
||||
(defn- not-check-. [x] (unless (string/has-prefix? "." x) x))
|
||||
|
||||
@@ -1817,19 +1928,19 @@
|
||||
[":cur:/:all:.jimage" :image check-.]
|
||||
[":cur:/:all:.janet" :source check-.]
|
||||
[":cur:/:all:/init.janet" :source check-.]
|
||||
[(string ":cur:/:all:" nati) :native check-.]
|
||||
[":cur:/:all::native:" :native check-.]
|
||||
|
||||
# As a path from (os/cwd)
|
||||
[":all:.jimage" :image not-check-.]
|
||||
[":all:.janet" :source not-check-.]
|
||||
[":all:/init.janet" :source not-check-.]
|
||||
[(string ":all:" nati) :native not-check-.]
|
||||
[":all::native:" :native not-check-.]
|
||||
|
||||
# System paths
|
||||
[":sys:/:all:.jimage" :image not-check-.]
|
||||
[":sys:/:all:.janet" :source not-check-.]
|
||||
[":sys:/:all:/init.janet" :source not-check-.]
|
||||
[(string ":sys:/:all:" nati) :native not-check-.]])
|
||||
[":sys:/:all::native:" :native not-check-.]])
|
||||
|
||||
(setdyn :syspath (boot/opts "JANET_PATH"))
|
||||
(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
|
||||
@@ -1883,7 +1994,6 @@
|
||||
[nil (string "could not find module " path ":\n " ;str-parts)])))
|
||||
|
||||
(put _env 'fexists nil)
|
||||
(put _env 'nati nil)
|
||||
(put _env 'mod-filter nil)
|
||||
(put _env 'check-. nil)
|
||||
(put _env 'not-check-. nil)
|
||||
@@ -1908,8 +2018,11 @@
|
||||
(def f (if (= (type path) :core/file)
|
||||
path
|
||||
(file/open path :rb)))
|
||||
(def path-is-file (= f path))
|
||||
(default env (make-env))
|
||||
(put env :current-file (string path))
|
||||
(def spath (string path))
|
||||
(put env :current-file (if-not path-is-file spath))
|
||||
(put env :source (if-not path-is-file spath path))
|
||||
(defn chunks [buf _] (file/read f 2048 buf))
|
||||
(defn bp [&opt x y]
|
||||
(def ret (bad-parse x y))
|
||||
@@ -1921,19 +2034,20 @@
|
||||
ret)
|
||||
(unless f
|
||||
(error (string "could not find file " path)))
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
:on-parse-error bp
|
||||
:on-compile-error bc
|
||||
:on-status (fn [f x]
|
||||
(when (not= (fiber/status f) :dead)
|
||||
(debug/stacktrace f x)
|
||||
(if exit-on-error (os/exit 1))))
|
||||
:evaluator evaluator
|
||||
:expander expander
|
||||
:source (or source (if (= f path) "<anonymous>" path))})
|
||||
(when (not= f path) (file/close f))
|
||||
env)
|
||||
(def nenv
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
:on-parse-error bp
|
||||
:on-compile-error bc
|
||||
:on-status (fn [f x]
|
||||
(when (not= (fiber/status f) :dead)
|
||||
(debug/stacktrace f x)
|
||||
(if exit-on-error (os/exit 1))))
|
||||
:evaluator evaluator
|
||||
:expander expander
|
||||
:source (if path-is-file "<anonymous>" spath)}))
|
||||
(if-not path-is-file (file/close f))
|
||||
nenv)
|
||||
|
||||
(def module/loaders
|
||||
"A table of loading method names to loading functions.
|
||||
@@ -1943,7 +2057,6 @@
|
||||
:source (fn [path args]
|
||||
(put module/loading path true)
|
||||
(def newenv (dofile path ;args))
|
||||
(put newenv :source path)
|
||||
(put module/loading path nil)
|
||||
newenv)
|
||||
:image (fn [path &] (load-image (slurp path)))})
|
||||
@@ -2000,75 +2113,57 @@
|
||||
[& modules]
|
||||
~(do ,;(map (fn [x] ~(,import* ,(string x) :prefix "")) modules)))
|
||||
|
||||
###
|
||||
###
|
||||
### REPL
|
||||
###
|
||||
###
|
||||
|
||||
(defn repl
|
||||
"Run a repl. The first parameter is an optional function to call to
|
||||
get a chunk of source code that should return nil for end of file.
|
||||
The second parameter is a function that is called when a signal is
|
||||
caught."
|
||||
caught. One can provide an optional environment table to run
|
||||
the repl in."
|
||||
[&opt chunks onsignal env]
|
||||
(def level (+ (dyn :debug-level 0) 1))
|
||||
(default env (make-env))
|
||||
(default chunks (fn [buf p] (getline (string "repl:"
|
||||
((parser/where p) 0)
|
||||
":"
|
||||
(parser/state p :delimiters) "> ")
|
||||
buf)))
|
||||
(default onsignal (fn [f x]
|
||||
(case (fiber/status f)
|
||||
:dead (do
|
||||
(pp x)
|
||||
(put env '_ @{:value x}))
|
||||
:debug (let [nextenv (make-env env)]
|
||||
(put nextenv '_fiber @{:value f})
|
||||
(setdyn :debug-level level)
|
||||
(debug/stacktrace f x)
|
||||
(print ```
|
||||
(defn make-onsignal
|
||||
[e level]
|
||||
|
||||
entering debugger - (quit) or Ctrl-D to exit
|
||||
_fiber is bound to the suspended fiber
|
||||
(defn enter-debugger
|
||||
[f x]
|
||||
(def nextenv (make-env env))
|
||||
(put nextenv :fiber f)
|
||||
(put nextenv :debug-level level)
|
||||
(put nextenv :signal x)
|
||||
(debug/stacktrace f x)
|
||||
(defn debugger-chunks [buf p]
|
||||
(def status (parser/state p :delimiters))
|
||||
(def c ((parser/where p) 0))
|
||||
(def prompt (string "debug[" level "]:" c ":" status "> "))
|
||||
(getline prompt buf))
|
||||
(print "entering debug[" level "] - (quit) to exit")
|
||||
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
|
||||
(print "exiting debug[" level "]")
|
||||
(nextenv :resume-value))
|
||||
|
||||
(fn [f x]
|
||||
(if (= :dead (fiber/status f))
|
||||
(do (pp x) (put e '_ @{:value x}))
|
||||
(if (e :debug)
|
||||
(enter-debugger f x)
|
||||
(do (debug/stacktrace f x) nil)))))
|
||||
|
||||
```)
|
||||
(repl (fn [buf p]
|
||||
(def status (parser/state p :delimiters))
|
||||
(def c ((parser/where p) 0))
|
||||
(def prompt (string "debug[" level "]:" c ":" status "> "))
|
||||
(getline prompt buf))
|
||||
onsignal nextenv))
|
||||
(debug/stacktrace f x))))
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
:on-status onsignal
|
||||
:on-status (or onsignal (make-onsignal env 1))
|
||||
:source "repl"}))
|
||||
|
||||
(defn- env-walk
|
||||
[pred &opt env]
|
||||
(default env (fiber/getenv (fiber/current)))
|
||||
(def envs @[])
|
||||
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
|
||||
(def ret-set @{})
|
||||
(loop [envi :in envs
|
||||
k :keys envi
|
||||
:when (pred k)]
|
||||
(put ret-set k true))
|
||||
(sort (keys ret-set)))
|
||||
|
||||
(defn all-bindings
|
||||
"Get all symbols available in an enviroment. Defaults to the current
|
||||
fiber's environment."
|
||||
[&opt env]
|
||||
(env-walk symbol? env))
|
||||
|
||||
(defn all-dynamics
|
||||
"Get all dynamic bindings in an environment. Defaults to the current
|
||||
fiber's environment."
|
||||
[&opt env]
|
||||
(env-walk keyword? env))
|
||||
|
||||
# Clean up some extra defs
|
||||
(put _env 'boot/opts nil)
|
||||
(put _env 'env-walk nil)
|
||||
(put _env '_env nil)
|
||||
|
||||
###
|
||||
###
|
||||
### CLI Tool Main
|
||||
@@ -2095,7 +2190,7 @@ _fiber is bound to the suspended fiber
|
||||
(if-let [jp (os/getenv "JANET_HEADERPATH")] (setdyn :headerpath jp))
|
||||
|
||||
# Flag handlers
|
||||
(def handlers :private
|
||||
(def handlers
|
||||
{"h" (fn [&]
|
||||
(print "usage: " (dyn :executable "janet") " [options] script args...")
|
||||
(print
|
||||
@@ -2163,10 +2258,16 @@ _fiber is bound to the suspended fiber
|
||||
(while (< i lenargs)
|
||||
(def arg (in args i))
|
||||
(if (and *handleopts* (= "-" (string/slice arg 0 1)))
|
||||
(+= i (dohandler (string/slice arg 1 2) i))
|
||||
(+= i (dohandler (string/slice arg 1) i))
|
||||
(do
|
||||
(set *no-file* false)
|
||||
(dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator)
|
||||
(def env (make-env))
|
||||
(def subargs (array/slice args i))
|
||||
(put env :args subargs)
|
||||
(dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator :env env)
|
||||
(if-let [main (get (in env 'main) :value)]
|
||||
(let [thunk (compile [main ;(tuple/slice args i)] env arg)]
|
||||
(if (function? thunk) (thunk) (error (thunk :error)))))
|
||||
(set i lenargs))))
|
||||
|
||||
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
||||
@@ -2189,6 +2290,22 @@ _fiber is bound to the suspended fiber
|
||||
(setdyn :err-color (if *colorize* true))
|
||||
(repl getchunk onsig)))
|
||||
|
||||
|
||||
###
|
||||
###
|
||||
### Clean up
|
||||
###
|
||||
###
|
||||
|
||||
(def root-env "The root environment used to create envionments with (make-env)" _env)
|
||||
|
||||
(do
|
||||
(put _env 'boot/opts nil)
|
||||
(put _env '_env nil)
|
||||
(def load-dict (env-lookup _env))
|
||||
(merge-into load-image-dict load-dict)
|
||||
(merge-into make-image-dict (invert load-dict)))
|
||||
|
||||
###
|
||||
###
|
||||
### Bootstrap
|
||||
|
||||
@@ -27,10 +27,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 5
|
||||
#define JANET_VERSION_MINOR 6
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.5.0"
|
||||
#define JANET_VERSION "1.6.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
||||
@@ -125,6 +125,28 @@ static Janet cfun_array_new(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_new_filled(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t count = janet_getinteger(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
JanetArray *array = janet_array(count);
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
array->data[i] = x;
|
||||
}
|
||||
array->count = count;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_array_fill(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
for (int32_t i = 0; i < array->count; i++) {
|
||||
array->data[i] = x;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_array_pop(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
@@ -243,6 +265,17 @@ static const JanetReg array_cfuns[] = {
|
||||
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||
"(array) but can be more efficient if the maximum size of an array is known.")
|
||||
},
|
||||
{
|
||||
"array/new-filled", cfun_array_new_filled,
|
||||
JDOC("(array/new-filled count &opt value)\n\n"
|
||||
"Creates a new array of count elements, all set to value, which defaults to nil. Returns the new array.")
|
||||
},
|
||||
{
|
||||
"array/fill", cfun_array_fill,
|
||||
JDOC("(array/fill arr &opt value)\n\n"
|
||||
"Replace all elements of an array with value (defaulting to nil) without changing the length of the array. "
|
||||
"Returns the modified array.")
|
||||
},
|
||||
{
|
||||
"array/pop", cfun_array_pop,
|
||||
JDOC("(array/pop arr)\n\n"
|
||||
@@ -261,11 +294,11 @@ static const JanetReg array_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"array/ensure", cfun_array_ensure,
|
||||
JDOC("(array/ensure arr capacity)\n\n"
|
||||
JDOC("(array/ensure arr capacity growth)\n\n"
|
||||
"Ensures that the memory backing the array is large enough for capacity "
|
||||
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||
"so that there is enough space.")
|
||||
"items at the given rate of growth. Capacity and growth must be integers. "
|
||||
"If the backing capacity is already enough, then this function does nothing. "
|
||||
"Otherwise, the backing memory will be reallocated so that there is enough space.")
|
||||
},
|
||||
{
|
||||
"array/slice", cfun_array_slice,
|
||||
@@ -273,7 +306,8 @@ static const JanetReg array_cfuns[] = {
|
||||
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||
"Returns a new array.")
|
||||
"Note that index -1 is synonymous with index (length arrtup) to allow a full "
|
||||
"negative slice range. Returns a new array.")
|
||||
},
|
||||
{
|
||||
"array/concat", cfun_array_concat,
|
||||
|
||||
@@ -85,6 +85,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
|
||||
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
|
||||
{"gtn", JOP_NUMERIC_GREATER_THAN},
|
||||
{"in", JOP_IN},
|
||||
{"jmp", JOP_JUMP},
|
||||
{"jmpif", JOP_JUMP_IF},
|
||||
{"jmpno", JOP_JUMP_IF_NOT},
|
||||
@@ -172,17 +173,25 @@ static void janet_asm_deinit(JanetAssembler *a) {
|
||||
janet_table_deinit(&a->defs);
|
||||
}
|
||||
|
||||
static void janet_asm_longjmp(JanetAssembler *a) {
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
_longjmp(a->on_error, 1);
|
||||
#else
|
||||
longjmp(a->on_error, 1);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Throw some kind of assembly error */
|
||||
static void janet_asm_error(JanetAssembler *a, const char *message) {
|
||||
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
|
||||
longjmp(a->on_error, 1);
|
||||
janet_asm_longjmp(a);
|
||||
}
|
||||
#define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
|
||||
|
||||
/* Throw some kind of assembly error */
|
||||
static void janet_asm_errorv(JanetAssembler *a, const uint8_t *m) {
|
||||
a->errmessage = m;
|
||||
longjmp(a->on_error, 1);
|
||||
janet_asm_longjmp(a);
|
||||
}
|
||||
|
||||
/* Add a closure environment to the assembler. Sub funcdefs may need
|
||||
@@ -500,10 +509,14 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
janet_table_init(&a.defs, 0);
|
||||
|
||||
/* Set error jump */
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
if (_setjmp(a.on_error)) {
|
||||
#else
|
||||
if (setjmp(a.on_error)) {
|
||||
#endif
|
||||
if (NULL != a.parent) {
|
||||
janet_asm_deinit(&a);
|
||||
longjmp(a.parent->on_error, 1);
|
||||
janet_asm_longjmp(a.parent);
|
||||
}
|
||||
result.funcdef = NULL;
|
||||
result.error = a.errmessage;
|
||||
|
||||
@@ -182,6 +182,19 @@ static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t byte = 0;
|
||||
if (argc == 2) {
|
||||
byte = janet_getinteger(argv, 1) & 0xFF;
|
||||
}
|
||||
if (buffer->count) {
|
||||
memset(buffer->data, byte, buffer->count);
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
@@ -345,8 +358,8 @@ static const JanetReg buffer_cfuns[] = {
|
||||
{
|
||||
"buffer/new", cfun_buffer_new,
|
||||
JDOC("(buffer/new capacity)\n\n"
|
||||
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
||||
"Returns a new buffer.")
|
||||
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
|
||||
"Returns a new buffer of length 0.")
|
||||
},
|
||||
{
|
||||
"buffer/new-filled", cfun_buffer_new_filled,
|
||||
@@ -354,6 +367,12 @@ static const JanetReg buffer_cfuns[] = {
|
||||
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
|
||||
"Returns the new buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/fill", cfun_buffer_fill,
|
||||
JDOC("(buffer/fill buffer &opt byte)\n\n"
|
||||
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
|
||||
"Returns the modified buffer.")
|
||||
},
|
||||
{
|
||||
"buffer/push-byte", cfun_buffer_u8,
|
||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||
|
||||
@@ -80,6 +80,7 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_SSS, /* JOP_RESUME, */
|
||||
JINT_SSU, /* JOP_SIGNAL, */
|
||||
JINT_SSS, /* JOP_PROPAGATE */
|
||||
JINT_SSS, /* JOP_IN, */
|
||||
JINT_SSS, /* JOP_GET, */
|
||||
JINT_SSS, /* JOP_PUT, */
|
||||
JINT_SSU, /* JOP_GET_INDEX, */
|
||||
@@ -203,7 +204,7 @@ int32_t janet_verify(JanetFuncDef *def) {
|
||||
|
||||
/* Allocate an empty funcdef. This function may have added functionality
|
||||
* as commonalities between asm and compile arise. */
|
||||
JanetFuncDef *janet_funcdef_alloc() {
|
||||
JanetFuncDef *janet_funcdef_alloc(void) {
|
||||
JanetFuncDef *def = janet_gcalloc(JANET_MEMORY_FUNCDEF, sizeof(JanetFuncDef));
|
||||
def->environments = NULL;
|
||||
def->constants = NULL;
|
||||
|
||||
@@ -29,7 +29,11 @@
|
||||
void janet_panicv(Janet message) {
|
||||
if (janet_vm_return_reg != NULL) {
|
||||
*janet_vm_return_reg = message;
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
_longjmp(*janet_vm_jmp_buf, 1);
|
||||
#else
|
||||
longjmp(*janet_vm_jmp_buf, 1);
|
||||
#endif
|
||||
} else {
|
||||
fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
|
||||
exit(1);
|
||||
@@ -103,13 +107,15 @@ type janet_opt##name(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_le
|
||||
return janet_get##name(argv, n); \
|
||||
}
|
||||
|
||||
Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods) {
|
||||
int janet_getmethod(const uint8_t *method, const JanetMethod *methods, Janet *out) {
|
||||
while (methods->name) {
|
||||
if (!janet_cstrcmp(method, methods->name))
|
||||
return janet_wrap_cfunction(methods->cfun);
|
||||
if (!janet_cstrcmp(method, methods->name)) {
|
||||
*out = janet_wrap_cfunction(methods->cfun);
|
||||
return 1;
|
||||
}
|
||||
methods++;
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
return 0;
|
||||
}
|
||||
|
||||
DEFINE_GETTER(number, NUMBER, double)
|
||||
@@ -166,6 +172,30 @@ bad:
|
||||
janet_panicf("bad slot #%d, expected non-negative 32 bit signed integer, got %v", n, x);
|
||||
}
|
||||
|
||||
JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
|
||||
JanetAbstract a = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(a) != at) return NULL;
|
||||
return a;
|
||||
}
|
||||
|
||||
static int janet_strlike_cmp(JanetType type, Janet x, const char *cstring) {
|
||||
if (janet_type(x) != type) return 0;
|
||||
return !janet_cstrcmp(janet_unwrap_string(x), cstring);
|
||||
}
|
||||
|
||||
int janet_keyeq(Janet x, const char *cstring) {
|
||||
return janet_strlike_cmp(JANET_KEYWORD, x, cstring);
|
||||
}
|
||||
|
||||
int janet_streq(Janet x, const char *cstring) {
|
||||
return janet_strlike_cmp(JANET_STRING, x, cstring);
|
||||
}
|
||||
|
||||
int janet_symeq(Janet x, const char *cstring) {
|
||||
return janet_strlike_cmp(JANET_SYMBOL, x, cstring);
|
||||
}
|
||||
|
||||
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint(x)) {
|
||||
|
||||
@@ -27,10 +27,6 @@
|
||||
#include "vector.h"
|
||||
#endif
|
||||
|
||||
static int fixarity0(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
return janet_v_count(args) == 0;
|
||||
}
|
||||
static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
return janet_v_count(args) == 1;
|
||||
@@ -101,10 +97,18 @@ static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||
}
|
||||
static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
||||
(void)args;
|
||||
janetc_emit(opts.compiler, JOP_SIGNAL | (2 << 24));
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
int32_t len = janet_v_count(args);
|
||||
JanetSlot t = janetc_gettarget(opts);
|
||||
janetc_emit_ssu(opts.compiler, JOP_SIGNAL, t,
|
||||
(len == 1) ? args[0] : janetc_cslot(janet_wrap_nil()),
|
||||
JANET_SIGNAL_DEBUG,
|
||||
1);
|
||||
return t;
|
||||
}
|
||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_IN, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
@@ -270,7 +274,7 @@ static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
|
||||
|
||||
/* Arranged by tag */
|
||||
static const JanetFunOptimizer optimizers[] = {
|
||||
{fixarity0, do_debug},
|
||||
{maxarity1, do_debug},
|
||||
{fixarity1, do_error},
|
||||
{minarity2, do_apply},
|
||||
{maxarity1, do_yield},
|
||||
@@ -301,7 +305,8 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{NULL, do_lte},
|
||||
{NULL, do_eq},
|
||||
{NULL, do_neq},
|
||||
{fixarity2, do_propagate}
|
||||
{fixarity2, do_propagate},
|
||||
{fixarity2, do_get}
|
||||
};
|
||||
|
||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||
|
||||
@@ -569,15 +569,24 @@ static int macroexpand1(
|
||||
return 0;
|
||||
|
||||
/* Evaluate macro */
|
||||
JanetFiber *fiberp = NULL;
|
||||
JanetFunction *macro = janet_unwrap_function(macroval);
|
||||
int32_t arity = janet_tuple_length(form) - 1;
|
||||
JanetFiber *fiberp = janet_fiber(macro, 64, arity, form + 1);
|
||||
if (NULL == fiberp) {
|
||||
int32_t minar = macro->def->min_arity;
|
||||
int32_t maxar = macro->def->max_arity;
|
||||
const uint8_t *es = NULL;
|
||||
if (minar >= 0 && arity < minar)
|
||||
es = janet_formatc("macro arity mismatch, expected at least %d, got %d", minar, arity);
|
||||
if (maxar >= 0 && arity > maxar)
|
||||
es = janet_formatc("macro arity mismatch, expected at most %d, got %d", maxar, arity);
|
||||
c->result.macrofiber = NULL;
|
||||
janetc_error(c, es);
|
||||
}
|
||||
/* Set env */
|
||||
fiberp->env = c->env;
|
||||
int lock = janet_gclock();
|
||||
JanetSignal status = janet_pcall(
|
||||
macro,
|
||||
janet_tuple_length(form) - 1,
|
||||
form + 1,
|
||||
&x,
|
||||
&fiberp);
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &x);
|
||||
janet_gcunlock(lock);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
const uint8_t *es = janet_formatc("(macro) %V", x);
|
||||
|
||||
@@ -61,6 +61,7 @@
|
||||
#define JANET_FUN_EQ 30
|
||||
#define JANET_FUN_NEQ 31
|
||||
#define JANET_FUN_PROP 32
|
||||
#define JANET_FUN_GET 33
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct JanetCompiler JanetCompiler;
|
||||
|
||||
@@ -177,6 +177,13 @@ static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
|
||||
} else if (strncmp(template + i, ":name:", 6) == 0) {
|
||||
janet_buffer_push_cstring(out, name);
|
||||
i += 5;
|
||||
} else if (strncmp(template + i, ":native:", 8) == 0) {
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_buffer_push_cstring(out, ".dll");
|
||||
#else
|
||||
janet_buffer_push_cstring(out, ".so");
|
||||
#endif
|
||||
i += 7;
|
||||
} else {
|
||||
janet_buffer_push_u8(out, (uint8_t) template[i]);
|
||||
}
|
||||
@@ -262,61 +269,6 @@ static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
|
||||
return argv[1];
|
||||
}
|
||||
|
||||
static Janet janet_core_get(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
Janet ds = argv[0];
|
||||
Janet key = argv[1];
|
||||
Janet dflt = argc == 3 ? argv[2] : janet_wrap_nil();
|
||||
JanetType t = janet_type(argv[0]);
|
||||
switch (t) {
|
||||
default:
|
||||
return dflt;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD: {
|
||||
if (!janet_checkint(key)) return dflt;
|
||||
int32_t index = janet_unwrap_integer(key);
|
||||
if (index < 0) return dflt;
|
||||
const uint8_t *str = janet_unwrap_string(ds);
|
||||
if (index >= janet_string_length(str)) return dflt;
|
||||
return janet_wrap_integer(str[index]);
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(ds);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get) return dflt;
|
||||
return (type->get)(abst, key);
|
||||
}
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
if (!janet_checkint(key)) return dflt;
|
||||
int32_t index = janet_unwrap_integer(key);
|
||||
if (index < 0) return dflt;
|
||||
if (t == JANET_ARRAY) {
|
||||
JanetArray *a = janet_unwrap_array(ds);
|
||||
if (index >= a->count) return dflt;
|
||||
return a->data[index];
|
||||
} else {
|
||||
const Janet *t = janet_unwrap_tuple(ds);
|
||||
if (index >= janet_tuple_length(t)) return dflt;
|
||||
return t[index];
|
||||
}
|
||||
}
|
||||
case JANET_TABLE: {
|
||||
JanetTable *flag = NULL;
|
||||
Janet ret = janet_table_get_ex(janet_unwrap_table(ds), key, &flag);
|
||||
if (flag == NULL) return dflt;
|
||||
return ret;
|
||||
}
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *st = janet_unwrap_struct(ds);
|
||||
Janet ret = janet_struct_get(st, key);
|
||||
if (janet_checktype(ret, JANET_NIL)) return dflt;
|
||||
return ret;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
JanetModule init;
|
||||
janet_arity(argc, 1, 2);
|
||||
@@ -646,7 +598,7 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"gcsetinterval", janet_core_gcsetinterval,
|
||||
JDOC("(gcsetinterval interval)\n\n"
|
||||
"Set an integer number of bytes to allocate before running garbage collection. "
|
||||
"Low valuesi for interval will be slower but use less memory. "
|
||||
"Low values for interval will be slower but use less memory. "
|
||||
"High values will be faster but use more memory.")
|
||||
},
|
||||
{
|
||||
@@ -723,7 +675,13 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"Expands a path template as found in module/paths for module/find. "
|
||||
"This takes in a path (the argument to require) and a template string, template, "
|
||||
"to expand the path to a path that can be "
|
||||
"used for importing files.")
|
||||
"used for importing files. The replacements are as follows:\n\n"
|
||||
"\t:all:\tthe value of path verbatim\n"
|
||||
"\t:cur:\tthe current file, or (dyn :current-file)\n"
|
||||
"\t:dir:\tthe directory containing the current file\n"
|
||||
"\t:name:\tthe filename component of path, with extenion if given\n"
|
||||
"\t:native:\tthe extension used to load natives, .so or .dll\n"
|
||||
"\t:sys:\tthe system path, or (syn :syspath)")
|
||||
},
|
||||
{
|
||||
"int?", janet_core_check_int,
|
||||
@@ -740,14 +698,6 @@ static const JanetReg corelib_cfuns[] = {
|
||||
JDOC("(slice x &opt start end)\n\n"
|
||||
"Extract a sub-range of an indexed data strutrue or byte sequence.")
|
||||
},
|
||||
{
|
||||
"get", janet_core_get,
|
||||
JDOC("(get ds key &opt dflt)\n\n"
|
||||
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
|
||||
"Similar to get, but will not throw an error if the key is invalid for the data structure "
|
||||
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
|
||||
"an error.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -829,7 +779,7 @@ static void templatize_varop(
|
||||
SSI(JOP_GET_INDEX, 3, 0, 0), /* accum = args[0] */
|
||||
SI(JOP_LOAD_INTEGER, 5, 1), /* i = 1 */
|
||||
/* Main loop */
|
||||
SSS(JOP_GET, 4, 0, 5), /* operand = args[i] */
|
||||
SSS(JOP_IN, 4, 0, 5), /* operand = args[i] */
|
||||
SSS(op, 3, 3, 4), /* accum = accum op operand */
|
||||
SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
|
||||
SSI(JOP_EQUALS, 2, 5, 1), /* jump? = (i == argn) */
|
||||
@@ -877,7 +827,7 @@ static void templatize_comparator(
|
||||
SI(JOP_LOAD_INTEGER, 5, 1), /* i = 1 */
|
||||
|
||||
/* Main loop */
|
||||
SSS(JOP_GET, 4, 0, 5), /* next = args[i] */
|
||||
SSS(JOP_IN, 4, 0, 5), /* next = args[i] */
|
||||
SSS(op, 2, 3, 4), /* jump? = last compare next */
|
||||
SI(JOP_JUMP_IF_NOT, 2, 7), /* if not jump? goto fail (return false) */
|
||||
SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
|
||||
@@ -924,7 +874,7 @@ static void make_apply(JanetTable *env) {
|
||||
SI(JOP_LOAD_INTEGER, 4, 0), /* i = 0 */
|
||||
|
||||
/* Main loop */
|
||||
SSS(JOP_GET, 5, 1, 4), /* x = args[i] */
|
||||
SSS(JOP_IN, 5, 1, 4), /* x = args[i] */
|
||||
SSI(JOP_ADD_IMMEDIATE, 4, 4, 1), /* i++ */
|
||||
SSI(JOP_EQUALS, 3, 4, 2), /* jump? = (i == argn) */
|
||||
SI(JOP_JUMP_IF, 3, 3), /* if jump? go forward 3 */
|
||||
@@ -953,7 +903,7 @@ static const uint32_t error_asm[] = {
|
||||
};
|
||||
static const uint32_t debug_asm[] = {
|
||||
JOP_SIGNAL | (2 << 24),
|
||||
JOP_RETURN_NIL
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t yield_asm[] = {
|
||||
JOP_SIGNAL | (3 << 24),
|
||||
@@ -963,6 +913,14 @@ static const uint32_t resume_asm[] = {
|
||||
JOP_RESUME | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t in_asm[] = {
|
||||
JOP_IN | (1 << 24),
|
||||
JOP_LOAD_NIL | (3 << 8),
|
||||
JOP_EQUALS | (3 << 8) | (3 << 24),
|
||||
JOP_JUMP_IF | (3 << 8) | (2 << 16),
|
||||
JOP_RETURN,
|
||||
JOP_RETURN | (2 << 8)
|
||||
};
|
||||
static const uint32_t get_asm[] = {
|
||||
JOP_GET | (1 << 24),
|
||||
JOP_LOAD_NIL | (3 << 8),
|
||||
@@ -987,13 +945,48 @@ static const uint32_t propagate_asm[] = {
|
||||
JOP_PROPAGATE | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
#endif /* ifndef JANET_NO_BOOTSTRAP */
|
||||
#endif /* ifdef JANET_BOOTSTRAP */
|
||||
|
||||
/*
|
||||
* Setup Environment
|
||||
*/
|
||||
|
||||
static void janet_load_libs(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, corelib_cfuns);
|
||||
janet_lib_io(env);
|
||||
janet_lib_math(env);
|
||||
janet_lib_array(env);
|
||||
janet_lib_tuple(env);
|
||||
janet_lib_buffer(env);
|
||||
janet_lib_table(env);
|
||||
janet_lib_fiber(env);
|
||||
janet_lib_os(env);
|
||||
janet_lib_parse(env);
|
||||
janet_lib_compile(env);
|
||||
janet_lib_debug(env);
|
||||
janet_lib_string(env);
|
||||
janet_lib_marsh(env);
|
||||
#ifdef JANET_PEG
|
||||
janet_lib_peg(env);
|
||||
#endif
|
||||
#ifdef JANET_ASSEMBLER
|
||||
janet_lib_asm(env);
|
||||
#endif
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
janet_lib_typed_array(env);
|
||||
#endif
|
||||
#ifdef JANET_INT_TYPES
|
||||
janet_lib_inttypes(env);
|
||||
#endif
|
||||
#ifdef JANET_THREADS
|
||||
janet_lib_thread(env);
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||
janet_core_cfuns(env, NULL, corelib_cfuns);
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
janet_quick_asm(env, JANET_FUN_PROP,
|
||||
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
||||
JDOC("(propagate x fiber)\n\n"
|
||||
@@ -1002,17 +995,17 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"fiber is in a state that can be resumed, resuming the current fiber will "
|
||||
"first resume fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||
"debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm),
|
||||
JDOC("(debug)\n\n"
|
||||
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
||||
JDOC("(debug &opt x)\n\n"
|
||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||
"the running state of the current fiber. Returns nil."));
|
||||
"the running state of the current fiber. Returns the value passed in by resume."));
|
||||
janet_quick_asm(env, JANET_FUN_ERROR,
|
||||
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
|
||||
JDOC("(error e)\n\n"
|
||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_YIELD,
|
||||
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
|
||||
JDOC("(yield x)\n\n"
|
||||
JDOC("(yield &opt x)\n\n"
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
@@ -1024,14 +1017,19 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_IN,
|
||||
"in", 3, 2, 3, 4, get_asm, sizeof(get_asm),
|
||||
"in", 3, 2, 3, 4, in_asm, sizeof(in_asm),
|
||||
JDOC("(in ds key &opt dflt)\n\n"
|
||||
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
|
||||
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
|
||||
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
|
||||
"take any value as a key except nil and will return nil or dflt if not found."));
|
||||
janet_quick_asm(env, JANET_FUN_GET,
|
||||
"get", 3, 2, 3, 4, get_asm, sizeof(in_asm),
|
||||
JDOC("(get ds key &opt dflt)\n\n"
|
||||
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
||||
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
||||
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
||||
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
||||
"integer representations of bytes as result of a get call. If no values is found, will return "
|
||||
"dflt or nil if no default is provided."));
|
||||
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
|
||||
"Similar to in, but will not throw an error if the key is invalid for the data structure "
|
||||
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
|
||||
"an error."));
|
||||
janet_quick_asm(env, JANET_FUN_PUT,
|
||||
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
|
||||
JDOC("(put ds key value)\n\n"
|
||||
@@ -1145,48 +1143,50 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Allow references to the environment */
|
||||
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
||||
|
||||
/* Set as gc root */
|
||||
janet_load_libs(env);
|
||||
janet_gcroot(janet_wrap_table(env));
|
||||
#endif
|
||||
return env;
|
||||
}
|
||||
|
||||
/* Load auxiliary envs */
|
||||
janet_lib_io(env);
|
||||
janet_lib_math(env);
|
||||
janet_lib_array(env);
|
||||
janet_lib_tuple(env);
|
||||
janet_lib_buffer(env);
|
||||
janet_lib_table(env);
|
||||
janet_lib_fiber(env);
|
||||
janet_lib_os(env);
|
||||
janet_lib_parse(env);
|
||||
janet_lib_compile(env);
|
||||
janet_lib_debug(env);
|
||||
janet_lib_string(env);
|
||||
janet_lib_marsh(env);
|
||||
#ifdef JANET_PEG
|
||||
janet_lib_peg(env);
|
||||
#endif
|
||||
#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
|
||||
#else
|
||||
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
/* Unmarshal from core image */
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Memoize core env, ignoring replacements the second time around. */
|
||||
if (NULL != janet_vm_core_env) {
|
||||
return janet_vm_core_env;
|
||||
}
|
||||
|
||||
/* Load core cfunctions (and some built in janet assembly functions) */
|
||||
JanetTable *dict = janet_table(300);
|
||||
janet_load_libs(dict);
|
||||
|
||||
/* Add replacements */
|
||||
if (replacements != NULL) {
|
||||
for (int32_t i = 0; i < replacements->capacity; i++) {
|
||||
JanetKV kv = replacements->data[i];
|
||||
if (!janet_checktype(kv.key, JANET_NIL)) {
|
||||
janet_table_put(dict, kv.key, kv.value);
|
||||
if (janet_checktype(kv.value, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, kv.value, kv.key);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Unmarshal bytecode */
|
||||
Janet marsh_out = janet_unmarshal(
|
||||
janet_core_image,
|
||||
janet_core_image_size,
|
||||
0,
|
||||
env,
|
||||
dict,
|
||||
NULL);
|
||||
|
||||
/* Memoize */
|
||||
janet_gcroot(marsh_out);
|
||||
env = janet_unwrap_table(marsh_out);
|
||||
#endif
|
||||
JanetTable *env = janet_unwrap_table(marsh_out);
|
||||
janet_vm_core_env = env;
|
||||
|
||||
return env;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -313,6 +313,14 @@ static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet cfun_debug_step(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet out = janet_wrap_nil();
|
||||
janet_step(fiber, argc == 1 ? janet_wrap_nil() : argv[1], &out);
|
||||
return out;
|
||||
}
|
||||
|
||||
static const JanetReg debug_cfuns[] = {
|
||||
{
|
||||
"debug/break", cfun_debug_break,
|
||||
@@ -381,6 +389,13 @@ static const JanetReg debug_cfuns[] = {
|
||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||
"be used mostly for debugging purposes.")
|
||||
},
|
||||
{
|
||||
"debug/step", cfun_debug_step,
|
||||
JDOC("(debug/step fiber &opt x)\n\n"
|
||||
"Run a fiber for one virtual instruction of the Janet machine. Can optionally "
|
||||
"pass in a value that will be passed as the resuming value. Returns the signal value, "
|
||||
"which will usually be nil, as breakpoints raise nil signals.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -40,6 +40,13 @@ JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch Memory */
|
||||
#ifdef JANET_64
|
||||
#define SCRATCH_HDR_SIZE 16 /* smalloc must guarantee 16 byte alignment. */
|
||||
#elif JANET_32
|
||||
#define SCRATCH_HDR_SIZE 8 /* smalloc must guarantee 8 byte alignment. */
|
||||
#else
|
||||
#error "unknown scratch alignment"
|
||||
#endif
|
||||
JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
@@ -347,10 +354,18 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
return (void *)mem;
|
||||
}
|
||||
|
||||
static void free_one_scratch(void *mem) {
|
||||
ScratchFinalizer finalize = *(ScratchFinalizer *)mem;
|
||||
if (finalize)
|
||||
finalize((char *)mem + SCRATCH_HDR_SIZE);
|
||||
free(mem);
|
||||
}
|
||||
|
||||
/* Free all allocated scratch memory */
|
||||
static void janet_free_all_scratch(void) {
|
||||
for (size_t i = 0; i < janet_scratch_len; i++)
|
||||
free(janet_scratch_mem[i]);
|
||||
for (size_t i = 0; i < janet_scratch_len; i++) {
|
||||
free_one_scratch(janet_scratch_mem[i]);
|
||||
}
|
||||
janet_scratch_len = 0;
|
||||
}
|
||||
|
||||
@@ -457,10 +472,11 @@ void janet_gcunlock(int handle) {
|
||||
/* Scratch memory API */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
void *mem = malloc(size);
|
||||
void *mem = malloc(SCRATCH_HDR_SIZE + size);
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
*(ScratchFinalizer *)mem = NULL;
|
||||
if (janet_scratch_len == janet_scratch_cap) {
|
||||
size_t newcap = 2 * janet_scratch_cap + 2;
|
||||
void **newmem = (void **) realloc(janet_scratch_mem, newcap * sizeof(void *));
|
||||
@@ -471,20 +487,21 @@ void *janet_smalloc(size_t size) {
|
||||
janet_scratch_mem = newmem;
|
||||
}
|
||||
janet_scratch_mem[janet_scratch_len++] = mem;
|
||||
return mem;
|
||||
return (char *)mem + SCRATCH_HDR_SIZE;
|
||||
}
|
||||
|
||||
void *janet_srealloc(void *mem, size_t size) {
|
||||
if (NULL == mem) return janet_smalloc(size);
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
void *newmem = realloc(mem, size);
|
||||
void *newmem = realloc(mem, size + SCRATCH_HDR_SIZE);
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_mem[i] = newmem;
|
||||
return newmem;
|
||||
return (char *)newmem + SCRATCH_HDR_SIZE;
|
||||
}
|
||||
if (i == 0) break;
|
||||
}
|
||||
@@ -492,13 +509,19 @@ void *janet_srealloc(void *mem, size_t size) {
|
||||
janet_exit("invalid janet_srealloc");
|
||||
}
|
||||
|
||||
void janet_sfinalizer(void *mem, ScratchFinalizer finalizer) {
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
*(ScratchFinalizer *)mem = finalizer;
|
||||
}
|
||||
|
||||
void janet_sfree(void *mem) {
|
||||
if (NULL == mem) return;
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
|
||||
free(mem);
|
||||
free_one_scratch(mem);
|
||||
return;
|
||||
}
|
||||
if (i == 0) break;
|
||||
|
||||
@@ -36,26 +36,29 @@
|
||||
|
||||
#define MAX_INT_IN_DBL 9007199254740992ULL /* 2^53 */
|
||||
|
||||
static Janet it_s64_get(void *p, Janet key);
|
||||
static Janet it_u64_get(void *p, Janet key);
|
||||
static int it_s64_get(void *p, Janet key, Janet *out);
|
||||
static int it_u64_get(void *p, Janet key, Janet *out);
|
||||
|
||||
static void int64_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
janet_marshal_abstract(ctx, p);
|
||||
janet_marshal_int64(ctx, *((int64_t *)p));
|
||||
}
|
||||
|
||||
static void int64_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
*((int64_t *)p) = janet_unmarshal_int64(ctx);
|
||||
static void *int64_unmarshal(JanetMarshalContext *ctx) {
|
||||
int64_t *p = janet_unmarshal_abstract(ctx, sizeof(int64_t));
|
||||
p[0] = janet_unmarshal_int64(ctx);
|
||||
return p;
|
||||
}
|
||||
|
||||
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
|
||||
char str[32];
|
||||
sprintf(str, "<core/s64 %" PRId64 ">", *((int64_t *)p));
|
||||
sprintf(str, "%" PRId64, *((int64_t *)p));
|
||||
janet_buffer_push_cstring(buffer, str);
|
||||
}
|
||||
|
||||
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
||||
char str[32];
|
||||
sprintf(str, "<core/u64 %" PRIu64 ">", *((uint64_t *)p));
|
||||
sprintf(str, "%" PRIu64, *((uint64_t *)p));
|
||||
janet_buffer_push_cstring(buffer, str);
|
||||
}
|
||||
|
||||
@@ -348,18 +351,18 @@ static JanetMethod it_u64_methods[] = {
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet it_s64_get(void *p, Janet key) {
|
||||
static int it_s64_get(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD))
|
||||
janet_panicf("expected keyword, got %v", key);
|
||||
return janet_getmethod(janet_unwrap_keyword(key), it_s64_methods);
|
||||
return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), it_s64_methods, out);
|
||||
}
|
||||
|
||||
static Janet it_u64_get(void *p, Janet key) {
|
||||
static int it_u64_get(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD))
|
||||
janet_panicf("expected keyword, got %v", key);
|
||||
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods);
|
||||
return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg it_cfuns[] = {
|
||||
|
||||
145
src/core/io.c
145
src/core/io.c
@@ -20,32 +20,18 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* Compiler feature test macros for things */
|
||||
#define _DEFAULT_SOURCE
|
||||
#define _BSD_SOURCE
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <sys/wait.h>
|
||||
#endif
|
||||
|
||||
#define IO_WRITE 1
|
||||
#define IO_READ 2
|
||||
#define IO_APPEND 4
|
||||
#define IO_UPDATE 8
|
||||
#define IO_NOT_CLOSEABLE 16
|
||||
#define IO_CLOSED 32
|
||||
#define IO_BINARY 64
|
||||
#define IO_SERIALIZABLE 128
|
||||
#define IO_PIPED 256
|
||||
|
||||
typedef struct IOFile IOFile;
|
||||
struct IOFile {
|
||||
FILE *file;
|
||||
@@ -53,7 +39,7 @@ struct IOFile {
|
||||
};
|
||||
|
||||
static int cfun_io_gc(void *p, size_t len);
|
||||
static Janet io_file_get(void *p, Janet);
|
||||
static int io_file_get(void *p, Janet key, Janet *out);
|
||||
|
||||
JanetAbstractType cfun_io_filetype = {
|
||||
"core/file",
|
||||
@@ -78,13 +64,13 @@ static int checkflags(const uint8_t *str) {
|
||||
janet_panicf("invalid flag %c, expected w, a, or r", *str);
|
||||
break;
|
||||
case 'w':
|
||||
flags |= IO_WRITE;
|
||||
flags |= JANET_FILE_WRITE;
|
||||
break;
|
||||
case 'a':
|
||||
flags |= IO_APPEND;
|
||||
flags |= JANET_FILE_APPEND;
|
||||
break;
|
||||
case 'r':
|
||||
flags |= IO_READ;
|
||||
flags |= JANET_FILE_READ;
|
||||
break;
|
||||
}
|
||||
for (i = 1; i < len; i++) {
|
||||
@@ -93,12 +79,12 @@ static int checkflags(const uint8_t *str) {
|
||||
janet_panicf("invalid flag %c, expected + or b", str[i]);
|
||||
break;
|
||||
case '+':
|
||||
if (flags & IO_UPDATE) return -1;
|
||||
flags |= IO_UPDATE;
|
||||
if (flags & JANET_FILE_UPDATE) return -1;
|
||||
flags |= JANET_FILE_UPDATE;
|
||||
break;
|
||||
case 'b':
|
||||
if (flags & IO_BINARY) return -1;
|
||||
flags |= IO_BINARY;
|
||||
if (flags & JANET_FILE_BINARY) return -1;
|
||||
flags |= JANET_FILE_BINARY;
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -132,10 +118,10 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
|
||||
}
|
||||
flags = IO_PIPED | (fmode[0] == 'r' ? IO_READ : IO_WRITE);
|
||||
flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = IO_PIPED | IO_READ;
|
||||
flags = JANET_FILE_PIPED | JANET_FILE_READ;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
#define popen _popen
|
||||
@@ -158,7 +144,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = IO_READ;
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
@@ -174,7 +160,7 @@ static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = IO_READ;
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fdopen _fdopen
|
||||
@@ -186,7 +172,7 @@ static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fileno _fileno
|
||||
@@ -196,7 +182,7 @@ static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
|
||||
|
||||
/* Read up to n bytes into buffer. */
|
||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
||||
if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not readable");
|
||||
janet_buffer_extra(buffer, nBytesMax);
|
||||
size_t ntoread = nBytesMax;
|
||||
@@ -210,7 +196,7 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED) janet_panic("file is closed");
|
||||
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
|
||||
JanetBuffer *buffer;
|
||||
if (argc == 2) {
|
||||
buffer = janet_buffer(0);
|
||||
@@ -221,27 +207,11 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||
const uint8_t *sym = janet_unwrap_keyword(argv[1]);
|
||||
if (!janet_cstrcmp(sym, "all")) {
|
||||
/* Read whole file */
|
||||
int status = fseek(iof->file, 0, SEEK_SET);
|
||||
if (status) {
|
||||
/* backwards fseek did not work (stream like popen) */
|
||||
int32_t sizeBefore;
|
||||
do {
|
||||
sizeBefore = buffer->count;
|
||||
read_chunk(iof, buffer, 1024);
|
||||
} while (sizeBefore < buffer->count);
|
||||
} else {
|
||||
fseek(iof->file, 0, SEEK_END);
|
||||
long fsize = ftell(iof->file);
|
||||
if (fsize < 0) {
|
||||
janet_panicf("could not get file size of %v", argv[0]);
|
||||
}
|
||||
if (fsize > (INT32_MAX)) {
|
||||
janet_panic("file to large to read into buffer");
|
||||
}
|
||||
fseek(iof->file, 0, SEEK_SET);
|
||||
read_chunk(iof, buffer, (int32_t) fsize);
|
||||
}
|
||||
int32_t sizeBefore;
|
||||
do {
|
||||
sizeBefore = buffer->count;
|
||||
read_chunk(iof, buffer, 4096);
|
||||
} while (sizeBefore < buffer->count);
|
||||
/* Never return nil for :all */
|
||||
return janet_wrap_buffer(buffer);
|
||||
} else if (!janet_cstrcmp(sym, "line")) {
|
||||
@@ -266,9 +236,9 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not writeable");
|
||||
int32_t i;
|
||||
/* Verify all arguments before writing to file */
|
||||
@@ -289,9 +259,9 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not writeable");
|
||||
if (fflush(iof->file))
|
||||
janet_panic("could not flush file");
|
||||
@@ -302,7 +272,7 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
static int cfun_io_gc(void *p, size_t len) {
|
||||
(void) len;
|
||||
IOFile *iof = (IOFile *)p;
|
||||
if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) {
|
||||
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
return fclose(iof->file);
|
||||
}
|
||||
return 0;
|
||||
@@ -312,22 +282,22 @@ static int cfun_io_gc(void *p, size_t len) {
|
||||
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (iof->flags & (IO_NOT_CLOSEABLE))
|
||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||
janet_panic("file not closable");
|
||||
if (iof->flags & IO_PIPED) {
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
int status = pclose(iof->file);
|
||||
iof->flags |= IO_CLOSED;
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
if (status == -1) janet_panic("could not close file");
|
||||
return janet_wrap_integer(WEXITSTATUS(status));
|
||||
} else {
|
||||
if (fclose(iof->file)) janet_panic("could not close file");
|
||||
iof->flags |= IO_CLOSED;
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
@@ -336,7 +306,7 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
long int offset = 0;
|
||||
int whence = SEEK_CUR;
|
||||
@@ -361,18 +331,19 @@ static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
|
||||
static JanetMethod io_file_methods[] = {
|
||||
{"close", cfun_io_fclose},
|
||||
{"read", cfun_io_fread},
|
||||
{"write", cfun_io_fwrite},
|
||||
{"fileno", cfun_io_fileno},
|
||||
{"flush", cfun_io_fflush},
|
||||
{"read", cfun_io_fread},
|
||||
{"seek", cfun_io_fseek},
|
||||
{"write", cfun_io_fwrite},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet io_file_get(void *p, Janet key) {
|
||||
static int io_file_get(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD))
|
||||
janet_panicf("expected keyword, got %v", key);
|
||||
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods);
|
||||
return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods, out);
|
||||
}
|
||||
|
||||
FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
@@ -452,7 +423,7 @@ static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv,
|
||||
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
const char *name, FILE *dflt_file) {
|
||||
FILE *f;
|
||||
janet_arity(argc, 1, -1);
|
||||
@@ -466,6 +437,7 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv,
|
||||
/* Special case buffer */
|
||||
JanetBuffer *buf = janet_unwrap_buffer(x);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_NIL:
|
||||
@@ -482,6 +454,7 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv,
|
||||
}
|
||||
JanetBuffer *buf = janet_buffer(10);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
if (buf->count) {
|
||||
if (1 != fwrite(buf->data, buf->count, 1, f)) {
|
||||
janet_panicf("could not print %d bytes to file", buf->count, name);
|
||||
@@ -496,11 +469,19 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv,
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, "out", stdout);
|
||||
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
|
||||
static Janet cfun_io_prinf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
|
||||
}
|
||||
|
||||
static Janet cfun_io_eprintf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, "err", stderr);
|
||||
return cfun_io_printf_impl(argc, argv, 1, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
|
||||
@@ -557,7 +538,12 @@ static const JanetReg io_cfuns[] = {
|
||||
{
|
||||
"printf", cfun_io_printf,
|
||||
JDOC("(printf fmt & xs)\n\n"
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout).")
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.")
|
||||
},
|
||||
{
|
||||
"prinf", cfun_io_prinf,
|
||||
JDOC("(prinf fmt & xs)\n\n"
|
||||
"Like printf but with no trailing newline.")
|
||||
},
|
||||
{
|
||||
"eprin", cfun_io_eprin,
|
||||
@@ -572,7 +558,12 @@ static const JanetReg io_cfuns[] = {
|
||||
{
|
||||
"eprintf", cfun_io_eprintf,
|
||||
JDOC("(eprintf fmt & xs)\n\n"
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr).")
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.")
|
||||
},
|
||||
{
|
||||
"eprinf", cfun_io_eprinf,
|
||||
JDOC("(eprinf fmt & xs)\n\n"
|
||||
"Like eprintf but with no trailing newline.")
|
||||
},
|
||||
{
|
||||
"file/open", cfun_io_fopen,
|
||||
@@ -675,15 +666,15 @@ void janet_lib_io(JanetTable *env) {
|
||||
|
||||
/* stdout */
|
||||
janet_core_def(env, "stdout",
|
||||
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
makef(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
JDOC("The standard output file."));
|
||||
/* stderr */
|
||||
janet_core_def(env, "stderr",
|
||||
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
makef(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
JDOC("The standard error file."));
|
||||
/* stdin */
|
||||
janet_core_def(env, "stdin",
|
||||
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
makef(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
JDOC("The standard input file."));
|
||||
|
||||
}
|
||||
|
||||
@@ -338,6 +338,13 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
|
||||
marshal_one(st, x, ctx->flags + 1);
|
||||
}
|
||||
|
||||
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
janet_table_put(&st->seen,
|
||||
janet_wrap_abstract(abstract),
|
||||
janet_wrap_integer(st->nextid++));
|
||||
}
|
||||
|
||||
#define MARK_SEEN() \
|
||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
|
||||
|
||||
@@ -345,11 +352,9 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *at = janet_abstract_type(abstract);
|
||||
if (at->marshal) {
|
||||
JanetMarshalContext context = {st, NULL, flags, NULL};
|
||||
pushbyte(st, LB_ABSTRACT);
|
||||
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
||||
push64(st, (uint64_t) janet_abstract_size(abstract));
|
||||
MARK_SEEN();
|
||||
JanetMarshalContext context = {st, NULL, flags, NULL, at};
|
||||
at->marshal(abstract, &context);
|
||||
} else {
|
||||
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
|
||||
@@ -983,6 +988,11 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
return data;
|
||||
}
|
||||
|
||||
void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
MARSH_EOS(st, ctx->data + size);
|
||||
}
|
||||
|
||||
int32_t janet_unmarshal_int(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
return readint(st, &(ctx->data));
|
||||
@@ -1017,17 +1027,28 @@ Janet janet_unmarshal_janet(JanetMarshalContext *ctx) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
if (ctx->at == NULL) {
|
||||
janet_panicf("janet_unmarshal_abstract called more than once");
|
||||
}
|
||||
void *p = janet_abstract(ctx->at, size);
|
||||
janet_v_push(st->lookup, janet_wrap_abstract(p));
|
||||
ctx->at = NULL;
|
||||
return p;
|
||||
}
|
||||
|
||||
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
|
||||
Janet key;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
const JanetAbstractType *at = janet_get_abstract_type(key);
|
||||
if (at == NULL) return NULL;
|
||||
if (at->unmarshal) {
|
||||
void *p = janet_abstract(at, (size_t) read64(st, &data));
|
||||
*out = janet_wrap_abstract(p);
|
||||
JanetMarshalContext context = {NULL, st, flags, data};
|
||||
janet_v_push(st->lookup, *out);
|
||||
at->unmarshal(p, &context);
|
||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||
if (context.at != NULL) {
|
||||
janet_panicf("janet_unmarshal_abstract not called");
|
||||
}
|
||||
return context.data;
|
||||
}
|
||||
return NULL;
|
||||
|
||||
168
src/core/math.c
168
src/core/math.c
@@ -29,10 +29,11 @@
|
||||
|
||||
static JANET_THREAD_LOCAL JanetRNG janet_vm_rng = {0, 0, 0, 0, 0};
|
||||
|
||||
static Janet janet_rng_get(void *p, Janet key);
|
||||
static int janet_rng_get(void *p, Janet key, Janet *out);
|
||||
|
||||
static void janet_rng_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetRNG *rng = (JanetRNG *)p;
|
||||
janet_marshal_abstract(ctx, p);
|
||||
janet_marshal_int(ctx, (int32_t) rng->a);
|
||||
janet_marshal_int(ctx, (int32_t) rng->b);
|
||||
janet_marshal_int(ctx, (int32_t) rng->c);
|
||||
@@ -40,13 +41,14 @@ static void janet_rng_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
janet_marshal_int(ctx, (int32_t) rng->counter);
|
||||
}
|
||||
|
||||
static void janet_rng_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetRNG *rng = (JanetRNG *)p;
|
||||
static void *janet_rng_unmarshal(JanetMarshalContext *ctx) {
|
||||
JanetRNG *rng = janet_unmarshal_abstract(ctx, sizeof(JanetRNG));
|
||||
rng->a = (uint32_t) janet_unmarshal_int(ctx);
|
||||
rng->b = (uint32_t) janet_unmarshal_int(ctx);
|
||||
rng->c = (uint32_t) janet_unmarshal_int(ctx);
|
||||
rng->d = (uint32_t) janet_unmarshal_int(ctx);
|
||||
rng->counter = (uint32_t) janet_unmarshal_int(ctx);
|
||||
return rng;
|
||||
}
|
||||
|
||||
static JanetAbstractType JanetRNG_type = {
|
||||
@@ -65,11 +67,27 @@ JanetRNG *janet_default_rng(void) {
|
||||
}
|
||||
|
||||
void janet_rng_seed(JanetRNG *rng, uint32_t seed) {
|
||||
rng->a = seed + 123573u;
|
||||
rng->b = (seed + 43234283u) % 12391233u;
|
||||
rng->c = 0x17af0931u;
|
||||
rng->d = 0xFFFaaFFFu;
|
||||
rng->a = seed;
|
||||
rng->b = 0x97654321u;
|
||||
rng->c = 123871873u;
|
||||
rng->d = 0xf23f56c8u;
|
||||
rng->counter = 0u;
|
||||
/* First several numbers aren't that random. */
|
||||
for (int i = 0; i < 16; i++) janet_rng_u32(rng);
|
||||
}
|
||||
|
||||
void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len) {
|
||||
uint8_t state[16] = {0};
|
||||
for (int32_t i = 0; i < len; i++)
|
||||
state[i & 0xF] ^= bytes[i];
|
||||
rng->a = state[0] + (state[1] << 8) + (state[2] << 16) + (state[3] << 24);
|
||||
rng->b = state[4] + (state[5] << 8) + (state[6] << 16) + (state[7] << 24);
|
||||
rng->c = state[8] + (state[9] << 8) + (state[10] << 16) + (state[11] << 24);
|
||||
rng->d = state[12] + (state[13] << 8) + (state[14] << 16) + (state[15] << 24);
|
||||
rng->counter = 0u;
|
||||
/* a, b, c, d can't all be 0 */
|
||||
if (rng->a == 0) rng->a = 1u;
|
||||
for (int i = 0; i < 16; i++) janet_rng_u32(rng);
|
||||
}
|
||||
|
||||
uint32_t janet_rng_u32(JanetRNG *rng) {
|
||||
@@ -96,9 +114,18 @@ double janet_rng_double(JanetRNG *rng) {
|
||||
|
||||
static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
uint32_t seed = (uint32_t)(argc == 1 ? janet_getinteger(argv, 0) : 0);
|
||||
JanetRNG *rng = janet_abstract(&JanetRNG_type, sizeof(JanetRNG));
|
||||
janet_rng_seed(rng, seed);
|
||||
if (argc == 1) {
|
||||
if (janet_checkint(argv[0])) {
|
||||
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
|
||||
janet_rng_seed(rng, seed);
|
||||
} else {
|
||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||
janet_rng_longseed(rng, bytes.bytes, bytes.len);
|
||||
}
|
||||
} else {
|
||||
janet_rng_seed(rng, 0);
|
||||
}
|
||||
return janet_wrap_abstract(rng);
|
||||
}
|
||||
|
||||
@@ -128,16 +155,51 @@ static Janet cfun_rng_int(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
|
||||
uint32_t word = janet_rng_u32(rng);
|
||||
buf[0] = word & 0xFF;
|
||||
buf[1] = (word >> 8) & 0xFF;
|
||||
buf[2] = (word >> 16) & 0xFF;
|
||||
buf[3] = (word >> 24) & 0xFF;
|
||||
}
|
||||
|
||||
static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n);
|
||||
|
||||
/* Split into first part (that is divisible by 4), and rest */
|
||||
int32_t first_part = n & ~3;
|
||||
int32_t second_part = n - first_part;
|
||||
|
||||
/* Get first part in chunks of 4 bytes */
|
||||
janet_buffer_extra(buffer, n);
|
||||
uint8_t *buf = buffer->data + buffer->count;
|
||||
for (int32_t i = 0; i < first_part; i += 4) rng_get_4bytes(rng, buf + i);
|
||||
buffer->count += first_part;
|
||||
|
||||
/* Get remaining 0 - 3 bytes */
|
||||
if (second_part) {
|
||||
uint8_t wordbuf[4] = {0};
|
||||
rng_get_4bytes(rng, wordbuf);
|
||||
janet_buffer_push_bytes(buffer, wordbuf, second_part);
|
||||
}
|
||||
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static const JanetMethod rng_methods[] = {
|
||||
{"uniform", cfun_rng_uniform},
|
||||
{"int", cfun_rng_int},
|
||||
{"buffer", cfun_rng_buffer},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet janet_rng_get(void *p, Janet key) {
|
||||
static int janet_rng_get(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) janet_panicf("expected keyword method");
|
||||
return janet_getmethod(janet_unwrap_keyword(key), rng_methods);
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), rng_methods, out);
|
||||
}
|
||||
|
||||
/* Get a random number */
|
||||
@@ -150,8 +212,13 @@ static Janet janet_rand(int32_t argc, Janet *argv) {
|
||||
/* Seed the random number generator */
|
||||
static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t x = janet_getinteger(argv, 0);
|
||||
janet_rng_seed(&janet_vm_rng, (uint32_t) x);
|
||||
if (janet_checkint(argv[0])) {
|
||||
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
|
||||
janet_rng_seed(&janet_vm_rng, seed);
|
||||
} else {
|
||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||
janet_rng_longseed(&janet_vm_rng, bytes.bytes, bytes.len);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -174,17 +241,26 @@ JANET_DEFINE_MATHOP(asin, asin)
|
||||
JANET_DEFINE_MATHOP(atan, atan)
|
||||
JANET_DEFINE_MATHOP(cos, cos)
|
||||
JANET_DEFINE_MATHOP(cosh, cosh)
|
||||
JANET_DEFINE_MATHOP(acosh, acosh)
|
||||
JANET_DEFINE_MATHOP(sin, sin)
|
||||
JANET_DEFINE_MATHOP(sinh, sinh)
|
||||
JANET_DEFINE_MATHOP(asinh, asinh)
|
||||
JANET_DEFINE_MATHOP(tan, tan)
|
||||
JANET_DEFINE_MATHOP(tanh, tanh)
|
||||
JANET_DEFINE_MATHOP(atanh, atanh)
|
||||
JANET_DEFINE_MATHOP(exp, exp)
|
||||
JANET_DEFINE_MATHOP(exp2, exp2)
|
||||
JANET_DEFINE_MATHOP(expm1, expm1)
|
||||
JANET_DEFINE_MATHOP(log, log)
|
||||
JANET_DEFINE_MATHOP(log10, log10)
|
||||
JANET_DEFINE_MATHOP(log2, log2)
|
||||
JANET_DEFINE_MATHOP(sqrt, sqrt)
|
||||
JANET_DEFINE_MATHOP(cbrt, cbrt)
|
||||
JANET_DEFINE_MATHOP(ceil, ceil)
|
||||
JANET_DEFINE_MATHOP(fabs, fabs)
|
||||
JANET_DEFINE_MATHOP(floor, floor)
|
||||
JANET_DEFINE_MATHOP(trunc, trunc)
|
||||
JANET_DEFINE_MATHOP(round, round)
|
||||
|
||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
@@ -196,6 +272,7 @@ static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||
JANET_DEFINE_MATH2OP(pow, pow)
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot)
|
||||
|
||||
static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
@@ -220,8 +297,8 @@ static const JanetReg math_cfuns[] = {
|
||||
{
|
||||
"math/seedrandom", janet_srand,
|
||||
JDOC("(math/seedrandom seed)\n\n"
|
||||
"Set the seed for the random number generator. 'seed' should be "
|
||||
"an integer.")
|
||||
"Set the seed for the random number generator. seed should be "
|
||||
"an integer or a buffer.")
|
||||
},
|
||||
{
|
||||
"math/cos", janet_cos,
|
||||
@@ -268,11 +345,21 @@ static const JanetReg math_cfuns[] = {
|
||||
JDOC("(math/log10 x)\n\n"
|
||||
"Returns log base 10 of x.")
|
||||
},
|
||||
{
|
||||
"math/log2", janet_log2,
|
||||
JDOC("(math/log2 x)\n\n"
|
||||
"Returns log base 2 of x.")
|
||||
},
|
||||
{
|
||||
"math/sqrt", janet_sqrt,
|
||||
JDOC("(math/sqrt x)\n\n"
|
||||
"Returns the square root of x.")
|
||||
},
|
||||
{
|
||||
"math/cbrt", janet_cbrt,
|
||||
JDOC("(math/cbrt x)\n\n"
|
||||
"Returns the cube root of x.")
|
||||
},
|
||||
{
|
||||
"math/floor", janet_floor,
|
||||
JDOC("(math/floor x)\n\n"
|
||||
@@ -308,6 +395,21 @@ static const JanetReg math_cfuns[] = {
|
||||
JDOC("(math/tanh x)\n\n"
|
||||
"Return the hyperbolic tangent of x.")
|
||||
},
|
||||
{
|
||||
"math/atanh", janet_atanh,
|
||||
JDOC("(math/atanh x)\n\n"
|
||||
"Return the hyperbolic arctangent of x.")
|
||||
},
|
||||
{
|
||||
"math/asinh", janet_asinh,
|
||||
JDOC("(math/asinh x)\n\n"
|
||||
"Return the hyperbolic arcsine of x.")
|
||||
},
|
||||
{
|
||||
"math/acosh", janet_acosh,
|
||||
JDOC("(math/acosh x)\n\n"
|
||||
"Return the hyperbolic arccosine of x.")
|
||||
},
|
||||
{
|
||||
"math/atan2", janet_atan2,
|
||||
JDOC("(math/atan2 y x)\n\n"
|
||||
@@ -331,12 +433,44 @@ static const JanetReg math_cfuns[] = {
|
||||
"Extract a random random integer in the range [0, max] from the RNG. If "
|
||||
"no max is given, the default is 2^31 - 1.")
|
||||
},
|
||||
{
|
||||
"math/rng-buffer", cfun_rng_buffer,
|
||||
JDOC("(math/rng-buffer rng n &opt buf)\n\n"
|
||||
"Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
|
||||
"provided, otherwise appends to the given buffer. Returns the buffer.")
|
||||
},
|
||||
{
|
||||
"math/hypot", janet_hypot,
|
||||
JDOC("(math/hypot a b)\n\n"
|
||||
"Returns the c from the equation c^2 = a^2 + b^2")
|
||||
},
|
||||
{
|
||||
"math/exp2", janet_exp2,
|
||||
JDOC("(math/exp2 x)\n\n"
|
||||
"Returns 2 to the power of x.")
|
||||
},
|
||||
{
|
||||
"math/expm1", janet_expm1,
|
||||
JDOC("(math/expm1 x)\n\n"
|
||||
"Returns e to the power of x minus 1.")
|
||||
},
|
||||
{
|
||||
"math/trunc", janet_trunc,
|
||||
JDOC("(math/trunc x)\n\n"
|
||||
"Returns the integer between x and 0 nearest to x.")
|
||||
},
|
||||
{
|
||||
"math/round", janet_round,
|
||||
JDOC("(math/round x)\n\n"
|
||||
"Returns the integer nearest to x.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_math(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, math_cfuns);
|
||||
janet_register_abstract_type(&JanetRNG_type);
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||
JDOC("The value pi."));
|
||||
@@ -344,5 +478,7 @@ void janet_lib_math(JanetTable *env) {
|
||||
JDOC("The base of the natural log."));
|
||||
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
|
||||
JDOC("The number representing positive infinity"));
|
||||
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
|
||||
JDOC("The number representing negative infinity"));
|
||||
#endif
|
||||
}
|
||||
|
||||
132
src/core/os.c
132
src/core/os.c
@@ -25,10 +25,9 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <time.h>
|
||||
#include <fcntl.h>
|
||||
#include <errno.h>
|
||||
@@ -36,6 +35,8 @@
|
||||
#include <string.h>
|
||||
#include <sys/stat.h>
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#include <direct.h>
|
||||
@@ -58,6 +59,12 @@ extern char **environ;
|
||||
#include <mach/mach.h>
|
||||
#endif
|
||||
|
||||
/* Setting C99 standard makes this not available, but it should
|
||||
* work/link properly if we detect a BSD */
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
void arc4random_buf(void *buf, size_t nbytes);
|
||||
#endif
|
||||
|
||||
#endif /* JANET_REDCUED_OS */
|
||||
|
||||
/* Core OS functions */
|
||||
@@ -74,11 +81,11 @@ static Janet os_which(int32_t argc, Janet *argv) {
|
||||
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
|
||||
#elif defined(JANET_WINDOWS)
|
||||
return janet_ckeywordv("windows");
|
||||
#elif defined(__APPLE__)
|
||||
#elif defined(JANET_APPLE)
|
||||
return janet_ckeywordv("macos");
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
return janet_ckeywordv("web");
|
||||
#elif defined(__linux__)
|
||||
#elif defined(JANET_LINUX)
|
||||
return janet_ckeywordv("linux");
|
||||
#elif defined(__FreeBSD__)
|
||||
return janet_ckeywordv("freebsd");
|
||||
@@ -86,6 +93,8 @@ static Janet os_which(int32_t argc, Janet *argv) {
|
||||
return janet_ckeywordv("netbsd");
|
||||
#elif defined(__OpenBSD__)
|
||||
return janet_ckeywordv("openbsd");
|
||||
#elif defined(JANET_BSD)
|
||||
return janet_ckeywordv("bsd");
|
||||
#else
|
||||
return janet_ckeywordv("posix");
|
||||
#endif
|
||||
@@ -101,7 +110,7 @@ static Janet os_arch(int32_t argc, Janet *argv) {
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
return janet_ckeywordv("wasm");
|
||||
#elif (defined(__x86_64__) || defined(_M_X64))
|
||||
return janet_ckeywordv("x86-64");
|
||||
return janet_ckeywordv("x64");
|
||||
#elif defined(__i386) || defined(_M_IX86)
|
||||
return janet_ckeywordv("x86");
|
||||
#elif defined(_M_ARM64) || defined(__aarch64__)
|
||||
@@ -322,7 +331,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
|
||||
/* Check error */
|
||||
if (-1 == status) {
|
||||
janet_panic(strerror(errno));
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
}
|
||||
|
||||
return janet_wrap_integer(status);
|
||||
@@ -351,7 +360,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
/* Wait for child */
|
||||
if (status) {
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
janet_panic(strerror(status));
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
} else {
|
||||
waitpid(pid, &status, 0);
|
||||
}
|
||||
@@ -372,6 +381,30 @@ static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
: janet_wrap_boolean(stat);
|
||||
}
|
||||
|
||||
static Janet os_environ(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
int32_t nenv = 0;
|
||||
char **env = environ;
|
||||
while (*env++)
|
||||
nenv += 1;
|
||||
JanetTable *t = janet_table(nenv);
|
||||
for (int32_t i = 0; i < nenv; i++) {
|
||||
char *e = environ[i];
|
||||
char *eq = strchr(e, '=');
|
||||
if (!eq) janet_panic("no '=' in environ");
|
||||
char *v = eq + 1;
|
||||
int32_t full_len = (int32_t) strlen(e);
|
||||
int32_t val_len = (int32_t) strlen(v);
|
||||
janet_table_put(
|
||||
t,
|
||||
janet_stringv((const uint8_t *)e, full_len - val_len - 1),
|
||||
janet_stringv((const uint8_t *)v, val_len)
|
||||
);
|
||||
}
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *cstr = janet_getcstring(argv, 0);
|
||||
@@ -409,9 +442,10 @@ static Janet os_time(int32_t argc, Janet *argv) {
|
||||
/* Clock shims */
|
||||
#ifdef JANET_WINDOWS
|
||||
static int gettime(struct timespec *spec) {
|
||||
int64_t wintime = 0LL;
|
||||
GetSystemTimeAsFileTime((FILETIME *)&wintime);
|
||||
/* Windows epoch is January 1, 1601 apparently*/
|
||||
FILETIME ftime;
|
||||
GetSystemTimeAsFileTime(&ftime);
|
||||
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
|
||||
/* Windows epoch is January 1, 1601 apparently */
|
||||
wintime -= 116444736000000000LL;
|
||||
spec->tv_sec = wintime / 10000000LL;
|
||||
/* Resolution is 100 nanoseconds. */
|
||||
@@ -449,12 +483,13 @@ static Janet os_sleep(int32_t argc, Janet *argv) {
|
||||
#ifdef JANET_WINDOWS
|
||||
Sleep((DWORD)(delay * 1000));
|
||||
#else
|
||||
int rc;
|
||||
struct timespec ts;
|
||||
ts.tv_sec = (time_t) delay;
|
||||
ts.tv_nsec = (delay <= UINT32_MAX)
|
||||
? (long)((delay - ((uint32_t)delay)) * 1000000000)
|
||||
: 0;
|
||||
nanosleep(&ts, NULL);
|
||||
RETRY_EINTR(rc, nanosleep(&ts, &ts));
|
||||
#endif
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
@@ -473,6 +508,63 @@ static Janet os_cwd(int32_t argc, Janet *argv) {
|
||||
return janet_cstringv(ptr);
|
||||
}
|
||||
|
||||
static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *buffer;
|
||||
const char *genericerr = "unable to get sufficient random data";
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t offset;
|
||||
int32_t n = janet_getinteger(argv, 0);
|
||||
if (n < 0) janet_panic("expected positive integer");
|
||||
if (argc == 2) {
|
||||
buffer = janet_getbuffer(argv, 1);
|
||||
offset = buffer->count;
|
||||
} else {
|
||||
offset = 0;
|
||||
buffer = janet_buffer(n);
|
||||
}
|
||||
/* We could optimize here by adding setcount_uninit */
|
||||
janet_buffer_setcount(buffer, offset + n);
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
for (int32_t i = offset; i < buffer->count; i += sizeof(unsigned int)) {
|
||||
unsigned int v;
|
||||
if (rand_s(&v))
|
||||
janet_panic(genericerr);
|
||||
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < buffer->count); j++) {
|
||||
buffer->data[i + j] = v & 0xff;
|
||||
v = v >> 8;
|
||||
}
|
||||
}
|
||||
#elif defined(JANET_LINUX)
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros.
|
||||
In both cases, use this fallback path for now... */
|
||||
int rc;
|
||||
int randfd;
|
||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY));
|
||||
if (randfd < 0)
|
||||
janet_panic(genericerr);
|
||||
while (n > 0) {
|
||||
ssize_t nread;
|
||||
RETRY_EINTR(nread, read(randfd, buffer->data + offset, n));
|
||||
if (nread <= 0) {
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
janet_panic(genericerr);
|
||||
}
|
||||
offset += nread;
|
||||
n -= nread;
|
||||
}
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
#elif defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
(void) genericerr;
|
||||
arc4random_buf(buffer->data + offset, n);
|
||||
#else
|
||||
(void) genericerr;
|
||||
janet_panic("cryptorand currently unsupported on this platform");
|
||||
#endif
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static Janet os_date(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 2);
|
||||
(void) argv;
|
||||
@@ -529,7 +621,7 @@ static Janet os_link(int32_t argc, Janet *argv) {
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
int res = ((argc == 3 && janet_getboolean(argv, 2)) ? symlink : link)(oldpath, newpath);
|
||||
if (res == -1) janet_panic(strerror(errno));
|
||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
||||
return janet_wrap_integer(res);
|
||||
#endif
|
||||
}
|
||||
@@ -553,7 +645,7 @@ static Janet os_rmdir(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
int res = rmdir(path);
|
||||
#endif
|
||||
if (res == -1) janet_panic(strerror(errno));
|
||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -565,7 +657,7 @@ static Janet os_cd(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
int res = chdir(path);
|
||||
#endif
|
||||
if (res == -1) janet_panic(strerror(errno));
|
||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -593,7 +685,7 @@ static Janet os_remove(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
int status = remove(path);
|
||||
if (-1 == status) janet_panic(strerror(errno));
|
||||
if (-1 == status) janet_panicf("%s: %s", strerror(errno), path);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -849,6 +941,11 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:unknown\n")
|
||||
},
|
||||
#ifndef JANET_REDUCED_OS
|
||||
{
|
||||
"os/environ", os_environ,
|
||||
JDOC("(os/environ)\n\n"
|
||||
"Get a copy of the os environment table.")
|
||||
},
|
||||
{
|
||||
"os/dir", os_dir,
|
||||
JDOC("(os/dir dir &opt array)\n\n"
|
||||
@@ -952,6 +1049,11 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/cwd)\n\n"
|
||||
"Returns the current working directory.")
|
||||
},
|
||||
{
|
||||
"os/cryptorand", os_cryptorand,
|
||||
JDOC("(os/cryptorand n &opt buf)\n\n"
|
||||
"Get or append n bytes of good quality random data provided by the os. Returns a new buffer or buf.")
|
||||
},
|
||||
{
|
||||
"os/date", os_date,
|
||||
JDOC("(os/date &opt time local)\n\n"
|
||||
|
||||
@@ -38,7 +38,7 @@ static int is_whitespace(uint8_t c) {
|
||||
|
||||
/* Code generated by tools/symcharsgen.c.
|
||||
* The table contains 256 bits, where each bit is 1
|
||||
* if the corresponding ascci code is a symbol char, and 0
|
||||
* if the corresponding ascii code is a symbol char, and 0
|
||||
* if not. The upper characters are also considered symbol
|
||||
* chars and are then checked for utf-8 compliance. */
|
||||
static const uint32_t symchars[8] = {
|
||||
@@ -233,7 +233,7 @@ static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
p->error = "invalid hex digit in hex escape";
|
||||
return 1;
|
||||
}
|
||||
state->argn = (state->argn << 4) + digit;;
|
||||
state->argn = (state->argn << 4) + digit;
|
||||
state->counter--;
|
||||
if (!state->counter) {
|
||||
push_buf(p, (state->argn & 0xFF));
|
||||
@@ -329,6 +329,12 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int start_dig = p->buf[0] >= '0' && p->buf[0] <= '9';
|
||||
int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
|
||||
if (p->buf[0] == ':') {
|
||||
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
||||
int valid = (!state->argn) || valid_utf8(p->buf + 1, blen - 1);
|
||||
if (!valid) {
|
||||
p->error = "invalid utf-8 in keyword";
|
||||
return 0;
|
||||
}
|
||||
ret = janet_keywordv(p->buf + 1, blen - 1);
|
||||
} else if (start_num && !janet_scan_number(p->buf, blen, &numval)) {
|
||||
ret = janet_wrap_number(numval);
|
||||
@@ -338,7 +344,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
ret = janet_wrap_false();
|
||||
} else if (!check_str_const("true", p->buf, blen)) {
|
||||
ret = janet_wrap_true();
|
||||
} else if (p->buf) {
|
||||
} else {
|
||||
if (start_dig) {
|
||||
p->error = "symbol literal cannot start with a digit";
|
||||
return 0;
|
||||
@@ -351,9 +357,6 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
}
|
||||
ret = janet_symbolv(p->buf, blen);
|
||||
}
|
||||
} else {
|
||||
p->error = "empty symbol invalid";
|
||||
return 0;
|
||||
}
|
||||
p->bufcount = 0;
|
||||
popstate(p, ret);
|
||||
@@ -727,7 +730,7 @@ static int parsergc(void *p, size_t size) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static Janet parserget(void *p, Janet key);
|
||||
static int parserget(void *p, Janet key, Janet *out);
|
||||
|
||||
static JanetAbstractType janet_parse_parsertype = {
|
||||
"core/parser",
|
||||
@@ -1052,10 +1055,10 @@ static const JanetMethod parser_methods[] = {
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet parserget(void *p, Janet key) {
|
||||
static int parserget(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) janet_panicf("expected keyword method");
|
||||
return janet_getmethod(janet_unwrap_keyword(key), parser_methods);
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), parser_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg parse_cfuns[] = {
|
||||
|
||||
@@ -445,6 +445,7 @@ tail:
|
||||
|
||||
typedef struct {
|
||||
JanetTable *grammar;
|
||||
JanetTable *default_grammar;
|
||||
JanetTable *tags;
|
||||
Janet *constants;
|
||||
uint32_t *bytecode;
|
||||
@@ -886,9 +887,14 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
int i = JANET_RECURSION_GUARD;
|
||||
JanetTable *grammar = old_grammar;
|
||||
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
|
||||
peg = janet_table_get_ex(grammar, peg, &grammar);
|
||||
if (!grammar || janet_checktype(peg, JANET_NIL))
|
||||
peg_panic(b, "unkown rule");
|
||||
Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
|
||||
if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
|
||||
nextPeg = janet_table_get(b->default_grammar, peg);
|
||||
if (janet_checktype(nextPeg, JANET_NIL)) {
|
||||
peg_panic(b, "unknown rule");
|
||||
}
|
||||
}
|
||||
peg = nextPeg;
|
||||
b->form = peg;
|
||||
b->grammar = grammar;
|
||||
}
|
||||
@@ -1017,6 +1023,7 @@ static void peg_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
Peg *peg = (Peg *)p;
|
||||
janet_marshal_size(ctx, peg->bytecode_len);
|
||||
janet_marshal_int(ctx, (int32_t)peg->num_constants);
|
||||
janet_marshal_abstract(ctx, p);
|
||||
for (size_t i = 0; i < peg->bytecode_len; i++)
|
||||
janet_marshal_int(ctx, (int32_t) peg->bytecode[i]);
|
||||
for (uint32_t j = 0; j < peg->num_constants; j++)
|
||||
@@ -1030,25 +1037,28 @@ static size_t size_padded(size_t offset, size_t size) {
|
||||
return x - (x % size);
|
||||
}
|
||||
|
||||
static void peg_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
char *mem = p;
|
||||
Peg *peg = (Peg *)p;
|
||||
peg->bytecode_len = janet_unmarshal_size(ctx);
|
||||
peg->num_constants = (uint32_t) janet_unmarshal_int(ctx);
|
||||
static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
size_t bytecode_len = janet_unmarshal_size(ctx);
|
||||
uint32_t num_constants = (uint32_t) janet_unmarshal_int(ctx);
|
||||
|
||||
/* Calculate offsets. Should match those in make_peg */
|
||||
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||
size_t bytecode_size = peg->bytecode_len * sizeof(uint32_t);
|
||||
size_t bytecode_size = bytecode_len * sizeof(uint32_t);
|
||||
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
|
||||
size_t total_size = constants_start + sizeof(Janet) * num_constants;
|
||||
|
||||
/* DOS prevention? I.E. we could read bytecode and constants before
|
||||
* hand so we don't allocated a ton of memory on bad, short input */
|
||||
|
||||
/* Allocate PEG */
|
||||
char *mem = janet_unmarshal_abstract(ctx, total_size);
|
||||
Peg *peg = (Peg *)mem;
|
||||
uint32_t *bytecode = (uint32_t *)(mem + bytecode_start);
|
||||
Janet *constants = (Janet *)(mem + constants_start);
|
||||
peg->bytecode = NULL;
|
||||
peg->constants = NULL;
|
||||
|
||||
/* Ensure not too large */
|
||||
if (constants_start + sizeof(Janet) * peg->num_constants > janet_abstract_size(p)) {
|
||||
janet_panic("size mismatch");
|
||||
}
|
||||
peg->bytecode_len = bytecode_len;
|
||||
peg->num_constants = num_constants;
|
||||
|
||||
for (size_t i = 0; i < peg->bytecode_len; i++)
|
||||
bytecode[i] = (uint32_t) janet_unmarshal_int(ctx);
|
||||
@@ -1176,18 +1186,20 @@ static void peg_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
peg->bytecode = bytecode;
|
||||
peg->constants = constants;
|
||||
free(op_flags);
|
||||
return;
|
||||
return peg;
|
||||
|
||||
bad:
|
||||
free(op_flags);
|
||||
janet_panic("invalid peg bytecode");
|
||||
}
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
|
||||
|
||||
static const JanetAbstractType peg_type = {
|
||||
"core/peg",
|
||||
NULL,
|
||||
peg_mark,
|
||||
NULL,
|
||||
cfun_peg_getter,
|
||||
NULL,
|
||||
peg_marshal,
|
||||
peg_unmarshal,
|
||||
@@ -1216,6 +1228,7 @@ static Peg *make_peg(Builder *b) {
|
||||
static Peg *compile_peg(Janet x) {
|
||||
Builder builder;
|
||||
builder.grammar = janet_table(0);
|
||||
builder.default_grammar = janet_get_core_table("default-peg-grammar");
|
||||
builder.tags = janet_table(0);
|
||||
builder.constants = NULL;
|
||||
builder.bytecode = NULL;
|
||||
@@ -1272,6 +1285,15 @@ static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
|
||||
(void) a;
|
||||
if (janet_keyeq(key, "match")) {
|
||||
*out = janet_wrap_cfunction(cfun_peg_match);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static const JanetReg peg_cfuns[] = {
|
||||
{
|
||||
"peg/compile", cfun_peg_compile,
|
||||
|
||||
@@ -27,6 +27,7 @@
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
/* Implements a pretty printer for Janet. The pretty printer
|
||||
@@ -37,7 +38,12 @@
|
||||
|
||||
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%g", x);
|
||||
/* Use int32_t range for valid integers because that is the
|
||||
* range most integer-expecting functions in the C api use. */
|
||||
const char *fmt = (x == floor(x) &&
|
||||
x <= ((double) INT32_MAX) &&
|
||||
x >= ((double) INT32_MIN)) ? "%.0f" : "%g";
|
||||
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
|
||||
buffer->count += count;
|
||||
}
|
||||
|
||||
@@ -253,11 +259,13 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
default:
|
||||
janet_description_b(buffer, x);
|
||||
break;
|
||||
case JANET_BUFFER:
|
||||
janet_buffer_push_bytes(buffer,
|
||||
janet_unwrap_buffer(x)->data,
|
||||
janet_unwrap_buffer(x)->count);
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *to = janet_unwrap_buffer(x);
|
||||
/* Prevent resizing buffer while appending */
|
||||
if (buffer == to) janet_buffer_extra(buffer, to->count);
|
||||
janet_buffer_push_bytes(buffer, to->data, to->count);
|
||||
break;
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
|
||||
@@ -55,7 +55,11 @@ static JanetSlot qq_slots(JanetFopts opts, JanetSlot *slots, int makeop) {
|
||||
return target;
|
||||
}
|
||||
|
||||
static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
||||
static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
||||
if (depth == 0) {
|
||||
janetc_cerror(opts.compiler, "quasiquote too deeply nested");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
JanetSlot *slots = NULL;
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
@@ -66,11 +70,18 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
||||
len = janet_tuple_length(tup);
|
||||
if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) {
|
||||
const uint8_t *head = janet_unwrap_symbol(tup[0]);
|
||||
if (!janet_cstrcmp(head, "unquote"))
|
||||
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
|
||||
if (!janet_cstrcmp(head, "unquote")) {
|
||||
if (level == 0) {
|
||||
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
|
||||
} else {
|
||||
level--;
|
||||
}
|
||||
} else if (!janet_cstrcmp(head, "quasiquote")) {
|
||||
level++;
|
||||
}
|
||||
}
|
||||
for (i = 0; i < len; i++)
|
||||
janet_v_push(slots, quasiquote(opts, tup[i]));
|
||||
janet_v_push(slots, quasiquote(opts, tup[i], depth - 1, level));
|
||||
return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||
? JOP_MAKE_BRACKET_TUPLE
|
||||
: JOP_MAKE_TUPLE);
|
||||
@@ -79,7 +90,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
||||
int32_t i;
|
||||
JanetArray *array = janet_unwrap_array(x);
|
||||
for (i = 0; i < array->count; i++)
|
||||
janet_v_push(slots, quasiquote(opts, array->data[i]));
|
||||
janet_v_push(slots, quasiquote(opts, array->data[i], depth - 1, level));
|
||||
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
||||
}
|
||||
case JANET_TABLE:
|
||||
@@ -88,8 +99,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
||||
int32_t len, cap = 0;
|
||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
||||
JanetSlot key = quasiquote(opts, kv->key);
|
||||
JanetSlot value = quasiquote(opts, kv->value);
|
||||
JanetSlot key = quasiquote(opts, kv->key, depth - 1, level);
|
||||
JanetSlot value = quasiquote(opts, kv->value, depth - 1, level);
|
||||
key.flags &= ~JANET_SLOT_SPLICED;
|
||||
value.flags &= ~JANET_SLOT_SPLICED;
|
||||
janet_v_push(slots, key);
|
||||
@@ -106,7 +117,7 @@ static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *a
|
||||
janetc_cerror(opts.compiler, "expected 1 argument");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
return quasiquote(opts, argv[0]);
|
||||
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
|
||||
}
|
||||
|
||||
static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
@@ -146,7 +157,7 @@ static int destructure(JanetCompiler *c,
|
||||
janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
|
||||
} else {
|
||||
JanetSlot k = janetc_cslot(janet_wrap_integer(i));
|
||||
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
|
||||
janetc_emit_sss(c, JOP_IN, nextright, right, k, 1);
|
||||
}
|
||||
if (destructure(c, subval, nextright, leaf, attr))
|
||||
janetc_freeslot(c, nextright);
|
||||
@@ -162,7 +173,7 @@ static int destructure(JanetCompiler *c,
|
||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||
JanetSlot nextright = janetc_farslot(c);
|
||||
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
|
||||
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
|
||||
janetc_emit_sss(c, JOP_IN, nextright, right, k, 1);
|
||||
if (destructure(c, kvs[i].value, nextright, leaf, attr))
|
||||
janetc_freeslot(c, nextright);
|
||||
}
|
||||
|
||||
@@ -32,6 +32,9 @@
|
||||
* be in it. However, thread local global variables for interpreter
|
||||
* state should allow easy multi-threading. */
|
||||
|
||||
/* Cache the core environment */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
|
||||
/* How many VM stacks have been entered */
|
||||
extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||
|
||||
@@ -70,4 +73,10 @@ extern JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
/* Setup / teardown */
|
||||
#ifdef JANET_THREADS
|
||||
void janet_threads_init(void);
|
||||
void janet_threads_deinit(void);
|
||||
#endif
|
||||
|
||||
#endif /* JANET_STATE_H_defined */
|
||||
|
||||
@@ -404,7 +404,6 @@ static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
|
||||
bitset[index] |= mask;
|
||||
}
|
||||
/* Check set */
|
||||
if (str.len == 0) return janet_wrap_false();
|
||||
for (int32_t i = 0; i < str.len; i++) {
|
||||
int index = str.bytes[i] >> 5;
|
||||
uint32_t mask = 1 << (str.bytes[i] & 0x1F);
|
||||
@@ -526,7 +525,8 @@ static const JanetReg string_cfuns[] = {
|
||||
"Returns a substring from a byte sequence. The substring is from "
|
||||
"index start inclusive to index end exclusive. All indexing "
|
||||
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
||||
"from the end of the string.")
|
||||
"from the end of the string. Note that index -1 is synonymous with "
|
||||
"index (length bytes) to allow a full negative slice range. ")
|
||||
},
|
||||
{
|
||||
"string/repeat", cfun_string_repeat,
|
||||
@@ -613,8 +613,9 @@ static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/check-set", cfun_string_checkset,
|
||||
JDOC("(string/check-set set str)\n\n"
|
||||
"Checks if any of the bytes in the string set appear in the string str. "
|
||||
"Returns true if some bytes in set do appear in str, false if no bytes do.")
|
||||
"Checks that the string str only contains bytes that appear in the string set. "
|
||||
"Returns true if all bytes in str appear in set, false if some bytes in str do "
|
||||
"not appear in set.")
|
||||
},
|
||||
{
|
||||
"string/join", cfun_string_join,
|
||||
|
||||
@@ -196,7 +196,7 @@ static double bignat_extract(struct BigNat *mant, int32_t exponent2) {
|
||||
|
||||
/* Read in a mantissa and exponent of a certain base, and give
|
||||
* back the double value. Should properly handle 0s, infinities, and
|
||||
* denormalized numbers. (When the exponent values are too large) */
|
||||
* denormalized numbers. (When the exponent values are too large or small) */
|
||||
static double convert(
|
||||
int negative,
|
||||
struct BigNat *mant,
|
||||
@@ -205,11 +205,20 @@ static double convert(
|
||||
|
||||
int32_t exponent2 = 0;
|
||||
|
||||
/* Short circuit zero and huge numbers */
|
||||
/* Approximate exponent in base 2 of mant and exponent. This should get us a good estimate of the final size of the
|
||||
* number, within * 2^32 or so. */
|
||||
int32_t mant_exp2_approx = mant->n * 32 + 16;
|
||||
int32_t exp_exp2_approx = (int32_t)(floor(log2(base) * exponent));
|
||||
int32_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
|
||||
|
||||
/* Short circuit zero, huge, and small numbers. We use the exponent range of valid IEEE754 doubles (-1022, 1023)
|
||||
* with a healthy buffer to allow for inaccuracies in the approximation and denormailzed numbers. */
|
||||
if (mant->n == 0 && mant->first_digit == 0)
|
||||
return negative ? -0.0 : 0.0;
|
||||
if (exponent > 1023)
|
||||
if (exp2_approx > 1176)
|
||||
return negative ? -INFINITY : INFINITY;
|
||||
if (exp2_approx < -1175)
|
||||
return negative ? -0.0 : 0.0;
|
||||
|
||||
/* Final value is X = mant * base ^ exponent * 2 ^ exponent2
|
||||
* Get exponent to zero while holding X constant. */
|
||||
@@ -326,7 +335,7 @@ int janet_scan_number(
|
||||
/* Read exponent */
|
||||
if (str < end && foundexp) {
|
||||
int eneg = 0;
|
||||
int ee = 0;
|
||||
int32_t ee = 0;
|
||||
seenadigit = 0;
|
||||
str++;
|
||||
if (str >= end) goto error;
|
||||
@@ -341,10 +350,12 @@ int janet_scan_number(
|
||||
str++;
|
||||
seenadigit = 1;
|
||||
}
|
||||
while (str < end && ee < (INT32_MAX / 40)) {
|
||||
while (str < end) {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str > 127 || digit >= base) goto error;
|
||||
ee = base * ee + digit;
|
||||
if (ee < (INT32_MAX / 40)) {
|
||||
ee = base * ee + digit;
|
||||
}
|
||||
str++;
|
||||
seenadigit = 1;
|
||||
}
|
||||
|
||||
650
src/core/thread.c
Normal file
650
src/core/thread.c
Normal file
@@ -0,0 +1,650 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_THREADS
|
||||
|
||||
#include <math.h>
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <setjmp.h>
|
||||
#include <time.h>
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
|
||||
/* typedefed in janet.h */
|
||||
struct JanetMailbox {
|
||||
|
||||
/* Synchronization */
|
||||
#ifdef JANET_WINDOWS
|
||||
CRITICAL_SECTION lock;
|
||||
CONDITION_VARIABLE cond;
|
||||
#else
|
||||
pthread_mutex_t lock;
|
||||
pthread_cond_t cond;
|
||||
#endif
|
||||
|
||||
/* Receiving messages - (only by owner thread) */
|
||||
JanetTable *decode;
|
||||
|
||||
/* Setup procedure - requires a parent mailbox
|
||||
* to receive thunk from */
|
||||
JanetMailbox *parent;
|
||||
|
||||
/* Memory management - reference counting */
|
||||
int refCount;
|
||||
int closed;
|
||||
|
||||
/* Store messages */
|
||||
uint16_t messageCapacity;
|
||||
uint16_t messageCount;
|
||||
uint16_t messageFirst;
|
||||
uint16_t messageNext;
|
||||
|
||||
/* Buffers to store messages. These buffers are manually allocated, so
|
||||
* are not owned by any thread's GC. */
|
||||
JanetBuffer messages[];
|
||||
};
|
||||
|
||||
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
|
||||
static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
|
||||
|
||||
static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, uint16_t capacity) {
|
||||
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * capacity);
|
||||
if (NULL == mailbox) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
InitializeCriticalSection(&mailbox->lock);
|
||||
InitializeConditionVariable(&mailbox->cond);
|
||||
#else
|
||||
pthread_mutex_init(&mailbox->lock, NULL);
|
||||
pthread_cond_init(&mailbox->cond, NULL);
|
||||
#endif
|
||||
mailbox->refCount = refCount;
|
||||
mailbox->closed = 0;
|
||||
mailbox->parent = parent;
|
||||
mailbox->messageCount = 0;
|
||||
mailbox->messageCapacity = capacity;
|
||||
mailbox->messageFirst = 0;
|
||||
mailbox->messageNext = 0;
|
||||
for (uint16_t i = 0; i < capacity; i++) {
|
||||
janet_buffer_init(mailbox->messages + i, 0);
|
||||
}
|
||||
return mailbox;
|
||||
}
|
||||
|
||||
static void janet_mailbox_destroy(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
DeleteCriticalSection(&mailbox->lock);
|
||||
#else
|
||||
pthread_mutex_destroy(&mailbox->lock);
|
||||
pthread_cond_destroy(&mailbox->cond);
|
||||
#endif
|
||||
for (uint16_t i = 0; i < mailbox->messageCapacity; i++) {
|
||||
janet_buffer_deinit(mailbox->messages + i);
|
||||
}
|
||||
free(mailbox);
|
||||
}
|
||||
|
||||
static void janet_mailbox_lock(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
EnterCriticalSection(&mailbox->lock);
|
||||
#else
|
||||
pthread_mutex_lock(&mailbox->lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
static void janet_mailbox_unlock(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
LeaveCriticalSection(&mailbox->lock);
|
||||
#else
|
||||
pthread_mutex_unlock(&mailbox->lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Assumes you have the mailbox lock already */
|
||||
static void janet_mailbox_ref_with_lock(JanetMailbox *mailbox, int delta) {
|
||||
mailbox->refCount += delta;
|
||||
if (mailbox->refCount <= 0) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
janet_mailbox_destroy(mailbox);
|
||||
} else {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
}
|
||||
}
|
||||
|
||||
static void janet_mailbox_ref(JanetMailbox *mailbox, int delta) {
|
||||
janet_mailbox_lock(mailbox);
|
||||
janet_mailbox_ref_with_lock(mailbox, delta);
|
||||
}
|
||||
|
||||
static void janet_close_thread(JanetThread *thread) {
|
||||
if (thread->mailbox) {
|
||||
janet_mailbox_ref(thread->mailbox, -1);
|
||||
thread->mailbox = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
static int thread_gc(void *p, size_t size) {
|
||||
(void) size;
|
||||
JanetThread *thread = (JanetThread *)p;
|
||||
janet_close_thread(thread);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int thread_mark(void *p, size_t size) {
|
||||
(void) size;
|
||||
JanetThread *thread = (JanetThread *)p;
|
||||
if (thread->encode) {
|
||||
janet_mark(janet_wrap_table(thread->encode));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Abstract waiting for timeout across windows/posix */
|
||||
typedef struct {
|
||||
int timedwait;
|
||||
int nowait;
|
||||
#ifdef JANET_WINDOWS
|
||||
DWORD interval;
|
||||
DWORD ticksLeft;
|
||||
#else
|
||||
struct timespec ts;
|
||||
#endif
|
||||
} JanetWaiter;
|
||||
|
||||
static void janet_waiter_init(JanetWaiter *waiter, double sec) {
|
||||
waiter->timedwait = 0;
|
||||
waiter->nowait = 0;
|
||||
|
||||
if (sec <= 0.0 || isnan(sec)) {
|
||||
waiter->nowait = 1;
|
||||
return;
|
||||
}
|
||||
waiter->timedwait = sec > 0.0 && !isinf(sec);
|
||||
|
||||
/* Set maximum wait time to 30 days */
|
||||
if (sec > (60.0 * 60.0 * 24.0 * 30.0)) {
|
||||
sec = 60.0 * 60.0 * 24.0 * 30.0;
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
if (waiter->timedwait) {
|
||||
waiter->ticksLeft = waiter->interval = (DWORD) floor(1000.0 * sec);
|
||||
}
|
||||
#else
|
||||
if (waiter->timedwait) {
|
||||
/* N seconds -> timespec of (now + sec) */
|
||||
struct timespec now;
|
||||
clock_gettime(CLOCK_REALTIME, &now);
|
||||
time_t tvsec = (time_t) floor(sec);
|
||||
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
|
||||
tvsec += now.tv_sec;
|
||||
tvnsec += now.tv_nsec;
|
||||
if (tvnsec >= 1000000000L) {
|
||||
tvnsec -= 1000000000L;
|
||||
tvsec += 1;
|
||||
}
|
||||
waiter->ts.tv_sec = tvsec;
|
||||
waiter->ts.tv_nsec = tvnsec;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
static int janet_waiter_wait(JanetWaiter *wait, JanetMailbox *mailbox) {
|
||||
if (wait->nowait) return 1;
|
||||
#ifdef JANET_WINDOWS
|
||||
if (wait->timedwait) {
|
||||
if (wait->ticksLeft == 0) return 1;
|
||||
DWORD startTime = GetTickCount();
|
||||
int status = !SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, wait->ticksLeft);
|
||||
DWORD dTick = GetTickCount() - startTime;
|
||||
/* Be careful about underflow */
|
||||
wait->ticksLeft = dTick > wait->ticksLeft ? 0 : dTick;
|
||||
return status;
|
||||
} else {
|
||||
SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, INFINITE);
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
if (wait->timedwait) {
|
||||
return pthread_cond_timedwait(&mailbox->cond, &mailbox->lock, &wait->ts);
|
||||
} else {
|
||||
pthread_cond_wait(&mailbox->cond, &mailbox->lock);
|
||||
return 0;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
static void janet_mailbox_wakeup(JanetMailbox *mailbox) {
|
||||
#ifdef JANET_WINDOWS
|
||||
WakeConditionVariable(&mailbox->cond);
|
||||
#else
|
||||
pthread_cond_signal(&mailbox->cond);
|
||||
#endif
|
||||
}
|
||||
|
||||
static int mailbox_at_capacity(JanetMailbox *mailbox) {
|
||||
return mailbox->messageCount >= mailbox->messageCapacity;
|
||||
}
|
||||
|
||||
/* Returns 1 if could not send (encode error or timeout), 2 for mailbox closed, and
|
||||
* 0 otherwise. Will not panic. */
|
||||
int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
|
||||
|
||||
/* Ensure mailbox is not closed. */
|
||||
JanetMailbox *mailbox = thread->mailbox;
|
||||
if (NULL == mailbox) return 2;
|
||||
janet_mailbox_lock(mailbox);
|
||||
if (mailbox->closed) {
|
||||
janet_mailbox_ref_with_lock(mailbox, -1);
|
||||
thread->mailbox = NULL;
|
||||
return 2;
|
||||
}
|
||||
|
||||
/* Back pressure */
|
||||
if (mailbox_at_capacity(mailbox)) {
|
||||
JanetWaiter wait;
|
||||
janet_waiter_init(&wait, timeout);
|
||||
|
||||
if (wait.nowait) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Retry loop, as there can be multiple writers */
|
||||
while (mailbox_at_capacity(mailbox)) {
|
||||
if (janet_waiter_wait(&wait, mailbox)) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
janet_mailbox_wakeup(mailbox);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Hack to capture all panics from marshalling. This works because
|
||||
* we know janet_marshal won't mess with other essential global state. */
|
||||
jmp_buf buf;
|
||||
jmp_buf *old_buf = janet_vm_jmp_buf;
|
||||
janet_vm_jmp_buf = &buf;
|
||||
int32_t oldmcount = mailbox->messageCount;
|
||||
|
||||
int ret = 0;
|
||||
if (setjmp(buf)) {
|
||||
ret = 1;
|
||||
mailbox->messageCount = oldmcount;
|
||||
} else {
|
||||
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageNext;
|
||||
msgbuf->count = 0;
|
||||
|
||||
/* Start panic zone */
|
||||
janet_marshal(msgbuf, msg, thread->encode, 0);
|
||||
/* End panic zone */
|
||||
|
||||
mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
|
||||
mailbox->messageCount++;
|
||||
}
|
||||
|
||||
/* Cleanup */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
janet_mailbox_unlock(mailbox);
|
||||
|
||||
/* Potentially wake up a blocked thread */
|
||||
janet_mailbox_wakeup(mailbox);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Returns 0 on successful message. Returns 1 if timedout */
|
||||
int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
JanetMailbox *mailbox = janet_vm_mailbox;
|
||||
janet_mailbox_lock(mailbox);
|
||||
|
||||
/* For timeouts */
|
||||
JanetWaiter wait;
|
||||
janet_waiter_init(&wait, timeout);
|
||||
|
||||
for (;;) {
|
||||
|
||||
/* Check for messages waiting for us */
|
||||
if (mailbox->messageCount > 0) {
|
||||
|
||||
/* Hack to capture all panics from marshalling. This works because
|
||||
* we know janet_marshal won't mess with other essential global state. */
|
||||
jmp_buf buf;
|
||||
jmp_buf *old_buf = janet_vm_jmp_buf;
|
||||
janet_vm_jmp_buf = &buf;
|
||||
|
||||
/* Handle errors */
|
||||
if (setjmp(buf)) {
|
||||
/* Cleanup jmp_buf, keep lock */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
} else {
|
||||
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst;
|
||||
mailbox->messageCount--;
|
||||
mailbox->messageFirst = (mailbox->messageFirst + 1) % mailbox->messageCapacity;
|
||||
|
||||
/* Read from beginning of channel */
|
||||
const uint8_t *nextItem = NULL;
|
||||
Janet item = janet_unmarshal(
|
||||
msgbuf->data, msgbuf->count,
|
||||
0, mailbox->decode, &nextItem);
|
||||
*msg_out = item;
|
||||
|
||||
/* Cleanup */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
janet_mailbox_unlock(mailbox);
|
||||
|
||||
/* Potentially wake up pending threads */
|
||||
janet_mailbox_wakeup(mailbox);
|
||||
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
if (wait.nowait) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Wait for next message */
|
||||
if (janet_waiter_wait(&wait, mailbox)) {
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static int janet_thread_getter(void *p, Janet key, Janet *out);
|
||||
|
||||
static JanetAbstractType Thread_AT = {
|
||||
"core/thread",
|
||||
thread_gc,
|
||||
thread_mark,
|
||||
janet_thread_getter,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
};
|
||||
|
||||
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
|
||||
JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread));
|
||||
thread->mailbox = mailbox;
|
||||
thread->encode = encode;
|
||||
return thread;
|
||||
}
|
||||
|
||||
JanetThread *janet_getthread(const Janet *argv, int32_t n) {
|
||||
return (JanetThread *) janet_getabstract(argv, n, &Thread_AT);
|
||||
}
|
||||
|
||||
/* Runs in new thread */
|
||||
static int thread_worker(JanetMailbox *mailbox) {
|
||||
JanetFiber *fiber = NULL;
|
||||
Janet out;
|
||||
|
||||
/* Use the mailbox we were given */
|
||||
janet_vm_mailbox = mailbox;
|
||||
|
||||
/* Init VM */
|
||||
janet_init();
|
||||
|
||||
/* Get dictionaries for default encode/decode */
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
mailbox->decode = janet_get_core_table("load-image-dict");
|
||||
|
||||
/* Create parent thread */
|
||||
JanetThread *parent = janet_make_thread(mailbox->parent, encode);
|
||||
janet_mailbox_ref(mailbox->parent, -1);
|
||||
mailbox->parent = NULL; /* only used to create the thread */
|
||||
Janet parentv = janet_wrap_abstract(parent);
|
||||
|
||||
/* Unmarshal the function */
|
||||
Janet funcv;
|
||||
int status = janet_thread_receive(&funcv, INFINITY);
|
||||
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
|
||||
JanetFunction *func = janet_unwrap_function(funcv);
|
||||
|
||||
/* Arity check */
|
||||
if (func->def->min_arity > 1 || func->def->max_arity < 1) {
|
||||
goto error;
|
||||
}
|
||||
|
||||
/* Call function */
|
||||
Janet argv[1] = { parentv };
|
||||
fiber = janet_fiber(func, 64, 1, argv);
|
||||
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (sig != JANET_SIGNAL_OK) {
|
||||
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(mailbox, encode)));
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
/* Normal exit */
|
||||
janet_deinit();
|
||||
return 0;
|
||||
|
||||
/* Fail to set something up */
|
||||
error:
|
||||
janet_eprintf("\nthread failed to start\n");
|
||||
janet_deinit();
|
||||
return 1;
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
|
||||
thread_worker((JanetMailbox *)param);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetThread *thread) {
|
||||
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, thread->mailbox, 0, NULL);
|
||||
int ret = NULL == handle;
|
||||
/* Does not kill thread, simply detatches */
|
||||
if (!ret) CloseHandle(handle);
|
||||
return ret;
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
static void *janet_pthread_wrapper(void *param) {
|
||||
thread_worker((JanetMailbox *)param);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetThread *thread) {
|
||||
pthread_t handle;
|
||||
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, thread->mailbox);
|
||||
if (error) {
|
||||
return 1;
|
||||
} else {
|
||||
pthread_detach(handle);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Setup/Teardown
|
||||
*/
|
||||
|
||||
void janet_threads_init(void) {
|
||||
if (NULL == janet_vm_mailbox) {
|
||||
janet_vm_mailbox = janet_mailbox_create(NULL, 1, 10);
|
||||
}
|
||||
}
|
||||
|
||||
void janet_threads_deinit(void) {
|
||||
janet_mailbox_lock(janet_vm_mailbox);
|
||||
janet_vm_mailbox->closed = 1;
|
||||
janet_mailbox_ref_with_lock(janet_vm_mailbox, -1);
|
||||
janet_vm_mailbox = NULL;
|
||||
janet_vm_thread_current = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Cfuns
|
||||
*/
|
||||
|
||||
static Janet cfun_thread_current(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
if (NULL == janet_vm_thread_current) {
|
||||
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
|
||||
janet_mailbox_ref(janet_vm_mailbox, 1);
|
||||
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
|
||||
}
|
||||
return janet_wrap_abstract(janet_vm_thread_current);
|
||||
}
|
||||
|
||||
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
/* Just type checking */
|
||||
janet_getfunction(argv, 0);
|
||||
int32_t cap = janet_optinteger(argv, argc, 1, 10);
|
||||
if (cap < 1 || cap > UINT16_MAX) {
|
||||
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
|
||||
}
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
JanetMailbox *mailbox = janet_mailbox_create(janet_vm_mailbox, 2, (uint16_t) cap);
|
||||
|
||||
/* one for created thread, one for ->parent reference in new mailbox */
|
||||
janet_mailbox_ref(janet_vm_mailbox, 2);
|
||||
|
||||
JanetThread *thread = janet_make_thread(mailbox, encode);
|
||||
if (janet_thread_start_child(thread)) {
|
||||
janet_mailbox_ref(mailbox, -1); /* mailbox reference */
|
||||
janet_mailbox_ref(janet_vm_mailbox, -1); /* ->parent reference */
|
||||
janet_panic("could not start thread");
|
||||
}
|
||||
|
||||
/* If thread started, send the worker function. */
|
||||
if (janet_thread_send(thread, argv[0], INFINITY)) {
|
||||
janet_panicf("could not send worker function %v to thread", argv[0]);
|
||||
}
|
||||
|
||||
return janet_wrap_abstract(thread);
|
||||
}
|
||||
|
||||
static Janet cfun_thread_send(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetThread *thread = janet_getthread(argv, 0);
|
||||
int status = janet_thread_send(thread, argv[1], janet_optnumber(argv, argc, 2, 1.0));
|
||||
switch (status) {
|
||||
default:
|
||||
break;
|
||||
case 1:
|
||||
janet_panicf("failed to send message %v", argv[1]);
|
||||
case 2:
|
||||
janet_panic("thread mailbox is closed");
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
double wait = janet_optnumber(argv, argc, 0, 1.0);
|
||||
Janet out;
|
||||
int status = janet_thread_receive(&out, wait);
|
||||
switch (status) {
|
||||
default:
|
||||
break;
|
||||
case 1:
|
||||
janet_panicf("timeout after %f seconds", wait);
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
static Janet cfun_thread_close(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetThread *thread = janet_getthread(argv, 0);
|
||||
janet_close_thread(thread);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static const JanetMethod janet_thread_methods[] = {
|
||||
{"send", cfun_thread_send},
|
||||
{"close", cfun_thread_close},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int janet_thread_getter(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), janet_thread_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg threadlib_cfuns[] = {
|
||||
{
|
||||
"thread/current", cfun_thread_current,
|
||||
JDOC("(thread/current)\n\n"
|
||||
"Get the current running thread.")
|
||||
},
|
||||
{
|
||||
"thread/new", cfun_thread_new,
|
||||
JDOC("(thread/new func &opt capacity)\n\n"
|
||||
"Start a new thread that will start immediately. "
|
||||
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
|
||||
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
|
||||
"Returns a handle to the new thread.")
|
||||
},
|
||||
{
|
||||
"thread/send", cfun_thread_send,
|
||||
JDOC("(thread/send thread msg)\n\n"
|
||||
"Send a message to the thread. This will never block and returns thread immediately. "
|
||||
"Will throw an error if there is a problem sending the message.")
|
||||
},
|
||||
{
|
||||
"thread/receive", cfun_thread_receive,
|
||||
JDOC("(thread/receive &opt timeout)\n\n"
|
||||
"Get a message sent to this thread. If timeout is provided, an error will be thrown after the timeout has elapsed but "
|
||||
"no messages are received.")
|
||||
},
|
||||
{
|
||||
"thread/close", cfun_thread_close,
|
||||
JDOC("(thread/close thread)\n\n"
|
||||
"Close a thread, unblocking it and ending communication with it. Note that closing "
|
||||
"a thread is idempotent and does not cancel the thread's operation. Returns nil.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_thread(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, threadlib_cfuns);
|
||||
janet_register_abstract_type(&Thread_AT);
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -143,7 +143,10 @@ static const JanetReg tuple_cfuns[] = {
|
||||
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
||||
"Take a sub sequence of an array or tuple from index start "
|
||||
"inclusive to index end exclusive. If start or end are not provided, "
|
||||
"they default to 0 and the length of arrtup respectively."
|
||||
"they default to 0 and the length of arrtup respectively. "
|
||||
"'start' and 'end' can also be negative to indicate indexing "
|
||||
"from the end of the input. Note that index -1 is synonymous with "
|
||||
"index '(length arrtup)' to allow a full negative slice range. "
|
||||
"Returns the new tuple.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -94,17 +94,20 @@ static int ta_buffer_gc(void *p, size_t s) {
|
||||
|
||||
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(void *p, JanetMarshalContext *ctx) {
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||
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 = janet_unmarshal_int(ctx);
|
||||
buf->flags = flags;
|
||||
janet_unmarshal_bytes(ctx, buf->data, size);
|
||||
return buf;
|
||||
}
|
||||
|
||||
static const JanetAbstractType ta_buffer_type = {
|
||||
@@ -128,6 +131,7 @@ static int ta_mark(void *p, size_t s) {
|
||||
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);
|
||||
@@ -135,11 +139,11 @@ static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer));
|
||||
}
|
||||
|
||||
static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
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);
|
||||
@@ -157,54 +161,55 @@ static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
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 Janet ta_getter(void *p, Janet key) {
|
||||
Janet value;
|
||||
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);
|
||||
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) {
|
||||
value = janet_wrap_nil();
|
||||
return 0;
|
||||
} else {
|
||||
switch (array->type) {
|
||||
case JANET_TARRAY_TYPE_U8:
|
||||
value = janet_wrap_number(array->as.u8[i]);
|
||||
*out = janet_wrap_number(array->as.u8[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S8:
|
||||
value = janet_wrap_number(array->as.s8[i]);
|
||||
*out = janet_wrap_number(array->as.s8[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U16:
|
||||
value = janet_wrap_number(array->as.u16[i]);
|
||||
*out = janet_wrap_number(array->as.u16[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S16:
|
||||
value = janet_wrap_number(array->as.s16[i]);
|
||||
*out = janet_wrap_number(array->as.s16[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_U32:
|
||||
value = janet_wrap_number(array->as.u32[i]);
|
||||
*out = janet_wrap_number(array->as.u32[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S32:
|
||||
value = janet_wrap_number(array->as.s32[i]);
|
||||
*out = janet_wrap_number(array->as.s32[i]);
|
||||
break;
|
||||
#ifdef JANET_INT_TYPES
|
||||
case JANET_TARRAY_TYPE_U64:
|
||||
value = janet_wrap_u64(array->as.u64[i]);
|
||||
*out = janet_wrap_u64(array->as.u64[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_S64:
|
||||
value = janet_wrap_s64(array->as.s64[i]);
|
||||
*out = janet_wrap_s64(array->as.s64[i]);
|
||||
break;
|
||||
#endif
|
||||
case JANET_TARRAY_TYPE_F32:
|
||||
value = janet_wrap_number_safe(array->as.f32[i]);
|
||||
*out = janet_wrap_number_safe(array->as.f32[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_F64:
|
||||
value = janet_wrap_number_safe(array->as.f64[i]);
|
||||
*out = janet_wrap_number_safe(array->as.f64[i]);
|
||||
break;
|
||||
default:
|
||||
janet_panicf("cannot get from typed array of type %s",
|
||||
@@ -212,7 +217,7 @@ static Janet ta_getter(void *p, Janet key) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
return value;
|
||||
return 1;
|
||||
}
|
||||
|
||||
static void ta_setter(void *p, Janet key, Janet value) {
|
||||
@@ -445,7 +450,8 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
JanetArray *array = janet_array(range.end - range.start);
|
||||
if (array->data) {
|
||||
for (int32_t i = range.start; i < range.end; i++) {
|
||||
array->data[i - range.start] = ta_getter(src, janet_wrap_number(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;
|
||||
|
||||
@@ -331,18 +331,9 @@ const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
||||
(void) p;
|
||||
Janet key = janet_csymbolv(name);
|
||||
Janet value;
|
||||
/* During init, allow replacing core library cfunctions with values from
|
||||
* the env. */
|
||||
Janet check = janet_table_get(env, key);
|
||||
if (janet_checktype(check, JANET_NIL)) {
|
||||
value = x;
|
||||
} else {
|
||||
value = check;
|
||||
}
|
||||
janet_table_put(env, key, value);
|
||||
if (janet_checktype(value, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, value, key);
|
||||
janet_table_put(env, key, x);
|
||||
if (janet_checktype(x, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, x, key);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -379,6 +370,14 @@ JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out)
|
||||
return JANET_BINDING_DEF;
|
||||
}
|
||||
|
||||
/* Resolve a symbol in the core environment. */
|
||||
Janet janet_resolve_core(const char *name) {
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
Janet out = janet_wrap_nil();
|
||||
janet_resolve(env, janet_csymbol(name), &out);
|
||||
return out;
|
||||
}
|
||||
|
||||
/* Read both tuples and arrays as c pointers + int32_t length. Return 1 if the
|
||||
* view can be constructed, 0 if an invalid type. */
|
||||
int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
@@ -449,3 +448,12 @@ int janet_checksize(Janet x) {
|
||||
return dval == (double)((size_t) dval) &&
|
||||
dval <= SIZE_MAX;
|
||||
}
|
||||
|
||||
JanetTable *janet_get_core_table(const char *name) {
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
Janet out = janet_wrap_nil();
|
||||
JanetBindingType bt = janet_resolve(env, janet_csymbol(name), &out);
|
||||
if (bt == JANET_BINDING_NONE) return NULL;
|
||||
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
||||
return janet_unwrap_table(out);
|
||||
}
|
||||
|
||||
@@ -72,6 +72,7 @@ const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
JanetTable *janet_get_core_table(const char *name);
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
@@ -120,5 +121,8 @@ void janet_lib_typed_array(JanetTable *env);
|
||||
#ifdef JANET_INT_TYPES
|
||||
void janet_lib_inttypes(JanetTable *env);
|
||||
#endif
|
||||
#ifdef JANET_THREADS
|
||||
void janet_lib_thread(JanetTable *env);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -156,7 +156,7 @@ bad:
|
||||
}
|
||||
|
||||
/* Gets a value and returns. Can panic. */
|
||||
Janet janet_get(Janet ds, Janet key) {
|
||||
Janet janet_in(Janet ds, Janet key) {
|
||||
Janet value;
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
@@ -197,7 +197,8 @@ Janet janet_get(Janet ds, Janet key) {
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||
if (type->get) {
|
||||
value = (type->get)(janet_unwrap_abstract(ds), key);
|
||||
if (!(type->get)(janet_unwrap_abstract(ds), key, &value))
|
||||
janet_panicf("key %v not found in %v ", key, ds);
|
||||
} else {
|
||||
janet_panicf("no getter for %v ", ds);
|
||||
}
|
||||
@@ -207,6 +208,60 @@ Janet janet_get(Janet ds, Janet key) {
|
||||
return value;
|
||||
}
|
||||
|
||||
Janet janet_get(Janet ds, Janet key) {
|
||||
JanetType t = janet_type(ds);
|
||||
switch (t) {
|
||||
default:
|
||||
return janet_wrap_nil();
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD: {
|
||||
if (!janet_checkint(key)) return janet_wrap_nil();
|
||||
int32_t index = janet_unwrap_integer(key);
|
||||
if (index < 0) return janet_wrap_nil();
|
||||
const uint8_t *str = janet_unwrap_string(ds);
|
||||
if (index >= janet_string_length(str)) return janet_wrap_nil();
|
||||
return janet_wrap_integer(str[index]);
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
Janet value;
|
||||
void *abst = janet_unwrap_abstract(ds);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get) return janet_wrap_nil();
|
||||
if ((type->get)(abst, key, &value))
|
||||
return value;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE:
|
||||
case JANET_BUFFER: {
|
||||
if (!janet_checkint(key)) return janet_wrap_nil();
|
||||
int32_t index = janet_unwrap_integer(key);
|
||||
if (index < 0) return janet_wrap_nil();
|
||||
if (t == JANET_ARRAY) {
|
||||
JanetArray *a = janet_unwrap_array(ds);
|
||||
if (index >= a->count) return janet_wrap_nil();
|
||||
return a->data[index];
|
||||
} else if (t == JANET_BUFFER) {
|
||||
JanetBuffer *b = janet_unwrap_buffer(ds);
|
||||
if (index >= b->count) return janet_wrap_nil();
|
||||
return janet_wrap_integer(b->data[index]);
|
||||
} else {
|
||||
const Janet *t = janet_unwrap_tuple(ds);
|
||||
if (index >= janet_tuple_length(t)) return janet_wrap_nil();
|
||||
return t[index];
|
||||
}
|
||||
}
|
||||
case JANET_TABLE: {
|
||||
return janet_table_get(janet_unwrap_table(ds), key);
|
||||
}
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *st = janet_unwrap_struct(ds);
|
||||
return janet_struct_get(st, key);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Janet janet_getindex(Janet ds, int32_t index) {
|
||||
Janet value;
|
||||
if (index < 0) janet_panic("expected non-negative index");
|
||||
@@ -253,7 +308,8 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||
if (type->get) {
|
||||
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
|
||||
if (!(type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index), &value))
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
janet_panicf("no getter for %v ", ds);
|
||||
}
|
||||
|
||||
122
src/core/vm.c
122
src/core/vm.c
@@ -30,6 +30,7 @@
|
||||
#endif
|
||||
|
||||
/* VM state */
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
JANET_THREAD_LOCAL int janet_vm_stackn = 0;
|
||||
JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
|
||||
@@ -203,7 +204,7 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
key = callee;
|
||||
}
|
||||
fiber->stacktop = fiber->stackstart;
|
||||
return janet_get(ds, key);
|
||||
return janet_in(ds, key);
|
||||
}
|
||||
|
||||
/* Get a callable from a keyword method name and check ensure that it is valid. */
|
||||
@@ -274,6 +275,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
&&label_JOP_RESUME,
|
||||
&&label_JOP_SIGNAL,
|
||||
&&label_JOP_PROPAGATE,
|
||||
&&label_JOP_IN,
|
||||
&&label_JOP_GET,
|
||||
&&label_JOP_PUT,
|
||||
&&label_JOP_GET_INDEX,
|
||||
@@ -475,7 +477,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#endif
|
||||
@@ -490,21 +491,20 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
* waiting to be resumed. In those cases, use input and increment pc. We
|
||||
* DO NOT use input when resuming a fiber that has been interrupted at a
|
||||
* breakpoint. */
|
||||
uint8_t first_opcode;
|
||||
if (status != JANET_STATUS_NEW &&
|
||||
((*pc & 0xFF) == JOP_SIGNAL ||
|
||||
(*pc & 0xFF) == JOP_PROPAGATE ||
|
||||
(*pc & 0xFF) == JOP_RESUME)) {
|
||||
stack[A] = in;
|
||||
pc++;
|
||||
first_opcode = *pc & 0xFF;
|
||||
} else if (status == JANET_STATUS_DEBUG) {
|
||||
first_opcode = *pc & 0x7F;
|
||||
} else {
|
||||
first_opcode = *pc & 0xFF;
|
||||
}
|
||||
|
||||
/* The first opcode to execute. If the first opcode has
|
||||
* the breakpoint bit set and we were in the debug state, skip
|
||||
* that first breakpoint. */
|
||||
uint8_t first_opcode = (status == JANET_STATUS_DEBUG)
|
||||
? (*pc & 0x7F)
|
||||
: (*pc & 0xFF);
|
||||
|
||||
/* Main interpreter loop. Semantically is a switch on
|
||||
* (*pc & 0xFF) inside of an infinite loop. */
|
||||
VM_START();
|
||||
@@ -894,7 +894,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
JanetFiber *f = janet_unwrap_fiber(fv);
|
||||
JanetFiberStatus sub_status = janet_fiber_status(f);
|
||||
if (sub_status > JANET_STATUS_USER9) {
|
||||
vm_throw("cannot propagate from new or alive fiber");
|
||||
vm_commit();
|
||||
janet_panicf("cannot propagate from fiber with status :%s",
|
||||
janet_status_names[sub_status]);
|
||||
}
|
||||
janet_vm_fiber->child = f;
|
||||
vm_return((int) sub_status, stack[B]);
|
||||
@@ -910,6 +912,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
janet_putindex(stack[A], C, stack[B]);
|
||||
vm_checkgc_pcnext();
|
||||
|
||||
VM_OP(JOP_IN)
|
||||
vm_commit();
|
||||
stack[A] = janet_in(stack[B], stack[C]);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_GET)
|
||||
vm_commit();
|
||||
stack[A] = janet_get(stack[B], stack[C]);
|
||||
@@ -949,8 +956,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
VM_OP(JOP_MAKE_TABLE) {
|
||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||
Janet *mem = fiber->data + fiber->stackstart;
|
||||
if (count & 1)
|
||||
vm_throw("expected even number of arguments to table constructor");
|
||||
if (count & 1) {
|
||||
vm_commit();
|
||||
janet_panicf("expected even number of arguments to table constructor, got %d", count);
|
||||
}
|
||||
JanetTable *table = janet_table(count / 2);
|
||||
for (int32_t i = 0; i < count; i += 2)
|
||||
janet_table_put(table, mem[i], mem[i + 1]);
|
||||
@@ -962,8 +971,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
VM_OP(JOP_MAKE_STRUCT) {
|
||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||
Janet *mem = fiber->data + fiber->stackstart;
|
||||
if (count & 1)
|
||||
vm_throw("expected even number of arguments to struct constructor");
|
||||
if (count & 1) {
|
||||
vm_commit();
|
||||
janet_panicf("expected even number of arguments to struct constructor, got %d", count);
|
||||
}
|
||||
JanetKV *st = janet_struct_begin(count / 2);
|
||||
for (int32_t i = 0; i < count; i += 2)
|
||||
janet_struct_put(st, mem[i], mem[i + 1]);
|
||||
@@ -999,6 +1010,68 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
VM_END()
|
||||
}
|
||||
|
||||
/*
|
||||
* Execute a single instruction in the fiber. Does this by inspecting
|
||||
* the fiber, setting a breakpoint at the next instruction, executing, and
|
||||
* reseting breakpoints to how they were prior. Yes, it's a bit hacky.
|
||||
*/
|
||||
JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
/* No finished or currently alive fibers. */
|
||||
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||
if (status == JANET_STATUS_ALIVE ||
|
||||
status == JANET_STATUS_DEAD ||
|
||||
status == JANET_STATUS_ERROR) {
|
||||
janet_panicf("cannot step fiber with status :%s", janet_status_names[status]);
|
||||
}
|
||||
|
||||
/* Get PC for setting breakpoints */
|
||||
uint32_t *pc = janet_stack_frame(fiber->data + fiber->frame)->pc;
|
||||
|
||||
/* Check current opcode (sans debug flag). This tells us where the next or next two candidate
|
||||
* instructions will be. Usually it's the next instruction in memory,
|
||||
* but for branching instructions it is also the target of the branch. */
|
||||
uint32_t *nexta = NULL, *nextb = NULL, olda = 0, oldb = 0;
|
||||
|
||||
/* Set temporary breakpoints */
|
||||
switch (*pc & 0x7F) {
|
||||
default:
|
||||
nexta = pc + 1;
|
||||
break;
|
||||
/* These we just ignore for now. Supporting them means
|
||||
* we could step into and out of functions (including JOP_CALL). */
|
||||
case JOP_RETURN_NIL:
|
||||
case JOP_RETURN:
|
||||
case JOP_ERROR:
|
||||
case JOP_TAILCALL:
|
||||
break;
|
||||
case JOP_JUMP:
|
||||
nexta = pc + DS;
|
||||
break;
|
||||
case JOP_JUMP_IF:
|
||||
case JOP_JUMP_IF_NOT:
|
||||
nexta = pc + 1;
|
||||
nextb = pc + ES;
|
||||
break;
|
||||
}
|
||||
if (nexta) {
|
||||
olda = *nexta;
|
||||
*nexta |= 0x80;
|
||||
}
|
||||
if (nextb) {
|
||||
oldb = *nextb;
|
||||
*nextb |= 0x80;
|
||||
}
|
||||
|
||||
/* Go */
|
||||
JanetSignal signal = janet_continue(fiber, in, out);
|
||||
|
||||
/* Restore */
|
||||
if (nexta) *nexta = olda;
|
||||
if (nextb) *nextb = oldb;
|
||||
|
||||
return signal;
|
||||
}
|
||||
|
||||
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
/* Check entry conditions */
|
||||
if (!janet_vm_fiber)
|
||||
@@ -1045,7 +1118,9 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
if (old_status == JANET_STATUS_ALIVE ||
|
||||
old_status == JANET_STATUS_DEAD ||
|
||||
old_status == JANET_STATUS_ERROR) {
|
||||
*out = janet_cstringv("cannot resume alive, dead, or errored fiber");
|
||||
const uint8_t *str = janet_formatc("cannot resume fiber with status :%s",
|
||||
janet_status_names[old_status]);
|
||||
*out = janet_wrap_string(str);
|
||||
return JANET_SIGNAL_ERROR;
|
||||
}
|
||||
|
||||
@@ -1078,7 +1153,11 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
|
||||
/* Run loop */
|
||||
JanetSignal signal;
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
if (_setjmp(buf)) {
|
||||
#else
|
||||
if (setjmp(buf)) {
|
||||
#endif
|
||||
signal = JANET_SIGNAL_ERROR;
|
||||
} else {
|
||||
signal = run_vm(fiber, in, old_status);
|
||||
@@ -1126,9 +1205,8 @@ Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT)) {
|
||||
void *abst = janet_unwrap_abstract(argv[0]);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get)
|
||||
if (!type->get || !(type->get)(abst, janet_ckeywordv(name), &method))
|
||||
janet_panicf("abstract value %v does not implement :%s", argv[0], name);
|
||||
method = (type->get)(abst, janet_ckeywordv(name));
|
||||
} else if (janet_checktype(argv[0], JANET_TABLE)) {
|
||||
JanetTable *table = janet_unwrap_table(argv[0]);
|
||||
method = janet_table_get(table, janet_ckeywordv(name));
|
||||
@@ -1171,8 +1249,14 @@ int janet_init(void) {
|
||||
/* Initialize registry */
|
||||
janet_vm_registry = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
/* Core env */
|
||||
janet_vm_core_env = NULL;
|
||||
/* Seed RNG */
|
||||
janet_rng_seed(janet_default_rng(), 0);
|
||||
/* Threads */
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_init();
|
||||
#endif
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1185,4 +1269,8 @@ void janet_deinit(void) {
|
||||
janet_vm_root_count = 0;
|
||||
janet_vm_root_capacity = 0;
|
||||
janet_vm_registry = NULL;
|
||||
janet_vm_core_env = NULL;
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_deinit();
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -45,6 +45,23 @@ extern "C" {
|
||||
* detection for unsupported platforms
|
||||
*/
|
||||
|
||||
/* Check for any flavor of BSD (except apple) */
|
||||
#if defined(__FreeBSD__) || defined(__DragonFly__) || \
|
||||
defined(__NetBSD__) || defined(__OpenBSD__)
|
||||
#define JANET_BSD 1
|
||||
#define _BSD_SOURCE 1
|
||||
#endif
|
||||
|
||||
/* Check for Mac */
|
||||
#ifdef __APPLE__
|
||||
#define JANET_APPLE 1
|
||||
#endif
|
||||
|
||||
/* Check for Linux */
|
||||
#ifdef __linux__
|
||||
#define JANET_LINUX 1
|
||||
#endif
|
||||
|
||||
/* Check Unix */
|
||||
#if defined(_AIX) \
|
||||
|| defined(__APPLE__) /* Darwin */ \
|
||||
@@ -58,11 +75,8 @@ extern "C" {
|
||||
|| defined(__QNXNTO__) \
|
||||
|| defined(sun) || defined(__sun) /* Solaris */ \
|
||||
|| defined(unix) || defined(__unix) || defined(__unix__)
|
||||
#define JANET_UNIX 1
|
||||
/* Enable certain posix features */
|
||||
#ifndef _POSIX_C_SOURCE
|
||||
#define JANET_POSIX 1
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
#define JANET_WEB 1
|
||||
#elif defined(WIN32) || defined(_WIN32)
|
||||
@@ -71,7 +85,7 @@ extern "C" {
|
||||
|
||||
/* Check 64-bit vs 32-bit */
|
||||
#if ((defined(__x86_64__) || defined(_M_X64)) \
|
||||
&& (defined(JANET_UNIX) || defined(JANET_WINDOWS))) \
|
||||
&& (defined(JANET_POSIX) || defined(JANET_WINDOWS))) \
|
||||
|| (defined(_WIN64)) /* Windows 64 bit */ \
|
||||
|| (defined(__ia64__) && defined(__LP64__)) /* Itanium in LP64 mode */ \
|
||||
|| defined(__alpha__) /* DEC Alpha */ \
|
||||
@@ -112,8 +126,10 @@ extern "C" {
|
||||
#define JANET_THREAD_LOCAL
|
||||
#elif defined(__GNUC__)
|
||||
#define JANET_THREAD_LOCAL __thread
|
||||
#define JANET_THREADS
|
||||
#elif defined(_MSC_BUILD)
|
||||
#define JANET_THREAD_LOCAL __declspec(thread)
|
||||
#define JANET_THREADS
|
||||
#else
|
||||
#define JANET_THREAD_LOCAL
|
||||
#endif
|
||||
@@ -228,9 +244,13 @@ typedef struct {
|
||||
|
||||
/***** START SECTION TYPES *****/
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
// Must be defined before including stdlib.h
|
||||
#define _CRT_RAND_S
|
||||
#endif
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdarg.h>
|
||||
#include <setjmp.h>
|
||||
#include <stddef.h>
|
||||
@@ -319,6 +339,14 @@ typedef struct JanetRange JanetRange;
|
||||
typedef struct JanetRNG JanetRNG;
|
||||
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
|
||||
/* String and other aliased pointer types */
|
||||
typedef const uint8_t *JanetString;
|
||||
typedef const uint8_t *JanetSymbol;
|
||||
typedef const uint8_t *JanetKeyword;
|
||||
typedef const Janet *JanetTuple;
|
||||
typedef const JanetKV *JanetStruct;
|
||||
typedef void *JanetAbstract;
|
||||
|
||||
/* Basic types for all Janet Values */
|
||||
typedef enum JanetType {
|
||||
JANET_NUMBER,
|
||||
@@ -649,6 +677,7 @@ struct Janet {
|
||||
JANET_API int janet_checkint(Janet x);
|
||||
JANET_API int janet_checkint64(Janet x);
|
||||
JANET_API int janet_checksize(Janet x);
|
||||
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
||||
#define janet_checkintrange(x) ((x) == (int32_t)(x))
|
||||
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
@@ -813,8 +842,8 @@ struct JanetFuncDef {
|
||||
|
||||
/* Various debug information */
|
||||
JanetSourceMapping *sourcemap;
|
||||
const uint8_t *source;
|
||||
const uint8_t *name;
|
||||
JanetString source;
|
||||
JanetString name;
|
||||
|
||||
int32_t flags;
|
||||
int32_t slotcount; /* The amount of stack space required for the function */
|
||||
@@ -882,6 +911,7 @@ typedef struct {
|
||||
void *u_state;
|
||||
int flags;
|
||||
const uint8_t *data;
|
||||
const JanetAbstractType *at;
|
||||
} JanetMarshalContext;
|
||||
|
||||
/* Defines an abstract type */
|
||||
@@ -889,10 +919,10 @@ struct JanetAbstractType {
|
||||
const char *name;
|
||||
int (*gc)(void *data, size_t len);
|
||||
int (*gcmark)(void *data, size_t len);
|
||||
Janet(*get)(void *data, Janet key);
|
||||
int (*get)(void *data, Janet key, Janet *out);
|
||||
void (*put)(void *data, Janet key, Janet value);
|
||||
void (*marshal)(void *p, JanetMarshalContext *ctx);
|
||||
void (*unmarshal)(void *p, JanetMarshalContext *ctx);
|
||||
void *(*unmarshal)(JanetMarshalContext *ctx);
|
||||
void (*tostring)(void *p, JanetBuffer *buffer);
|
||||
};
|
||||
|
||||
@@ -933,6 +963,17 @@ struct JanetRNG {
|
||||
uint32_t counter;
|
||||
};
|
||||
|
||||
/* Thread types */
|
||||
#ifdef JANET_THREADS
|
||||
typedef struct JanetThread JanetThread;
|
||||
typedef struct JanetMailbox JanetMailbox;
|
||||
struct JanetThread {
|
||||
JanetMailbox *mailbox;
|
||||
JanetTable *encode;
|
||||
};
|
||||
#endif
|
||||
|
||||
|
||||
/***** END SECTION TYPES *****/
|
||||
|
||||
/***** START SECTION OPCODES *****/
|
||||
@@ -1021,6 +1062,7 @@ enum JanetOpCode {
|
||||
JOP_RESUME,
|
||||
JOP_SIGNAL,
|
||||
JOP_PROPAGATE,
|
||||
JOP_IN,
|
||||
JOP_GET,
|
||||
JOP_PUT,
|
||||
JOP_GET_INDEX,
|
||||
@@ -1068,7 +1110,7 @@ enum JanetAssembleStatus {
|
||||
};
|
||||
struct JanetAssembleResult {
|
||||
JanetFuncDef *funcdef;
|
||||
const uint8_t *error;
|
||||
JanetString error;
|
||||
enum JanetAssembleStatus status;
|
||||
};
|
||||
JANET_API JanetAssembleResult janet_asm(Janet source, int flags);
|
||||
@@ -1084,12 +1126,12 @@ enum JanetCompileStatus {
|
||||
};
|
||||
struct JanetCompileResult {
|
||||
JanetFuncDef *funcdef;
|
||||
const uint8_t *error;
|
||||
JanetString error;
|
||||
JanetFiber *macrofiber;
|
||||
JanetSourceMapping error_mapping;
|
||||
enum JanetCompileStatus status;
|
||||
};
|
||||
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where);
|
||||
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, JanetString where);
|
||||
|
||||
/* Get the default environment for janet */
|
||||
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||
@@ -1107,11 +1149,12 @@ JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
|
||||
JANET_API void janet_debug_unbreak(JanetFuncDef *def, int32_t pc);
|
||||
JANET_API void janet_debug_find(
|
||||
JanetFuncDef **def_out, int32_t *pc_out,
|
||||
const uint8_t *source, int32_t line, int32_t column);
|
||||
JanetString source, int32_t line, int32_t column);
|
||||
|
||||
/* RNG */
|
||||
JANET_API JanetRNG *janet_default_rng(void);
|
||||
JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
|
||||
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
|
||||
JANET_API uint32_t janet_rng_u32(JanetRNG *rng);
|
||||
|
||||
/* Array functions */
|
||||
@@ -1131,7 +1174,7 @@ JANET_API void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_
|
||||
JANET_API void janet_buffer_setcount(JanetBuffer *buffer, int32_t count);
|
||||
JANET_API void janet_buffer_extra(JanetBuffer *buffer, int32_t n);
|
||||
JANET_API void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t len);
|
||||
JANET_API void janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string);
|
||||
JANET_API void janet_buffer_push_string(JanetBuffer *buffer, JanetString string);
|
||||
JANET_API void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring);
|
||||
JANET_API void janet_buffer_push_u8(JanetBuffer *buffer, uint8_t x);
|
||||
JANET_API void janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x);
|
||||
@@ -1149,35 +1192,35 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
#define janet_tuple_sm_column(t) (janet_tuple_head(t)->sm_column)
|
||||
#define janet_tuple_flag(t) (janet_tuple_head(t)->gc.flags)
|
||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
||||
JANET_API const Janet *janet_tuple_n(const Janet *values, int32_t n);
|
||||
JANET_API int janet_tuple_equal(const Janet *lhs, const Janet *rhs);
|
||||
JANET_API int janet_tuple_compare(const Janet *lhs, const Janet *rhs);
|
||||
JANET_API JanetTuple janet_tuple_end(Janet *tuple);
|
||||
JANET_API JanetTuple janet_tuple_n(const Janet *values, int32_t n);
|
||||
JANET_API int janet_tuple_equal(JanetTuple lhs, JanetTuple rhs);
|
||||
JANET_API int janet_tuple_compare(JanetTuple lhs, JanetTuple rhs);
|
||||
|
||||
/* String/Symbol functions */
|
||||
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
|
||||
#define janet_string_length(s) (janet_string_head(s)->length)
|
||||
#define janet_string_hash(s) (janet_string_head(s)->hash)
|
||||
JANET_API uint8_t *janet_string_begin(int32_t length);
|
||||
JANET_API const uint8_t *janet_string_end(uint8_t *str);
|
||||
JANET_API const uint8_t *janet_string(const uint8_t *buf, int32_t len);
|
||||
JANET_API const uint8_t *janet_cstring(const char *cstring);
|
||||
JANET_API int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs);
|
||||
JANET_API int janet_string_equal(const uint8_t *lhs, const uint8_t *rhs);
|
||||
JANET_API int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash);
|
||||
JANET_API const uint8_t *janet_description(Janet x);
|
||||
JANET_API const uint8_t *janet_to_string(Janet x);
|
||||
JANET_API JanetString janet_string_end(uint8_t *str);
|
||||
JANET_API JanetString janet_string(const uint8_t *buf, int32_t len);
|
||||
JANET_API JanetString janet_cstring(const char *cstring);
|
||||
JANET_API int janet_string_compare(JanetString lhs, JanetString rhs);
|
||||
JANET_API int janet_string_equal(JanetString lhs, JanetString rhs);
|
||||
JANET_API int janet_string_equalconst(JanetString lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash);
|
||||
JANET_API JanetString janet_description(Janet x);
|
||||
JANET_API JanetString janet_to_string(Janet x);
|
||||
JANET_API void janet_to_string_b(JanetBuffer *buffer, Janet x);
|
||||
JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
|
||||
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
||||
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
||||
JANET_API const uint8_t *janet_formatc(const char *format, ...);
|
||||
JANET_API JanetString janet_formatc(const char *format, ...);
|
||||
JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args);
|
||||
|
||||
/* Symbol functions */
|
||||
JANET_API const uint8_t *janet_symbol(const uint8_t *str, int32_t len);
|
||||
JANET_API const uint8_t *janet_csymbol(const char *str);
|
||||
JANET_API const uint8_t *janet_symbol_gen(void);
|
||||
JANET_API JanetSymbol janet_symbol(const uint8_t *str, int32_t len);
|
||||
JANET_API JanetSymbol janet_csymbol(const char *str);
|
||||
JANET_API JanetSymbol janet_symbol_gen(void);
|
||||
#define janet_symbolv(str, len) janet_wrap_symbol(janet_symbol((str), (len)))
|
||||
#define janet_csymbolv(cstr) janet_wrap_symbol(janet_csymbol(cstr))
|
||||
|
||||
@@ -1194,12 +1237,12 @@ JANET_API const uint8_t *janet_symbol_gen(void);
|
||||
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
|
||||
JANET_API JanetKV *janet_struct_begin(int32_t count);
|
||||
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||
JANET_API const JanetKV *janet_struct_end(JanetKV *st);
|
||||
JANET_API Janet janet_struct_get(const JanetKV *st, Janet key);
|
||||
JANET_API JanetTable *janet_struct_to_table(const JanetKV *st);
|
||||
JANET_API int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs);
|
||||
JANET_API int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs);
|
||||
JANET_API const JanetKV *janet_struct_find(const JanetKV *st, Janet key);
|
||||
JANET_API JanetStruct janet_struct_end(JanetKV *st);
|
||||
JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
|
||||
JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
|
||||
JANET_API int janet_struct_equal(JanetStruct lhs, JanetStruct rhs);
|
||||
JANET_API int janet_struct_compare(JanetStruct lhs, JanetStruct rhs);
|
||||
JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
|
||||
|
||||
/* Table functions */
|
||||
JANET_API JanetTable *janet_table(int32_t capacity);
|
||||
@@ -1210,9 +1253,9 @@ JANET_API Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which)
|
||||
JANET_API Janet janet_table_rawget(JanetTable *t, Janet key);
|
||||
JANET_API Janet janet_table_remove(JanetTable *t, Janet key);
|
||||
JANET_API void janet_table_put(JanetTable *t, Janet key, Janet value);
|
||||
JANET_API const JanetKV *janet_table_to_struct(JanetTable *t);
|
||||
JANET_API JanetStruct janet_table_to_struct(JanetTable *t);
|
||||
JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
|
||||
JANET_API void janet_table_merge_struct(JanetTable *table, const JanetKV *other);
|
||||
JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
|
||||
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
||||
JANET_API JanetTable *janet_table_clone(JanetTable *table);
|
||||
|
||||
@@ -1234,13 +1277,13 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
|
||||
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
|
||||
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
|
||||
JANET_API void *janet_abstract_begin(const JanetAbstractType *type, size_t size);
|
||||
JANET_API void *janet_abstract_end(void *);
|
||||
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size); /* begin and end in one call */
|
||||
JANET_API JanetAbstract janet_abstract_end(void *abstractTemplate);
|
||||
JANET_API JanetAbstract janet_abstract(const JanetAbstractType *type, size_t size); /* begin and end in one call */
|
||||
|
||||
/* Native */
|
||||
typedef void (*JanetModule)(JanetTable *);
|
||||
typedef JanetBuildConfig(*JanetModconf)(void);
|
||||
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
||||
JANET_API JanetModule janet_native(const char *name, JanetString *error);
|
||||
|
||||
/* Marshaling */
|
||||
JANET_API void janet_marshal(
|
||||
@@ -1282,7 +1325,8 @@ JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, J
|
||||
JANET_API int janet_equals(Janet x, Janet y);
|
||||
JANET_API int32_t janet_hash(Janet x);
|
||||
JANET_API int janet_compare(Janet x, Janet y);
|
||||
JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
|
||||
JANET_API int janet_cstrcmp(JanetString str, const char *other);
|
||||
JANET_API Janet janet_in(Janet ds, Janet key);
|
||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||
JANET_API int32_t janet_length(Janet x);
|
||||
@@ -1291,19 +1335,25 @@ JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||
#define janet_flag_at(F, I) ((F) & ((1ULL) << (I)))
|
||||
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);
|
||||
|
||||
/* VM functions */
|
||||
JANET_API int janet_init(void);
|
||||
JANET_API void janet_deinit(void);
|
||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||
JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
|
||||
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
|
||||
JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
|
||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||
|
||||
/* Scratch Memory API */
|
||||
typedef void (*ScratchFinalizer)(void *);
|
||||
JANET_API void *janet_smalloc(size_t size);
|
||||
JANET_API void *janet_srealloc(void *mem, size_t size);
|
||||
JANET_API void janet_sfinalizer(void *mem, ScratchFinalizer finalizer);
|
||||
JANET_API void janet_sfree(void *mem);
|
||||
|
||||
/* C Library helpers */
|
||||
@@ -1316,9 +1366,12 @@ typedef enum {
|
||||
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 JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out);
|
||||
JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
|
||||
JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
/* Get values from the core environment. */
|
||||
JANET_API Janet janet_resolve_core(const char *name);
|
||||
|
||||
/* New C API */
|
||||
|
||||
/* Allow setting entry name for static libraries */
|
||||
@@ -1334,7 +1387,7 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
|
||||
JANET_NO_RETURN JANET_API void janet_panic(const char *message);
|
||||
JANET_NO_RETURN JANET_API void janet_panics(const uint8_t *message);
|
||||
JANET_NO_RETURN JANET_API void janet_panics(JanetString message);
|
||||
JANET_NO_RETURN JANET_API void janet_panicf(const char *format, ...);
|
||||
JANET_API void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...);
|
||||
#define janet_printf(...) janet_dynprintf("out", stdout, __VA_ARGS__)
|
||||
@@ -1344,17 +1397,17 @@ JANET_NO_RETURN JANET_API void janet_panic_abstract(Janet x, int32_t n, const Ja
|
||||
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 Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods);
|
||||
JANET_API int janet_getmethod(JanetKeyword method, const JanetMethod *methods, Janet *out);
|
||||
|
||||
JANET_API double janet_getnumber(const Janet *argv, int32_t n);
|
||||
JANET_API JanetArray *janet_getarray(const Janet *argv, int32_t n);
|
||||
JANET_API const Janet *janet_gettuple(const Janet *argv, int32_t n);
|
||||
JANET_API JanetTuple janet_gettuple(const Janet *argv, int32_t n);
|
||||
JANET_API JanetTable *janet_gettable(const Janet *argv, int32_t n);
|
||||
JANET_API const JanetKV *janet_getstruct(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getstring(const Janet *argv, int32_t n);
|
||||
JANET_API JanetStruct janet_getstruct(const Janet *argv, int32_t n);
|
||||
JANET_API JanetString janet_getstring(const Janet *argv, int32_t n);
|
||||
JANET_API const char *janet_getcstring(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getsymbol(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getkeyword(const Janet *argv, int32_t n);
|
||||
JANET_API JanetSymbol janet_getsymbol(const Janet *argv, int32_t n);
|
||||
JANET_API JanetKeyword janet_getkeyword(const Janet *argv, int32_t n);
|
||||
JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n);
|
||||
JANET_API JanetFiber *janet_getfiber(const Janet *argv, int32_t n);
|
||||
JANET_API JanetFunction *janet_getfunction(const Janet *argv, int32_t n);
|
||||
@@ -1377,12 +1430,12 @@ JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flag
|
||||
|
||||
/* Optionals */
|
||||
JANET_API double janet_optnumber(const Janet *argv, int32_t argc, int32_t n, double dflt);
|
||||
JANET_API const Janet *janet_opttuple(const Janet *argv, int32_t argc, int32_t n, const Janet *dflt);
|
||||
JANET_API const JanetKV *janet_optstruct(const Janet *argv, int32_t argc, int32_t n, const JanetKV *dflt);
|
||||
JANET_API const uint8_t *janet_optstring(const Janet *argv, int32_t argc, int32_t n, const uint8_t *dflt);
|
||||
JANET_API JanetTuple janet_opttuple(const Janet *argv, int32_t argc, int32_t n, JanetTuple dflt);
|
||||
JANET_API JanetStruct janet_optstruct(const Janet *argv, int32_t argc, int32_t n, JanetStruct dflt);
|
||||
JANET_API JanetString janet_optstring(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
|
||||
JANET_API const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt);
|
||||
JANET_API const uint8_t *janet_optsymbol(const Janet *argv, int32_t argc, int32_t n, const uint8_t *dflt);
|
||||
JANET_API const uint8_t *janet_optkeyword(const Janet *argv, int32_t argc, int32_t n, const uint8_t *dflt);
|
||||
JANET_API JanetSymbol janet_optsymbol(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
|
||||
JANET_API JanetKeyword janet_optkeyword(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
|
||||
JANET_API JanetFiber *janet_optfiber(const Janet *argv, int32_t argc, int32_t n, JanetFiber *dflt);
|
||||
JANET_API JanetFunction *janet_optfunction(const Janet *argv, int32_t argc, int32_t n, JanetFunction *dflt);
|
||||
JANET_API JanetCFunction janet_optcfunction(const Janet *argv, int32_t argc, int32_t n, JanetCFunction dflt);
|
||||
@@ -1392,7 +1445,7 @@ JANET_API int32_t janet_optnat(const Janet *argv, int32_t argc, int32_t n, int32
|
||||
JANET_API int32_t janet_optinteger(const Janet *argv, int32_t argc, int32_t n, int32_t dflt);
|
||||
JANET_API int64_t janet_optinteger64(const Janet *argv, int32_t argc, int32_t n, int64_t dflt);
|
||||
JANET_API size_t janet_optsize(const Janet *argv, int32_t argc, int32_t n, size_t dflt);
|
||||
JANET_API void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, void *dflt);
|
||||
JANET_API JanetAbstract janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, JanetAbstract dflt);
|
||||
|
||||
/* Mutable optional types specify a size default, and construct a new value if none is provided */
|
||||
JANET_API JanetBuffer *janet_optbuffer(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len);
|
||||
@@ -1402,6 +1455,16 @@ JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n,
|
||||
JANET_API Janet janet_dyn(const char *name);
|
||||
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||
|
||||
#define JANET_FILE_WRITE 1
|
||||
#define JANET_FILE_READ 2
|
||||
#define JANET_FILE_APPEND 4
|
||||
#define JANET_FILE_UPDATE 8
|
||||
#define JANET_FILE_NOT_CLOSEABLE 16
|
||||
#define JANET_FILE_CLOSED 32
|
||||
#define JANET_FILE_BINARY 64
|
||||
#define JANET_FILE_SERIALIZABLE 128
|
||||
#define JANET_FILE_PIPED 256
|
||||
|
||||
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
|
||||
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
|
||||
|
||||
@@ -1412,13 +1475,16 @@ JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
|
||||
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
|
||||
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
|
||||
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
|
||||
JANET_API void janet_marshal_abstract(JanetMarshalContext *ctx, JanetAbstract abstract);
|
||||
|
||||
JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size);
|
||||
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
|
||||
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
|
||||
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
|
||||
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
|
||||
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
|
||||
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
|
||||
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
|
||||
|
||||
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
|
||||
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
|
||||
|
||||
@@ -89,18 +89,18 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
/* static state */
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static int gbl_israwmode = 0;
|
||||
static const char *gbl_prompt = "> ";
|
||||
static int gbl_plen = 2;
|
||||
static char gbl_buf[JANET_LINE_MAX];
|
||||
static int gbl_len = 0;
|
||||
static int gbl_pos = 0;
|
||||
static int gbl_cols = 80;
|
||||
static char *gbl_history[JANET_HISTORY_MAX];
|
||||
static int gbl_history_count = 0;
|
||||
static int gbl_historyi = 0;
|
||||
static int gbl_sigint_flag = 0;
|
||||
static struct termios gbl_termios_start;
|
||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
|
||||
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
@@ -126,7 +126,6 @@ static int rawmode() {
|
||||
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
|
||||
t = gbl_termios_start;
|
||||
t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
|
||||
t.c_oflag &= ~(OPOST);
|
||||
t.c_cflag |= (CS8);
|
||||
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
|
||||
t.c_cc[VMIN] = 1;
|
||||
@@ -314,6 +313,14 @@ static void kbackspace() {
|
||||
}
|
||||
}
|
||||
|
||||
static void kdelete() {
|
||||
if (gbl_pos != gbl_len) {
|
||||
memmove(gbl_buf + gbl_pos, gbl_buf + gbl_pos + 1, gbl_len - gbl_pos);
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static int line() {
|
||||
gbl_cols = getcols();
|
||||
gbl_plen = 0;
|
||||
@@ -386,6 +393,9 @@ static int line() {
|
||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
||||
if (seq[2] == '~') {
|
||||
switch (seq[1]) {
|
||||
case '3': /* delete */
|
||||
kdelete();
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
@@ -479,6 +489,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
}
|
||||
return;
|
||||
}
|
||||
fflush(stdin);
|
||||
norawmode();
|
||||
fputc('\n', out);
|
||||
janet_buffer_ensure(buffer, gbl_len + 1, 2);
|
||||
|
||||
@@ -4,22 +4,23 @@
|
||||
(var num-tests-run 0)
|
||||
(var suite-num 0)
|
||||
(var numchecks 0)
|
||||
(var start-time 0)
|
||||
|
||||
(defn assert [x e]
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
x)
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
x)
|
||||
|
||||
(defmacro assert-error
|
||||
[msg & forms]
|
||||
@@ -32,10 +33,12 @@
|
||||
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defn start-suite [x]
|
||||
(set suite-num x)
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
(set suite-num x)
|
||||
(set start-time (os/clock))
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
|
||||
(defn end-suite []
|
||||
(print "\n\nTest suite " suite-num " finished.")
|
||||
(print num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
(def delta (- (os/clock) start-time))
|
||||
(printf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
|
||||
(print num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
|
||||
@@ -55,6 +55,8 @@
|
||||
(assert (= (get @{} 1) nil) "get nil from empty table")
|
||||
(assert (= (get {:boop :bap} :boop) :bap) "get non nil from struct")
|
||||
(assert (= (get @{:boop :bap} :boop) :bap) "get non nil from table")
|
||||
(assert (= (get @"\0" 0) 0) "get non nil from buffer")
|
||||
(assert (= (get @"\0" 1) nil) "get nil from buffer oob")
|
||||
(assert (put @{} :boop :bap) "can add to empty table")
|
||||
(assert (put @{1 3} :boop :bap) "can add to non-empty table")
|
||||
|
||||
@@ -314,5 +316,8 @@
|
||||
(assert (= y 1) "regression #137 (5)")
|
||||
(assert (= z 2) "regression #137 (6)")
|
||||
|
||||
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
|
||||
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -65,6 +65,9 @@
|
||||
(assert (:== (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) "0xfffffffffffffff") "bigint operations")
|
||||
(assert (let [a (u64 0xff)] (:== (:+ a a a a) (:* a 2 2))) "bigint operations")
|
||||
|
||||
(assert (= (string (i64 -123)) "-123") "i64 prints reasonably")
|
||||
(assert (= (string (u64 123)) "123") "u64 prints reasonably")
|
||||
|
||||
(assert-error
|
||||
"trap INT64_MIN / -1"
|
||||
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
|
||||
@@ -118,12 +121,23 @@
|
||||
(assert (deep= (parser/status p) (parser/status p2)) "parser 2")
|
||||
(assert (deep= (parser/state p) (parser/state p2)) "parser 3")
|
||||
|
||||
# Parser errors
|
||||
(defn parse-error [input]
|
||||
(def p (parser/new))
|
||||
(parser/consume p input)
|
||||
(parser/error p))
|
||||
|
||||
# Invalid utf-8 sequences
|
||||
(assert (not= nil (parse-error @"\xc3\x28")) "reject invalid utf-8 symbol")
|
||||
(assert (not= nil (parse-error @":\xc3\x28")) "reject invalid utf-8 keyword")
|
||||
|
||||
# String check-set
|
||||
(assert (string/check-set "abc" "a") "string/check-set 1")
|
||||
(assert (not (string/check-set "abc" "z")) "string/check-set 2")
|
||||
(assert (string/check-set "abc" "abc") "string/check-set 3")
|
||||
(assert (not (string/check-set "abc" "")) "string/check-set 4")
|
||||
(assert (string/check-set "abc" "") "string/check-set 4")
|
||||
(assert (not (string/check-set "" "aabc")) "string/check-set 5")
|
||||
(assert (not (string/check-set "abc" "abcdefg")) "string/check-set 6")
|
||||
|
||||
# Marshal and unmarshal pegs
|
||||
(def p (-> "abcd" peg/compile marshal unmarshal))
|
||||
|
||||
@@ -208,6 +208,11 @@
|
||||
(for i 0 75
|
||||
(test-rng (math/rng (:int seedrng))))
|
||||
|
||||
(assert (deep-not= (-> 123 math/rng (:buffer 16))
|
||||
(-> 456 math/rng (:buffer 16))) "math/rng-buffer 1")
|
||||
|
||||
(assert-no-error "math/rng-buffer 2" (math/seedrandom "abcdefg"))
|
||||
|
||||
# OS Date test
|
||||
|
||||
(assert (deep= {:year-day 0
|
||||
@@ -221,4 +226,55 @@
|
||||
:week-day 3}
|
||||
(os/date 1388608200)) "os/date")
|
||||
|
||||
# Appending buffer to self
|
||||
|
||||
(with-dyns [:out @""]
|
||||
(prin "abcd")
|
||||
(prin (dyn :out))
|
||||
(prin (dyn :out))
|
||||
(assert (deep= (dyn :out) @"abcdabcdabcdabcd") "print buffer to self"))
|
||||
|
||||
(os/setenv "TESTENV1" "v1")
|
||||
(os/setenv "TESTENV2" "v2")
|
||||
(assert (= (os/getenv "TESTENV1") "v1") "getenv works")
|
||||
(def environ (os/environ))
|
||||
(assert (= [(environ "TESTENV1") (environ "TESTENV2")] ["v1" "v2"]) "environ works")
|
||||
|
||||
# Issue #183 - just parse it :)
|
||||
1e-4000000000000000000000
|
||||
|
||||
# Ensure randomness puts n of pred into our buffer eventually
|
||||
(defn cryptorand-check
|
||||
[n pred]
|
||||
(def max-attempts 10000)
|
||||
(var attempts 0)
|
||||
(while (not= attempts max-attempts)
|
||||
(def cryptobuf (os/cryptorand 10))
|
||||
(when (= n (count pred cryptobuf))
|
||||
(break))
|
||||
(++ attempts))
|
||||
(not= attempts max-attempts))
|
||||
|
||||
(def v (math/rng-int (math/rng (os/time)) 100))
|
||||
(assert (cryptorand-check 0 |(= $ v)) "cryptorand skips value sometimes")
|
||||
(assert (cryptorand-check 1 |(= $ v)) "cryptorand has value sometimes")
|
||||
|
||||
(do
|
||||
(def buf (buffer/new-filled 1))
|
||||
(os/cryptorand 1 buf)
|
||||
(assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
|
||||
(assert (= (length buf) 2) "cryptorand appends to buffer"))
|
||||
|
||||
# Nested quasiquotation
|
||||
|
||||
(def nested ~(a ~(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
|
||||
(assert (deep= nested '(a ~(b ,(+ 1 2) ,(foo 4 d) e) f)) "nested quasiquote")
|
||||
|
||||
# Top level unquote
|
||||
(defn constantly
|
||||
[]
|
||||
(comptime (math/random)))
|
||||
|
||||
(assert (= (constantly) (constantly)) "comptime 1")
|
||||
|
||||
(end-suite)
|
||||
|
||||
14
tools/afl/README.md
Normal file
14
tools/afl/README.md
Normal file
@@ -0,0 +1,14 @@
|
||||
# AFL Fuzzing scripts
|
||||
|
||||
To use these, you need to install afl (of course), and xterm. A tiling window manager helps manage
|
||||
many concurrent fuzzer instances.
|
||||
|
||||
## Fuzz the parser
|
||||
```
|
||||
$ sh ./tools/afl/prepare_to_fuzz.sh
|
||||
export NFUZZ=1
|
||||
$ sh ./tools/afl/fuzz.sh parser
|
||||
Ctrl+C when done to close all fuzzer terminals.
|
||||
$ sh ./tools/afl/aggregate_cases.sh parser
|
||||
$ ls ./fuzz_out/parser_aggregated/
|
||||
```
|
||||
13
tools/afl/aggregate_cases.sh
Normal file
13
tools/afl/aggregate_cases.sh
Normal file
@@ -0,0 +1,13 @@
|
||||
set -eux
|
||||
|
||||
n=0
|
||||
for tc in $(echo ./fuzz_out/$1/*/hangs/* ./fuzz_out/$1/*/crashes/*)
|
||||
do
|
||||
if ! test -e $tc
|
||||
then
|
||||
continue
|
||||
fi
|
||||
mkdir -p ./fuzz_out/$1_aggregated/
|
||||
cp "$tc" $(printf "./fuzz_out/$1_aggregated/$1-%04d.test" $n)
|
||||
n=$((n + 1))
|
||||
done
|
||||
36
tools/afl/fuzz.sh
Normal file
36
tools/afl/fuzz.sh
Normal file
@@ -0,0 +1,36 @@
|
||||
set -eux
|
||||
|
||||
NFUZZ=${NFUZZ:-1}
|
||||
children=""
|
||||
|
||||
function finish {
|
||||
for pid in $children
|
||||
do
|
||||
set +e
|
||||
kill -s INT $pid
|
||||
done
|
||||
wait
|
||||
}
|
||||
trap finish EXIT
|
||||
|
||||
test -e ./tools/afl/$1_testcases
|
||||
test -e ./tools/afl/$1_runner.janet
|
||||
|
||||
echo "running fuzz master..."
|
||||
xterm -e \
|
||||
"afl-fuzz -i ./tools/afl/$1_testcases -o ./fuzz_out/$1 -M Fuzz$1_0 -- ./build/janet ./tools/afl/$1_runner.janet @@" &
|
||||
children="$! $children"
|
||||
echo "waiting for afl to get started before starting secondary fuzzers"
|
||||
sleep 10
|
||||
|
||||
NFUZZ=$((NFUZZ - 1))
|
||||
|
||||
for N in $(seq $NFUZZ)
|
||||
do
|
||||
xterm -e \
|
||||
"afl-fuzz -i ./tools/afl/$1_testcases -o ./fuzz_out/$1 -S Fuzz$1_$N -- ./build/janet ./tools/afl/$1_runner.janet @@" &
|
||||
children="$! $children"
|
||||
done
|
||||
|
||||
echo "waiting for child terminals to exit."
|
||||
wait
|
||||
4
tools/afl/parser_runner.janet
Normal file
4
tools/afl/parser_runner.janet
Normal file
@@ -0,0 +1,4 @@
|
||||
(def p (parser/new))
|
||||
(parser/consume p (slurp ((dyn :args) 1)))
|
||||
(while (parser/has-more p)
|
||||
(pp (parser/produce p)))
|
||||
15
tools/afl/parser_testcases/simple.janet
Normal file
15
tools/afl/parser_testcases/simple.janet
Normal file
@@ -0,0 +1,15 @@
|
||||
0
|
||||
123.653
|
||||
true
|
||||
:true
|
||||
{}
|
||||
`
|
||||
hello
|
||||
`
|
||||
|()
|
||||
,()
|
||||
@{:hello "world"}
|
||||
@[1 "hello"]
|
||||
nil
|
||||
(foo 2 3)
|
||||
([{} @{:k ([""])}])
|
||||
6
tools/afl/prepare_to_fuzz.sh
Normal file
6
tools/afl/prepare_to_fuzz.sh
Normal file
@@ -0,0 +1,6 @@
|
||||
set -eux
|
||||
|
||||
export CC=afl-clang
|
||||
make clean
|
||||
make -j $(nproc) all
|
||||
mkdir -p "./fuzz_out"
|
||||
@@ -1,4 +1,4 @@
|
||||
#!/bin/bash
|
||||
#!/usr/bin/env bash
|
||||
|
||||
# Format all code with astyle
|
||||
|
||||
|
||||
Reference in New Issue
Block a user