mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-01-12 16:40:27 +00:00
Code Issues 1 Releases Wiki Activity

Add make format to format code.

Browse Source 
A consistent style should help with contributors and
readability. We use astyle as the formatter as can make a pretty
good approximation of the current style and my preferred style.

Astyle can be found at http://astyle.sourceforge.net/astyle.html
This commit is contained in:
Calvin Rose 2019-02-19 20:51:34 -05:00
parent 7c19ed8a48
commit 9d4effc02e
37 changed files with 2472 additions and 2503 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Makefile
View File

@ -209,6 +209,13 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
##### Other ##### ##### Other #####
################# #################
STYLEOPTS=--style=attach --indent-switches --convert-tabs \
--align-pointer=name --pad-header --pad-oper --unpad-paren --indent-labels
format:
astyle $(STYLEOPTS) */*.c
astyle $(STYLEOPTS) */*/*.c
astyle $(STYLEOPTS) */*/*.h
grammar: build/janet.tmLanguage grammar: build/janet.tmLanguage
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET) build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
$(JANET_TARGET) $< > $@ $(JANET_TARGET) $< > $@
@ -236,5 +243,5 @@ uninstall:
-rm -rf $(INCLUDEDIR) -rm -rf $(INCLUDEDIR)
.PHONY: clean install repl debug valgrind test amalg \ .PHONY: clean install repl debug valgrind test amalg \
valtest emscripten dist uninstall docs grammar \ valtest emscripten dist uninstall docs grammar format \
$(TEST_PROGRAM_PHONIES) $(TEST_PROGRAM_VALPHONIES) $(TEST_PROGRAM_PHONIES) $(TEST_PROGRAM_VALPHONIES)

50
examples/numarray/numarray.c
View File

@ -2,23 +2,23 @@
#include <janet.h> #include <janet.h>
typedef struct { typedef struct {
double * data; double *data;
size_t size; size_t size;
} num_array; } num_array;
static num_array * num_array_init(num_array * array,size_t size) { static num_array *num_array_init(num_array *array, size_t size) {
array->data=(double *)calloc(size,sizeof(double)); array->data = (double *)calloc(size, sizeof(double));
array->size=size; array->size = size;
return array; return array;
} }
static void num_array_deinit(num_array * array) { static void num_array_deinit(num_array *array) {
free(array->data); free(array->data);
} }
static int num_array_gc(void *p, size_t s) { static int num_array_gc(void *p, size_t s) {
(void) s; (void) s;
num_array * array=(num_array *)p; num_array *array = (num_array *)p;
num_array_deinit(array); num_array_deinit(array);
return 0; return 0;
} }
@ -36,42 +36,42 @@ static const JanetAbstractType num_array_type = {
static Janet num_array_new(int32_t argc, Janet *argv) { static Janet num_array_new(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
int32_t size=janet_getinteger(argv,0); int32_t size = janet_getinteger(argv, 0);
num_array * array = (num_array *)janet_abstract(&num_array_type,sizeof(num_array)); num_array *array = (num_array *)janet_abstract(&num_array_type, sizeof(num_array));
num_array_init(array,size); num_array_init(array, size);
return janet_wrap_abstract(array); return janet_wrap_abstract(array);
} }
static Janet num_array_scale(int32_t argc, Janet *argv) { static Janet num_array_scale(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
num_array * array = (num_array *)janet_getabstract(argv,0,&num_array_type); num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
double factor = janet_getnumber(argv,1); double factor = janet_getnumber(argv, 1);
size_t i; size_t i;
for (i=0;i<array->size;i++) { for (i = 0; i < array->size; i++) {
array->data[i]*=factor; array->data[i] *= factor;
} }
return argv[0]; return argv[0];
} }
static Janet num_array_sum(int32_t argc, Janet *argv) { static Janet num_array_sum(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
num_array * array = (num_array *)janet_getabstract(argv,0,&num_array_type); num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
double sum = 0; double sum = 0;
for (size_t i=0;i<array->size;i++) sum+=array->data[i]; for (size_t i = 0; i < array->size; i++) sum += array->data[i];
return janet_wrap_number(sum); return janet_wrap_number(sum);
} }
void num_array_put(void *p, Janet key, Janet value) { void num_array_put(void *p, Janet key, Janet value) {
size_t index; size_t index;
num_array * array=(num_array *)p; num_array *array = (num_array *)p;
if (!janet_checkint(key)) if (!janet_checkint(key))
janet_panic("expected integer key"); janet_panic("expected integer key");
if (!janet_checktype(value,JANET_NUMBER)) if (!janet_checktype(value, JANET_NUMBER))
janet_panic("expected number value"); janet_panic("expected number value");
index = (size_t)janet_unwrap_integer(key); index = (size_t)janet_unwrap_integer(key);
if (index < array->size) { if (index < array->size) {
array->data[index]=janet_unwrap_number(value); array->data[index] = janet_unwrap_number(value);
} }
} }
@ -84,7 +84,7 @@ static const JanetMethod methods[] = {
Janet num_array_get(void *p, Janet key) { Janet num_array_get(void *p, Janet key) {
size_t index; size_t index;
Janet value; Janet value;
num_array * array=(num_array *)p; num_array *array = (num_array *)p;
if (janet_checktype(key, JANET_KEYWORD)) if (janet_checktype(key, JANET_KEYWORD))
return janet_getmethod(janet_unwrap_keyword(key), methods); return janet_getmethod(janet_unwrap_keyword(key), methods);
if (!janet_checkint(key)) if (!janet_checkint(key))
@ -99,15 +99,17 @@ Janet num_array_get(void *p, Janet key) {
} }
static const JanetReg cfuns[] = { static const JanetReg cfuns[] = {
{"numarray/new", num_array_new, {
"numarray/new", num_array_new,
"(numarray/new size)\n\n" "(numarray/new size)\n\n"
"Create new numarray" "Create new numarray"
}, },
{"numarray/scale", num_array_scale, {
"numarray/scale", num_array_scale,
"(numarray/scale numarray factor)\n\n" "(numarray/scale numarray factor)\n\n"
"scale numarray by factor" "scale numarray by factor"
}, },
{NULL,NULL,NULL} {NULL, NULL, NULL}
}; };
JANET_MODULE_ENTRY(JanetTable *env) { JANET_MODULE_ENTRY(JanetTable *env) {

85
src/core/array.c
View File

@ -180,15 +180,14 @@ static Janet cfun_array_concat(int32_t argc, Janet *argv) {
janet_array_push(array, argv[i]); janet_array_push(array, argv[i]);
break; break;
case JANET_ARRAY: case JANET_ARRAY:
case JANET_TUPLE: case JANET_TUPLE: {
{ int32_t j, len;
int32_t j, len; const Janet *vals;
const Janet *vals; janet_indexed_view(argv[i], &vals, &len);
janet_indexed_view(argv[i], &vals, &len); for (j = 0; j < len; j++)
for (j = 0; j < len; j++) janet_array_push(array, vals[j]);
janet_array_push(array, vals[j]); }
} break;
break;
} }
} }
return janet_wrap_array(array); return janet_wrap_array(array);
@ -216,51 +215,59 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
} }
static const JanetReg array_cfuns[] = { static const JanetReg array_cfuns[] = {
{"array/new", cfun_array_new, {
"array/new", cfun_array_new,
JDOC("(array/new capacity)\n\n" JDOC("(array/new capacity)\n\n"
"Creates a new empty array with a pre-allocated capacity. The same as " "Creates a new empty array with a pre-allocated capacity. The same as "
"(array) but can be more efficient if the maximum size of an array is known.") "(array) but can be more efficient if the maximum size of an array is known.")
}, },
{"array/pop", cfun_array_pop, {
"array/pop", cfun_array_pop,
JDOC("(array/pop arr)\n\n" JDOC("(array/pop arr)\n\n"
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies " "Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
"the input array.") "the input array.")
}, },
{"array/peek", cfun_array_peek, {
"array/peek", cfun_array_peek,
JDOC("(array/peek arr)\n\n" JDOC("(array/peek arr)\n\n"
"Returns the last element of the array. Does not modify the array.") "Returns the last element of the array. Does not modify the array.")
}, },
{"array/push", cfun_array_push, {
"array/push", cfun_array_push,
JDOC("(array/push arr x)\n\n" JDOC("(array/push arr x)\n\n"
"Insert an element in the end of an array. Modifies the input array and returns it.") "Insert an element in the end of an array. Modifies the input array and returns it.")
}, },
{"array/ensure", cfun_array_ensure, {
"array/ensure", cfun_array_ensure,
JDOC("(array/ensure arr capacity)\n\n" JDOC("(array/ensure arr capacity)\n\n"
"Ensures that the memory backing the array has enough memory for capacity " "Ensures that the memory backing the array has enough memory for capacity "
"items. Capacity must be an integer. If the backing capacity is already enough, " "items. Capacity must be an integer. If the backing capacity is already enough, "
"then this function does nothing. Otherwise, the backing memory will be reallocated " "then this function does nothing. Otherwise, the backing memory will be reallocated "
"so that there is enough space.") "so that there is enough space.")
}, },
{"array/slice", cfun_array_slice, {
"array/slice", cfun_array_slice,
JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n" JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
"Takes a slice of array or tuple from start to end. The range is half open, " "Takes a slice of array or tuple from start to end. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the end of the " "[start, end). Indexes can also be negative, indicating indexing from the end of the "
"end of the array. By default, start is 0 and end is the length of the array. " "end of the array. By default, start is 0 and end is the length of the array. "
"Returns a new array.") "Returns a new array.")
}, },
{"array/concat", cfun_array_concat, {
"array/concat", cfun_array_concat,
JDOC("(array/concat arr & parts)\n\n" JDOC("(array/concat arr & parts)\n\n"
"Concatenates a variadic number of arrays (and tuples) into the first argument " "Concatenates a variadic number of arrays (and tuples) into the first argument "
"which must an array. If any of the parts are arrays or tuples, their elements will " "which must an array. If any of the parts are arrays or tuples, their elements will "
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. " "be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
"Return the modified array arr.") "Return the modified array arr.")
}, },
{"array/insert", cfun_array_insert, {
"array/insert", cfun_array_insert,
JDOC("(array/insert arr at & xs)\n\n" JDOC("(array/insert arr at & xs)\n\n"
"Insert all of xs into array arr at index at. at should be an integer " "Insert all of xs into array arr at index at. at should be an integer "
"0 and the length of the array. A negative value for at will index from " "0 and the length of the array. A negative value for at will index from "
"the end of the array, such that inserting at -1 appends to the array. " "the end of the array, such that inserting at -1 appends to the array. "
"Returns the array.") "Returns the array.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

150
src/core/asm.c
View File

@ -224,9 +224,9 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
/* Parse an argument to an assembly instruction, and return the result as an /* Parse an argument to an assembly instruction, and return the result as an
* integer. This integer will need to be bounds checked. */ * integer. This integer will need to be bounds checked. */
static int32_t doarg_1( static int32_t doarg_1(
JanetAssembler *a, JanetAssembler *a,
enum JanetOpArgType argtype, enum JanetOpArgType argtype,
Janet x) { Janet x) {
int32_t ret = -1; int32_t ret = -1;
JanetTable *c; JanetTable *c;
switch (argtype) { switch (argtype) {
@ -253,8 +253,7 @@ static int32_t doarg_1(
default: default:
goto error; goto error;
break; break;
case JANET_NUMBER: case JANET_NUMBER: {
{
double y = janet_unwrap_number(x); double y = janet_unwrap_number(x);
if (janet_checkintrange(y)) { if (janet_checkintrange(y)) {
ret = (int32_t) y; ret = (int32_t) y;
@ -263,8 +262,7 @@ static int32_t doarg_1(
} }
break; break;
} }
case JANET_TUPLE: case JANET_TUPLE: {
{
const Janet *t = janet_unwrap_tuple(x); const Janet *t = janet_unwrap_tuple(x);
if (argtype == JANET_OAT_TYPE) { if (argtype == JANET_OAT_TYPE) {
int32_t i = 0; int32_t i = 0;
@ -277,8 +275,7 @@ static int32_t doarg_1(
} }
break; break;
} }
case JANET_KEYWORD: case JANET_KEYWORD: {
{
if (NULL != c && argtype == JANET_OAT_LABEL) { if (NULL != c && argtype == JANET_OAT_LABEL) {
Janet result = janet_table_get(c, x); Janet result = janet_table_get(c, x);
if (janet_checktype(result, JANET_NUMBER)) { if (janet_checktype(result, JANET_NUMBER)) {
@ -288,10 +285,10 @@ static int32_t doarg_1(
} }
} else if (argtype == JANET_OAT_TYPE || argtype == JANET_OAT_SIMPLETYPE) { } else if (argtype == JANET_OAT_TYPE || argtype == JANET_OAT_SIMPLETYPE) {
const TypeAlias *alias = janet_strbinsearch( const TypeAlias *alias = janet_strbinsearch(
&type_aliases, &type_aliases,
sizeof(type_aliases)/sizeof(TypeAlias), sizeof(type_aliases) / sizeof(TypeAlias),
sizeof(TypeAlias), sizeof(TypeAlias),
janet_unwrap_keyword(x)); janet_unwrap_keyword(x));
if (alias) { if (alias) {
ret = alias->mask; ret = alias->mask;
} else { } else {
@ -302,8 +299,7 @@ static int32_t doarg_1(
} }
break; break;
} }
case JANET_SYMBOL: case JANET_SYMBOL: {
{
if (NULL != c) { if (NULL != c) {
Janet result = janet_table_get(c, x); Janet result = janet_table_get(c, x);
if (janet_checktype(result, JANET_NUMBER)) { if (janet_checktype(result, JANET_NUMBER)) {
@ -328,7 +324,7 @@ static int32_t doarg_1(
a->def->slotcount = (int32_t) ret + 1; a->def->slotcount = (int32_t) ret + 1;
return ret; return ret;
error: error:
janet_asm_errorv(a, janet_formatc("error parsing instruction argument %v", x)); janet_asm_errorv(a, janet_formatc("error parsing instruction argument %v", x));
return 0; return 0;
} }
@ -336,12 +332,12 @@ static int32_t doarg_1(
/* Parse a single argument to an instruction. Trims it as well as /* Parse a single argument to an instruction. Trims it as well as
* try to convert arguments to bit patterns */ * try to convert arguments to bit patterns */
static uint32_t doarg( static uint32_t doarg(
JanetAssembler *a, JanetAssembler *a,
enum JanetOpArgType argtype, enum JanetOpArgType argtype,
int nth, int nth,
int nbytes, int nbytes,
int hassign, int hassign,
Janet x) { Janet x) {
int32_t arg = doarg_1(a, argtype, x); int32_t arg = doarg_1(a, argtype, x);
/* Calculate the min and max values that can be stored given /* Calculate the min and max values that can be stored given
* nbytes, and whether or not the storage is signed */ * nbytes, and whether or not the storage is signed */
@ -349,59 +345,53 @@ static uint32_t doarg(
int32_t min = hassign ? -max - 1 : 0; int32_t min = hassign ? -max - 1 : 0;
if (arg < min) if (arg < min)
janet_asm_errorv(a, janet_formatc("instruction argument %v is too small, must be %d byte%s", janet_asm_errorv(a, janet_formatc("instruction argument %v is too small, must be %d byte%s",
x, nbytes, nbytes > 1 ? "s" : "")); x, nbytes, nbytes > 1 ? "s" : ""));
if (arg > max) if (arg > max)
janet_asm_errorv(a, janet_formatc("instruction argument %v is too large, must be %d byte%s", janet_asm_errorv(a, janet_formatc("instruction argument %v is too large, must be %d byte%s",
x, nbytes, nbytes > 1 ? "s" : "")); x, nbytes, nbytes > 1 ? "s" : ""));
return ((uint32_t) arg) << (nth << 3); return ((uint32_t) arg) << (nth << 3);
} }
/* Provide parsing methods for the different kinds of arguments */ /* Provide parsing methods for the different kinds of arguments */
static uint32_t read_instruction( static uint32_t read_instruction(
JanetAssembler *a, JanetAssembler *a,
const JanetInstructionDef *idef, const JanetInstructionDef *idef,
const Janet *argt) { const Janet *argt) {
uint32_t instr = idef->opcode; uint32_t instr = idef->opcode;
enum JanetInstructionType type = janet_instructions[idef->opcode]; enum JanetInstructionType type = janet_instructions[idef->opcode];
switch (type) { switch (type) {
case JINT_0: case JINT_0: {
{
if (janet_tuple_length(argt) != 1) if (janet_tuple_length(argt) != 1)
janet_asm_error(a, "expected 0 arguments: (op)"); janet_asm_error(a, "expected 0 arguments: (op)");
break; break;
} }
case JINT_S: case JINT_S: {
{
if (janet_tuple_length(argt) != 2) if (janet_tuple_length(argt) != 2)
janet_asm_error(a, "expected 1 argument: (op, slot)"); janet_asm_error(a, "expected 1 argument: (op, slot)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 2, 0, argt[1]); instr |= doarg(a, JANET_OAT_SLOT, 1, 2, 0, argt[1]);
break; break;
} }
case JINT_L: case JINT_L: {
{
if (janet_tuple_length(argt) != 2) if (janet_tuple_length(argt) != 2)
janet_asm_error(a, "expected 1 argument: (op, label)"); janet_asm_error(a, "expected 1 argument: (op, label)");
instr |= doarg(a, JANET_OAT_LABEL, 1, 3, 1, argt[1]); instr |= doarg(a, JANET_OAT_LABEL, 1, 3, 1, argt[1]);
break; break;
} }
case JINT_SS: case JINT_SS: {
{
if (janet_tuple_length(argt) != 3) if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, slot)"); janet_asm_error(a, "expected 2 arguments: (op, slot, slot)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]); instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_SLOT, 2, 2, 0, argt[2]); instr |= doarg(a, JANET_OAT_SLOT, 2, 2, 0, argt[2]);
break; break;
} }
case JINT_SL: case JINT_SL: {
{
if (janet_tuple_length(argt) != 3) if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, label)"); janet_asm_error(a, "expected 2 arguments: (op, slot, label)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]); instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_LABEL, 2, 2, 1, argt[2]); instr |= doarg(a, JANET_OAT_LABEL, 2, 2, 1, argt[2]);
break; break;
} }
case JINT_ST: case JINT_ST: {
{
if (janet_tuple_length(argt) != 3) if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, type)"); janet_asm_error(a, "expected 2 arguments: (op, slot, type)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]); instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
@ -409,24 +399,21 @@ static uint32_t read_instruction(
break; break;
} }
case JINT_SI: case JINT_SI:
case JINT_SU: case JINT_SU: {
{
if (janet_tuple_length(argt) != 3) if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, integer)"); janet_asm_error(a, "expected 2 arguments: (op, slot, integer)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]); instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_INTEGER, 2, 2, type == JINT_SI, argt[2]); instr |= doarg(a, JANET_OAT_INTEGER, 2, 2, type == JINT_SI, argt[2]);
break; break;
} }
case JINT_SD: case JINT_SD: {
{
if (janet_tuple_length(argt) != 3) if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, funcdef)"); janet_asm_error(a, "expected 2 arguments: (op, slot, funcdef)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]); instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, JANET_OAT_FUNCDEF, 2, 2, 0, argt[2]); instr |= doarg(a, JANET_OAT_FUNCDEF, 2, 2, 0, argt[2]);
break; break;
} }
case JINT_SSS: case JINT_SSS: {
{
if (janet_tuple_length(argt) != 4) if (janet_tuple_length(argt) != 4)
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)"); janet_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]); instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
@ -435,8 +422,7 @@ static uint32_t read_instruction(
break; break;
} }
case JINT_SSI: case JINT_SSI:
case JINT_SSU: case JINT_SSU: {
{
if (janet_tuple_length(argt) != 4) if (janet_tuple_length(argt) != 4)
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)"); janet_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]); instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
@ -444,8 +430,7 @@ static uint32_t read_instruction(
instr |= doarg(a, JANET_OAT_INTEGER, 3, 1, type == JINT_SSI, argt[3]); instr |= doarg(a, JANET_OAT_INTEGER, 3, 1, type == JINT_SSI, argt[3]);
break; break;
} }
case JINT_SES: case JINT_SES: {
{
JanetAssembler *b = a; JanetAssembler *b = a;
uint32_t env; uint32_t env;
if (janet_tuple_length(argt) != 4) if (janet_tuple_length(argt) != 4)
@ -461,8 +446,7 @@ static uint32_t read_instruction(
instr |= doarg(b, JANET_OAT_SLOT, 3, 1, 0, argt[3]); instr |= doarg(b, JANET_OAT_SLOT, 3, 1, 0, argt[3]);
break; break;
} }
case JINT_SC: case JINT_SC: {
{
if (janet_tuple_length(argt) != 3) if (janet_tuple_length(argt) != 3)
janet_asm_error(a, "expected 2 arguments: (op, slot, constant)"); janet_asm_error(a, "expected 2 arguments: (op, slot, constant)");
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]); instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
@ -528,9 +512,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
} }
janet_asm_assert(&a, janet_asm_assert(&a,
janet_checktype(s, JANET_STRUCT) || janet_checktype(s, JANET_STRUCT) ||
janet_checktype(s, JANET_TABLE), janet_checktype(s, JANET_TABLE),
"expected struct or table for assembly source"); "expected struct or table for assembly source");
/* Check for function name */ /* Check for function name */
a.name = janet_get1(s, janet_csymbolv("name")); a.name = janet_get1(s, janet_csymbolv("name"));
@ -586,16 +570,16 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
for (i = 0; i < count; i++) { for (i = 0; i < count; i++) {
Janet ct = arr[i]; Janet ct = arr[i];
if (janet_checktype(ct, JANET_TUPLE) && if (janet_checktype(ct, JANET_TUPLE) &&
janet_tuple_length(janet_unwrap_tuple(ct)) > 1 && janet_tuple_length(janet_unwrap_tuple(ct)) > 1 &&
janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) { janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) {
const Janet *t = janet_unwrap_tuple(ct); const Janet *t = janet_unwrap_tuple(ct);
int32_t tcount = janet_tuple_length(t); int32_t tcount = janet_tuple_length(t);
const uint8_t *macro = janet_unwrap_symbol(t[0]); const uint8_t *macro = janet_unwrap_symbol(t[0]);
if (0 == janet_cstrcmp(macro, "quote")) { if (0 == janet_cstrcmp(macro, "quote")) {
def->constants[i] = t[1]; def->constants[i] = t[1];
} else if (tcount == 3 && } else if (tcount == 3 &&
janet_checktype(t[1], JANET_SYMBOL) && janet_checktype(t[1], JANET_SYMBOL) &&
0 == janet_cstrcmp(macro, "def")) { 0 == janet_cstrcmp(macro, "def")) {
def->constants[i] = t[2]; def->constants[i] = t[2];
janet_table_put(&a.constants, t[1], janet_wrap_integer(i)); janet_table_put(&a.constants, t[1], janet_wrap_integer(i));
} else { } else {
@ -678,12 +662,12 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
op = 0; op = 0;
} else { } else {
janet_asm_assert(&a, janet_checktype(t[0], JANET_SYMBOL), janet_asm_assert(&a, janet_checktype(t[0], JANET_SYMBOL),
"expected symbol in assembly instruction"); "expected symbol in assembly instruction");
idef = janet_strbinsearch( idef = janet_strbinsearch(
&janet_ops, &janet_ops,
sizeof(janet_ops)/sizeof(JanetInstructionDef), sizeof(janet_ops) / sizeof(JanetInstructionDef),
sizeof(JanetInstructionDef), sizeof(JanetInstructionDef),
janet_unwrap_symbol(t[0])); janet_unwrap_symbol(t[0]));
if (NULL == idef) if (NULL == idef)
janet_asm_errorv(&a, janet_formatc("unknown instruction %v", t[0])); janet_asm_errorv(&a, janet_formatc("unknown instruction %v", t[0]));
op = read_instruction(&a, idef, t); op = read_instruction(&a, idef, t);
@ -750,7 +734,7 @@ JanetAssembleResult janet_asm(Janet source, int flags) {
static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) { static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
size_t i; size_t i;
uint32_t opcode = instr & 0x7F; uint32_t opcode = instr & 0x7F;
for (i = 0; i < sizeof(janet_ops)/sizeof(JanetInstructionDef); i++) { for (i = 0; i < sizeof(janet_ops) / sizeof(JanetInstructionDef); i++) {
const JanetInstructionDef *def = janet_ops + i; const JanetInstructionDef *def = janet_ops + i;
if (def->opcode == opcode) if (def->opcode == opcode)
return def; return def;
@ -808,25 +792,25 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
case JINT_SU: case JINT_SU:
case JINT_SD: case JINT_SD:
return tup3(name, return tup3(name,
janet_wrap_integer(oparg(1, 0xFF)), janet_wrap_integer(oparg(1, 0xFF)),
janet_wrap_integer(oparg(2, 0xFFFF))); janet_wrap_integer(oparg(2, 0xFFFF)));
case JINT_SI: case JINT_SI:
case JINT_SL: case JINT_SL:
return tup3(name, return tup3(name,
janet_wrap_integer(oparg(1, 0xFF)), janet_wrap_integer(oparg(1, 0xFF)),
janet_wrap_integer((int32_t)instr >> 16)); janet_wrap_integer((int32_t)instr >> 16));
case JINT_SSS: case JINT_SSS:
case JINT_SES: case JINT_SES:
case JINT_SSU: case JINT_SSU:
return tup4(name, return tup4(name,
janet_wrap_integer(oparg(1, 0xFF)), janet_wrap_integer(oparg(1, 0xFF)),
janet_wrap_integer(oparg(2, 0xFF)), janet_wrap_integer(oparg(2, 0xFF)),
janet_wrap_integer(oparg(3, 0xFF))); janet_wrap_integer(oparg(3, 0xFF)));
case JINT_SSI: case JINT_SSI:
return tup4(name, return tup4(name,
janet_wrap_integer(oparg(1, 0xFF)), janet_wrap_integer(oparg(1, 0xFF)),
janet_wrap_integer(oparg(2, 0xFF)), janet_wrap_integer(oparg(2, 0xFF)),
janet_wrap_integer((int32_t)instr >> 24)); janet_wrap_integer((int32_t)instr >> 24));
} }
#undef oparg #undef oparg
return janet_wrap_nil(); return janet_wrap_nil();
@ -934,17 +918,19 @@ static Janet cfun_disasm(int32_t argc, Janet *argv) {
} }
static const JanetReg asm_cfuns[] = { static const JanetReg asm_cfuns[] = {
{"asm", cfun_asm, {
"asm", cfun_asm,
JDOC("(asm assembly)\n\n" JDOC("(asm assembly)\n\n"
"Returns a new function that is the compiled result of the assembly.\n" "Returns a new function that is the compiled result of the assembly.\n"
"The syntax for the assembly can be found on the janet wiki. Will throw an\n" "The syntax for the assembly can be found on the janet wiki. Will throw an\n"
"error on invalid assembly.") "error on invalid assembly.")
}, },
{"disasm", cfun_disasm, {
"disasm", cfun_disasm,
JDOC("(disasm func)\n\n" JDOC("(disasm func)\n\n"
"Returns assembly that could be used be compile the given function.\n" "Returns assembly that could be used be compile the given function.\n"
"func must be a function, not a c function. Will throw on error on a badly\n" "func must be a function, not a c function. Will throw on error on a badly\n"
"typed argument.") "typed argument.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

100
src/core/buffer.c
View File

@ -182,7 +182,7 @@ static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1); janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0); JanetBuffer *buffer = janet_getbuffer(argv, 0);
for (i = 1; i < argc; i++) { for (i = 1; i < argc; i++) {
janet_buffer_push_u8(buffer, (uint8_t) (janet_getinteger(argv, i) & 0xFF)); janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
} }
return argv[0]; return argv[0];
} }
@ -326,75 +326,89 @@ static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
} }
static const JanetReg buffer_cfuns[] = { static const JanetReg buffer_cfuns[] = {
{"buffer/new", cfun_buffer_new, {
"buffer/new", cfun_buffer_new,
JDOC("(buffer/new capacity)\n\n" JDOC("(buffer/new capacity)\n\n"
"Creates a new, empty buffer with enough memory for capacity bytes. " "Creates a new, empty buffer with enough memory for capacity bytes. "
"Returns a new buffer.") "Returns a new buffer.")
}, },
{"buffer/new-filled", cfun_buffer_new_filled, {
"buffer/new-filled", cfun_buffer_new_filled,
JDOC("(buffer/new-filled count [, byte=0])\n\n" JDOC("(buffer/new-filled count [, byte=0])\n\n"
"Creates a new buffer of length count filled with byte. " "Creates a new buffer of length count filled with byte. "
"Returns the new buffer.") "Returns the new buffer.")
}, },
{"buffer/push-byte", cfun_buffer_u8, {
"buffer/push-byte", cfun_buffer_u8,
JDOC("(buffer/push-byte buffer x)\n\n" JDOC("(buffer/push-byte buffer x)\n\n"
"Append a byte to a buffer. Will expand the buffer as necessary. " "Append a byte to a buffer. Will expand the buffer as necessary. "
"Returns the modified buffer. Will throw an error if the buffer overflows.") "Returns the modified buffer. Will throw an error if the buffer overflows.")
}, },
{"buffer/push-word", cfun_buffer_word, {
"buffer/push-word", cfun_buffer_word,
JDOC("(buffer/push-word buffer x)\n\n" JDOC("(buffer/push-word buffer x)\n\n"
"Append a machine word to a buffer. The 4 bytes of the integer are appended " "Append a machine word to a buffer. The 4 bytes of the integer are appended "
"in twos complement, big endian order, unsigned. Returns the modified buffer. Will " "in twos complement, big endian order, unsigned. Returns the modified buffer. Will "
"throw an error if the buffer overflows.") "throw an error if the buffer overflows.")
}, },
{"buffer/push-string", cfun_buffer_chars, {
"buffer/push-string", cfun_buffer_chars,
JDOC("(buffer/push-string buffer str)\n\n" JDOC("(buffer/push-string buffer str)\n\n"
"Push a string onto the end of a buffer. Non string values will be converted " "Push a string onto the end of a buffer. Non string values will be converted "
"to strings before being pushed. Returns the modified buffer. " "to strings before being pushed. Returns the modified buffer. "
"Will throw an error if the buffer overflows.") "Will throw an error if the buffer overflows.")
}, },
{"buffer/popn", cfun_buffer_popn, {
"buffer/popn", cfun_buffer_popn,
JDOC("(buffer/popn buffer n)\n\n" JDOC("(buffer/popn buffer n)\n\n"
"Removes the last n bytes from the buffer. Returns the modified buffer.") "Removes the last n bytes from the buffer. Returns the modified buffer.")
}, },
{"buffer/clear", cfun_buffer_clear, {
"buffer/clear", cfun_buffer_clear,
JDOC("(buffer/clear buffer)\n\n" JDOC("(buffer/clear buffer)\n\n"
"Sets the size of a buffer to 0 and empties it. The buffer retains " "Sets the size of a buffer to 0 and empties it. The buffer retains "
"its memory so it can be efficiently refilled. Returns the modified buffer.") "its memory so it can be efficiently refilled. Returns the modified buffer.")
}, },
{"buffer/slice", cfun_buffer_slice, {
"buffer/slice", cfun_buffer_slice,
JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n" JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
"Takes a slice of a byte sequence from start to end. The range is half open, " "Takes a slice of a byte sequence from start to end. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the end of the " "[start, end). Indexes can also be negative, indicating indexing from the end of the "
"end of the array. By default, start is 0 and end is the length of the buffer. " "end of the array. By default, start is 0 and end is the length of the buffer. "
"Returns a new buffer.") "Returns a new buffer.")
}, },
{"buffer/bit-set", cfun_buffer_bitset, {
"buffer/bit-set", cfun_buffer_bitset,
JDOC("(buffer/bit-set buffer index)\n\n" JDOC("(buffer/bit-set buffer index)\n\n"
"Sets the bit at the given bit-index. Returns the buffer.") "Sets the bit at the given bit-index. Returns the buffer.")
}, },
{"buffer/bit-clear", cfun_buffer_bitclear, {
"buffer/bit-clear", cfun_buffer_bitclear,
JDOC("(buffer/bit-clear buffer index)\n\n" JDOC("(buffer/bit-clear buffer index)\n\n"
"Clears the bit at the given bit-index. Returns the buffer.") "Clears the bit at the given bit-index. Returns the buffer.")
}, },
{"buffer/bit", cfun_buffer_bitget, {
"buffer/bit", cfun_buffer_bitget,
JDOC("(buffer/bit buffer index)\n\n" JDOC("(buffer/bit buffer index)\n\n"
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.") "Gets the bit at the given bit-index. Returns true if the bit is set, false if not.")
}, },
{"buffer/bit-toggle", cfun_buffer_bittoggle, {
"buffer/bit-toggle", cfun_buffer_bittoggle,
JDOC("(buffer/bit-toggle buffer index)\n\n" JDOC("(buffer/bit-toggle buffer index)\n\n"
"Toggles the bit at the given bit index in buffer. Returns the buffer.") "Toggles the bit at the given bit index in buffer. Returns the buffer.")
}, },
{"buffer/blit", cfun_buffer_blit, {
"buffer/blit", cfun_buffer_blit,
JDOC("(buffer/blit dest src [, dest-start=0 [, src-start=0 [, src-end=-1]]])\n\n" JDOC("(buffer/blit dest src [, dest-start=0 [, src-start=0 [, src-end=-1]]])\n\n"
"Insert the contents of src into dest. Can optionally take indices that " "Insert the contents of src into dest. Can optionally take indices that "
"indicate which part of src to copy into which part of dest. Indices can be " "indicate which part of src to copy into which part of dest. Indices can be "
"negative to index from the end of src or dest. Returns dest.") "negative to index from the end of src or dest. Returns dest.")
}, },
{"buffer/format", cfun_buffer_format, {
"buffer/format", cfun_buffer_format,
JDOC("(buffer/format buffer format & args)\n\n" JDOC("(buffer/format buffer format & args)\n\n"
"Snprintf like functionality for printing values into a buffer. Returns " "Snprintf like functionality for printing values into a buffer. Returns "
" the modified buffer.") " the modified buffer.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

108
src/core/bytecode.c
View File

@ -118,72 +118,62 @@ int32_t janet_verify(JanetFuncDef *def) {
switch (type) { switch (type) {
case JINT_0: case JINT_0:
continue; continue;
case JINT_S: case JINT_S: {
{ if ((int32_t)(instr >> 8) >= sc) return 4;
if ((int32_t)(instr >> 8) >= sc) return 4; continue;
continue; }
}
case JINT_SI: case JINT_SI:
case JINT_SU: case JINT_SU:
case JINT_ST: case JINT_ST: {
{ if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4; continue;
continue; }
} case JINT_L: {
case JINT_L: int32_t jumpdest = i + (((int32_t)instr) >> 8);
{ if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
int32_t jumpdest = i + (((int32_t)instr) >> 8); continue;
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5; }
continue; case JINT_SS: {
} if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
case JINT_SS:
{
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
(int32_t)(instr >> 16) >= sc) return 4; (int32_t)(instr >> 16) >= sc) return 4;
continue; continue;
} }
case JINT_SSI: case JINT_SSI:
case JINT_SSU: case JINT_SSU: {
{ if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
(int32_t)((instr >> 16) & 0xFF) >= sc) return 4; (int32_t)((instr >> 16) & 0xFF) >= sc) return 4;
continue; continue;
} }
case JINT_SL: case JINT_SL: {
{ int32_t jumpdest = i + (((int32_t)instr) >> 16);
int32_t jumpdest = i + (((int32_t)instr) >> 16); if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4; if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5; continue;
continue; }
} case JINT_SSS: {
case JINT_SSS: if (((int32_t)(instr >> 8) & 0xFF) >= sc ||
{
if (((int32_t)(instr >> 8) & 0xFF) >= sc ||
((int32_t)(instr >> 16) & 0xFF) >= sc || ((int32_t)(instr >> 16) & 0xFF) >= sc ||
((int32_t)(instr >> 24) & 0xFF) >= sc) return 4; ((int32_t)(instr >> 24) & 0xFF) >= sc) return 4;
continue; continue;
} }
case JINT_SD: case JINT_SD: {
{ if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4; if ((int32_t)(instr >> 16) >= def->defs_length) return 6;
if ((int32_t)(instr >> 16) >= def->defs_length) return 6; continue;
continue; }
} case JINT_SC: {
case JINT_SC: if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
{ if ((int32_t)(instr >> 16) >= def->constants_length) return 7;
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4; continue;
if ((int32_t)(instr >> 16) >= def->constants_length) return 7; }
continue; case JINT_SES: {
} /* How can we check the last slot index? We need info parent funcdefs. Resort
case JINT_SES: * to runtime checks for now. Maybe invalid upvalue references could be defaulted
{ * to nil? (don't commit to this in the long term, though) */
/* How can we check the last slot index? We need info parent funcdefs. Resort if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
* to runtime checks for now. Maybe invalid upvalue references could be defaulted if ((int32_t)((instr >> 16) & 0xFF) >= def->environments_length) return 8;
* to nil? (don't commit to this in the long term, though) */ continue;
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4; }
if ((int32_t)((instr >> 16) & 0xFF) >= def->environments_length) return 8;
continue;
}
} }
} }

26
src/core/cfuns.c
View File

@ -64,10 +64,10 @@ static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
/* Emit a series of instructions instead of a function call to a math op */ /* Emit a series of instructions instead of a function call to a math op */
static JanetSlot opreduce( static JanetSlot opreduce(
JanetFopts opts, JanetFopts opts,
JanetSlot *args, JanetSlot *args,
int op, int op,
Janet nullary) { Janet nullary) {
JanetCompiler *c = opts.compiler; JanetCompiler *c = opts.compiler;
int32_t i, len; int32_t i, len;
len = janet_v_count(args); len = janet_v_count(args);
@ -125,9 +125,9 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
JanetCompiler *c = opts.compiler; JanetCompiler *c = opts.compiler;
int32_t i; int32_t i;
for (i = 1; i < janet_v_count(args) - 3; i += 3) for (i = 1; i < janet_v_count(args) - 3; i += 3)
janetc_emit_sss(c, JOP_PUSH_3, args[i], args[i+1], args[i+2], 0); janetc_emit_sss(c, JOP_PUSH_3, args[i], args[i + 1], args[i + 2], 0);
if (i == janet_v_count(args) - 3) if (i == janet_v_count(args) - 3)
janetc_emit_ss(c, JOP_PUSH_2, args[i], args[i+1], 0); janetc_emit_ss(c, JOP_PUSH_2, args[i], args[i + 1], 0);
else if (i == janet_v_count(args) - 2) else if (i == janet_v_count(args) - 2)
janetc_emit_s(c, JOP_PUSH, args[i], 0); janetc_emit_s(c, JOP_PUSH, args[i], 0);
/* Push array phase */ /* Push array phase */
@ -183,10 +183,10 @@ static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
/* Specialization for comparators */ /* Specialization for comparators */
static JanetSlot compreduce( static JanetSlot compreduce(
JanetFopts opts, JanetFopts opts,
JanetSlot *args, JanetSlot *args,
int op, int op,
int invert) { int invert) {
JanetCompiler *c = opts.compiler; JanetCompiler *c = opts.compiler;
int32_t i, len; int32_t i, len;
len = janet_v_count(args); len = janet_v_count(args);
@ -194,8 +194,8 @@ static JanetSlot compreduce(
JanetSlot t; JanetSlot t;
if (len < 2) { if (len < 2) {
return invert return invert
? janetc_cslot(janet_wrap_false()) ? janetc_cslot(janet_wrap_false())
: janetc_cslot(janet_wrap_true()); : janetc_cslot(janet_wrap_true());
} }
t = janetc_gettarget(opts); t = janetc_gettarget(opts);
for (i = 1; i < len; i++) { for (i = 1; i < len; i++) {
@ -297,7 +297,7 @@ const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
if (tag == 0) if (tag == 0)
return NULL; return NULL;
uint32_t index = tag - 1; uint32_t index = tag - 1;
if (index >= (sizeof(optimizers)/sizeof(optimizers[0]))) if (index >= (sizeof(optimizers) / sizeof(optimizers[0])))
return NULL; return NULL;
return optimizers + index; return optimizers + index;
} }

101
src/core/compile.c
View File

@ -166,8 +166,8 @@ void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot) {
/* Allow searching for symbols. Return information about the symbol */ /* Allow searching for symbols. Return information about the symbol */
JanetSlot janetc_resolve( JanetSlot janetc_resolve(
JanetCompiler *c, JanetCompiler *c,
const uint8_t *sym) { const uint8_t *sym) {
JanetSlot ret = janetc_cslot(janet_wrap_nil()); JanetSlot ret = janetc_cslot(janet_wrap_nil());
JanetScope *scope = c->scope; JanetScope *scope = c->scope;
@ -206,8 +206,7 @@ JanetSlot janetc_resolve(
case JANET_BINDING_DEF: case JANET_BINDING_DEF:
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */ case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
return janetc_cslot(check); return janetc_cslot(check);
case JANET_BINDING_VAR: case JANET_BINDING_VAR: {
{
JanetSlot ret = janetc_cslot(check); JanetSlot ret = janetc_cslot(check);
/* TODO save type info */ /* TODO save type info */
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY; ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
@ -218,7 +217,7 @@ JanetSlot janetc_resolve(
} }
/* Symbol was found */ /* Symbol was found */
found: found:
/* Constants can be returned immediately (they are stateless) */ /* Constants can be returned immediately (they are stateless) */
if (ret.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) if (ret.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF))
@ -283,8 +282,8 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s) {
JanetSlot janetc_gettarget(JanetFopts opts) { JanetSlot janetc_gettarget(JanetFopts opts) {
JanetSlot slot; JanetSlot slot;
if ((opts.flags & JANET_FOPTS_HINT) && if ((opts.flags & JANET_FOPTS_HINT) &&
(opts.hint.envindex < 0) && (opts.hint.envindex < 0) &&
(opts.hint.index >= 0 && opts.hint.index <= 0xFF)) { (opts.hint.index >= 0 && opts.hint.index <= 0xFF)) {
slot = opts.hint; slot = opts.hint;
} else { } else {
slot.envindex = -1; slot.envindex = -1;
@ -334,17 +333,17 @@ void janetc_pushslots(JanetCompiler *c, JanetSlot *slots) {
i++; i++;
} else if (slots[i + 1].flags & JANET_SLOT_SPLICED) { } else if (slots[i + 1].flags & JANET_SLOT_SPLICED) {
janetc_emit_s(c, JOP_PUSH, slots[i], 0); janetc_emit_s(c, JOP_PUSH, slots[i], 0);
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i+1], 0); janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 1], 0);
i += 2; i += 2;
} else if (i + 2 == count) { } else if (i + 2 == count) {
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0); janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
i += 2; i += 2;
} else if (slots[i + 2].flags & JANET_SLOT_SPLICED) { } else if (slots[i + 2].flags & JANET_SLOT_SPLICED) {
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0); janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i+2], 0); janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 2], 0);
i += 3; i += 3;
} else { } else {
janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i+1], slots[i+2], 0); janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i + 1], slots[i + 2], 0);
i += 3; i += 3;
} }
} }
@ -434,23 +433,23 @@ static JanetSlot janetc_array(JanetFopts opts, Janet x) {
JanetCompiler *c = opts.compiler; JanetCompiler *c = opts.compiler;
JanetArray *a = janet_unwrap_array(x); JanetArray *a = janet_unwrap_array(x);
return janetc_maker(opts, return janetc_maker(opts,
janetc_toslots(c, a->data, a->count), janetc_toslots(c, a->data, a->count),
JOP_MAKE_ARRAY); JOP_MAKE_ARRAY);
} }
static JanetSlot janetc_tuple(JanetFopts opts, Janet x) { static JanetSlot janetc_tuple(JanetFopts opts, Janet x) {
JanetCompiler *c = opts.compiler; JanetCompiler *c = opts.compiler;
const Janet *t = janet_unwrap_tuple(x); const Janet *t = janet_unwrap_tuple(x);
return janetc_maker(opts, return janetc_maker(opts,
janetc_toslots(c, t, janet_tuple_length(t)), janetc_toslots(c, t, janet_tuple_length(t)),
JOP_MAKE_TUPLE); JOP_MAKE_TUPLE);
} }
static JanetSlot janetc_tablector(JanetFopts opts, Janet x, int op) { static JanetSlot janetc_tablector(JanetFopts opts, Janet x, int op) {
JanetCompiler *c = opts.compiler; JanetCompiler *c = opts.compiler;
return janetc_maker(opts, return janetc_maker(opts,
janetc_toslotskv(c, x), janetc_toslotskv(c, x),
op); op);
} }
static JanetSlot janetc_bufferctor(JanetFopts opts, Janet x) { static JanetSlot janetc_bufferctor(JanetFopts opts, Janet x) {
@ -458,17 +457,17 @@ static JanetSlot janetc_bufferctor(JanetFopts opts, Janet x) {
JanetBuffer *b = janet_unwrap_buffer(x); JanetBuffer *b = janet_unwrap_buffer(x);
Janet onearg = janet_stringv(b->data, b->count); Janet onearg = janet_stringv(b->data, b->count);
return janetc_maker(opts, return janetc_maker(opts,
janetc_toslots(c, &onearg, 1), janetc_toslots(c, &onearg, 1),
JOP_MAKE_BUFFER); JOP_MAKE_BUFFER);
} }
/* Expand a macro one time. Also get the special form compiler if we /* Expand a macro one time. Also get the special form compiler if we
* find that instead. */ * find that instead. */
static int macroexpand1( static int macroexpand1(
JanetCompiler *c, JanetCompiler *c,
Janet x, Janet x,
Janet *out, Janet *out,
const JanetSpecial **spec) { const JanetSpecial **spec) {
if (!janet_checktype(x, JANET_TUPLE)) if (!janet_checktype(x, JANET_TUPLE))
return 0; return 0;
const Janet *form = janet_unwrap_tuple(x); const Janet *form = janet_unwrap_tuple(x);
@ -498,11 +497,11 @@ static int macroexpand1(
JanetFunction *macro = janet_unwrap_function(macroval); JanetFunction *macro = janet_unwrap_function(macroval);
int lock = janet_gclock(); int lock = janet_gclock();
JanetSignal status = janet_pcall( JanetSignal status = janet_pcall(
macro, macro,
janet_tuple_length(form) - 1, janet_tuple_length(form) - 1,
form + 1, form + 1,
&x, &x,
&fiberp); &fiberp);
janet_gcunlock(lock); janet_gcunlock(lock);
if (status != JANET_SIGNAL_OK) { if (status != JANET_SIGNAL_OK) {
const uint8_t *es = janet_formatc("(macro) %V", x); const uint8_t *es = janet_formatc("(macro) %V", x);
@ -548,24 +547,23 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1); ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1);
} else { } else {
switch (janet_type(x)) { switch (janet_type(x)) {
case JANET_TUPLE: case JANET_TUPLE: {
{ JanetFopts subopts = janetc_fopts_default(c);
JanetFopts subopts = janetc_fopts_default(c); const Janet *tup = janet_unwrap_tuple(x);
const Janet *tup = janet_unwrap_tuple(x); /* Empty tuple is tuple literal */
/* Empty tuple is tuple literal */ if (janet_tuple_length(tup) == 0) {
if (janet_tuple_length(tup) == 0) { ret = janetc_cslot(x);
ret = janetc_cslot(x); } else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */
} else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */ ret = janetc_tuple(opts, x);
ret = janetc_tuple(opts, x); } else {
} else { JanetSlot head = janetc_value(subopts, tup[0]);
JanetSlot head = janetc_value(subopts, tup[0]); subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION; ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head);
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head); janetc_freeslot(c, head);
janetc_freeslot(c, head);
}
ret.flags &= ~JANET_SLOT_SPLICED;
} }
break; ret.flags &= ~JANET_SLOT_SPLICED;
}
break;
case JANET_SYMBOL: case JANET_SYMBOL:
ret = janetc_resolve(c, janet_unwrap_symbol(x)); ret = janetc_resolve(c, janet_unwrap_symbol(x));
break; break;
@ -737,12 +735,13 @@ static Janet cfun(int32_t argc, Janet *argv) {
} }
static const JanetReg compile_cfuns[] = { static const JanetReg compile_cfuns[] = {
{"compile", cfun, {
"compile", cfun,
JDOC("(compile ast env [, source])\n\n" JDOC("(compile ast env [, source])\n\n"
"Compiles an Abstract Syntax Tree (ast) into a janet function. " "Compiles an Abstract Syntax Tree (ast) into a janet function. "
"Pair the compile function with parsing functionality to implement " "Pair the compile function with parsing functionality to implement "
"eval. Returns a janet function and does not modify ast. Throws an " "eval. Returns a janet function and does not modify ast. Throws an "
"error if the ast cannot be compiled.") "error if the ast cannot be compiled.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

4
src/core/compile.h
View File

@ -180,13 +180,13 @@ JanetFopts janetc_fopts_default(JanetCompiler *c);
/* For optimizing builtin normal functions. */ /* For optimizing builtin normal functions. */
struct JanetFunOptimizer { struct JanetFunOptimizer {
int (*can_optimize)(JanetFopts opts, JanetSlot *args); int (*can_optimize)(JanetFopts opts, JanetSlot *args);
JanetSlot (*optimize)(JanetFopts opts, JanetSlot *args); JanetSlot(*optimize)(JanetFopts opts, JanetSlot *args);
}; };
/* A grouping of a named special and the corresponding compiler fragment */ /* A grouping of a named special and the corresponding compiler fragment */
struct JanetSpecial { struct JanetSpecial {
const char *name; const char *name;
JanetSlot (*compile)(JanetFopts opts, int32_t argn, const Janet *argv); JanetSlot(*compile)(JanetFopts opts, int32_t argn, const Janet *argv);
}; };
/****************************************************/ /****************************************************/

486
src/core/corelib.c
View File

@ -229,8 +229,8 @@ static Janet janet_core_next(int32_t argc, Janet *argv) {
JanetDictView view = janet_getdictionary(argv, 0); JanetDictView view = janet_getdictionary(argv, 0);
const JanetKV *end = view.kvs + view.cap; const JanetKV *end = view.kvs + view.cap;
const JanetKV *kv = janet_checktype(argv[1], JANET_NIL) const JanetKV *kv = janet_checktype(argv[1], JANET_NIL)
? view.kvs ? view.kvs
: janet_dict_find(view.kvs, view.cap, argv[1]) + 1; : janet_dict_find(view.kvs, view.cap, argv[1]) + 1;
while (kv < end) { while (kv < end) {
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key; if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
kv++; kv++;
@ -244,134 +244,154 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
} }
static const JanetReg corelib_cfuns[] = { static const JanetReg corelib_cfuns[] = {
{"native", janet_core_native, {
"native", janet_core_native,
JDOC("(native path [,env])\n\n" JDOC("(native path [,env])\n\n"
"Load a native module from the given path. The path " "Load a native module from the given path. The path "
"must be an absolute or relative path on the file system, and is " "must be an absolute or relative path on the file system, and is "
"usually a .so file on Unix systems, and a .dll file on Windows. " "usually a .so file on Unix systems, and a .dll file on Windows. "
"Returns an environment table that contains functions and other values " "Returns an environment table that contains functions and other values "
"from the native module.") "from the native module.")
}, },
{"print", janet_core_print, {
"print", janet_core_print,
JDOC("(print & xs)\n\n" JDOC("(print & xs)\n\n"
"Print values to the console (standard out). Value are converted " "Print values to the console (standard out). Value are converted "
"to strings if they are not already. After printing all values, a " "to strings if they are not already. After printing all values, a "
"newline character is printed. Returns nil.") "newline character is printed. Returns nil.")
}, },
{"describe", janet_core_describe, {
"describe", janet_core_describe,
JDOC("(describe x)\n\n" JDOC("(describe x)\n\n"
"Returns a string that is a human readable description of a value x.") "Returns a string that is a human readable description of a value x.")
}, },
{"string", janet_core_string, {
"string", janet_core_string,
JDOC("(string & parts)\n\n" JDOC("(string & parts)\n\n"
"Creates a string by concatenating values together. Values are " "Creates a string by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. " "converted to bytes via describe if they are not byte sequences. "
"Returns the new string.") "Returns the new string.")
}, },
{"symbol", janet_core_symbol, {
"symbol", janet_core_symbol,
JDOC("(symbol & xs)\n\n" JDOC("(symbol & xs)\n\n"
"Creates a symbol by concatenating values together. Values are " "Creates a symbol by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns " "converted to bytes via describe if they are not byte sequences. Returns "
"the new symbol.") "the new symbol.")
}, },
{"keyword", janet_core_keyword, {
"keyword", janet_core_keyword,
JDOC("(keyword & xs)\n\n" JDOC("(keyword & xs)\n\n"
"Creates a keyword by concatenating values together. Values are " "Creates a keyword by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns " "converted to bytes via describe if they are not byte sequences. Returns "
"the new keyword.") "the new keyword.")
}, },
{"buffer", janet_core_buffer, {
"buffer", janet_core_buffer,
JDOC("(buffer & xs)\n\n" JDOC("(buffer & xs)\n\n"
"Creates a new buffer by concatenating values together. Values are " "Creates a new buffer by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns " "converted to bytes via describe if they are not byte sequences. Returns "
"the new buffer.") "the new buffer.")
}, },
{"abstract?", janet_core_is_abstract, {
"abstract?", janet_core_is_abstract,
JDOC("(abstract? x)\n\n" JDOC("(abstract? x)\n\n"
"Check if x is an abstract type.") "Check if x is an abstract type.")
}, },
{"table", janet_core_table, {
"table", janet_core_table,
JDOC("(table & kvs)\n\n" JDOC("(table & kvs)\n\n"
"Creates a new table from a variadic number of keys and values. " "Creates a new table from a variadic number of keys and values. "
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has " "kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
"an odd number of elements, an error will be thrown. Returns the " "an odd number of elements, an error will be thrown. Returns the "
"new table.") "new table.")
}, },
{"array", janet_core_array, {
"array", janet_core_array,
JDOC("(array & items)\n\n" JDOC("(array & items)\n\n"
"Create a new array that contains items. Returns the new array.") "Create a new array that contains items. Returns the new array.")
}, },
{"scan-number", janet_core_scannumber, {
"scan-number", janet_core_scannumber,
JDOC("(scan-number str)\n\n" JDOC("(scan-number str)\n\n"
"Parse a number from a byte sequence an return that number, either and integer " "Parse a number from a byte sequence an return that number, either and integer "
"or a real. The number " "or a real. The number "
"must be in the same format as numbers in janet source code. Will return nil " "must be in the same format as numbers in janet source code. Will return nil "
"on an invalid number.") "on an invalid number.")
}, },
{"tuple", janet_core_tuple, {
"tuple", janet_core_tuple,
JDOC("(tuple & items)\n\n" JDOC("(tuple & items)\n\n"
"Creates a new tuple that contains items. Returns the new tuple.") "Creates a new tuple that contains items. Returns the new tuple.")
}, },
{"struct", janet_core_struct, {
"struct", janet_core_struct,
JDOC("(struct & kvs)\n\n" JDOC("(struct & kvs)\n\n"
"Create a new struct from a sequence of key value pairs. " "Create a new struct from a sequence of key value pairs. "
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has " "kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
"an odd number of elements, an error will be thrown. Returns the " "an odd number of elements, an error will be thrown. Returns the "
"new struct.") "new struct.")
}, },
{"gensym", janet_core_gensym, {
"gensym", janet_core_gensym,
JDOC("(gensym)\n\n" JDOC("(gensym)\n\n"
"Returns a new symbol that is unique across the runtime. This means it " "Returns a new symbol that is unique across the runtime. This means it "
"will not collide with any already created symbols during compilation, so " "will not collide with any already created symbols during compilation, so "
"it can be used in macros to generate automatic bindings.") "it can be used in macros to generate automatic bindings.")
}, },
{"gccollect", janet_core_gccollect, {
"gccollect", janet_core_gccollect,
JDOC("(gccollect)\n\n" JDOC("(gccollect)\n\n"
"Run garbage collection. You should probably not call this manually.") "Run garbage collection. You should probably not call this manually.")
}, },
{"gcsetinterval", janet_core_gcsetinterval, {
"gcsetinterval", janet_core_gcsetinterval,
JDOC("(gcsetinterval interval)\n\n" JDOC("(gcsetinterval interval)\n\n"
"Set an integer number of bytes to allocate before running garbage collection. " "Set an integer number of bytes to allocate before running garbage collection. "
"Low valuesi for interval will be slower but use less memory. " "Low valuesi for interval will be slower but use less memory. "
"High values will be faster but use more memory.") "High values will be faster but use more memory.")
}, },
{"gcinterval", janet_core_gcinterval, {
"gcinterval", janet_core_gcinterval,
JDOC("(gcinterval)\n\n" JDOC("(gcinterval)\n\n"
"Returns the integer number of bytes to allocate before running an iteration " "Returns the integer number of bytes to allocate before running an iteration "
"of garbage collection.") "of garbage collection.")
}, },
{"type", janet_core_type, {
"type", janet_core_type,
JDOC("(type x)\n\n" JDOC("(type x)\n\n"
"Returns the type of x as a keyword symbol. x is one of\n" "Returns the type of x as a keyword symbol. x is one of\n"
"\t:nil\n" "\t:nil\n"
"\t:boolean\n" "\t:boolean\n"
"\t:integer\n" "\t:integer\n"
"\t:real\n" "\t:real\n"
"\t:array\n" "\t:array\n"
"\t:tuple\n" "\t:tuple\n"
"\t:table\n" "\t:table\n"
"\t:struct\n" "\t:struct\n"
"\t:string\n" "\t:string\n"
"\t:buffer\n" "\t:buffer\n"
"\t:symbol\n" "\t:symbol\n"
"\t:keyword\n" "\t:keyword\n"
"\t:function\n" "\t:function\n"
"\t:cfunction\n\n" "\t:cfunction\n\n"
"or another symbol for an abstract type.") "or another symbol for an abstract type.")
}, },
{"next", janet_core_next, {
"next", janet_core_next,
JDOC("(next dict key)\n\n" JDOC("(next dict key)\n\n"
"Gets the next key in a struct or table. Can be used to iterate through " "Gets the next key in a struct or table. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed " "the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if they data structure is not mutated " "to be seen only once per iteration if they data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next " "during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through. ") "returns nil, there are no more keys to iterate through. ")
}, },
{"hash", janet_core_hash, {
"hash", janet_core_hash,
JDOC("(hash value)\n\n" JDOC("(hash value)\n\n"
"Gets a hash value for any janet value. The hash is an integer can be used " "Gets a hash value for any janet value. The hash is an integer can be used "
"as a cheap hash function for all janet objects. If two values are strictly equal, " "as a cheap hash function for all janet objects. If two values are strictly equal, "
"then they will have the same hash value.") "then they will have the same hash value.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };
@ -380,14 +400,14 @@ static const JanetReg corelib_cfuns[] = {
/* Utility for inline assembly */ /* Utility for inline assembly */
static void janet_quick_asm( static void janet_quick_asm(
JanetTable *env, JanetTable *env,
int32_t flags, int32_t flags,
const char *name, const char *name,
int32_t arity, int32_t arity,
int32_t slots, int32_t slots,
const uint32_t *bytecode, const uint32_t *bytecode,
size_t bytecode_size, size_t bytecode_size,
const char *doc) { const char *doc) {
JanetFuncDef *def = janet_funcdef_alloc(); JanetFuncDef *def = janet_funcdef_alloc();
def->arity = arity; def->arity = arity;
def->flags = flags; def->flags = flags;
@ -411,13 +431,13 @@ static void janet_quick_asm(
/* Templatize a varop */ /* Templatize a varop */
static void templatize_varop( static void templatize_varop(
JanetTable *env, JanetTable *env,
int32_t flags, int32_t flags,
const char *name, const char *name,
int32_t nullary, int32_t nullary,
int32_t unary, int32_t unary,
uint32_t op, uint32_t op,
const char *doc) { const char *doc) {
/* Variadic operator assembly. Must be templatized for each different opcode. */ /* Variadic operator assembly. Must be templatized for each different opcode. */
/* Reg 0: Argument tuple (args) */ /* Reg 0: Argument tuple (args) */
@ -461,24 +481,24 @@ static void templatize_varop(
}; };
janet_quick_asm( janet_quick_asm(
env, env,
flags | JANET_FUNCDEF_FLAG_VARARG, flags | JANET_FUNCDEF_FLAG_VARARG,
name, name,
0, 0,
6, 6,
varop_asm, varop_asm,
sizeof(varop_asm), sizeof(varop_asm),
doc); doc);
} }
/* Templatize variadic comparators */ /* Templatize variadic comparators */
static void templatize_comparator( static void templatize_comparator(
JanetTable *env, JanetTable *env,
int32_t flags, int32_t flags,
const char *name, const char *name,
int invert, int invert,
uint32_t op, uint32_t op,
const char *doc) { const char *doc) {
/* Reg 0: Argument tuple (args) */ /* Reg 0: Argument tuple (args) */
/* Reg 1: Argument count (argn) */ /* Reg 1: Argument count (argn) */
@ -514,14 +534,14 @@ static void templatize_comparator(
}; };
janet_quick_asm( janet_quick_asm(
env, env,
flags | JANET_FUNCDEF_FLAG_VARARG, flags | JANET_FUNCDEF_FLAG_VARARG,
name, name,
0, 0,
6, 6,
comparator_asm, comparator_asm,
sizeof(comparator_asm), sizeof(comparator_asm),
doc); doc);
} }
/* Make the apply function */ /* Make the apply function */
@ -555,22 +575,22 @@ static void make_apply(JanetTable *env) {
S(JOP_TAILCALL, 0) S(JOP_TAILCALL, 0)
}; };
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG, janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 6, apply_asm, sizeof(apply_asm), "apply", 1, 6, apply_asm, sizeof(apply_asm),
JDOC("(apply f & args)\n\n" JDOC("(apply f & args)\n\n"
"Applies a function to a variable number of arguments. Each element in args " "Applies a function to a variable number of arguments. Each element in args "
"is used as an argument to f, except the last element in args, which is expected to " "is used as an argument to f, except the last element in args, which is expected to "
"be an array-like. Each element in this last argument is then also pushed as an argument to " "be an array-like. Each element in this last argument is then also pushed as an argument to "
"f. For example:\n\n" "f. For example:\n\n"
"\t(apply + 1000 (range 10))\n\n" "\t(apply + 1000 (range 10))\n\n"
"sums the first 10 integers and 1000.)")); "sums the first 10 integers and 1000.)"));
} }
static const uint32_t error_asm[] = { static const uint32_t error_asm[] = {
JOP_ERROR JOP_ERROR
}; };
static const uint32_t debug_asm[] = { static const uint32_t debug_asm[] = {
JOP_SIGNAL | (2 << 24), JOP_SIGNAL | (2 << 24),
JOP_RETURN_NIL JOP_RETURN_NIL
}; };
static const uint32_t yield_asm[] = { static const uint32_t yield_asm[] = {
JOP_SIGNAL | (3 << 24), JOP_SIGNAL | (3 << 24),
@ -604,133 +624,133 @@ JanetTable *janet_core_env(void) {
#ifdef JANET_BOOTSTRAP #ifdef JANET_BOOTSTRAP
janet_quick_asm(env, JANET_FUN_YIELD, "debug", 0, 1, debug_asm, sizeof(debug_asm), janet_quick_asm(env, JANET_FUN_YIELD, "debug", 0, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug)\n\n" JDOC("(debug)\n\n"
"Throws a debug signal that can be caught by a parent fiber and used to inspect " "Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns nil.")); "the running state of the current fiber. Returns nil."));
janet_quick_asm(env, JANET_FUN_ERROR, "error", 1, 1, error_asm, sizeof(error_asm), janet_quick_asm(env, JANET_FUN_ERROR, "error", 1, 1, error_asm, sizeof(error_asm),
JDOC("(error e)\n\n" JDOC("(error e)\n\n"
"Throws an error e that can be caught and handled by a parent fiber.")); "Throws an error e that can be caught and handled by a parent fiber."));
janet_quick_asm(env, JANET_FUN_YIELD, "yield", 1, 2, yield_asm, sizeof(yield_asm), janet_quick_asm(env, JANET_FUN_YIELD, "yield", 1, 2, yield_asm, sizeof(yield_asm),
JDOC("(yield x)\n\n" JDOC("(yield x)\n\n"
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until " "Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will " "another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume.")); "return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_RESUME, "resume", 2, 2, resume_asm, sizeof(resume_asm), janet_quick_asm(env, JANET_FUN_RESUME, "resume", 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber [,x])\n\n" JDOC("(resume fiber [,x])\n\n"
"Resume a new or suspended fiber and optionally pass in a value to the fiber that " "Resume a new or suspended fiber and optionally pass in a value to the fiber that "
"will be returned to the last yield in the case of a pending fiber, or the argument to " "will be returned to the last yield in the case of a pending fiber, or the argument to "
"the dispatch function in the case of a new fiber. Returns either the return result of " "the dispatch function in the case of a new fiber. Returns either the return result of "
"the fiber's dispatch function, or the value from the next yield call in fiber.")); "the fiber's dispatch function, or the value from the next yield call in fiber."));
janet_quick_asm(env, JANET_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm), janet_quick_asm(env, JANET_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm),
JDOC("(get ds key)\n\n" JDOC("(get ds key)\n\n"
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, " "Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
"symbols, and buffers are all associative and can be used with get. Order structures, name " "symbols, and buffers are all associative and can be used with get. Order structures, name "
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can " "arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
"take any value as a key except nil and return a value except nil. Byte sequences will return " "take any value as a key except nil and return a value except nil. Byte sequences will return "
"integer representations of bytes as result of a get call.")); "integer representations of bytes as result of a get call."));
janet_quick_asm(env, JANET_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm), janet_quick_asm(env, JANET_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm),
JDOC("(put ds key value)\n\n" JDOC("(put ds key value)\n\n"
"Associate a key with a value in any mutable associative data structure. Indexed data structures " "Associate a key with a value in any mutable associative data structure. Indexed data structures "
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds " "(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra " "value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype " "space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting " "will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
"a value nil into a table will remove the key from the table. Returns the data structure ds.")); "a value nil into a table will remove the key from the table. Returns the data structure ds."));
janet_quick_asm(env, JANET_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm), janet_quick_asm(env, JANET_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm),
JDOC("(length ds)\n\n" JDOC("(length ds)\n\n"
"Returns the length or count of a data structure in constant time as an integer. For " "Returns the length or count of a data structure in constant time as an integer. For "
"structs and tables, returns the number of key-value pairs in the data structure.")); "structs and tables, returns the number of key-value pairs in the data structure."));
janet_quick_asm(env, JANET_FUN_BNOT, "bnot", 1, 1, bnot_asm, sizeof(bnot_asm), janet_quick_asm(env, JANET_FUN_BNOT, "bnot", 1, 1, bnot_asm, sizeof(bnot_asm),
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x.")); JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
make_apply(env); make_apply(env);
/* Variadic ops */ /* Variadic ops */
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD, templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
JDOC("(+ & xs)\n\n" JDOC("(+ & xs)\n\n"
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0.")); "Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT, templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
JDOC("(- & xs)\n\n" JDOC("(- & xs)\n\n"
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the " "Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
"negative value of that element. Otherwise, returns the first element in xs minus the sum of " "negative value of that element. Otherwise, returns the first element in xs minus the sum of "
"the rest of the elements.")); "the rest of the elements."));
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY, templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
JDOC("(* & xs)\n\n" JDOC("(* & xs)\n\n"
"Returns the product of all elements in xs. If xs is empty, returns 1.")); "Returns the product of all elements in xs. If xs is empty, returns 1."));
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE, templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
JDOC("(/ & xs)\n\n" JDOC("(/ & xs)\n\n"
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns " "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 " "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values. Division by two integers uses truncating division.")); "values. Division by two integers uses truncating division."));
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND, templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
JDOC("(band & xs)\n\n" JDOC("(band & xs)\n\n"
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); "Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR, templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
JDOC("(bor & xs)\n\n" JDOC("(bor & xs)\n\n"
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer.")); "Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR, templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
JDOC("(bxor & xs)\n\n" JDOC("(bxor & xs)\n\n"
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer.")); "Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT, templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
JDOC("(blshift x & shifts)\n\n" JDOC("(blshift x & shifts)\n\n"
"Returns the value of x bit shifted left by the sum of all values in shifts. x " "Returns the value of x bit shifted left by the sum of all values in shifts. x "
"and each element in shift must be an integer.")); "and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT, templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
JDOC("(brshift x & shifts)\n\n" JDOC("(brshift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x " "Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer.")); "and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED, templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
JDOC("(brushift x & shifts)\n\n" JDOC("(brushift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x " "Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer. The sign of x is not preserved, so " "and each element in shift must be an integer. The sign of x is not preserved, so "
"for positive shifts the return value will always be positive.")); "for positive shifts the return value will always be positive."));
/* Variadic comparators */ /* Variadic comparators */
templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN, templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN,
JDOC("(order> & xs)\n\n" JDOC("(order> & xs)\n\n"
"Check if xs is strictly descending according to a total order " "Check if xs is strictly descending according to a total order "
"over all values. Returns a boolean.")); "over all values. Returns a boolean."));
templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN, templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN,
JDOC("(order< & xs)\n\n" JDOC("(order< & xs)\n\n"
"Check if xs is strictly increasing according to a total order " "Check if xs is strictly increasing according to a total order "
"over all values. Returns a boolean.")); "over all values. Returns a boolean."));
templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN, templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN,
JDOC("(order>= & xs)\n\n" JDOC("(order>= & xs)\n\n"
"Check if xs is not increasing according to a total order " "Check if xs is not increasing according to a total order "
"over all values. Returns a boolean.")); "over all values. Returns a boolean."));
templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN, templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN,
JDOC("(order<= & xs)\n\n" JDOC("(order<= & xs)\n\n"
"Check if xs is not decreasing according to a total order " "Check if xs is not decreasing according to a total order "
"over all values. Returns a boolean.")); "over all values. Returns a boolean."));
templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS, templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS,
JDOC("(= & xs)\n\n" JDOC("(= & xs)\n\n"
"Returns true if all values in xs are the same, false otherwise.")); "Returns true if all values in xs are the same, false otherwise."));
templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS, templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS,
JDOC("(not= & xs)\n\n" JDOC("(not= & xs)\n\n"
"Return true if any values in xs are not equal, otherwise false.")); "Return true if any values in xs are not equal, otherwise false."));
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN, templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN,
JDOC("(> & xs)\n\n" JDOC("(> & xs)\n\n"
"Check if xs is in numerically descending order. Returns a boolean.")); "Check if xs is in numerically descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN, templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN,
JDOC("(< & xs)\n\n" JDOC("(< & xs)\n\n"
"Check if xs is in numerically ascending order. Returns a boolean.")); "Check if xs is in numerically ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL, templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL,
JDOC("(>= & xs)\n\n" JDOC("(>= & xs)\n\n"
"Check if xs is in numerically non-ascending order. Returns a boolean.")); "Check if xs is in numerically non-ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL, templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL,
JDOC("(<= & xs)\n\n" JDOC("(<= & xs)\n\n"
"Check if xs is in numerically non-descending order. Returns a boolean.")); "Check if xs is in numerically non-descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL, templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL,
JDOC("(== & xs)\n\n" JDOC("(== & xs)\n\n"
"Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean.")); "Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean."));
templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL, templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL,
JDOC("(not== & xs)\n\n" JDOC("(not== & xs)\n\n"
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean.")); "Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean."));
/* Platform detection */ /* Platform detection */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION), janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
JDOC("The version number of the running janet program.")); JDOC("The version number of the running janet program."));
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD), janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
JDOC("The build identifier of the running janet program.")); JDOC("The build identifier of the running janet program."));
/* Allow references to the environment */ /* Allow references to the environment */
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope.")); janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
@ -768,12 +788,12 @@ JanetTable *janet_core_env(void) {
/* Unmarshal from core image */ /* Unmarshal from core image */
Janet marsh_out; Janet marsh_out;
int status = janet_unmarshal( int status = janet_unmarshal(
janet_core_image, janet_core_image,
janet_core_image_size, janet_core_image_size,
0, 0,
&marsh_out, &marsh_out,
env, env,
NULL); NULL);
if (status) { if (status) {
printf("error unmarshaling core image\n"); printf("error unmarshaling core image\n");
exit(1); exit(1);

78
src/core/debug.c
View File

@ -51,8 +51,8 @@ void janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
* location. * location.
*/ */
void janet_debug_find( void janet_debug_find(
JanetFuncDef **def_out, int32_t *pc_out, JanetFuncDef **def_out, int32_t *pc_out,
const uint8_t *source, int32_t offset) { const uint8_t *source, int32_t offset) {
/* Scan the heap for right func def */ /* Scan the heap for right func def */
JanetGCMemoryHeader *current = janet_vm_blocks; JanetGCMemoryHeader *current = janet_vm_blocks;
/* Keep track of the best source mapping we have seen so far */ /* Keep track of the best source mapping we have seen so far */
@ -144,7 +144,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
if (frame->flags & JANET_STACKFRAME_TAILCALL) if (frame->flags & JANET_STACKFRAME_TAILCALL)
fprintf(stderr, " (tailcall)"); fprintf(stderr, " (tailcall)");
if (frame->func && frame->pc) { if (frame->func && frame->pc) {
int32_t off = (int32_t) (frame->pc - def->bytecode); int32_t off = (int32_t)(frame->pc - def->bytecode);
if (def->sourcemap) { if (def->sourcemap) {
JanetSourceMapping mapping = def->sourcemap[off]; JanetSourceMapping mapping = def->sourcemap[off];
fprintf(stderr, " at (%d:%d)", mapping.start, mapping.end); fprintf(stderr, " at (%d:%d)", mapping.start, mapping.end);
@ -252,7 +252,7 @@ static Janet doframe(JanetStackFrame *frame) {
if (frame->func && frame->pc) { if (frame->func && frame->pc) {
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE; Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
JanetArray *slots; JanetArray *slots;
off = (int32_t) (frame->pc - def->bytecode); off = (int32_t)(frame->pc - def->bytecode);
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off)); janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
if (def->sourcemap) { if (def->sourcemap) {
JanetSourceMapping mapping = def->sourcemap[off]; JanetSourceMapping mapping = def->sourcemap[off];
@ -307,69 +307,69 @@ static const JanetReg debug_cfuns[] = {
{ {
"debug/break", cfun_debug_break, "debug/break", cfun_debug_break,
JDOC("(debug/break source byte-offset)\n\n" JDOC("(debug/break source byte-offset)\n\n"
"Sets a breakpoint with source a key at a given byte offset. An offset " "Sets a breakpoint with source a key at a given byte offset. An offset "
"of 0 is the first byte in a file. Will throw an error if the breakpoint location " "of 0 is the first byte in a file. Will throw an error if the breakpoint location "
"cannot be found. For example\n\n" "cannot be found. For example\n\n"
"\t(debug/break \"core.janet\" 1000)\n\n" "\t(debug/break \"core.janet\" 1000)\n\n"
"wil set a breakpoint at the 1000th byte of the file core.janet.") "wil set a breakpoint at the 1000th byte of the file core.janet.")
}, },
{ {
"debug/unbreak", cfun_debug_unbreak, "debug/unbreak", cfun_debug_unbreak,
JDOC("(debug/unbreak source byte-offset)\n\n" JDOC("(debug/unbreak source byte-offset)\n\n"
"Remove a breakpoint with a source key at a given byte offset. An offset " "Remove a breakpoint with a source key at a given byte offset. An offset "
"of 0 is the first byte in a file. Will throw an error if the breakpoint " "of 0 is the first byte in a file. Will throw an error if the breakpoint "
"cannot be found.") "cannot be found.")
}, },
{ {
"debug/fbreak", cfun_debug_fbreak, "debug/fbreak", cfun_debug_fbreak,
JDOC("(debug/fbreak fun [,pc=0])\n\n" JDOC("(debug/fbreak fun [,pc=0])\n\n"
"Set a breakpoint in a given function. pc is an optional offset, which " "Set a breakpoint in a given function. pc is an optional offset, which "
"is in bytecode instructions. fun is a function value. Will throw an error " "is in bytecode instructions. fun is a function value. Will throw an error "
"if the offset is too large or negative.") "if the offset is too large or negative.")
}, },
{ {
"debug/unfbreak", cfun_debug_unfbreak, "debug/unfbreak", cfun_debug_unfbreak,
JDOC("(debug/unfbreak fun [,pc=0])\n\n" JDOC("(debug/unfbreak fun [,pc=0])\n\n"
"Unset a breakpoint set with debug/fbreak.") "Unset a breakpoint set with debug/fbreak.")
}, },
{ {
"debug/arg-stack", cfun_debug_argstack, "debug/arg-stack", cfun_debug_argstack,
JDOC("(debug/arg-stack fiber)\n\n" JDOC("(debug/arg-stack fiber)\n\n"
"Gets all values currently on the fiber's argument stack. Normally, " "Gets all values currently on the fiber's argument stack. Normally, "
"this should be empty unless the fiber signals while pushing arguments " "this should be empty unless the fiber signals while pushing arguments "
"to make a function call. Returns a new array.") "to make a function call. Returns a new array.")
}, },
{ {
"debug/stack", cfun_debug_stack, "debug/stack", cfun_debug_stack,
JDOC("(debug/stack fib)\n\n" JDOC("(debug/stack fib)\n\n"
"Gets information about the stack as an array of tables. Each table " "Gets information about the stack as an array of tables. Each table "
"in the array contains information about a stack frame. The top most, current " "in the array contains information about a stack frame. The top most, current "
"stack frame is the first table in the array, and the bottom most stack frame " "stack frame is the first table in the array, and the bottom most stack frame "
"is the last value. Each stack frame contains some of the following attributes:\n\n" "is the last value. Each stack frame contains some of the following attributes:\n\n"
"\t:c - true if the stack frame is a c function invocation\n" "\t:c - true if the stack frame is a c function invocation\n"
"\t:column - the current source column of the stack frame\n" "\t:column - the current source column of the stack frame\n"
"\t:function - the function that the stack frame represents\n" "\t:function - the function that the stack frame represents\n"
"\t:line - the current source line of the stack frame\n" "\t:line - the current source line of the stack frame\n"
"\t:name - the human friendly name of the function\n" "\t:name - the human friendly name of the function\n"
"\t:pc - integer indicating the location of the program counter\n" "\t:pc - integer indicating the location of the program counter\n"
"\t:source - string with the file path or other identifier for the source code\n" "\t:source - string with the file path or other identifier for the source code\n"
"\t:slots - array of all values in each slot\n" "\t:slots - array of all values in each slot\n"
"\t:tail - boolean indicating a tail call") "\t:tail - boolean indicating a tail call")
}, },
{ {
"debug/stacktrace", cfun_debug_stacktrace, "debug/stacktrace", cfun_debug_stacktrace,
JDOC("(debug/stacktrace fiber err)\n\n" JDOC("(debug/stacktrace fiber err)\n\n"
"Prints a nice looking stacktrace for a fiber. The error message " "Prints a nice looking stacktrace for a fiber. The error message "
"err must be passed to the function as fiber's do not keep track of " "err must be passed to the function as fiber's do not keep track of "
"the last error they have thrown. Returns the fiber.") "the last error they have thrown. Returns the fiber.")
}, },
{ {
"debug/lineage", cfun_debug_lineage, "debug/lineage", cfun_debug_lineage,
JDOC("(debug/lineage fib)\n\n" JDOC("(debug/lineage fib)\n\n"
"Returns an array of all child fibers from a root fiber. This function " "Returns an array of all child fibers from a root fiber. This function "
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, " "is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
"the fiber handling the error can see which fiber raised the signal. This function should " "the fiber handling the error can see which fiber raised the signal. This function should "
"be used mostly for debugging purposes.") "be used mostly for debugging purposes.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

76
src/core/emit.c
View File

@ -84,26 +84,24 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
case JANET_FALSE: case JANET_FALSE:
janetc_emit(c, (reg << 8) | JOP_LOAD_FALSE); janetc_emit(c, (reg << 8) | JOP_LOAD_FALSE);
break; break;
case JANET_NUMBER: case JANET_NUMBER: {
{ double dval = janet_unwrap_number(k);
double dval = janet_unwrap_number(k); int32_t i = (int32_t) dval;
int32_t i = (int32_t) dval; if (dval != i || !(dval >= INT16_MIN && dval <= INT16_MAX))
if (dval != i || !(dval >= INT16_MIN && dval <= INT16_MAX)) goto do_constant;
goto do_constant; janetc_emit(c,
janetc_emit(c,
(i << 16) | (i << 16) |
(reg << 8) | (reg << 8) |
JOP_LOAD_INTEGER); JOP_LOAD_INTEGER);
break; break;
} }
default: default:
do_constant: do_constant: {
{
int32_t cindex = janetc_const(c, k); int32_t cindex = janetc_const(c, k);
janetc_emit(c, janetc_emit(c,
(cindex << 16) | (cindex << 16) |
(reg << 8) | (reg << 8) |
JOP_LOAD_CONSTANT); JOP_LOAD_CONSTANT);
break; break;
} }
} }
@ -111,53 +109,53 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
/* Move a slot to a near register */ /* Move a slot to a near register */
static void janetc_movenear(JanetCompiler *c, static void janetc_movenear(JanetCompiler *c,
int32_t dest, int32_t dest,
JanetSlot src) { JanetSlot src) {
if (src.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) { if (src.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) {
janetc_loadconst(c, src.constant, dest); janetc_loadconst(c, src.constant, dest);
/* If we also are a reference, deref the one element array */ /* If we also are a reference, deref the one element array */
if (src.flags & JANET_SLOT_REF) { if (src.flags & JANET_SLOT_REF) {
janetc_emit(c, janetc_emit(c,
(dest << 16) | (dest << 16) |
(dest << 8) | (dest << 8) |
JOP_GET_INDEX); JOP_GET_INDEX);
} }
} else if (src.envindex >= 0) { } else if (src.envindex >= 0) {
janetc_emit(c, janetc_emit(c,
((uint32_t)(src.index) << 24) | ((uint32_t)(src.index) << 24) |
((uint32_t)(src.envindex) << 16) | ((uint32_t)(src.envindex) << 16) |
((uint32_t)(dest) << 8) | ((uint32_t)(dest) << 8) |
JOP_LOAD_UPVALUE); JOP_LOAD_UPVALUE);
} else if (src.index > 0xFF || src.index != dest) { } else if (src.index > 0xFF || src.index != dest) {
janetc_emit(c, janetc_emit(c,
((uint32_t)(src.index) << 16) | ((uint32_t)(src.index) << 16) |
((uint32_t)(dest) << 8) | ((uint32_t)(dest) << 8) |
JOP_MOVE_NEAR); JOP_MOVE_NEAR);
} }
} }
/* Move a near register to a Slot. */ /* Move a near register to a Slot. */
static void janetc_moveback(JanetCompiler *c, static void janetc_moveback(JanetCompiler *c,
JanetSlot dest, JanetSlot dest,
int32_t src) { int32_t src) {
if (dest.flags & JANET_SLOT_REF) { if (dest.flags & JANET_SLOT_REF) {
int32_t refreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_5); int32_t refreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_5);
janetc_loadconst(c, dest.constant, refreg); janetc_loadconst(c, dest.constant, refreg);
janetc_emit(c, janetc_emit(c,
(src << 16) | (src << 16) |
(refreg << 8) | (refreg << 8) |
JOP_PUT_INDEX); JOP_PUT_INDEX);
janetc_regalloc_freetemp(&c->scope->ra, refreg, JANETC_REGTEMP_5); janetc_regalloc_freetemp(&c->scope->ra, refreg, JANETC_REGTEMP_5);
} else if (dest.envindex >= 0) { } else if (dest.envindex >= 0) {
janetc_emit(c, janetc_emit(c,
((uint32_t)(dest.index) << 24) | ((uint32_t)(dest.index) << 24) |
((uint32_t)(dest.envindex) << 16) | ((uint32_t)(dest.envindex) << 16) |
((uint32_t)(src) << 8) | ((uint32_t)(src) << 8) |
JOP_SET_UPVALUE); JOP_SET_UPVALUE);
} else if (dest.index != src) { } else if (dest.index != src) {
janetc_emit(c, janetc_emit(c,
((uint32_t)(dest.index) << 16) | ((uint32_t)(dest.index) << 16) |
((uint32_t)(src) << 8) | ((uint32_t)(src) << 8) |
JOP_MOVE_FAR); JOP_MOVE_FAR);
} }
} }
@ -221,9 +219,9 @@ static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
/* Move values from one slot to another. The destination must /* Move values from one slot to another. The destination must
* be writeable (not a literal). */ * be writeable (not a literal). */
void janetc_copy( void janetc_copy(
JanetCompiler *c, JanetCompiler *c,
JanetSlot dest, JanetSlot dest,
JanetSlot src) { JanetSlot src) {
if (dest.flags & JANET_SLOT_CONSTANT) { if (dest.flags & JANET_SLOT_CONSTANT) {
janetc_cerror(c, "cannot write to constant"); janetc_cerror(c, "cannot write to constant");
return; return;

66
src/core/fiber.c
View File

@ -170,8 +170,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0)); fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
} else { } else {
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n( fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
fiber->data + tuplehead, fiber->data + tuplehead,
oldtop - tuplehead)); oldtop - tuplehead));
} }
} }
@ -231,8 +231,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0)); fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
} else { } else {
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n( fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
fiber->data + tuplehead, fiber->data + tuplehead,
fiber->stacktop - tuplehead)); fiber->stacktop - tuplehead));
} }
stacksize = tuplehead - fiber->stackstart + 1; stacksize = tuplehead - fiber->stackstart + 1;
} else { } else {
@ -352,7 +352,7 @@ static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0); JanetFiber *fiber = janet_getfiber(argv, 0);
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >> uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
JANET_FIBER_STATUS_OFFSET; JANET_FIBER_STATUS_OFFSET;
return janet_ckeywordv(janet_status_names[s]); return janet_ckeywordv(janet_status_names[s]);
} }
@ -383,50 +383,50 @@ static const JanetReg fiber_cfuns[] = {
{ {
"fiber/new", cfun_fiber_new, "fiber/new", cfun_fiber_new,
JDOC("(fiber/new func [,sigmask])\n\n" JDOC("(fiber/new func [,sigmask])\n\n"
"Create a new fiber with function body func. Can optionally " "Create a new fiber with function body func. Can optionally "
"take a set of signals to block from the current parent fiber " "take a set of signals to block from the current parent fiber "
"when called. The mask is specified as a keyword where each character " "when called. The mask is specified as a keyword where each character "
"is used to indicate a signal to block. The default sigmask is :y. " "is used to indicate a signal to block. The default sigmask is :y. "
"For example, \n\n" "For example, \n\n"
"\t(fiber/new myfun :e123)\n\n" "\t(fiber/new myfun :e123)\n\n"
"blocks error signals and user signals 1, 2 and 3. The signals are " "blocks error signals and user signals 1, 2 and 3. The signals are "
"as follows: \n\n" "as follows: \n\n"
"\ta - block all signals\n" "\ta - block all signals\n"
"\td - block debug signals\n" "\td - block debug signals\n"
"\te - block error signals\n" "\te - block error signals\n"
"\tu - block user signals\n" "\tu - block user signals\n"
"\ty - block yield signals\n" "\ty - block yield signals\n"
"\t0-9 - block a specific user signal") "\t0-9 - block a specific user signal")
}, },
{ {
"fiber/status", cfun_fiber_status, "fiber/status", cfun_fiber_status,
JDOC("(fiber/status fib)\n\n" JDOC("(fiber/status fib)\n\n"
"Get the status of a fiber. The status will be one of:\n\n" "Get the status of a fiber. The status will be one of:\n\n"
"\t:dead - the fiber has finished\n" "\t:dead - the fiber has finished\n"
"\t:error - the fiber has errored out\n" "\t:error - the fiber has errored out\n"
"\t:debug - the fiber is suspended in debug mode\n" "\t:debug - the fiber is suspended in debug mode\n"
"\t:pending - the fiber has been yielded\n" "\t:pending - the fiber has been yielded\n"
"\t:user(0-9) - the fiber is suspended by a user signal\n" "\t:user(0-9) - the fiber is suspended by a user signal\n"
"\t:alive - the fiber is currently running and cannot be resumed\n" "\t:alive - the fiber is currently running and cannot be resumed\n"
"\t:new - the fiber has just been created and not yet run") "\t:new - the fiber has just been created and not yet run")
}, },
{ {
"fiber/current", cfun_fiber_current, "fiber/current", cfun_fiber_current,
JDOC("(fiber/current)\n\n" JDOC("(fiber/current)\n\n"
"Returns the currently running fiber.") "Returns the currently running fiber.")
}, },
{ {
"fiber/maxstack", cfun_fiber_maxstack, "fiber/maxstack", cfun_fiber_maxstack,
JDOC("(fiber/maxstack fib)\n\n" JDOC("(fiber/maxstack fib)\n\n"
"Gets the maximum stack size in janet values allowed for a fiber. While memory for " "Gets the maximum stack size in janet values allowed for a fiber. While memory for "
"the fiber's stack is not allocated up front, the fiber will not allocated more " "the fiber's stack is not allocated up front, the fiber will not allocated more "
"than this amount and will throw a stack-overflow error if more memory is needed. ") "than this amount and will throw a stack-overflow error if more memory is needed. ")
}, },
{ {
"fiber/setmaxstack", cfun_fiber_setmaxstack, "fiber/setmaxstack", cfun_fiber_setmaxstack,
JDOC("(fiber/setmaxstack fib maxstack)\n\n" JDOC("(fiber/setmaxstack fib maxstack)\n\n"
"Sets the maximum stack size in janet values for a fiber. By default, the " "Sets the maximum stack size in janet values for a fiber. By default, the "
"maximum stack size is usually 8192.") "maximum stack size is usually 8192.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

89
src/core/gc.c
View File

@ -60,18 +60,37 @@ void janet_mark(Janet x) {
if (depth) { if (depth) {
depth--; depth--;
switch (janet_type(x)) { switch (janet_type(x)) {
default: break; default:
break;
case JANET_STRING: case JANET_STRING:
case JANET_KEYWORD: case JANET_KEYWORD:
case JANET_SYMBOL: janet_mark_string(janet_unwrap_string(x)); break; case JANET_SYMBOL:
case JANET_FUNCTION: janet_mark_function(janet_unwrap_function(x)); break; janet_mark_string(janet_unwrap_string(x));
case JANET_ARRAY: janet_mark_array(janet_unwrap_array(x)); break; break;
case JANET_TABLE: janet_mark_table(janet_unwrap_table(x)); break; case JANET_FUNCTION:
case JANET_STRUCT: janet_mark_struct(janet_unwrap_struct(x)); break; janet_mark_function(janet_unwrap_function(x));
case JANET_TUPLE: janet_mark_tuple(janet_unwrap_tuple(x)); break; break;
case JANET_BUFFER: janet_mark_buffer(janet_unwrap_buffer(x)); break; case JANET_ARRAY:
case JANET_FIBER: janet_mark_fiber(janet_unwrap_fiber(x)); break; janet_mark_array(janet_unwrap_array(x));
case JANET_ABSTRACT: janet_mark_abstract(janet_unwrap_abstract(x)); break; break;
case JANET_TABLE:
janet_mark_table(janet_unwrap_table(x));
break;
case JANET_STRUCT:
janet_mark_struct(janet_unwrap_struct(x));
break;
case JANET_TUPLE:
janet_mark_tuple(janet_unwrap_tuple(x));
break;
case JANET_BUFFER:
janet_mark_buffer(janet_unwrap_buffer(x));
break;
case JANET_FIBER:
janet_mark_fiber(janet_unwrap_fiber(x));
break;
case JANET_ABSTRACT:
janet_mark_abstract(janet_unwrap_abstract(x));
break;
} }
depth++; depth++;
} else { } else {
@ -123,7 +142,7 @@ static void janet_mark_array(JanetArray *array) {
} }
static void janet_mark_table(JanetTable *table) { static void janet_mark_table(JanetTable *table) {
recur: /* Manual tail recursion */ recur: /* Manual tail recursion */
if (janet_gc_reachable(table)) if (janet_gc_reachable(table))
return; return;
janet_gc_mark(table); janet_gc_mark(table);
@ -201,7 +220,7 @@ recur:
/* Mark values on the argument stack */ /* Mark values on the argument stack */
janet_mark_many(fiber->data + fiber->stackstart, janet_mark_many(fiber->data + fiber->stackstart,
fiber->stacktop - fiber->stackstart); fiber->stacktop - fiber->stackstart);
i = fiber->frame; i = fiber->frame;
j = fiber->stackstart - JANET_FRAME_SIZE; j = fiber->stackstart - JANET_FRAME_SIZE;
@ -236,10 +255,10 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
janet_symbol_deinit((const uint8_t *)mem + 2 * sizeof(int32_t)); janet_symbol_deinit((const uint8_t *)mem + 2 * sizeof(int32_t));
break; break;
case JANET_MEMORY_ARRAY: case JANET_MEMORY_ARRAY:
janet_array_deinit((JanetArray*) mem); janet_array_deinit((JanetArray *) mem);
break; break;
case JANET_MEMORY_TABLE: case JANET_MEMORY_TABLE:
janet_table_deinit((JanetTable*) mem); janet_table_deinit((JanetTable *) mem);
break; break;
case JANET_MEMORY_FIBER: case JANET_MEMORY_FIBER:
free(((JanetFiber *)mem)->data); free(((JanetFiber *)mem)->data);
@ -252,24 +271,22 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
janet_assert(!h->type->gc((void *)(h + 1), h->size), "finalizer failed"); janet_assert(!h->type->gc((void *)(h + 1), h->size), "finalizer failed");
} }
break; break;
case JANET_MEMORY_FUNCENV: case JANET_MEMORY_FUNCENV: {
{ JanetFuncEnv *env = (JanetFuncEnv *)mem;
JanetFuncEnv *env = (JanetFuncEnv *)mem; if (0 == env->offset)
if (0 == env->offset) free(env->as.values);
free(env->as.values); }
} break;
break; case JANET_MEMORY_FUNCDEF: {
case JANET_MEMORY_FUNCDEF: JanetFuncDef *def = (JanetFuncDef *)mem;
{ /* TODO - get this all with one alloc and one free */
JanetFuncDef *def = (JanetFuncDef *)mem; free(def->defs);
/* TODO - get this all with one alloc and one free */ free(def->environments);
free(def->defs); free(def->constants);
free(def->environments); free(def->bytecode);
free(def->constants); free(def->sourcemap);
free(def->bytecode); }
free(def->sourcemap); break;
}
break;
} }
} }
@ -417,5 +434,9 @@ void janet_clear_memory(void) {
} }
/* Primitives for suspending GC. */ /* Primitives for suspending GC. */
int janet_gclock(void) { return janet_vm_gc_suspend++; } int janet_gclock(void) {
void janet_gcunlock(int handle) { janet_vm_gc_suspend = handle; } return janet_vm_gc_suspend++;
}
void janet_gcunlock(int handle) {
janet_vm_gc_suspend = handle;
}

86
src/core/io.c
View File

@ -122,7 +122,7 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
if (argc == 2) { if (argc == 2) {
fmode = janet_getkeyword(argv, 1); fmode = janet_getkeyword(argv, 1);
if (janet_string_length(fmode) != 1 || if (janet_string_length(fmode) != 1 ||
!(fmode[0] == 'r' || fmode[0] == 'w')) { !(fmode[0] == 'r' || fmode[0] == 'w')) {
janet_panicf("invalid file mode :%S, expected :r or :w", fmode); janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
} }
flags = IO_PIPED | (fmode[0] == 'r' ? IO_READ : IO_WRITE); flags = IO_PIPED | (fmode[0] == 'r' ? IO_READ : IO_WRITE);
@ -331,66 +331,66 @@ static const JanetReg io_cfuns[] = {
{ {
"file/open", cfun_io_fopen, "file/open", cfun_io_fopen,
JDOC("(file/open path [,mode])\n\n" JDOC("(file/open path [,mode])\n\n"
"Open a file. path is an absolute or relative path, and " "Open a file. path is an absolute or relative path, and "
"mode is a set of flags indicating the mode to open the file in. " "mode is a set of flags indicating the mode to open the file in. "
"mode is a keyword where each character represents a flag. If the file " "mode is a keyword where each character represents a flag. If the file "
"cannot be opened, returns nil, otherwise returns the new file handle. " "cannot be opened, returns nil, otherwise returns the new file handle. "
"Mode flags:\n\n" "Mode flags:\n\n"
"\tr - allow reading from the file\n" "\tr - allow reading from the file\n"
"\tw - allow writing to the file\n" "\tw - allow writing to the file\n"
"\ta - append to the file\n" "\ta - append to the file\n"
"\tb - open the file in binary mode (rather than text mode)\n" "\tb - open the file in binary mode (rather than text mode)\n"
"\t+ - append to the file instead of overwriting it") "\t+ - append to the file instead of overwriting it")
}, },
{ {
"file/close", cfun_io_fclose, "file/close", cfun_io_fclose,
JDOC("(file/close f)\n\n" JDOC("(file/close f)\n\n"
"Close a file and release all related resources. When you are " "Close a file and release all related resources. When you are "
"done reading a file, close it to prevent a resource leak and let " "done reading a file, close it to prevent a resource leak and let "
"other processes read the file.") "other processes read the file.")
}, },
{ {
"file/read", cfun_io_fread, "file/read", cfun_io_fread,
JDOC("(file/read f what [,buf])\n\n" JDOC("(file/read f what [,buf])\n\n"
"Read a number of bytes from a file into a buffer. A buffer can " "Read a number of bytes from a file into a buffer. A buffer can "
"be provided as an optional fourth argument, otherwise a new buffer " "be provided as an optional fourth argument, otherwise a new buffer "
"is created. 'what' can either be an integer or a keyword. Returns the " "is created. 'what' can either be an integer or a keyword. Returns the "
"buffer with file contents. " "buffer with file contents. "
"Values for 'what':\n\n" "Values for 'what':\n\n"
"\t:all - read the whole file\n" "\t:all - read the whole file\n"
"\t:line - read up to and including the next newline character\n" "\t:line - read up to and including the next newline character\n"
"\tn (integer) - read up to n bytes from the file") "\tn (integer) - read up to n bytes from the file")
}, },
{ {
"file/write", cfun_io_fwrite, "file/write", cfun_io_fwrite,
JDOC("(file/write f bytes)\n\n" JDOC("(file/write f bytes)\n\n"
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the " "Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
"file.") "file.")
}, },
{ {
"file/flush", cfun_io_fflush, "file/flush", cfun_io_fflush,
JDOC("(file/flush f)\n\n" JDOC("(file/flush f)\n\n"
"Flush any buffered bytes to the file system. In most files, writes are " "Flush any buffered bytes to the file system. In most files, writes are "
"buffered for efficiency reasons. Returns the file handle.") "buffered for efficiency reasons. Returns the file handle.")
}, },
{ {
"file/seek", cfun_io_fseek, "file/seek", cfun_io_fseek,
JDOC("(file/seek f [,whence [,n]])\n\n" JDOC("(file/seek f [,whence [,n]])\n\n"
"Jump to a relative location in the file. 'whence' must be one of\n\n" "Jump to a relative location in the file. 'whence' must be one of\n\n"
"\t:cur - jump relative to the current file location\n" "\t:cur - jump relative to the current file location\n"
"\t:set - jump relative to the beginning of the file\n" "\t:set - jump relative to the beginning of the file\n"
"\t:end - jump relative to the end of the file\n\n" "\t:end - jump relative to the end of the file\n\n"
"By default, 'whence' is :cur. Optionally a value n may be passed " "By default, 'whence' is :cur. Optionally a value n may be passed "
"for the relative number of bytes to seek in the file. n may be a real " "for the relative number of bytes to seek in the file. n may be a real "
"number to handle large files of more the 4GB. Returns the file handle.") "number to handle large files of more the 4GB. Returns the file handle.")
}, },
{ {
"file/popen", cfun_io_popen, "file/popen", cfun_io_popen,
JDOC("(file/popen path [,mode])\n\n" JDOC("(file/popen path [,mode])\n\n"
"Open a file that is backed by a process. The file must be opened in either " "Open a file that is backed by a process. The file must be opened in either "
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the " "the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
"process can be read from the file. In :w mode, the stdin of the process " "process can be read from the file. In :w mode, the stdin of the process "
"can be written to. Returns the new file.") "can be written to. Returns the new file.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };
@ -401,14 +401,14 @@ void janet_lib_io(JanetTable *env) {
/* stdout */ /* stdout */
janet_core_def(env, "stdout", janet_core_def(env, "stdout",
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE), makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
JDOC("The standard output file.")); JDOC("The standard output file."));
/* stderr */ /* stderr */
janet_core_def(env, "stderr", janet_core_def(env, "stderr",
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE), makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
JDOC("The standard error file.")); JDOC("The standard error file."));
/* stdin */ /* stdin */
janet_core_def(env, "stdin", janet_core_def(env, "stdin",
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE), makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
JDOC("The standard input file.")); JDOC("The standard input file."));
} }

619
src/core/marsh.c
View File

@ -113,8 +113,8 @@ JanetTable *janet_env_lookup(JanetTable *env) {
for (int32_t i = 0; i < env->capacity; i++) { for (int32_t i = 0; i < env->capacity; i++) {
if (janet_checktype(env->data[i].key, JANET_SYMBOL)) { if (janet_checktype(env->data[i].key, JANET_SYMBOL)) {
janet_table_put(renv, janet_table_put(renv,
env->data[i].key, env->data[i].key,
entry_getval(env->data[i].value)); entry_getval(env->data[i].value));
} }
} }
env = env->proto; env = env->proto;
@ -306,15 +306,14 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_TRUE: case JANET_TRUE:
pushbyte(st, 200 + type); pushbyte(st, 200 + type);
goto done; goto done;
case JANET_NUMBER: case JANET_NUMBER: {
{ double xval = janet_unwrap_number(x);
double xval = janet_unwrap_number(x); if (janet_checkintrange(xval)) {
if (janet_checkintrange(xval)) { pushint(st, (int32_t) xval);
pushint(st, (int32_t) xval); goto done;
goto done;
}
break;
} }
break;
}
} }
#define MARK_SEEN() \ #define MARK_SEEN() \
@ -343,132 +342,131 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
/* Reference types */ /* Reference types */
switch (type) { switch (type) {
case JANET_NUMBER: case JANET_NUMBER: {
{ union {
union { double d;
double d; uint8_t bytes[8];
uint8_t bytes[8]; } u;
} u; u.d = janet_unwrap_number(x);
u.d = janet_unwrap_number(x);
#ifdef JANET_BIG_ENDIAN #ifdef JANET_BIG_ENDIAN
/* Swap byte order */ /* Swap byte order */
uint8_t temp; uint8_t temp;
temp = u.bytes[7]; u.bytes[7] = u.bytes[0]; u.bytes[0] = temp; temp = u.bytes[7];
temp = u.bytes[6]; u.bytes[6] = u.bytes[1]; u.bytes[1] = temp; u.bytes[7] = u.bytes[0];
temp = u.bytes[5]; u.bytes[5] = u.bytes[2]; u.bytes[2] = temp; u.bytes[0] = temp;
temp = u.bytes[4]; u.bytes[4] = u.bytes[3]; u.bytes[3] = temp; temp = u.bytes[6];
u.bytes[6] = u.bytes[1];
u.bytes[1] = temp;
temp = u.bytes[5];
u.bytes[5] = u.bytes[2];
u.bytes[2] = temp;
temp = u.bytes[4];
u.bytes[4] = u.bytes[3];
u.bytes[3] = temp;
#endif #endif
pushbyte(st, LB_REAL); pushbyte(st, LB_REAL);
pushbytes(st, u.bytes, 8); pushbytes(st, u.bytes, 8);
MARK_SEEN(); MARK_SEEN();
} }
goto done; goto done;
case JANET_STRING: case JANET_STRING:
case JANET_SYMBOL: case JANET_SYMBOL:
case JANET_KEYWORD: case JANET_KEYWORD: {
{ const uint8_t *str = janet_unwrap_string(x);
const uint8_t *str = janet_unwrap_string(x); int32_t length = janet_string_length(str);
int32_t length = janet_string_length(str); /* Record reference */
/* Record reference */ MARK_SEEN();
MARK_SEEN(); uint8_t lb = (type == JANET_STRING) ? LB_STRING :
uint8_t lb = (type == JANET_STRING) ? LB_STRING : (type == JANET_SYMBOL) ? LB_SYMBOL :
(type == JANET_SYMBOL) ? LB_SYMBOL : LB_KEYWORD;
LB_KEYWORD; pushbyte(st, lb);
pushbyte(st, lb); pushint(st, length);
pushint(st, length); pushbytes(st, str, length);
pushbytes(st, str, length); }
goto done;
case JANET_BUFFER: {
JanetBuffer *buffer = janet_unwrap_buffer(x);
/* Record reference */
MARK_SEEN();
pushbyte(st, LB_BUFFER);
pushint(st, buffer->count);
pushbytes(st, buffer->data, buffer->count);
}
goto done;
case JANET_ARRAY: {
int32_t i;
JanetArray *a = janet_unwrap_array(x);
MARK_SEEN();
pushbyte(st, LB_ARRAY);
pushint(st, a->count);
for (i = 0; i < a->count; i++)
marshal_one(st, a->data[i], flags + 1);
}
goto done;
case JANET_TUPLE: {
int32_t i, count, flag;
const Janet *tup = janet_unwrap_tuple(x);
count = janet_tuple_length(tup);
flag = janet_tuple_flag(tup);
pushbyte(st, LB_TUPLE);
pushint(st, count);
pushint(st, flag);
for (i = 0; i < count; i++)
marshal_one(st, tup[i], flags + 1);
/* Mark as seen AFTER marshaling */
MARK_SEEN();
}
goto done;
case JANET_TABLE: {
JanetTable *t = janet_unwrap_table(x);
MARK_SEEN();
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
pushint(st, t->count);
if (t->proto)
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
for (int32_t i = 0; i < t->capacity; i++) {
if (janet_checktype(t->data[i].key, JANET_NIL))
continue;
marshal_one(st, t->data[i].key, flags + 1);
marshal_one(st, t->data[i].value, flags + 1);
} }
goto done; }
case JANET_BUFFER: goto done;
{ case JANET_STRUCT: {
JanetBuffer *buffer = janet_unwrap_buffer(x); int32_t count;
/* Record reference */ const JanetKV *struct_ = janet_unwrap_struct(x);
MARK_SEEN(); count = janet_struct_length(struct_);
pushbyte(st, LB_BUFFER); pushbyte(st, LB_STRUCT);
pushint(st, buffer->count); pushint(st, count);
pushbytes(st, buffer->data, buffer->count); for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
if (janet_checktype(struct_[i].key, JANET_NIL))
continue;
marshal_one(st, struct_[i].key, flags + 1);
marshal_one(st, struct_[i].value, flags + 1);
} }
goto done; /* Mark as seen AFTER marshaling */
case JANET_ARRAY: MARK_SEEN();
{ }
int32_t i; goto done;
JanetArray *a = janet_unwrap_array(x);
MARK_SEEN();
pushbyte(st, LB_ARRAY);
pushint(st, a->count);
for (i = 0; i < a->count; i++)
marshal_one(st, a->data[i], flags + 1);
}
goto done;
case JANET_TUPLE:
{
int32_t i, count, flag;
const Janet *tup = janet_unwrap_tuple(x);
count = janet_tuple_length(tup);
flag = janet_tuple_flag(tup);
pushbyte(st, LB_TUPLE);
pushint(st, count);
pushint(st, flag);
for (i = 0; i < count; i++)
marshal_one(st, tup[i], flags + 1);
/* Mark as seen AFTER marshaling */
MARK_SEEN();
}
goto done;
case JANET_TABLE:
{
JanetTable *t = janet_unwrap_table(x);
MARK_SEEN();
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
pushint(st, t->count);
if (t->proto)
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
for (int32_t i = 0; i < t->capacity; i++) {
if (janet_checktype(t->data[i].key, JANET_NIL))
continue;
marshal_one(st, t->data[i].key, flags + 1);
marshal_one(st, t->data[i].value, flags + 1);
}
}
goto done;
case JANET_STRUCT:
{
int32_t count;
const JanetKV *struct_ = janet_unwrap_struct(x);
count = janet_struct_length(struct_);
pushbyte(st, LB_STRUCT);
pushint(st, count);
for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
if (janet_checktype(struct_[i].key, JANET_NIL))
continue;
marshal_one(st, struct_[i].key, flags + 1);
marshal_one(st, struct_[i].value, flags + 1);
}
/* Mark as seen AFTER marshaling */
MARK_SEEN();
}
goto done;
case JANET_ABSTRACT: case JANET_ABSTRACT:
case JANET_CFUNCTION: case JANET_CFUNCTION:
goto noregval; goto noregval;
case JANET_FUNCTION: case JANET_FUNCTION: {
{ pushbyte(st, LB_FUNCTION);
pushbyte(st, LB_FUNCTION); JanetFunction *func = janet_unwrap_function(x);
JanetFunction *func = janet_unwrap_function(x); marshal_one_def(st, func->def, flags);
marshal_one_def(st, func->def, flags); /* Mark seen after reading def, but before envs */
/* Mark seen after reading def, but before envs */ MARK_SEEN();
MARK_SEEN(); for (int32_t i = 0; i < func->def->environments_length; i++)
for (int32_t i = 0; i < func->def->environments_length; i++) marshal_one_env(st, func->envs[i], flags + 1);
marshal_one_env(st, func->envs[i], flags + 1); }
} goto done;
goto done; case JANET_FIBER: {
case JANET_FIBER: MARK_SEEN();
{ pushbyte(st, LB_FIBER);
MARK_SEEN(); marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
pushbyte(st, LB_FIBER); }
marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1); goto done;
}
goto done;
default: default:
goto nyi; goto nyi;
} }
@ -489,11 +487,11 @@ noregval:
} }
int janet_marshal( int janet_marshal(
JanetBuffer *buf, JanetBuffer *buf,
Janet x, Janet x,
Janet *errval, Janet *errval,
JanetTable *rreg, JanetTable *rreg,
int flags) { int flags) {
int status; int status;
MarshalState st; MarshalState st;
st.buf = buf; st.buf = buf;
@ -565,9 +563,9 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
} else if (*data == LB_INTEGER) { } else if (*data == LB_INTEGER) {
if (data + 5 > st->end) longjmp(st->err, UMR_EOS); if (data + 5 > st->end) longjmp(st->err, UMR_EOS);
ret = ((int32_t)(data[1]) << 24) | ret = ((int32_t)(data[1]) << 24) |
((int32_t)(data[2]) << 16) | ((int32_t)(data[2]) << 16) |
((int32_t)(data[3]) << 8) | ((int32_t)(data[3]) << 8) |
(int32_t)(data[4]); (int32_t)(data[4]);
data += 5; data += 5;
} else { } else {
longjmp(st->err, UMR_EXPECTED_INTEGER); longjmp(st->err, UMR_EXPECTED_INTEGER);
@ -578,32 +576,32 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
/* Forward declarations for mutual recursion */ /* Forward declarations for mutual recursion */
static const uint8_t *unmarshal_one( static const uint8_t *unmarshal_one(
UnmarshalState *st, UnmarshalState *st,
const uint8_t *data, const uint8_t *data,
Janet *out, Janet *out,
int flags); int flags);
static const uint8_t *unmarshal_one_env( static const uint8_t *unmarshal_one_env(
UnmarshalState *st, UnmarshalState *st,
const uint8_t *data, const uint8_t *data,
JanetFuncEnv **out, JanetFuncEnv **out,
int flags); int flags);
static const uint8_t *unmarshal_one_def( static const uint8_t *unmarshal_one_def(
UnmarshalState *st, UnmarshalState *st,
const uint8_t *data, const uint8_t *data,
JanetFuncDef **out, JanetFuncDef **out,
int flags); int flags);
static const uint8_t *unmarshal_one_fiber( static const uint8_t *unmarshal_one_fiber(
UnmarshalState *st, UnmarshalState *st,
const uint8_t *data, const uint8_t *data,
JanetFiber **out, JanetFiber **out,
int flags); int flags);
/* Unmarshal a funcenv */ /* Unmarshal a funcenv */
static const uint8_t *unmarshal_one_env( static const uint8_t *unmarshal_one_env(
UnmarshalState *st, UnmarshalState *st,
const uint8_t *data, const uint8_t *data,
JanetFuncEnv **out, JanetFuncEnv **out,
int flags) { int flags) {
const uint8_t *end = st->end; const uint8_t *end = st->end;
if (data >= end) longjmp(st->err, UMR_EOS); if (data >= end) longjmp(st->err, UMR_EOS);
if (*data == LB_FUNCENV_REF) { if (*data == LB_FUNCENV_REF) {
@ -646,10 +644,10 @@ static const uint8_t *unmarshal_one_env(
/* Unmarshal a funcdef */ /* Unmarshal a funcdef */
static const uint8_t *unmarshal_one_def( static const uint8_t *unmarshal_one_def(
UnmarshalState *st, UnmarshalState *st,
const uint8_t *data, const uint8_t *data,
JanetFuncDef **out, JanetFuncDef **out,
int flags) { int flags) {
const uint8_t *end = st->end; const uint8_t *end = st->end;
if (data >= end) longjmp(st->err, UMR_EOS); if (data >= end) longjmp(st->err, UMR_EOS);
if (*data == LB_FUNCDEF_REF) { if (*data == LB_FUNCDEF_REF) {
@ -788,10 +786,10 @@ static const uint8_t *unmarshal_one_def(
/* Unmarshal a fiber */ /* Unmarshal a fiber */
static const uint8_t *unmarshal_one_fiber( static const uint8_t *unmarshal_one_fiber(
UnmarshalState *st, UnmarshalState *st,
const uint8_t *data, const uint8_t *data,
JanetFiber **out, JanetFiber **out,
int flags) { int flags) {
/* Initialize a new fiber */ /* Initialize a new fiber */
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber)); JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
@ -909,10 +907,10 @@ error:
} }
static const uint8_t *unmarshal_one( static const uint8_t *unmarshal_one(
UnmarshalState *st, UnmarshalState *st,
const uint8_t *data, const uint8_t *data,
Janet *out, Janet *out,
int flags) { int flags) {
const uint8_t *end = st->end; const uint8_t *end = st->end;
uint8_t lead; uint8_t lead;
if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) { if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) {
@ -939,91 +937,88 @@ static const uint8_t *unmarshal_one(
/* Long integer */ /* Long integer */
EXTRA(5); EXTRA(5);
*out = janet_wrap_integer( *out = janet_wrap_integer(
(data[4]) | (data[4]) |
(data[3] << 8) | (data[3] << 8) |
(data[2] << 16) | (data[2] << 16) |
(data[1] << 24)); (data[1] << 24));
return data + 5; return data + 5;
case LB_REAL: case LB_REAL:
/* Real */ /* Real */
{ {
union { union {
double d; double d;
uint8_t bytes[8]; uint8_t bytes[8];
} u; } u;
EXTRA(9); EXTRA(9);
#ifdef JANET_BIG_ENDIAN #ifdef JANET_BIG_ENDIAN
u.bytes[0] = data[8]; u.bytes[0] = data[8];
u.bytes[1] = data[7]; u.bytes[1] = data[7];
u.bytes[2] = data[6]; u.bytes[2] = data[6];
u.bytes[5] = data[5]; u.bytes[5] = data[5];
u.bytes[4] = data[4]; u.bytes[4] = data[4];
u.bytes[5] = data[3]; u.bytes[5] = data[3];
u.bytes[6] = data[2]; u.bytes[6] = data[2];
u.bytes[7] = data[1]; u.bytes[7] = data[1];
#else #else
memcpy(&u.bytes, data + 1, sizeof(double)); memcpy(&u.bytes, data + 1, sizeof(double));
#endif #endif
*out = janet_wrap_number(u.d); *out = janet_wrap_number(u.d);
janet_array_push(&st->lookup, *out); janet_array_push(&st->lookup, *out);
return data + 9; return data + 9;
} }
case LB_STRING: case LB_STRING:
case LB_SYMBOL: case LB_SYMBOL:
case LB_BUFFER: case LB_BUFFER:
case LB_KEYWORD: case LB_KEYWORD:
case LB_REGISTRY: case LB_REGISTRY: {
{ data++;
data++; int32_t len = readint(st, &data);
int32_t len = readint(st, &data); EXTRA(len);
EXTRA(len); if (lead == LB_STRING) {
if (lead == LB_STRING) { const uint8_t *str = janet_string(data, len);
const uint8_t *str = janet_string(data, len); *out = janet_wrap_string(str);
*out = janet_wrap_string(str); } else if (lead == LB_SYMBOL) {
} else if (lead == LB_SYMBOL) { const uint8_t *str = janet_symbol(data, len);
const uint8_t *str = janet_symbol(data, len); *out = janet_wrap_symbol(str);
*out = janet_wrap_symbol(str); } else if (lead == LB_KEYWORD) {
} else if (lead == LB_KEYWORD) { const uint8_t *str = janet_keyword(data, len);
const uint8_t *str = janet_keyword(data, len); *out = janet_wrap_keyword(str);
*out = janet_wrap_keyword(str); } else if (lead == LB_REGISTRY) {
} else if (lead == LB_REGISTRY) { if (st->reg) {
if (st->reg) { Janet regkey = janet_symbolv(data, len);
Janet regkey = janet_symbolv(data, len); *out = janet_table_get(st->reg, regkey);
*out = janet_table_get(st->reg, regkey); } else {
} else { *out = janet_wrap_nil();
*out = janet_wrap_nil();
}
} else { /* (lead == LB_BUFFER) */
JanetBuffer *buffer = janet_buffer(len);
buffer->count = len;
memcpy(buffer->data, data, len);
*out = janet_wrap_buffer(buffer);
} }
janet_array_push(&st->lookup, *out); } else { /* (lead == LB_BUFFER) */
return data + len; JanetBuffer *buffer = janet_buffer(len);
buffer->count = len;
memcpy(buffer->data, data, len);
*out = janet_wrap_buffer(buffer);
} }
case LB_FIBER: janet_array_push(&st->lookup, *out);
{ return data + len;
JanetFiber *fiber; }
data = unmarshal_one_fiber(st, data + 1, &fiber, flags); case LB_FIBER: {
*out = janet_wrap_fiber(fiber); JanetFiber *fiber;
return data; data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
} *out = janet_wrap_fiber(fiber);
case LB_FUNCTION: return data;
{ }
JanetFunction *func; case LB_FUNCTION: {
JanetFuncDef *def; JanetFunction *func;
data = unmarshal_one_def(st, data + 1, &def, flags + 1); JanetFuncDef *def;
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + data = unmarshal_one_def(st, data + 1, &def, flags + 1);
def->environments_length * sizeof(JanetFuncEnv)); func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
func->def = def; def->environments_length * sizeof(JanetFuncEnv));
*out = janet_wrap_function(func); func->def = def;
janet_array_push(&st->lookup, *out); *out = janet_wrap_function(func);
for (int32_t i = 0; i < def->environments_length; i++) { janet_array_push(&st->lookup, *out);
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1); for (int32_t i = 0; i < def->environments_length; i++) {
} data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
return data;
} }
return data;
}
case LB_REFERENCE: case LB_REFERENCE:
case LB_ARRAY: case LB_ARRAY:
case LB_TUPLE: case LB_TUPLE:
@ -1031,63 +1026,63 @@ static const uint8_t *unmarshal_one(
case LB_TABLE: case LB_TABLE:
case LB_TABLE_PROTO: case LB_TABLE_PROTO:
/* Things that open with integers */ /* Things that open with integers */
{ {
data++; data++;
int32_t len = readint(st, &data); int32_t len = readint(st, &data);
if (lead == LB_ARRAY) { if (lead == LB_ARRAY) {
/* Array */ /* Array */
JanetArray *array = janet_array(len); JanetArray *array = janet_array(len);
array->count = len; array->count = len;
*out = janet_wrap_array(array); *out = janet_wrap_array(array);
janet_array_push(&st->lookup, *out); janet_array_push(&st->lookup, *out);
for (int32_t i = 0; i < len; i++) { for (int32_t i = 0; i < len; i++) {
data = unmarshal_one(st, data, array->data + i, flags + 1); data = unmarshal_one(st, data, array->data + i, flags + 1);
} }
} else if (lead == LB_TUPLE) { } else if (lead == LB_TUPLE) {
/* Tuple */ /* Tuple */
Janet *tup = janet_tuple_begin(len); Janet *tup = janet_tuple_begin(len);
int32_t flag = readint(st, &data); int32_t flag = readint(st, &data);
janet_tuple_flag(tup) = flag; janet_tuple_flag(tup) = flag;
for (int32_t i = 0; i < len; i++) { for (int32_t i = 0; i < len; i++) {
data = unmarshal_one(st, data, tup + i, flags + 1); data = unmarshal_one(st, data, tup + i, flags + 1);
} }
*out = janet_wrap_tuple(janet_tuple_end(tup)); *out = janet_wrap_tuple(janet_tuple_end(tup));
janet_array_push(&st->lookup, *out); janet_array_push(&st->lookup, *out);
} else if (lead == LB_STRUCT) { } else if (lead == LB_STRUCT) {
/* Struct */ /* Struct */
JanetKV *struct_ = janet_struct_begin(len); JanetKV *struct_ = janet_struct_begin(len);
for (int32_t i = 0; i < len; i++) { for (int32_t i = 0; i < len; i++) {
Janet key, value; Janet key, value;
data = unmarshal_one(st, data, &key, flags + 1); data = unmarshal_one(st, data, &key, flags + 1);
data = unmarshal_one(st, data, &value, flags + 1); data = unmarshal_one(st, data, &value, flags + 1);
janet_struct_put(struct_, key, value); janet_struct_put(struct_, key, value);
} }
*out = janet_wrap_struct(janet_struct_end(struct_)); *out = janet_wrap_struct(janet_struct_end(struct_));
janet_array_push(&st->lookup, *out); janet_array_push(&st->lookup, *out);
} else if (lead == LB_REFERENCE) { } else if (lead == LB_REFERENCE) {
if (len < 0 || len >= st->lookup.count) if (len < 0 || len >= st->lookup.count)
longjmp(st->err, UMR_INVALID_REFERENCE); longjmp(st->err, UMR_INVALID_REFERENCE);
*out = st->lookup.data[len]; *out = st->lookup.data[len];
} else { } else {
/* Table */ /* Table */
JanetTable *t = janet_table(len); JanetTable *t = janet_table(len);
*out = janet_wrap_table(t); *out = janet_wrap_table(t);
janet_array_push(&st->lookup, *out); janet_array_push(&st->lookup, *out);
if (lead == LB_TABLE_PROTO) { if (lead == LB_TABLE_PROTO) {
Janet proto; Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1); data = unmarshal_one(st, data, &proto, flags + 1);
if (!janet_checktype(proto, JANET_TABLE)) longjmp(st->err, UMR_EXPECTED_TABLE); if (!janet_checktype(proto, JANET_TABLE)) longjmp(st->err, UMR_EXPECTED_TABLE);
t->proto = janet_unwrap_table(proto); t->proto = janet_unwrap_table(proto);
} }
for (int32_t i = 0; i < len; i++) { for (int32_t i = 0; i < len; i++) {
Janet key, value; Janet key, value;
data = unmarshal_one(st, data, &key, flags + 1); data = unmarshal_one(st, data, &key, flags + 1);
data = unmarshal_one(st, data, &value, flags + 1); data = unmarshal_one(st, data, &value, flags + 1);
janet_table_put(t, key, value); janet_table_put(t, key, value);
}
} }
return data;
} }
return data;
}
default: default:
longjmp(st->err, UMR_UNKNOWN); longjmp(st->err, UMR_UNKNOWN);
return NULL; return NULL;
@ -1096,12 +1091,12 @@ static const uint8_t *unmarshal_one(
} }
int janet_unmarshal( int janet_unmarshal(
const uint8_t *bytes, const uint8_t *bytes,
size_t len, size_t len,
int flags, int flags,
Janet *out, Janet *out,
JanetTable *reg, JanetTable *reg,
const uint8_t **next) { const uint8_t **next) {
int status; int status;
/* Avoid longjmp clobber warning in GCC */ /* Avoid longjmp clobber warning in GCC */
UnmarshalState st; UnmarshalState st;
@ -1168,26 +1163,26 @@ static const JanetReg marsh_cfuns[] = {
{ {
"marshal", cfun_marshal, "marshal", cfun_marshal,
JDOC("(marshal x [,reverse-lookup [,buffer]])\n\n" JDOC("(marshal x [,reverse-lookup [,buffer]])\n\n"
"Marshal a janet value into a buffer and return the buffer. The buffer " "Marshal a janet value into a buffer and return the buffer. The buffer "
"can the later be unmarshalled to reconstruct the initial value. " "can the later be unmarshalled to reconstruct the initial value. "
"Optionally, one can pass in a reverse lookup table to not marshal " "Optionally, one can pass in a reverse lookup table to not marshal "
"aliased values that are found in the table. Then a forward" "aliased values that are found in the table. Then a forward"
"lookup table can be used to recover the original janet value when " "lookup table can be used to recover the original janet value when "
"unmarshalling.") "unmarshalling.")
}, },
{ {
"unmarshal", cfun_unmarshal, "unmarshal", cfun_unmarshal,
JDOC("(unmarshal buffer [,lookup])\n\n" JDOC("(unmarshal buffer [,lookup])\n\n"
"Unmarshal a janet value from a buffer. An optional lookup table " "Unmarshal a janet value from a buffer. An optional lookup table "
"can be provided to allow for aliases to be resolved. Returns the value " "can be provided to allow for aliases to be resolved. Returns the value "
"unmarshalled from the buffer.") "unmarshalled from the buffer.")
}, },
{ {
"env-lookup", cfun_env_lookup, "env-lookup", cfun_env_lookup,
JDOC("(env-lookup env)\n\n" JDOC("(env-lookup env)\n\n"
"Creates a forward lookup table for unmarshalling from an environment. " "Creates a forward lookup table for unmarshalling from an environment. "
"To create a reverse lookup table, use the invert function to swap keys " "To create a reverse lookup table, use the invert function to swap keys "
"and values in the returned table.") "and values in the returned table.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

50
src/core/math.c
View File

@ -94,7 +94,7 @@ static const JanetReg math_cfuns[] = {
{ {
"%", janet_remainder, "%", janet_remainder,
JDOC("(% dividend divisor)\n\n" JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor.") "Returns the remainder of dividend / divisor.")
}, },
{ {
"not", janet_not, "not", janet_not,
@ -103,103 +103,103 @@ static const JanetReg math_cfuns[] = {
{ {
"math/random", janet_rand, "math/random", janet_rand,
JDOC("(math/random)\n\n" JDOC("(math/random)\n\n"
"Returns a uniformly distributed random number between 0 and 1.") "Returns a uniformly distributed random number between 0 and 1.")
}, },
{ {
"math/seedrandom", janet_srand, "math/seedrandom", janet_srand,
JDOC("(math/seedrandom seed)\n\n" JDOC("(math/seedrandom seed)\n\n"
"Set the seed for the random number generator. 'seed' should be an " "Set the seed for the random number generator. 'seed' should be an "
"an integer.") "an integer.")
}, },
{ {
"math/cos", janet_cos, "math/cos", janet_cos,
JDOC("(math/cos x)\n\n" JDOC("(math/cos x)\n\n"
"Returns the cosine of x.") "Returns the cosine of x.")
}, },
{ {
"math/sin", janet_sin, "math/sin", janet_sin,
JDOC("(math/sin x)\n\n" JDOC("(math/sin x)\n\n"
"Returns the sine of x.") "Returns the sine of x.")
}, },
{ {
"math/tan", janet_tan, "math/tan", janet_tan,
JDOC("(math/tan x)\n\n" JDOC("(math/tan x)\n\n"
"Returns the tangent of x.") "Returns the tangent of x.")
}, },
{ {
"math/acos", janet_acos, "math/acos", janet_acos,
JDOC("(math/acos x)\n\n" JDOC("(math/acos x)\n\n"
"Returns the arccosine of x.") "Returns the arccosine of x.")
}, },
{ {
"math/asin", janet_asin, "math/asin", janet_asin,
JDOC("(math/asin x)\n\n" JDOC("(math/asin x)\n\n"
"Returns the arcsine of x.") "Returns the arcsine of x.")
}, },
{ {
"math/atan", janet_atan, "math/atan", janet_atan,
JDOC("(math/atan x)\n\n" JDOC("(math/atan x)\n\n"
"Returns the arctangent of x.") "Returns the arctangent of x.")
}, },
{ {
"math/exp", janet_exp, "math/exp", janet_exp,
JDOC("(math/exp x)\n\n" JDOC("(math/exp x)\n\n"
"Returns e to the power of x.") "Returns e to the power of x.")
}, },
{ {
"math/log", janet_log, "math/log", janet_log,
JDOC("(math/log x)\n\n" JDOC("(math/log x)\n\n"
"Returns log base 2 of x.") "Returns log base 2 of x.")
}, },
{ {
"math/log10", janet_log10, "math/log10", janet_log10,
JDOC("(math/log10 x)\n\n" JDOC("(math/log10 x)\n\n"
"Returns log base 10 of x.") "Returns log base 10 of x.")
}, },
{ {
"math/sqrt", janet_sqrt, "math/sqrt", janet_sqrt,
JDOC("(math/sqrt x)\n\n" JDOC("(math/sqrt x)\n\n"
"Returns the square root of x.") "Returns the square root of x.")
}, },
{ {
"math/floor", janet_floor, "math/floor", janet_floor,
JDOC("(math/floor x)\n\n" JDOC("(math/floor x)\n\n"
"Returns the largest integer value number that is not greater than x.") "Returns the largest integer value number that is not greater than x.")
}, },
{ {
"math/ceil", janet_ceil, "math/ceil", janet_ceil,
JDOC("(math/ceil x)\n\n" JDOC("(math/ceil x)\n\n"
"Returns the smallest integer value number that is not less than x.") "Returns the smallest integer value number that is not less than x.")
}, },
{ {
"math/pow", janet_pow, "math/pow", janet_pow,
JDOC("(math/pow a x)\n\n" JDOC("(math/pow a x)\n\n"
"Return a to the power of x.") "Return a to the power of x.")
}, },
{ {
"math/abs", janet_fabs, "math/abs", janet_fabs,
JDOC("(math/abs x)\n\n" JDOC("(math/abs x)\n\n"
"Return the absolute value of x.") "Return the absolute value of x.")
}, },
{ {
"math/sinh", janet_sinh, "math/sinh", janet_sinh,
JDOC("(math/sinh x)\n\n" JDOC("(math/sinh x)\n\n"
"Return the hyperbolic sine of x.") "Return the hyperbolic sine of x.")
}, },
{ {
"math/cosh", janet_cosh, "math/cosh", janet_cosh,
JDOC("(math/cosh x)\n\n" JDOC("(math/cosh x)\n\n"
"Return the hyperbolic cosine of x.") "Return the hyperbolic cosine of x.")
}, },
{ {
"math/tanh", janet_tanh, "math/tanh", janet_tanh,
JDOC("(math/tanh x)\n\n" JDOC("(math/tanh x)\n\n"
"Return the hyperbolic tangent of x.") "Return the hyperbolic tangent of x.")
}, },
{ {
"math/atan2", janet_atan2, "math/atan2", janet_atan2,
JDOC("(math/atan2 y x)\n\n" JDOC("(math/atan2 y x)\n\n"
"Return the arctangent of y/x. Works even when x is 0.") "Return the arctangent of y/x. Works even when x is 0.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };
@ -209,10 +209,10 @@ void janet_lib_math(JanetTable *env) {
janet_core_cfuns(env, NULL, math_cfuns); janet_core_cfuns(env, NULL, math_cfuns);
#ifdef JANET_BOOTSTRAP #ifdef JANET_BOOTSTRAP
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931), janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
JDOC("The value pi.")); JDOC("The value pi."));
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451), janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
JDOC("The base of the natural log.")); JDOC("The base of the natural log."));
janet_def(env, "math/inf", janet_wrap_number(INFINITY), janet_def(env, "math/inf", janet_wrap_number(INFINITY),
JDOC("The number representing positive infinity")); JDOC("The number representing positive infinity"));
#endif #endif
} }

128
src/core/os.c
View File

@ -47,15 +47,15 @@
static Janet os_which(int32_t argc, Janet *argv) { static Janet os_which(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0); janet_fixarity(argc, 0);
(void) argv; (void) argv;
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
return janet_ckeywordv("windows"); return janet_ckeywordv("windows");
#elif __APPLE__ #elif __APPLE__
return janet_ckeywordv("macos"); return janet_ckeywordv("macos");
#elif defined(__EMSCRIPTEN__) #elif defined(__EMSCRIPTEN__)
return janet_ckeywordv("web"); return janet_ckeywordv("web");
#else #else
return janet_ckeywordv("posix"); return janet_ckeywordv("posix");
#endif #endif
} }
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
@ -77,12 +77,12 @@ static Janet os_execute(int32_t argc, Janet *argv) {
JANET_OUT_OF_MEMORY; JANET_OUT_OF_MEMORY;
} }
int nwritten = MultiByteToWideChar( int nwritten = MultiByteToWideChar(
CP_UTF8, CP_UTF8,
MB_PRECOMPOSED, MB_PRECOMPOSED,
buffer->data, buffer->data,
buffer->count, buffer->count,
sys_str, sys_str,
buffer->count); buffer->count);
if (nwritten == 0) { if (nwritten == 0) {
free(sys_str); free(sys_str);
janet_panic("could not create process"); janet_panic("could not create process");
@ -96,16 +96,16 @@ static Janet os_execute(int32_t argc, Janet *argv) {
ZeroMemory(&pi, sizeof(pi)); ZeroMemory(&pi, sizeof(pi));
// Start the child process. // Start the child process.
if(!CreateProcess(NULL, if (!CreateProcess(NULL,
(LPSTR) sys_str, (LPSTR) sys_str,
NULL, NULL,
NULL, NULL,
FALSE, FALSE,
0, 0,
NULL, NULL,
NULL, NULL,
&si, &si,
&pi)) { &pi)) {
free(sys_str); free(sys_str);
janet_panic("could not create process"); janet_panic("could not create process");
} }
@ -151,12 +151,12 @@ static Janet os_execute(int32_t argc, Janet *argv) {
static Janet os_shell(int32_t argc, Janet *argv) { static Janet os_shell(int32_t argc, Janet *argv) {
janet_arity(argc, 0, 1); janet_arity(argc, 0, 1);
const char *cmd = argc const char *cmd = argc
? (const char *)janet_getstring(argv, 0) ? (const char *)janet_getstring(argv, 0)
: NULL; : NULL;
int stat = system(cmd); int stat = system(cmd);
return argc return argc
? janet_wrap_integer(stat) ? janet_wrap_integer(stat)
: janet_wrap_boolean(stat); : janet_wrap_boolean(stat);
} }
static Janet os_getenv(int32_t argc, Janet *argv) { static Janet os_getenv(int32_t argc, Janet *argv) {
@ -165,8 +165,8 @@ static Janet os_getenv(int32_t argc, Janet *argv) {
const char *cstr = (const char *) k; const char *cstr = (const char *) k;
const char *res = getenv(cstr); const char *res = getenv(cstr);
return (res && cstr) return (res && cstr)
? janet_cstringv(res) ? janet_cstringv(res)
: janet_wrap_nil(); : janet_wrap_nil();
} }
static Janet os_setenv(int32_t argc, Janet *argv) { static Janet os_setenv(int32_t argc, Janet *argv) {
@ -212,7 +212,7 @@ static Janet os_time(int32_t argc, Janet *argv) {
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
static int gettime(struct timespec *spec) { static int gettime(struct timespec *spec) {
int64_t wintime = 0LL; int64_t wintime = 0LL;
GetSystemTimeAsFileTime((FILETIME*)&wintime); GetSystemTimeAsFileTime((FILETIME *)&wintime);
/* Windows epoch is January 1, 1601 apparently*/ /* Windows epoch is January 1, 1601 apparently*/
wintime -= 116444736000000000LL; wintime -= 116444736000000000LL;
spec->tv_sec = wintime / 10000000LL; spec->tv_sec = wintime / 10000000LL;
@ -249,13 +249,13 @@ static Janet os_sleep(int32_t argc, Janet *argv) {
double delay = janet_getnumber(argv, 0); double delay = janet_getnumber(argv, 0);
if (delay < 0) janet_panic("invalid argument to sleep"); if (delay < 0) janet_panic("invalid argument to sleep");
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
Sleep((DWORD) (delay * 1000)); Sleep((DWORD)(delay * 1000));
#else #else
struct timespec ts; struct timespec ts;
ts.tv_sec = (time_t) delay; ts.tv_sec = (time_t) delay;
ts.tv_nsec = (delay <= UINT32_MAX) ts.tv_nsec = (delay <= UINT32_MAX)
? (long)((delay - ((uint32_t)delay)) * 1000000000) ? (long)((delay - ((uint32_t)delay)) * 1000000000)
: 0; : 0;
nanosleep(&ts, NULL); nanosleep(&ts, NULL);
#endif #endif
return janet_wrap_nil(); return janet_wrap_nil();
@ -303,75 +303,75 @@ static const JanetReg os_cfuns[] = {
{ {
"os/which", os_which, "os/which", os_which,
JDOC("(os/which)\n\n" JDOC("(os/which)\n\n"
"Check the current operating system. Returns one of:\n\n" "Check the current operating system. Returns one of:\n\n"
"\t:windows - Microsoft Windows\n" "\t:windows - Microsoft Windows\n"
"\t:macos - Apple macos\n" "\t:macos - Apple macos\n"
"\t:posix - A POSIX compatible system (default)") "\t:posix - A POSIX compatible system (default)")
}, },
{ {
"os/execute", os_execute, "os/execute", os_execute,
JDOC("(os/execute program & args)\n\n" JDOC("(os/execute program & args)\n\n"
"Execute a program on the system and pass it string arguments. Returns " "Execute a program on the system and pass it string arguments. Returns "
"the exit status of the program.") "the exit status of the program.")
}, },
{ {
"os/shell", os_shell, "os/shell", os_shell,
JDOC("(os/shell str)\n\n" JDOC("(os/shell str)\n\n"
"Pass a command string str directly to the system shell.") "Pass a command string str directly to the system shell.")
}, },
{ {
"os/exit", os_exit, "os/exit", os_exit,
JDOC("(os/exit x)\n\n" JDOC("(os/exit x)\n\n"
"Exit from janet with an exit code equal to x. If x is not an integer, " "Exit from janet with an exit code equal to x. If x is not an integer, "
"the exit with status equal the hash of x.") "the exit with status equal the hash of x.")
}, },
{ {
"os/getenv", os_getenv, "os/getenv", os_getenv,
JDOC("(os/getenv variable)\n\n" JDOC("(os/getenv variable)\n\n"
"Get the string value of an environment variable.") "Get the string value of an environment variable.")
}, },
{ {
"os/setenv", os_setenv, "os/setenv", os_setenv,
JDOC("(os/setenv variable value)\n\n" JDOC("(os/setenv variable value)\n\n"
"Set an environment variable.") "Set an environment variable.")
}, },
{ {
"os/time", os_time, "os/time", os_time,
JDOC("(os/time)\n\n" JDOC("(os/time)\n\n"
"Get the current time expressed as the number of seconds since " "Get the current time expressed as the number of seconds since "
"January 1, 1970, the Unix epoch. Returns a real number.") "January 1, 1970, the Unix epoch. Returns a real number.")
}, },
{ {
"os/clock", os_clock, "os/clock", os_clock,
JDOC("(os/clock)\n\n" JDOC("(os/clock)\n\n"
"Return the number of seconds since some fixed point in time. The clock " "Return the number of seconds since some fixed point in time. The clock "
"is guaranteed to be non decreasing in real time.") "is guaranteed to be non decreasing in real time.")
}, },
{ {
"os/sleep", os_sleep, "os/sleep", os_sleep,
JDOC("(os/sleep nsec)\n\n" JDOC("(os/sleep nsec)\n\n"
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns " "Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
"nil.") "nil.")
}, },
{ {
"os/cwd", os_cwd, "os/cwd", os_cwd,
JDOC("(os/cwd)\n\n" JDOC("(os/cwd)\n\n"
"Returns the current working directory.") "Returns the current working directory.")
}, },
{ {
"os/date", os_date, "os/date", os_date,
JDOC("(os/date [,time])\n\n" JDOC("(os/date [,time])\n\n"
"Returns the given time as a date struct, or the current time if no time is given. " "Returns the given time as a date struct, or the current time if no time is given. "
"Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n" "Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
"\t:seconds - number of seconds [0-61]\n" "\t:seconds - number of seconds [0-61]\n"
"\t:minutes - number of minutes [0-59]\n" "\t:minutes - number of minutes [0-59]\n"
"\t:seconds - number of hours [0-23]\n" "\t:seconds - number of hours [0-23]\n"
"\t:month-day - day of month [0-30]\n" "\t:month-day - day of month [0-30]\n"
"\t:month - month of year [0, 11]\n" "\t:month - month of year [0, 11]\n"
"\t:year - years since year 0 (e.g. 2019)\n" "\t:year - years since year 0 (e.g. 2019)\n"
"\t:week-day - day of the week [0-6]\n" "\t:week-day - day of the week [0-6]\n"
"\t:year-day - day of the year [0-365]\n" "\t:year-day - day of the year [0-365]\n"
"\t:dst - If Day Light Savings is in effect") "\t:dst - If Day Light Savings is in effect")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

200
src/core/parse.c
View File

@ -28,11 +28,11 @@
/* Check if a character is whitespace */ /* Check if a character is whitespace */
static int is_whitespace(uint8_t c) { static int is_whitespace(uint8_t c) {
return c == ' ' return c == ' '
|| c == '\t' || c == '\t'
|| c == '\n' || c == '\n'
|| c == '\r' || c == '\r'
|| c == '\0' || c == '\0'
|| c == '\f'; || c == '\f';
} }
/* Code generated by tools/symcharsgen.c. /* Code generated by tools/symcharsgen.c.
@ -191,17 +191,28 @@ static void popstate(JanetParser *p, Janet val) {
static int checkescape(uint8_t c) { static int checkescape(uint8_t c) {
switch (c) { switch (c) {
default: return -1; default:
case 'x': return 1; return -1;
case 'n': return '\n'; case 'x':
case 't': return '\t'; return 1;
case 'r': return '\r'; case 'n':
case '0': return '\0'; return '\n';
case 'z': return '\0'; case 't':
case 'f': return '\f'; return '\t';
case 'e': return 27; case 'r':
case '"': return '"'; return '\r';
case '\\': return '\\'; case '0':
return '\0';
case 'z':
return '\0';
case 'f':
return '\f';
case 'e':
return 27;
case '"':
return '"';
case '\\':
return '\\';
} }
} }
@ -421,23 +432,23 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
(void) state; (void) state;
p->statecount--; p->statecount--;
switch (c) { switch (c) {
case '{': case '{':
pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS | PFLAG_ATSYM); pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS | PFLAG_ATSYM);
return 1; return 1;
case '"': case '"':
pushstate(p, stringchar, PFLAG_BUFFER | PFLAG_STRING); pushstate(p, stringchar, PFLAG_BUFFER | PFLAG_STRING);
return 1; return 1;
case '`': case '`':
pushstate(p, longstring, PFLAG_BUFFER | PFLAG_LONGSTRING); pushstate(p, longstring, PFLAG_BUFFER | PFLAG_LONGSTRING);
return 1; return 1;
case '[': case '[':
pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS | PFLAG_ATSYM); pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS | PFLAG_ATSYM);
return 1; return 1;
case '(': case '(':
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS | PFLAG_ATSYM); pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS | PFLAG_ATSYM);
return 1; return 1;
default: default:
break; break;
} }
pushstate(p, tokenchar, 0); pushstate(p, tokenchar, 0);
push_buf(p, '@'); /* Push the leading ampersand that was dropped */ push_buf(p, '@'); /* Push the leading ampersand that was dropped */
@ -475,37 +486,36 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
return 1; return 1;
case ')': case ')':
case ']': case ']':
case '}': case '}': {
{ Janet ds;
Janet ds; if (p->statecount == 1) {
if (p->statecount == 1) { p->error = "unexpected delimiter";
p->error = "unexpected delimiter"; return 1;
return 1;
}
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
(c == ']' && (state->flags & PFLAG_SQRBRACKETS))) {
if (state->flags & PFLAG_ATSYM) {
ds = close_array(p, state);
} else {
ds = close_tuple(p, state, c == ']' ? JANET_TUPLE_FLAG_BRACKETCTOR : 0);
}
} else if (c == '}' && (state->flags & PFLAG_CURLYBRACKETS)) {
if (state->argn & 1) {
p->error = "struct and table literals expect even number of arguments";
return 1;
}
if (state->flags & PFLAG_ATSYM) {
ds = close_table(p, state);
} else {
ds = close_struct(p, state);
}
} else {
p->error = "mismatched delimiter";
return 1;
}
popstate(p, ds);
} }
return 1; if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
(c == ']' && (state->flags & PFLAG_SQRBRACKETS))) {
if (state->flags & PFLAG_ATSYM) {
ds = close_array(p, state);
} else {
ds = close_tuple(p, state, c == ']' ? JANET_TUPLE_FLAG_BRACKETCTOR : 0);
}
} else if (c == '}' && (state->flags & PFLAG_CURLYBRACKETS)) {
if (state->argn & 1) {
p->error = "struct and table literals expect even number of arguments";
return 1;
}
if (state->flags & PFLAG_ATSYM) {
ds = close_table(p, state);
} else {
ds = close_struct(p, state);
}
} else {
p->error = "mismatched delimiter";
return 1;
}
popstate(p, ds);
}
return 1;
case '(': case '(':
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS); pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS);
return 1; return 1;
@ -799,78 +809,78 @@ static const JanetReg parse_cfuns[] = {
{ {
"parser/new", cfun_parse_parser, "parser/new", cfun_parse_parser,
JDOC("(parser/new)\n\n" JDOC("(parser/new)\n\n"
"Creates and returns a new parser object. Parsers are state machines " "Creates and returns a new parser object. Parsers are state machines "
"that can receive bytes, and generate a stream of janet values. ") "that can receive bytes, and generate a stream of janet values. ")
}, },
{ {
"parser/has-more", cfun_parse_has_more, "parser/has-more", cfun_parse_has_more,
JDOC("(parser/has-more parser)\n\n" JDOC("(parser/has-more parser)\n\n"
"Check if the parser has more values in the value queue.") "Check if the parser has more values in the value queue.")
}, },
{ {
"parser/produce", cfun_parse_produce, "parser/produce", cfun_parse_produce,
JDOC("(parser/produce parser)\n\n" JDOC("(parser/produce parser)\n\n"
"Dequeue the next value in the parse queue. Will return nil if " "Dequeue the next value in the parse queue. Will return nil if "
"no parsed values are in the queue, otherwise will dequeue the " "no parsed values are in the queue, otherwise will dequeue the "
"next value.") "next value.")
}, },
{ {
"parser/consume", cfun_parse_consume, "parser/consume", cfun_parse_consume,
JDOC("(parser/consume parser bytes [, index])\n\n" JDOC("(parser/consume parser bytes [, index])\n\n"
"Input bytes into the parser and parse them. Will not throw errors " "Input bytes into the parser and parse them. Will not throw errors "
"if there is a parse error. Starts at the byte index given by index. Returns " "if there is a parse error. Starts at the byte index given by index. Returns "
"the number of bytes read.") "the number of bytes read.")
}, },
{ {
"parser/byte", cfun_parse_byte, "parser/byte", cfun_parse_byte,
JDOC("(parser/byte parser b)\n\n" JDOC("(parser/byte parser b)\n\n"
"Input a single byte into the parser byte stream. Returns the parser.") "Input a single byte into the parser byte stream. Returns the parser.")
}, },
{ {
"parser/error", cfun_parse_error, "parser/error", cfun_parse_error,
JDOC("(parser/error parser)\n\n" JDOC("(parser/error parser)\n\n"
"If the parser is in the error state, returns the message associated with " "If the parser is in the error state, returns the message associated with "
"that error. Otherwise, returns nil. Also flushes the parser state and parser " "that error. Otherwise, returns nil. Also flushes the parser state and parser "
"queue, so be sure to handle everything in the queue before calling " "queue, so be sure to handle everything in the queue before calling "
"parser/error.") "parser/error.")
}, },
{ {
"parser/status", cfun_parse_status, "parser/status", cfun_parse_status,
JDOC("(parser/status parser)\n\n" JDOC("(parser/status parser)\n\n"
"Gets the current status of the parser state machine. The status will " "Gets the current status of the parser state machine. The status will "
"be one of:\n\n" "be one of:\n\n"
"\t:pending - a value is being parsed.\n" "\t:pending - a value is being parsed.\n"
"\t:error - a parsing error was encountered.\n" "\t:error - a parsing error was encountered.\n"
"\t:root - the parser can either read more values or safely terminate.") "\t:root - the parser can either read more values or safely terminate.")
}, },
{ {
"parser/flush", cfun_parse_flush, "parser/flush", cfun_parse_flush,
JDOC("(parser/flush parser)\n\n" JDOC("(parser/flush parser)\n\n"
"Clears the parser state and parse queue. Can be used to reset the parser " "Clears the parser state and parse queue. Can be used to reset the parser "
"if an error was encountered. Does not reset the line and column counter, so " "if an error was encountered. Does not reset the line and column counter, so "
"to begin parsing in a new context, create a new parser.") "to begin parsing in a new context, create a new parser.")
}, },
{ {
"parser/state", cfun_parse_state, "parser/state", cfun_parse_state,
JDOC("(parser/state parser)\n\n" JDOC("(parser/state parser)\n\n"
"Returns a string representation of the internal state of the parser. " "Returns a string representation of the internal state of the parser. "
"Each byte in the string represents a nested data structure. For example, " "Each byte in the string represents a nested data structure. For example, "
"if the parser state is '([\"', then the parser is in the middle of parsing a " "if the parser state is '([\"', then the parser is in the middle of parsing a "
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.") "string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.")
}, },
{ {
"parser/where", cfun_parse_where, "parser/where", cfun_parse_where,
JDOC("(parser/where parser)\n\n" JDOC("(parser/where parser)\n\n"
"Returns the current line number and column number of the parser's location " "Returns the current line number and column number of the parser's location "
"in the byte stream as a tuple (line, column). Lines and columns are counted from " "in the byte stream as a tuple (line, column). Lines and columns are counted from "
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.") "1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
}, },
{ {
"parser/insert", cfun_parse_insert, "parser/insert", cfun_parse_insert,
JDOC("(parser/insert parser value)\n\n" JDOC("(parser/insert parser value)\n\n"
"Insert a value into the parser. This means that the parser state can be manipulated " "Insert a value into the parser. This means that the parser state can be manipulated "
"in between chunks of bytes. This would allow a user to add extra elements to arrays " "in between chunks of bytes. This would allow a user to add extra elements to arrays "
"and tuples, for example. Returns the parser.") "and tuples, for example. Returns the parser.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

690
src/core/peg.c
View File

@ -129,338 +129,317 @@ static void pushcap(PegState *s, Janet capture, uint32_t tag) {
* not be changed, though. * not be changed, though.
*/ */
static const uint8_t *peg_rule( static const uint8_t *peg_rule(
PegState *s, PegState *s,
const uint32_t *rule, const uint32_t *rule,
const uint8_t *text) { const uint8_t *text) {
tail: tail:
switch(*rule & 0x1F) { switch (*rule & 0x1F) {
default: default:
janet_panic("unexpected opcode"); janet_panic("unexpected opcode");
return NULL; return NULL;
case RULE_LITERAL: case RULE_LITERAL: {
{ uint32_t len = rule[1];
uint32_t len = rule[1]; if (text + len > s->text_end) return NULL;
if (text + len > s->text_end) return NULL; return memcmp(text, rule + 2, len) ? NULL : text + len;
return memcmp(text, rule + 2, len) ? NULL : text + len; }
}
case RULE_NCHAR: case RULE_NCHAR: {
{ uint32_t n = rule[1];
uint32_t n = rule[1]; return (text + n > s->text_end) ? NULL : text + n;
return (text + n > s->text_end) ? NULL : text + n; }
}
case RULE_NOTNCHAR: case RULE_NOTNCHAR: {
{ uint32_t n = rule[1];
uint32_t n = rule[1]; return (text + n > s->text_end) ? text : NULL;
return (text + n > s->text_end) ? text : NULL; }
}
case RULE_RANGE: case RULE_RANGE: {
{ uint8_t lo = rule[1] & 0xFF;
uint8_t lo = rule[1] & 0xFF; uint8_t hi = (rule[1] >> 16) & 0xFF;
uint8_t hi = (rule[1] >> 16) & 0xFF; return (text < s->text_end &&
return (text < s->text_end && text[0] >= lo &&
text[0] >= lo && text[0] <= hi)
text[0] <= hi) ? text + 1
? text + 1 : NULL;
: NULL; }
}
case RULE_SET: case RULE_SET: {
{ uint32_t word = rule[1 + (text[0] >> 5)];
uint32_t word = rule[1 + (text[0] >> 5)]; uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F); return (text < s->text_end && (word & mask))
return (text < s->text_end && (word & mask)) ? text + 1
? text + 1 : NULL;
: NULL; }
}
case RULE_LOOK: case RULE_LOOK: {
{ text += ((int32_t *)rule)[1];
text += ((int32_t *)rule)[1]; if (text < s->text_start || text > s->text_end) return NULL;
if (text < s->text_start || text > s->text_end) return NULL; int oldmode = s->mode;
int oldmode = s->mode; s->mode = PEG_MODE_NOCAPTURE;
s->mode = PEG_MODE_NOCAPTURE; down1(s);
down1(s); const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text); up1(s);
up1(s); s->mode = oldmode;
s->mode = oldmode; return result ? text : NULL;
return result ? text : NULL; }
}
case RULE_CHOICE: case RULE_CHOICE: {
{ uint32_t len = rule[1];
uint32_t len = rule[1]; const uint32_t *args = rule + 2;
const uint32_t *args = rule + 2; if (len == 0) return NULL;
if (len == 0) return NULL; down1(s);
down1(s); CapState cs = cap_save(s);
CapState cs = cap_save(s); for (uint32_t i = 0; i < len - 1; i++) {
for (uint32_t i = 0; i < len - 1; i++) { const uint8_t *result = peg_rule(s, s->bytecode + args[i], text);
const uint8_t *result = peg_rule(s, s->bytecode + args[i], text); if (result) {
if (result) { up1(s);
up1(s); return result;
return result;
}
cap_load(s, cs);
} }
up1(s); cap_load(s, cs);
rule = s->bytecode + args[len - 1];
goto tail;
} }
up1(s);
rule = s->bytecode + args[len - 1];
goto tail;
}
case RULE_SEQUENCE: case RULE_SEQUENCE: {
{ uint32_t len = rule[1];
uint32_t len = rule[1]; const uint32_t *args = rule + 2;
const uint32_t *args = rule + 2; if (len == 0) return text;
if (len == 0) return text; down1(s);
down1(s); for (uint32_t i = 0; text && i < len - 1; i++)
for (uint32_t i = 0; text && i < len - 1; i++) text = peg_rule(s, s->bytecode + args[i], text);
text = peg_rule(s, s->bytecode + args[i], text); up1(s);
up1(s); if (!text) return NULL;
if (!text) return NULL; rule = s->bytecode + args[len - 1];
rule = s->bytecode + args[len - 1]; goto tail;
goto tail; }
}
case RULE_IF: case RULE_IF:
case RULE_IFNOT: case RULE_IFNOT: {
{ const uint32_t *rule_a = s->bytecode + rule[1];
const uint32_t *rule_a = s->bytecode + rule[1]; const uint32_t *rule_b = s->bytecode + rule[2];
const uint32_t *rule_b = s->bytecode + rule[2]; int oldmode = s->mode;
int oldmode = s->mode; s->mode = PEG_MODE_NOCAPTURE;
s->mode = PEG_MODE_NOCAPTURE; down1(s);
down1(s); const uint8_t *result = peg_rule(s, rule_a, text);
const uint8_t *result = peg_rule(s, rule_a, text); up1(s);
up1(s); s->mode = oldmode;
s->mode = oldmode; if (rule[0] == RULE_IF ? !result : !!result) return NULL;
if (rule[0] == RULE_IF ? !result : !!result) return NULL; rule = rule_b;
rule = rule_b; goto tail;
goto tail; }
}
case RULE_NOT: case RULE_NOT: {
{ const uint32_t *rule_a = s->bytecode + rule[1];
const uint32_t *rule_a = s->bytecode + rule[1]; int oldmode = s->mode;
int oldmode = s->mode; s->mode = PEG_MODE_NOCAPTURE;
s->mode = PEG_MODE_NOCAPTURE; down1(s);
down1(s); const uint8_t *result = peg_rule(s, rule_a, text);
const uint8_t *result = peg_rule(s, rule_a, text); up1(s);
up1(s); s->mode = oldmode;
s->mode = oldmode; return (result) ? NULL : text;
return (result) ? NULL : text; }
}
case RULE_BETWEEN: case RULE_BETWEEN: {
{ uint32_t lo = rule[1];
uint32_t lo = rule[1]; uint32_t hi = rule[2];
uint32_t hi = rule[2]; const uint32_t *rule_a = s->bytecode + rule[3];
const uint32_t *rule_a = s->bytecode + rule[3]; uint32_t captured = 0;
uint32_t captured = 0; const uint8_t *next_text;
const uint8_t *next_text; CapState cs = cap_save(s);
CapState cs = cap_save(s); down1(s);
down1(s); while (captured < hi) {
while (captured < hi) { CapState cs2 = cap_save(s);
CapState cs2 = cap_save(s); next_text = peg_rule(s, rule_a, text);
next_text = peg_rule(s, rule_a, text); if (!next_text || next_text == text) {
if (!next_text || next_text == text) { cap_load(s, cs2);
cap_load(s, cs2); break;
break;
}
captured++;
text = next_text;
} }
up1(s); captured++;
if (captured < lo) { text = next_text;
cap_load(s, cs);
return NULL;
}
return text;
} }
up1(s);
if (captured < lo) {
cap_load(s, cs);
return NULL;
}
return text;
}
/* Capturing rules */ /* Capturing rules */
case RULE_GETTAG: case RULE_GETTAG: {
{ uint32_t search = rule[1];
uint32_t search = rule[1]; uint32_t tag = rule[2];
uint32_t tag = rule[2]; for (int32_t i = s->tags->count - 1; i >= 0; i--) {
for (int32_t i = s->tags->count - 1; i >= 0; i--) { if (s->tags->data[i] == search) {
if (s->tags->data[i] == search) { pushcap(s, s->captures->data[i], tag);
pushcap(s, s->captures->data[i], tag); return text;
return text;
}
} }
return NULL;
} }
return NULL;
}
case RULE_POSITION: case RULE_POSITION: {
{ pushcap(s, janet_wrap_number((double)(text - s->text_start)), rule[1]);
pushcap(s, janet_wrap_number((double)(text - s->text_start)), rule[1]); return text;
return text; }
}
case RULE_ARGUMENT: case RULE_ARGUMENT: {
{ int32_t index = ((int32_t *)rule)[1];
int32_t index = ((int32_t *)rule)[1]; Janet capture = (index >= s->extrac) ? janet_wrap_nil() : s->extrav[index];
Janet capture = (index >= s->extrac) ? janet_wrap_nil() : s->extrav[index]; pushcap(s, capture, rule[2]);
pushcap(s, capture, rule[2]); return text;
return text; }
}
case RULE_CONSTANT: case RULE_CONSTANT: {
{ pushcap(s, s->constants[rule[1]], rule[2]);
pushcap(s, s->constants[rule[1]], rule[2]); return text;
return text; }
}
case RULE_CAPTURE: case RULE_CAPTURE: {
{ uint32_t tag = rule[2];
uint32_t tag = rule[2]; if (!tag && s->mode == PEG_MODE_NOCAPTURE) {
if (!tag && s->mode == PEG_MODE_NOCAPTURE) { rule = s->bytecode + rule[1];
rule = s->bytecode + rule[1]; goto tail;
goto tail;
}
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
if (!result) return NULL;
/* Specialized pushcap - avoid intermediate string creation */
if (!tag && s->mode == PEG_MODE_ACCUMULATE) {
janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text));
} else {
pushcap(s, janet_stringv(text, (int32_t)(result - text)), tag);
}
return result;
} }
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
if (!result) return NULL;
/* Specialized pushcap - avoid intermediate string creation */
if (!tag && s->mode == PEG_MODE_ACCUMULATE) {
janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text));
} else {
pushcap(s, janet_stringv(text, (int32_t)(result - text)), tag);
}
return result;
}
case RULE_ACCUMULATE: case RULE_ACCUMULATE: {
{ uint32_t tag = rule[2];
uint32_t tag = rule[2]; int oldmode = s->mode;
int oldmode = s->mode; /* No capture mode, skip captures. Accumulate inside accumulate also does nothing. */
/* No capture mode, skip captures. Accumulate inside accumulate also does nothing. */ if (!tag && oldmode != PEG_MODE_NORMAL) {
if (!tag && oldmode != PEG_MODE_NORMAL) { rule = s->bytecode + rule[1];
rule = s->bytecode + rule[1]; goto tail;
goto tail;
}
CapState cs = cap_save(s);
s->mode = PEG_MODE_ACCUMULATE;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
s->mode = oldmode;
if (!result) return NULL;
Janet cap = janet_stringv(s->scratch->data + cs.scratch, s->scratch->count - cs.scratch);
cap_load(s, cs);
pushcap(s, cap, tag);
return result;
} }
CapState cs = cap_save(s);
s->mode = PEG_MODE_ACCUMULATE;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
s->mode = oldmode;
if (!result) return NULL;
Janet cap = janet_stringv(s->scratch->data + cs.scratch, s->scratch->count - cs.scratch);
cap_load(s, cs);
pushcap(s, cap, tag);
return result;
}
case RULE_DROP: case RULE_DROP: {
{ CapState cs = cap_save(s);
CapState cs = cap_save(s); down1(s);
down1(s); const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text); up1(s);
up1(s); if (!result) return NULL;
if (!result) return NULL; cap_load(s, cs);
cap_load(s, cs); return result;
return result; }
}
case RULE_GROUP: case RULE_GROUP: {
{ uint32_t tag = rule[2];
uint32_t tag = rule[2]; int oldmode = s->mode;
int oldmode = s->mode; if (!tag && oldmode == PEG_MODE_NOCAPTURE) {
if (!tag && oldmode == PEG_MODE_NOCAPTURE) { rule = s->bytecode + rule[1];
rule = s->bytecode + rule[1]; goto tail;
goto tail;
}
CapState cs = cap_save(s);
s->mode = PEG_MODE_NORMAL;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
s->mode = oldmode;
if (!result) return NULL;
int32_t num_sub_captures = s->captures->count - cs.cap;
JanetArray *sub_captures = janet_array(num_sub_captures);
memcpy(sub_captures->data,
s->captures->data + cs.cap,
sizeof(Janet) * num_sub_captures);
sub_captures->count = num_sub_captures;
cap_load(s, cs);
pushcap(s, janet_wrap_array(sub_captures), tag);
return result;
} }
CapState cs = cap_save(s);
s->mode = PEG_MODE_NORMAL;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
s->mode = oldmode;
if (!result) return NULL;
int32_t num_sub_captures = s->captures->count - cs.cap;
JanetArray *sub_captures = janet_array(num_sub_captures);
memcpy(sub_captures->data,
s->captures->data + cs.cap,
sizeof(Janet) * num_sub_captures);
sub_captures->count = num_sub_captures;
cap_load(s, cs);
pushcap(s, janet_wrap_array(sub_captures), tag);
return result;
}
case RULE_REPLACE: case RULE_REPLACE:
case RULE_MATCHTIME: case RULE_MATCHTIME: {
{ uint32_t tag = rule[3];
uint32_t tag = rule[3]; int oldmode = s->mode;
int oldmode = s->mode; if (!tag && rule[0] == RULE_REPLACE && oldmode == PEG_MODE_NOCAPTURE) {
if (!tag && rule[0] == RULE_REPLACE && oldmode == PEG_MODE_NOCAPTURE) { rule = s->bytecode + rule[1];
rule = s->bytecode + rule[1]; goto tail;
goto tail;
}
CapState cs = cap_save(s);
s->mode = PEG_MODE_NORMAL;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
s->mode = oldmode;
if (!result) return NULL;
Janet cap;
Janet constant = s->constants[rule[2]];
switch (janet_type(constant)) {
default:
cap = constant;
break;
case JANET_STRUCT:
cap = janet_struct_get(janet_unwrap_struct(constant),
s->captures->data[s->captures->count - 1]);
break;
case JANET_TABLE:
cap = janet_table_get(janet_unwrap_table(constant),
s->captures->data[s->captures->count - 1]);
break;
case JANET_CFUNCTION:
cap = janet_unwrap_cfunction(constant)(s->captures->count - cs.cap,
s->captures->data + cs.cap);
break;
case JANET_FUNCTION:
cap = janet_call(janet_unwrap_function(constant),
s->captures->count - cs.cap,
s->captures->data + cs.cap);
break;
}
cap_load(s, cs);
if (rule[0] == RULE_MATCHTIME && !janet_truthy(cap)) return NULL;
pushcap(s, cap, tag);
return result;
} }
CapState cs = cap_save(s);
s->mode = PEG_MODE_NORMAL;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
s->mode = oldmode;
if (!result) return NULL;
case RULE_ERROR: Janet cap;
{ Janet constant = s->constants[rule[2]];
int oldmode = s->mode; switch (janet_type(constant)) {
s->mode = PEG_MODE_NORMAL; default:
int32_t old_cap = s->captures->count; cap = constant;
down1(s); break;
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text); case JANET_STRUCT:
up1(s); cap = janet_struct_get(janet_unwrap_struct(constant),
s->mode = oldmode; s->captures->data[s->captures->count - 1]);
if (!result) return NULL; break;
if (s->captures->count > old_cap) { case JANET_TABLE:
/* Throw last capture */ cap = janet_table_get(janet_unwrap_table(constant),
janet_panicv(s->captures->data[s->captures->count - 1]); s->captures->data[s->captures->count - 1]);
} else { break;
/* Throw generic error */ case JANET_CFUNCTION:
int32_t start = (int32_t)(text - s->text_start); cap = janet_unwrap_cfunction(constant)(s->captures->count - cs.cap,
int32_t end = (int32_t)(result - s->text_start); s->captures->data + cs.cap);
janet_panicf("match error in range (%d:%d)", start, end); break;
} case JANET_FUNCTION:
return NULL; cap = janet_call(janet_unwrap_function(constant),
s->captures->count - cs.cap,
s->captures->data + cs.cap);
break;
} }
cap_load(s, cs);
if (rule[0] == RULE_MATCHTIME && !janet_truthy(cap)) return NULL;
pushcap(s, cap, tag);
return result;
}
case RULE_ERROR: {
int oldmode = s->mode;
s->mode = PEG_MODE_NORMAL;
int32_t old_cap = s->captures->count;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
s->mode = oldmode;
if (!result) return NULL;
if (s->captures->count > old_cap) {
/* Throw last capture */
janet_panicv(s->captures->data[s->captures->count - 1]);
} else {
/* Throw generic error */
int32_t start = (int32_t)(text - s->text_start);
int32_t end = (int32_t)(result - s->text_start);
janet_panicf("match error in range (%d:%d)", start, end);
}
return NULL;
}
} }
} }
@ -501,9 +480,9 @@ static void peg_panic(Builder *b, const char *msg) {
static void peg_fixarity(Builder *b, int32_t argc, int32_t arity) { static void peg_fixarity(Builder *b, int32_t argc, int32_t arity) {
if (argc != arity) { if (argc != arity) {
peg_panicf(b, "expected %d argument%s, got %d%", peg_panicf(b, "expected %d argument%s, got %d%",
arity, arity,
arity == 1 ? "" : "s", arity == 1 ? "" : "s",
argc); argc);
} }
} }
@ -921,62 +900,57 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
default: default:
peg_panicf(b, "unexpected peg source"); peg_panicf(b, "unexpected peg source");
return 0; return 0;
case JANET_NUMBER: case JANET_NUMBER: {
{ int32_t n = peg_getinteger(b, peg);
int32_t n = peg_getinteger(b, peg); Reserve r = reserve(b, 2);
Reserve r = reserve(b, 2); if (n < 0) {
if (n < 0) { emit_1(r, RULE_NOTNCHAR, -n);
emit_1(r, RULE_NOTNCHAR, -n); } else {
} else { emit_1(r, RULE_NCHAR, n);
emit_1(r, RULE_NCHAR, n);
}
break;
}
case JANET_STRING:
{
const uint8_t *str = janet_unwrap_string(peg);
int32_t len = janet_string_length(str);
emit_bytes(b, RULE_LITERAL, len, str);
break;
}
case JANET_KEYWORD:
{
Janet check = janet_table_get(b->grammar, peg);
if (janet_checktype(check, JANET_NIL))
peg_panicf(b, "unknown rule");
rule = peg_compile1(b, check);
break;
}
case JANET_STRUCT:
{
JanetTable *grammar = janet_struct_to_table(janet_unwrap_struct(peg));
grammar->proto = b->grammar;
b->grammar = grammar;
Janet main_rule = janet_table_get(grammar, janet_ckeywordv("main"));
if (janet_checktype(main_rule, JANET_NIL))
peg_panicf(b, "grammar requires :main rule");
rule = peg_compile1(b, main_rule);
b->grammar = grammar->proto;
break;
}
case JANET_TUPLE:
{
const Janet *tup = janet_unwrap_tuple(peg);
int32_t len = janet_tuple_length(tup);
if (len == 0) peg_panic(b, "tuple in grammar must have non-zero length");
if (!janet_checktype(tup[0], JANET_SYMBOL))
peg_panicf(b, "expected grammar command, found %v", tup[0]);
const uint8_t *sym = janet_unwrap_symbol(tup[0]);
const SpecialPair *sp = janet_strbinsearch(
&peg_specials,
sizeof(peg_specials)/sizeof(SpecialPair),
sizeof(SpecialPair),
sym);
if (!sp)
peg_panicf(b, "unknown special %S", sym);
sp->special(b, len - 1, tup + 1);
break;
} }
break;
}
case JANET_STRING: {
const uint8_t *str = janet_unwrap_string(peg);
int32_t len = janet_string_length(str);
emit_bytes(b, RULE_LITERAL, len, str);
break;
}
case JANET_KEYWORD: {
Janet check = janet_table_get(b->grammar, peg);
if (janet_checktype(check, JANET_NIL))
peg_panicf(b, "unknown rule");
rule = peg_compile1(b, check);
break;
}
case JANET_STRUCT: {
JanetTable *grammar = janet_struct_to_table(janet_unwrap_struct(peg));
grammar->proto = b->grammar;
b->grammar = grammar;
Janet main_rule = janet_table_get(grammar, janet_ckeywordv("main"));
if (janet_checktype(main_rule, JANET_NIL))
peg_panicf(b, "grammar requires :main rule");
rule = peg_compile1(b, main_rule);
b->grammar = grammar->proto;
break;
}
case JANET_TUPLE: {
const Janet *tup = janet_unwrap_tuple(peg);
int32_t len = janet_tuple_length(tup);
if (len == 0) peg_panic(b, "tuple in grammar must have non-zero length");
if (!janet_checktype(tup[0], JANET_SYMBOL))
peg_panicf(b, "expected grammar command, found %v", tup[0]);
const uint8_t *sym = janet_unwrap_symbol(tup[0]);
const SpecialPair *sp = janet_strbinsearch(
&peg_specials,
sizeof(peg_specials) / sizeof(SpecialPair),
sizeof(SpecialPair),
sym);
if (!sp)
peg_panicf(b, "unknown special %S", sym);
sp->special(b, len - 1, tup + 1);
break;
}
} }
/* Increase depth again */ /* Increase depth again */
@ -1089,16 +1063,18 @@ static Janet cfun_peg_match(int32_t argc, Janet *argv) {
} }
static const JanetReg peg_cfuns[] = { static const JanetReg peg_cfuns[] = {
{"peg/compile", cfun_peg_compile, {
"peg/compile", cfun_peg_compile,
JDOC("(peg/compile peg)\n\n" JDOC("(peg/compile peg)\n\n"
"Compiles a peg source data structure into a <core/peg>. This will speed up matching " "Compiles a peg source data structure into a <core/peg>. This will speed up matching "
"if the same peg will be used multiple times.") "if the same peg will be used multiple times.")
}, },
{"peg/match", cfun_peg_match, {
"peg/match", cfun_peg_match,
JDOC("(peg/match peg text [,start=0])\n\n" JDOC("(peg/match peg text [,start=0])\n\n"
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. " "Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
"Returns nil if text does not match the language defined by peg. The syntax of PEGs are very " "Returns nil if text does not match the language defined by peg. The syntax of PEGs are very "
"similar to those defined by LPeg, and have similar capabilities.") "similar to those defined by LPeg, and have similar capabilities.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

424
src/core/pp.c
View File

@ -73,7 +73,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
len = count_dig10(x); len = count_dig10(x);
buf += len; buf += len;
while (x) { while (x) {
uint8_t digit = (uint8_t) -(x % 10); uint8_t digit = (uint8_t) - (x % 10);
*(--buf) = '0' + digit; *(--buf) = '0' + digit;
x /= 10; x /= 10;
} }
@ -167,53 +167,50 @@ static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
void janet_description_b(JanetBuffer *buffer, Janet x) { void janet_description_b(JanetBuffer *buffer, Janet x) {
switch (janet_type(x)) { switch (janet_type(x)) {
case JANET_NIL: case JANET_NIL:
janet_buffer_push_cstring(buffer, "nil"); janet_buffer_push_cstring(buffer, "nil");
return; return;
case JANET_TRUE: case JANET_TRUE:
janet_buffer_push_cstring(buffer, "true"); janet_buffer_push_cstring(buffer, "true");
return; return;
case JANET_FALSE: case JANET_FALSE:
janet_buffer_push_cstring(buffer, "false"); janet_buffer_push_cstring(buffer, "false");
return; return;
case JANET_NUMBER: case JANET_NUMBER:
number_to_string_b(buffer, janet_unwrap_number(x)); number_to_string_b(buffer, janet_unwrap_number(x));
return; return;
case JANET_KEYWORD: case JANET_KEYWORD:
janet_buffer_push_u8(buffer, ':'); janet_buffer_push_u8(buffer, ':');
/* fallthrough */ /* fallthrough */
case JANET_SYMBOL: case JANET_SYMBOL:
janet_buffer_push_bytes(buffer, janet_buffer_push_bytes(buffer,
janet_unwrap_string(x), janet_unwrap_string(x),
janet_string_length(janet_unwrap_string(x))); janet_string_length(janet_unwrap_string(x)));
return; return;
case JANET_STRING: case JANET_STRING:
janet_escape_string_b(buffer, janet_unwrap_string(x)); janet_escape_string_b(buffer, janet_unwrap_string(x));
return; return;
case JANET_BUFFER: case JANET_BUFFER:
janet_escape_buffer_b(buffer, janet_unwrap_buffer(x)); janet_escape_buffer_b(buffer, janet_unwrap_buffer(x));
return; return;
case JANET_ABSTRACT: case JANET_ABSTRACT: {
{
const char *n = janet_abstract_type(janet_unwrap_abstract(x))->name; const char *n = janet_abstract_type(janet_unwrap_abstract(x))->name;
string_description_b(buffer, n, janet_unwrap_abstract(x)); string_description_b(buffer, n, janet_unwrap_abstract(x));
return; return;
} }
case JANET_CFUNCTION: case JANET_CFUNCTION: {
{
Janet check = janet_table_get(janet_vm_registry, x); Janet check = janet_table_get(janet_vm_registry, x);
if (janet_checktype(check, JANET_SYMBOL)) { if (janet_checktype(check, JANET_SYMBOL)) {
janet_buffer_push_cstring(buffer, "<cfunction "); janet_buffer_push_cstring(buffer, "<cfunction ");
janet_buffer_push_bytes(buffer, janet_buffer_push_bytes(buffer,
janet_unwrap_symbol(check), janet_unwrap_symbol(check),
janet_string_length(janet_unwrap_symbol(check))); janet_string_length(janet_unwrap_symbol(check)));
janet_buffer_push_u8(buffer, '>'); janet_buffer_push_u8(buffer, '>');
break; break;
} }
goto fallthrough; goto fallthrough;
} }
case JANET_FUNCTION: case JANET_FUNCTION: {
{
JanetFunction *fun = janet_unwrap_function(x); JanetFunction *fun = janet_unwrap_function(x);
JanetFuncDef *def = fun->def; JanetFuncDef *def = fun->def;
if (def->name) { if (def->name) {
@ -226,9 +223,9 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
goto fallthrough; goto fallthrough;
} }
fallthrough: fallthrough:
default: default:
string_description_b(buffer, janet_type_names[janet_type(x)], janet_unwrap_pointer(x)); string_description_b(buffer, janet_type_names[janet_type(x)], janet_unwrap_pointer(x));
break; break;
} }
} }
@ -239,15 +236,15 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
break; break;
case JANET_BUFFER: case JANET_BUFFER:
janet_buffer_push_bytes(buffer, janet_buffer_push_bytes(buffer,
janet_unwrap_buffer(x)->data, janet_unwrap_buffer(x)->data,
janet_unwrap_buffer(x)->count); janet_unwrap_buffer(x)->count);
break; break;
case JANET_STRING: case JANET_STRING:
case JANET_SYMBOL: case JANET_SYMBOL:
case JANET_KEYWORD: case JANET_KEYWORD:
janet_buffer_push_bytes(buffer, janet_buffer_push_bytes(buffer,
janet_unwrap_string(x), janet_unwrap_string(x),
janet_string_length(janet_unwrap_string(x))); janet_string_length(janet_unwrap_string(x)));
break; break;
} }
} }
@ -265,15 +262,14 @@ const uint8_t *janet_description(Janet x) {
* strings, symbols, and buffers will return their content. */ * strings, symbols, and buffers will return their content. */
const uint8_t *janet_to_string(Janet x) { const uint8_t *janet_to_string(Janet x) {
switch (janet_type(x)) { switch (janet_type(x)) {
default: default: {
{ JanetBuffer b;
JanetBuffer b; janet_buffer_init(&b, 10);
janet_buffer_init(&b, 10); janet_to_string_b(&b, x);
janet_to_string_b(&b, x); const uint8_t *ret = janet_string(b.data, b.count);
const uint8_t *ret = janet_string(b.data, b.count); janet_buffer_deinit(&b);
janet_buffer_deinit(&b); return ret;
return ret; }
}
case JANET_BUFFER: case JANET_BUFFER:
return janet_string(janet_unwrap_buffer(x)->data, janet_unwrap_buffer(x)->count); return janet_string(janet_unwrap_buffer(x)->data, janet_unwrap_buffer(x)->count);
case JANET_STRING: case JANET_STRING:
@ -313,19 +309,18 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
case JANET_TRUE: case JANET_TRUE:
case JANET_FALSE: case JANET_FALSE:
break; break;
default: default: {
{ Janet seenid = janet_table_get(&S->seen, x);
Janet seenid = janet_table_get(&S->seen, x); if (janet_checktype(seenid, JANET_NUMBER)) {
if (janet_checktype(seenid, JANET_NUMBER)) { janet_buffer_push_cstring(S->buffer, "<cycle ");
janet_buffer_push_cstring(S->buffer, "<cycle "); integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid)); janet_buffer_push_u8(S->buffer, '>');
janet_buffer_push_u8(S->buffer, '>'); return;
return; } else {
} else { janet_table_put(&S->seen, x, janet_wrap_integer(S->seen.count));
janet_table_put(&S->seen, x, janet_wrap_integer(S->seen.count)); break;
break;
}
} }
}
} }
switch (janet_type(x)) { switch (janet_type(x)) {
@ -333,84 +328,82 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_description_b(S->buffer, x); janet_description_b(S->buffer, x);
break; break;
case JANET_ARRAY: case JANET_ARRAY:
case JANET_TUPLE: case JANET_TUPLE: {
{ int32_t i, len;
int32_t i, len; const Janet *arr;
const Janet *arr; int isarray = janet_checktype(x, JANET_ARRAY);
int isarray = janet_checktype(x, JANET_ARRAY); janet_indexed_view(x, &arr, &len);
janet_indexed_view(x, &arr, &len); int hasbrackets = !isarray && (janet_tuple_flag(arr) & JANET_TUPLE_FLAG_BRACKETCTOR);
int hasbrackets = !isarray && (janet_tuple_flag(arr) & JANET_TUPLE_FLAG_BRACKETCTOR); const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "(";
const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "("; const char endchar = isarray ? ']' : hasbrackets ? ']' : ')';
const char endchar = isarray ? ']' : hasbrackets ? ']' : ')'; janet_buffer_push_cstring(S->buffer, startstr);
janet_buffer_push_cstring(S->buffer, startstr); S->depth--;
S->depth--; S->indent += 2;
S->indent += 2; if (S->depth == 0) {
if (S->depth == 0) { janet_buffer_push_cstring(S->buffer, "...");
janet_buffer_push_cstring(S->buffer, "..."); } else {
} else { if (!isarray && len >= 5)
if (!isarray && len >= 5) janet_buffer_push_u8(S->buffer, ' ');
janet_buffer_push_u8(S->buffer, ' '); if (is_dict_value && len >= 5) print_newline(S, 0);
if (is_dict_value && len >= 5) print_newline(S, 0); for (i = 0; i < len; i++) {
for (i = 0; i < len; i++) { if (i) print_newline(S, len < 5);
if (i) print_newline(S, len < 5); janet_pretty_one(S, arr[i], 0);
janet_pretty_one(S, arr[i], 0);
}
} }
S->indent -= 2;
S->depth++;
janet_buffer_push_u8(S->buffer, endchar);
break;
} }
S->indent -= 2;
S->depth++;
janet_buffer_push_u8(S->buffer, endchar);
break;
}
case JANET_STRUCT: case JANET_STRUCT:
case JANET_TABLE: case JANET_TABLE: {
{ int istable = janet_checktype(x, JANET_TABLE);
int istable = janet_checktype(x, JANET_TABLE); janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
/* For object-like tables, print class name */ /* For object-like tables, print class name */
if (istable) { if (istable) {
JanetTable *t = janet_unwrap_table(x); JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto; JanetTable *proto = t->proto;
if (NULL != proto) { if (NULL != proto) {
Janet name = janet_table_get(proto, janet_csymbolv(":name")); Janet name = janet_table_get(proto, janet_csymbolv(":name"));
if (janet_checktype(name, JANET_SYMBOL)) { if (janet_checktype(name, JANET_SYMBOL)) {
const uint8_t *sym = janet_unwrap_symbol(name); const uint8_t *sym = janet_unwrap_symbol(name);
janet_buffer_push_bytes(S->buffer, sym, janet_string_length(sym)); janet_buffer_push_bytes(S->buffer, sym, janet_string_length(sym));
}
}
janet_buffer_push_cstring(S->buffer, "{");
}
S->depth--;
S->indent += 2;
if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "...");
} else {
int32_t i, len, cap;
int first_kv_pair = 1;
const JanetKV *kvs;
janet_dictionary_view(x, &kvs, &len, &cap);
if (!istable && len >= 4)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= 5) print_newline(S, 0);
for (i = 0; i < cap; i++) {
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
if (first_kv_pair) {
first_kv_pair = 0;
} else {
print_newline(S, len < 4);
}
janet_pretty_one(S, kvs[i].key, 0);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[i].value, 1);
}
} }
} }
S->indent -= 2; janet_buffer_push_cstring(S->buffer, "{");
S->depth++;
janet_buffer_push_u8(S->buffer, '}');
break;
} }
S->depth--;
S->indent += 2;
if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "...");
} else {
int32_t i, len, cap;
int first_kv_pair = 1;
const JanetKV *kvs;
janet_dictionary_view(x, &kvs, &len, &cap);
if (!istable && len >= 4)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= 5) print_newline(S, 0);
for (i = 0; i < cap; i++) {
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
if (first_kv_pair) {
first_kv_pair = 0;
} else {
print_newline(S, len < 4);
}
janet_pretty_one(S, kvs[i].key, 0);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[i].value, 1);
}
}
}
S->indent -= 2;
S->depth++;
janet_buffer_push_u8(S->buffer, '}');
break;
}
} }
/* Remove from seen */ /* Remove from seen */
janet_table_remove(&S->seen, x); janet_table_remove(&S->seen, x);
@ -436,8 +429,8 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x) {
static const char *typestr(Janet x) { static const char *typestr(Janet x) {
JanetType t = janet_type(x); JanetType t = janet_type(x);
return (t == JANET_ABSTRACT) return (t == JANET_ABSTRACT)
? janet_abstract_type(janet_unwrap_abstract(x))->name ? janet_abstract_type(janet_unwrap_abstract(x))->name
: janet_type_names[t]; : janet_type_names[t];
} }
static void pushtypes(JanetBuffer *buffer, int types) { static void pushtypes(JanetBuffer *buffer, int types) {
@ -483,8 +476,7 @@ const uint8_t *janet_formatc(const char *format, ...) {
default: default:
janet_buffer_push_u8(bufp, c); janet_buffer_push_u8(bufp, c);
break; break;
case '%': case '%': {
{
if (i + 1 >= len) if (i + 1 >= len)
break; break;
switch (format[++i]) { switch (format[++i]) {
@ -497,8 +489,7 @@ const uint8_t *janet_formatc(const char *format, ...) {
case 'd': case 'd':
integer_to_string_b(bufp, va_arg(args, long)); integer_to_string_b(bufp, va_arg(args, long));
break; break;
case 'S': case 'S': {
{
const uint8_t *str = va_arg(args, const uint8_t *); const uint8_t *str = va_arg(args, const uint8_t *);
janet_buffer_push_bytes(bufp, str, janet_string_length(str)); janet_buffer_push_bytes(bufp, str, janet_string_length(str));
break; break;
@ -509,35 +500,29 @@ const uint8_t *janet_formatc(const char *format, ...) {
case 'c': case 'c':
janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long)); janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long));
break; break;
case 'q': case 'q': {
{
const uint8_t *str = va_arg(args, const uint8_t *); const uint8_t *str = va_arg(args, const uint8_t *);
janet_escape_string_b(bufp, str); janet_escape_string_b(bufp, str);
break; break;
} }
case 't': case 't': {
{
janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet))); janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet)));
break; break;
} }
case 'T': case 'T': {
{
int types = va_arg(args, long); int types = va_arg(args, long);
pushtypes(bufp, types); pushtypes(bufp, types);
break; break;
} }
case 'V': case 'V': {
{
janet_to_string_b(bufp, va_arg(args, Janet)); janet_to_string_b(bufp, va_arg(args, Janet));
break; break;
} }
case 'v': case 'v': {
{
janet_description_b(bufp, va_arg(args, Janet)); janet_description_b(bufp, va_arg(args, Janet));
break; break;
} }
case 'p': case 'p': {
{
janet_pretty(bufp, 4, va_arg(args, Janet)); janet_pretty(bufp, 4, va_arg(args, Janet));
} }
} }
@ -561,29 +546,29 @@ const uint8_t *janet_formatc(const char *format, ...) {
#define MAX_FORMAT 32 #define MAX_FORMAT 32
static const char *scanformat( static const char *scanformat(
const char *strfrmt, const char *strfrmt,
char *form, char *form,
char width[3], char width[3],
char precision[3]) { char precision[3]) {
const char *p = strfrmt; const char *p = strfrmt;
memset(width, '\0', 3); memset(width, '\0', 3);
memset(precision, '\0', 3); memset(precision, '\0', 3);
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL) while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
p++; /* skip flags */ p++; /* skip flags */
if ((size_t) (p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char)) if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
janet_panic("invalid format (repeated flags)"); janet_panic("invalid format (repeated flags)");
if (isdigit((int) (*p))) if (isdigit((int)(*p)))
width[0] = *p++; /* skip width */ width[0] = *p++; /* skip width */
if (isdigit((int) (*p))) if (isdigit((int)(*p)))
width[1] = *p++; /* (2 digits at most) */ width[1] = *p++; /* (2 digits at most) */
if (*p == '.') { if (*p == '.') {
p++; p++;
if (isdigit((int) (*p))) if (isdigit((int)(*p)))
precision[0] = *p++; /* skip precision */ precision[0] = *p++; /* skip precision */
if (isdigit((int) (*p))) if (isdigit((int)(*p)))
precision[1] = *p++; /* (2 digits at most) */ precision[1] = *p++; /* (2 digits at most) */
} }
if (isdigit((int) (*p))) if (isdigit((int)(*p)))
janet_panic("invalid format (width or precision too long)"); janet_panic("invalid format (width or precision too long)");
*(form++) = '%'; *(form++) = '%';
memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char)); memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
@ -595,11 +580,11 @@ static const char *scanformat(
/* Shared implementation between string/format and /* Shared implementation between string/format and
* buffer/format */ * buffer/format */
void janet_buffer_format( void janet_buffer_format(
JanetBuffer *b, JanetBuffer *b,
const char *strfrmt, const char *strfrmt,
int32_t argstart, int32_t argstart,
int32_t argc, int32_t argc,
Janet *argv) { Janet *argv) {
size_t sfl = strlen(strfrmt); size_t sfl = strlen(strfrmt);
const char *strfrmt_end = strfrmt + sfl; const char *strfrmt_end = strfrmt + sfl;
int32_t arg = argstart; int32_t arg = argstart;
@ -616,76 +601,69 @@ void janet_buffer_format(
janet_panic("not enough values for format"); janet_panic("not enough values for format");
strfrmt = scanformat(strfrmt, form, width, precision); strfrmt = scanformat(strfrmt, form, width, precision);
switch (*strfrmt++) { switch (*strfrmt++) {
case 'c': case 'c': {
{ nb = snprintf(item, MAX_ITEM, form, (int)
nb = snprintf(item, MAX_ITEM, form, (int) janet_getinteger(argv, arg));
janet_getinteger(argv, arg)); break;
break; }
}
case 'd': case 'd':
case 'i': case 'i':
case 'o': case 'o':
case 'u': case 'u':
case 'x': case 'x':
case 'X': case 'X': {
{ int32_t n = janet_getinteger(argv, arg);
int32_t n = janet_getinteger(argv, arg); nb = snprintf(item, MAX_ITEM, form, n);
nb = snprintf(item, MAX_ITEM, form, n); break;
break; }
}
case 'a': case 'a':
case 'A': case 'A':
case 'e': case 'e':
case 'E': case 'E':
case 'f': case 'f':
case 'g': case 'g':
case 'G': case 'G': {
{ double d = janet_getnumber(argv, arg);
double d = janet_getnumber(argv, arg); nb = snprintf(item, MAX_ITEM, form, d);
nb = snprintf(item, MAX_ITEM, form, d); break;
break; }
} case 's': {
case 's': const uint8_t *s = janet_getstring(argv, arg);
{ size_t l = janet_string_length(s);
const uint8_t *s = janet_getstring(argv, arg); if (form[2] == '\0')
size_t l = janet_string_length(s); janet_buffer_push_bytes(b, s, l);
if (form[2] == '\0') else {
janet_buffer_push_bytes(b, s, l); if (l != strlen((const char *) s))
else { janet_panic("string contains zeros");
if (l != strlen((const char *) s)) if (!strchr(form, '.') && l >= 100) {
janet_panic("string contains zeros"); janet_panic
if (!strchr(form, '.') && l >= 100) { ("no precision and string is too long to be formatted");
janet_panic } else {
("no precision and string is too long to be formatted"); nb = snprintf(item, MAX_ITEM, form, s);
} else {
nb = snprintf(item, MAX_ITEM, form, s);
}
} }
break;
}
case 'V':
{
janet_to_string_b(b, argv[arg]);
break;
}
case 'v':
{
janet_description_b(b, argv[arg]);
break;
}
case 'p': /* janet pretty , precision = depth */
{
int depth = atoi(precision);
if (depth < 1)
depth = 4;
janet_pretty(b, depth, argv[arg]);
break;
}
default:
{ /* also treat cases 'nLlh' */
janet_panicf("invalid conversion '%s' to 'format'",
form);
} }
break;
}
case 'V': {
janet_to_string_b(b, argv[arg]);
break;
}
case 'v': {
janet_description_b(b, argv[arg]);
break;
}
case 'p': { /* janet pretty , precision = depth */
int depth = atoi(precision);
if (depth < 1)
depth = 4;
janet_pretty(b, depth, argv[arg]);
break;
}
default: {
/* also treat cases 'nLlh' */
janet_panicf("invalid conversion '%s' to 'format'",
form);
}
} }
if (nb >= MAX_ITEM) if (nb >= MAX_ITEM)
janet_panicf("format buffer overflow", form); janet_panicf("format buffer overflow", form);

195
src/core/specials.c
View File

@ -60,45 +60,42 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
switch (janet_type(x)) { switch (janet_type(x)) {
default: default:
return janetc_cslot(x); return janetc_cslot(x);
case JANET_TUPLE: case JANET_TUPLE: {
{ int32_t i, len;
int32_t i, len; const Janet *tup = janet_unwrap_tuple(x);
const Janet *tup = janet_unwrap_tuple(x); len = janet_tuple_length(tup);
len = janet_tuple_length(tup); if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) {
if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) { const uint8_t *head = janet_unwrap_symbol(tup[0]);
const uint8_t *head = janet_unwrap_symbol(tup[0]); if (!janet_cstrcmp(head, "unquote"))
if (!janet_cstrcmp(head, "unquote")) return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
}
for (i = 0; i < len; i++)
janet_v_push(slots, quasiquote(opts, tup[i]));
return qq_slots(opts, slots, JOP_MAKE_TUPLE);
}
case JANET_ARRAY:
{
int32_t i;
JanetArray *array = janet_unwrap_array(x);
for (i = 0; i < array->count; i++)
janet_v_push(slots, quasiquote(opts, array->data[i]));
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
} }
for (i = 0; i < len; i++)
janet_v_push(slots, quasiquote(opts, tup[i]));
return qq_slots(opts, slots, JOP_MAKE_TUPLE);
}
case JANET_ARRAY: {
int32_t i;
JanetArray *array = janet_unwrap_array(x);
for (i = 0; i < array->count; i++)
janet_v_push(slots, quasiquote(opts, array->data[i]));
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
}
case JANET_TABLE: case JANET_TABLE:
case JANET_STRUCT: case JANET_STRUCT: {
{ const JanetKV *kv = NULL, *kvs = NULL;
const JanetKV *kv = NULL, *kvs = NULL; int32_t len, cap;
int32_t len, cap; janet_dictionary_view(x, &kvs, &len, &cap);
janet_dictionary_view(x, &kvs, &len, &cap); while ((kv = janet_dictionary_next(kvs, cap, kv))) {
while ((kv = janet_dictionary_next(kvs, cap, kv))) { JanetSlot key = quasiquote(opts, kv->key);
JanetSlot key = quasiquote(opts, kv->key); JanetSlot value = quasiquote(opts, kv->value);
JanetSlot value = quasiquote(opts, kv->value); key.flags &= ~JANET_SLOT_SPLICED;
key.flags &= ~JANET_SLOT_SPLICED; value.flags &= ~JANET_SLOT_SPLICED;
value.flags &= ~JANET_SLOT_SPLICED; janet_v_push(slots, key);
janet_v_push(slots, key); janet_v_push(slots, value);
janet_v_push(slots, value);
}
return qq_slots(opts, slots,
janet_checktype(x, JANET_TABLE) ? JOP_MAKE_TABLE : JOP_MAKE_STRUCT);
} }
return qq_slots(opts, slots,
janet_checktype(x, JANET_TABLE) ? JOP_MAKE_TABLE : JOP_MAKE_STRUCT);
}
} }
} }
@ -121,13 +118,13 @@ static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv
* keep the order registers are freed. * keep the order registers are freed.
* Returns if the slot 'right' can be freed. */ * Returns if the slot 'right' can be freed. */
static int destructure(JanetCompiler *c, static int destructure(JanetCompiler *c,
Janet left, Janet left,
JanetSlot right, JanetSlot right,
int (*leaf)(JanetCompiler *c, int (*leaf)(JanetCompiler *c,
const uint8_t *sym, const uint8_t *sym,
JanetSlot s, JanetSlot s,
JanetTable *attr), JanetTable *attr),
JanetTable *attr) { JanetTable *attr) {
switch (janet_type(left)) { switch (janet_type(left)) {
default: default:
janetc_cerror(c, "unexpected type in destructuring"); janetc_cerror(c, "unexpected type in destructuring");
@ -136,41 +133,39 @@ static int destructure(JanetCompiler *c,
/* Leaf, assign right to left */ /* Leaf, assign right to left */
return leaf(c, janet_unwrap_symbol(left), right, attr); return leaf(c, janet_unwrap_symbol(left), right, attr);
case JANET_TUPLE: case JANET_TUPLE:
case JANET_ARRAY: case JANET_ARRAY: {
{ int32_t i, len;
int32_t i, len; const Janet *values;
const Janet *values; janet_indexed_view(left, &values, &len);
janet_indexed_view(left, &values, &len); for (i = 0; i < len; i++) {
for (i = 0; i < len; i++) { JanetSlot nextright = janetc_farslot(c);
JanetSlot nextright = janetc_farslot(c); Janet subval = values[i];
Janet subval = values[i]; if (i < 0x100) {
if (i < 0x100) { janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1); } else {
} else { JanetSlot k = janetc_cslot(janet_wrap_integer(i));
JanetSlot k = janetc_cslot(janet_wrap_integer(i));
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
}
if (destructure(c, subval, nextright, leaf, attr))
janetc_freeslot(c, nextright);
}
}
return 1;
case JANET_TABLE:
case JANET_STRUCT:
{
const JanetKV *kvs = NULL;
int32_t i, cap, len;
janet_dictionary_view(left, &kvs, &len, &cap);
for (i = 0; i < cap; i++) {
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
JanetSlot nextright = janetc_farslot(c);
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1); janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
if (destructure(c, kvs[i].value, nextright, leaf, attr))
janetc_freeslot(c, nextright);
} }
if (destructure(c, subval, nextright, leaf, attr))
janetc_freeslot(c, nextright);
} }
return 1; }
return 1;
case JANET_TABLE:
case JANET_STRUCT: {
const JanetKV *kvs = NULL;
int32_t i, cap, len;
janet_dictionary_view(left, &kvs, &len, &cap);
for (i = 0; i < cap; i++) {
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
JanetSlot nextright = janetc_farslot(c);
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
if (destructure(c, kvs[i].value, nextright, leaf, attr))
janetc_freeslot(c, nextright);
}
}
return 1;
} }
} }
@ -264,8 +259,8 @@ static JanetSlot dohead(JanetCompiler *c, JanetFopts opts, Janet *head, int32_t
/* Def or var a symbol in a local scope */ /* Def or var a symbol in a local scope */
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret) { static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret) {
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) { 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);
@ -278,10 +273,10 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
} }
static int varleaf( static int varleaf(
JanetCompiler *c, JanetCompiler *c,
const uint8_t *sym, const uint8_t *sym,
JanetSlot s, JanetSlot s,
JanetTable *attr) { JanetTable *attr) {
if (c->scope->flags & JANET_SCOPE_TOP) { if (c->scope->flags & JANET_SCOPE_TOP) {
/* Global var, generate var */ /* Global var, generate var */
JanetSlot refslot; JanetSlot refslot;
@ -291,7 +286,7 @@ static int varleaf(
janet_array_push(ref, janet_wrap_nil()); janet_array_push(ref, janet_wrap_nil());
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref)); janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
janet_table_put(reftab, janet_ckeywordv("source-map"), janet_table_put(reftab, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c))); janet_wrap_tuple(janetc_make_sourcemap(c)));
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab)); janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab));
refslot = janetc_cslot(janet_wrap_array(ref)); refslot = janetc_cslot(janet_wrap_array(ref));
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0); janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
@ -312,14 +307,14 @@ static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
} }
static int defleaf( static int defleaf(
JanetCompiler *c, JanetCompiler *c,
const uint8_t *sym, const uint8_t *sym,
JanetSlot s, JanetSlot s,
JanetTable *attr) { JanetTable *attr) {
if (c->scope->flags & JANET_SCOPE_TOP) { if (c->scope->flags & JANET_SCOPE_TOP) {
JanetTable *tab = janet_table(2); JanetTable *tab = janet_table(2);
janet_table_put(tab, janet_ckeywordv("source-map"), janet_table_put(tab, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c))); janet_wrap_tuple(janetc_make_sourcemap(c)));
tab->proto = attr; tab->proto = attr;
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value")); JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab)); JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
@ -382,8 +377,8 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Set target for compilation */ /* Set target for compilation */
target = (drop || tail) target = (drop || tail)
? janetc_cslot(janet_wrap_nil()) ? janetc_cslot(janet_wrap_nil())
: janetc_gettarget(opts); : janetc_gettarget(opts);
/* Compile condition */ /* Compile condition */
janetc_scope(&condscope, c, 0, "if"); janetc_scope(&condscope, c, 0, "if");
@ -518,8 +513,8 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Infinite loop does not need to check condition */ /* Infinite loop does not need to check condition */
labelc = infinite labelc = infinite
? 0 ? 0
: janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0); : janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
/* Compile body */ /* Compile body */
for (i = 1; i < argn; i++) { for (i = 1; i < argn; i++) {
@ -659,11 +654,11 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
if (parami + 1 == argn) { if (parami + 1 == argn) {
janetc_emit(c, JOP_RETURN_NIL); janetc_emit(c, JOP_RETURN_NIL);
} else for (argi = parami + 1; argi < argn; argi++) { } else for (argi = parami + 1; argi < argn; argi++) {
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP; subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
janetc_value(subopts, argv[argi]); janetc_value(subopts, argv[argi]);
if (c->result.status == JANET_COMPILE_ERROR) if (c->result.status == JANET_COMPILE_ERROR)
goto error2; goto error2;
} }
/* Build function */ /* Build function */
def = janetc_pop_funcdef(c); def = janetc_pop_funcdef(c);
@ -707,9 +702,9 @@ static const JanetSpecial janetc_specials[] = {
/* Find a special */ /* Find a special */
const JanetSpecial *janetc_special(const uint8_t *name) { const JanetSpecial *janetc_special(const uint8_t *name) {
return janet_strbinsearch( return janet_strbinsearch(
&janetc_specials, &janetc_specials,
sizeof(janetc_specials)/sizeof(JanetSpecial), sizeof(janetc_specials) / sizeof(JanetSpecial),
sizeof(JanetSpecial), sizeof(JanetSpecial),
name); name);
} }

95
src/core/string.c
View File

@ -32,7 +32,7 @@
/* Begin building a string */ /* Begin building a string */
uint8_t *janet_string_begin(int32_t length) { uint8_t *janet_string_begin(int32_t length) {
char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + length + 1); char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + length + 1);
uint8_t *str = (uint8_t *) (data + 2 * sizeof(int32_t)); uint8_t *str = (uint8_t *)(data + 2 * sizeof(int32_t));
janet_string_length(str) = length; janet_string_length(str) = length;
str[length] = 0; str[length] = 0;
return str; return str;
@ -48,7 +48,7 @@ const uint8_t *janet_string_end(uint8_t *str) {
const uint8_t *janet_string(const uint8_t *buf, int32_t len) { const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
int32_t hash = janet_string_calchash(buf, len); int32_t hash = janet_string_calchash(buf, len);
char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + len + 1); char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + len + 1);
uint8_t *str = (uint8_t *) (data + 2 * sizeof(int32_t)); uint8_t *str = (uint8_t *)(data + 2 * sizeof(int32_t));
memcpy(str, buf, len); memcpy(str, buf, len);
str[len] = 0; str[len] = 0;
janet_string_length(str) = len; janet_string_length(str) = len;
@ -81,7 +81,7 @@ int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, int32_t rlen
/* Check if two strings are equal */ /* Check if two strings are equal */
int janet_string_equal(const uint8_t *lhs, const uint8_t *rhs) { int janet_string_equal(const uint8_t *lhs, const uint8_t *rhs) {
return janet_string_equalconst(lhs, rhs, return janet_string_equalconst(lhs, rhs,
janet_string_length(rhs), janet_string_hash(rhs)); janet_string_length(rhs), janet_string_hash(rhs));
} }
/* Load a c string */ /* Load a c string */
@ -102,9 +102,9 @@ struct kmp_state {
}; };
static void kmp_init( static void kmp_init(
struct kmp_state *s, struct kmp_state *s,
const uint8_t *text, int32_t textlen, const uint8_t *text, int32_t textlen,
const uint8_t *pat, int32_t patlen) { const uint8_t *pat, int32_t patlen) {
int32_t *lookup = calloc(patlen, sizeof(int32_t)); int32_t *lookup = calloc(patlen, sizeof(int32_t));
if (!lookup) { if (!lookup) {
JANET_OUT_OF_MEMORY; JANET_OUT_OF_MEMORY;
@ -272,8 +272,8 @@ static Janet cfun_string_find(int32_t argc, Janet *argv) {
result = kmp_next(&state); result = kmp_next(&state);
kmp_deinit(&state); kmp_deinit(&state);
return result < 0 return result < 0
? janet_wrap_nil() ? janet_wrap_nil()
: janet_wrap_integer(result); : janet_wrap_integer(result);
} }
static Janet cfun_string_findall(int32_t argc, Janet *argv) { static Janet cfun_string_findall(int32_t argc, Janet *argv) {
@ -324,8 +324,8 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) {
memcpy(buf, s.kmp.text, result); memcpy(buf, s.kmp.text, result);
memcpy(buf + result, s.subst, s.substlen); memcpy(buf + result, s.subst, s.substlen);
memcpy(buf + result + s.substlen, memcpy(buf + result + s.substlen,
s.kmp.text + result + s.kmp.patlen, s.kmp.text + result + s.kmp.patlen,
s.kmp.textlen - result - s.kmp.patlen); s.kmp.textlen - result - s.kmp.patlen);
kmp_deinit(&s.kmp); kmp_deinit(&s.kmp);
return janet_wrap_string(janet_string_end(buf)); return janet_wrap_string(janet_string_end(buf));
} }
@ -453,97 +453,98 @@ static const JanetReg string_cfuns[] = {
{ {
"string/slice", cfun_string_slice, "string/slice", cfun_string_slice,
JDOC("(string/slice bytes [,start=0 [,end=(length str)]])\n\n" JDOC("(string/slice bytes [,start=0 [,end=(length str)]])\n\n"
"Returns a substring from a byte sequence. The substring is from " "Returns a substring from a byte sequence. The substring is from "
"index start inclusive to index end exclusive. All indexing " "index start inclusive to index end exclusive. All indexing "
"is from 0. 'start' and 'end' can also be negative to indicate indexing " "is from 0. 'start' and 'end' can also be negative to indicate indexing "
"from the end of the string.") "from the end of the string.")
}, },
{ {
"string/repeat", cfun_string_repeat, "string/repeat", cfun_string_repeat,
JDOC("(string/repeat bytes n)\n\n" JDOC("(string/repeat bytes n)\n\n"
"Returns a string that is n copies of bytes concatenated.") "Returns a string that is n copies of bytes concatenated.")
}, },
{ {
"string/bytes", cfun_string_bytes, "string/bytes", cfun_string_bytes,
JDOC("(string/bytes str)\n\n" JDOC("(string/bytes str)\n\n"
"Returns an array of integers that are the byte values of the string.") "Returns an array of integers that are the byte values of the string.")
}, },
{ {
"string/from-bytes", cfun_string_frombytes, "string/from-bytes", cfun_string_frombytes,
JDOC("(string/from-bytes byte-array)\n\n" JDOC("(string/from-bytes byte-array)\n\n"
"Creates a string from an array of integers with byte values. All integers " "Creates a string from an array of integers with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.") "will be coerced to the range of 1 byte 0-255.")
}, },
{ {
"string/ascii-lower", cfun_string_asciilower, "string/ascii-lower", cfun_string_asciilower,
JDOC("(string/ascii-lower str)\n\n" JDOC("(string/ascii-lower str)\n\n"
"Returns a new string where all bytes are replaced with the " "Returns a new string where all bytes are replaced with the "
"lowercase version of themselves in ASCII. Does only a very simple " "lowercase version of themselves in ASCII. Does only a very simple "
"case check, meaning no unicode support.") "case check, meaning no unicode support.")
}, },
{ {
"string/ascii-upper", cfun_string_asciiupper, "string/ascii-upper", cfun_string_asciiupper,
JDOC("(string/ascii-upper str)\n\n" JDOC("(string/ascii-upper str)\n\n"
"Returns a new string where all bytes are replaced with the " "Returns a new string where all bytes are replaced with the "
"uppercase version of themselves in ASCII. Does only a very simple " "uppercase version of themselves in ASCII. Does only a very simple "
"case check, meaning no unicode support.") "case check, meaning no unicode support.")
}, },
{ {
"string/reverse", cfun_string_reverse, "string/reverse", cfun_string_reverse,
JDOC("(string/reverse str)\n\n" JDOC("(string/reverse str)\n\n"
"Returns a string that is the reversed version of str.") "Returns a string that is the reversed version of str.")
}, },
{ {
"string/find", cfun_string_find, "string/find", cfun_string_find,
JDOC("(string/find patt str)\n\n" JDOC("(string/find patt str)\n\n"
"Searches for the first instance of pattern patt in string " "Searches for the first instance of pattern patt in string "
"str. Returns the index of the first character in patt if found, " "str. Returns the index of the first character in patt if found, "
"otherwise returns nil.") "otherwise returns nil.")
}, },
{ {
"string/find-all", cfun_string_findall, "string/find-all", cfun_string_findall,
JDOC("(string/find patt str)\n\n" JDOC("(string/find patt str)\n\n"
"Searches for all instances of pattern patt in string " "Searches for all instances of pattern patt in string "
"str. Returns an array of all indices of found patterns. Overlapping " "str. Returns an array of all indices of found patterns. Overlapping "
"instances of the pattern are not counted, meaning a byte in string " "instances of the pattern are not counted, meaning a byte in string "
"will only contribute to finding at most on occurrence of pattern. If no " "will only contribute to finding at most on occurrence of pattern. If no "
"occurrences are found, will return an empty array.") "occurrences are found, will return an empty array.")
}, },
{ {
"string/replace", cfun_string_replace, "string/replace", cfun_string_replace,
JDOC("(string/replace patt subst str)\n\n" JDOC("(string/replace patt subst str)\n\n"
"Replace the first occurrence of patt with subst in the string str. " "Replace the first occurrence of patt with subst in the string str. "
"Will return the new string if patt is found, otherwise returns str.") "Will return the new string if patt is found, otherwise returns str.")
}, },
{ {
"string/replace-all", cfun_string_replaceall, "string/replace-all", cfun_string_replaceall,
JDOC("(string/replace-all patt subst str)\n\n" JDOC("(string/replace-all patt subst str)\n\n"
"Replace all instances of patt with subst in the string str. " "Replace all instances of patt with subst in the string str. "
"Will return the new string if patt is found, otherwise returns str.") "Will return the new string if patt is found, otherwise returns str.")
}, },
{ {
"string/split", cfun_string_split, "string/split", cfun_string_split,
JDOC("(string/split delim str)\n\n" JDOC("(string/split delim str)\n\n"
"Splits a string str with delimiter delim and returns an array of " "Splits a string str with delimiter delim and returns an array of "
"substrings. The substrings will not contain the delimiter delim. If delim " "substrings. The substrings will not contain the delimiter delim. If delim "
"is not found, the returned array will have one element.") "is not found, the returned array will have one element.")
}, },
{ {
"string/check-set", cfun_string_checkset, "string/check-set", cfun_string_checkset,
JDOC("(string/check-set set str)\n\n" JDOC("(string/check-set set str)\n\n"
"Checks if any of the bytes in the string set appear in the string str. " "Checks if any of the bytes in the string set appear in the string str. "
"Returns true if some bytes in set do appear in str, false if no bytes do.") "Returns true if some bytes in set do appear in str, false if no bytes do.")
}, },
{ {
"string/join", cfun_string_join, "string/join", cfun_string_join,
JDOC("(string/join parts [,sep])\n\n" JDOC("(string/join parts [,sep])\n\n"
"Joins an array of strings into one string, optionally separated by " "Joins an array of strings into one string, optionally separated by "
"a separator string sep.") "a separator string sep.")
}, },
{ "string/format", cfun_string_format, {
"string/format", cfun_string_format,
JDOC("(string/format format & values)\n\n" JDOC("(string/format format & values)\n\n"
"Similar to snprintf, but specialized for operating with janet. Returns " "Similar to snprintf, but specialized for operating with janet. Returns "
"a new string.") "a new string.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

61
src/core/strtod.c
View File

@ -50,14 +50,14 @@
/* Lookup table for getting values of characters when parsing numbers. Handles /* Lookup table for getting values of characters when parsing numbers. Handles
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */ * digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
static uint8_t digit_lookup[128] = { static uint8_t digit_lookup[128] = {
0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
0,1,2,3,4,5,6,7,8,9,0xff,0xff,0xff,0xff,0xff,0xff, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
0xff,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, 0xff, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
25,26,27,28,29,30,31,32,33,34,35,0xff,0xff,0xff,0xff,0xff, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 0xff, 0xff, 0xff, 0xff, 0xff,
0xff,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, 0xff, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
25,26,27,28,29,30,31,32,33,34,35,0xff,0xff,0xff,0xff,0xff 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 0xff, 0xff, 0xff, 0xff, 0xff
}; };
#define BIGNAT_NBIT 31 #define BIGNAT_NBIT 31
@ -197,10 +197,10 @@ static double bignat_extract(struct BigNat *mant, int32_t exponent2) {
* back the double value. Should properly handle 0s, infinities, and * back the double value. Should properly handle 0s, infinities, and
* denormalized numbers. (When the exponent values are too large) */ * denormalized numbers. (When the exponent values are too large) */
static double convert( static double convert(
int negative, int negative,
struct BigNat *mant, struct BigNat *mant,
int32_t base, int32_t base,
int32_t exponent) { int32_t exponent) {
int32_t exponent2 = 0; int32_t exponent2 = 0;
@ -214,9 +214,9 @@ static double convert(
* Get exponent to zero while holding X constant. */ * Get exponent to zero while holding X constant. */
/* Positive exponents are simple */ /* Positive exponents are simple */
for (;exponent > 3; exponent -= 4) bignat_muladd(mant, base * base * base * base, 0); for (; exponent > 3; exponent -= 4) bignat_muladd(mant, base * base * base * base, 0);
for (;exponent > 1; exponent -= 2) bignat_muladd(mant, base * base, 0); for (; exponent > 1; exponent -= 2) bignat_muladd(mant, base * base, 0);
for (;exponent > 0; exponent -= 1) bignat_muladd(mant, base, 0); for (; exponent > 0; exponent -= 1) bignat_muladd(mant, base, 0);
/* Negative exponents are tricky - we don't want to loose bits /* Negative exponents are tricky - we don't want to loose bits
* from integer division, so we need to premultiply. */ * from integer division, so we need to premultiply. */
@ -224,22 +224,22 @@ static double convert(
int32_t shamt = 5 - exponent / 4; int32_t shamt = 5 - exponent / 4;
bignat_lshift_n(mant, shamt); bignat_lshift_n(mant, shamt);
exponent2 -= shamt * BIGNAT_NBIT; exponent2 -= shamt * BIGNAT_NBIT;
for (;exponent < -3; exponent += 4) bignat_div(mant, base * base * base * base); for (; exponent < -3; exponent += 4) bignat_div(mant, base * base * base * base);
for (;exponent < -1; exponent += 2) bignat_div(mant, base * base); for (; exponent < -1; exponent += 2) bignat_div(mant, base * base);
for (;exponent < 0; exponent += 1) bignat_div(mant, base); for (; exponent < 0; exponent += 1) bignat_div(mant, base);
} }
return negative return negative
? -bignat_extract(mant, exponent2) ? -bignat_extract(mant, exponent2)
: bignat_extract(mant, exponent2); : bignat_extract(mant, exponent2);
} }
/* Scan a real (double) from a string. If the string cannot be converted into /* Scan a real (double) from a string. If the string cannot be converted into
* and integer, set *err to 1 and return 0. */ * and integer, set *err to 1 and return 0. */
int janet_scan_number( int janet_scan_number(
const uint8_t *str, const uint8_t *str,
int32_t len, int32_t len,
double *out) { double *out) {
const uint8_t *end = str + len; const uint8_t *end = str + len;
int seenadigit = 0; int seenadigit = 0;
int ex = 0; int ex = 0;
@ -271,14 +271,14 @@ int janet_scan_number(
base = 16; base = 16;
str += 2; str += 2;
} else if (str + 1 < end && } else if (str + 1 < end &&
str[0] >= '0' && str[0] <= '9' && str[0] >= '0' && str[0] <= '9' &&
str[1] == 'r') { str[1] == 'r') {
base = str[0] - '0'; base = str[0] - '0';
str += 2; str += 2;
} else if (str + 2 < end && } else if (str + 2 < end &&
str[0] >= '0' && str[0] <= '9' && str[0] >= '0' && str[0] <= '9' &&
str[1] >= '0' && str[1] <= '9' && str[1] >= '0' && str[1] <= '9' &&
str[2] == 'r') { str[2] == 'r') {
base = 10 * (str[0] - '0') + (str[1] - '0'); base = 10 * (str[0] - '0') + (str[1] - '0');
if (base < 2 || base > 36) goto error; if (base < 2 || base > 36) goto error;
str += 3; str += 3;
@ -346,7 +346,8 @@ int janet_scan_number(
str++; str++;
seenadigit = 1; seenadigit = 1;
} }
if (eneg) ex -= ee; else ex += ee; if (eneg) ex -= ee;
else ex += ee;
} }
if (!seenadigit) if (!seenadigit)
@ -356,7 +357,7 @@ int janet_scan_number(
free(mant.digits); free(mant.digits);
return 0; return 0;
error: error:
free(mant.digits); free(mant.digits);
return 1; return 1;
} }

96
src/core/struct.c
View File

@ -36,7 +36,7 @@ JanetKV *janet_struct_begin(int32_t count) {
size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(JanetKV)); size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(JanetKV));
char *data = janet_gcalloc(JANET_MEMORY_STRUCT, s); char *data = janet_gcalloc(JANET_MEMORY_STRUCT, s);
JanetKV *st = (JanetKV *) (data + 4 * sizeof(int32_t)); JanetKV *st = (JanetKV *)(data + 4 * sizeof(int32_t));
janet_memempty(st, capacity); janet_memempty(st, capacity);
janet_struct_length(st) = count; janet_struct_length(st) = count;
janet_struct_capacity(st) = capacity; janet_struct_capacity(st) = capacity;
@ -78,54 +78,54 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
/* Avoid extra items */ /* Avoid extra items */
if (janet_struct_hash(st) == janet_struct_length(st)) return; if (janet_struct_hash(st) == janet_struct_length(st)) return;
for (dist = 0, j = 0; j < 4; j += 2) for (dist = 0, j = 0; j < 4; j += 2)
for (i = bounds[j]; i < bounds[j + 1]; i++, dist++) { for (i = bounds[j]; i < bounds[j + 1]; i++, dist++) {
int status; int status;
int32_t otherhash; int32_t otherhash;
int32_t otherindex, otherdist; int32_t otherindex, otherdist;
JanetKV *kv = st + i; JanetKV *kv = st + i;
/* We found an empty slot, so just add key and value */ /* We found an empty slot, so just add key and value */
if (janet_checktype(kv->key, JANET_NIL)) { if (janet_checktype(kv->key, JANET_NIL)) {
kv->key = key; kv->key = key;
kv->value = value; kv->value = value;
/* Update the temporary count */ /* Update the temporary count */
janet_struct_hash(st)++; janet_struct_hash(st)++;
return; return;
}
/* Robinhood hashing - check if colliding kv pair
* is closer to their source than current. We use robinhood
* hashing to ensure that equivalent structs that are constructed
* with different order have the same internal layout, and therefor
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
* Collisions are resolved via an insertion sort insertion. */
otherhash = janet_hash(kv->key);
otherindex = janet_maphash(cap, otherhash);
otherdist = (i + cap - otherindex) & (cap - 1);
if (dist < otherdist)
status = -1;
else if (otherdist < dist)
status = 1;
else if (hash < otherhash)
status = -1;
else if (otherhash < hash)
status = 1;
else
status = janet_compare(key, kv->key);
/* If other is closer to their ideal slot */
if (status == 1) {
/* Swap current kv pair with pair in slot */
JanetKV temp = *kv;
kv->key = key;
kv->value = value;
key = temp.key;
value = temp.value;
/* Save dist and hash of new kv pair */
dist = otherdist;
hash = otherhash;
} else if (status == 0) {
/* A key was added to the struct more than once */
return;
}
} }
/* Robinhood hashing - check if colliding kv pair
* is closer to their source than current. We use robinhood
* hashing to ensure that equivalent structs that are constructed
* with different order have the same internal layout, and therefor
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
* Collisions are resolved via an insertion sort insertion. */
otherhash = janet_hash(kv->key);
otherindex = janet_maphash(cap, otherhash);
otherdist = (i + cap - otherindex) & (cap - 1);
if (dist < otherdist)
status = -1;
else if (otherdist < dist)
status = 1;
else if (hash < otherhash)
status = -1;
else if (otherhash < hash)
status = 1;
else
status = janet_compare(key, kv->key);
/* If other is closer to their ideal slot */
if (status == 1) {
/* Swap current kv pair with pair in slot */
JanetKV temp = *kv;
kv->key = key;
kv->value = value;
key = temp.key;
value = temp.value;
/* Save dist and hash of new kv pair */
dist = otherdist;
hash = otherhash;
} else if (status == 0) {
/* A key was added to the struct more than once */
return;
}
}
} }
/* Finish building a struct */ /* Finish building a struct */

32
src/core/symcache.c
View File

@ -66,10 +66,10 @@ static const uint8_t JANET_SYMCACHE_DELETED[1] = {0};
* If the item is not found, return the location * If the item is not found, return the location
* where one would put it. */ * where one would put it. */
static const uint8_t **janet_symcache_findmem( static const uint8_t **janet_symcache_findmem(
const uint8_t *str, const uint8_t *str,
int32_t len, int32_t len,
int32_t hash, int32_t hash,
int *success) { int *success) {
uint32_t bounds[4]; uint32_t bounds[4];
uint32_t i, j, index; uint32_t i, j, index;
const uint8_t **firstEmpty = NULL; const uint8_t **firstEmpty = NULL;
@ -82,7 +82,7 @@ static const uint8_t **janet_symcache_findmem(
bounds[2] = 0; bounds[2] = 0;
bounds[3] = index; bounds[3] = index;
for (j = 0; j < 4; j += 2) for (j = 0; j < 4; j += 2)
for (i = bounds[j]; i < bounds[j+1]; ++i) { for (i = bounds[j]; i < bounds[j + 1]; ++i) {
const uint8_t *test = janet_vm_cache[i]; const uint8_t *test = janet_vm_cache[i];
/* Check empty spots */ /* Check empty spots */
if (NULL == test) { if (NULL == test) {
@ -107,7 +107,7 @@ static const uint8_t **janet_symcache_findmem(
return janet_vm_cache + i; return janet_vm_cache + i;
} }
} }
notfound: notfound:
*success = 0; *success = 0;
return firstEmpty; return firstEmpty;
} }
@ -177,7 +177,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
if (success) if (success)
return *bucket; return *bucket;
newstr = (uint8_t *) janet_gcalloc(JANET_MEMORY_SYMBOL, 2 * sizeof(int32_t) + len + 1) newstr = (uint8_t *) janet_gcalloc(JANET_MEMORY_SYMBOL, 2 * sizeof(int32_t) + len + 1)
+ (2 * sizeof(int32_t)); + (2 * sizeof(int32_t));
janet_string_hash(newstr) = hash; janet_string_hash(newstr) = hash;
janet_string_length(newstr) = len; janet_string_length(newstr) = len;
memcpy(newstr, str, len); memcpy(newstr, str, len);
@ -226,18 +226,18 @@ const uint8_t *janet_symbol_gen(void) {
* is enough for resolving collisions. */ * is enough for resolving collisions. */
do { do {
hash = janet_string_calchash( hash = janet_string_calchash(
gensym_counter, gensym_counter,
sizeof(gensym_counter) - 1); sizeof(gensym_counter) - 1);
bucket = janet_symcache_findmem( bucket = janet_symcache_findmem(
gensym_counter, gensym_counter,
sizeof(gensym_counter) - 1, sizeof(gensym_counter) - 1,
hash, hash,
&status); &status);
} while (status && (inc_gensym(), 1)); } while (status && (inc_gensym(), 1));
sym = (uint8_t *) janet_gcalloc( sym = (uint8_t *) janet_gcalloc(
JANET_MEMORY_SYMBOL, JANET_MEMORY_SYMBOL,
2 * sizeof(int32_t) + sizeof(gensym_counter)) + 2 * sizeof(int32_t) + sizeof(gensym_counter)) +
(2 * sizeof(int32_t)); (2 * sizeof(int32_t));
memcpy(sym, gensym_counter, sizeof(gensym_counter)); memcpy(sym, gensym_counter, sizeof(gensym_counter));
janet_string_length(sym) = sizeof(gensym_counter) - 1; janet_string_length(sym) = sizeof(gensym_counter) - 1;
janet_string_hash(sym) = hash; janet_string_hash(sym) = hash;

28
src/core/table.c
View File

@ -208,8 +208,8 @@ static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetTable *t = janet_gettable(argv, 0); JanetTable *t = janet_gettable(argv, 0);
return t->proto return t->proto
? janet_wrap_table(t->proto) ? janet_wrap_table(t->proto)
: janet_wrap_nil(); : janet_wrap_nil();
} }
static Janet cfun_table_setproto(int32_t argc, Janet *argv) { static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
@ -239,34 +239,34 @@ static const JanetReg table_cfuns[] = {
{ {
"table/new", cfun_table_new, "table/new", cfun_table_new,
JDOC("(table/new capacity)\n\n" JDOC("(table/new capacity)\n\n"
"Creates a new empty table with pre-allocated memory " "Creates a new empty table with pre-allocated memory "
"for capacity entries. This means that if one knows the number of " "for capacity entries. This means that if one knows the number of "
"entries going to go in a table on creation, extra memory allocation " "entries going to go in a table on creation, extra memory allocation "
"can be avoided. Returns the new table.") "can be avoided. Returns the new table.")
}, },
{ {
"table/to-struct", cfun_table_tostruct, "table/to-struct", cfun_table_tostruct,
JDOC("(table/to-struct tab)\n\n" JDOC("(table/to-struct tab)\n\n"
"Convert a table to a struct. Returns a new struct. This function " "Convert a table to a struct. Returns a new struct. This function "
"does not take into account prototype tables.") "does not take into account prototype tables.")
}, },
{ {
"table/getproto", cfun_table_getproto, "table/getproto", cfun_table_getproto,
JDOC("(table/getproto tab)\n\n" JDOC("(table/getproto tab)\n\n"
"Get the prototype table of a table. Returns nil if a table " "Get the prototype table of a table. Returns nil if a table "
"has no prototype, otherwise returns the prototype.") "has no prototype, otherwise returns the prototype.")
}, },
{ {
"table/setproto", cfun_table_setproto, "table/setproto", cfun_table_setproto,
JDOC("(table/setproto tab proto)\n\n" JDOC("(table/setproto tab proto)\n\n"
"Set the prototype of a table. Returns the original table tab.") "Set the prototype of a table. Returns the original table tab.")
}, },
{ {
"table/rawget", cfun_table_rawget, "table/rawget", cfun_table_rawget,
JDOC("(table/rawget tab key)\n\n" JDOC("(table/rawget tab key)\n\n"
"Gets a value from a table without looking at the prototype table. " "Gets a value from a table without looking at the prototype table. "
"If a table tab does not contain t directly, the function will return " "If a table tab does not contain t directly, the function will return "
"nil without checking the prototype. Returns the value in the table.") "nil without checking the prototype. Returns the value in the table.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

30
src/core/tuple.c
View File

@ -140,37 +140,37 @@ static const JanetReg tuple_cfuns[] = {
{ {
"tuple/brackets", cfun_tuple_brackets, "tuple/brackets", cfun_tuple_brackets,
JDOC("(tuple/brackets & xs)\n\n" JDOC("(tuple/brackets & xs)\n\n"
"Creates a new bracketed tuple containing the elements xs.") "Creates a new bracketed tuple containing the elements xs.")
}, },
{ {
"tuple/slice", cfun_tuple_slice, "tuple/slice", cfun_tuple_slice,
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n" JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
"Take a sub sequence of an array or tuple from index start " "Take a sub sequence of an array or tuple from index start "
"inclusive to index end exclusive. If start or end are not provided, " "inclusive to index end exclusive. If start or end are not provided, "
"they default to 0 and the length of arrtup respectively." "they default to 0 and the length of arrtup respectively."
"Returns the new tuple.") "Returns the new tuple.")
}, },
{ {
"tuple/append", cfun_tuple_append, "tuple/append", cfun_tuple_append,
JDOC("(tuple/append tup & items)\n\n" JDOC("(tuple/append tup & items)\n\n"
"Returns a new tuple that is the result of appending " "Returns a new tuple that is the result of appending "
"each element in items to tup.") "each element in items to tup.")
}, },
{ {
"tuple/prepend", cfun_tuple_prepend, "tuple/prepend", cfun_tuple_prepend,
JDOC("(tuple/prepend tup & items)\n\n" JDOC("(tuple/prepend tup & items)\n\n"
"Prepends each element in items to tuple and " "Prepends each element in items to tuple and "
"returns a new tuple. Items are prepended such that the " "returns a new tuple. Items are prepended such that the "
"last element in items is the first element in the new tuple.") "last element in items is the first element in the new tuple.")
}, },
{ {
"tuple/type", cfun_tuple_type, "tuple/type", cfun_tuple_type,
JDOC("(tuple/type tup)\n\n" JDOC("(tuple/type tup)\n\n"
"Checks how the tuple was constructed. Will return the keyword " "Checks how the tuple was constructed. Will return the keyword "
":brackets if the tuple was parsed with brackets, and :parens " ":brackets if the tuple was parsed with brackets, and :parens "
"otherwise. The two types of tuples will behave the same most of " "otherwise. The two types of tuples will behave the same most of "
"the time, but will print differently and be treated differently by " "the time, but will print differently and be treated differently by "
"the compiler.") "the compiler.")
}, },
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };

12
src/core/util.c
View File

@ -210,10 +210,10 @@ int janet_cstrcmp(const uint8_t *str, const char *other) {
* have a string as its first element, and the struct must be sorted * have a string as its first element, and the struct must be sorted
* lexicographically by that element. */ * lexicographically by that element. */
const void *janet_strbinsearch( const void *janet_strbinsearch(
const void *tab, const void *tab,
size_t tabcount, size_t tabcount,
size_t itemsize, size_t itemsize,
const uint8_t *key) { const uint8_t *key) {
size_t low = 0; size_t low = 0;
size_t hi = tabcount; size_t hi = tabcount;
const char *t = (const char *)tab; const char *t = (const char *)tab;
@ -311,8 +311,8 @@ JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out)
return JANET_BINDING_NONE; return JANET_BINDING_NONE;
entry_table = janet_unwrap_table(entry); entry_table = janet_unwrap_table(entry);
if (!janet_checktype( if (!janet_checktype(
janet_table_get(entry_table, janet_ckeywordv("macro")), janet_table_get(entry_table, janet_ckeywordv("macro")),
JANET_NIL)) { JANET_NIL)) {
*out = janet_table_get(entry_table, janet_ckeywordv("value")); *out = janet_table_get(entry_table, janet_ckeywordv("value"));
return JANET_BINDING_MACRO; return JANET_BINDING_MACRO;
} }

18
src/core/util.h
View File

@ -48,16 +48,16 @@ Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
void janet_memempty(JanetKV *mem, int32_t count); void janet_memempty(JanetKV *mem, int32_t count);
void *janet_memalloc_empty(int32_t count); void *janet_memalloc_empty(int32_t count);
const void *janet_strbinsearch( const void *janet_strbinsearch(
const void *tab, const void *tab,
size_t tabcount, size_t tabcount,
size_t itemsize, size_t itemsize,
const uint8_t *key); const uint8_t *key);
void janet_buffer_format( void janet_buffer_format(
JanetBuffer *b, JanetBuffer *b,
const char *strfrmt, const char *strfrmt,
int32_t argstart, int32_t argstart,
int32_t argc, int32_t argc,
Janet *argv); Janet *argv);
/* Inside the janet core, defining globals is different /* Inside the janet core, defining globals is different
* at bootstrap time and normal runtime */ * at bootstrap time and normal runtime */

391
src/core/value.c
View File

@ -35,27 +35,27 @@ int janet_equals(Janet x, Janet y) {
result = 0; result = 0;
} else { } else {
switch (janet_type(x)) { switch (janet_type(x)) {
case JANET_NIL: case JANET_NIL:
case JANET_TRUE: case JANET_TRUE:
case JANET_FALSE: case JANET_FALSE:
result = 1; result = 1;
break; break;
case JANET_NUMBER: case JANET_NUMBER:
result = (janet_unwrap_number(x) == janet_unwrap_number(y)); result = (janet_unwrap_number(x) == janet_unwrap_number(y));
break; break;
case JANET_STRING: case JANET_STRING:
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y)); result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
break; break;
case JANET_TUPLE: case JANET_TUPLE:
result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y)); result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
break; break;
case JANET_STRUCT: case JANET_STRUCT:
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y)); result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
break; break;
default: default:
/* compare pointers */ /* compare pointers */
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y)); result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
break; break;
} }
} }
return result; return result;
@ -65,41 +65,41 @@ int janet_equals(Janet x, Janet y) {
int32_t janet_hash(Janet x) { int32_t janet_hash(Janet x) {
int32_t hash = 0; int32_t hash = 0;
switch (janet_type(x)) { switch (janet_type(x)) {
case JANET_NIL: case JANET_NIL:
hash = 0; hash = 0;
break; break;
case JANET_FALSE: case JANET_FALSE:
hash = 1; hash = 1;
break; break;
case JANET_TRUE: case JANET_TRUE:
hash = 2; hash = 2;
break; break;
case JANET_STRING: case JANET_STRING:
case JANET_SYMBOL: case JANET_SYMBOL:
case JANET_KEYWORD: case JANET_KEYWORD:
hash = janet_string_hash(janet_unwrap_string(x)); hash = janet_string_hash(janet_unwrap_string(x));
break; break;
case JANET_TUPLE: case JANET_TUPLE:
hash = janet_tuple_hash(janet_unwrap_tuple(x)); hash = janet_tuple_hash(janet_unwrap_tuple(x));
break; break;
case JANET_STRUCT: case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x)); hash = janet_struct_hash(janet_unwrap_struct(x));
break; break;
default: default:
/* TODO - test performance with different hash functions */ /* TODO - test performance with different hash functions */
if (sizeof(double) == sizeof(void *)) { if (sizeof(double) == sizeof(void *)) {
/* Assuming 8 byte pointer */ /* Assuming 8 byte pointer */
uint64_t i = janet_u64(x); uint64_t i = janet_u64(x);
hash = (int32_t)(i & 0xFFFFFFFF); hash = (int32_t)(i & 0xFFFFFFFF);
/* Get a bit more entropy by shifting the low bits out */ /* Get a bit more entropy by shifting the low bits out */
hash >>= 3; hash >>= 3;
hash ^= (int32_t) (i >> 32); hash ^= (int32_t)(i >> 32);
} else { } else {
/* Assuming 4 byte pointer (or smaller) */ /* Assuming 4 byte pointer (or smaller) */
hash = (int32_t) ((char *)janet_unwrap_pointer(x) - (char *)0); hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);
hash >>= 2; hash >>= 2;
} }
break; break;
} }
return hash; return hash;
} }
@ -118,8 +118,8 @@ int janet_compare(Janet x, Janet y) {
/* Check for NaNs to ensure total order */ /* Check for NaNs to ensure total order */
if (janet_unwrap_number(x) != janet_unwrap_number(x)) if (janet_unwrap_number(x) != janet_unwrap_number(x))
return janet_unwrap_number(y) != janet_unwrap_number(y) return janet_unwrap_number(y) != janet_unwrap_number(y)
? 0 ? 0
: -1; : -1;
if (janet_unwrap_number(y) != janet_unwrap_number(y)) if (janet_unwrap_number(y) != janet_unwrap_number(y))
return 1; return 1;
@ -161,75 +161,70 @@ Janet janet_get(Janet ds, Janet key) {
case JANET_TABLE: case JANET_TABLE:
value = janet_table_get(janet_unwrap_table(ds), key); value = janet_table_get(janet_unwrap_table(ds), key);
break; break;
case JANET_ARRAY: case JANET_ARRAY: {
{ JanetArray *array = janet_unwrap_array(ds);
JanetArray *array = janet_unwrap_array(ds); int32_t index;
int32_t index; if (!janet_checkint(key))
if (!janet_checkint(key)) janet_panic("expected integer key");
janet_panic("expected integer key"); index = janet_unwrap_integer(key);
index = janet_unwrap_integer(key); if (index < 0 || index >= array->count) {
if (index < 0 || index >= array->count) { value = janet_wrap_nil();
value = janet_wrap_nil(); } else {
} else { value = array->data[index];
value = array->data[index];
}
break;
} }
case JANET_TUPLE: break;
{ }
const Janet *tuple = janet_unwrap_tuple(ds); case JANET_TUPLE: {
int32_t index; const Janet *tuple = janet_unwrap_tuple(ds);
if (!janet_checkint(key)) int32_t index;
janet_panic("expected integer key"); if (!janet_checkint(key))
index = janet_unwrap_integer(key); janet_panic("expected integer key");
if (index < 0 || index >= janet_tuple_length(tuple)) { index = janet_unwrap_integer(key);
value = janet_wrap_nil(); if (index < 0 || index >= janet_tuple_length(tuple)) {
} else { value = janet_wrap_nil();
value = tuple[index]; } else {
} value = tuple[index];
break;
} }
case JANET_BUFFER: break;
{ }
JanetBuffer *buffer = janet_unwrap_buffer(ds); case JANET_BUFFER: {
int32_t index; JanetBuffer *buffer = janet_unwrap_buffer(ds);
if (!janet_checkint(key)) int32_t index;
janet_panic("expected integer key"); if (!janet_checkint(key))
index = janet_unwrap_integer(key); janet_panic("expected integer key");
if (index < 0 || index >= buffer->count) { index = janet_unwrap_integer(key);
value = janet_wrap_nil(); if (index < 0 || index >= buffer->count) {
} else { value = janet_wrap_nil();
value = janet_wrap_integer(buffer->data[index]); } else {
} value = janet_wrap_integer(buffer->data[index]);
break;
} }
break;
}
case JANET_STRING: case JANET_STRING:
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;
int32_t index; if (!janet_checkint(key))
if (!janet_checkint(key)) janet_panic("expected integer key");
janet_panic("expected integer key"); index = janet_unwrap_integer(key);
index = janet_unwrap_integer(key); if (index < 0 || index >= janet_string_length(str)) {
if (index < 0 || index >= janet_string_length(str)) { value = janet_wrap_nil();
value = janet_wrap_nil(); } else {
} else { value = janet_wrap_integer(str[index]);
value = janet_wrap_integer(str[index]);
}
break;
} }
case JANET_ABSTRACT: break;
{ }
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); case JANET_ABSTRACT: {
if (type->get) { JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
value = (type->get)(janet_unwrap_abstract(ds),key); if (type->get) {
} else { value = (type->get)(janet_unwrap_abstract(ds), key);
janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds); } else {
value = janet_wrap_nil(); janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds);
} value = janet_wrap_nil();
break;
} }
break;
}
} }
return value; return value;
} }
@ -278,17 +273,16 @@ Janet janet_getindex(Janet ds, int32_t index) {
case JANET_STRUCT: case JANET_STRUCT:
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index)); value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
break; break;
case JANET_ABSTRACT: case JANET_ABSTRACT: {
{ JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); if (type->get) {
if (type->get) { value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
value = (type->get)(janet_unwrap_abstract(ds),janet_wrap_integer(index)); } else {
} else { janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds);
janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds); value = janet_wrap_nil();
value = janet_wrap_nil();
}
break;
} }
break;
}
} }
return value; return value;
} }
@ -319,46 +313,42 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
switch (janet_type(ds)) { switch (janet_type(ds)) {
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);
break; break;
case JANET_ARRAY: case JANET_ARRAY: {
{ JanetArray *array = janet_unwrap_array(ds);
JanetArray *array = janet_unwrap_array(ds); if (index >= array->count) {
if (index >= array->count) { janet_array_ensure(array, index + 1, 2);
janet_array_ensure(array, index + 1, 2); array->count = index + 1;
array->count = index + 1;
}
array->data[index] = value;
break;
} }
case JANET_BUFFER: array->data[index] = value;
{ break;
JanetBuffer *buffer = janet_unwrap_buffer(ds); }
if (!janet_checkint(value)) case JANET_BUFFER: {
janet_panicf("can only put integers in buffers, got %v", value); JanetBuffer *buffer = janet_unwrap_buffer(ds);
if (index >= buffer->count) { if (!janet_checkint(value))
janet_buffer_ensure(buffer, index + 1, 2); janet_panicf("can only put integers in buffers, got %v", value);
buffer->count = index + 1; if (index >= buffer->count) {
} janet_buffer_ensure(buffer, index + 1, 2);
buffer->data[index] = janet_unwrap_integer(value); buffer->count = index + 1;
break;
} }
case JANET_TABLE: buffer->data[index] = janet_unwrap_integer(value);
{ break;
JanetTable *table = janet_unwrap_table(ds); }
janet_table_put(table, janet_wrap_integer(index), value); case JANET_TABLE: {
break; JanetTable *table = janet_unwrap_table(ds);
} janet_table_put(table, janet_wrap_integer(index), value);
case JANET_ABSTRACT: break;
{ }
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); case JANET_ABSTRACT: {
if (type->put) { JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
(type->put)(janet_unwrap_abstract(ds),janet_wrap_integer(index),value); if (type->put) {
} else { (type->put)(janet_unwrap_abstract(ds), janet_wrap_integer(index), value);
janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds); } else {
} janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds);
break;
} }
break;
}
} }
} }
@ -366,48 +356,45 @@ void janet_put(Janet ds, Janet key, Janet value) {
switch (janet_type(ds)) { switch (janet_type(ds)) {
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);
break; break;
case JANET_ARRAY: case JANET_ARRAY: {
{ int32_t index;
int32_t index; JanetArray *array = janet_unwrap_array(ds);
JanetArray *array = janet_unwrap_array(ds); if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key); index = janet_unwrap_integer(key);
index = janet_unwrap_integer(key); if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key); if (index >= array->count) {
if (index >= array->count) { janet_array_setcount(array, index + 1);
janet_array_setcount(array, index + 1);
}
array->data[index] = value;
break;
} }
case JANET_BUFFER: array->data[index] = value;
{ break;
int32_t index; }
JanetBuffer *buffer = janet_unwrap_buffer(ds); case JANET_BUFFER: {
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key); int32_t index;
index = janet_unwrap_integer(key); JanetBuffer *buffer = janet_unwrap_buffer(ds);
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key); if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
if (!janet_checkint(value)) index = janet_unwrap_integer(key);
janet_panicf("can only put integers in buffers, got %v", value); if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
if (index >= buffer->count) { if (!janet_checkint(value))
janet_buffer_setcount(buffer, index + 1); janet_panicf("can only put integers in buffers, got %v", value);
} if (index >= buffer->count) {
buffer->data[index] = (uint8_t) (janet_unwrap_integer(value) & 0xFF); janet_buffer_setcount(buffer, index + 1);
break;
} }
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
break;
}
case JANET_TABLE: case JANET_TABLE:
janet_table_put(janet_unwrap_table(ds), key, value); janet_table_put(janet_unwrap_table(ds), key, value);
break; break;
case JANET_ABSTRACT: case JANET_ABSTRACT: {
{ JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds)); if (type->put) {
if (type->put) { (type->put)(janet_unwrap_abstract(ds), key, value);
(type->put)(janet_unwrap_abstract(ds),key,value); } else {
} else { janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds);
janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds);
}
break;
} }
break;
}
} }
} }

22
src/core/vector.c
View File

@ -29,17 +29,17 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0; int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
int32_t min_needed = janet_v_count(v) + increment; int32_t min_needed = janet_v_count(v) + increment;
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed; int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t)*2); int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
if (NULL != p) { if (NULL != p) {
if (!v) p[1] = 0; if (!v) p[1] = 0;
p[0] = m; p[0] = m;
return p + 2; return p + 2;
} else { } else {
{ {
JANET_OUT_OF_MEMORY; JANET_OUT_OF_MEMORY;
} }
return (void *) (2 * sizeof(int32_t)); return (void *)(2 * sizeof(int32_t));
} }
} }
/* Convert a buffer to normal allocated memory (forget capacity) */ /* Convert a buffer to normal allocated memory (forget capacity) */
@ -53,10 +53,10 @@ void *janet_v_flattenmem(void *v, int32_t itemsize) {
memcpy(p, v, sizen); memcpy(p, v, sizen);
return p; return p;
} else { } else {
{ {
JANET_OUT_OF_MEMORY; JANET_OUT_OF_MEMORY;
} }
return NULL; return NULL;
} }
} }

106
src/core/vm.c
View File

@ -229,7 +229,7 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
Janet ds, key; Janet ds, key;
if (argn != 1) janet_panicf("%v called with arity %d, expected 1", callee, argn); if (argn != 1) janet_panicf("%v called with arity %d, expected 1", callee, argn);
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY | if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) { JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
ds = callee; ds = callee;
key = fiber->data[fiber->stackstart]; key = fiber->data[fiber->stackstart];
} else { } else {
@ -263,8 +263,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
* the breakpoint bit set and we were in the debug state, skip * the breakpoint bit set and we were in the debug state, skip
* that first breakpoint. */ * that first breakpoint. */
uint8_t first_opcode = (status == JANET_STATUS_DEBUG) uint8_t first_opcode = (status == JANET_STATUS_DEBUG)
? (*pc & 0x7F) ? (*pc & 0x7F)
: (*pc & 0xFF); : (*pc & 0xFF);
/* Main interpreter loop. Semantically is a switch on /* Main interpreter loop. Semantically is a switch on
* (*pc & 0xFF) inside of an infinite loop. */ * (*pc & 0xFF) inside of an infinite loop. */
@ -283,8 +283,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_assert_types(stack[A], E); vm_assert_types(stack[A], E);
vm_pcnext(); vm_pcnext();
VM_OP(JOP_RETURN) VM_OP(JOP_RETURN) {
{
Janet retval = stack[D]; Janet retval = stack[D];
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE; int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
janet_fiber_popframe(fiber); janet_fiber_popframe(fiber);
@ -294,8 +293,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_checkgc_pcnext(); vm_checkgc_pcnext();
} }
VM_OP(JOP_RETURN_NIL) VM_OP(JOP_RETURN_NIL) {
{
Janet retval = janet_wrap_nil(); Janet retval = janet_wrap_nil();
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE; int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
janet_fiber_popframe(fiber); janet_fiber_popframe(fiber);
@ -321,37 +319,36 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_binop(*); vm_binop(*);
VM_OP(JOP_NUMERIC_LESS_THAN) VM_OP(JOP_NUMERIC_LESS_THAN)
vm_numcomp(<); vm_numcomp( <);
VM_OP(JOP_NUMERIC_LESS_THAN_EQUAL) VM_OP(JOP_NUMERIC_LESS_THAN_EQUAL)
vm_numcomp(<=); vm_numcomp( <=);
VM_OP(JOP_NUMERIC_GREATER_THAN) VM_OP(JOP_NUMERIC_GREATER_THAN)
vm_numcomp(>); vm_numcomp( >);
VM_OP(JOP_NUMERIC_GREATER_THAN_EQUAL) VM_OP(JOP_NUMERIC_GREATER_THAN_EQUAL)
vm_numcomp(>=); vm_numcomp( >=);
VM_OP(JOP_NUMERIC_EQUAL) VM_OP(JOP_NUMERIC_EQUAL)
vm_numcomp(==); vm_numcomp( ==);
VM_OP(JOP_DIVIDE_IMMEDIATE) VM_OP(JOP_DIVIDE_IMMEDIATE)
vm_binop_immediate(/); vm_binop_immediate( /);
VM_OP(JOP_DIVIDE) VM_OP(JOP_DIVIDE)
vm_binop(/); vm_binop( /);
VM_OP(JOP_BAND) VM_OP(JOP_BAND)
vm_bitop(&); vm_bitop(&);
VM_OP(JOP_BOR) VM_OP(JOP_BOR)
vm_bitop(|); vm_bitop( |);
VM_OP(JOP_BXOR) VM_OP(JOP_BXOR)
vm_bitop(^); vm_bitop(^);
VM_OP(JOP_BNOT) VM_OP(JOP_BNOT) {
{
Janet op = stack[E]; Janet op = stack[E];
vm_assert_type(op, JANET_NUMBER); vm_assert_type(op, JANET_NUMBER);
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op)); stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
@ -359,22 +356,22 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
} }
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED) VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
vm_bitopu(>>); vm_bitopu( >>);
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE) VM_OP(JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE)
vm_bitopu_immediate(>>); vm_bitopu_immediate( >>);
VM_OP(JOP_SHIFT_RIGHT) VM_OP(JOP_SHIFT_RIGHT)
vm_bitop(>>); vm_bitop( >>);
VM_OP(JOP_SHIFT_RIGHT_IMMEDIATE) VM_OP(JOP_SHIFT_RIGHT_IMMEDIATE)
vm_bitop_immediate(>>); vm_bitop_immediate( >>);
VM_OP(JOP_SHIFT_LEFT) VM_OP(JOP_SHIFT_LEFT)
vm_bitop(<<); vm_bitop( <<);
VM_OP(JOP_SHIFT_LEFT_IMMEDIATE) VM_OP(JOP_SHIFT_LEFT_IMMEDIATE)
vm_bitop_immediate(<<); vm_bitop_immediate( <<);
VM_OP(JOP_MOVE_NEAR) VM_OP(JOP_MOVE_NEAR)
stack[A] = stack[E]; stack[A] = stack[E];
@ -448,8 +445,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
stack[A] = janet_wrap_integer(ES); stack[A] = janet_wrap_integer(ES);
vm_pcnext(); vm_pcnext();
VM_OP(JOP_LOAD_CONSTANT) VM_OP(JOP_LOAD_CONSTANT) {
{
int32_t cindex = (int32_t)E; int32_t cindex = (int32_t)E;
vm_assert(cindex < func->def->constants_length, "invalid constant"); vm_assert(cindex < func->def->constants_length, "invalid constant");
stack[A] = func->def->constants[cindex]; stack[A] = func->def->constants[cindex];
@ -460,8 +456,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
stack[D] = janet_wrap_function(func); stack[D] = janet_wrap_function(func);
vm_pcnext(); vm_pcnext();
VM_OP(JOP_LOAD_UPVALUE) VM_OP(JOP_LOAD_UPVALUE) {
{
int32_t eindex = B; int32_t eindex = B;
int32_t vindex = C; int32_t vindex = C;
JanetFuncEnv *env; JanetFuncEnv *env;
@ -478,8 +473,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_pcnext(); vm_pcnext();
} }
VM_OP(JOP_SET_UPVALUE) VM_OP(JOP_SET_UPVALUE) {
{
int32_t eindex = B; int32_t eindex = B;
int32_t vindex = C; int32_t vindex = C;
JanetFuncEnv *env; JanetFuncEnv *env;
@ -494,8 +488,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_pcnext(); vm_pcnext();
} }
VM_OP(JOP_CLOSURE) VM_OP(JOP_CLOSURE) {
{
JanetFuncDef *fd; JanetFuncDef *fd;
JanetFunction *fn; JanetFunction *fn;
int32_t elen; int32_t elen;
@ -544,8 +537,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
stack = fiber->data + fiber->frame; stack = fiber->data + fiber->frame;
vm_checkgc_pcnext(); vm_checkgc_pcnext();
VM_OP(JOP_PUSH_ARRAY) VM_OP(JOP_PUSH_ARRAY) {
{
const Janet *vals; const Janet *vals;
int32_t len; int32_t len;
if (janet_indexed_view(stack[D], &vals, &len)) { if (janet_indexed_view(stack[D], &vals, &len)) {
@ -557,8 +549,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
stack = fiber->data + fiber->frame; stack = fiber->data + fiber->frame;
vm_checkgc_pcnext(); vm_checkgc_pcnext();
VM_OP(JOP_CALL) VM_OP(JOP_CALL) {
{
Janet callee = stack[E]; Janet callee = stack[E];
if (fiber->stacktop > fiber->maxstack) { if (fiber->stacktop > fiber->maxstack) {
vm_throw("stack overflow"); vm_throw("stack overflow");
@ -575,7 +566,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
if (janet_fiber_funcframe(fiber, func)) { if (janet_fiber_funcframe(fiber, func)) {
int32_t n = fiber->stacktop - fiber->stackstart; int32_t n = fiber->stacktop - fiber->stackstart;
janet_panicf("%v called with %d argument%s, expected %d", janet_panicf("%v called with %d argument%s, expected %d",
callee, n, n == 1 ? "" : "s", func->def->arity); callee, n, n == 1 ? "" : "s", func->def->arity);
} }
stack = fiber->data + fiber->frame; stack = fiber->data + fiber->frame;
pc = func->def->bytecode; pc = func->def->bytecode;
@ -597,8 +588,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
} }
} }
VM_OP(JOP_TAILCALL) VM_OP(JOP_TAILCALL) {
{
Janet callee = stack[D]; Janet callee = stack[D];
if (janet_checktype(callee, JANET_KEYWORD)) { if (janet_checktype(callee, JANET_KEYWORD)) {
vm_commit(); vm_commit();
@ -612,7 +602,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
janet_stack_frame(fiber->data + fiber->frame)->pc = pc; janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
int32_t n = fiber->stacktop - fiber->stackstart; int32_t n = fiber->stacktop - fiber->stackstart;
janet_panicf("%v called with %d argument%s, expected %d", janet_panicf("%v called with %d argument%s, expected %d",
callee, n, n == 1 ? "" : "s", func->def->arity); callee, n, n == 1 ? "" : "s", func->def->arity);
} }
stack = fiber->data + fiber->frame; stack = fiber->data + fiber->frame;
pc = func->def->bytecode; pc = func->def->bytecode;
@ -638,8 +628,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
} }
} }
VM_OP(JOP_RESUME) VM_OP(JOP_RESUME) {
{
Janet retreg; Janet retreg;
vm_assert_type(stack[B], JANET_FIBER); vm_assert_type(stack[B], JANET_FIBER);
JanetFiber *child = janet_unwrap_fiber(stack[B]); JanetFiber *child = janet_unwrap_fiber(stack[B]);
@ -652,8 +641,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_checkgc_pcnext(); vm_checkgc_pcnext();
} }
VM_OP(JOP_SIGNAL) VM_OP(JOP_SIGNAL) {
{
int32_t s = C; int32_t s = C;
if (s > JANET_SIGNAL_USER9) s = JANET_SIGNAL_USER9; if (s > JANET_SIGNAL_USER9) s = JANET_SIGNAL_USER9;
if (s < 0) s = 0; if (s < 0) s = 0;
@ -685,8 +673,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
stack[A] = janet_wrap_integer(janet_length(stack[E])); stack[A] = janet_wrap_integer(janet_length(stack[E]));
vm_pcnext(); vm_pcnext();
VM_OP(JOP_MAKE_ARRAY) VM_OP(JOP_MAKE_ARRAY) {
{
int32_t count = fiber->stacktop - fiber->stackstart; int32_t count = fiber->stacktop - fiber->stackstart;
Janet *mem = fiber->data + fiber->stackstart; Janet *mem = fiber->data + fiber->stackstart;
stack[D] = janet_wrap_array(janet_array_n(mem, count)); stack[D] = janet_wrap_array(janet_array_n(mem, count));
@ -694,8 +681,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_checkgc_pcnext(); vm_checkgc_pcnext();
} }
VM_OP(JOP_MAKE_TUPLE) VM_OP(JOP_MAKE_TUPLE) {
{
int32_t count = fiber->stacktop - fiber->stackstart; int32_t count = fiber->stacktop - fiber->stackstart;
Janet *mem = fiber->data + fiber->stackstart; Janet *mem = fiber->data + fiber->stackstart;
stack[D] = janet_wrap_tuple(janet_tuple_n(mem, count)); stack[D] = janet_wrap_tuple(janet_tuple_n(mem, count));
@ -703,8 +689,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_checkgc_pcnext(); vm_checkgc_pcnext();
} }
VM_OP(JOP_MAKE_TABLE) VM_OP(JOP_MAKE_TABLE) {
{
int32_t count = fiber->stacktop - fiber->stackstart; int32_t count = fiber->stacktop - fiber->stackstart;
Janet *mem = fiber->data + fiber->stackstart; Janet *mem = fiber->data + fiber->stackstart;
if (count & 1) if (count & 1)
@ -717,8 +702,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_checkgc_pcnext(); vm_checkgc_pcnext();
} }
VM_OP(JOP_MAKE_STRUCT) VM_OP(JOP_MAKE_STRUCT) {
{
int32_t count = fiber->stacktop - fiber->stackstart; int32_t count = fiber->stacktop - fiber->stackstart;
Janet *mem = fiber->data + fiber->stackstart; Janet *mem = fiber->data + fiber->stackstart;
if (count & 1) if (count & 1)
@ -731,8 +715,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_checkgc_pcnext(); vm_checkgc_pcnext();
} }
VM_OP(JOP_MAKE_STRING) VM_OP(JOP_MAKE_STRING) {
{
int32_t count = fiber->stacktop - fiber->stackstart; int32_t count = fiber->stacktop - fiber->stackstart;
Janet *mem = fiber->data + fiber->stackstart; Janet *mem = fiber->data + fiber->stackstart;
JanetBuffer buffer; JanetBuffer buffer;
@ -745,8 +728,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
vm_checkgc_pcnext(); vm_checkgc_pcnext();
} }
VM_OP(JOP_MAKE_BUFFER) VM_OP(JOP_MAKE_BUFFER) {
{
int32_t count = fiber->stacktop - fiber->stackstart; int32_t count = fiber->stacktop - fiber->stackstart;
Janet *mem = fiber->data + fiber->stackstart; Janet *mem = fiber->data + fiber->stackstart;
JanetBuffer *buffer = janet_buffer(10 * count); JanetBuffer *buffer = janet_buffer(10 * count);
@ -784,8 +766,8 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
/* Run vm */ /* Run vm */
JanetSignal signal = run_vm(janet_vm_fiber, JanetSignal signal = run_vm(janet_vm_fiber,
janet_wrap_nil(), janet_wrap_nil(),
JANET_STATUS_ALIVE); JANET_STATUS_ALIVE);
/* Teardown */ /* Teardown */
janet_vm_return_reg = old_return_reg; janet_vm_return_reg = old_return_reg;
@ -865,11 +847,11 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
} }
JanetSignal janet_pcall( JanetSignal janet_pcall(
JanetFunction *fun, JanetFunction *fun,
int32_t argc, int32_t argc,
const Janet *argv, const Janet *argv,
Janet *out, Janet *out,
JanetFiber **f) { JanetFiber **f) {
JanetFiber *fiber = janet_fiber(fun, 64, argc, argv); JanetFiber *fiber = janet_fiber(fun, 64, argc, argv);
if (f) *f = fiber; if (f) *f = fiber;
if (!fiber) { if (!fiber) {

32
src/include/janet.h
View File

@ -277,7 +277,7 @@ typedef struct JanetView JanetView;
typedef struct JanetByteView JanetByteView; typedef struct JanetByteView JanetByteView;
typedef struct JanetDictView JanetDictView; typedef struct JanetDictView JanetDictView;
typedef struct JanetRange JanetRange; typedef struct JanetRange JanetRange;
typedef Janet (*JanetCFunction)(int32_t argc, Janet *argv); typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
/* Basic types for all Janet Values */ /* Basic types for all Janet Values */
typedef enum JanetType { typedef enum JanetType {
@ -724,7 +724,7 @@ enum JanetParserStatus {
/* A janet parser */ /* A janet parser */
struct JanetParser { struct JanetParser {
Janet* args; Janet *args;
const char *error; const char *error;
JanetParseState *states; JanetParseState *states;
uint8_t *buf; uint8_t *buf;
@ -744,7 +744,7 @@ struct JanetAbstractType {
const char *name; const char *name;
int (*gc)(void *data, size_t len); int (*gc)(void *data, size_t len);
int (*gcmark)(void *data, size_t len); int (*gcmark)(void *data, size_t len);
Janet (*get)(void *data, Janet key); Janet(*get)(void *data, Janet key);
void (*put)(void *data, Janet key, Janet value); void (*put)(void *data, Janet key, Janet value);
}; };
@ -955,8 +955,8 @@ JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc); JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
JANET_API void janet_debug_unbreak(JanetFuncDef *def, int32_t pc); JANET_API void janet_debug_unbreak(JanetFuncDef *def, int32_t pc);
JANET_API void janet_debug_find( JANET_API void janet_debug_find(
JanetFuncDef **def_out, int32_t *pc_out, JanetFuncDef **def_out, int32_t *pc_out,
const uint8_t *source, int32_t offset); const uint8_t *source, int32_t offset);
/* Array functions */ /* Array functions */
JANET_API JanetArray *janet_array(int32_t capacity); JANET_API JanetArray *janet_array(int32_t capacity);
@ -1084,18 +1084,18 @@ JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
/* Marshaling */ /* Marshaling */
JANET_API int janet_marshal( JANET_API int janet_marshal(
JanetBuffer *buf, JanetBuffer *buf,
Janet x, Janet x,
Janet *errval, Janet *errval,
JanetTable *rreg, JanetTable *rreg,
int flags); int flags);
JANET_API int janet_unmarshal( JANET_API int janet_unmarshal(
const uint8_t *bytes, const uint8_t *bytes,
size_t len, size_t len,
int flags, int flags,
Janet *out, Janet *out,
JanetTable *reg, JanetTable *reg,
const uint8_t **next); const uint8_t **next);
JANET_API JanetTable *janet_env_lookup(JanetTable *env); JANET_API JanetTable *janet_env_lookup(JanetTable *env);
/* GC */ /* GC */

194
src/mainclient/line.c
View File

@ -144,8 +144,8 @@ static int curpos() {
int cols, rows; int cols, rows;
unsigned int i = 0; unsigned int i = 0;
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1; if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
while (i < sizeof(buf)-1) { while (i < sizeof(buf) - 1) {
if (read(STDIN_FILENO, buf+i, 1) != 1) break; if (read(STDIN_FILENO, buf + i, 1) != 1) break;
if (buf[i] == 'R') break; if (buf[i] == 'R') break;
i++; i++;
} }
@ -166,7 +166,7 @@ static int getcols() {
if (cols == -1) goto failed; if (cols == -1) goto failed;
if (cols > start) { if (cols > start) {
char seq[32]; char seq[32];
snprintf(seq, 32, "\x1b[%dD", cols-start); snprintf(seq, 32, "\x1b[%dD", cols - start);
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {} if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {}
} }
return cols; return cols;
@ -178,7 +178,7 @@ failed:
} }
static void clear() { static void clear() {
if (write(STDOUT_FILENO,"\x1b[H\x1b[2J",7) <= 0) {} if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {}
} }
static void refresh() { static void refresh() {
@ -206,7 +206,7 @@ static void refresh() {
/* Erase to right */ /* Erase to right */
janet_buffer_push_cstring(&b, "\x1b[0K"); janet_buffer_push_cstring(&b, "\x1b[0K");
/* Move cursor to original position. */ /* Move cursor to original position. */
snprintf(seq, 64,"\r\x1b[%dC", (int)(_pos + plen)); snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + plen));
janet_buffer_push_cstring(&b, seq); janet_buffer_push_cstring(&b, seq);
if (write(STDOUT_FILENO, b.data, b.count) == -1) {} if (write(STDOUT_FILENO, b.data, b.count) == -1) {}
janet_buffer_deinit(&b); janet_buffer_deinit(&b);
@ -321,103 +321,103 @@ static int line() {
nread = read(STDIN_FILENO, &c, 1); nread = read(STDIN_FILENO, &c, 1);
if (nread <= 0) return -1; if (nread <= 0) return -1;
switch(c) { switch (c) {
default: default:
if (insert(c)) return -1; if (insert(c)) return -1;
break; break;
case 9: /* tab */ case 9: /* tab */
if (insert(' ')) return -1; if (insert(' ')) return -1;
if (insert(' ')) return -1; if (insert(' ')) return -1;
break; break;
case 13: /* enter */ case 13: /* enter */
return 0; return 0;
case 3: /* ctrl-c */ case 3: /* ctrl-c */
errno = EAGAIN; errno = EAGAIN;
return -1; return -1;
case 127: /* backspace */ case 127: /* backspace */
case 8: /* ctrl-h */ case 8: /* ctrl-h */
kbackspace(); kbackspace();
break; break;
case 4: /* ctrl-d, eof */ case 4: /* ctrl-d, eof */
return -1; return -1;
case 2: /* ctrl-b */ case 2: /* ctrl-b */
kleft(); kleft();
break; break;
case 6: /* ctrl-f */ case 6: /* ctrl-f */
kright(); kright();
break; break;
case 21: case 21:
buf[0] = '\0'; buf[0] = '\0';
pos = len = 0; pos = len = 0;
refresh(); refresh();
break; break;
case 26: /* ctrl-z */ case 26: /* ctrl-z */
norawmode(); norawmode();
kill(getpid(), SIGSTOP); kill(getpid(), SIGSTOP);
rawmode(); rawmode();
refresh(); refresh();
break; break;
case 12: case 12:
clear(); clear();
refresh(); refresh();
break; break;
case 27: /* escape sequence */ case 27: /* escape sequence */
/* Read the next two bytes representing the escape sequence. /* Read the next two bytes representing the escape sequence.
* Use two calls to handle slow terminals returning the two * Use two calls to handle slow terminals returning the two
* chars at different times. */ * chars at different times. */
if (read(STDIN_FILENO, seq, 1) == -1) break; if (read(STDIN_FILENO, seq, 1) == -1) break;
if (read(STDIN_FILENO, seq + 1, 1) == -1) break; if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
if (seq[0] == '[') { if (seq[0] == '[') {
if (seq[1] >= '0' && seq[1] <= '9') { if (seq[1] >= '0' && seq[1] <= '9') {
/* Extended escape, read additional byte. */ /* Extended escape, read additional byte. */
if (read(STDIN_FILENO, seq + 2, 1) == -1) break; if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
if (seq[2] == '~') { if (seq[2] == '~') {
switch(seq[1]) { switch (seq[1]) {
default: default:
break; break;
}
}
} else {
switch (seq[1]) {
default:
break;
case 'A':
historymove(1);
break;
case 'B':
historymove(-1);
break;
case 'C': /* Right */
kright();
break;
case 'D': /* Left */
kleft();
break;
case 'H':
pos = 0;
refresh();
break;
case 'F':
pos = len;
refresh();
break;
} }
} }
} else { } else if (seq[0] == 'O') {
switch (seq[1]) { switch (seq[1]) {
default: default:
break; break;
case 'A': case 'H':
historymove(1); pos = 0;
break; refresh();
case 'B': break;
historymove(-1); case 'F':
break; pos = len;
case 'C': /* Right */ refresh();
kright(); break;
break;
case 'D': /* Left */
kleft();
break;
case 'H':
pos = 0;
refresh();
break;
case 'F':
pos = len;
refresh();
break;
} }
} }
} else if (seq[0] == 'O') { break;
switch (seq[1]) {
default:
break;
case 'H':
pos = 0;
refresh();
break;
case 'F':
pos = len;
refresh();
break;
}
}
break;
} }
} }
return 0; return 0;

34
tools/symcharsgen.c
View File

@ -29,23 +29,23 @@ static int is_symbol_char_gen(uint8_t c) {
if (c >= 'A' && c <= 'Z') return 1; if (c >= 'A' && c <= 'Z') return 1;
if (c >= '0' && c <= '9') return 1; if (c >= '0' && c <= '9') return 1;
return (c == '!' || return (c == '!' ||
c == '$' || c == '$' ||
c == '%' || c == '%' ||
c == '&' || c == '&' ||
c == '*' || c == '*' ||
c == '+' || c == '+' ||
c == '-' || c == '-' ||
c == '.' || c == '.' ||
c == '/' || c == '/' ||
c == ':' || c == ':' ||
c == '<' || c == '<' ||
c == '?' || c == '?' ||
c == '=' || c == '=' ||
c == '>' || c == '>' ||
c == '@' || c == '@' ||
c == '^' || c == '^' ||
c == '_' || c == '_' ||
c == '|'); c == '|');
} }
int main() { int main() {

4
tools/xxd.c
View File

@ -86,9 +86,9 @@ int main(int argc, const char **argv) {
lineIndex = 0; lineIndex = 0;
} }
} }
/* Write the tail */ /* Write the tail */
fputs("\n};\n\n", out); fputs("\n};\n\n", out);
fprintf(out, "const unsigned char *%s = bytes_%s;\n\n", argv[3], argv[3]); fprintf(out, "const unsigned char *%s = bytes_%s;\n\n", argv[3], argv[3]);