mirror of
https://github.com/janet-lang/janet
synced 2025-10-28 14:17:42 +00:00
Compare commits
38 Commits
v1.29.1
...
op_subtrac
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
3b6371e03d | ||
|
|
b5d3c87253 | ||
|
|
f73b8c550a | ||
|
|
5437744126 | ||
|
|
5a5e70b001 | ||
|
|
348a5bc0a9 | ||
|
|
026c64fa01 | ||
|
|
e38663c457 | ||
|
|
117c741c29 | ||
|
|
9bc5bec9f1 | ||
|
|
a5f4e4d328 | ||
|
|
db0abfde72 | ||
|
|
edf263bcb5 | ||
|
|
60fba585e3 | ||
|
|
ebb6fe5be3 | ||
|
|
d91c95bf92 | ||
|
|
2007438424 | ||
|
|
81423635ad | ||
|
|
58d297364a | ||
|
|
db902c90c4 | ||
|
|
42ccd0f790 | ||
|
|
20ec6f574e | ||
|
|
b3db367ae7 | ||
|
|
8a62c742e6 | ||
|
|
b125cbeac9 | ||
|
|
3f7a2c2197 | ||
|
|
f6248369fe | ||
|
|
c83f3ec097 | ||
|
|
0cd00da354 | ||
|
|
4b7b285aa9 | ||
|
|
d63379e777 | ||
|
|
b219b146fa | ||
|
|
ff90b81ec3 | ||
|
|
9120eaef79 | ||
|
|
1ccd879916 | ||
|
|
f977ace7f8 | ||
|
|
c3f4dc0c15 | ||
|
|
78eed9b11c |
15
.github/workflows/test.yml
vendored
15
.github/workflows/test.yml
vendored
@@ -74,3 +74,18 @@ jobs:
|
||||
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
|
||||
- name: Test the project
|
||||
run: make test UNAME=MINGW RUN=wine
|
||||
|
||||
test-arm-linux:
|
||||
name: Build and test ARM32 cross compilation
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Setup qemu and cross compiler
|
||||
run: |
|
||||
sudo apt-get update
|
||||
sudo apt-get install gcc-arm-linux-gnueabi qemu-user
|
||||
- name: Compile the project
|
||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
|
||||
- name: Test the project
|
||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test
|
||||
|
||||
@@ -1,6 +1,15 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
|
||||
- Fix bug with marshalling channels
|
||||
- Add `div` for floored division
|
||||
- Make `div` and `mod` variadic
|
||||
- Support `bnot` for integer types.
|
||||
- Define `(mod x 0)` as `x`
|
||||
- Add `ffi/pointer-cfunction` to convert pointers to cfunctions
|
||||
|
||||
## 1.29.1 - 2023-06-19
|
||||
- Add support for passing booleans to PEGs for "always" and "never" matching.
|
||||
- Allow dictionary types for `take` and `drop`
|
||||
|
||||
4
Makefile
4
Makefile
@@ -308,7 +308,7 @@ build/janet.pc: $(JANET_TARGET)
|
||||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
strip '$(DESTDIR)$(BINDIR)/janet'
|
||||
strip -x -S '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||
@@ -357,7 +357,7 @@ uninstall:
|
||||
#################
|
||||
|
||||
format:
|
||||
tools/format.sh
|
||||
sh tools/format.sh
|
||||
|
||||
grammar: build/janet.tmLanguage
|
||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
|
||||
@@ -151,7 +151,7 @@
|
||||
(defmacro -= "Decrements the var x by n." [x & ns] ~(set ,x (,- ,x ,;ns)))
|
||||
(defmacro *= "Shorthand for (set x (\\* x n))." [x & ns] ~(set ,x (,* ,x ,;ns)))
|
||||
(defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
|
||||
(defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n)))
|
||||
(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
|
||||
|
||||
(defmacro assert
|
||||
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
|
||||
@@ -3520,6 +3520,24 @@
|
||||
(when-let [constants (dasm :constants)]
|
||||
(eprintf " constants: %.4q" constants))
|
||||
(eprintf " slots: %.4q\n" (frame :slots))
|
||||
(when-let [src-path (in dasm :source)]
|
||||
(when (and (fexists src-path)
|
||||
sourcemap)
|
||||
(defn dump
|
||||
[src cur]
|
||||
(def offset 5)
|
||||
(def beg (max 1 (- cur offset)))
|
||||
(def lines (array/concat @[""] (string/split "\n" src)))
|
||||
(def end (min (+ cur offset) (length lines)))
|
||||
(def digits (inc (math/floor (math/log10 end))))
|
||||
(def fmt-str (string "%" digits "d: %s"))
|
||||
(for i beg end
|
||||
(eprin " ") # breakpoint someday?
|
||||
(eprin (if (= i cur) "> " " "))
|
||||
(eprintf fmt-str i (get lines i))))
|
||||
(let [[sl _] (sourcemap pc)]
|
||||
(dump (slurp src-path) sl)
|
||||
(eprint))))
|
||||
(def padding (string/repeat " " 20))
|
||||
(loop [i :range [0 (length bytecode)]
|
||||
:let [instr (bytecode i)]]
|
||||
|
||||
@@ -75,6 +75,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"cmp", JOP_COMPARE},
|
||||
{"cncl", JOP_CANCEL},
|
||||
{"div", JOP_DIVIDE},
|
||||
{"divf", JOP_DIVIDE_FLOOR},
|
||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||
{"eq", JOP_EQUALS},
|
||||
{"eqim", JOP_EQUALS_IMMEDIATE},
|
||||
@@ -137,6 +138,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"sru", JOP_SHIFT_RIGHT_UNSIGNED},
|
||||
{"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
|
||||
{"sub", JOP_SUBTRACT},
|
||||
{"subim", JOP_SUBTRACT_IMMEDIATE},
|
||||
{"tcall", JOP_TAILCALL},
|
||||
{"tchck", JOP_TYPECHECK}
|
||||
};
|
||||
|
||||
@@ -37,11 +37,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_0, /* JOP_RETURN_NIL, */
|
||||
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_ADD, */
|
||||
JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_SUBTRACT, */
|
||||
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_MULTIPLY, */
|
||||
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_DIVIDE, */
|
||||
JINT_SSS, /* JOP_DIVIDE_FLOOR */
|
||||
JINT_SSS, /* JOP_MODULO, */
|
||||
JINT_SSS, /* JOP_REMAINDER, */
|
||||
JINT_SSS, /* JOP_BAND, */
|
||||
@@ -250,6 +252,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
||||
case JOP_SIGNAL:
|
||||
/* Write A, Read B */
|
||||
case JOP_ADD_IMMEDIATE:
|
||||
case JOP_SUBTRACT_IMMEDIATE:
|
||||
case JOP_MULTIPLY_IMMEDIATE:
|
||||
case JOP_DIVIDE_IMMEDIATE:
|
||||
case JOP_SHIFT_LEFT_IMMEDIATE:
|
||||
@@ -301,6 +304,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
||||
case JOP_SUBTRACT:
|
||||
case JOP_MULTIPLY:
|
||||
case JOP_DIVIDE:
|
||||
case JOP_DIVIDE_FLOOR:
|
||||
case JOP_MODULO:
|
||||
case JOP_REMAINDER:
|
||||
case JOP_SHIFT_LEFT:
|
||||
|
||||
@@ -216,12 +216,32 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||
}
|
||||
|
||||
const char *janet_getcbytes(const Janet *argv, int32_t n) {
|
||||
/* Ensure buffer 0-padded */
|
||||
if (janet_checktype(argv[n], JANET_BUFFER)) {
|
||||
JanetBuffer *b = janet_unwrap_buffer(argv[n]);
|
||||
if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) {
|
||||
/* Make a copy with janet_smalloc in the rare case we have a buffer that
|
||||
* cannot be realloced and pushing a 0 byte would panic. */
|
||||
char *new_string = janet_smalloc(b->count + 1);
|
||||
memcpy(new_string, b->data, b->count);
|
||||
new_string[b->count] = 0;
|
||||
if (strlen(new_string) != (size_t) b->count) goto badzeros;
|
||||
return new_string;
|
||||
} else {
|
||||
/* Ensure trailing 0 */
|
||||
janet_buffer_push_u8(b, 0);
|
||||
b->count--;
|
||||
if (strlen((char *)b->data) != (size_t) b->count) goto badzeros;
|
||||
return (const char *) b->data;
|
||||
}
|
||||
}
|
||||
JanetByteView view = janet_getbytes(argv, n);
|
||||
const char *cstr = (const char *)view.bytes;
|
||||
if (strlen(cstr) != (size_t) view.len) {
|
||||
janet_panic("bytes contain embedded 0s");
|
||||
}
|
||||
if (strlen(cstr) != (size_t) view.len) goto badzeros;
|
||||
return cstr;
|
||||
|
||||
badzeros:
|
||||
janet_panic("bytes contain embedded 0s");
|
||||
}
|
||||
|
||||
const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
|
||||
@@ -273,6 +293,14 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkuint(x)) {
|
||||
janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
|
||||
}
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||
#ifdef JANET_INT_TYPES
|
||||
return janet_unwrap_s64(argv[n]);
|
||||
@@ -290,7 +318,7 @@ uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
|
||||
return janet_unwrap_u64(argv[n]);
|
||||
#else
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint64(x)) {
|
||||
if (!janet_checkuint64(x)) {
|
||||
janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
|
||||
}
|
||||
return (uint64_t) janet_unwrap_number(x);
|
||||
|
||||
@@ -116,7 +116,8 @@ static JanetSlot opreduce(
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
int opim,
|
||||
Janet nullary) {
|
||||
Janet nullary,
|
||||
Janet unary) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
int8_t imm = 0;
|
||||
@@ -132,7 +133,7 @@ static JanetSlot opreduce(
|
||||
if (op == JOP_SUBTRACT) {
|
||||
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
@@ -155,7 +156,7 @@ static JanetSlot opreduce(
|
||||
/* Function optimizers */
|
||||
|
||||
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||
@@ -172,7 +173,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
||||
return t;
|
||||
}
|
||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
if (janet_v_count(args) == 3) {
|
||||
@@ -192,20 +193,14 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
c->buffer[label] |= (current - label) << 16;
|
||||
return t;
|
||||
} else {
|
||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
}
|
||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
if (opts.flags & JANET_FOPTS_DROP) {
|
||||
@@ -262,34 +257,43 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
/* Variadic operators specialization */
|
||||
|
||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_SUBTRACT, JOP_SUBTRACT_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
|
||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1));
|
||||
}
|
||||
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
||||
return genericSS(opts, JOP_BNOT, args[0]);
|
||||
@@ -383,10 +387,11 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{fixarity2, do_propagate},
|
||||
{arity2or3, do_get},
|
||||
{arity1or2, do_next},
|
||||
{fixarity2, do_modulo},
|
||||
{fixarity2, do_remainder},
|
||||
{NULL, do_modulo},
|
||||
{NULL, do_remainder},
|
||||
{fixarity2, do_cmp},
|
||||
{fixarity2, do_cancel},
|
||||
{NULL, do_divf}
|
||||
};
|
||||
|
||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||
|
||||
@@ -69,6 +69,7 @@ typedef enum {
|
||||
#define JANET_FUN_REMAINDER 30
|
||||
#define JANET_FUN_CMP 31
|
||||
#define JANET_FUN_CANCEL 32
|
||||
#define JANET_FUN_DIVIDE_FLOOR 33
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct JanetCompiler JanetCompiler;
|
||||
|
||||
@@ -985,14 +985,6 @@ static const uint32_t next_asm[] = {
|
||||
JOP_NEXT | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t modulo_asm[] = {
|
||||
JOP_MODULO | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t remainder_asm[] = {
|
||||
JOP_REMAINDER | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t cmp_asm[] = {
|
||||
JOP_COMPARE | (1 << 24),
|
||||
JOP_RETURN
|
||||
@@ -1077,14 +1069,6 @@ static void janet_load_libs(JanetTable *env) {
|
||||
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||
janet_quick_asm(env, JANET_FUN_MODULO,
|
||||
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
|
||||
JDOC("(mod dividend divisor)\n\n"
|
||||
"Returns the modulo of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_REMAINDER,
|
||||
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_CMP,
|
||||
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
|
||||
JDOC("(cmp x y)\n\n"
|
||||
@@ -1183,6 +1167,18 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"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."));
|
||||
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`."));
|
||||
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."));
|
||||
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."));
|
||||
|
||||
@@ -401,11 +401,11 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
}
|
||||
janet_marshal_abstract(ctx, p);
|
||||
janet_marshal_int(ctx, (int32_t) s->flags);
|
||||
janet_marshal_int64(ctx, (intptr_t) s->methods);
|
||||
janet_marshal_ptr(ctx, 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
|
||||
* for network sockets, and in general for winsock it is better to not duplicate
|
||||
* unless there is a need to. */
|
||||
HANDLE duph = INVALID_HANDLE_VALUE;
|
||||
if (s->flags & JANET_STREAM_SOCKET) {
|
||||
@@ -438,7 +438,7 @@ static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
|
||||
p->_mask = 0;
|
||||
p->state = NULL;
|
||||
p->flags = (uint32_t) janet_unmarshal_int(ctx);
|
||||
p->methods = (void *) janet_unmarshal_int64(ctx);
|
||||
p->methods = janet_unmarshal_ptr(ctx);
|
||||
#ifdef JANET_WINDOWS
|
||||
p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
|
||||
#else
|
||||
@@ -1224,6 +1224,7 @@ static Janet janet_chanat_next(void *p, Janet key) {
|
||||
|
||||
static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetChannel *channel = (JanetChannel *)p;
|
||||
janet_marshal_abstract(ctx, channel);
|
||||
janet_marshal_byte(ctx, channel->closed);
|
||||
janet_marshal_int(ctx, channel->limit);
|
||||
int32_t count = janet_q_count(&channel->items);
|
||||
|
||||
@@ -1530,6 +1530,22 @@ JANET_CORE_FN(cfun_ffi_pointer_buffer,
|
||||
return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_pointer_cfunction,
|
||||
"(ffi/pointer-cfunction pointer &opt name source-file source-line)",
|
||||
"Create a C Function from a raw pointer. Optionally give the cfunction a name and "
|
||||
"source location for stack traces and debugging.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_arity(argc, 1, 4);
|
||||
void *pointer = janet_getpointer(argv, 0);
|
||||
const char *name = janet_optcstring(argv, argc, 1, NULL);
|
||||
const char *source = janet_optcstring(argv, argc, 2, NULL);
|
||||
int32_t line = janet_optinteger(argv, argc, 3, -1);
|
||||
if ((name != NULL) || (source != NULL) || (line != -1)) {
|
||||
janet_registry_put((JanetCFunction) pointer, name, NULL, source, line);
|
||||
}
|
||||
return janet_wrap_cfunction((JanetCFunction) pointer);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
|
||||
"(ffi/calling-conventions)",
|
||||
"Get an array of all supported calling conventions on the current arhcitecture. Some architectures may have some FFI "
|
||||
@@ -1567,6 +1583,7 @@ void janet_lib_ffi(JanetTable *env) {
|
||||
JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
|
||||
JANET_CORE_REG("ffi/free", cfun_ffi_free),
|
||||
JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
|
||||
JANET_CORE_REG("ffi/pointer-cfunction", cfun_ffi_pointer_cfunction),
|
||||
JANET_CORE_REG("ffi/calling-conventions", cfun_ffi_supported_calling_conventions),
|
||||
JANET_REG_END
|
||||
};
|
||||
|
||||
@@ -431,7 +431,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define OPMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
@@ -440,6 +440,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define UNARYMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = oper(janet_unwrap_##type(argv[0])); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define DIVZERO(name) DIVZERO_##name
|
||||
#define DIVZERO_div janet_panic("division by zero")
|
||||
#define DIVZERO_rem janet_panic("division by zero")
|
||||
#define DIVZERO_mod return janet_wrap_abstract(box)
|
||||
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
@@ -447,19 +460,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
@@ -471,7 +484,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
@@ -479,26 +492,50 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
if (op2 == 0) janet_panic("division by zero");
|
||||
int64_t x = op1 / op2;
|
||||
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op1 = janet_unwrap_s64(argv[1]);
|
||||
if (op2 == 0) janet_panic("division by zero");
|
||||
int64_t x = op1 / op2;
|
||||
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
*box = (op1 > 0)
|
||||
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||
if (op2 == 0) {
|
||||
*box = op1;
|
||||
} else {
|
||||
int64_t x = op1 % op2;
|
||||
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
@@ -507,37 +544,43 @@ static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op1 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
*box = (op1 > 0)
|
||||
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||
if (op2 == 0) {
|
||||
*box = op1;
|
||||
} else {
|
||||
int64_t x = op1 % op2;
|
||||
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
OPMETHOD(int64_t, s64, add, +)
|
||||
OPMETHOD(int64_t, s64, sub, -)
|
||||
OPMETHODINVERT(int64_t, s64, subi, -)
|
||||
OPMETHODINVERT(int64_t, s64, sub, -)
|
||||
OPMETHOD(int64_t, s64, mul, *)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
UNARYMETHOD(int64_t, s64, not, ~)
|
||||
OPMETHOD(int64_t, s64, lshift, <<)
|
||||
OPMETHOD(int64_t, s64, rshift, >>)
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
OPMETHODINVERT(uint64_t, u64, sub, -)
|
||||
OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, rem, %)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, modi, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, div, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, rem, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, mod, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
UNARYMETHOD(uint64_t, u64, not, ~)
|
||||
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
|
||||
@@ -555,6 +598,8 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"r*", cfun_it_s64_mul},
|
||||
{"/", cfun_it_s64_div},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"div", cfun_it_s64_divf},
|
||||
{"rdiv", cfun_it_s64_divfi},
|
||||
{"mod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"%", cfun_it_s64_rem},
|
||||
@@ -565,6 +610,7 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"r|", cfun_it_s64_or},
|
||||
{"^", cfun_it_s64_xor},
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"~", cfun_it_s64_not},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
{"compare", cfun_it_s64_compare},
|
||||
@@ -580,16 +626,19 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"r*", cfun_it_u64_mul},
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"div", cfun_it_u64_div},
|
||||
{"rdiv", cfun_it_u64_divi},
|
||||
{"mod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_rem},
|
||||
{"r%", cfun_it_u64_remi},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
{"r|", cfun_it_u64_or},
|
||||
{"^", cfun_it_u64_xor},
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"~", cfun_it_u64_not},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
{"compare", cfun_it_u64_compare},
|
||||
|
||||
100
src/core/marsh.c
100
src/core/marsh.c
@@ -154,7 +154,7 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
|
||||
janet_buffer_push_bytes(st->buf, bytes, len);
|
||||
}
|
||||
|
||||
static void pushpointer(MarshalState *st, void *ptr) {
|
||||
static void pushpointer(MarshalState *st, const void *ptr) {
|
||||
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
|
||||
}
|
||||
|
||||
@@ -246,6 +246,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
}
|
||||
/* Add to lookup */
|
||||
janet_v_push(st->seen_defs, def);
|
||||
|
||||
pushint(st, def->flags);
|
||||
pushint(st, def->slotcount);
|
||||
pushint(st, def->arity);
|
||||
@@ -266,14 +267,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
|
||||
/* marshal constants */
|
||||
for (int32_t i = 0; i < def->constants_length; i++)
|
||||
marshal_one(st, def->constants[i], flags);
|
||||
marshal_one(st, def->constants[i], flags + 1);
|
||||
|
||||
/* Marshal symbol map, if needed */
|
||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
||||
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].death_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].slot_index);
|
||||
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
|
||||
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags + 1);
|
||||
}
|
||||
|
||||
/* marshal the bytecode */
|
||||
@@ -362,6 +363,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
|
||||
pushint(st, value);
|
||||
}
|
||||
|
||||
/* Only use in unsafe - don't marshal pointers otherwise */
|
||||
void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
|
||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panic("can only marshal pointers in unsafe mode");
|
||||
}
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushpointer(st, ptr);
|
||||
}
|
||||
|
||||
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushbyte(st, value);
|
||||
@@ -378,18 +388,27 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
|
||||
marshal_one(st, x, ctx->flags + 1);
|
||||
}
|
||||
|
||||
#ifdef JANET_MARSHAL_DEBUG
|
||||
#define MARK_SEEN() \
|
||||
do { if (st->maybe_cycles) { \
|
||||
Janet _check = janet_table_get(&st->seen, x); \
|
||||
if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \
|
||||
janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \
|
||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
|
||||
} } while (0)
|
||||
#else
|
||||
#define MARK_SEEN() \
|
||||
do { if (st->maybe_cycles) { \
|
||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
|
||||
} } while (0)
|
||||
#endif
|
||||
|
||||
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
if (st->maybe_cycles) {
|
||||
janet_table_put(&st->seen,
|
||||
janet_wrap_abstract(abstract),
|
||||
janet_wrap_integer(st->nextid++));
|
||||
}
|
||||
Janet x = janet_wrap_abstract(abstract);
|
||||
MARK_SEEN();
|
||||
}
|
||||
|
||||
#define MARK_SEEN() \
|
||||
do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
|
||||
|
||||
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
#ifdef JANET_EV
|
||||
@@ -411,7 +430,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
if (at->marshal) {
|
||||
pushbyte(st, LB_ABSTRACT);
|
||||
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
||||
JanetMarshalContext context = {st, NULL, flags, NULL, at};
|
||||
JanetMarshalContext context = {st, NULL, flags + 1, NULL, at};
|
||||
at->marshal(abstract, &context);
|
||||
} else {
|
||||
janet_panicf("cannot marshal %p", x);
|
||||
@@ -728,9 +747,22 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
#ifdef JANET_MARSHAL_DEBUG
|
||||
static void dump_reference_table(UnmarshalState *st) {
|
||||
for (int32_t i = 0; i < janet_v_count(st->lookup); i++) {
|
||||
janet_eprintf(" reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Assert a janet type */
|
||||
static void janet_asserttype(Janet x, JanetType t) {
|
||||
static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) {
|
||||
if (!janet_checktype(x, t)) {
|
||||
#ifdef JANET_MARSHAL_DEBUG
|
||||
dump_reference_table(st);
|
||||
#else
|
||||
(void) st;
|
||||
#endif
|
||||
janet_panicf("expected type %T, got %v", 1 << t, x);
|
||||
}
|
||||
}
|
||||
@@ -782,7 +814,7 @@ static const uint8_t *unmarshal_one_env(
|
||||
Janet fiberv;
|
||||
/* On stack variant */
|
||||
data = unmarshal_one(st, data, &fiberv, flags);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
janet_asserttype(fiberv, JANET_FIBER, st);
|
||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||
/* Negative offset indicates untrusted input */
|
||||
env->offset = -offset;
|
||||
@@ -880,13 +912,13 @@ static const uint8_t *unmarshal_one_def(
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||
Janet x;
|
||||
data = unmarshal_one(st, data, &x, flags + 1);
|
||||
janet_asserttype(x, JANET_STRING);
|
||||
janet_asserttype(x, JANET_STRING, st);
|
||||
def->name = janet_unwrap_string(x);
|
||||
}
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
|
||||
Janet x;
|
||||
data = unmarshal_one(st, data, &x, flags + 1);
|
||||
janet_asserttype(x, JANET_STRING);
|
||||
janet_asserttype(x, JANET_STRING, st);
|
||||
def->source = janet_unwrap_string(x);
|
||||
}
|
||||
|
||||
@@ -916,8 +948,9 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
|
||||
Janet value;
|
||||
data = unmarshal_one(st, data, &value, flags + 1);
|
||||
if (!janet_checktype(value, JANET_SYMBOL))
|
||||
janet_panic("expected symbol in symbol map");
|
||||
if (!janet_checktype(value, JANET_SYMBOL)) {
|
||||
janet_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value);
|
||||
}
|
||||
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
|
||||
}
|
||||
def->symbolmap_length = (uint32_t) symbolmap_length;
|
||||
@@ -1066,7 +1099,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
/* Get function */
|
||||
Janet funcv;
|
||||
data = unmarshal_one(st, data, &funcv, flags + 1);
|
||||
janet_asserttype(funcv, JANET_FUNCTION);
|
||||
janet_asserttype(funcv, JANET_FUNCTION, st);
|
||||
func = janet_unwrap_function(funcv);
|
||||
def = func->def;
|
||||
|
||||
@@ -1112,7 +1145,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
Janet envv;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
janet_asserttype(envv, JANET_TABLE, st);
|
||||
fiber_env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
@@ -1121,7 +1154,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
Janet fiberv;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
data = unmarshal_one(st, data, &fiberv, flags + 1);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
janet_asserttype(fiberv, JANET_FIBER, st);
|
||||
fiber->child = janet_unwrap_fiber(fiberv);
|
||||
}
|
||||
|
||||
@@ -1165,6 +1198,18 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
|
||||
return read64(st, &(ctx->data));
|
||||
}
|
||||
|
||||
void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
|
||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panic("can only unmarshal pointers in unsafe mode");
|
||||
}
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
void *ptr;
|
||||
MARSH_EOS(st, ctx->data + sizeof(void *) - 1);
|
||||
memcpy((char *) &ptr, ctx->data, sizeof(void *));
|
||||
ctx->data += sizeof(void *);
|
||||
return ptr;
|
||||
}
|
||||
|
||||
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
MARSH_EOS(st, ctx->data);
|
||||
@@ -1207,7 +1252,9 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
if (at == NULL) janet_panic("unknown abstract type");
|
||||
if (at->unmarshal) {
|
||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||
void *abst = at->unmarshal(&context);
|
||||
janet_assert(abst != NULL, "null pointer abstract");
|
||||
*out = janet_wrap_abstract(abst);
|
||||
if (context.at != NULL) {
|
||||
janet_panic("janet_unmarshal_abstract not called");
|
||||
}
|
||||
@@ -1308,7 +1355,7 @@ static const uint8_t *unmarshal_one(
|
||||
}
|
||||
case LB_FIBER: {
|
||||
JanetFiber *fiber;
|
||||
data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
|
||||
data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1);
|
||||
*out = janet_wrap_fiber(fiber);
|
||||
return data;
|
||||
}
|
||||
@@ -1323,6 +1370,9 @@ static const uint8_t *unmarshal_one(
|
||||
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
|
||||
len * sizeof(JanetFuncEnv));
|
||||
func->def = NULL;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
func->envs[i] = NULL;
|
||||
}
|
||||
*out = janet_wrap_function(func);
|
||||
janet_v_push(st->lookup, *out);
|
||||
data = unmarshal_one_def(st, data, &def, flags + 1);
|
||||
@@ -1376,7 +1426,7 @@ static const uint8_t *unmarshal_one(
|
||||
if (lead == LB_STRUCT_PROTO) {
|
||||
Janet proto;
|
||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||
janet_asserttype(proto, JANET_STRUCT);
|
||||
janet_asserttype(proto, JANET_STRUCT, st);
|
||||
janet_struct_proto(struct_) = janet_unwrap_struct(proto);
|
||||
}
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
@@ -1399,7 +1449,7 @@ static const uint8_t *unmarshal_one(
|
||||
if (lead == LB_TABLE_PROTO) {
|
||||
Janet proto;
|
||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||
janet_asserttype(proto, JANET_TABLE);
|
||||
janet_asserttype(proto, JANET_TABLE, st);
|
||||
t->proto = janet_unwrap_table(proto);
|
||||
}
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
|
||||
@@ -1145,14 +1145,16 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
posix_spawn_file_actions_addclose(&actions, pipe_in);
|
||||
} else if (new_in != JANET_HANDLE_NONE && new_in != 0) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_in, 0);
|
||||
posix_spawn_file_actions_addclose(&actions, new_in);
|
||||
if (new_in != new_out && new_in != new_err)
|
||||
posix_spawn_file_actions_addclose(&actions, new_in);
|
||||
}
|
||||
if (pipe_out != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
|
||||
posix_spawn_file_actions_addclose(&actions, pipe_out);
|
||||
} else if (new_out != JANET_HANDLE_NONE && new_out != 1) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_out, 1);
|
||||
posix_spawn_file_actions_addclose(&actions, new_out);
|
||||
if (new_out != new_err)
|
||||
posix_spawn_file_actions_addclose(&actions, new_out);
|
||||
}
|
||||
if (pipe_err != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
|
||||
|
||||
@@ -259,6 +259,14 @@ static int checkescape(uint8_t c) {
|
||||
return '\f';
|
||||
case 'v':
|
||||
return '\v';
|
||||
case 'a':
|
||||
return '\a';
|
||||
case 'b':
|
||||
return '\b';
|
||||
case '\'':
|
||||
return '\'';
|
||||
case '?':
|
||||
return '?';
|
||||
case 'e':
|
||||
return 27;
|
||||
case '"':
|
||||
|
||||
@@ -152,6 +152,12 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
||||
case '\v':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
|
||||
break;
|
||||
case '\a':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
|
||||
break;
|
||||
case '\b':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
|
||||
break;
|
||||
case 27:
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
|
||||
break;
|
||||
@@ -244,6 +250,10 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
case JANET_FUNCTION: {
|
||||
JanetFunction *fun = janet_unwrap_function(x);
|
||||
JanetFuncDef *def = fun->def;
|
||||
if (def == NULL) {
|
||||
janet_buffer_push_cstring(buffer, "<incomplete function>");
|
||||
break;
|
||||
}
|
||||
if (def->name) {
|
||||
const uint8_t *n = def->name;
|
||||
janet_buffer_push_cstring(buffer, "<function ");
|
||||
|
||||
@@ -357,7 +357,8 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
|
||||
|
||||
if (has_drop && can_destructure_lhs && rhs_is_indexed) {
|
||||
/* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */
|
||||
JanetView view_lhs, view_rhs;
|
||||
JanetView view_lhs = {0};
|
||||
JanetView view_rhs = {0};
|
||||
janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
|
||||
janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
|
||||
int found_amp = 0;
|
||||
|
||||
@@ -805,6 +805,13 @@ int janet_checkint(Janet x) {
|
||||
return janet_checkintrange(dval);
|
||||
}
|
||||
|
||||
int janet_checkuint(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return janet_checkuintrange(dval);
|
||||
}
|
||||
|
||||
int janet_checkint64(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
@@ -816,7 +823,7 @@ int janet_checkuint64(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
|
||||
return janet_checkuint64range(dval);
|
||||
}
|
||||
|
||||
int janet_checksize(Janet x) {
|
||||
|
||||
@@ -698,11 +698,16 @@ Janet janet_lengthv(Janet x) {
|
||||
const JanetAbstractType *type = janet_abstract_type(abst);
|
||||
if (type->length != NULL) {
|
||||
size_t len = type->length(abst, janet_abstract_size(abst));
|
||||
if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) {
|
||||
/* If len is always less then double, we can never overflow */
|
||||
#ifdef JANET_32
|
||||
return janet_wrap_number(len);
|
||||
#else
|
||||
if (len < (size_t) JANET_INTMAX_INT64) {
|
||||
return janet_wrap_number((double) len);
|
||||
} else {
|
||||
janet_panicf("integer length %u too large", len);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
Janet argv[1] = { x };
|
||||
return janet_mcall("length", 1, argv);
|
||||
|
||||
@@ -138,7 +138,7 @@
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define _vm_bitop_immediate(op, type1)\
|
||||
#define _vm_bitop_immediate(op, type1, rangecheck, msg)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
@@ -147,13 +147,15 @@
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
double y1 = janet_unwrap_number(op1);\
|
||||
if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
|
||||
type1 x1 = (type1) y1;\
|
||||
stack[A] = janet_wrap_number((type1) (x1 op CS));\
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t, janet_checkintrange, "32-bit signed integers");
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers");
|
||||
#define _vm_binop(op, wrap)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
@@ -170,14 +172,18 @@
|
||||
}\
|
||||
}
|
||||
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
||||
#define _vm_bitop(op, type1)\
|
||||
#define _vm_bitop(op, type1, rangecheck, msg)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
double y1 = janet_unwrap_number(op1);\
|
||||
double y2 = janet_unwrap_number(op2);\
|
||||
if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
|
||||
if (!janet_checkintrange(y2)) { vm_commit(); janet_panicf("rhs must be valid 32-bit signed integer, got %f", op2); }\
|
||||
type1 x1 = (type1) y1;\
|
||||
int32_t x2 = (int32_t) y2;\
|
||||
stack[A] = janet_wrap_number((type1) (x1 op x2));\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
@@ -185,8 +191,8 @@
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t, janet_checkintrange, "32-bit signed integers")
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers")
|
||||
#define vm_compop(op) \
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
@@ -295,6 +301,16 @@ static Janet janet_method_lookup(Janet x, const char *name) {
|
||||
return method_to_fun(janet_ckeywordv(name), x);
|
||||
}
|
||||
|
||||
static Janet janet_unary_call(const char *method, Janet arg) {
|
||||
Janet m = janet_method_lookup(arg, method);
|
||||
if (janet_checktype(m, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v", method, arg);
|
||||
} else {
|
||||
Janet argv[1] = { arg };
|
||||
return janet_method_invoke(m, 1, argv);
|
||||
}
|
||||
}
|
||||
|
||||
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
|
||||
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
|
||||
Janet lm = janet_method_lookup(lhs, lmethod);
|
||||
@@ -331,11 +347,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_JOP_RETURN_NIL,
|
||||
&&label_JOP_ADD_IMMEDIATE,
|
||||
&&label_JOP_ADD,
|
||||
&&label_JOP_SUBTRACT_IMMEDIATE,
|
||||
&&label_JOP_SUBTRACT,
|
||||
&&label_JOP_MULTIPLY_IMMEDIATE,
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_DIVIDE_FLOOR,
|
||||
&&label_JOP_MODULO,
|
||||
&&label_JOP_REMAINDER,
|
||||
&&label_JOP_BAND,
|
||||
@@ -576,8 +594,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#endif
|
||||
@@ -667,6 +683,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
VM_OP(JOP_ADD)
|
||||
vm_binop(+);
|
||||
|
||||
VM_OP(JOP_SUBTRACT_IMMEDIATE)
|
||||
vm_binop_immediate(-);
|
||||
|
||||
VM_OP(JOP_SUBTRACT)
|
||||
vm_binop(-);
|
||||
|
||||
@@ -682,14 +701,33 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
VM_OP(JOP_DIVIDE)
|
||||
vm_binop( /);
|
||||
|
||||
VM_OP(JOP_DIVIDE_FLOOR) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
stack[A] = janet_wrap_number(floor(x1 / x2));
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_binop_call("div", "rdiv", op1, op2);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_MODULO) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
double intres = x2 * floor(x1 / x2);
|
||||
stack[A] = janet_wrap_number(x1 - intres);
|
||||
if (x2 == 0) {
|
||||
stack[A] = janet_wrap_number(x1);
|
||||
} else {
|
||||
double intres = x2 * floor(x1 / x2);
|
||||
stack[A] = janet_wrap_number(x1 - intres);
|
||||
}
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
@@ -724,9 +762,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
VM_OP(JOP_BNOT) {
|
||||
Janet op = stack[E];
|
||||
vm_assert_type(op, JANET_NUMBER);
|
||||
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
||||
vm_pcnext();
|
||||
if (janet_checktype(op, JANET_NUMBER)) {
|
||||
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_unary_call("~", op);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
|
||||
@@ -980,7 +1023,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
|
||||
}
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
vm_commit();
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
janet_panicf("%v called with %d argument%s, expected %d",
|
||||
|
||||
@@ -868,12 +868,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#endif
|
||||
|
||||
JANET_API int janet_checkint(Janet x);
|
||||
JANET_API int janet_checkuint(Janet x);
|
||||
JANET_API int janet_checkint64(Janet x);
|
||||
JANET_API int janet_checkuint64(Janet x);
|
||||
JANET_API int janet_checksize(Janet x);
|
||||
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
||||
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
|
||||
#define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x))
|
||||
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
|
||||
#define janet_checkuint64range(x) ((x) >= 0 && (x) <= JANET_INTMAX_DOUBLE && (x) == (uint64_t)(x))
|
||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
||||
|
||||
@@ -1259,11 +1262,13 @@ enum JanetOpCode {
|
||||
JOP_RETURN_NIL,
|
||||
JOP_ADD_IMMEDIATE,
|
||||
JOP_ADD,
|
||||
JOP_SUBTRACT_IMMEDIATE,
|
||||
JOP_SUBTRACT,
|
||||
JOP_MULTIPLY_IMMEDIATE,
|
||||
JOP_MULTIPLY,
|
||||
JOP_DIVIDE_IMMEDIATE,
|
||||
JOP_DIVIDE,
|
||||
JOP_DIVIDE_FLOOR,
|
||||
JOP_MODULO,
|
||||
JOP_REMAINDER,
|
||||
JOP_BAND,
|
||||
@@ -2050,6 +2055,7 @@ JANET_API int janet_cryptorand(uint8_t *out, size_t n);
|
||||
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
|
||||
JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
|
||||
JANET_API void janet_marshal_ptr(JanetMarshalContext *ctx, const void *value);
|
||||
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
|
||||
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
|
||||
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
|
||||
@@ -2059,6 +2065,7 @@ JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size);
|
||||
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
|
||||
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
|
||||
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
|
||||
JANET_API void *janet_unmarshal_ptr(JanetMarshalContext *ctx);
|
||||
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
|
||||
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
|
||||
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
|
||||
|
||||
@@ -30,10 +30,12 @@
|
||||
(assert (= 1 (brshift 4 2)) "right shift")
|
||||
# unsigned shift
|
||||
(assert (= 32768 (brushift 0x80000000 16)) "right shift unsigned 1")
|
||||
(assert (= -32768 (brshift 0x80000000 16)) "right shift unsigned 2")
|
||||
(assert-error "right shift unsigned 2" (= -32768 (brshift 0x80000000 16)))
|
||||
(assert (= -1 (brshift -1 16)) "right shift unsigned 3")
|
||||
# non-immediate forms
|
||||
(assert (= 32768 (brushift 0x80000000 (+ 0 16))) "right shift unsigned non-immediate")
|
||||
(assert (= -32768 (brshift 0x80000000 (+ 0 16))) "right shift non-immediate")
|
||||
(assert-error "right shift non-immediate" (= -32768 (brshift 0x80000000 (+ 0 16))))
|
||||
(assert (= -1 (brshift -1 (+ 0 16))) "right shift non-immediate 2")
|
||||
(assert (= 32768 (blshift 1 (+ 0 15))) "left shift non-immediate")
|
||||
# 7e46ead
|
||||
(assert (< 1 2 3 4 5 6) "less than integers")
|
||||
@@ -44,8 +46,28 @@
|
||||
(assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals")
|
||||
(assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers")
|
||||
(assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals")
|
||||
(assert (= 7 (% 20 13)) "modulo 1")
|
||||
(assert (= -7 (% -20 13)) "modulo 2")
|
||||
|
||||
(assert (= 7 (% 20 13)) "rem 1")
|
||||
(assert (= -7 (% -20 13)) "rem 2")
|
||||
(assert (= 7 (% 20 -13)) "rem 3")
|
||||
(assert (= -7 (% -20 -13)) "rem 4")
|
||||
(assert (nan? (% 20 0)) "rem 5")
|
||||
|
||||
(assert (= 7 (mod 20 13)) "mod 1")
|
||||
(assert (= 6 (mod -20 13)) "mod 2")
|
||||
(assert (= -6 (mod 20 -13)) "mod 3")
|
||||
(assert (= -7 (mod -20 -13)) "mod 4")
|
||||
(assert (= 20 (mod 20 0)) "mod 5")
|
||||
|
||||
(assert (= 1 (div 20 13)) "div 1")
|
||||
(assert (= -2 (div -20 13)) "div 2")
|
||||
(assert (= -2 (div 20 -13)) "div 3")
|
||||
(assert (= 1 (div -20 -13)) "div 4")
|
||||
(assert (= math/inf (div 20 0)) "div 5")
|
||||
|
||||
(assert (all = (seq [n :range [0 10]] (mod n 5 3))
|
||||
(seq [n :range [0 10]] (% n 5 3))
|
||||
[0 1 2 0 1 0 1 2 0 1]) "variadic mod")
|
||||
|
||||
(assert (< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
|
||||
@@ -25,38 +25,41 @@
|
||||
# 5e1a8c86f
|
||||
(def janet (dyn :executable))
|
||||
|
||||
# Subprocess should inherit the "RUN" parameter for fancy testing
|
||||
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
|
||||
|
||||
(repeat 10
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(os/proc-wait p)
|
||||
(def x (:read (p :out) :all))
|
||||
(assert (deep= "hello" (string/trim x))
|
||||
"capture stdout from os/spawn pre close."))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(def x (:read (p :out) 1024))
|
||||
(os/proc-wait p)
|
||||
(assert (deep= "hello" (string/trim x))
|
||||
"capture stdout from os/spawn post close."))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px
|
||||
(let [p (os/spawn [;run janet "-e" `(file/read stdin :line)`] :px
|
||||
{:in :pipe})]
|
||||
(:write (p :in) "hello!\n")
|
||||
(assert-no-error "pipe stdin to process" (os/proc-wait p))))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px
|
||||
(let [p (os/spawn [;run janet "-e" `(print (file/read stdin :line))`] :px
|
||||
{:in :pipe :out :pipe})]
|
||||
(:write (p :in) "hello!\n")
|
||||
(def x (:read (p :out) 1024))
|
||||
(assert-no-error "pipe stdin to process 2" (os/proc-wait p))
|
||||
(assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(os/proc-kill p)
|
||||
(def retval (os/proc-wait p))
|
||||
(assert (not= retval 24) "Process was *not* terminated by parent"))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(os/proc-kill p false :term)
|
||||
(def retval (os/proc-wait p))
|
||||
(assert (not= retval 24) "Process was *not* terminated by parent"))
|
||||
@@ -66,7 +69,7 @@
|
||||
(defn calc-1
|
||||
"Run subprocess, read from stdout, then wait on subprocess."
|
||||
[code]
|
||||
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
{:out :pipe})]
|
||||
(os/proc-wait p)
|
||||
(def output (:read (p :out) :all))
|
||||
@@ -86,7 +89,7 @@
|
||||
to 10 bytes instead of :all
|
||||
``
|
||||
[code]
|
||||
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
{:out :pipe})]
|
||||
(def output (:read (p :out) 10))
|
||||
(os/proc-wait p)
|
||||
@@ -104,18 +107,18 @@
|
||||
# a1cc5ca04
|
||||
(assert-no-error "file writing 1"
|
||||
(with [f (file/temp)]
|
||||
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
|
||||
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
|
||||
|
||||
(assert-no-error "file writing 2"
|
||||
(with [f (file/open "unique.txt" :w)]
|
||||
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
|
||||
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
|
||||
(file/flush f)))
|
||||
|
||||
# Issue #593
|
||||
# a1cc5ca04
|
||||
(assert-no-error "file writing 3"
|
||||
(def outfile (file/open "unique.txt" :w))
|
||||
(os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
|
||||
(os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
|
||||
{:out outfile})
|
||||
(file/flush outfile)
|
||||
(file/close outfile)
|
||||
@@ -256,7 +259,7 @@
|
||||
(ev/cancel fiber "boop")
|
||||
|
||||
# f0dbc2e
|
||||
(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
|
||||
(assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
|
||||
|
||||
# Test some channel
|
||||
# e76b8da26
|
||||
|
||||
@@ -171,22 +171,43 @@
|
||||
(assert (not (even? (int/s64 "-1001"))) "even? 6")
|
||||
|
||||
# integer type operations
|
||||
(defn modcheck [x y]
|
||||
(assert (= (string (mod x y)) (string (mod (int/s64 x) y)))
|
||||
(string "int/s64 (mod " x " " y ") expected " (mod x y) ", got "
|
||||
(mod (int/s64 x) y)))
|
||||
(assert (= (string (% x y)) (string (% (int/s64 x) y)))
|
||||
(string "int/s64 (% " x " " y ") expected " (% x y) ", got "
|
||||
(% (int/s64 x) y))))
|
||||
(defn opcheck [int x y]
|
||||
(each op [mod % div]
|
||||
(assert (compare= (op x y) (op (int x) y))
|
||||
(string int " (" op " " x " " y ") expected " (op x y)
|
||||
", got " (op (int x) y)))
|
||||
(assert (compare= (op x y) (op x (int y)))
|
||||
(string int " (" op " " x " " y ") expected " (op x y)
|
||||
", got " (op x (int y))))
|
||||
(assert (compare= (op x y) (op (int x) (int y)))
|
||||
(string int " (" op " " x " " y ") expected " (op x y)
|
||||
", got " (op (int x) (int y))))))
|
||||
|
||||
(modcheck 1 2)
|
||||
(modcheck 1 3)
|
||||
(modcheck 4 2)
|
||||
(modcheck 4 1)
|
||||
(modcheck 10 3)
|
||||
(modcheck 10 -3)
|
||||
(modcheck -10 3)
|
||||
(modcheck -10 -3)
|
||||
(loop [x :in [-5 -3 0 3 5]
|
||||
y :in [-4 -3 3 4]]
|
||||
(opcheck int/s64 x y)
|
||||
(if (and (>= x 0) (>= y 0))
|
||||
(opcheck int/u64 x y)))
|
||||
|
||||
(each int [int/s64 int/u64]
|
||||
(each op [% / div]
|
||||
(assert-error "division by zero" (op (int 7) 0))
|
||||
(assert-error "division by zero" (op 7 (int 0)))
|
||||
(assert-error "division by zero" (op (int 7) (int 0)))))
|
||||
|
||||
(each int [int/s64 int/u64]
|
||||
(loop [x :in [-5 -3 0 3 5]]
|
||||
(assert (= (int x) (mod (int x) 0)) (string int " mod 0"))
|
||||
(assert (= (int x) (mod x (int 0))) (string int " mod 0"))
|
||||
(assert (= (int x) (mod (int x) (int 0))) (string int " mod 0"))))
|
||||
|
||||
(loop [x :in [-5 -3 0 3 5]]
|
||||
(assert (compare= (bnot x) (bnot (int/s64 x))) "int/s64 bnot"))
|
||||
|
||||
(loop [x :range [0 10]]
|
||||
(assert (= (int/u64 "0xFFFF_FFFF_FFFF_FFFF")
|
||||
(bxor (int/u64 x) (bnot (int/u64 x))))
|
||||
"int/u64 bnot"))
|
||||
|
||||
# Check for issue #1130
|
||||
# 7e65c2bda
|
||||
@@ -253,6 +274,14 @@
|
||||
(assert (= (compare (i64 -1) (u64 1)) -1) "compare 11")
|
||||
(assert (= (compare (i64 -1) (u64 -1)) -1) "compare 12")
|
||||
|
||||
# off by 1 error in inttypes
|
||||
# a3e812b86
|
||||
(assert (= (int/s64 "-0x8000_0000_0000_0000")
|
||||
(+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
|
||||
(assert (= (int/s64 "0x7FFF_FFFF_FFFF_FFFF")
|
||||
(- (int/s64 "-0x8000_0000_0000_0000") 1)) "int types wrap around")
|
||||
|
||||
# Issue #1217
|
||||
(assert (= (- (int/u64 "0xFFFFFFFF") 1) (int/u64 "0xFFFFFFFE")) "u64 subtract")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -138,5 +138,13 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
# XXX: still needed? see 72beeeea
|
||||
(gccollect)
|
||||
|
||||
# ev/chan marshalling
|
||||
(compwhen (dyn 'ev/chan)
|
||||
(def chan (ev/chan 10))
|
||||
(ev/give chan chan)
|
||||
(def newchan (unmarshal (marshal chan)))
|
||||
(def item (ev/take newchan))
|
||||
(assert (= item newchan) "ev/chan marshalling"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -21,6 +21,9 @@
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
(def janet (dyn :executable))
|
||||
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
|
||||
|
||||
# OS Date test
|
||||
# 719f7ba0c
|
||||
(assert (deep= {:year-day 0
|
||||
@@ -94,9 +97,9 @@
|
||||
(assert (= (length buf) 2) "cryptorand appends to buffer"))
|
||||
|
||||
# 80db68210
|
||||
(assert-no-error (os/clock :realtime) "realtime clock")
|
||||
(assert-no-error (os/clock :cputime) "cputime clock")
|
||||
(assert-no-error (os/clock :monotonic) "monotonic clock")
|
||||
(assert-no-error "realtime clock" (os/clock :realtime))
|
||||
(assert-no-error "cputime clock" (os/clock :cputime))
|
||||
(assert-no-error "monotonic clock" (os/clock :monotonic))
|
||||
|
||||
(def before (os/clock :monotonic))
|
||||
(def after (os/clock :monotonic))
|
||||
@@ -118,16 +121,31 @@
|
||||
|
||||
# os/execute with environment variables
|
||||
# issue #636 - 7e2c433ab
|
||||
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe
|
||||
(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe
|
||||
(merge (os/environ) {"HELLO" "WORLD"})))
|
||||
"os/execute with env")
|
||||
|
||||
# os/execute regressions
|
||||
# 427f7c362
|
||||
(for i 0 10
|
||||
(assert (= i (os/execute [(dyn :executable) "-e"
|
||||
(assert (= i (os/execute [;run janet "-e"
|
||||
(string/format "(os/exit %d)" i)] :p))
|
||||
(string "os/execute " i)))
|
||||
|
||||
# os/execute IO redirection
|
||||
(assert-no-error "IO redirection"
|
||||
(defn devnull []
|
||||
(def os (os/which))
|
||||
(def path (if (or (= os :mingw) (= os :windows))
|
||||
"NUL"
|
||||
"/dev/null"))
|
||||
(os/open path :w))
|
||||
(with [dn (devnull)]
|
||||
(os/execute [;run janet
|
||||
"-e"
|
||||
"(print :foo) (eprint :bar)"]
|
||||
:px
|
||||
{:out dn :err dn})))
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -307,12 +307,12 @@
|
||||
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00"
|
||||
@[(int/u64 0x7fff)])
|
||||
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00"
|
||||
@[(int/s64 0x7fff)])
|
||||
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
|
||||
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
|
||||
(when-let [u64 int/u64
|
||||
i64 int/s64]
|
||||
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
|
||||
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(i64 0x7fff)])
|
||||
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
|
||||
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(i64 0x7fff)]))
|
||||
|
||||
(check-deep '(* (int 2) -1) "123" nil)
|
||||
|
||||
@@ -367,7 +367,7 @@
|
||||
(set "!$%&*+-./:<?=>@^_|"))
|
||||
:token (some :symchars)
|
||||
:hex (range "09" "af" "AF")
|
||||
:escape (* "\\" (+ (set "ntrvzf0e\"\\")
|
||||
:escape (* "\\" (+ (set `"'0?\abefnrtvz`)
|
||||
(* "x" :hex :hex)
|
||||
(error (constant "bad hex escape"))))
|
||||
:comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment))
|
||||
|
||||
@@ -35,10 +35,5 @@
|
||||
# c876e63
|
||||
0xf&1fffFFFF
|
||||
|
||||
# off by 1 error in inttypes
|
||||
# a3e812b86
|
||||
(assert (= (int/s64 "-0x8000_0000_0000_0000")
|
||||
(+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
2
tools/format.sh
Executable file → Normal file
2
tools/format.sh
Executable file → Normal file
@@ -1,4 +1,4 @@
|
||||
#!/usr/bin/env bash
|
||||
#!/usr/bin/env sh
|
||||
|
||||
# Format all code with astyle
|
||||
|
||||
|
||||
Reference in New Issue
Block a user