mirror of
https://github.com/janet-lang/janet
synced 2026-04-05 22:41:26 +00:00
Compare commits
43 Commits
inet_test
...
bytecode_o
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
b099bd97f2 | ||
|
|
9c97d8f648 | ||
|
|
40080b23ae | ||
|
|
7acb5c63e0 | ||
|
|
fcca9bbab3 | ||
|
|
dbb2187425 | ||
|
|
82e51f9e81 | ||
|
|
4782a76bca | ||
|
|
d13788a4ed | ||
|
|
e64a0175b1 | ||
|
|
4aca94154f | ||
|
|
ac5f118dac | ||
|
|
a2812ec5eb | ||
|
|
70f13f1b62 | ||
|
|
77e62a25cb | ||
|
|
09345ec786 | ||
|
|
bad73baf98 | ||
|
|
3602f5aa5d | ||
|
|
672b705faf | ||
|
|
64e3cdeb2b | ||
|
|
909c906080 | ||
|
|
71bde11e95 | ||
|
|
fc20fbed92 | ||
|
|
e6b7c85c37 | ||
|
|
b3a92363f8 | ||
|
|
e9f2d1aca7 | ||
|
|
b4e3dbf331 | ||
|
|
c3620786cf | ||
|
|
41943746e4 | ||
|
|
176e816b8c | ||
|
|
50a19bd870 | ||
|
|
57b751b994 | ||
|
|
c47c2e538d | ||
|
|
cc5545277d | ||
|
|
63353b98cd | ||
|
|
4dfc869b8a | ||
|
|
b4b1c7d80b | ||
|
|
e53c03028f | ||
|
|
53afc2e50a | ||
|
|
0f35acade1 | ||
|
|
56d72ec4c5 | ||
|
|
71d51c160d | ||
|
|
0b58e505ee |
4
Makefile
4
Makefile
@@ -51,7 +51,7 @@ LDFLAGS?=-rdynamic
|
|||||||
RUN:=$(RUN)
|
RUN:=$(RUN)
|
||||||
|
|
||||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS)
|
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
|
||||||
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||||
|
|
||||||
# For installation
|
# For installation
|
||||||
@@ -296,7 +296,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
|||||||
strip '$(DESTDIR)$(BINDIR)/janet'
|
strip '$(DESTDIR)$(BINDIR)/janet'
|
||||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||||
ln -sf -T ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' || true #fixme bsd
|
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||||
if test $(UNAME) = Darwin ; then \
|
if test $(UNAME) = Darwin ; then \
|
||||||
|
|||||||
@@ -923,67 +923,68 @@
|
|||||||
(set k (next ind k)))
|
(set k (next ind k)))
|
||||||
ret)
|
ret)
|
||||||
|
|
||||||
|
(defmacro- map-aggregator
|
||||||
|
`Aggregation logic for various map functions.`
|
||||||
|
[maptype res val]
|
||||||
|
(case maptype
|
||||||
|
:map ~(array/push ,res ,val)
|
||||||
|
:mapcat ~(array/concat ,res ,val)
|
||||||
|
:keep ~(if (def y ,val) (array/push ,res y))
|
||||||
|
:count ~(if ,val (++ ,res))
|
||||||
|
:some ~(if (def y ,val) (do (set ,res y) (break)))
|
||||||
|
:all ~(if (def y ,val) nil (do (set ,res y) (break)))))
|
||||||
|
|
||||||
|
(defmacro- map-n
|
||||||
|
`Generates efficient map logic for a specific number of
|
||||||
|
indexed beyond the first.`
|
||||||
|
[n maptype res f ind inds]
|
||||||
|
~(do
|
||||||
|
(def ,(seq [k :range [0 n]] (symbol 'ind k)) ,inds)
|
||||||
|
,;(seq [k :range [0 n]] ~(var ,(symbol 'key k) nil))
|
||||||
|
(each x ,ind
|
||||||
|
,;(seq [k :range [0 n]]
|
||||||
|
~(if (= nil (set ,(symbol 'key k) (next ,(symbol 'ind k) ,(symbol 'key k)))) (break)))
|
||||||
|
(map-aggregator ,maptype ,res (,f x ,;(seq [k :range [0 n]] ~(in ,(symbol 'ind k) ,(symbol 'key k))))))))
|
||||||
|
|
||||||
|
(defmacro- map-template
|
||||||
|
[maptype res f ind inds]
|
||||||
|
~(do
|
||||||
|
(def ninds (length ,inds))
|
||||||
|
(case ninds
|
||||||
|
0 (each x ,ind (map-aggregator ,maptype ,res (,f x)))
|
||||||
|
1 (map-n 1 ,maptype ,res ,f ,ind ,inds)
|
||||||
|
2 (map-n 2 ,maptype ,res ,f ,ind ,inds)
|
||||||
|
3 (map-n 3 ,maptype ,res ,f ,ind ,inds)
|
||||||
|
4 (map-n 4 ,maptype ,res ,f ,ind ,inds)
|
||||||
|
(do
|
||||||
|
(def iter-keys (array/new-filled ninds))
|
||||||
|
(def call-buffer (array/new-filled ninds))
|
||||||
|
(var done false)
|
||||||
|
(each x ,ind
|
||||||
|
(forv i 0 ninds
|
||||||
|
(let [old-key (in iter-keys i)
|
||||||
|
ii (in ,inds i)
|
||||||
|
new-key (next ii old-key)]
|
||||||
|
(if (= nil new-key)
|
||||||
|
(do (set done true) (break))
|
||||||
|
(do (set (iter-keys i) new-key) (set (call-buffer i) (in ii new-key))))))
|
||||||
|
(if done (break))
|
||||||
|
(map-aggregator ,maptype ,res (,f x ;call-buffer)))))))
|
||||||
|
|
||||||
(defn map
|
(defn map
|
||||||
`Map a function over every value in a data structure and
|
`Map a function over every value in a data structure and
|
||||||
return an array of the results.`
|
return an array of the results.`
|
||||||
[f & inds]
|
[f ind & inds]
|
||||||
(def ninds (length inds))
|
|
||||||
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
|
|
||||||
(def res @[])
|
(def res @[])
|
||||||
(def [i1 i2 i3 i4] inds)
|
(map-template :map res f ind inds)
|
||||||
(case ninds
|
|
||||||
1 (each x i1 (array/push res (f x)))
|
|
||||||
2 (do
|
|
||||||
(var k1 nil)
|
|
||||||
(var k2 nil)
|
|
||||||
(while true
|
|
||||||
(if (= nil (set k1 (next i1 k1))) (break))
|
|
||||||
(if (= nil (set k2 (next i2 k2))) (break))
|
|
||||||
(array/push res (f (in i1 k1) (in i2 k2)))))
|
|
||||||
3 (do
|
|
||||||
(var k1 nil)
|
|
||||||
(var k2 nil)
|
|
||||||
(var k3 nil)
|
|
||||||
(while true
|
|
||||||
(if (= nil (set k1 (next i1 k1))) (break))
|
|
||||||
(if (= nil (set k2 (next i2 k2))) (break))
|
|
||||||
(if (= nil (set k3 (next i3 k3))) (break))
|
|
||||||
(array/push res (f (in i1 k1) (in i2 k2) (in i3 k3)))))
|
|
||||||
4 (do
|
|
||||||
(var k1 nil)
|
|
||||||
(var k2 nil)
|
|
||||||
(var k3 nil)
|
|
||||||
(var k4 nil)
|
|
||||||
(while true
|
|
||||||
(if (= nil (set k1 (next i1 k1))) (break))
|
|
||||||
(if (= nil (set k2 (next i2 k2))) (break))
|
|
||||||
(if (= nil (set k3 (next i3 k3))) (break))
|
|
||||||
(if (= nil (set k4 (next i4 k4))) (break))
|
|
||||||
(array/push res (f (in i1 k1) (in i2 k2) (in i3 k3) (in i4 k4)))))
|
|
||||||
(do
|
|
||||||
(def iterkeys (array/new-filled ninds))
|
|
||||||
(var done false)
|
|
||||||
(def call-buffer @[])
|
|
||||||
(while true
|
|
||||||
(forv i 0 ninds
|
|
||||||
(let [old-key (in iterkeys i)
|
|
||||||
ii (in inds i)
|
|
||||||
new-key (next ii old-key)]
|
|
||||||
(if (= nil new-key)
|
|
||||||
(do (set done true) (break))
|
|
||||||
(do (set (iterkeys i) new-key) (array/push call-buffer (in ii new-key))))))
|
|
||||||
(if done (break))
|
|
||||||
(array/push res (f ;call-buffer))
|
|
||||||
(array/clear call-buffer))))
|
|
||||||
res)
|
res)
|
||||||
|
|
||||||
(defn mapcat
|
(defn mapcat
|
||||||
``Map a function over every element in an array or tuple and
|
``Map a function over every element in an array or tuple and
|
||||||
use `array/concat` to concatenate the results.``
|
use `array/concat` to concatenate the results.``
|
||||||
[f ind]
|
[f ind & inds]
|
||||||
(def res @[])
|
(def res @[])
|
||||||
(each x ind
|
(map-template :mapcat res f ind inds)
|
||||||
(array/concat res (f x)))
|
|
||||||
res)
|
res)
|
||||||
|
|
||||||
(defn filter
|
(defn filter
|
||||||
@@ -999,23 +1000,19 @@
|
|||||||
(defn count
|
(defn count
|
||||||
``Count the number of items in `ind` for which `(pred item)`
|
``Count the number of items in `ind` for which `(pred item)`
|
||||||
is true.``
|
is true.``
|
||||||
[pred ind]
|
[pred ind & inds]
|
||||||
(var counter 0)
|
(var res 0)
|
||||||
(each item ind
|
(map-template :count res pred ind inds)
|
||||||
(if (pred item)
|
res)
|
||||||
(++ counter)))
|
|
||||||
counter)
|
|
||||||
|
|
||||||
(defn keep
|
(defn keep
|
||||||
``Given a predicate `pred`, return a new array containing the truthy results
|
``Given a predicate `pred`, return a new array containing the truthy results
|
||||||
of applying `pred` to each element in the indexed collection `ind`. This is
|
of applying `pred` to each element in the indexed collection `ind`. This is
|
||||||
different from `filter` which returns an array of the original elements where
|
different from `filter` which returns an array of the original elements where
|
||||||
the predicate is truthy.``
|
the predicate is truthy.``
|
||||||
[pred ind]
|
[pred ind & inds]
|
||||||
(def res @[])
|
(def res @[])
|
||||||
(each item ind
|
(map-template :keep res pred ind inds)
|
||||||
(if-let [y (pred item)]
|
|
||||||
(array/push res y)))
|
|
||||||
res)
|
res)
|
||||||
|
|
||||||
(defn range
|
(defn range
|
||||||
@@ -1749,6 +1746,14 @@
|
|||||||
(printf (dyn *pretty-format* "%q") x)
|
(printf (dyn *pretty-format* "%q") x)
|
||||||
(flush))
|
(flush))
|
||||||
|
|
||||||
|
|
||||||
|
(defn file/lines
|
||||||
|
"Return an iterator over the lines of a file."
|
||||||
|
[file]
|
||||||
|
(coro
|
||||||
|
(while (def line (file/read file :line))
|
||||||
|
(yield line))))
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
### Pattern Matching
|
### Pattern Matching
|
||||||
@@ -2090,21 +2095,21 @@
|
|||||||
ret)
|
ret)
|
||||||
|
|
||||||
(defn all
|
(defn all
|
||||||
``Returns true if `(pred item)` returns a truthy value for every item in `xs`.
|
``Returns true if `(pred item)` is truthy for every item in `ind`.
|
||||||
Otherwise, returns the first falsey `(pred item)` result encountered.
|
Otherwise, returns the first falsey result encountered.
|
||||||
Returns true if `xs` is empty.``
|
Returns true if `ind` is empty.``
|
||||||
[pred xs]
|
[pred ind & inds]
|
||||||
(var ret true)
|
(var res true)
|
||||||
(loop [x :in xs :while ret] (set ret (pred x)))
|
(map-template :all res pred ind inds)
|
||||||
ret)
|
res)
|
||||||
|
|
||||||
(defn some
|
(defn some
|
||||||
``Returns nil if all `xs` are false or nil, otherwise returns the result of the
|
``Returns nil if `(pred item)` is false or nil for every item in `ind`.
|
||||||
first truthy predicate, `(pred x)`.``
|
Otherwise, returns the first truthy result encountered.``
|
||||||
[pred xs]
|
[pred ind & inds]
|
||||||
(var ret nil)
|
(var res nil)
|
||||||
(loop [x :in xs :while (not ret)] (if-let [y (pred x)] (set ret y)))
|
(map-template :some res pred ind inds)
|
||||||
ret)
|
res)
|
||||||
|
|
||||||
(defn deep-not=
|
(defn deep-not=
|
||||||
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
|
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
|
||||||
@@ -2114,8 +2119,24 @@
|
|||||||
(or
|
(or
|
||||||
(not= tx (type y))
|
(not= tx (type y))
|
||||||
(case tx
|
(case tx
|
||||||
:tuple (or (not= (length x) (length y)) (some identity (map deep-not= x y)))
|
:tuple (or (not= (length x) (length y))
|
||||||
:array (or (not= (length x) (length y)) (some identity (map deep-not= x 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))
|
:struct (deep-not= (kvs x) (kvs y))
|
||||||
:table (deep-not= (table/to-struct x) (table/to-struct y))
|
:table (deep-not= (table/to-struct x) (table/to-struct y))
|
||||||
:buffer (not= (string x) (string y))
|
:buffer (not= (string x) (string y))
|
||||||
|
|||||||
@@ -324,7 +324,8 @@ static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offs
|
|||||||
|
|
||||||
JANET_CORE_FN(cfun_buffer_push_at,
|
JANET_CORE_FN(cfun_buffer_push_at,
|
||||||
"(buffer/push-at buffer index & xs)",
|
"(buffer/push-at buffer index & xs)",
|
||||||
"Same as buffer/push, but inserts new data at index `index`.") {
|
"Same as buffer/push, but copies the new data into the buffer "
|
||||||
|
" at index `index`.") {
|
||||||
janet_arity(argc, 2, -1);
|
janet_arity(argc, 2, -1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
int32_t index = janet_getinteger(argv, 1);
|
int32_t index = janet_getinteger(argv, 1);
|
||||||
|
|||||||
@@ -25,6 +25,7 @@
|
|||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include "regalloc.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Look up table for instructions */
|
/* Look up table for instructions */
|
||||||
@@ -106,6 +107,288 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_SSS /* JOP_CANCEL, */
|
JINT_SSS /* JOP_CANCEL, */
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* Remove all noops while preserving jumps and debugging information.
|
||||||
|
* Useful as part of a filtering compiler pass. */
|
||||||
|
void janet_bytecode_remove_noops(JanetFuncDef *def) {
|
||||||
|
|
||||||
|
/* Get an instruction rewrite map so we can rewrite jumps */
|
||||||
|
uint32_t *pc_map = janet_smalloc(sizeof(uint32_t) * (1 + def->bytecode_length));
|
||||||
|
uint32_t new_bytecode_length = 0;
|
||||||
|
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||||
|
uint32_t instr = def->bytecode[i];
|
||||||
|
uint32_t opcode = instr & 0x7F;
|
||||||
|
pc_map[i] = new_bytecode_length;
|
||||||
|
if (opcode != JOP_NOOP) {
|
||||||
|
new_bytecode_length++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
pc_map[def->bytecode_length] = new_bytecode_length;
|
||||||
|
|
||||||
|
/* Linear scan rewrite bytecode and sourcemap. Also fix jumps. */
|
||||||
|
int32_t j = 0;
|
||||||
|
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||||
|
uint32_t instr = def->bytecode[i];
|
||||||
|
uint32_t opcode = instr & 0x7F;
|
||||||
|
int32_t old_jump_target = 0;
|
||||||
|
int32_t new_jump_target = 0;
|
||||||
|
switch (opcode) {
|
||||||
|
case JOP_NOOP:
|
||||||
|
continue;
|
||||||
|
case JOP_JUMP:
|
||||||
|
/* relative pc is in DS field of instruction */
|
||||||
|
old_jump_target = i + (((int32_t)instr) >> 8);
|
||||||
|
new_jump_target = pc_map[old_jump_target];
|
||||||
|
instr += (new_jump_target - old_jump_target + (i - j)) << 8;
|
||||||
|
break;
|
||||||
|
case JOP_JUMP_IF:
|
||||||
|
case JOP_JUMP_IF_NIL:
|
||||||
|
case JOP_JUMP_IF_NOT:
|
||||||
|
case JOP_JUMP_IF_NOT_NIL:
|
||||||
|
/* relative pc is in ES field of instruction */
|
||||||
|
old_jump_target = i + (((int32_t)instr) >> 16);
|
||||||
|
new_jump_target = pc_map[old_jump_target];
|
||||||
|
instr += (new_jump_target - old_jump_target + (i - j)) << 16;
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
def->bytecode[j] = instr;
|
||||||
|
if (def->sourcemap != NULL) {
|
||||||
|
def->sourcemap[j] = def->sourcemap[i];
|
||||||
|
}
|
||||||
|
j++;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Rewrite symbolmap */
|
||||||
|
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
||||||
|
JanetSymbolMap *sm = def->symbolmap + i;
|
||||||
|
/* Don't rewrite upvalue mappings */
|
||||||
|
if (sm->birth_pc < UINT32_MAX) {
|
||||||
|
sm->birth_pc = pc_map[sm->birth_pc];
|
||||||
|
sm->death_pc = pc_map[sm->death_pc];
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
def->bytecode_length = new_bytecode_length;
|
||||||
|
janet_sfree(pc_map);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Remove redundant loads, moves and other instructions if possible and convert them to
|
||||||
|
* noops. Input is assumed valid bytecode. */
|
||||||
|
void janet_bytecode_movopt(JanetFuncDef *def) {
|
||||||
|
JanetcRegisterAllocator ra;
|
||||||
|
int recur = 1;
|
||||||
|
|
||||||
|
/* Iterate this until no more instructions can be removed. */
|
||||||
|
while (recur) {
|
||||||
|
janetc_regalloc_init(&ra);
|
||||||
|
|
||||||
|
/* Look for slots that have writes but no reads (and aren't in the closure bitset). */
|
||||||
|
if (def->closure_bitset != NULL) {
|
||||||
|
for (int32_t i = 0; i < def->slotcount; i++) {
|
||||||
|
int32_t index = i >> 5;
|
||||||
|
uint32_t mask = 1U << (((uint32_t) i) & 31);
|
||||||
|
if (def->closure_bitset[index] & mask) {
|
||||||
|
janetc_regalloc_touch(&ra, i);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
#define AA ((instr >> 8) & 0xFF)
|
||||||
|
#define BB ((instr >> 16) & 0xFF)
|
||||||
|
#define CC (instr >> 24)
|
||||||
|
#define DD (instr >> 8)
|
||||||
|
#define EE (instr >> 16)
|
||||||
|
|
||||||
|
/* Check reads and writes */
|
||||||
|
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||||
|
uint32_t instr = def->bytecode[i];
|
||||||
|
switch (instr & 0x7F) {
|
||||||
|
|
||||||
|
/* Group instructions my how they read from slots */
|
||||||
|
|
||||||
|
/* No reads or writes */
|
||||||
|
default:
|
||||||
|
janet_assert(0, "unhandled instruction");
|
||||||
|
case JOP_JUMP:
|
||||||
|
case JOP_NOOP:
|
||||||
|
case JOP_RETURN_NIL:
|
||||||
|
/* Write A */
|
||||||
|
case JOP_LOAD_INTEGER:
|
||||||
|
case JOP_LOAD_CONSTANT:
|
||||||
|
case JOP_LOAD_UPVALUE:
|
||||||
|
case JOP_CLOSURE:
|
||||||
|
/* Write D */
|
||||||
|
case JOP_LOAD_NIL:
|
||||||
|
case JOP_LOAD_TRUE:
|
||||||
|
case JOP_LOAD_FALSE:
|
||||||
|
case JOP_LOAD_SELF:
|
||||||
|
case JOP_MAKE_ARRAY:
|
||||||
|
case JOP_MAKE_BUFFER:
|
||||||
|
case JOP_MAKE_STRING:
|
||||||
|
case JOP_MAKE_STRUCT:
|
||||||
|
case JOP_MAKE_TABLE:
|
||||||
|
case JOP_MAKE_TUPLE:
|
||||||
|
case JOP_MAKE_BRACKET_TUPLE:
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* Read A */
|
||||||
|
case JOP_ERROR:
|
||||||
|
case JOP_TYPECHECK:
|
||||||
|
case JOP_JUMP_IF:
|
||||||
|
case JOP_JUMP_IF_NOT:
|
||||||
|
case JOP_JUMP_IF_NIL:
|
||||||
|
case JOP_JUMP_IF_NOT_NIL:
|
||||||
|
case JOP_SET_UPVALUE:
|
||||||
|
/* Write E, Read A */
|
||||||
|
case JOP_MOVE_FAR:
|
||||||
|
janetc_regalloc_touch(&ra, AA);
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* Read B */
|
||||||
|
case JOP_SIGNAL:
|
||||||
|
/* Write A, Read B */
|
||||||
|
case JOP_ADD_IMMEDIATE:
|
||||||
|
case JOP_MULTIPLY_IMMEDIATE:
|
||||||
|
case JOP_DIVIDE_IMMEDIATE:
|
||||||
|
case JOP_SHIFT_LEFT_IMMEDIATE:
|
||||||
|
case JOP_SHIFT_RIGHT_IMMEDIATE:
|
||||||
|
case JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE:
|
||||||
|
case JOP_GREATER_THAN_IMMEDIATE:
|
||||||
|
case JOP_LESS_THAN_IMMEDIATE:
|
||||||
|
case JOP_EQUALS_IMMEDIATE:
|
||||||
|
case JOP_NOT_EQUALS_IMMEDIATE:
|
||||||
|
case JOP_GET_INDEX:
|
||||||
|
janetc_regalloc_touch(&ra, BB);
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* Read D */
|
||||||
|
case JOP_RETURN:
|
||||||
|
case JOP_PUSH:
|
||||||
|
case JOP_PUSH_ARRAY:
|
||||||
|
case JOP_TAILCALL:
|
||||||
|
janetc_regalloc_touch(&ra, DD);
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* Write A, Read E */
|
||||||
|
case JOP_MOVE_NEAR:
|
||||||
|
case JOP_LENGTH:
|
||||||
|
case JOP_BNOT:
|
||||||
|
case JOP_CALL:
|
||||||
|
janetc_regalloc_touch(&ra, EE);
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* Read A, B */
|
||||||
|
case JOP_PUT_INDEX:
|
||||||
|
janetc_regalloc_touch(&ra, AA);
|
||||||
|
janetc_regalloc_touch(&ra, BB);
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* Read A, E */
|
||||||
|
case JOP_PUSH_2:
|
||||||
|
janetc_regalloc_touch(&ra, AA);
|
||||||
|
janetc_regalloc_touch(&ra, EE);
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* Read B, C */
|
||||||
|
case JOP_PROPAGATE:
|
||||||
|
/* Write A, Read B and C */
|
||||||
|
case JOP_BAND:
|
||||||
|
case JOP_BOR:
|
||||||
|
case JOP_BXOR:
|
||||||
|
case JOP_ADD:
|
||||||
|
case JOP_SUBTRACT:
|
||||||
|
case JOP_MULTIPLY:
|
||||||
|
case JOP_DIVIDE:
|
||||||
|
case JOP_MODULO:
|
||||||
|
case JOP_REMAINDER:
|
||||||
|
case JOP_SHIFT_LEFT:
|
||||||
|
case JOP_SHIFT_RIGHT:
|
||||||
|
case JOP_SHIFT_RIGHT_UNSIGNED:
|
||||||
|
case JOP_GREATER_THAN:
|
||||||
|
case JOP_LESS_THAN:
|
||||||
|
case JOP_EQUALS:
|
||||||
|
case JOP_COMPARE:
|
||||||
|
case JOP_IN:
|
||||||
|
case JOP_GET:
|
||||||
|
case JOP_GREATER_THAN_EQUAL:
|
||||||
|
case JOP_LESS_THAN_EQUAL:
|
||||||
|
case JOP_NOT_EQUALS:
|
||||||
|
case JOP_CANCEL:
|
||||||
|
case JOP_RESUME:
|
||||||
|
case JOP_NEXT:
|
||||||
|
janetc_regalloc_touch(&ra, BB);
|
||||||
|
janetc_regalloc_touch(&ra, CC);
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* Read A, B, C */
|
||||||
|
case JOP_PUT:
|
||||||
|
case JOP_PUSH_3:
|
||||||
|
janetc_regalloc_touch(&ra, AA);
|
||||||
|
janetc_regalloc_touch(&ra, BB);
|
||||||
|
janetc_regalloc_touch(&ra, CC);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Iterate and set noops on instructions that make writes that no one ever reads.
|
||||||
|
* Only set noops for instructions with no side effects - moves, loads, etc. that can't
|
||||||
|
* raise errors (outside of systemic errors like oom or stack overflow). */
|
||||||
|
recur = 0;
|
||||||
|
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||||
|
uint32_t instr = def->bytecode[i];
|
||||||
|
switch (instr & 0x7F) {
|
||||||
|
default:
|
||||||
|
break;
|
||||||
|
/* Write D */
|
||||||
|
case JOP_LOAD_NIL:
|
||||||
|
case JOP_LOAD_TRUE:
|
||||||
|
case JOP_LOAD_FALSE:
|
||||||
|
case JOP_LOAD_SELF:
|
||||||
|
case JOP_MAKE_ARRAY:
|
||||||
|
case JOP_MAKE_TUPLE:
|
||||||
|
case JOP_MAKE_BRACKET_TUPLE: {
|
||||||
|
if (!janetc_regalloc_check(&ra, DD)) {
|
||||||
|
def->bytecode[i] = JOP_NOOP;
|
||||||
|
recur = 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
/* Write E, Read A */
|
||||||
|
case JOP_MOVE_FAR: {
|
||||||
|
if (!janetc_regalloc_check(&ra, EE)) {
|
||||||
|
def->bytecode[i] = JOP_NOOP;
|
||||||
|
recur = 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
/* Write A, Read E */
|
||||||
|
case JOP_MOVE_NEAR:
|
||||||
|
/* Write A, Read B */
|
||||||
|
case JOP_GET_INDEX:
|
||||||
|
/* Write A */
|
||||||
|
case JOP_LOAD_INTEGER:
|
||||||
|
case JOP_LOAD_CONSTANT:
|
||||||
|
case JOP_LOAD_UPVALUE:
|
||||||
|
case JOP_CLOSURE: {
|
||||||
|
if (!janetc_regalloc_check(&ra, AA)) {
|
||||||
|
def->bytecode[i] = JOP_NOOP;
|
||||||
|
recur = 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
janetc_regalloc_deinit(&ra);
|
||||||
|
#undef AA
|
||||||
|
#undef BB
|
||||||
|
#undef CC
|
||||||
|
#undef DD
|
||||||
|
#undef EE
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Verify some bytecode */
|
/* Verify some bytecode */
|
||||||
int janet_verify(JanetFuncDef *def) {
|
int janet_verify(JanetFuncDef *def) {
|
||||||
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||||
|
|||||||
@@ -989,6 +989,10 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
/* Pop the scope */
|
/* Pop the scope */
|
||||||
janetc_popscope(c);
|
janetc_popscope(c);
|
||||||
|
|
||||||
|
/* Do basic optimization */
|
||||||
|
janet_bytecode_movopt(def);
|
||||||
|
janet_bytecode_remove_noops(def);
|
||||||
|
|
||||||
return def;
|
return def;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -267,4 +267,8 @@ JanetSlot janetc_cslot(Janet x);
|
|||||||
/* Search for a symbol */
|
/* Search for a symbol */
|
||||||
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
||||||
|
|
||||||
|
/* Bytecode optimization */
|
||||||
|
void janet_bytecode_movopt(JanetFuncDef *def);
|
||||||
|
void janet_bytecode_remove_noops(JanetFuncDef *def);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -458,7 +458,7 @@ JANET_CORE_FN(janet_core_getproto,
|
|||||||
? janet_wrap_struct(janet_struct_proto(st))
|
? janet_wrap_struct(janet_struct_proto(st))
|
||||||
: janet_wrap_nil();
|
: janet_wrap_nil();
|
||||||
}
|
}
|
||||||
janet_panicf("expected struct|table, got %v", argv[0]);
|
janet_panicf("expected struct or table, got %v", argv[0]);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(janet_core_struct,
|
JANET_CORE_FN(janet_core_struct,
|
||||||
|
|||||||
@@ -2911,7 +2911,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
|||||||
JanetFiber *fiber;
|
JanetFiber *fiber;
|
||||||
if (!janet_checktype(fiberv, JANET_FIBER)) {
|
if (!janet_checktype(fiberv, JANET_FIBER)) {
|
||||||
if (!janet_checktype(fiberv, JANET_FUNCTION)) {
|
if (!janet_checktype(fiberv, JANET_FUNCTION)) {
|
||||||
janet_panicf("expected function|fiber, got %v", fiberv);
|
janet_panicf("expected function or fiber, got %v", fiberv);
|
||||||
}
|
}
|
||||||
JanetFunction *func = janet_unwrap_function(fiberv);
|
JanetFunction *func = janet_unwrap_function(fiberv);
|
||||||
if (func->def->min_arity > 1) {
|
if (func->def->min_arity > 1) {
|
||||||
|
|||||||
@@ -138,7 +138,7 @@ int64_t janet_unwrap_s64(Janet x) {
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
janet_panicf("bad s64 initializer: %t", x);
|
janet_panicf("can not convert %t %q to 64 bit signed integer", x, x);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -169,7 +169,7 @@ uint64_t janet_unwrap_u64(Janet x) {
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
janet_panicf("bad u64 initializer: %t", x);
|
janet_panicf("can not convert %t %q to a 64 bit unsigned integer", x, x);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -460,7 +460,7 @@ JANET_CORE_FN(cfun_net_connect,
|
|||||||
if (binding) {
|
if (binding) {
|
||||||
struct addrinfo *rp = NULL;
|
struct addrinfo *rp = NULL;
|
||||||
int did_bind = 0;
|
int did_bind = 0;
|
||||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
for (rp = binding; rp != NULL; rp = rp->ai_next) {
|
||||||
if (bind(sock, rp->ai_addr, (int) rp->ai_addrlen) == 0) {
|
if (bind(sock, rp->ai_addr, (int) rp->ai_addrlen) == 0) {
|
||||||
did_bind = 1;
|
did_bind = 1;
|
||||||
break;
|
break;
|
||||||
|
|||||||
110
src/core/os.c
110
src/core/os.c
@@ -624,12 +624,99 @@ JANET_CORE_FN(os_proc_wait,
|
|||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
|
struct keyword_signal {
|
||||||
|
const char *keyword;
|
||||||
|
int signal;
|
||||||
|
};
|
||||||
|
|
||||||
|
#ifndef JANET_WINDOWS
|
||||||
|
static const struct keyword_signal signal_keywords[] = {
|
||||||
|
#ifdef SIGKILL
|
||||||
|
{"kill", SIGKILL},
|
||||||
|
#endif
|
||||||
|
{"int", SIGINT},
|
||||||
|
{"abrt", SIGABRT},
|
||||||
|
{"fpe", SIGFPE},
|
||||||
|
{"ill", SIGILL},
|
||||||
|
{"segv", SIGSEGV},
|
||||||
|
#ifdef SIGTERM
|
||||||
|
{"term", SIGTERM},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGARLM
|
||||||
|
{"alrm", SIGALRM},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGHUP
|
||||||
|
{"hup", SIGHUP},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGPIPE
|
||||||
|
{"pipe", SIGPIPE},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGQUIT
|
||||||
|
{"quit", SIGQUIT},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGUSR1
|
||||||
|
{"usr1", SIGUSR1},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGUSR2
|
||||||
|
{"usr2", SIGUSR2},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGCHLD
|
||||||
|
{"chld", SIGCHLD},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGCONT
|
||||||
|
{"cont", SIGCONT},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGSTOP
|
||||||
|
{"stop", SIGSTOP},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGTSTP
|
||||||
|
{"tstp", SIGTSTP},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGTTIN
|
||||||
|
{"ttin", SIGTTIN},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGTTOU
|
||||||
|
{"ttou", SIGTTOU},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGBUS
|
||||||
|
{"bus", SIGBUS},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGPOLL
|
||||||
|
{"poll", SIGPOLL},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGPROF
|
||||||
|
{"prof", SIGPROF},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGSYS
|
||||||
|
{"sys", SIGSYS},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGTRAP
|
||||||
|
{"trap", SIGTRAP},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGURG
|
||||||
|
{"urg", SIGURG},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGVTALRM
|
||||||
|
{"vtlarm", SIGVTALRM},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGXCPU
|
||||||
|
{"xcpu", SIGXCPU},
|
||||||
|
#endif
|
||||||
|
#ifdef SIGXFSZ
|
||||||
|
{"xfsz", SIGXFSZ},
|
||||||
|
#endif
|
||||||
|
{NULL, 0},
|
||||||
|
};
|
||||||
|
#endif
|
||||||
|
|
||||||
JANET_CORE_FN(os_proc_kill,
|
JANET_CORE_FN(os_proc_kill,
|
||||||
"(os/proc-kill proc &opt wait)",
|
"(os/proc-kill proc &opt wait signal)",
|
||||||
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
|
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
|
||||||
"handle on windows. If `wait` is truthy, will wait for the process to finish and "
|
"handle on windows. If `wait` is truthy, will wait for the process to finish and "
|
||||||
"returns the exit code. Otherwise, returns `proc`.") {
|
"returns the exit code. Otherwise, returns `proc`. If signal is specified send it instead."
|
||||||
janet_arity(argc, 1, 2);
|
"Signal keywords are named after their C counterparts but in lowercase with the leading "
|
||||||
|
"`SIG` stripped. Signals are ignored on windows.") {
|
||||||
|
janet_arity(argc, 1, 3);
|
||||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||||
if (proc->flags & JANET_PROC_WAITED) {
|
if (proc->flags & JANET_PROC_WAITED) {
|
||||||
janet_panicf("cannot kill process that has already finished");
|
janet_panicf("cannot kill process that has already finished");
|
||||||
@@ -643,7 +730,22 @@ JANET_CORE_FN(os_proc_kill,
|
|||||||
CloseHandle(proc->pHandle);
|
CloseHandle(proc->pHandle);
|
||||||
CloseHandle(proc->tHandle);
|
CloseHandle(proc->tHandle);
|
||||||
#else
|
#else
|
||||||
int status = kill(proc->pid, SIGKILL);
|
int signal = -1;
|
||||||
|
if (argc == 3) {
|
||||||
|
JanetKeyword signal_kw = janet_getkeyword(argv, 2);
|
||||||
|
const struct keyword_signal *ptr = signal_keywords;
|
||||||
|
while (ptr->keyword) {
|
||||||
|
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
|
||||||
|
signal = ptr->signal;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
ptr++;
|
||||||
|
}
|
||||||
|
if (signal == -1) {
|
||||||
|
janet_panic("undefined signal");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
|
||||||
if (status) {
|
if (status) {
|
||||||
janet_panic(strerror(errno));
|
janet_panic(strerror(errno));
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1100,7 +1100,7 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
Janet fun = argv[1];
|
Janet fun = argv[1];
|
||||||
if (!janet_checktype(fun, JANET_FUNCTION) &&
|
if (!janet_checktype(fun, JANET_FUNCTION) &&
|
||||||
!janet_checktype(fun, JANET_CFUNCTION)) {
|
!janet_checktype(fun, JANET_CFUNCTION)) {
|
||||||
peg_panicf(b, "expected function|cfunction, got %v", fun);
|
peg_panicf(b, "expected function or cfunction, got %v", fun);
|
||||||
}
|
}
|
||||||
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
|
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
|
||||||
uint32_t cindex = emit_constant(b, fun);
|
uint32_t cindex = emit_constant(b, fun);
|
||||||
|
|||||||
@@ -736,7 +736,7 @@ static void pushtypes(JanetBuffer *buffer, int types) {
|
|||||||
if (first) {
|
if (first) {
|
||||||
first = 0;
|
first = 0;
|
||||||
} else {
|
} else {
|
||||||
janet_buffer_push_u8(buffer, '|');
|
janet_buffer_push_cstring(buffer, (types == 1) ? " or " : ", ");
|
||||||
}
|
}
|
||||||
janet_buffer_push_cstring(buffer, janet_type_names[i]);
|
janet_buffer_push_cstring(buffer, janet_type_names[i]);
|
||||||
}
|
}
|
||||||
@@ -846,7 +846,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
|||||||
}
|
}
|
||||||
case 'd':
|
case 'd':
|
||||||
case 'i': {
|
case 'i': {
|
||||||
int64_t n = va_arg(args, long);
|
int64_t n = va_arg(args, int);
|
||||||
nb = snprintf(item, MAX_ITEM, form, n);
|
nb = snprintf(item, MAX_ITEM, form, n);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -854,7 +854,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
|||||||
case 'X':
|
case 'X':
|
||||||
case 'o':
|
case 'o':
|
||||||
case 'u': {
|
case 'u': {
|
||||||
uint64_t n = va_arg(args, unsigned long);
|
uint64_t n = va_arg(args, unsigned int);
|
||||||
nb = snprintf(item, MAX_ITEM, form, n);
|
nb = snprintf(item, MAX_ITEM, form, n);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -27,6 +27,8 @@
|
|||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* The JanetRegisterAllocator is really just a bitset. */
|
||||||
|
|
||||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||||
ra->chunks = NULL;
|
ra->chunks = NULL;
|
||||||
ra->count = 0;
|
ra->count = 0;
|
||||||
@@ -139,6 +141,14 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
|
|||||||
ra->chunks[chunk] &= ~ithbit(bit);
|
ra->chunks[chunk] &= ~ithbit(bit);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Check if a register is set. */
|
||||||
|
int janetc_regalloc_check(JanetcRegisterAllocator *ra, int32_t reg) {
|
||||||
|
int32_t chunk = reg >> 5;
|
||||||
|
int32_t bit = reg & 0x1F;
|
||||||
|
while (chunk >= ra->count) pushchunk(ra);
|
||||||
|
return !!(ra->chunks[chunk] & ithbit(bit));
|
||||||
|
}
|
||||||
|
|
||||||
/* Get a register that will fit in 8 bits (< 256). Do not call this
|
/* Get a register that will fit in 8 bits (< 256). Do not call this
|
||||||
* twice with the same value of nth without calling janetc_regalloc_free
|
* twice with the same value of nth without calling janetc_regalloc_free
|
||||||
* on the returned register before. */
|
* on the returned register before. */
|
||||||
|
|||||||
@@ -56,5 +56,6 @@ int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth
|
|||||||
void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRegisterTemp nth);
|
void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRegisterTemp nth);
|
||||||
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
|
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
|
||||||
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
|
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
|
||||||
|
int janetc_regalloc_check(JanetcRegisterAllocator *ra, int32_t reg);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -264,7 +264,7 @@ static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
|||||||
|
|
||||||
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
if (argn != 2) {
|
if (argn != 2) {
|
||||||
janetc_cerror(opts.compiler, "expected 2 arguments");
|
janetc_cerror(opts.compiler, "expected 2 arguments to set");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
||||||
@@ -335,11 +335,11 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
|
|||||||
return tab;
|
return tab;
|
||||||
}
|
}
|
||||||
|
|
||||||
static JanetSlot dohead(JanetCompiler *c, JanetFopts opts, Janet *head, int32_t argn, const Janet *argv) {
|
static JanetSlot dohead(const char *kind, JanetCompiler *c, JanetFopts opts, Janet *head, int32_t argn, const Janet *argv) {
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
JanetSlot ret;
|
JanetSlot ret;
|
||||||
if (argn < 2) {
|
if (argn < 2) {
|
||||||
janetc_cerror(c, "expected at least 2 arguments");
|
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
*head = argv[0];
|
*head = argv[0];
|
||||||
@@ -354,7 +354,17 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
|
|||||||
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
||||||
ret.index > 0 &&
|
ret.index > 0 &&
|
||||||
ret.envindex >= 0;
|
ret.envindex >= 0;
|
||||||
if (!isUnnamedRegister) {
|
/* optimization for `(def x my-def)` - don't emit a movn/movf instruction, we can just alias my-def */
|
||||||
|
/* TODO - implement optimization for `(def x my-var)` correctly as well w/ de-aliasing */
|
||||||
|
int canAlias = !(flags & JANET_SLOT_MUTABLE) &&
|
||||||
|
!(ret.flags & JANET_SLOT_MUTABLE) &&
|
||||||
|
(ret.flags & JANET_SLOT_NAMED) &&
|
||||||
|
(ret.index >= 0) &&
|
||||||
|
(ret.envindex == -1);
|
||||||
|
if (canAlias) {
|
||||||
|
ret.flags &= ~JANET_SLOT_MUTABLE;
|
||||||
|
isUnnamedRegister = 1; /* don't free slot after use - is an alias for another slot */
|
||||||
|
} else if (!isUnnamedRegister) {
|
||||||
/* Slot is not able to be named */
|
/* Slot is not able to be named */
|
||||||
JanetSlot localslot = janetc_farslot(c);
|
JanetSlot localslot = janetc_farslot(c);
|
||||||
janetc_copy(c, localslot, ret);
|
janetc_copy(c, localslot, ret);
|
||||||
@@ -404,7 +414,7 @@ static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
Janet head;
|
Janet head;
|
||||||
JanetTable *attr_table = handleattr(c, argn, argv);
|
JanetTable *attr_table = handleattr(c, argn, argv);
|
||||||
JanetSlot ret = dohead(c, opts, &head, argn, argv);
|
JanetSlot ret = dohead("var", c, opts, &head, argn, argv);
|
||||||
if (c->result.status == JANET_COMPILE_ERROR)
|
if (c->result.status == JANET_COMPILE_ERROR)
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
destructure(c, argv[0], ret, varleaf, attr_table);
|
destructure(c, argv[0], ret, varleaf, attr_table);
|
||||||
@@ -454,7 +464,7 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
Janet head;
|
Janet head;
|
||||||
opts.flags &= ~JANET_FOPTS_HINT;
|
opts.flags &= ~JANET_FOPTS_HINT;
|
||||||
JanetTable *attr_table = handleattr(c, argn, argv);
|
JanetTable *attr_table = handleattr(c, argn, argv);
|
||||||
JanetSlot ret = dohead(c, opts, &head, argn, argv);
|
JanetSlot ret = dohead("def", c, opts, &head, argn, argv);
|
||||||
if (c->result.status == JANET_COMPILE_ERROR)
|
if (c->result.status == JANET_COMPILE_ERROR)
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
destructure(c, argv[0], ret, defleaf, attr_table);
|
destructure(c, argv[0], ret, defleaf, attr_table);
|
||||||
@@ -707,8 +717,8 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
uint8_t ifjmp = JOP_JUMP_IF;
|
uint8_t ifjmp = JOP_JUMP_IF;
|
||||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
||||||
|
|
||||||
if (argn < 2) {
|
if (argn < 1) {
|
||||||
janetc_cerror(c, "expected at least 2 arguments");
|
janetc_cerror(c, "expected at least 1 argument to while");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -535,7 +535,30 @@ JANET_CORE_FN(cfun_string_join,
|
|||||||
JANET_CORE_FN(cfun_string_format,
|
JANET_CORE_FN(cfun_string_format,
|
||||||
"(string/format format & values)",
|
"(string/format format & values)",
|
||||||
"Similar to C's `snprintf`, but specialized for operating with Janet values. Returns "
|
"Similar to C's `snprintf`, but specialized for operating with Janet values. Returns "
|
||||||
"a new string.") {
|
"a new string.\n\n"
|
||||||
|
"The following conversion specifiers are supported, where the upper case specifiers generate "
|
||||||
|
"upper case output:\n"
|
||||||
|
"- `c`: ASCII character.\n"
|
||||||
|
"- `d`, `i`: integer, formatted as a decimal number.\n"
|
||||||
|
"- `x`, `X`: integer, formatted as a hexadecimal number.\n"
|
||||||
|
"- `o`: integer, formatted as an octal number.\n"
|
||||||
|
"- `f`, `F`: floating point number, formatted as a decimal number.\n"
|
||||||
|
"- `e`, `E`: floating point number, formatted in scientific notation.\n"
|
||||||
|
"- `g`, `G`: floating point number, formatted in its shortest form.\n"
|
||||||
|
"- `a`, `A`: floating point number, formatted as a hexadecimal number.\n"
|
||||||
|
"- `s`: formatted as a string, precision indicates padding and maximum length.\n"
|
||||||
|
"- `t`: emit the type of the given value.\n"
|
||||||
|
"- `v`: format with (describe x)"
|
||||||
|
"- `V`: format with (string x)"
|
||||||
|
"- `j`: format to jdn (Janet data notation).\n"
|
||||||
|
"\n"
|
||||||
|
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
|
||||||
|
"variants generate colored output. These speficiers can take a precision "
|
||||||
|
"argument to specify the maximum nesting depth to print.\n"
|
||||||
|
"- `p`, `P`: pretty format, truncating if necessary\n"
|
||||||
|
"- `m`, `M`: pretty format without truncating.\n"
|
||||||
|
"- `q`, `Q`: pretty format on one line, truncating if necessary.\n"
|
||||||
|
"- `n`, `N`: pretty format on one line without truncation.\n") {
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetBuffer *buffer = janet_buffer(0);
|
JanetBuffer *buffer = janet_buffer(0);
|
||||||
const char *strfrmt = (const char *) janet_getstring(argv, 0);
|
const char *strfrmt = (const char *) janet_getstring(argv, 0);
|
||||||
|
|||||||
@@ -933,7 +933,7 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
|
|||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
|
int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
|
||||||
clockid_t cid = JANET_TIME_REALTIME;
|
clockid_t cid = CLOCK_REALTIME;
|
||||||
if (source == JANET_TIME_REALTIME) {
|
if (source == JANET_TIME_REALTIME) {
|
||||||
cid = CLOCK_REALTIME;
|
cid = CLOCK_REALTIME;
|
||||||
} else if (source == JANET_TIME_MONOTONIC) {
|
} else if (source == JANET_TIME_MONOTONIC) {
|
||||||
|
|||||||
@@ -439,20 +439,21 @@ int janet_compare(Janet x, Janet y) {
|
|||||||
return status - 2;
|
return status - 2;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int32_t getter_checkint(Janet key, int32_t max) {
|
static int32_t getter_checkint(JanetType type, Janet key, int32_t max) {
|
||||||
if (!janet_checkint(key)) goto bad;
|
if (!janet_checkint(key)) goto bad;
|
||||||
int32_t ret = janet_unwrap_integer(key);
|
int32_t ret = janet_unwrap_integer(key);
|
||||||
if (ret < 0) goto bad;
|
if (ret < 0) goto bad;
|
||||||
if (ret >= max) goto bad;
|
if (ret >= max) goto bad;
|
||||||
return ret;
|
return ret;
|
||||||
bad:
|
bad:
|
||||||
janet_panicf("expected integer key in range [0, %d), got %v", max, key);
|
janet_panicf("expected integer key for %s in range [0, %d), got %v", janet_type_names[type], max, key);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Gets a value and returns. Can panic. */
|
/* Gets a value and returns. Can panic. */
|
||||||
Janet janet_in(Janet ds, Janet key) {
|
Janet janet_in(Janet ds, Janet key) {
|
||||||
Janet value;
|
Janet value;
|
||||||
switch (janet_type(ds)) {
|
JanetType type = janet_type(ds);
|
||||||
|
switch (type) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
break;
|
break;
|
||||||
@@ -464,19 +465,19 @@ Janet janet_in(Janet ds, Janet key) {
|
|||||||
break;
|
break;
|
||||||
case JANET_ARRAY: {
|
case JANET_ARRAY: {
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
int32_t index = getter_checkint(key, array->count);
|
int32_t index = getter_checkint(type, key, array->count);
|
||||||
value = array->data[index];
|
value = array->data[index];
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_TUPLE: {
|
case JANET_TUPLE: {
|
||||||
const Janet *tuple = janet_unwrap_tuple(ds);
|
const Janet *tuple = janet_unwrap_tuple(ds);
|
||||||
int32_t len = janet_tuple_length(tuple);
|
int32_t len = janet_tuple_length(tuple);
|
||||||
value = tuple[getter_checkint(key, len)];
|
value = tuple[getter_checkint(type, key, len)];
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_BUFFER: {
|
case JANET_BUFFER: {
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
int32_t index = getter_checkint(key, buffer->count);
|
int32_t index = getter_checkint(type, key, buffer->count);
|
||||||
value = janet_wrap_integer(buffer->data[index]);
|
value = janet_wrap_integer(buffer->data[index]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -484,7 +485,7 @@ Janet janet_in(Janet ds, Janet key) {
|
|||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
case JANET_KEYWORD: {
|
case JANET_KEYWORD: {
|
||||||
const uint8_t *str = janet_unwrap_string(ds);
|
const uint8_t *str = janet_unwrap_string(ds);
|
||||||
int32_t index = getter_checkint(key, janet_string_length(str));
|
int32_t index = getter_checkint(type, key, janet_string_length(str));
|
||||||
value = janet_wrap_integer(str[index]);
|
value = janet_wrap_integer(str[index]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -752,13 +753,14 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
void janet_put(Janet ds, Janet key, Janet value) {
|
void janet_put(Janet ds, Janet key, Janet value) {
|
||||||
switch (janet_type(ds)) {
|
JanetType type = janet_type(ds);
|
||||||
|
switch (type) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v",
|
janet_panicf("expected %T, got %v",
|
||||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||||
case JANET_ARRAY: {
|
case JANET_ARRAY: {
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
int32_t index = getter_checkint(key, INT32_MAX - 1);
|
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
|
||||||
if (index >= array->count) {
|
if (index >= array->count) {
|
||||||
janet_array_setcount(array, index + 1);
|
janet_array_setcount(array, index + 1);
|
||||||
}
|
}
|
||||||
@@ -767,7 +769,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
|||||||
}
|
}
|
||||||
case JANET_BUFFER: {
|
case JANET_BUFFER: {
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
int32_t index = getter_checkint(key, INT32_MAX - 1);
|
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
|
||||||
if (!janet_checkint(value))
|
if (!janet_checkint(value))
|
||||||
janet_panicf("can only put integers in buffers, got %v", value);
|
janet_panicf("can only put integers in buffers, got %v", value);
|
||||||
if (index >= buffer->count) {
|
if (index >= buffer->count) {
|
||||||
|
|||||||
@@ -1423,6 +1423,7 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
|
|||||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||||
*out = in;
|
*out = in;
|
||||||
janet_fiber_set_status(fiber, sig);
|
janet_fiber_set_status(fiber, sig);
|
||||||
|
fiber->last_value = child->last_value;
|
||||||
return sig;
|
return sig;
|
||||||
}
|
}
|
||||||
/* Check if we need any special handling for certain opcodes */
|
/* Check if we need any special handling for certain opcodes */
|
||||||
|
|||||||
@@ -30,7 +30,6 @@
|
|||||||
#ifdef _WIN32
|
#ifdef _WIN32
|
||||||
#include <windows.h>
|
#include <windows.h>
|
||||||
#include <shlwapi.h>
|
#include <shlwapi.h>
|
||||||
#include <versionhelpers.h>
|
|
||||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||||
#endif
|
#endif
|
||||||
@@ -147,9 +146,8 @@ static void setup_console_output(void) {
|
|||||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||||
DWORD dwMode = 0;
|
DWORD dwMode = 0;
|
||||||
GetConsoleMode(hOut, &dwMode);
|
GetConsoleMode(hOut, &dwMode);
|
||||||
if (IsWindows10OrGreater()) {
|
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
dwMode |= ENABLE_PROCESSED_OUTPUT;
|
||||||
}
|
|
||||||
SetConsoleMode(hOut, dwMode);
|
SetConsoleMode(hOut, dwMode);
|
||||||
if (IsValidCodePage(65001)) {
|
if (IsValidCodePage(65001)) {
|
||||||
SetConsoleOutputCP(65001);
|
SetConsoleOutputCP(65001);
|
||||||
@@ -165,10 +163,8 @@ static int rawmode(void) {
|
|||||||
dwMode &= ~ENABLE_LINE_INPUT;
|
dwMode &= ~ENABLE_LINE_INPUT;
|
||||||
dwMode &= ~ENABLE_INSERT_MODE;
|
dwMode &= ~ENABLE_INSERT_MODE;
|
||||||
dwMode &= ~ENABLE_ECHO_INPUT;
|
dwMode &= ~ENABLE_ECHO_INPUT;
|
||||||
if (IsWindows10OrGreater()) {
|
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
|
dwMode &= ~ENABLE_PROCESSED_INPUT;
|
||||||
dwMode &= ~ENABLE_PROCESSED_INPUT;
|
|
||||||
}
|
|
||||||
if (!SetConsoleMode(hOut, dwMode)) return 1;
|
if (!SetConsoleMode(hOut, dwMode)) return 1;
|
||||||
gbl_israwmode = 1;
|
gbl_israwmode = 1;
|
||||||
return 0;
|
return 0;
|
||||||
@@ -183,10 +179,8 @@ static void norawmode(void) {
|
|||||||
dwMode |= ENABLE_LINE_INPUT;
|
dwMode |= ENABLE_LINE_INPUT;
|
||||||
dwMode |= ENABLE_INSERT_MODE;
|
dwMode |= ENABLE_INSERT_MODE;
|
||||||
dwMode |= ENABLE_ECHO_INPUT;
|
dwMode |= ENABLE_ECHO_INPUT;
|
||||||
if (IsWindows10OrGreater()) {
|
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||||
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
|
dwMode |= ENABLE_PROCESSED_INPUT;
|
||||||
dwMode |= ENABLE_PROCESSED_INPUT;
|
|
||||||
}
|
|
||||||
SetConsoleMode(hOut, dwMode);
|
SetConsoleMode(hOut, dwMode);
|
||||||
gbl_israwmode = 0;
|
gbl_israwmode = 0;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -323,11 +323,27 @@
|
|||||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
|
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
|
||||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]) @[1111 2222 3333]))
|
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]) @[1111 2222 3333]))
|
||||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000]) @[11111 22222 33333]))
|
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000]) @[11111 22222 33333]))
|
||||||
|
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000] [100000 200000 300000]) @[111111 222222 333333]))
|
||||||
|
|
||||||
# Mapping uses the shortest sequence
|
# Mapping uses the shortest sequence
|
||||||
(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
|
(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
|
||||||
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
|
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
|
||||||
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
|
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
|
||||||
|
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000] []) @[]))
|
||||||
|
|
||||||
|
# Variadic arguments to map-like functions
|
||||||
|
(assert (deep= (mapcat tuple [1 2 3 4] [5 6 7 8]) @[1 5 2 6 3 7 4 8]))
|
||||||
|
(assert (deep= (keep |(if (> $1 0) (/ $0 $1)) [1 2 3 4 5] [1 2 1 0 1]) @[1 1 3 5]))
|
||||||
|
|
||||||
|
(assert (= (count = [1 3 2 4 3 5 4 2 1] [1 2 3 4 5 4 3 2 1]) 4))
|
||||||
|
|
||||||
|
(assert (= (some not= (range 5) (range 5)) nil))
|
||||||
|
(assert (= (some = [1 2 3 4 5] [5 4 3 2 1]) true))
|
||||||
|
|
||||||
|
(assert (= (all = (range 5) (range 5)) true))
|
||||||
|
(assert (= (all not= [1 2 3 4 5] [5 4 3 2 1]) false))
|
||||||
|
|
||||||
|
(assert (= false (deep-not= [1] [1])) "issue #1149")
|
||||||
|
|
||||||
# Sort function
|
# Sort function
|
||||||
(assert (deep=
|
(assert (deep=
|
||||||
@@ -358,4 +374,11 @@
|
|||||||
(assert (= (or 1) 1) "or 1")
|
(assert (= (or 1) 1) "or 1")
|
||||||
(assert (= (or) nil) "or with no arguments")
|
(assert (= (or) nil) "or with no arguments")
|
||||||
|
|
||||||
|
(def yielder
|
||||||
|
(coro
|
||||||
|
(defer (yield :end)
|
||||||
|
(repeat 5 (yield :item)))))
|
||||||
|
(def items (seq [x :in yielder] x))
|
||||||
|
(assert (deep= @[:item :item :item :item :item :end] items) "yield within nested fibers")
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|||||||
@@ -52,6 +52,11 @@
|
|||||||
(def retval (os/proc-wait p))
|
(def retval (os/proc-wait p))
|
||||||
(assert (not= retval 24) "Process was *not* terminated by parent"))
|
(assert (not= retval 24) "Process was *not* terminated by parent"))
|
||||||
|
|
||||||
|
(let [p (os/spawn [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"))
|
||||||
|
|
||||||
# Parallel subprocesses
|
# Parallel subprocesses
|
||||||
|
|
||||||
(defn calc-1
|
(defn calc-1
|
||||||
@@ -97,6 +102,20 @@
|
|||||||
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
|
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
|
||||||
(file/flush f)))
|
(file/flush f)))
|
||||||
|
|
||||||
|
# each-line iterator
|
||||||
|
|
||||||
|
(assert-no-error "file/lines iterator"
|
||||||
|
(def outstream (os/open "unique.txt" :wct))
|
||||||
|
(def buf1 "123\n456\n")
|
||||||
|
(defer (:close outstream)
|
||||||
|
(:write outstream buf1))
|
||||||
|
(var buf2 "")
|
||||||
|
(with [f (file/open "unique.txt" :r)]
|
||||||
|
(each line (file/lines f)
|
||||||
|
(set buf2 (string buf2 line))))
|
||||||
|
(assert (= buf1 buf2) "file/lines iterator")
|
||||||
|
(os/rm "unique.txt"))
|
||||||
|
|
||||||
# Issue #593
|
# Issue #593
|
||||||
(assert-no-error "file writing 3"
|
(assert-no-error "file writing 3"
|
||||||
(def outfile (file/open "unique.txt" :w))
|
(def outfile (file/open "unique.txt" :w))
|
||||||
|
|||||||
@@ -28,7 +28,8 @@
|
|||||||
(assert (= (thunk) 1) "delay 3")
|
(assert (= (thunk) 1) "delay 3")
|
||||||
(assert (= counter 1) "delay 4")
|
(assert (= counter 1) "delay 4")
|
||||||
|
|
||||||
(def has-ffi (dyn 'ffi/native))
|
# We should get ARM support...
|
||||||
|
(def has-ffi (and (dyn 'ffi/native) (= (os/arch) :x64)))
|
||||||
|
|
||||||
# FFI check
|
# FFI check
|
||||||
(compwhen has-ffi
|
(compwhen has-ffi
|
||||||
|
|||||||
@@ -4,7 +4,7 @@
|
|||||||
(start-suite 15)
|
(start-suite 15)
|
||||||
|
|
||||||
(assert (deep= (in (disasm (defn a [] (def x 10) x)) :symbolmap)
|
(assert (deep= (in (disasm (defn a [] (def x 10) x)) :symbolmap)
|
||||||
@[[0 3 0 'a] [1 3 1 'x]])
|
@[[0 2 0 'a] [0 2 1 'x]])
|
||||||
"symbolslots when *debug* is true")
|
"symbolslots when *debug* is true")
|
||||||
|
|
||||||
(defn a [arg]
|
(defn a [arg]
|
||||||
@@ -33,11 +33,11 @@
|
|||||||
(def y 20)
|
(def y 20)
|
||||||
(def z 30)
|
(def z 30)
|
||||||
(+ x y z)))) :symbolmap)
|
(+ x y z)))) :symbolmap)
|
||||||
@[[0 7 0 'arg]
|
@[[0 6 0 'arg]
|
||||||
[0 7 1 'a]
|
[0 6 1 'a]
|
||||||
[1 7 2 'x]
|
[0 6 2 'x]
|
||||||
[2 7 3 'y]
|
[1 6 3 'y]
|
||||||
[3 7 4 'z]])
|
[2 6 4 'z]])
|
||||||
"arg & inner symbolslots")
|
"arg & inner symbolslots")
|
||||||
|
|
||||||
# buffer/push-at
|
# buffer/push-at
|
||||||
@@ -45,4 +45,6 @@
|
|||||||
(assert (deep= @"abc456789" (buffer/push-at @"abc123" 3 "456789")) "buffer/push-at 2")
|
(assert (deep= @"abc456789" (buffer/push-at @"abc123" 3 "456789")) "buffer/push-at 2")
|
||||||
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4")) "buffer/push-at 3")
|
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4")) "buffer/push-at 3")
|
||||||
|
|
||||||
|
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|||||||
Reference in New Issue
Block a user