mirror of
https://github.com/janet-lang/janet
synced 2026-04-06 15:01:28 +00:00
Compare commits
90 Commits
longstring
...
ev_execute
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
47bb7fd21b | ||
|
|
1c7ed8ca48 | ||
|
|
61c65f3df1 | ||
|
|
05166b3673 | ||
|
|
0a1c93b869 | ||
|
|
788f91a36f | ||
|
|
c831ecf5d2 | ||
|
|
9e42ee153c | ||
|
|
d457aa5951 | ||
|
|
ab37ee6ebb | ||
|
|
8655530b19 | ||
|
|
27b1f59aa9 | ||
|
|
cc2cc4db43 | ||
|
|
20bcd95279 | ||
|
|
d7954be5e5 | ||
|
|
0ea77cabfb | ||
|
|
0d46352ff4 | ||
|
|
ffa0d5fe45 | ||
|
|
a2c837a99c | ||
|
|
13d8d11011 | ||
|
|
2357b6162f | ||
|
|
b4f242193d | ||
|
|
7242ee0186 | ||
|
|
3e742ffc4c | ||
|
|
2ec12fe06f | ||
|
|
c76e0ae685 | ||
|
|
cae4f19629 | ||
|
|
04f6c7b156 | ||
|
|
77b79e9899 | ||
|
|
a55354357c | ||
|
|
392d5d51df | ||
|
|
9bc996a630 | ||
|
|
7b709d4c68 | ||
|
|
eab5f67c5c | ||
|
|
6020106000 | ||
|
|
12f470ed10 | ||
|
|
945cbcfad6 | ||
|
|
d53007739e | ||
|
|
6eaf8272e1 | ||
|
|
6fb83dce06 | ||
|
|
52addc877d | ||
|
|
53a5f3d2dc | ||
|
|
711ee5a36d | ||
|
|
cd09b696b5 | ||
|
|
df1ca255a9 | ||
|
|
811a5d93f4 | ||
|
|
adbe361b9b | ||
|
|
0f16f21677 | ||
|
|
aa0de01e5f | ||
|
|
785757f2f6 | ||
|
|
01120dfc46 | ||
|
|
a119eb4ef0 | ||
|
|
0aa4c3d217 | ||
|
|
3c0cc59d77 | ||
|
|
7e1d095996 | ||
|
|
cfa9fb6ee4 | ||
|
|
9d23192614 | ||
|
|
7c1a52ae65 | ||
|
|
9aa1b9c740 | ||
|
|
c4a4916055 | ||
|
|
b402e0671a | ||
|
|
8144f83b66 | ||
|
|
cd2a55e268 | ||
|
|
f92b5d69c8 | ||
|
|
a8c21459c3 | ||
|
|
4789b4c9f3 | ||
|
|
ee1cd6f151 | ||
|
|
dfcda296a3 | ||
|
|
4d38fcb289 | ||
|
|
cbdea8f331 | ||
|
|
51d6a13510 | ||
|
|
7b4eeecd9f | ||
|
|
82eff7e082 | ||
|
|
b922e36071 | ||
|
|
7c75aeaad2 | ||
|
|
2db9323671 | ||
|
|
31ae93de19 | ||
|
|
a81e9f23f0 | ||
|
|
59f09a4386 | ||
|
|
53400ecac1 | ||
|
|
1b8928a8ec | ||
|
|
e706494893 | ||
|
|
894aea7ce7 | ||
|
|
87167a21c9 | ||
|
|
7c8f5ef811 | ||
|
|
7aa4241662 | ||
|
|
56a915b5b1 | ||
|
|
90a0dfa35f | ||
|
|
128d72785f | ||
|
|
21a6017547 |
@@ -1,14 +0,0 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
doas jpm --verbose install circlet
|
||||
@@ -1,15 +0,0 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
meson configure -Dprf=true
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
doas jpm --verbose install circlet
|
||||
@@ -1,22 +0,0 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
meson configure -Dsingle_threaded=true
|
||||
meson configure -Dnanbox=false
|
||||
meson configure -Ddynamic_modules=false
|
||||
meson configure -Ddocstrings=false
|
||||
meson configure -Dnet=false
|
||||
meson configure -Dsourcemaps=false
|
||||
meson configure -Dpeg=false
|
||||
meson configure -Dassembler=false
|
||||
meson configure -Dint_types=false
|
||||
meson configure -Dtyped_array=false
|
||||
meson configure -Dreduced_os=true
|
||||
ninja # will not pass tests but should build
|
||||
@@ -3,10 +3,31 @@ sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
- gmake: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
- meson_min: |
|
||||
cd janet
|
||||
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true
|
||||
cd build_meson_min
|
||||
ninja
|
||||
- meson_prf: |
|
||||
cd janet
|
||||
meson setup build_meson_prf --buildtype=release -Dprf=true
|
||||
cd build_meson_prf
|
||||
ninja
|
||||
ninja test
|
||||
- meson_default: |
|
||||
cd janet
|
||||
meson setup build_meson_default --buildtype=release
|
||||
cd build_meson_default
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
doas jpm --verbose install circlet
|
||||
|
||||
|
||||
25
CHANGELOG.md
25
CHANGELOG.md
@@ -2,8 +2,24 @@
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Deprecate `file/popen` in favor of `os/spawn`.
|
||||
- Add `:all` keyword to `ev/read` and `net/read` to make them more like `file/read`. However, we
|
||||
do not provide any `:line` option as that requires buffering.
|
||||
- Change repl behavior to make Ctrl-C raise SIGINT on posix. The old behavior for Ctrl-C,
|
||||
to clear the current line buffer, has been moved to Ctrl-Q.
|
||||
- Importing modules that start with `/` is now the only way to import from project root.
|
||||
Before, this would import from / on disk.
|
||||
- Change hash function for numbers.
|
||||
- Improve error handling of `dofile`.
|
||||
|
||||
## 1.13.1 - 2020-12-13
|
||||
- Pretty printing a table with a prototype will look for `:_name` instead of `:name`
|
||||
in the prototype table to tag the output.
|
||||
- `match` macro implementation changed to be tail recursive.
|
||||
- Adds a :preload loader which allows one to manually put things into `module/cache`.
|
||||
- Add `buffer/push` function.
|
||||
- Backtick delimited strings and buffers are now reindented based on the column of the
|
||||
opening delimiter. WHitespace in columns to the left of the starting column is ignored unless
|
||||
opening delimiter. Whitespace in columns to the left of the starting column is ignored unless
|
||||
there are non-space/non-newline characters in that region, in which case the old behavior is preserved.
|
||||
- Argument to `(error)` combinator in PEGs is now optional.
|
||||
- Add `(line)` and `(column)` combinators to PEGs to capture source line and column.
|
||||
@@ -12,16 +28,17 @@ All notable changes to this project will be documented in this file.
|
||||
- During installation and release, merge janetconf.h into janet.h for easier install.
|
||||
- Add `upscope` special form.
|
||||
- `os/execute` and `os/spawn` can take streams for redirecting IO.
|
||||
- Add `;parser` and `:read` parameters to `run-context`.
|
||||
- Add `:parser` and `:read` parameters to `run-context`.
|
||||
- Add `os/open` if ev is enabled.
|
||||
- Add `os/pipe` if ev is enabled.
|
||||
- Add `janet_thread_current(void)` to C API
|
||||
- Add integer parsing forms to pegs. This makes parsing many binary protocols easier.
|
||||
- Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows.
|
||||
- Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users
|
||||
for single threaded cooperative scheduling and asynchornous IO.
|
||||
for single threaded cooperative scheduling and asynchronous IO.
|
||||
- Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts
|
||||
and are more flexible. They also allow furter improvements to these utility functions.
|
||||
and are more flexible. They also allow further improvements to these utility functions.
|
||||
- Various small bug fixes.
|
||||
|
||||
## 1.12.2 - 2020-09-20
|
||||
- Add janet\_try and janet\_restore to C API.
|
||||
|
||||
2
Makefile
2
Makefile
@@ -157,7 +157,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.12
|
||||
SONAME=libjanet.so.1.13
|
||||
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
@@ -4,8 +4,6 @@
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
|
||||
22
examples/async-execute.janet
Normal file
22
examples/async-execute.janet
Normal file
@@ -0,0 +1,22 @@
|
||||
(defn dowork [name n]
|
||||
(print name " starting work...")
|
||||
(os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")])
|
||||
(print name " finished work!"))
|
||||
|
||||
# Will be done in parallel
|
||||
(print "starting group A")
|
||||
(ev/call dowork "A 2" 2)
|
||||
(ev/call dowork "A 1" 1)
|
||||
(ev/call dowork "A 3" 3)
|
||||
|
||||
(ev/sleep 4)
|
||||
|
||||
# Will also be done in parallel
|
||||
(print "starting group B")
|
||||
(ev/call dowork "B 2" 2)
|
||||
(ev/call dowork "B 1" 1)
|
||||
(ev/call dowork "B 3" 3)
|
||||
|
||||
(ev/sleep 4)
|
||||
|
||||
(print "all work done")
|
||||
8
janet.1
8
janet.1
@@ -64,6 +64,10 @@ Move cursor to the beginning of input line.
|
||||
.BR Ctrl\-B
|
||||
Move cursor one character to the left.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-D
|
||||
If on a newline, indicate end of stream and exit the repl.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-E
|
||||
Move cursor to the end of input line.
|
||||
@@ -100,6 +104,10 @@ Delete one word before the cursor.
|
||||
.BR Ctrl\-G
|
||||
Show documentation for the current symbol under the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-Q
|
||||
Clear the current command, including already typed lines.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-B/Alt\-F
|
||||
Move cursor backwards and forwards one word.
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.13.0')
|
||||
version : '1.13.1')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
|
||||
@@ -180,8 +180,8 @@
|
||||
(defmacro cond
|
||||
`Evaluates conditions sequentially until the first true condition
|
||||
is found, and then executes the corresponding body. If there are an
|
||||
odd number of forms, the last expression is executed if no forms
|
||||
are matched. If there are no matches, return nil.`
|
||||
odd number of forms, and no forms are matched, the last expression
|
||||
is executed. If there are no matches, return nil.`
|
||||
[& pairs]
|
||||
(defn aux [i]
|
||||
(def restlen (- (length pairs) i))
|
||||
@@ -494,13 +494,13 @@
|
||||
(error (string "unexpected loop verb " verb)))))
|
||||
|
||||
(defmacro forv
|
||||
`Do a c style for loop for side effects. The iteration variable i
|
||||
can be mutated in the loop, unlike normal for. Returns nil.`
|
||||
``Do a C-style for-loop for side effects. The iteration variable `i`
|
||||
can be mutated in the loop, unlike normal `for`. Returns nil.``
|
||||
[i start stop & body]
|
||||
(for-var-template i start stop 1 < + body))
|
||||
|
||||
(defmacro for
|
||||
"Do a c style for loop for side effects. Returns nil."
|
||||
"Do a C-style for-loop for side effects. Returns nil."
|
||||
[i start stop & body]
|
||||
(for-template i start stop 1 < + body))
|
||||
|
||||
@@ -562,9 +562,9 @@
|
||||
two-element tuple with a start and (exclusive) end value, and an optional
|
||||
(positive!) step size.
|
||||
|
||||
* :down-to -- same :as down, but the range is inclusive [start, end].
|
||||
* :down-to -- same as :down, but the range is inclusive [start, end].
|
||||
|
||||
* :keys -- terate over the keys in a data structure.
|
||||
* :keys -- iterate over the keys in a data structure.
|
||||
|
||||
* :pairs -- iterate over the key-value pairs as tuples in a data structure.
|
||||
|
||||
@@ -692,7 +692,7 @@
|
||||
;(tuple/slice functions 4 -1)))))
|
||||
|
||||
(defn identity
|
||||
"A function that returns its first argument."
|
||||
"A function that returns its argument."
|
||||
[x]
|
||||
x)
|
||||
|
||||
@@ -731,11 +731,11 @@
|
||||
## Polymorphic comparisons
|
||||
|
||||
(defn compare
|
||||
`Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
|
||||
``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
|
||||
Differs from the primitive comparators in that it first checks to
|
||||
see whether either x or y implement a 'compare' method which can
|
||||
compare x and y. If so it uses that compare method. If not, it
|
||||
delegates to the primitive comparators.`
|
||||
see whether either x or y implement a `compare` method which can
|
||||
compare x and y. If so, it uses that method. If not, it
|
||||
delegates to the primitive comparators.``
|
||||
[x y]
|
||||
(or
|
||||
(when-let [f (get x :compare)] (f x y))
|
||||
@@ -753,27 +753,27 @@
|
||||
r)
|
||||
|
||||
(defn compare=
|
||||
"Equivalent of '=' but using compare function instead of primitive comparator"
|
||||
``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.``
|
||||
[& xs]
|
||||
(compare-reduce = xs))
|
||||
|
||||
(defn compare<
|
||||
"Equivalent of '<' but using compare function instead of primitive comparator"
|
||||
``Equivalent of `<` but using polymorphic `compare` instead of primitive comparator.``
|
||||
[& xs]
|
||||
(compare-reduce < xs))
|
||||
|
||||
(defn compare<=
|
||||
"Equivalent of '<=' but using compare function instead of primitive comparator"
|
||||
``Equivalent of `<=` but using polymorphic `compare` instead of primitive comparator.``
|
||||
[& xs]
|
||||
(compare-reduce <= xs))
|
||||
|
||||
(defn compare>
|
||||
"Equivalent of '>' but using compare function instead of primitive comparator"
|
||||
``Equivalent of `>` but using polymorphic `compare` instead of primitive comparator.``
|
||||
[& xs]
|
||||
(compare-reduce > xs))
|
||||
|
||||
(defn compare>=
|
||||
"Equivalent of '>=' but using compare function instead of primitive comparator"
|
||||
``Equivalent of `>=` but using polymorphic `compare` instead of primitive comparator.``
|
||||
[& xs]
|
||||
(compare-reduce >= xs))
|
||||
|
||||
@@ -790,36 +790,50 @@
|
||||
###
|
||||
###
|
||||
|
||||
(defn- sort-part
|
||||
[a lo hi by]
|
||||
(def pivot (in a hi))
|
||||
(var i lo)
|
||||
(forv j lo hi
|
||||
(def aj (in a j))
|
||||
(when (by aj pivot)
|
||||
(def ai (in a i))
|
||||
(set (a i) aj)
|
||||
(set (a j) ai)
|
||||
(++ i)))
|
||||
(set (a hi) (in a i))
|
||||
(set (a i) pivot)
|
||||
i)
|
||||
(defn- median-of-three [a b c]
|
||||
(if (not= (> a b) (> a c))
|
||||
a
|
||||
(if (not= (> b a) (> b c)) b c)))
|
||||
|
||||
(defn- sort-help
|
||||
[a lo hi by]
|
||||
(when (> hi lo)
|
||||
(def piv (sort-part a lo hi by))
|
||||
(sort-help a lo (- piv 1) by)
|
||||
(sort-help a (+ piv 1) hi by))
|
||||
(defn- insertion-sort [a lo hi by]
|
||||
(for i (+ lo 1) (+ hi 1)
|
||||
(def temp (in a i))
|
||||
(var j (- i 1))
|
||||
(while (and (>= j lo) (by temp (in a j)))
|
||||
(set (a (+ j 1)) (in a j))
|
||||
(-- j))
|
||||
|
||||
(set (a (+ j 1)) temp))
|
||||
a)
|
||||
|
||||
(defn sort
|
||||
"Sort an array in-place. Uses quick-sort and is not a stable sort."
|
||||
[a &opt by]
|
||||
(sort-help a 0 (- (length a) 1) (or by <)))
|
||||
(default by <)
|
||||
(def stack @[[0 (- (length a) 1)]])
|
||||
(while (not (empty? stack))
|
||||
(def [lo hi] (array/pop stack))
|
||||
(when (< lo hi)
|
||||
(when (< (- hi lo) 32) (insertion-sort a lo hi by) (break))
|
||||
(def pivot (median-of-three (in a hi) (in a lo) (in a (math/floor (/ (+ lo hi) 2)))))
|
||||
(var left lo)
|
||||
(var right hi)
|
||||
(while true
|
||||
(while (by (in a left) pivot) (++ left))
|
||||
(while (by pivot (in a right)) (-- right))
|
||||
(when (<= left right)
|
||||
(def tmp (in a left))
|
||||
(set (a left) (in a right))
|
||||
(set (a right) tmp)
|
||||
(++ left)
|
||||
(-- right))
|
||||
(if (>= left right) (break)))
|
||||
(array/push stack [lo right])
|
||||
(array/push stack [left hi])))
|
||||
a)
|
||||
|
||||
(undef sort-part)
|
||||
(undef sort-help)
|
||||
(undef median-of-three)
|
||||
(undef insertion-sort)
|
||||
|
||||
(defn sort-by
|
||||
`Returns a new sorted array that compares elements by invoking
|
||||
@@ -945,8 +959,10 @@
|
||||
counter)
|
||||
|
||||
(defn keep
|
||||
`Given a predicate, take only elements from an array or tuple for
|
||||
which (pred element) is truthy. Returns a new array of truthy predicate results.`
|
||||
``Given a predicate `pred`, return a new array containing the truthy results
|
||||
of applying `pred` to each element in the indexed collection `ind`. This is
|
||||
different from `filter` which returns an array of the original elements where
|
||||
the predicate is truthy.``
|
||||
[pred ind]
|
||||
(def res @[])
|
||||
(each item ind
|
||||
@@ -1557,109 +1573,173 @@
|
||||
###
|
||||
###
|
||||
|
||||
(defmacro- with-idemp
|
||||
`Return janet code body that has been prepended
|
||||
with a binding of form to atom. If form is a non-idempotent
|
||||
form (a function call, etc.), make sure the resulting
|
||||
code will only evaluate once, even if body contains multiple
|
||||
copies of binding. In body, use binding instead of form.`
|
||||
[binding form & body]
|
||||
(def $result (gensym))
|
||||
(def $form (gensym))
|
||||
~(do
|
||||
(def ,$form ,form)
|
||||
(def ,binding (if (idempotent? ,$form) ,$form (gensym)))
|
||||
(def ,$result (do ,;body))
|
||||
(if (= ,$form ,binding)
|
||||
,$result
|
||||
(tuple 'do (tuple 'def ,binding ,$form) ,$result))))
|
||||
|
||||
|
||||
# Sentinel value for mismatches
|
||||
(def- sentinel ~',(gensym))
|
||||
|
||||
(defn- match-1
|
||||
[pattern expr onmatch seen]
|
||||
(cond
|
||||
|
||||
(= '_ pattern)
|
||||
(onmatch)
|
||||
|
||||
(symbol? pattern)
|
||||
(if (in seen pattern)
|
||||
~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)
|
||||
(do
|
||||
(put seen pattern true)
|
||||
~(do (def ,pattern ,expr) ,(onmatch))))
|
||||
|
||||
(and (tuple? pattern) (= :parens (tuple/type pattern)))
|
||||
(if (= (get pattern 0) '@)
|
||||
# Unification with external values
|
||||
~(if (= ,(get pattern 1) ,expr) ,(onmatch) ,sentinel)
|
||||
(match-1
|
||||
(in pattern 0) expr
|
||||
(fn []
|
||||
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen))
|
||||
|
||||
(indexed? pattern)
|
||||
(do
|
||||
(def len (length pattern))
|
||||
(var i -1)
|
||||
(with-idemp
|
||||
$arr expr
|
||||
~(if (,indexed? ,$arr)
|
||||
(if (< (,length ,$arr) ,len)
|
||||
,sentinel
|
||||
,((fn aux []
|
||||
(++ i)
|
||||
(if (= i len)
|
||||
(onmatch)
|
||||
(match-1 (in pattern i) (tuple in $arr i) aux seen)))))
|
||||
,sentinel)))
|
||||
|
||||
(dictionary? pattern)
|
||||
(do
|
||||
(var key nil)
|
||||
(with-idemp
|
||||
$dict expr
|
||||
~(if (,dictionary? ,$dict)
|
||||
,((fn aux []
|
||||
(set key (next pattern key))
|
||||
(def $val (gensym))
|
||||
(if (= key nil)
|
||||
(onmatch)
|
||||
~(do (def ,$val (,get ,$dict ,key))
|
||||
,(match-1 [(in pattern key) [not= nil $val]] $val aux seen)))))
|
||||
,sentinel)))
|
||||
|
||||
:else ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)))
|
||||
|
||||
(defmacro match
|
||||
`Pattern matching. Match an expression x against
|
||||
any number of cases. Each case is a pattern to match against, followed
|
||||
by an expression to evaluate to if that case is matched. A pattern that is
|
||||
a symbol will match anything, binding x's value to that symbol. An array
|
||||
will match only if all of it's elements match the corresponding elements in
|
||||
x. A table or struct will match if all values match with the corresponding
|
||||
values in x. A tuple pattern will match if it's first element matches, and the following
|
||||
elements are treated as predicates and are true. The last special case is
|
||||
the '_ symbol, which is a wildcard that will match any value without creating a binding.
|
||||
Any other value pattern will only match if it is equal to x.`
|
||||
[x & cases]
|
||||
(with-idemp $x x
|
||||
(def len (length cases))
|
||||
(def len-1 (dec len))
|
||||
((fn aux [i]
|
||||
(cond
|
||||
(= i len-1) (in cases i)
|
||||
(< i len-1) (with-syms [$res]
|
||||
~(if (= ,sentinel (def ,$res ,(match-1 (in cases i) $x (fn [] (in cases (inc i))) @{})))
|
||||
,(aux (+ 2 i))
|
||||
,$res)))) 0)))
|
||||
```
|
||||
Pattern matching. Match an expression `x` against any number of cases.
|
||||
Each case is a pattern to match against, followed by an expression to
|
||||
evaluate to if that case is matched. Legal patterns are:
|
||||
|
||||
(undef sentinel)
|
||||
(undef match-1)
|
||||
(undef with-idemp)
|
||||
* symbol -- a pattern that is a symbol will match anything, binding `x`'s
|
||||
value to that symbol.
|
||||
|
||||
* array -- an array will match only if all of its elements match the
|
||||
corresponding elements in `x`.
|
||||
|
||||
* table or struct -- a table or struct will match if all values match with
|
||||
the corresponding values in `x`.
|
||||
|
||||
* tuple -- a tuple pattern will match if its first element matches, and the
|
||||
following elements are treated as predicates and are true.
|
||||
|
||||
* `_` symbol -- the last special case is the `_` symbol, which is a wildcard
|
||||
that will match any value without creating a binding.
|
||||
|
||||
Any other value pattern will only match if it is equal to `x`.
|
||||
```
|
||||
[x & cases]
|
||||
|
||||
# Partition body into sections.
|
||||
(def oddlen (odd? (length cases)))
|
||||
(def else (if oddlen (last cases)))
|
||||
(def patterns (partition 2 (if oddlen (slice cases 0 -2) cases)))
|
||||
|
||||
# Keep an array for accumulating the compilation output
|
||||
(def x-sym (if (idempotent? x) x (gensym)))
|
||||
(def accum @[])
|
||||
(if (not= x x-sym) (array/push accum ['def x-sym x]))
|
||||
|
||||
# Table of gensyms
|
||||
(def symbols @{[nil nil] x-sym})
|
||||
(def length-symbols @{})
|
||||
|
||||
(defn emit [x] (array/push accum x))
|
||||
(defn emit-branch [condition result] (array/push accum :branch condition result))
|
||||
|
||||
(defn get-sym
|
||||
[parent-sym key]
|
||||
(def symbol-key [parent-sym key])
|
||||
(or (get symbols symbol-key)
|
||||
(let [s (gensym)]
|
||||
(put symbols symbol-key s)
|
||||
(emit ['def s [get parent-sym key]])
|
||||
s)))
|
||||
|
||||
(defn get-length-sym
|
||||
[parent-sym]
|
||||
(or (get length-symbols parent-sym)
|
||||
(let [s (gensym)]
|
||||
(put length-symbols parent-sym s)
|
||||
(emit ['def s ['if [indexed? parent-sym] [length parent-sym]]])
|
||||
s)))
|
||||
|
||||
(defn visit-pattern-1
|
||||
[b2g parent-sym key pattern]
|
||||
(if (= pattern '_) (break))
|
||||
(def s (get-sym parent-sym key))
|
||||
(def t (type pattern))
|
||||
(def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
|
||||
(cond
|
||||
|
||||
# match local binding
|
||||
(= t :symbol)
|
||||
(if-let [x (in b2g pattern)]
|
||||
(array/push x s)
|
||||
(put b2g pattern @[s]))
|
||||
|
||||
# match data structure template
|
||||
(or isarr (= t :struct) (= t :table))
|
||||
(do
|
||||
(when isarr (get-length-sym s))
|
||||
(eachp [i sub-pattern] pattern
|
||||
(visit-pattern-1 b2g s i sub-pattern)))
|
||||
|
||||
# match global unification
|
||||
(and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
|
||||
(break)
|
||||
|
||||
# match predicated binding
|
||||
(and (= t :tuple) (>= (length pattern) 2))
|
||||
(do
|
||||
(visit-pattern-1 b2g parent-sym key (pattern 0)))))
|
||||
|
||||
(defn visit-pattern-2
|
||||
[anda gun preds parent-sym key pattern]
|
||||
(if (= pattern '_) (break))
|
||||
(def s (get-sym parent-sym key))
|
||||
(def t (type pattern))
|
||||
(def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
|
||||
(when isarr
|
||||
(array/push anda (get-length-sym s))
|
||||
(array/push anda [<= (length pattern) (get-length-sym s)]))
|
||||
(cond
|
||||
|
||||
# match data structure template
|
||||
(or isarr (= t :struct) (= t :table))
|
||||
(eachp [i sub-pattern] pattern
|
||||
(when (not isarr)
|
||||
(array/push anda [not= nil (get-sym s i)]))
|
||||
(visit-pattern-2 anda gun preds s i sub-pattern))
|
||||
|
||||
# match local binding
|
||||
(= t :symbol) (break)
|
||||
|
||||
# match global unification
|
||||
(and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
|
||||
(if-let [x (in gun (pattern 1))]
|
||||
(array/push x s)
|
||||
(put gun (pattern 1) @[s]))
|
||||
|
||||
# match predicated binding
|
||||
(and (= t :tuple) (>= (length pattern) 2))
|
||||
(do
|
||||
(array/push preds ;(slice pattern 1))
|
||||
(visit-pattern-2 anda gun preds parent-sym key (pattern 0)))
|
||||
|
||||
# match literal
|
||||
(array/push anda ['= s pattern])))
|
||||
|
||||
# Compile the patterns
|
||||
(each [pattern expression] patterns
|
||||
(def b2g @{})
|
||||
(def gun @{})
|
||||
(def preds @[])
|
||||
(visit-pattern-1 b2g nil nil pattern)
|
||||
(def anda @['and])
|
||||
(visit-pattern-2 anda gun preds nil nil pattern)
|
||||
# Local unification
|
||||
(def unify @[])
|
||||
(each syms b2g
|
||||
(when (< 1 (length syms))
|
||||
(array/push unify [= ;syms])))
|
||||
# Global unification
|
||||
(eachp [binding syms] gun
|
||||
(array/push unify [= binding ;syms]))
|
||||
(sort unify)
|
||||
(array/concat anda unify)
|
||||
# Final binding
|
||||
(def defs (seq [[k v] :in (sort (pairs b2g))] ['def k (first v)]))
|
||||
# Predicates
|
||||
(unless (empty? preds)
|
||||
(def pred-join ~(do ,;defs (and ,;preds)))
|
||||
(array/push anda pred-join))
|
||||
(emit-branch (tuple/slice anda) ['do ;defs expression]))
|
||||
|
||||
# Expand branches
|
||||
(def stack @[else])
|
||||
(each el (reverse accum)
|
||||
(if (= :branch el)
|
||||
(let [condition (array/pop stack)
|
||||
truthy (array/pop stack)
|
||||
if-form ~(if ,condition ,truthy
|
||||
,(case (length stack)
|
||||
0 nil
|
||||
1 (stack 0)
|
||||
~(do ,;(reverse stack))))]
|
||||
(array/remove stack 0 (length stack))
|
||||
(array/push stack if-form))
|
||||
(array/push stack el)))
|
||||
|
||||
~(do ,;(reverse stack)))
|
||||
|
||||
###
|
||||
###
|
||||
@@ -1694,8 +1774,9 @@
|
||||
(env-walk keyword? env local))
|
||||
|
||||
(defn doc-format
|
||||
`Reformat a docstring to wrap a certain width.
|
||||
Returns a buffer containing the formatted text.`
|
||||
`Reformat a docstring to wrap a certain width. Docstrings can either be plaintext
|
||||
or a subset of markdown. This allows a long single line of prose or formatted text to be
|
||||
a well-formed docstring. Returns a buffer containing the formatted text.`
|
||||
[str &opt width indent]
|
||||
(default indent 4)
|
||||
(def max-width (- (or width (dyn :doc-width 80)) 8))
|
||||
@@ -1708,38 +1789,8 @@
|
||||
(var leading 0)
|
||||
(var c nil)
|
||||
|
||||
(def base-indent
|
||||
# Is there a better way?
|
||||
(do
|
||||
(var min-indent 0)
|
||||
(var curr-indent 0)
|
||||
(var start-of-line false)
|
||||
(set c (get str pos))
|
||||
(while (not= nil c)
|
||||
(case c
|
||||
10 (do
|
||||
(set start-of-line true)
|
||||
(set curr-indent 0))
|
||||
32 (when start-of-line
|
||||
(++ curr-indent))
|
||||
(when start-of-line
|
||||
(set start-of-line false)
|
||||
(when (or (= 0 min-indent)
|
||||
(< curr-indent min-indent))
|
||||
(set min-indent curr-indent))))
|
||||
(set c (get str (++ pos))))
|
||||
min-indent))
|
||||
|
||||
(set pos 0)
|
||||
|
||||
(defn skip-base-indent []
|
||||
(var pos* pos)
|
||||
(set c (get str pos*))
|
||||
(while (and (< (- pos* pos) base-indent)
|
||||
(= 32 c))
|
||||
(set c (get str (++ pos*))))
|
||||
(set pos pos*))
|
||||
|
||||
(defn skip-line-indent []
|
||||
(var pos* pos)
|
||||
(set c (get str pos*))
|
||||
@@ -1895,19 +1946,15 @@
|
||||
(defn push-fcb []
|
||||
(update-levels)
|
||||
(push-line)
|
||||
(skip-base-indent)
|
||||
(while (not (end-fcb?))
|
||||
(push-line)
|
||||
(skip-base-indent))
|
||||
(push-line))
|
||||
(push-line))
|
||||
|
||||
(defn push-icb []
|
||||
(buffer/push-string res (buffer/new-filled leading 32))
|
||||
(push-line)
|
||||
(skip-base-indent)
|
||||
(while (not (start-nl?))
|
||||
(push-line)
|
||||
(skip-base-indent))
|
||||
(push-line))
|
||||
(push-nl))
|
||||
|
||||
(defn push-p []
|
||||
@@ -1936,7 +1983,6 @@
|
||||
(push-nl))
|
||||
|
||||
(while (< pos len)
|
||||
(skip-base-indent)
|
||||
(skip-line-indent)
|
||||
(cond
|
||||
(start-nl?)
|
||||
@@ -2095,7 +2141,8 @@
|
||||
'quasiquote expandqq
|
||||
'var expanddef
|
||||
'while expandall
|
||||
'break expandall})
|
||||
'break expandall
|
||||
'upscope expandall})
|
||||
|
||||
(defn dotup [t]
|
||||
(def h (in t 0))
|
||||
@@ -2393,9 +2440,6 @@
|
||||
(default where "<anonymous>")
|
||||
(default guard :ydt)
|
||||
|
||||
# Are we done yet?
|
||||
(var going true)
|
||||
|
||||
# Evaluate 1 source form in a protected manner
|
||||
(defn eval1 [source]
|
||||
(def source (if expand (expand source) source))
|
||||
@@ -2419,7 +2463,7 @@
|
||||
(fiber/setenv f env)
|
||||
(while (fiber/can-resume? f)
|
||||
(def res (resume f resumeval))
|
||||
(when good (when going (set resumeval (onstatus f res))))))
|
||||
(when good (set resumeval (onstatus f res)))))
|
||||
|
||||
# Reader version
|
||||
(when read
|
||||
@@ -2444,11 +2488,11 @@
|
||||
|
||||
# Loop
|
||||
(def buf @"")
|
||||
(while going
|
||||
(var parser-not-done true)
|
||||
(while parser-not-done
|
||||
(if (env :exit) (break))
|
||||
(buffer/clear buf)
|
||||
(if (= (chunks buf p)
|
||||
:cancel)
|
||||
(if (= (chunks buf p) :cancel)
|
||||
(do
|
||||
# A :cancel chunk represents a cancelled form in the REPL, so reset.
|
||||
(:flush p)
|
||||
@@ -2459,19 +2503,23 @@
|
||||
(def len (length buf))
|
||||
(when (= len 0)
|
||||
(:eof p)
|
||||
(set going false))
|
||||
(set parser-not-done false))
|
||||
(while (> len pindex)
|
||||
(+= pindex (p-consume p buf pindex))
|
||||
(while (p-has-more p)
|
||||
(eval1 (p-produce p)))
|
||||
(eval1 (p-produce p))
|
||||
(if (env :exit) (break)))
|
||||
(when (= (p-status p) :error)
|
||||
(parse-err p where))))))
|
||||
(parse-err p where)
|
||||
(if (env :exit) (break)))))))
|
||||
|
||||
# Check final parser state
|
||||
(while (p-has-more p)
|
||||
(eval1 (p-produce p)))
|
||||
(when (= (p-status p) :error)
|
||||
(parse-err p where))
|
||||
(unless (env :exit)
|
||||
(while (p-has-more p)
|
||||
(eval1 (p-produce p))
|
||||
(if (env :exit) (break)))
|
||||
(when (= (p-status p) :error)
|
||||
(parse-err p where)))
|
||||
|
||||
(in env :exit-value env))
|
||||
|
||||
@@ -2531,16 +2579,16 @@
|
||||
(error (parser/error p))
|
||||
(error "no value")))))
|
||||
|
||||
(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 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).`
|
||||
@{})
|
||||
|
||||
(defmacro comptime
|
||||
"Evals x at compile time and returns the result. Similar to a top level unquote."
|
||||
[x]
|
||||
@@ -2570,8 +2618,9 @@
|
||||
[image]
|
||||
(unmarshal image load-image-dict))
|
||||
|
||||
(defn- check-. [x] (if (string/has-prefix? "." x) x))
|
||||
(defn- not-check-. [x] (unless (string/has-prefix? "." x) x))
|
||||
(defn- check-relative [x] (if (string/has-prefix? "." x) x))
|
||||
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "." x)) x))
|
||||
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
||||
|
||||
(def module/paths
|
||||
```
|
||||
@@ -2591,6 +2640,10 @@
|
||||
(setdyn :syspath (boot/opts "JANET_PATH"))
|
||||
(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
|
||||
|
||||
(def module/cache
|
||||
"Table mapping loaded module identifiers to their environments."
|
||||
@{})
|
||||
|
||||
(defn module/add-paths
|
||||
```
|
||||
Add paths to module/paths for a given loader such that
|
||||
@@ -2603,18 +2656,19 @@
|
||||
(defn- find-prefix
|
||||
[pre]
|
||||
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
|
||||
(def all-index (find-prefix ":all:"))
|
||||
(array/insert module/paths all-index [(string ":all:" ext) loader not-check-.])
|
||||
(def all-index (find-prefix ".:all:"))
|
||||
(array/insert module/paths all-index [(string ".:all:" ext) loader check-project-relative])
|
||||
(def sys-index (find-prefix ":sys:"))
|
||||
(array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader not-check-.])
|
||||
(array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
|
||||
(def curall-index (find-prefix ":cur:/:all:"))
|
||||
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-.])
|
||||
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
|
||||
module/paths)
|
||||
|
||||
(module/add-paths ":native:" :native)
|
||||
(module/add-paths "/init.janet" :source)
|
||||
(module/add-paths ".janet" :source)
|
||||
(module/add-paths ".jimage" :image)
|
||||
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload])
|
||||
|
||||
# Version of fexists that works even with a reduced OS
|
||||
(defn fexists
|
||||
@@ -2666,12 +2720,9 @@
|
||||
|
||||
(undef fexists)
|
||||
(undef mod-filter)
|
||||
(undef check-.)
|
||||
(undef not-check-.)
|
||||
|
||||
(def module/cache
|
||||
"Table mapping loaded module identifiers to their environments."
|
||||
@{})
|
||||
(undef check-relative)
|
||||
(undef check-project-relative)
|
||||
(undef check-is-dep)
|
||||
|
||||
(def module/loading
|
||||
`Table mapping currently loading modules to true. Used to prevent
|
||||
@@ -2699,15 +2750,25 @@
|
||||
(def spath (string path))
|
||||
(put env :current-file (or src (if-not path-is-file spath)))
|
||||
(put env :source (or src (if-not path-is-file spath path)))
|
||||
(var exit-error nil)
|
||||
(var exit-fiber nil)
|
||||
(defn chunks [buf _] (file/read f 2048 buf))
|
||||
(defn bp [&opt x y]
|
||||
(def ret (bad-parse x y))
|
||||
(if exit (os/exit 1))
|
||||
ret)
|
||||
(when exit
|
||||
(bad-parse x y)
|
||||
(os/exit 1))
|
||||
(put env :exit true)
|
||||
(def [line col] (:where x))
|
||||
(def pe (string (:error x) " in " y " around line " line ", column " col))
|
||||
(set exit-error pe))
|
||||
(defn bc [&opt x y z]
|
||||
(def ret (bad-compile x y z))
|
||||
(if exit (os/exit 1))
|
||||
ret)
|
||||
(when exit
|
||||
(bad-compile x y z)
|
||||
(os/exit 1))
|
||||
(put env :exit true)
|
||||
(def ce (string x " while compiling " z))
|
||||
(set exit-error ce)
|
||||
(set exit-fiber y))
|
||||
(unless f
|
||||
(error (string "could not find file " path)))
|
||||
(def nenv
|
||||
@@ -2717,27 +2778,40 @@
|
||||
:on-compile-error bc
|
||||
:on-status (fn [f x]
|
||||
(when (not= (fiber/status f) :dead)
|
||||
(debug/stacktrace f x)
|
||||
(if exit (os/exit 1) (eflush))))
|
||||
(when exit
|
||||
(debug/stacktrace f x)
|
||||
(eflush)
|
||||
(os/exit 1))
|
||||
(put env :exit true)
|
||||
(set exit-error x)
|
||||
(set exit-fiber f)))
|
||||
:evaluator evaluator
|
||||
:expander expander
|
||||
:read read
|
||||
:parser parser
|
||||
:source (or src (if path-is-file "<anonymous>" spath))}))
|
||||
(if-not path-is-file (file/close f))
|
||||
(when exit-error
|
||||
(if exit-fiber
|
||||
(propagate exit-error exit-fiber)
|
||||
(error exit-error)))
|
||||
nenv)
|
||||
|
||||
(def module/loaders
|
||||
`A table of loading method names to loading functions.
|
||||
This table lets require and import load many different kinds
|
||||
of files as modules.`
|
||||
@{:native (fn [path &] (native path (make-env)))
|
||||
:source (fn [path args]
|
||||
@{:native (fn native-loader [path &] (native path (make-env)))
|
||||
:source (fn source-loader [path args]
|
||||
(put module/loading path true)
|
||||
(def newenv (dofile path ;args))
|
||||
(put module/loading path nil)
|
||||
newenv)
|
||||
:image (fn [path &] (load-image (slurp path)))})
|
||||
(defer (put module/loading path nil)
|
||||
(dofile path ;args)))
|
||||
:preload (fn preload-loader [path & args]
|
||||
(when-let [m (in module/cache path)]
|
||||
(if (function? m)
|
||||
(set (module/cache path) (m path ;args))
|
||||
m)))
|
||||
:image (fn image-loader [path &] (load-image (slurp path)))})
|
||||
|
||||
(defn require-1
|
||||
[path args kargs]
|
||||
@@ -3053,7 +3127,16 @@
|
||||
(defmacro ev/spawn
|
||||
"Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))."
|
||||
[& body]
|
||||
~(,ev/call (fn [] ,;body))))
|
||||
~(,ev/call (fn [] ,;body)))
|
||||
|
||||
(defmacro ev/with-deadline
|
||||
`Run a body of code with a deadline, such that if the code does not complete before
|
||||
the deadline is up, it will be canceled.`
|
||||
[deadline & body]
|
||||
(with-syms [f]
|
||||
~(let [,f (coro ,;body)]
|
||||
(,ev/deadline ,deadline nil ,f)
|
||||
(,resume ,f)))))
|
||||
|
||||
(compwhen (dyn 'net/listen)
|
||||
(defn net/server
|
||||
@@ -3248,8 +3331,7 @@
|
||||
(put load-dict 'boot/args nil)
|
||||
(each [k v] (pairs load-dict)
|
||||
(if (number? v) (put load-dict k nil)))
|
||||
(merge-into load-image-dict load-dict)
|
||||
(merge-into make-image-dict (invert load-dict)))
|
||||
(merge-into load-image-dict load-dict))
|
||||
|
||||
###
|
||||
###
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 13
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_PATCH 2
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.13.0-dev"
|
||||
#define JANET_VERSION "1.13.2-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
||||
@@ -31,12 +31,11 @@
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_gcpressure(capacity);
|
||||
data = malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
if (capacity < 4) capacity = 4;
|
||||
janet_gcpressure(capacity);
|
||||
data = malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
buffer->count = 0;
|
||||
buffer->capacity = capacity;
|
||||
@@ -200,19 +199,14 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
if (buffer->count) {
|
||||
if (buffer->count < buffer->capacity) {
|
||||
uint8_t *newData = realloc(buffer->data, buffer->count);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
buffer->data = newData;
|
||||
buffer->capacity = buffer->count;
|
||||
if (buffer->count < buffer->capacity) {
|
||||
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
|
||||
uint8_t *newData = realloc(buffer->data, newcap);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
} else {
|
||||
buffer->capacity = 0;
|
||||
free(buffer->data);
|
||||
buffer->data = NULL;
|
||||
buffer->data = newData;
|
||||
buffer->capacity = newcap;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
@@ -256,6 +250,26 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
||||
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
|
||||
} else {
|
||||
JanetByteView view = janet_getbytes(argv, i);
|
||||
if (view.bytes == buffer->data) {
|
||||
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
|
||||
view.bytes = buffer->data;
|
||||
}
|
||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||
}
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
@@ -407,22 +421,32 @@ static const JanetReg buffer_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"buffer/push-byte", cfun_buffer_u8,
|
||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
||||
JDOC("(buffer/push-byte buffer & xs)\n\n"
|
||||
"Append bytes to a buffer. Will expand the buffer as necessary. "
|
||||
"Returns the modified buffer. Will throw an error if the buffer overflows.")
|
||||
},
|
||||
{
|
||||
"buffer/push-word", cfun_buffer_word,
|
||||
JDOC("(buffer/push-word buffer x)\n\n"
|
||||
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
|
||||
JDOC("(buffer/push-word buffer & xs)\n\n"
|
||||
"Append machine words to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
|
||||
"throw an error if the buffer overflows.")
|
||||
},
|
||||
{
|
||||
"buffer/push-string", cfun_buffer_chars,
|
||||
JDOC("(buffer/push-string buffer str)\n\n"
|
||||
"Push a string onto the end of a buffer. Non string values will be converted "
|
||||
"to strings before being pushed. Returns the modified buffer. "
|
||||
JDOC("(buffer/push-string buffer & xs)\n\n"
|
||||
"Push byte sequences onto the end of a buffer. "
|
||||
"Will accept any of strings, keywords, symbols, and buffers. "
|
||||
"Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows.")
|
||||
},
|
||||
{
|
||||
"buffer/push", cfun_buffer_push,
|
||||
JDOC("(buffer/push buffer & xs)\n\n"
|
||||
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
|
||||
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
|
||||
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
|
||||
"Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -548,35 +548,35 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"describe", janet_core_describe,
|
||||
JDOC("(describe x)\n\n"
|
||||
"Returns a string that is a human readable description of a value x.")
|
||||
"Returns a string that is a human-readable description of a value x.")
|
||||
},
|
||||
{
|
||||
"string", janet_core_string,
|
||||
JDOC("(string & parts)\n\n"
|
||||
"Creates a string by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. "
|
||||
JDOC("(string & xs)\n\n"
|
||||
"Creates a string by concatenating the elements of `xs` together. If an "
|
||||
"element is not a byte sequence, it is converted to bytes via `describe`. "
|
||||
"Returns the new string.")
|
||||
},
|
||||
{
|
||||
"symbol", janet_core_symbol,
|
||||
JDOC("(symbol & xs)\n\n"
|
||||
"Creates a symbol by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new symbol.")
|
||||
"Creates a symbol by concatenating the elements of `xs` together. If an "
|
||||
"element is not a byte sequence, it is converted to bytes via `describe`. "
|
||||
"Returns the new symbol.")
|
||||
},
|
||||
{
|
||||
"keyword", janet_core_keyword,
|
||||
JDOC("(keyword & xs)\n\n"
|
||||
"Creates a keyword by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new keyword.")
|
||||
"Creates a keyword by concatenating the elements of `xs` together. If an "
|
||||
"element is not a byte sequence, it is converted to bytes via `describe`. "
|
||||
"Returns the new keyword.")
|
||||
},
|
||||
{
|
||||
"buffer", janet_core_buffer,
|
||||
JDOC("(buffer & xs)\n\n"
|
||||
"Creates a new buffer by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new buffer.")
|
||||
"Creates a buffer by concatenating the elements of `xs` together. If an "
|
||||
"element is not a byte sequence, it is converted to bytes via `describe`. "
|
||||
"Returns the new buffer.")
|
||||
},
|
||||
{
|
||||
"abstract?", janet_core_is_abstract,
|
||||
@@ -1250,6 +1250,21 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JanetTable *env = janet_unwrap_table(marsh_out);
|
||||
janet_vm_core_env = env;
|
||||
|
||||
/* Invert image dict manually here. We can't do this in boot.janet as it
|
||||
* breaks deterministic builds */
|
||||
Janet lidv, midv;
|
||||
lidv = midv = janet_wrap_nil();
|
||||
janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
|
||||
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
|
||||
JanetTable *lid = janet_unwrap_table(lidv);
|
||||
JanetTable *mid = janet_unwrap_table(midv);
|
||||
for (int32_t i = 0; i < lid->capacity; i++) {
|
||||
const JanetKV *kv = lid->data + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_table_put(mid, kv->value, kv->key);
|
||||
}
|
||||
}
|
||||
|
||||
return env;
|
||||
}
|
||||
|
||||
|
||||
402
src/core/ev.c
402
src/core/ev.c
@@ -31,12 +31,12 @@
|
||||
|
||||
#ifdef JANET_EV
|
||||
|
||||
/* Includes */
|
||||
#include <math.h>
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <winsock2.h>
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <pthread.h>
|
||||
#include <limits.h>
|
||||
#include <errno.h>
|
||||
#include <unistd.h>
|
||||
@@ -48,6 +48,7 @@
|
||||
#include <netinet/tcp.h>
|
||||
#include <netdb.h>
|
||||
#include <sys/socket.h>
|
||||
#include <sys/wait.h>
|
||||
#ifdef JANET_EV_EPOLL
|
||||
#include <sys/epoll.h>
|
||||
#include <sys/timerfd.h>
|
||||
@@ -131,6 +132,7 @@ typedef struct JanetTimeout JanetTimeout;
|
||||
struct JanetTimeout {
|
||||
JanetTimestamp when;
|
||||
JanetFiber *fiber;
|
||||
JanetFiber *curr_fiber;
|
||||
uint32_t sched_id;
|
||||
int is_error;
|
||||
};
|
||||
@@ -147,6 +149,7 @@ JANET_THREAD_LOCAL JanetRNG janet_vm_ev_rng;
|
||||
JANET_THREAD_LOCAL JanetListenerState **janet_vm_listeners = NULL;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_listener_count = 0;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_listener_cap = 0;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_extra_listeners = 0;
|
||||
|
||||
/* Get current timestamp (millisecond precision) */
|
||||
static JanetTimestamp ts_now(void);
|
||||
@@ -376,12 +379,56 @@ static int janet_stream_getter(void *p, Janet key, Janet *out) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetStream *s = p;
|
||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panic("can only marshal stream with unsafe flag");
|
||||
}
|
||||
janet_marshal_abstract(ctx, p);
|
||||
janet_marshal_int(ctx, (int32_t) s->flags);
|
||||
janet_marshal_int64(ctx, (intptr_t) s->methods);
|
||||
#ifdef JANET_WINDOWS
|
||||
/* TODO - ref counting to avoid situation where a handle is closed or GCed
|
||||
* while in transit, and it's value gets reused. DuplicateHandle does not work
|
||||
* for network sockets, and in general for winsock it is better to nipt duplicate
|
||||
* unless there is a need to. */
|
||||
janet_marshal_int64(ctx, (int64_t)(s->handle));
|
||||
#else
|
||||
/* Marshal after dup becuse it is easier than maintaining our own ref counting. */
|
||||
int duph = dup(s->handle);
|
||||
if (duph < 0) janet_panicf("failed to duplicate stream handle: %V", janet_ev_lasterr());
|
||||
janet_marshal_int(ctx, (int32_t)(duph));
|
||||
#endif
|
||||
}
|
||||
|
||||
static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
|
||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panic("can only unmarshal stream with unsafe flag");
|
||||
}
|
||||
JanetStream *p = janet_unmarshal_abstract(ctx, sizeof(JanetStream));
|
||||
/* Can't share listening state and such across threads */
|
||||
p->_mask = 0;
|
||||
p->state = NULL;
|
||||
p->flags = (uint32_t) janet_unmarshal_int(ctx);
|
||||
p->methods = (void *) janet_unmarshal_int64(ctx);
|
||||
#ifdef JANET_WINDOWS
|
||||
p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
|
||||
#else
|
||||
p->handle = (JanetHandle) janet_unmarshal_int(ctx);
|
||||
#endif
|
||||
return p;
|
||||
}
|
||||
|
||||
|
||||
const JanetAbstractType janet_stream_type = {
|
||||
"core/stream",
|
||||
janet_stream_gc,
|
||||
janet_stream_mark,
|
||||
janet_stream_getter,
|
||||
JANET_ATEND_GET
|
||||
NULL,
|
||||
janet_stream_marshal,
|
||||
janet_stream_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
/* Register a fiber to resume with value */
|
||||
@@ -433,6 +480,9 @@ void janet_ev_mark(void) {
|
||||
/* Pending timeouts */
|
||||
for (size_t i = 0; i < janet_vm_tq_count; i++) {
|
||||
janet_mark(janet_wrap_fiber(janet_vm_tq[i].fiber));
|
||||
if (janet_vm_tq[i].curr_fiber != NULL) {
|
||||
janet_mark(janet_wrap_fiber(janet_vm_tq[i].curr_fiber));
|
||||
}
|
||||
}
|
||||
|
||||
/* Pending listeners */
|
||||
@@ -471,6 +521,7 @@ void janet_ev_init_common(void) {
|
||||
/* Common deinit code */
|
||||
void janet_ev_deinit_common(void) {
|
||||
janet_q_deinit(&janet_vm_spawn);
|
||||
free(janet_vm_tq);
|
||||
free(janet_vm_listeners);
|
||||
janet_vm_listeners = NULL;
|
||||
}
|
||||
@@ -486,11 +537,20 @@ void janet_addtimeout(double sec) {
|
||||
JanetTimeout to;
|
||||
to.when = ts_delta(ts_now(), sec);
|
||||
to.fiber = fiber;
|
||||
to.curr_fiber = NULL;
|
||||
to.sched_id = fiber->sched_id;
|
||||
to.is_error = 1;
|
||||
add_timeout(to);
|
||||
}
|
||||
|
||||
void janet_ev_inc_refcount(void) {
|
||||
janet_vm_extra_listeners++;
|
||||
}
|
||||
|
||||
void janet_ev_dec_refcount(void) {
|
||||
janet_vm_extra_listeners--;
|
||||
}
|
||||
|
||||
/* Channels */
|
||||
|
||||
typedef struct {
|
||||
@@ -766,42 +826,111 @@ void janet_loop1(void) {
|
||||
JanetTimestamp now = ts_now();
|
||||
while (peek_timeout(&to) && to.when <= now) {
|
||||
pop_timeout(0);
|
||||
if (to.fiber->sched_id == to.sched_id) {
|
||||
if (to.is_error) {
|
||||
janet_cancel(to.fiber, janet_cstringv("timeout"));
|
||||
} else {
|
||||
janet_schedule(to.fiber, janet_wrap_nil());
|
||||
if (to.curr_fiber != NULL) {
|
||||
/* This is a deadline (for a fiber, not a function call) */
|
||||
JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
|
||||
int isFinished = s == (JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
s == JANET_STATUS_USER0 ||
|
||||
s == JANET_STATUS_USER1 ||
|
||||
s == JANET_STATUS_USER2 ||
|
||||
s == JANET_STATUS_USER3 ||
|
||||
s == JANET_STATUS_USER4);
|
||||
if (!isFinished) {
|
||||
janet_cancel(to.fiber, janet_cstringv("deadline expired"));
|
||||
}
|
||||
} else {
|
||||
/* This is a timeout (for a function call, not a whole fiber) */
|
||||
if (to.fiber->sched_id == to.sched_id) {
|
||||
if (to.is_error) {
|
||||
janet_cancel(to.fiber, janet_cstringv("timeout"));
|
||||
} else {
|
||||
janet_schedule(to.fiber, janet_wrap_nil());
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Run scheduled fibers */
|
||||
while (janet_vm_spawn.head != janet_vm_spawn.tail) {
|
||||
JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK};
|
||||
janet_q_pop(&janet_vm_spawn, &task, sizeof(task));
|
||||
run_one(task.fiber, task.value, task.sig);
|
||||
}
|
||||
|
||||
/* Poll for events */
|
||||
if (janet_vm_listener_count || janet_vm_tq_count) {
|
||||
if (janet_vm_listener_count || janet_vm_tq_count || janet_vm_extra_listeners) {
|
||||
JanetTimeout to;
|
||||
memset(&to, 0, sizeof(to));
|
||||
int has_timeout;
|
||||
/* Drop timeouts that are no longer needed */
|
||||
while ((has_timeout = peek_timeout(&to)) && to.fiber->sched_id != to.sched_id) {
|
||||
while ((has_timeout = peek_timeout(&to)) && (to.curr_fiber == NULL) && to.fiber->sched_id != to.sched_id) {
|
||||
pop_timeout(0);
|
||||
}
|
||||
/* Run polling implementation only if pending timeouts or pending events */
|
||||
if (janet_vm_tq_count || janet_vm_listener_count) {
|
||||
if (janet_vm_tq_count || janet_vm_listener_count || janet_vm_extra_listeners) {
|
||||
janet_loop1_impl(has_timeout, to.when);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void janet_loop(void) {
|
||||
while (janet_vm_listener_count || (janet_vm_spawn.head != janet_vm_spawn.tail) || janet_vm_tq_count) {
|
||||
while (janet_vm_listener_count || (janet_vm_spawn.head != janet_vm_spawn.tail) || janet_vm_tq_count || janet_vm_extra_listeners) {
|
||||
janet_loop1();
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Self-pipe handling code.
|
||||
*/
|
||||
|
||||
/* Wrap return value by pairing it with the callback used to handle it
|
||||
* in the main thread */
|
||||
typedef struct {
|
||||
JanetEVGenericMessage msg;
|
||||
JanetThreadedCallback cb;
|
||||
} JanetSelfPipeEvent;
|
||||
|
||||
/* Structure used to initialize threads in the thread pool
|
||||
* (same head structure as self pipe event)*/
|
||||
typedef struct {
|
||||
JanetEVGenericMessage msg;
|
||||
JanetThreadedCallback cb;
|
||||
JanetThreadedSubroutine subr;
|
||||
JanetHandle write_pipe;
|
||||
} JanetEVThreadInit;
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
/* On windows, use PostQueuedCompletionStatus instead for
|
||||
* custom events */
|
||||
|
||||
#else
|
||||
|
||||
static JANET_THREAD_LOCAL JanetHandle janet_vm_selfpipe[2];
|
||||
|
||||
static void janet_ev_setup_selfpipe(void) {
|
||||
if (janet_make_pipe(janet_vm_selfpipe)) {
|
||||
JANET_EXIT("failed to initialize self pipe in event loop");
|
||||
}
|
||||
}
|
||||
|
||||
/* Handle events from the self pipe inside the event loop */
|
||||
static void janet_ev_handle_selfpipe(void) {
|
||||
JanetSelfPipeEvent response;
|
||||
while (read(janet_vm_selfpipe[0], &response, sizeof(response)) > 0) {
|
||||
response.cb(response.msg);
|
||||
janet_ev_dec_refcount();
|
||||
}
|
||||
}
|
||||
|
||||
static void janet_ev_cleanup_selfpipe(void) {
|
||||
close(janet_vm_selfpipe[0]);
|
||||
close(janet_vm_selfpipe[1]);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
JANET_THREAD_LOCAL HANDLE janet_vm_iocp = NULL;
|
||||
@@ -861,6 +990,12 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
|
||||
if (!has_timeout) {
|
||||
/* queue emptied */
|
||||
}
|
||||
} else if (0 == completionKey) {
|
||||
/* Custom event */
|
||||
JanetSelfPipeEvent *response = (JanetSelfPipeEvent *)(overlapped);
|
||||
response->cb(response->msg);
|
||||
free(response);
|
||||
janet_ev_dec_refcount();
|
||||
} else {
|
||||
/* Normal event */
|
||||
JanetStream *stream = (JanetStream *) completionKey;
|
||||
@@ -969,8 +1104,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
|
||||
/* Step state machines */
|
||||
for (int i = 0; i < ready; i++) {
|
||||
JanetStream *stream = events[i].data.ptr;
|
||||
if (NULL != stream) { /* If NULL, is a timeout */
|
||||
void *p = events[i].data.ptr;
|
||||
if (&janet_vm_timerfd == p) {
|
||||
/* Timer expired, ignore */;
|
||||
} else if (janet_vm_selfpipe == p) {
|
||||
/* Self-pipe handling */
|
||||
janet_ev_handle_selfpipe();
|
||||
} else {
|
||||
JanetStream *stream = p;
|
||||
int mask = events[i].events;
|
||||
JanetListenerState *state = stream->state;
|
||||
state->event = events + i;
|
||||
@@ -1001,14 +1142,18 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
|
||||
void janet_ev_init(void) {
|
||||
janet_ev_init_common();
|
||||
janet_ev_setup_selfpipe();
|
||||
janet_vm_epoll = epoll_create1(EPOLL_CLOEXEC);
|
||||
janet_vm_timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC | TFD_NONBLOCK);
|
||||
janet_vm_timer_enabled = 0;
|
||||
if (janet_vm_epoll == -1 || janet_vm_timerfd == -1) goto error;
|
||||
struct epoll_event ev;
|
||||
ev.events = EPOLLIN | EPOLLET;
|
||||
ev.data.ptr = NULL;
|
||||
ev.data.ptr = &janet_vm_timerfd;
|
||||
if (-1 == epoll_ctl(janet_vm_epoll, EPOLL_CTL_ADD, janet_vm_timerfd, &ev)) goto error;
|
||||
ev.events = EPOLLIN | EPOLLET;
|
||||
ev.data.ptr = janet_vm_selfpipe;
|
||||
if (-1 == epoll_ctl(janet_vm_epoll, EPOLL_CTL_ADD, janet_vm_selfpipe[0], &ev)) goto error;
|
||||
return;
|
||||
error:
|
||||
JANET_EXIT("failed to initialize event loop");
|
||||
@@ -1018,6 +1163,7 @@ void janet_ev_deinit(void) {
|
||||
janet_ev_deinit_common();
|
||||
close(janet_vm_epoll);
|
||||
close(janet_vm_timerfd);
|
||||
janet_ev_cleanup_selfpipe();
|
||||
janet_vm_epoll = 0;
|
||||
}
|
||||
|
||||
@@ -1054,7 +1200,7 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
|
||||
JanetListenerState *state = janet_listen_impl(stream, behavior, mask, size, user);
|
||||
size_t newsize = janet_vm_listener_cap;
|
||||
if (newsize > oldsize) {
|
||||
janet_vm_fds = realloc(janet_vm_fds, newsize * sizeof(struct pollfd));
|
||||
janet_vm_fds = realloc(janet_vm_fds, (newsize + 1) * sizeof(struct pollfd));
|
||||
if (NULL == janet_vm_fds) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -1063,12 +1209,12 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
|
||||
ev.fd = stream->handle;
|
||||
ev.events = make_poll_events(state->stream->_mask);
|
||||
ev.revents = 0;
|
||||
janet_vm_fds[state->_index] = ev;
|
||||
janet_vm_fds[state->_index + 1] = ev;
|
||||
return state;
|
||||
}
|
||||
|
||||
static void janet_unlisten(JanetListenerState *state) {
|
||||
janet_vm_fds[state->_index] = janet_vm_fds[janet_vm_listener_count - 1];
|
||||
janet_vm_fds[state->_index + 1] = janet_vm_fds[janet_vm_listener_count];
|
||||
janet_unlisten_impl(state);
|
||||
}
|
||||
|
||||
@@ -1081,19 +1227,25 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
JanetTimestamp now = ts_now();
|
||||
to = now > timeout ? 0 : (int)(timeout - now);
|
||||
}
|
||||
ready = poll(janet_vm_fds, janet_vm_listener_count, to);
|
||||
ready = poll(janet_vm_fds, janet_vm_listener_count + 1, to);
|
||||
} while (ready == -1 && errno == EINTR);
|
||||
if (ready == -1) {
|
||||
JANET_EXIT("failed to poll events");
|
||||
}
|
||||
|
||||
/* Check selfpipe */
|
||||
if (janet_vm_fds[0].revents & POLLIN) {
|
||||
janet_vm_fds[0].revents = 0;
|
||||
janet_ev_handle_selfpipe();
|
||||
}
|
||||
|
||||
/* Step state machines */
|
||||
for (size_t i = 0; i < janet_vm_listener_count; i++) {
|
||||
struct pollfd *pfd = janet_vm_fds + i;
|
||||
struct pollfd *pfd = janet_vm_fds + i + 1;
|
||||
/* Skip fds where nothing interesting happened */
|
||||
JanetListenerState *state = janet_vm_listeners[i];
|
||||
/* Normal event */
|
||||
int mask = janet_vm_fds[i].revents;
|
||||
int mask = pfd->revents;
|
||||
JanetAsyncStatus status1 = JANET_ASYNC_STATUS_NOT_DONE;
|
||||
JanetAsyncStatus status2 = JANET_ASYNC_STATUS_NOT_DONE;
|
||||
JanetAsyncStatus status3 = JANET_ASYNC_STATUS_NOT_DONE;
|
||||
@@ -1118,20 +1270,157 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
void janet_ev_init(void) {
|
||||
janet_ev_init_common();
|
||||
janet_vm_fds = NULL;
|
||||
janet_ev_setup_selfpipe();
|
||||
janet_vm_fds = malloc(sizeof(struct pollfd));
|
||||
if (NULL == janet_vm_fds) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_fds[0].fd = janet_vm_selfpipe[0];
|
||||
janet_vm_fds[0].events = POLLIN;
|
||||
janet_vm_fds[0].revents = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
void janet_ev_deinit(void) {
|
||||
janet_ev_deinit_common();
|
||||
janet_ev_cleanup_selfpipe();
|
||||
free(janet_vm_fds);
|
||||
janet_vm_fds = NULL;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/* C API helpers for reading and writing from streams.
|
||||
/*
|
||||
* End poll implementation
|
||||
*/
|
||||
|
||||
/*
|
||||
* Threaded calls
|
||||
*/
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
static DWORD WINAPI janet_thread_body(LPVOID ptr) {
|
||||
JanetEVThreadInit *init = (JanetEVThreadInit *)ptr;
|
||||
JanetEVGenericMessage msg = init->msg;
|
||||
JanetThreadedSubroutine subr = init->subr;
|
||||
JanetThreadedCallback cb = init->cb;
|
||||
JanetHandle iocp = init->write_pipe;
|
||||
/* Reuse memory from thread init for returning data */
|
||||
init->msg = subr(msg);
|
||||
init->cb = cb;
|
||||
janet_assert(PostQueuedCompletionStatus(iocp,
|
||||
sizeof(JanetSelfPipeEvent),
|
||||
0,
|
||||
(LPOVERLAPPED) init),
|
||||
"failed to post completion event");
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
static void *janet_thread_body(void *ptr) {
|
||||
JanetEVThreadInit *init = (JanetEVThreadInit *)ptr;
|
||||
JanetEVGenericMessage msg = init->msg;
|
||||
JanetThreadedSubroutine subr = init->subr;
|
||||
JanetThreadedCallback cb = init->cb;
|
||||
int fd = init->write_pipe;
|
||||
free(init);
|
||||
JanetSelfPipeEvent response;
|
||||
response.msg = subr(msg);
|
||||
response.cb = cb;
|
||||
/* handle a bit of back pressure before giving up. */
|
||||
int tries = 4;
|
||||
while (tries > 0) {
|
||||
int status;
|
||||
do {
|
||||
status = write(fd, &response, sizeof(response));
|
||||
} while (status == -1 && errno == EINTR);
|
||||
if (status > 0) break;
|
||||
sleep(1);
|
||||
tries--;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
#endif
|
||||
|
||||
void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb) {
|
||||
JanetEVThreadInit *init = malloc(sizeof(JanetEVThreadInit));
|
||||
if (NULL == init) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
init->msg = arguments;
|
||||
init->subr = fp;
|
||||
init->cb = cb;
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
init->write_pipe = janet_vm_iocp;
|
||||
HANDLE thread_handle = CreateThread(NULL, 0, janet_thread_body, init, 0, NULL);
|
||||
if (NULL == thread_handle) {
|
||||
free(init);
|
||||
janet_panic("failed to create thread");
|
||||
}
|
||||
CloseHandle(thread_handle); /* detach from thread */
|
||||
#else
|
||||
init->write_pipe = janet_vm_selfpipe[1];
|
||||
pthread_t waiter_thread;
|
||||
int err = pthread_create(&waiter_thread, NULL, janet_thread_body, init);
|
||||
if (err) {
|
||||
free(init);
|
||||
janet_panicf("%s", strerror(err));
|
||||
}
|
||||
pthread_detach(waiter_thread);
|
||||
#endif
|
||||
|
||||
/* Increment ev refcount so we don't quit while waiting for a subprocess */
|
||||
janet_ev_inc_refcount();
|
||||
}
|
||||
|
||||
/* Default callback for janet_ev_threaded_await. */
|
||||
void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
|
||||
switch (return_value.tag) {
|
||||
default:
|
||||
case JANET_EV_TCTAG_NIL:
|
||||
janet_schedule(return_value.fiber, janet_wrap_nil());
|
||||
break;
|
||||
case JANET_EV_TCTAG_INTEGER:
|
||||
janet_schedule(return_value.fiber, janet_wrap_integer(return_value.argi));
|
||||
break;
|
||||
case JANET_EV_TCTAG_STRING:
|
||||
case JANET_EV_TCTAG_STRINGF:
|
||||
janet_schedule(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) free(return_value.argp);
|
||||
break;
|
||||
case JANET_EV_TCTAG_KEYWORD:
|
||||
janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
||||
break;
|
||||
case JANET_EV_TCTAG_ERR_STRING:
|
||||
case JANET_EV_TCTAG_ERR_STRINGF:
|
||||
janet_cancel(return_value.fiber, janet_cstringv((const char *) return_value.argp));
|
||||
if (return_value.tag == JANET_EV_TCTAG_STRINGF) free(return_value.argp);
|
||||
break;
|
||||
case JANET_EV_TCTAG_ERR_KEYWORD:
|
||||
janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
|
||||
break;
|
||||
}
|
||||
janet_gcunroot(janet_wrap_fiber(return_value.fiber));
|
||||
}
|
||||
|
||||
|
||||
/* Convenience method for common case */
|
||||
void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp) {
|
||||
JanetEVGenericMessage arguments;
|
||||
arguments.tag = tag;
|
||||
arguments.argi = argi;
|
||||
arguments.argp = argp;
|
||||
arguments.fiber = janet_root_fiber();
|
||||
janet_gcroot(janet_wrap_fiber(arguments.fiber));
|
||||
janet_ev_threaded_call(fp, arguments, janet_ev_default_threaded_callback);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
/*
|
||||
* C API helpers for reading and writing from streams.
|
||||
* There is some networking code in here as well as generic
|
||||
* reading and writing primitives. */
|
||||
* reading and writing primitives.
|
||||
*/
|
||||
|
||||
void janet_stream_flags(JanetStream *stream, uint32_t flags) {
|
||||
if (stream->flags & JANET_STREAM_CLOSED) {
|
||||
@@ -1232,7 +1521,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
janet_buffer_push_bytes(state->buf, state->chunk_buf, s->bytes);
|
||||
state->bytes_left -= s->bytes;
|
||||
|
||||
if (state->bytes_left <= 0 || !state->is_chunk || s->bytes == 0) {
|
||||
if (state->bytes_left == 0 || !state->is_chunk || s->bytes == 0) {
|
||||
Janet resume_val;
|
||||
#ifdef JANET_NET
|
||||
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
|
||||
@@ -1295,12 +1584,11 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
}
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_READ:
|
||||
/* Read in bytes */
|
||||
{
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
JanetBuffer *buffer = state->buf;
|
||||
int32_t bytes_left = state->bytes_left;
|
||||
janet_buffer_extra(buffer, bytes_left);
|
||||
int32_t read_limit = bytes_left < 0 ? 4096 : bytes_left;
|
||||
janet_buffer_extra(buffer, read_limit);
|
||||
ssize_t nread;
|
||||
#ifdef JANET_NET
|
||||
char saddr[256];
|
||||
@@ -1309,14 +1597,14 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
do {
|
||||
#ifdef JANET_NET
|
||||
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
|
||||
nread = recvfrom(s->stream->handle, buffer->data + buffer->count, bytes_left, state->flags,
|
||||
nread = recvfrom(s->stream->handle, buffer->data + buffer->count, read_limit, state->flags,
|
||||
(struct sockaddr *)&saddr, &socklen);
|
||||
} else if (state->mode == JANET_ASYNC_READMODE_RECV) {
|
||||
nread = recv(s->stream->handle, buffer->data + buffer->count, bytes_left, state->flags);
|
||||
nread = recv(s->stream->handle, buffer->data + buffer->count, read_limit, state->flags);
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
nread = read(s->stream->handle, buffer->data + buffer->count, bytes_left);
|
||||
nread = read(s->stream->handle, buffer->data + buffer->count, read_limit);
|
||||
}
|
||||
} while (nread == -1 && errno == EINTR);
|
||||
|
||||
@@ -1666,7 +1954,13 @@ int janet_make_pipe(JanetHandle handles[2]) {
|
||||
return 0;
|
||||
#else
|
||||
if (pipe(handles)) return -1;
|
||||
if (fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
|
||||
if (fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
|
||||
return 0;
|
||||
error:
|
||||
close(handles[0]);
|
||||
close(handles[1]);
|
||||
return -1;
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -1691,18 +1985,38 @@ static Janet cfun_ev_call(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_fiber(fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_ev_sleep(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
double sec = janet_getnumber(argv, 0);
|
||||
JANET_NO_RETURN void janet_sleep_await(double sec) {
|
||||
JanetTimeout to;
|
||||
to.when = ts_delta(ts_now(), sec);
|
||||
to.fiber = janet_vm_root_fiber;
|
||||
to.is_error = 0;
|
||||
to.sched_id = to.fiber->sched_id;
|
||||
to.curr_fiber = NULL;
|
||||
add_timeout(to);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static Janet cfun_ev_sleep(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
double sec = janet_getnumber(argv, 0);
|
||||
janet_sleep_await(sec);
|
||||
}
|
||||
|
||||
static Janet cfun_ev_deadline(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
double sec = janet_getnumber(argv, 0);
|
||||
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm_root_fiber);
|
||||
JanetFiber *tocheck = janet_optfiber(argv, argc, 2, janet_vm_fiber);
|
||||
JanetTimeout to;
|
||||
to.when = ts_delta(ts_now(), sec);
|
||||
to.fiber = tocancel;
|
||||
to.curr_fiber = tocheck;
|
||||
to.is_error = 0;
|
||||
to.sched_id = to.fiber->sched_id;
|
||||
add_timeout(to);
|
||||
return janet_wrap_fiber(tocancel);
|
||||
}
|
||||
|
||||
static Janet cfun_ev_cancel(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
@@ -1722,11 +2036,16 @@ Janet janet_cfun_stream_read(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_READABLE);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_read(stream, buffer, n);
|
||||
if (janet_keyeq(argv[1], "all")) {
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_readchunk(stream, buffer, -1);
|
||||
} else {
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_read(stream, buffer, n);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
@@ -1776,6 +2095,14 @@ static const JanetReg ev_cfuns[] = {
|
||||
JDOC("(ev/sleep sec)\n\n"
|
||||
"Suspend the current fiber for sec seconds without blocking the event loop.")
|
||||
},
|
||||
{
|
||||
"ev/deadline", cfun_ev_deadline,
|
||||
JDOC("(ev/deadline sec &opt tocancel tocheck)\n\n"
|
||||
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
|
||||
"`tocancel` will be canceled as with `ev/cancel`. "
|
||||
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
|
||||
"`(fiber/current)` respectively. Returns `tocancel`.")
|
||||
},
|
||||
{
|
||||
"ev/chan", cfun_channel_new,
|
||||
JDOC("(ev/chan &opt capacity)\n\n"
|
||||
@@ -1833,7 +2160,8 @@ static const JanetReg ev_cfuns[] = {
|
||||
{
|
||||
"ev/read", janet_cfun_stream_read,
|
||||
JDOC("(ev/read stream n &opt buffer timeout)\n\n"
|
||||
"Read up to n bytes into a buffer asynchronously from a stream. "
|
||||
"Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword "
|
||||
"`:all` to read into the buffer until end of stream. "
|
||||
"Optionally provide a buffer to write into "
|
||||
"as well as a timeout in seconds after which to cancel the operation and raise an error. "
|
||||
"Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an "
|
||||
|
||||
@@ -27,7 +27,7 @@
|
||||
|
||||
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|
||||
|| defined(__bsdi__) || defined(__DragonFly__)
|
||||
/* Use BSD soucre on any BSD systems, include OSX */
|
||||
/* Use BSD source on any BSD systems, include OSX */
|
||||
# define _BSD_SOURCE
|
||||
#else
|
||||
/* Use POSIX feature flags */
|
||||
|
||||
@@ -420,8 +420,7 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
|
||||
newframe->flags = 0;
|
||||
}
|
||||
|
||||
/* Pop a stack frame from the fiber. Returns the new stack frame, or
|
||||
* NULL if there are no more frames */
|
||||
/* Pop a stack frame from the fiber. */
|
||||
void janet_fiber_popframe(JanetFiber *fiber) {
|
||||
JanetStackFrame *frame = janet_fiber_frame(fiber);
|
||||
if (fiber->frame == 0) return;
|
||||
|
||||
@@ -226,11 +226,14 @@ static void janet_mark_function(JanetFunction *func) {
|
||||
if (janet_gc_reachable(func))
|
||||
return;
|
||||
janet_gc_mark(func);
|
||||
numenvs = func->def->environments_length;
|
||||
for (i = 0; i < numenvs; ++i) {
|
||||
janet_mark_funcenv(func->envs[i]);
|
||||
if (NULL != func->def) {
|
||||
/* this should always be true, except if function is only partially constructed */
|
||||
numenvs = func->def->environments_length;
|
||||
for (i = 0; i < numenvs; ++i) {
|
||||
janet_mark_funcenv(func->envs[i]);
|
||||
}
|
||||
janet_mark_funcdef(func->def);
|
||||
}
|
||||
janet_mark_funcdef(func->def);
|
||||
}
|
||||
|
||||
static void janet_mark_fiber(JanetFiber *fiber) {
|
||||
|
||||
@@ -777,7 +777,7 @@ static const JanetReg io_cfuns[] = {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"file/popen", cfun_io_popen,
|
||||
JDOC("(file/popen command &opt mode)\n\n"
|
||||
JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\n\n"
|
||||
"Open a file that is backed by a process. The file must be opened in either "
|
||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
|
||||
@@ -286,7 +286,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
|
||||
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 30)
|
||||
#define JANET_STACKFRAME_HASENV (1 << 31)
|
||||
#define JANET_STACKFRAME_HASENV (INT32_MIN)
|
||||
|
||||
/* Marshal a fiber */
|
||||
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
@@ -542,9 +542,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
case JANET_FUNCTION: {
|
||||
pushbyte(st, LB_FUNCTION);
|
||||
JanetFunction *func = janet_unwrap_function(x);
|
||||
marshal_one_def(st, func->def, flags);
|
||||
/* Mark seen after reading def, but before envs */
|
||||
/* Mark seen before reading def */
|
||||
MARK_SEEN();
|
||||
pushint(st, func->def->environments_length);
|
||||
marshal_one_def(st, func->def, flags);
|
||||
for (int32_t i = 0; i < func->def->environments_length; i++)
|
||||
marshal_one_env(st, func->envs[i], flags + 1);
|
||||
return;
|
||||
@@ -1228,12 +1229,20 @@ static const uint8_t *unmarshal_one(
|
||||
case LB_FUNCTION: {
|
||||
JanetFunction *func;
|
||||
JanetFuncDef *def;
|
||||
data = unmarshal_one_def(st, data + 1, &def, flags + 1);
|
||||
data++;
|
||||
int32_t len = readnat(st, &data);
|
||||
if (len > 255) {
|
||||
janet_panicf("invalid function");
|
||||
}
|
||||
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
|
||||
def->environments_length * sizeof(JanetFuncEnv));
|
||||
func->def = def;
|
||||
len * sizeof(JanetFuncEnv));
|
||||
*out = janet_wrap_function(func);
|
||||
janet_v_push(st->lookup, *out);
|
||||
data = unmarshal_one_def(st, data, &def, flags + 1);
|
||||
if (def->environments_length != len) {
|
||||
janet_panicf("invalid function");
|
||||
}
|
||||
func->def = def;
|
||||
for (int32_t i = 0; i < def->environments_length; i++) {
|
||||
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
|
||||
}
|
||||
|
||||
@@ -509,11 +509,16 @@ static Janet cfun_stream_read(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
|
||||
if (janet_keyeq(argv[1], "all")) {
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recvchunk(stream, buffer, -1, MSG_NOSIGNAL);
|
||||
} else {
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
@@ -643,6 +648,7 @@ static const JanetReg net_cfuns[] = {
|
||||
"net/read", cfun_stream_read,
|
||||
JDOC("(net/read stream nbytes &opt buf timeout)\n\n"
|
||||
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
|
||||
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
|
||||
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
|
||||
"Takes an optional timeout in seconds, after which will return nil. "
|
||||
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")
|
||||
|
||||
182
src/core/os.c
182
src/core/os.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
* Copyright (c) 2021 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -185,6 +185,7 @@ static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
|
||||
/* Get env for os_execute */
|
||||
static char **os_execute_env(int32_t argc, const Janet *argv) {
|
||||
char **envp = NULL;
|
||||
@@ -319,13 +320,15 @@ static JanetBuffer *os_exec_escape(JanetView args) {
|
||||
static const JanetAbstractType ProcAT;
|
||||
#define JANET_PROC_CLOSED 1
|
||||
#define JANET_PROC_WAITED 2
|
||||
#define JANET_PROC_WAITING 4
|
||||
#define JANET_PROC_ERROR_NONZERO 8
|
||||
typedef struct {
|
||||
int flags;
|
||||
#ifdef JANET_WINDOWS
|
||||
HANDLE pHandle;
|
||||
HANDLE tHandle;
|
||||
#else
|
||||
int pid;
|
||||
pid_t pid;
|
||||
#endif
|
||||
int return_code;
|
||||
#ifdef JANET_EV
|
||||
@@ -339,6 +342,62 @@ typedef struct {
|
||||
#endif
|
||||
} JanetProc;
|
||||
|
||||
#ifdef JANET_EV
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
WaitForSingleObject(proc->pHandle, INFINITE);
|
||||
GetExitCodeProcess(proc->pHandle, &args.argi);
|
||||
return args;
|
||||
}
|
||||
|
||||
#else /* windows check */
|
||||
|
||||
/* Function that is called in separate thread to wait on a pid */
|
||||
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
pid_t result;
|
||||
int status = 0;
|
||||
do {
|
||||
result = waitpid(proc->pid, &status, 0);
|
||||
} while (result == -1 && errno == EINTR);
|
||||
/* Use POSIX shell semantics for interpreting signals */
|
||||
if (WIFEXITED(status)) {
|
||||
status = WEXITSTATUS(status);
|
||||
} else if (WIFSTOPPED(status)) {
|
||||
status = WSTOPSIG(status) + 128;
|
||||
} else {
|
||||
status = WTERMSIG(status) + 128;
|
||||
}
|
||||
args.argi = status;
|
||||
return args;
|
||||
}
|
||||
|
||||
#endif /* End windows check */
|
||||
|
||||
/* Callback that is called in main thread when subroutine completes. */
|
||||
static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||
int status = args.argi;
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
if (NULL != proc) {
|
||||
proc->return_code = (int32_t) status;
|
||||
proc->flags |= JANET_PROC_WAITED;
|
||||
proc->flags &= ~JANET_PROC_WAITING;
|
||||
janet_gcunroot(janet_wrap_abstract(proc));
|
||||
janet_gcunroot(janet_wrap_fiber(args.fiber));
|
||||
if ((status != 0) && (proc->flags & JANET_PROC_ERROR_NONZERO)) {
|
||||
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
|
||||
janet_cancel(args.fiber, janet_wrap_string(s));
|
||||
} else {
|
||||
janet_schedule(args.fiber, janet_wrap_integer(status));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#endif /* End ev check */
|
||||
|
||||
static int janet_proc_gc(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetProc *proc = (JanetProc *) p;
|
||||
@@ -367,10 +426,26 @@ static int janet_proc_mark(void *p, size_t s) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
JANET_NO_RETURN
|
||||
#endif
|
||||
static Janet os_proc_wait_impl(JanetProc *proc) {
|
||||
if (proc->flags & JANET_PROC_WAITED) {
|
||||
janet_panicf("cannot wait on process that has already finished");
|
||||
if (proc->flags & (JANET_PROC_WAITED | JANET_PROC_WAITING)) {
|
||||
janet_panicf("cannot wait twice on a process");
|
||||
}
|
||||
#ifdef JANET_EV
|
||||
/* Event loop implementation - threaded call */
|
||||
proc->flags |= JANET_PROC_WAITING;
|
||||
JanetEVGenericMessage targs;
|
||||
memset(&targs, 0, sizeof(targs));
|
||||
targs.argp = proc;
|
||||
targs.fiber = janet_root_fiber();
|
||||
janet_gcroot(janet_wrap_abstract(proc));
|
||||
janet_gcroot(janet_wrap_fiber(targs.fiber));
|
||||
janet_ev_threaded_call(janet_proc_wait_subr, targs, janet_proc_wait_cb);
|
||||
janet_await();
|
||||
#else
|
||||
/* Non evented implementation */
|
||||
proc->flags |= JANET_PROC_WAITED;
|
||||
int status = 0;
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -386,6 +461,7 @@ static Janet os_proc_wait_impl(JanetProc *proc) {
|
||||
#endif
|
||||
proc->return_code = (int32_t) status;
|
||||
return janet_wrap_integer(proc->return_code);
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_proc_wait(int32_t argc, Janet *argv) {
|
||||
@@ -481,7 +557,7 @@ static int janet_proc_get(void *p, Janet key, Janet *out) {
|
||||
return 1;
|
||||
}
|
||||
if (janet_keyeq(key, "err")) {
|
||||
*out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
|
||||
*out = (NULL == proc->err) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
|
||||
return 1;
|
||||
}
|
||||
if ((-1 != proc->return_code) && janet_keyeq(key, "return-code")) {
|
||||
@@ -575,7 +651,7 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) {
|
||||
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
janet_arity(argc, 1, 3);
|
||||
|
||||
/* Get flags */
|
||||
@@ -713,7 +789,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) {
|
||||
tHandle = processInfo.hThread;
|
||||
|
||||
/* Wait and cleanup immedaitely */
|
||||
if (!is_async) {
|
||||
if (!is_spawn) {
|
||||
DWORD code;
|
||||
WaitForSingleObject(pHandle, INFINITE);
|
||||
GetExitCodeProcess(pHandle, &code);
|
||||
@@ -781,45 +857,51 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) {
|
||||
if (status) {
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
} else if (is_async) {
|
||||
} else if (is_spawn) {
|
||||
/* Get process handle */
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
} else {
|
||||
/* Wait to complete */
|
||||
waitpid(pid, &status, 0);
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
/* Use POSIX shell semantics for interpreting signals */
|
||||
if (WIFEXITED(status)) {
|
||||
status = WEXITSTATUS(status);
|
||||
} else if (WIFSTOPPED(status)) {
|
||||
status = WSTOPSIG(status) + 128;
|
||||
} else {
|
||||
status = WTERMSIG(status) + 128;
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
if (is_async) {
|
||||
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
|
||||
proc->return_code = -1;
|
||||
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
|
||||
proc->return_code = -1;
|
||||
#ifdef JANET_WINDOWS
|
||||
proc->pHandle = pHandle;
|
||||
proc->tHandle = tHandle;
|
||||
proc->pHandle = pHandle;
|
||||
proc->tHandle = tHandle;
|
||||
#else
|
||||
proc->pid = pid;
|
||||
proc->pid = pid;
|
||||
#endif
|
||||
proc->in = NULL;
|
||||
proc->out = NULL;
|
||||
proc->err = NULL;
|
||||
if (new_in != JANET_HANDLE_NONE) {
|
||||
proc->in = get_stdio_for_handle(new_in, orig_in, 0);
|
||||
if (NULL == proc->in) janet_panic("failed to construct proc");
|
||||
}
|
||||
if (new_out != JANET_HANDLE_NONE) {
|
||||
proc->out = get_stdio_for_handle(new_out, orig_out, 1);
|
||||
if (NULL == proc->out) janet_panic("failed to construct proc");
|
||||
}
|
||||
if (new_err != JANET_HANDLE_NONE) {
|
||||
proc->err = get_stdio_for_handle(new_err, orig_err, 1);
|
||||
proc->flags = 0;
|
||||
if (proc->in == NULL || proc->out == NULL || proc->err == NULL) {
|
||||
janet_panic("failed to construct proc");
|
||||
}
|
||||
if (NULL == proc->err) janet_panic("failed to construct proc");
|
||||
}
|
||||
proc->flags = 0;
|
||||
if (janet_flag_at(flags, 2)) {
|
||||
proc->flags |= JANET_PROC_ERROR_NONZERO;
|
||||
}
|
||||
|
||||
if (is_spawn) {
|
||||
return janet_wrap_abstract(proc);
|
||||
} else if (janet_flag_at(flags, 2) && status) {
|
||||
janet_panicf("command failed with non-zero exit code %d", status);
|
||||
} else {
|
||||
return janet_wrap_integer(status);
|
||||
#ifdef JANET_EV
|
||||
os_proc_wait_impl(proc);
|
||||
#else
|
||||
return os_proc_wait_impl(proc);
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2037,25 +2119,25 @@ static const JanetReg os_cfuns[] = {
|
||||
"mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
|
||||
"The default mode is 8r666. "
|
||||
"Allowed flags are as follows:\n\n"
|
||||
"\t:r - open this file for reading\n"
|
||||
"\t:w - open this file for writing\n"
|
||||
"\t:c - create a new file (O_CREATE)\n"
|
||||
"\t:e - fail if the file exists (O_EXCL)\n"
|
||||
"\t:t - shorten an existing file to length 0 (O_TRUNC)\n\n"
|
||||
"Posix only flags:\n"
|
||||
"\t:a - append to a file (O_APPEND)\n"
|
||||
"\t:x - O_SYNC\n"
|
||||
"\t:C - O_NOCTTY\n\n"
|
||||
"Windows only flags:\n"
|
||||
"\t:R - share reads (FILE_SHARE_READ)\n"
|
||||
"\t:W - share writes (FILE_SHARE_WRITE)\n"
|
||||
"\t:D - share deletes (FILE_SHARE_DELETE)\n"
|
||||
"\t:H - FILE_ATTRIBUTE_HIDDEN\n"
|
||||
"\t:O - FILE_ATTRIBUTE_READONLY\n"
|
||||
"\t:F - FILE_ATTRIBUTE_OFFLINE\n"
|
||||
"\t:T - FILE_ATTRIBUTE_TEMPORARY\n"
|
||||
"\t:d - FILE_FLAG_DELETE_ON_CLOSE\n"
|
||||
"\t:b - FILE_FLAG_NO_BUFFERING\n")
|
||||
" * :r - open this file for reading\n"
|
||||
" * :w - open this file for writing\n"
|
||||
" * :c - create a new file (O_CREATE)\n"
|
||||
" * :e - fail if the file exists (O_EXCL)\n"
|
||||
" * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
|
||||
"Posix only flags:\n\n"
|
||||
" * :a - append to a file (O_APPEND)\n"
|
||||
" * :x - O_SYNC\n"
|
||||
" * :C - O_NOCTTY\n\n"
|
||||
"Windows only flags:\n\n"
|
||||
" * :R - share reads (FILE_SHARE_READ)\n"
|
||||
" * :W - share writes (FILE_SHARE_WRITE)\n"
|
||||
" * :D - share deletes (FILE_SHARE_DELETE)\n"
|
||||
" * :H - FILE_ATTRIBUTE_HIDDEN\n"
|
||||
" * :O - FILE_ATTRIBUTE_READONLY\n"
|
||||
" * :F - FILE_ATTRIBUTE_OFFLINE\n"
|
||||
" * :T - FILE_ATTRIBUTE_TEMPORARY\n"
|
||||
" * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
|
||||
" * :b - FILE_FLAG_NO_BUFFERING\n")
|
||||
},
|
||||
{
|
||||
"os/pipe", os_pipe,
|
||||
@@ -2078,6 +2160,8 @@ void janet_lib_os(JanetTable *env) {
|
||||
InitializeCriticalSection(&env_lock);
|
||||
env_lock_initialized = 1;
|
||||
}
|
||||
#endif
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
#endif
|
||||
janet_core_cfuns(env, NULL, os_cfuns);
|
||||
}
|
||||
|
||||
@@ -985,8 +985,20 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
if (argc > 1) {
|
||||
int32_t line = janet_getinteger(argv, 1);
|
||||
if (line < 1)
|
||||
janet_panicf("invalid line number %d", line);
|
||||
p->line = (size_t) line;
|
||||
}
|
||||
if (argc > 2) {
|
||||
int32_t column = janet_getinteger(argv, 2);
|
||||
if (column < 0)
|
||||
janet_panicf("invalid column number %d", column);
|
||||
p->column = (size_t) column;
|
||||
}
|
||||
Janet *tup = janet_tuple_begin(2);
|
||||
tup[0] = janet_wrap_integer(p->line);
|
||||
tup[1] = janet_wrap_integer(p->column);
|
||||
@@ -1247,8 +1259,10 @@ static const JanetReg parse_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"parser/where", cfun_parse_where,
|
||||
JDOC("(parser/where parser)\n\n"
|
||||
"Returns the current line number and column of the parser's internal state.")
|
||||
JDOC("(parser/where parser &opt line col)\n\n"
|
||||
"Returns the current line number and column of the parser's internal state. If line is "
|
||||
"provided, the current line number of the parser is first set to that value. If column is "
|
||||
"also provided, the current column number of the parser is also first set to that value.")
|
||||
},
|
||||
{
|
||||
"parser/eof", cfun_parse_eof,
|
||||
|
||||
@@ -565,7 +565,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
JanetTable *t = janet_unwrap_table(x);
|
||||
JanetTable *proto = t->proto;
|
||||
if (NULL != proto) {
|
||||
Janet name = janet_table_get(proto, janet_ckeywordv("name"));
|
||||
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
|
||||
const uint8_t *n;
|
||||
int32_t len;
|
||||
if (janet_bytes_view(name, &n, &len)) {
|
||||
|
||||
@@ -227,19 +227,21 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
/* Computes hash of an array of values */
|
||||
int32_t janet_array_calchash(const Janet *array, int32_t len) {
|
||||
const Janet *end = array + len;
|
||||
uint32_t hash = 5381;
|
||||
while (array < end)
|
||||
hash = (hash << 5) + hash + janet_hash(*array++);
|
||||
uint32_t hash = 0;
|
||||
while (array < end) {
|
||||
uint32_t elem = janet_hash(*array++);
|
||||
hash ^= elem + 0x9e3779b9 + (hash << 6) + (hash >> 2);
|
||||
}
|
||||
return (int32_t) hash;
|
||||
}
|
||||
|
||||
/* Computes hash of an array of values */
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
|
||||
const JanetKV *end = kvs + len;
|
||||
uint32_t hash = 5381;
|
||||
uint32_t hash = 0;
|
||||
while (kvs < end) {
|
||||
hash = (hash << 5) + hash + janet_hash(kvs->key);
|
||||
hash = (hash << 5) + hash + janet_hash(kvs->value);
|
||||
hash ^= janet_hash(kvs->key) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
|
||||
hash ^= janet_hash(kvs->value) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
|
||||
kvs++;
|
||||
}
|
||||
return (int32_t) hash;
|
||||
|
||||
@@ -28,6 +28,8 @@
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
#include <math.h>
|
||||
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
|
||||
@@ -261,6 +263,21 @@ int32_t janet_hash(Janet x) {
|
||||
case JANET_STRUCT:
|
||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||
break;
|
||||
case JANET_NUMBER: {
|
||||
double num = janet_unwrap_number(x);
|
||||
if (isnan(num) || isinf(num) || num == 0) {
|
||||
hash = 0;
|
||||
} else {
|
||||
hash = (int32_t)num;
|
||||
hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
|
||||
hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
|
||||
hash = (hash >> 16) ^ hash;
|
||||
|
||||
uint32_t lo = (uint32_t)(janet_u64(x) & 0xFFFFFFFF);
|
||||
hash ^= lo + 0x9e3779b9 + (hash << 6) + (hash >> 2);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstract xx = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *at = janet_abstract_type(xx);
|
||||
|
||||
@@ -1478,7 +1478,6 @@ int janet_init(void) {
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
janet_vm_stackn = 0;
|
||||
/* Threads */
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_init();
|
||||
#endif
|
||||
|
||||
@@ -1279,14 +1279,59 @@ JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener be
|
||||
|
||||
/* Shorthand for yielding to event loop in C */
|
||||
JANET_NO_RETURN JANET_API void janet_await(void);
|
||||
JANET_NO_RETURN JANET_API void janet_sleep_await(double sec);
|
||||
|
||||
/* For use inside listeners - adds a timeout to the current fiber, such that
|
||||
* it will be resumed after sec seconds if no other event schedules the current fiber. */
|
||||
JANET_API void janet_addtimeout(double sec);
|
||||
JANET_API void janet_ev_inc_refcount(void);
|
||||
JANET_API void janet_ev_dec_refcount(void);
|
||||
|
||||
/* Get last error from a an IO operation */
|
||||
JANET_API Janet janet_ev_lasterr(void);
|
||||
|
||||
/* Async service for calling a function or syscall in a background thread. This is not
|
||||
* as efficient in the slightest as using Streams but can be used for arbitrary blocking
|
||||
* functions and syscalls. */
|
||||
|
||||
/* Used to pass data between the main thread and worker threads for simple tasks.
|
||||
* We could just use a pointer but this prevents malloc/free in the common case
|
||||
* of only a handful of arguments. */
|
||||
typedef struct {
|
||||
int tag;
|
||||
int argi;
|
||||
void *argp;
|
||||
JanetFiber *fiber;
|
||||
} JanetEVGenericMessage;
|
||||
|
||||
/* How to resume or cancel after a threaded call. Not exhaustive of the possible
|
||||
* ways one might want to resume after returning from a threaded call, but should
|
||||
* cover most of the common cases. For something more complicated, such as resuming
|
||||
* with an abstract type or a struct, one should use janet_ev_threaded_call instead
|
||||
* of janet_ev_threaded_await with a custom callback. */
|
||||
|
||||
#define JANET_EV_TCTAG_NIL 0 /* resume with nil */
|
||||
#define JANET_EV_TCTAG_INTEGER 1 /* resume with janet_wrap_integer(argi) */
|
||||
#define JANET_EV_TCTAG_STRING 2 /* resume with janet_cstringv((const char *) argp) */
|
||||
#define JANET_EV_TCTAG_STRINGF 3 /* resume with janet_cstringv((const char *) argp), then call free on argp. */
|
||||
#define JANET_EV_TCTAG_KEYWORD 4 /* resume with janet_ckeywordv((const char *) argp) */
|
||||
#define JANET_EV_TCTAG_ERR_STRING 5 /* cancel with janet_cstringv((const char *) argp) */
|
||||
#define JANET_EV_TCTAG_ERR_STRINGF 6 /* cancel with janet_cstringv((const char *) argp), then call free on argp. */
|
||||
#define JANET_EV_TCTAG_ERR_KEYWORD 7 /* cancel with janet_ckeywordv((const char *) argp) */
|
||||
|
||||
/* Function pointer that is run in the thread pool */
|
||||
typedef JanetEVGenericMessage(*JanetThreadedSubroutine)(JanetEVGenericMessage arguments);
|
||||
|
||||
/* Handler that is run in the main thread with the result of the JanetAsyncSubroutine */
|
||||
typedef void (*JanetThreadedCallback)(JanetEVGenericMessage return_value);
|
||||
|
||||
/* API calls for quickly offloading some work in C to a new thread or thread pool. */
|
||||
JANET_API void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb);
|
||||
JANET_API void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp);
|
||||
|
||||
/* Callback used by janet_ev_threaded_await */
|
||||
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
|
||||
|
||||
/* Read async from a stream */
|
||||
JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
|
||||
@@ -126,28 +126,21 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_MATCH_MAX 256
|
||||
#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 JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static int gbl_match_count = 0;
|
||||
static int gbl_lines_below = 0;
|
||||
|
||||
/* Put a lock around this global state so we don't screw up
|
||||
* the terminal in a multithreaded situation */
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
#include <pthread.h>
|
||||
static pthread_mutex_t gbl_lock = PTHREAD_MUTEX_INITIALIZER;
|
||||
#endif
|
||||
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;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
@@ -169,9 +162,6 @@ static char *sdup(const char *s) {
|
||||
/* Ansi terminal raw mode */
|
||||
static int rawmode(void) {
|
||||
struct termios t;
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
pthread_mutex_lock(&gbl_lock);
|
||||
#endif
|
||||
if (!isatty(STDIN_FILENO)) goto fatal;
|
||||
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
|
||||
t = gbl_termios_start;
|
||||
@@ -185,9 +175,6 @@ static int rawmode(void) {
|
||||
return 0;
|
||||
fatal:
|
||||
errno = ENOTTY;
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
pthread_mutex_unlock(&gbl_lock);
|
||||
#endif
|
||||
return -1;
|
||||
}
|
||||
|
||||
@@ -195,9 +182,6 @@ fatal:
|
||||
static void norawmode(void) {
|
||||
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1)
|
||||
gbl_israwmode = 0;
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
pthread_mutex_unlock(&gbl_lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
static int curpos(void) {
|
||||
@@ -774,6 +758,10 @@ static int line() {
|
||||
kleft();
|
||||
break;
|
||||
case 3: /* ctrl-c */
|
||||
clearlines();
|
||||
gbl_sigint_flag = 1;
|
||||
return -1;
|
||||
case 17: /* ctrl-q */
|
||||
gbl_cancel_current_repl_form = 1;
|
||||
clearlines();
|
||||
return -1;
|
||||
|
||||
@@ -13,7 +13,7 @@
|
||||
(when x (++ num-tests-passed))
|
||||
(def str (string e))
|
||||
(def truncated
|
||||
(if (> (length e) 40) (string (string/slice e 0 35) "...") (string e)))
|
||||
(if (> (length e) 40) (string (string/slice e 0 35) "...") (describe e)))
|
||||
(if x
|
||||
(eprintf "\e[32m✔\e[0m %s: %v" truncated x)
|
||||
(eprintf "\n\e[31m✘\e[0m %s: %v" truncated x))
|
||||
|
||||
@@ -1,3 +1,3 @@
|
||||
(import build/testmod :as testmod)
|
||||
(import /build/testmod :as testmod)
|
||||
|
||||
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
(use build/testmod)
|
||||
(use build/testmod2)
|
||||
(use build/testmod3)
|
||||
(use build/test-mod-4)
|
||||
(use /build/testmod)
|
||||
(use /build/testmod2)
|
||||
(use /build/testmod3)
|
||||
(use /build/test-mod-4)
|
||||
|
||||
(defn main [&]
|
||||
(print "Hello from executable!")
|
||||
|
||||
@@ -128,6 +128,18 @@
|
||||
(assert (not= nil (parse-error @"\xc3\x28")) "reject invalid utf-8 symbol")
|
||||
(assert (not= nil (parse-error @":\xc3\x28")) "reject invalid utf-8 keyword")
|
||||
|
||||
# Parser line and column numbers
|
||||
(defn parser-location [input &opt location]
|
||||
(def p (parser/new))
|
||||
(parser/consume p input)
|
||||
(if location
|
||||
(parser/where p ;location)
|
||||
(parser/where p)))
|
||||
|
||||
(assert (= [1 7] (parser-location @"(+ 1 2)")) "parser location 1")
|
||||
(assert (= [5 7] (parser-location @"(+ 1 2)" [5])) "parser location 2")
|
||||
(assert (= [10 10] (parser-location @"(+ 1 2)" [10 10])) "parser location 3")
|
||||
|
||||
# String check-set
|
||||
(assert (string/check-set "abc" "a") "string/check-set 1")
|
||||
(assert (not (string/check-set "abc" "z")) "string/check-set 2")
|
||||
|
||||
@@ -125,6 +125,7 @@
|
||||
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
|
||||
(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
|
||||
(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
|
||||
(assert (= "t" (match [true nil] [true _] "t")) "match wildcard 8")
|
||||
|
||||
# Regression #301
|
||||
(def b (buffer/new-filled 128 0x78))
|
||||
@@ -221,20 +222,6 @@
|
||||
neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
|
||||
|
||||
# No segfault, valgrind clean.
|
||||
|
||||
(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
|
||||
(assert-error "bad fiber status" (unmarshal x load-image-dict))
|
||||
(gccollect)
|
||||
(marshal x make-image-dict)
|
||||
|
||||
(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9")
|
||||
(unmarshal b load-image-dict)
|
||||
(gccollect)
|
||||
|
||||
(def v (unmarshal
|
||||
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
|
||||
load-image-dict))
|
||||
(gccollect)
|
||||
|
||||
# in vs get regression
|
||||
@@ -349,4 +336,12 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(check-replacer "aba" "ZZZZZZ" "ababababababa")
|
||||
(check-replacer "aba" "" "ababababababa")
|
||||
|
||||
# Peg bug
|
||||
(assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1")
|
||||
(assert (deep= @[] (peg/match '(any 1) (buffer))) "peg empty pattern 2")
|
||||
(assert (deep= @[] (peg/match '(any 1) "")) "peg empty pattern 3")
|
||||
(assert (deep= @[] (peg/match '(any 1) (string))) "peg empty pattern 4")
|
||||
(assert (deep= @[] (peg/match '(* "test" (any 1)) @"test")) "peg empty pattern 5")
|
||||
(assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test"))) "peg empty pattern 6")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -40,7 +40,7 @@
|
||||
# or else the first read can fail. Might be a strange windows
|
||||
# "bug", but needs further investigating. Otherwise, `build_win test`
|
||||
# can sometimes fail on windows, leading to flaky testing.
|
||||
(ev/sleep 0.2)
|
||||
(ev/sleep 0.3)
|
||||
|
||||
(defn test-echo [msg]
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
@@ -59,6 +59,7 @@
|
||||
(var pipe-counter 0)
|
||||
(def chan (ev/chan 10))
|
||||
(let [[reader writer] (os/pipe)]
|
||||
(ev/sleep 0.3)
|
||||
(ev/spawn
|
||||
(while (ev/read reader 3)
|
||||
(++ pipe-counter))
|
||||
|
||||
@@ -68,5 +68,68 @@
|
||||
# # off by 1 error in inttypes
|
||||
(assert (= (int/s64 "-0x8000_0000_0000_0000") (+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
|
||||
|
||||
#
|
||||
# Longstring indentation
|
||||
#
|
||||
|
||||
(defn reindent
|
||||
"Reindent a the contents of a longstring as the Janet parser would.
|
||||
This include removing leading and trailing newlines."
|
||||
[text indent]
|
||||
|
||||
# Detect minimum indent
|
||||
(var rewrite true)
|
||||
(each index (string/find-all "\n" text)
|
||||
(for i (+ index 1) (+ index indent 1)
|
||||
(case (get text i)
|
||||
nil (break)
|
||||
(chr "\n") (break)
|
||||
(chr " ") nil
|
||||
(set rewrite false))))
|
||||
|
||||
# Only re-indent if no dedented characters.
|
||||
(def str
|
||||
(if rewrite
|
||||
(peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text)
|
||||
text))
|
||||
|
||||
(def first-nl (= (chr "\n") (first str)))
|
||||
(def last-nl (= (chr "\n") (last str)))
|
||||
(string/slice str (if first-nl 1 0) (if last-nl -2)))
|
||||
|
||||
(defn reindent-reference
|
||||
"Same as reindent but use parser functionality. Useful for validating conformance."
|
||||
[text indent]
|
||||
(if (empty? text) (break text))
|
||||
(def source-code
|
||||
(string (string/repeat " " indent) "``````"
|
||||
text
|
||||
"``````"))
|
||||
(parse source-code))
|
||||
|
||||
(var indent-counter 0)
|
||||
(defn check-indent
|
||||
[text indent]
|
||||
(++ indent-counter)
|
||||
(let [a (reindent text indent)
|
||||
b (reindent-reference text indent)]
|
||||
(assert (= a b) (string "indent " indent-counter " (indent=" indent ")"))))
|
||||
|
||||
(check-indent "" 0)
|
||||
(check-indent "\n" 0)
|
||||
(check-indent "\n" 1)
|
||||
(check-indent "\n\n" 0)
|
||||
(check-indent "\n\n" 1)
|
||||
(check-indent "\nHello, world!" 0)
|
||||
(check-indent "\nHello, world!" 1)
|
||||
(check-indent "Hello, world!" 0)
|
||||
(check-indent "Hello, world!" 1)
|
||||
(check-indent "\n Hello, world!" 4)
|
||||
(check-indent "\n Hello, world!\n" 4)
|
||||
(check-indent "\n Hello, world!\n " 4)
|
||||
(check-indent "\n Hello, world!\n " 4)
|
||||
(check-indent "\n Hello, world!\n dedented text\n " 4)
|
||||
(check-indent "\n Hello, world!\n indented text\n " 4)
|
||||
|
||||
|
||||
(end-suite)
|
||||
|
||||
Reference in New Issue
Block a user