1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-21 09:44:49 +00:00

Compare commits

..

1 Commits

Author SHA1 Message Date
Calvin Rose
1bda40b644 Add first iteration of call hooks.
Hooks are per thread (not per fiber) for performance, and are exposed as
callback functions. Hooks cannot be nested, so hooks are disabled inside
other hooks.
2024-12-06 19:24:59 -06:00
30 changed files with 307 additions and 460 deletions

View File

@@ -27,16 +27,15 @@ jobs:
uses: actions/checkout@v3
- name: Initialize CodeQL
uses: github/codeql-action/init@v3
uses: github/codeql-action/init@v2
with:
languages: ${{ matrix.language }}
queries: +security-and-quality
tools: linked
- name: Autobuild
uses: github/codeql-action/autobuild@v3
uses: github/codeql-action/autobuild@v2
- name: Perform CodeQL Analysis
uses: github/codeql-action/analyze@v3
uses: github/codeql-action/analyze@v2
with:
category: "/language:${{ matrix.language }}"

View File

@@ -1,12 +1,6 @@
# Changelog
All notable changes to this project will be documented in this file.
## ??? - Unreleased
- Add `struct/rawget`
- Fix `deep=` and `deep-not=` to better handle degenerate cases with mutable table keys
- Long strings will now dedent on `\r\n` instead of just `\n`.
- Add `ev/to-file` for synchronous resource operations
## 1.37.1 - 2024-12-05
- Fix meson cross compilation
- Update timeout documentation for networking APIs: timeouts raise errors and do not return nil.

View File

@@ -207,7 +207,7 @@ Alternatively, install the package directly with `pkgin install janet`.
To build an `.msi` installer executable, in addition to the above steps, you will have to:
5. Install, or otherwise add to your PATH the [WiX 3.14 Toolset](https://github.com/wixtoolset/wix3/releases).
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
6. Run `build_win dist`.
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.

View File

@@ -91,7 +91,7 @@ exit /b 0
@rem Clean build artifacts
:CLEAN
del *.exe *.lib *.exp *.msi *.wixpdb
del *.exe *.lib *.exp
rd /s /q build
if exist dist (
rd /s /q dist
@@ -143,13 +143,7 @@ if defined CI (
) else (
set WIXBIN=
)
set WIXARCH=%BUILDARCH%
if "%WIXARCH%"=="aarch64" (
set WIXARCH=arm64
)
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %WIXARCH% -out build\
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\
%WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi
exit /b 0

View File

@@ -1311,7 +1311,7 @@
(defdyn *redef* "When set, allow dynamically rebinding top level defs. Will slow generated code and is intended to be used for development.")
(defdyn *debug* "Enables a built in debugger on errors and other useful features for debugging in a repl.")
(defdyn *exit* "When set, will cause the current context to complete. Can be set to exit from repl (or file), for example.")
(defdyn *exit-value* "Set the return value from `run-context` upon an exit.")
(defdyn *exit-value* "Set the return value from `run-context` upon an exit. By default, `run-context` will return nil.")
(defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrency control.")
(defdyn *current-file*
@@ -2219,31 +2219,56 @@
(map-template :some res pred ind inds)
res)
(defn deep-not=
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `not=`.``
[x y]
(def tx (type x))
(or
(not= tx (type y))
(case tx
:tuple (or (not= (length x) (length y))
(do
(var ret false)
(forv i 0 (length x)
(def xx (in x i))
(def yy (in y i))
(if (deep-not= xx yy)
(break (set ret true))))
ret))
:array (or (not= (length x) (length y))
(do
(var ret false)
(forv i 0 (length x)
(def xx (in x i))
(def yy (in y i))
(if (deep-not= xx yy)
(break (set ret true))))
ret))
:struct (deep-not= (kvs x) (kvs y))
:table (deep-not= (table/to-struct x) (table/to-struct y))
:buffer (not= (string x) (string y))
(not= x y))))
(defn deep=
``Like `=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `=`.``
[x y]
(not (deep-not= x y)))
(defn freeze
`Freeze an object (make it immutable) and do a deep copy, making
child values also immutable. Closures, fibers, and abstract types
will not be recursively frozen, but all other types will.`
[x]
(def tx (type x))
(cond
(or (= tx :array) (= tx :tuple))
(tuple/slice (map freeze x))
(or (= tx :table) (= tx :struct))
(let [temp-tab @{}]
# Handle multiple unique keys that freeze. Result should
# be independent of iteration order.
(eachp [k v] x
(def kk (freeze k))
(def vv (freeze v))
(def old (get temp-tab kk))
(def new (if (= nil old) vv (max vv old)))
(put temp-tab kk new))
(table/to-struct temp-tab (freeze (getproto x))))
(= tx :buffer)
(string x)
(case (type x)
:array (tuple/slice (map freeze x))
:tuple (tuple/slice (map freeze x))
:table (if-let [p (table/getproto x)]
(freeze (merge (table/clone p) x))
(struct ;(map freeze (kvs x))))
:struct (struct ;(map freeze (kvs x)))
:buffer (string x)
x))
(defn thaw
@@ -2259,41 +2284,6 @@
:string (buffer ds)
ds))
(defn deep-not=
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `not=`.``
[x y]
(def tx (type x))
(or
(not= tx (type y))
(cond
(or (= tx :tuple) (= tx :array))
(or (not= (length x) (length y))
(do
(var ret false)
(forv i 0 (length x)
(def xx (in x i))
(def yy (in y i))
(if (deep-not= xx yy)
(break (set ret true))))
ret))
(or (= tx :struct) (= tx :table))
(or (not= (length x) (length y))
(do
(def rawget (if (= tx :struct) struct/rawget table/rawget))
(var ret false)
(eachp [k v] x
(if (deep-not= (rawget y k) v) (break (set ret true))))
ret))
(= tx :buffer) (not= 0 (- (length x) (length y)) (memcmp x y))
(not= x y))))
(defn deep=
``Like `=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `=`.``
[x y]
(not (deep-not= x y)))
(defn macex
``Expand macros completely.
`on-binding` is an optional callback for whenever a normal symbolic binding
@@ -2864,8 +2854,8 @@
(when (and (string? pattern) (string/has-prefix? ":sys:/" pattern))
(set last-index index)
(array/push copies [(string/replace ":sys:" path pattern) ;(drop 1 entry)])))
(array/insert mp (+ 1 last-index) ;copies)
mp)
(array/insert mp (+ 1 last-index) ;copies)
mp)
(module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source)
@@ -4106,7 +4096,7 @@
(when (empty? b) (buffer/trim b) (os/chmod to perm) (break))
(file/write fto b)
(buffer/clear b)))
(errorf "destination file %s cannot be opened for writing" to))
(errorf "destination file %s cannot be opened for writing" to))
(errorf "source file %s cannot be opened for reading" from)))
(defn- copyrf

View File

@@ -62,13 +62,6 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
void janet_signalv(JanetSignal sig, Janet message) {
if (janet_vm.return_reg != NULL) {
/* Should match logic in janet_call for coercing everything not ok to an error (no awaits, yields, etc.) */
if (janet_vm.coerce_error && sig != JANET_SIGNAL_OK) {
if (sig != JANET_SIGNAL_ERROR) {
message = janet_wrap_string(janet_formatc("%v coerced from %s to error", message, janet_signal_names[sig]));
}
sig = JANET_SIGNAL_ERROR;
}
*janet_vm.return_reg = message;
if (NULL != janet_vm.fiber) {
janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP;

View File

@@ -449,9 +449,8 @@ JANET_CORE_FN(janet_core_range,
}
count = (count > 0) ? count : 0;
int32_t int_count;
janet_assert(count >= 0, "bad range code");
if (count > (double) INT32_MAX) {
janet_panicf("range is too large, %f elements", count);
int_count = INT32_MAX;
} else {
int_count = (int32_t) ceil(count);
}
@@ -1002,12 +1001,12 @@ static void make_apply(JanetTable *env) {
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
JDOC("(apply f & args)\n\n"
"Applies a function to a variable number of arguments. Each element in args "
"is used as an argument to f, except the last element in args, which is expected to "
"be an array-like. Each element in this last argument is then also pushed as an argument to "
"f. For example:\n\n"
"\t(apply + 1000 (range 10))\n\n"
"sums the first 10 integers and 1000."));
"Applies a function to a variable number of arguments. Each element in args "
"is used as an argument to f, except the last element in args, which is expected to "
"be an array-like. Each element in this last argument is then also pushed as an argument to "
"f. For example:\n\n"
"\t(apply + 1000 (range 10))\n\n"
"sums the first 10 integers and 1000."));
}
static const uint32_t error_asm[] = {
@@ -1160,82 +1159,82 @@ JanetTable *janet_core_env(JanetTable *replacements) {
janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n"
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"
"Gets the next key in a data structure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if the data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through."));
"Gets the next key in a data structure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if the data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through."));
janet_quick_asm(env, JANET_FUN_PROP,
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
JDOC("(propagate x fiber)\n\n"
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n"
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns the value passed in by resume."));
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns the value passed in by resume."));
janet_quick_asm(env, JANET_FUN_ERROR,
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
JDOC("(error e)\n\n"
"Throws an error e that can be caught and handled by a parent fiber."));
"Throws an error e that can be caught and handled by a parent fiber."));
janet_quick_asm(env, JANET_FUN_YIELD,
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
JDOC("(yield &opt x)\n\n"
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume."));
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_CANCEL,
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
JDOC("(cancel fiber err)\n\n"
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n"
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
"will be returned to the last yield in the case of a pending fiber, or the argument to "
"the dispatch function in the case of a new fiber. Returns either the return result of "
"the fiber's dispatch function, or the value from the next yield call in fiber."));
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
"will be returned to the last yield in the case of a pending fiber, or the argument to "
"the dispatch function in the case of a new fiber. Returns either the return result of "
"the fiber's dispatch function, or the value from the next yield call in fiber."));
janet_quick_asm(env, JANET_FUN_IN,
"in", 3, 2, 3, 4, in_asm, sizeof(in_asm),
JDOC("(in ds key &opt dflt)\n\n"
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
"take any value as a key except nil and will return nil or dflt if not found."));
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
"take any value as a key except nil and will return nil or dflt if not found."));
janet_quick_asm(env, JANET_FUN_GET,
"get", 3, 2, 3, 4, get_asm, sizeof(in_asm),
JDOC("(get ds key &opt dflt)\n\n"
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
"Similar to in, but will not throw an error if the key is invalid for the data structure "
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
"an error."));
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
"Similar to in, but will not throw an error if the key is invalid for the data structure "
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
"an error."));
janet_quick_asm(env, JANET_FUN_PUT,
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
JDOC("(put ds key value)\n\n"
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
janet_quick_asm(env, JANET_FUN_LENGTH,
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
JDOC("(length ds)\n\n"
"Returns the length or count of a data structure in constant time as an integer. For "
"structs and tables, returns the number of key-value pairs in the data structure."));
"Returns the length or count of a data structure in constant time as an integer. For "
"structs and tables, returns the number of key-value pairs in the data structure."));
janet_quick_asm(env, JANET_FUN_BNOT,
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
@@ -1244,74 +1243,74 @@ JanetTable *janet_core_env(JanetTable *replacements) {
/* Variadic ops */
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
JDOC("(+ & xs)\n\n"
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
JDOC("(- & xs)\n\n"
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
"the rest of the elements."));
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
"the rest of the elements."));
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
JDOC("(* & xs)\n\n"
"Returns the product of all elements in xs. If xs is empty, returns 1."));
"Returns the product of all elements in xs. If xs is empty, returns 1."));
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
JDOC("(/ & xs)\n\n"
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
JDOC("(div & xs)\n\n"
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
JDOC("(mod & xs)\n\n"
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
"`(mod x 0)` is defined to be `x`."));
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
"`(mod x 0)` is defined to be `x`."));
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
JDOC("(% & xs)\n\n"
"Returns the remainder of dividing the first value of xs by each remaining value."));
"Returns the remainder of dividing the first value of xs by each remaining value."));
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
JDOC("(band & xs)\n\n"
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
JDOC("(bor & xs)\n\n"
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
JDOC("(bxor & xs)\n\n"
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
JDOC("(blshift x & shifts)\n\n"
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
"and each element in shift must be an integer."));
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
"and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
JDOC("(brshift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer."));
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
JDOC("(brushift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer. The sign of x is not preserved, so "
"for positive shifts the return value will always be positive."));
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer. The sign of x is not preserved, so "
"for positive shifts the return value will always be positive."));
/* Variadic comparators */
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
JDOC("(> & xs)\n\n"
"Check if xs is in descending order. Returns a boolean."));
"Check if xs is in descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
JDOC("(< & xs)\n\n"
"Check if xs is in ascending order. Returns a boolean."));
"Check if xs is in ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
JDOC("(>= & xs)\n\n"
"Check if xs is in non-ascending order. Returns a boolean."));
"Check if xs is in non-ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
JDOC("(<= & xs)\n\n"
"Check if xs is in non-descending order. Returns a boolean."));
"Check if xs is in non-descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
JDOC("(= & xs)\n\n"
"Check if all values in xs are equal. Returns a boolean."));
"Check if all values in xs are equal. Returns a boolean."));
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
JDOC("(not= & xs)\n\n"
"Check if any values in xs are not equal. Returns a boolean."));
"Check if any values in xs are not equal. Returns a boolean."));
/* Platform detection */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
@@ -1320,7 +1319,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("The build identifier of the running janet program."));
janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS),
JDOC("The flag set of config options from janetconf.h which is used to check "
"if native modules are compatible with the host program."));
"if native modules are compatible with the host program."));
/* Allow references to the environment */
janet_def(env, "root-env", janet_wrap_table(env),

View File

@@ -428,6 +428,16 @@ JANET_CORE_FN(cfun_debug_step,
return out;
}
JANET_CORE_FN(cfun_debug_hook,
"(debug/hook hookfn)",
"Add a hook that will be called on certain runtime events.") {
janet_arity(argc, 0, 1);
JanetFunction *func = janet_optfunction(argv, argc, 0, NULL);
janet_vm.hook = func;
janet_vm.hook_reset = func;
return janet_wrap_nil();
}
/* Module entry point */
void janet_lib_debug(JanetTable *env) {
JanetRegExt debug_cfuns[] = {
@@ -440,6 +450,7 @@ void janet_lib_debug(JanetTable *env) {
JANET_CORE_REG("debug/stacktrace", cfun_debug_stacktrace),
JANET_CORE_REG("debug/lineage", cfun_debug_lineage),
JANET_CORE_REG("debug/step", cfun_debug_step),
JANET_CORE_REG("debug/hook", cfun_debug_hook),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, debug_cfuns);

View File

@@ -32,11 +32,9 @@
#ifdef JANET_EV
#include <math.h>
#include <fcntl.h>
#ifdef JANET_WINDOWS
#include <winsock2.h>
#include <windows.h>
#include <io.h>
#else
#include <pthread.h>
#include <limits.h>
@@ -45,6 +43,7 @@
#include <signal.h>
#include <sys/ioctl.h>
#include <sys/types.h>
#include <fcntl.h>
#include <netinet/in.h>
#include <netinet/tcp.h>
#include <netdb.h>
@@ -3276,64 +3275,6 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release,
return argv[0];
}
static JanetFile *get_file_for_stream(JanetStream *stream) {
int32_t flags = 0;
char fmt[4] = {0};
int index = 0;
if (stream->flags & JANET_STREAM_READABLE) {
flags |= JANET_FILE_READ;
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
fmt[index++] = 'r';
}
if (stream->flags & JANET_STREAM_WRITABLE) {
flags |= JANET_FILE_WRITE;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
int currindex = index;
fmt[index++] = (currindex == 0) ? 'w' : '+';
}
if (index == 0) return NULL;
/* duplicate handle when converting stream to file */
#ifdef JANET_WINDOWS
int htype = 0;
if (fmt[0] == 'r' && fmt[1] == '+') {
htype = _O_RDWR;
} else if (fmt[0] == 'r') {
htype = _O_RDONLY;
} else if (fmt[0] == 'w') {
htype = _O_WRONLY;
}
int fd = _open_osfhandle((intptr_t) stream->handle, htype);
if (fd < 0) return NULL;
int fd_dup = _dup(fd);
if (fd_dup < 0) return NULL;
FILE *f = _fdopen(fd_dup, fmt);
if (NULL == f) {
_close(fd_dup);
return NULL;
}
#else
int fd_dup = dup(stream->handle);
if (fd_dup < 0) return NULL;
FILE *f = fdopen(fd_dup, fmt);
if (NULL == f) {
close(fd_dup);
return NULL;
}
#endif
return janet_makejfile(f, flags);
}
JANET_CORE_FN(janet_cfun_to_file,
"(ev/to-file)",
"Create core/file copy of the stream. This value can be used "
"when blocking IO behavior is needed.") {
janet_fixarity(argc, 1);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
JanetFile *iof = get_file_for_stream(stream);
if (iof == NULL) janet_panic("cannot make file from stream");
return janet_wrap_abstract(iof);
}
JANET_CORE_FN(janet_cfun_ev_all_tasks,
"(ev/all-tasks)",
"Get an array of all active fibers that are being used by the scheduler.") {
@@ -3378,7 +3319,6 @@ void janet_lib_ev(JanetTable *env) {
JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock),
JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release),
JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release),
JANET_CORE_REG("ev/to-file", janet_cfun_to_file),
JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks),
JANET_REG_END
};

View File

@@ -591,6 +591,8 @@ void janet_collect(void) {
#ifdef JANET_EV
janet_ev_mark();
#endif
if (janet_vm.hook != NULL) janet_mark(janet_wrap_function(janet_vm.hook));
if (janet_vm.hook_reset != NULL) janet_mark(janet_wrap_function(janet_vm.hook_reset));
janet_mark_fiber(janet_vm.root_fiber);
for (i = 0; i < orig_rootcount; i++)
janet_mark(janet_vm.roots[i]);

View File

@@ -191,21 +191,21 @@ Janet janet_wrap_u64(uint64_t x) {
JANET_CORE_FN(cfun_it_s64_new,
"(int/s64 value)",
"Create a boxed signed 64 bit integer from a string value or a number.") {
"Create a boxed signed 64 bit integer from a string value.") {
janet_fixarity(argc, 1);
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
}
JANET_CORE_FN(cfun_it_u64_new,
"(int/u64 value)",
"Create a boxed unsigned 64 bit integer from a string value or a number.") {
"Create a boxed unsigned 64 bit integer from a string value.") {
janet_fixarity(argc, 1);
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
}
JANET_CORE_FN(cfun_to_number,
"(int/to-number value)",
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int64.") {
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
janet_fixarity(argc, 1);
if (janet_type(argv[0]) == JANET_ABSTRACT) {
void *abst = janet_unwrap_abstract(argv[0]);

View File

@@ -31,7 +31,6 @@
#ifndef JANET_WINDOWS
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/wait.h>
#include <unistd.h>
#endif
@@ -165,14 +164,6 @@ JANET_CORE_FN(cfun_io_fopen,
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
if (f != NULL) {
#ifndef JANET_WINDOWS
struct stat st;
fstat(fileno(f), &st);
if (S_ISDIR(st.st_mode)) {
fclose(f);
janet_panicf("cannot open directory: %s", fname);
}
#endif
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
if (bufsize != BUFSIZ) {
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);

View File

@@ -578,19 +578,17 @@ JANET_CORE_FN(cfun_net_connect,
net_sched_connect(stream);
}
static const char *serverify_socket(JSock sfd, int reuse) {
static const char *serverify_socket(JSock sfd) {
/* Set various socket options */
int enable = 1;
if (reuse) {
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEADDR) failed";
}
#ifdef SO_REUSEPORT
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEPORT) failed";
}
#endif
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEADDR) failed";
}
#ifdef SO_REUSEPORT
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEPORT) failed";
}
#endif
janet_net_socknoblock(sfd);
return NULL;
}
@@ -644,21 +642,19 @@ JANET_CORE_FN(cfun_net_shutdown,
}
JANET_CORE_FN(cfun_net_listen,
"(net/listen host port &opt type no-reuse)",
"(net/listen host port &opt type)",
"Creates a server. Returns a new stream that is neither readable nor "
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
"The type parameter specifies the type of network connection, either "
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
":stream. The host and port arguments are the same as in net/address. The last boolean parameter `no-reuse` will "
"disable the use of SO_REUSEADDR and SO_REUSEPORT when creating a server on some operating systems.") {
":stream. The host and port arguments are the same as in net/address.") {
janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
janet_arity(argc, 2, 4);
janet_arity(argc, 2, 3);
/* Get host, port, and handler*/
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix);
int reuse = !(argc >= 4 && janet_truthy(argv[3]));
JSock sfd = JSOCKDEFAULT;
#ifndef JANET_WINDOWS
@@ -668,7 +664,7 @@ JANET_CORE_FN(cfun_net_listen,
janet_free(ai);
janet_panicf("could not create socket: %V", janet_ev_lasterr());
}
const char *err = serverify_socket(sfd, reuse);
const char *err = serverify_socket(sfd);
if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
JSOCKCLOSE(sfd);
janet_free(ai);
@@ -691,7 +687,7 @@ JANET_CORE_FN(cfun_net_listen,
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
#endif
if (!JSOCKVALID(sfd)) continue;
const char *err = serverify_socket(sfd, reuse);
const char *err = serverify_socket(sfd);
if (NULL != err) {
JSOCKCLOSE(sfd);
continue;

View File

@@ -363,7 +363,8 @@ static int stringend(JanetParser *p, JanetParseState *state) {
JanetParseState top = p->states[p->statecount - 1];
int32_t indent_col = (int32_t) top.column - 1;
uint8_t *r = bufstart, *end = r + buflen;
/* Unless there are only spaces before EOLs, disable reindenting */
/* Check if there are any characters before the start column -
* if so, do not reindent. */
int reindent = 1;
while (reindent && (r < end)) {
if (*r++ == '\n') {
@@ -373,36 +374,34 @@ static int stringend(JanetParser *p, JanetParseState *state) {
break;
}
}
if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') reindent = 1;
}
}
/* Now reindent if able */
if (reindent) {
/* Now reindent if able to, otherwise just drop leading newline. */
if (!reindent) {
if (buflen > 0 && bufstart[0] == '\n') {
buflen--;
bufstart++;
}
} else {
uint8_t *w = bufstart;
r = bufstart;
while (r < end) {
if (*r == '\n') {
*w++ = *r++;
if (r == bufstart) {
/* Skip leading newline */
r++;
} else {
*w++ = *r++;
}
for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++);
if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') *w++ = *r++;
} else {
*w++ = *r++;
}
}
buflen = (int32_t)(w - bufstart);
}
/* Check for leading EOL so we can remove it */
if (buflen > 1 && bufstart[0] == '\r' && bufstart[1] == '\n') { /* Windows EOL */
buflen = buflen - 2;
bufstart = bufstart + 2;
} else if (buflen > 0 && bufstart[0] == '\n') { /* Unix EOL */
buflen--;
bufstart++;
}
/* Check for trailing EOL so we can remove it */
if (buflen > 1 && bufstart[buflen - 2] == '\r' && bufstart[buflen - 1] == '\n') { /* Windows EOL */
buflen = buflen - 2;
} else if (buflen > 0 && bufstart[buflen - 1] == '\n') { /* Unix EOL */
/* Check for trailing newline character so we can remove it */
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
buflen--;
}
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2025 Calvin Rose
* Copyright (c) 2024 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
@@ -549,39 +549,36 @@ tail:
const uint32_t *rule_separator = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
const uint8_t *chunk_start = text;
const uint8_t *chunk_end = NULL;
while (text <= saved_end) {
/* Find next split (or end of text) */
const uint8_t *separator_end = NULL;
do {
const uint8_t *text_start = text;
CapState cs = cap_save(s);
down1(s);
while (text <= saved_end) {
chunk_end = text;
const uint8_t *check = peg_rule(s, rule_separator, text);
while (text <= s->text_end) {
separator_end = peg_rule(s, rule_separator, text);
cap_load(s, cs);
if (check) {
text = check;
if (separator_end) {
break;
}
text++;
}
up1(s);
/* Match between splits */
s->text_end = chunk_end;
if (separator_end) {
s->text_end = text;
text = separator_end;
}
down1(s);
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, chunk_start);
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
up1(s);
s->text_end = saved_end;
if (!subpattern_end) return NULL; /* Don't match anything */
/* Ensure forward progress */
if (text == chunk_start) return NULL;
chunk_start = text;
}
if (!subpattern_end) {
return NULL;
}
} while (separator_end);
s->text_end = saved_end;
return s->text_end;
}
@@ -1419,11 +1416,6 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
emit_bytes(b, RULE_LITERAL, len, str);
break;
}
case JANET_BUFFER: {
const JanetBuffer *buf = janet_unwrap_buffer(peg);
emit_bytes(b, RULE_LITERAL, buf->count, buf->data);
break;
}
case JANET_TABLE: {
/* Build grammar table */
JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));

View File

@@ -28,7 +28,7 @@
/* Run a string */
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
JanetParser *parser;
JanetParser parser;
int errflags = 0, done = 0;
int32_t index = 0;
Janet ret = janet_wrap_nil();
@@ -37,16 +37,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
if (where) janet_gcroot(janet_wrap_string(where));
if (NULL == sourcePath) sourcePath = "<unknown>";
parser = janet_abstract(&janet_parser_type, sizeof(JanetParser));
janet_parser_init(parser);
janet_gcroot(janet_wrap_abstract(parser));
janet_parser_init(&parser);
/* While we haven't seen an error */
while (!done) {
/* Evaluate parsed values */
while (janet_parser_has_more(parser)) {
Janet form = janet_parser_produce(parser);
while (janet_parser_has_more(&parser)) {
Janet form = janet_parser_produce(&parser);
JanetCompileResult cres = janet_compile(form, env, where);
if (cres.status == JANET_COMPILE_OK) {
JanetFunction *f = janet_thunk(cres.funcdef);
@@ -60,8 +58,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
} else {
ret = janet_wrap_string(cres.error);
int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column;
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
if ((cres.error_mapping.line > 0) &&
(cres.error_mapping.column > 0)) {
line = cres.error_mapping.line;
@@ -83,16 +81,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
if (done) break;
/* Dispatch based on parse state */
switch (janet_parser_status(parser)) {
switch (janet_parser_status(&parser)) {
case JANET_PARSE_DEAD:
done = 1;
break;
case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(parser);
const char *e = janet_parser_error(&parser);
errflags |= 0x04;
ret = janet_cstringv(e);
int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column;
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
done = 1;
break;
@@ -100,9 +98,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
case JANET_PARSE_ROOT:
case JANET_PARSE_PENDING:
if (index >= len) {
janet_parser_eof(parser);
janet_parser_eof(&parser);
} else {
janet_parser_consume(parser, bytes[index++]);
janet_parser_consume(&parser, bytes[index++]);
}
break;
}
@@ -110,7 +108,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
/* Clean up and return errors */
janet_gcunroot(janet_wrap_abstract(parser));
janet_parser_deinit(&parser);
if (where) janet_gcunroot(janet_wrap_string(where));
#ifdef JANET_EV
/* Enter the event loop if we are not already in it */

View File

@@ -87,6 +87,10 @@ struct JanetVM {
/* How many VM stacks have been entered */
int stackn;
/* Debug hook for advanced tracing */
JanetFunction *hook;
JanetFunction *hook_reset; /* In case of error/signal inside a hook */
/* If this flag is true, suspend on function calls and backwards jumps.
* When this occurs, this flag will be reset to 0. */
volatile JanetAtomicInt auto_suspend;
@@ -100,7 +104,6 @@ struct JanetVM {
* return point for panics. */
jmp_buf *signal_buf;
Janet *return_reg;
int coerce_error;
/* The global registry for c functions. Used to store meta-data
* along with otherwise bare c function pointers. */

View File

@@ -301,7 +301,6 @@ int janet_scan_number_base(
if (base == 0) {
base = 10;
}
int exp_base = base;
/* Skip leading zeros */
while (str < end && (*str == '0' || *str == '.')) {
@@ -323,12 +322,6 @@ int janet_scan_number_base(
} else if (*str == '&') {
foundexp = 1;
break;
} else if (base == 16 && (*str == 'P' || *str == 'p')) { /* IEEE hex float */
foundexp = 1;
exp_base = 10;
base = 2;
ex *= 4; /* We need to correct the current exponent after we change the base */
break;
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
foundexp = 1;
break;
@@ -367,9 +360,9 @@ int janet_scan_number_base(
}
while (str < end) {
int digit = digit_lookup[*str & 0x7F];
if (*str > 127 || digit >= exp_base) goto error;
if (*str > 127 || digit >= base) goto error;
if (ee < (INT32_MAX / 40)) {
ee = exp_base * ee + digit;
ee = base * ee + digit;
}
str++;
seenadigit = 1;

View File

@@ -294,16 +294,6 @@ JANET_CORE_FN(cfun_struct_to_table,
return janet_wrap_table(tab);
}
JANET_CORE_FN(cfun_struct_rawget,
"(struct/rawget st key)",
"Gets a value from a struct `st` without looking at the prototype struct. "
"If `st` does not contain the key directly, the function will return "
"nil without checking the prototype. Returns the value in the struct.") {
janet_fixarity(argc, 2);
JanetStruct st = janet_getstruct(argv, 0);
return janet_struct_rawget(st, argv[1]);
}
/* Load the struct module */
void janet_lib_struct(JanetTable *env) {
JanetRegExt struct_cfuns[] = {
@@ -311,7 +301,6 @@ void janet_lib_struct(JanetTable *env) {
JANET_CORE_REG("struct/getproto", cfun_struct_getproto),
JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten),
JANET_CORE_REG("struct/to-table", cfun_struct_to_table),
JANET_CORE_REG("struct/rawget", cfun_struct_rawget),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, struct_cfuns);

View File

@@ -372,14 +372,12 @@ JANET_CORE_FN(cfun_table_setproto,
}
JANET_CORE_FN(cfun_table_tostruct,
"(table/to-struct tab &opt proto)",
"Convert a table to a struct. Returns a new struct.") {
janet_arity(argc, 1, 2);
"(table/to-struct tab)",
"Convert a table to a struct. Returns a new struct. This function "
"does not take into account prototype tables.") {
janet_fixarity(argc, 1);
JanetTable *t = janet_gettable(argv, 0);
JanetStruct proto = janet_optstruct(argv, argc, 1, NULL);
JanetStruct st = janet_table_to_struct(t);
janet_struct_proto(st) = proto;
return janet_wrap_struct(st);
return janet_wrap_struct(janet_table_to_struct(t));
}
JANET_CORE_FN(cfun_table_rawget,

View File

@@ -80,12 +80,22 @@
func = janet_stack_frame(stack)->func; \
} while (0)
#define vm_return(sig, val) do { \
janet_vm.return_reg[0] = (val); \
Janet val2 = (val); \
janet_vm.return_reg[0] = val2; \
vm_commit(); \
if (janet_vm.hook) { \
vm_do_hook_return(val2); \
janet_vm.return_reg[0] = val2; \
} \
return (sig); \
} while (0)
#define vm_return_no_restore(sig, val) do { \
janet_vm.return_reg[0] = (val); \
Janet val2 = (val); \
janet_vm.return_reg[0] = val2; \
if (janet_vm.hook) { \
vm_do_hook_return(val2); \
janet_vm.return_reg[0] = val2; \
} \
return (sig); \
} while (0)
@@ -280,6 +290,36 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
}
static void vm_do_hook(int32_t argc, const Janet *argv) {
JanetFunction *old_hook = janet_vm.hook;
janet_vm.hook = NULL;
janet_call(old_hook, argc, argv);
janet_vm.hook = old_hook;
}
static void vm_do_hook_call(Janet callee, int32_t argc, const Janet *argv) {
Janet argvv[3];
argvv[0] = janet_ckeywordv("call");
argvv[1] = callee;
argvv[2] = janet_wrap_tuple(janet_tuple_n(argv, argc));
vm_do_hook(3, argvv);
}
static void vm_do_hook_tailcall(Janet callee, int32_t argc, const Janet *argv) {
Janet argvv[3];
argvv[0] = janet_ckeywordv("tailcall");
argvv[1] = callee;
argvv[2] = janet_wrap_tuple(janet_tuple_n(argv, argc));
vm_do_hook(3, argvv);
}
static void vm_do_hook_return(Janet result) {
Janet argvv[2];
argvv[0] = janet_ckeywordv("return");
argvv[1] = result;
vm_do_hook(2, argvv);
}
/* Method lookup could potentially handle tables specially... */
static Janet method_to_fun(Janet method, Janet obj) {
return janet_get(obj, method);
@@ -663,6 +703,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
vm_restore();
stack[A] = retval;
if (janet_vm.hook) {
vm_do_hook_return(retval);
}
vm_checkgc_pcnext();
}
@@ -673,6 +716,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
vm_restore();
stack[A] = retval;
if (janet_vm.hook) {
vm_do_hook_return(retval);
}
vm_checkgc_pcnext();
}
@@ -1013,6 +1059,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (fiber->stacktop > fiber->maxstack) {
vm_throw("stack overflow");
}
if (janet_vm.hook) {
vm_commit();
vm_do_hook_call(callee, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
}
if (janet_checktype(callee, JANET_KEYWORD)) {
vm_commit();
callee = resolve_method(callee, fiber);
@@ -1039,10 +1089,16 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
janet_fiber_popframe(fiber);
stack = fiber->data + fiber->frame;
stack[A] = ret;
if (janet_vm.hook) {
vm_do_hook_return(stack[A]);
}
vm_checkgc_pcnext();
} else {
vm_commit();
stack[A] = call_nonfn(fiber, callee);
if (janet_vm.hook) {
vm_do_hook_return(stack[A]);
}
vm_pcnext();
}
}
@@ -1053,6 +1109,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (fiber->stacktop > fiber->maxstack) {
vm_throw("stack overflow");
}
if (janet_vm.hook) {
vm_commit();
vm_do_hook_tailcall(callee, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
}
if (janet_checktype(callee, JANET_KEYWORD)) {
vm_commit();
callee = resolve_method(callee, fiber);
@@ -1089,6 +1149,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
}
vm_restore();
stack[A] = retreg;
if (janet_vm.hook) {
vm_do_hook_return(stack[A]);
}
vm_checkgc_pcnext();
}
}
@@ -1373,10 +1436,7 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
/* Run vm */
janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
int old_coerce_error = janet_vm.coerce_error;
janet_vm.coerce_error = 1;
JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil());
janet_vm.coerce_error = old_coerce_error;
/* Teardown */
janet_vm.stackn = oldn;
@@ -1387,10 +1447,6 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
}
if (signal != JANET_SIGNAL_OK) {
/* Should match logic in janet_signalv */
if (signal != JANET_SIGNAL_ERROR) {
*janet_vm.return_reg = janet_wrap_string(janet_formatc("%v coerced from %s to error", *janet_vm.return_reg, janet_signal_names[signal]));
}
janet_panicv(*janet_vm.return_reg);
}
@@ -1437,10 +1493,8 @@ void janet_try_init(JanetTryState *state) {
state->vm_fiber = janet_vm.fiber;
state->vm_jmp_buf = janet_vm.signal_buf;
state->vm_return_reg = janet_vm.return_reg;
state->coerce_error = janet_vm.coerce_error;
janet_vm.return_reg = &(state->payload);
janet_vm.signal_buf = &(state->buf);
janet_vm.coerce_error = 0;
}
void janet_restore(JanetTryState *state) {
@@ -1449,7 +1503,8 @@ void janet_restore(JanetTryState *state) {
janet_vm.fiber = state->vm_fiber;
janet_vm.signal_buf = state->vm_jmp_buf;
janet_vm.return_reg = state->vm_return_reg;
janet_vm.coerce_error = state->coerce_error;
/* In case of error/signal thrown when inside a temporarily disabled hook */
janet_vm.hook = janet_vm.hook_reset;
}
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
@@ -1641,6 +1696,10 @@ int janet_init(void) {
/* Dynamic bindings */
janet_vm.top_dyns = NULL;
/* Hooks */
janet_vm.hook = NULL;
janet_vm.hook_reset = NULL;
/* Seed RNG */
janet_rng_seed(janet_default_rng(), 0);

View File

@@ -1261,7 +1261,6 @@ typedef struct {
/* new state */
jmp_buf buf;
Janet payload;
int coerce_error;
} JanetTryState;
/***** END SECTION TYPES *****/

View File

@@ -39,7 +39,7 @@
(defmacro assert
[x &opt e]
(def xx (gensym))
(default e (string/format "%j" x))
(default e ~',x)
~(do
(def ,xx ,x)
(,assert-no-tail ,xx ,e)

View File

@@ -896,18 +896,11 @@
(struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2"))
(table/setproto table-to-freeze @{:a @[1 2 3]})
(assert (deep= struct-to-thaw (freeze table-to-freeze)))
(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"}
(freeze table-to-freeze)))
(assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
# Check that freezing mutable keys is deterministic
# for issue #1535
(def hashes @{})
(repeat 200
(def x (freeze {@"" 1 @"" 2 @"" 3 @"" 4 @"" 5}))
(put hashes (hash x) true))
(assert (= 1 (length hashes)) "freeze mutable keys is deterministic")
# Make sure Carriage Returns don't end up in doc strings
# e528b86
(assert (not (string/find "\r"
@@ -1002,18 +995,4 @@
(assert-error "assertf error 3" (assertf false "%s message" "mystery"))
(assert-error "assertf error 4" (assertf nil "%s %s" "alice" "bob"))
# issue #1535
(loop [i :range [1 1000]]
(assert (deep-not= @{:key1 "value1" @"key" "value2"}
@{:key1 "value1" @"key" "value2"}) "deep= mutable keys"))
(assert (deep-not= {"abc" 123} {@"abc" 123}) "deep= mutable keys vs immutable key")
(assert (deep-not= {@"" 1 @"" 2 @"" 3} {@"" 1 @"" 2 @"" 3}) "deep= duplicate mutable keys")
(assert (deep-not= {@"" @"" @"" @"" @"" 3} {@"" @"" @"" @"" @"" 3}) "deep= duplicate mutable keys 2")
(assert (deep-not= {@[] @"" @[] @"" @[] 3} {@[] @"" @[] @"" @[] 3}) "deep= duplicate mutable keys 3")
(assert (deep-not= {@{} @"" @{} @"" @{} 3} {@{} @"" @{} @"" @{} 3}) "deep= duplicate mutable keys 4")
(assert (deep-not= @{:key1 "value1" @"key2" @"value2"}
@{:key1 "value1" @"key2" "value2"}) "deep= mutable keys")
(assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"}
@{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys")
(end-suite)

View File

@@ -174,7 +174,6 @@
(assert (deep= (range 0 17 4) @[0 4 8 12 16]) "(range 0 17 4)")
(assert (deep= (range 16 0 -4) @[16 12 8 4]) "(range 16 0 -4)")
(assert (deep= (range 17 0 -4) @[17 13 9 5 1]) "(range 17 0 -4)")
(assert-error "large range" (range 0xFFFFFFFFFF))
(assert (= (length (range 10)) 10) "(range 10)")
(assert (= (length (range -10)) 0) "(range -10)")

View File

@@ -410,10 +410,6 @@
(ev/call handler connection)
(break))))
# Make sure we can't bind again with no-reuse
(assert-error "no-reuse"
(net/listen test-host test-port :stream true))
# Read from socket
(defn expect-read
@@ -422,15 +418,9 @@
(assert (= result text) (string/format "expected %v, got %v" text result)))
# Now do our telnet chat
(def bob (net/connect test-host test-port :stream))
(def bob (net/connect test-host test-port))
(expect-read bob "Whats your name?\n")
(if (= :mingw (os/which))
(net/write bob "bob")
(do
(def fbob (ev/to-file bob))
(file/write fbob "bob")
(file/flush fbob)
(:close fbob)))
(net/write bob "bob")
(expect-read bob "Welcome bob\n")
(def alice (net/connect test-host test-port))
(expect-read alice "Whats your name?\n")
@@ -475,13 +465,4 @@
# Close chat server
(:close chat-server)
# Issue #1531
(def c (ev/chan 0))
(ev/spawn (while (def x (ev/take c))))
(defn print-to-chan [x] (ev/give c x))
(assert-error "coerce await inside janet_call to error"
(with-dyns [*out* print-to-chan]
(pp :foo)))
(ev/chan-close c)
(end-suite)

View File

@@ -207,7 +207,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
(gccollect)
(assert (= 1 (length t)) "table/weak-value marsh 3")
(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4")
(assert (deep= t tclone) "table/weak-values marsh 4")
# tables with prototypes
(def t (table/weak-values 1))
@@ -219,7 +219,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
(gccollect)
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")
(assert (deep= (freeze t) (freeze tclone)) "marsh weak tables with prototypes 4")
(assert (deep= t tclone) "marsh weak tables with prototypes 4")
(assert (deep= (getproto t) (getproto tclone)) "marsh weak tables with prototypes 5")
(end-suite)

View File

@@ -57,8 +57,6 @@
(for i (+ index 1) (+ index indent 1)
(case (get text i)
nil (break)
(chr "\r") (if-not (= (chr "\n") (get text (inc i)))
(set rewrite false))
(chr "\n") (break)
(chr " ") nil
(set rewrite false))))
@@ -66,17 +64,12 @@
# Only re-indent if no dedented characters.
(def str
(if rewrite
(peg/replace-all ~(* '(* (? "\r") "\n") (between 0 ,indent " "))
(fn [mtch eol] eol) text)
(peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text)
text))
(def first-eol (cond
(string/has-prefix? "\r\n" str) :crlf
(string/has-prefix? "\n" str) :lf))
(def last-eol (cond
(string/has-suffix? "\r\n" str) :crlf
(string/has-suffix? "\n" str) :lf))
(string/slice str (case first-eol :crlf 2 :lf 1 0) (case last-eol :crlf -3 :lf -2)))
(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
@@ -96,10 +89,8 @@
(let [a (reindent text indent)
b (reindent-reference text indent)]
(assert (= a b)
(string/format "reindent: %q, parse: %q (indent-test #%d with indent of %d)" a b indent-counter indent)
)))
(string "indent " indent-counter " (indent=" indent ")"))))
# Unix EOLs
(check-indent "" 0)
(check-indent "\n" 0)
(check-indent "\n" 1)
@@ -115,17 +106,6 @@
(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)
# Windows EOLs
(check-indent "\r\n" 0)
(check-indent "\r\n" 1)
(check-indent "\r\n\r\n" 0)
(check-indent "\r\n\r\n" 1)
(check-indent "\r\nHello, world!" 0)
(check-indent "\r\nHello, world!" 1)
(check-indent "\r\n Hello, world!\r\n " 4)
(check-indent "\r\n Hello, world!\r\n " 4)
(check-indent "\r\n Hello, world!\r\n dedented text\r\n " 4)
(check-indent "\r\n Hello, world!\r\n indented text\r\n " 4)
# Symbols with @ character
# d68eae9
@@ -208,14 +188,5 @@
(parser/consume p `")`)
(assert (= (parser/produce p) ["hello"]))
# Hex floats
(assert (= math/pi +0x1.921fb54442d18p+0001))
(assert (= math/int-max +0x1.ffff_ffff_ffff_ffp+0052))
(assert (= math/int-min -0x1.ffff_ffff_ffff_ffp+0052))
(assert (= 1 0x1P0))
(assert (= 2 0x1P1))
(assert (= -2 -0x1p1))
(assert (= -0.5 -0x1p-1))
(end-suite)

View File

@@ -772,22 +772,5 @@
"5:apple6:banana6:cherry"
@["apple" "banana" "cherry"])
# Issue #1539 - make sure split with "" doesn't infinite loop/oom
(test "issue 1539"
~(split "" (capture (to -1)))
"hello there friends"
nil)
(test "issue 1539 pt. 2"
~(split "," (capture 0))
"abc123,,,,"
@["" "" "" "" ""])
# Issue #1549 - allow buffers as peg literals
(test "issue 1549"
''@"abc123"
"abc123"
@["abc123"])
(end-suite)

View File

@@ -19,11 +19,6 @@
<?define ProgramFilesFolder="ProgramFilesFolder" ?>
<?define Win64="no" ?>
<?define Arch="(x86)" ?>
<?elseif $(sys.BUILDARCH)="arm64" ?>
<?define UpgradeCode="0bd4bab6-c838-4c2a-b9e6-56ea8064863c" ?>
<?define ProgramFilesFolder="ProgramFiles64Folder" ?>
<?define Win64="yes" ?>
<?define Arch="(Arm)" ?>
<?else ?>
<?error Unsupported value of sys.BUILDARCH=$(sys.BUILDARCH)?>
<?endif?>