mirror of
https://github.com/janet-lang/janet
synced 2024-11-29 03:19:54 +00:00
Merge remote-tracking branch 'upstream/master' into ta-with-marshal
This commit is contained in:
J.-F. Cap
commit
e5a4c6fc2b
@ -2,6 +2,8 @@
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 0.4.0 - ??
|
||||
- Remove `tuple/append` and `tuple/prepend`, which may have seened like `O(1)`
|
||||
operations. Instead, use the `splice` special to extend tuples.
|
||||
- Add `-m` flag to main client to allow specifying where to load
|
||||
system modules from.
|
||||
- Add `-c` flag to main client to allow compiling Janet modules to images.
|
||||
|
||||
@ -44,7 +44,6 @@ For changes to the VM and Core code, you will probably need to know C. Janet is
|
||||
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
|
||||
omissions.
|
||||
|
||||
* No Variable Length Arrays (yes these may work in newer MSVC compilers)
|
||||
* No `restrict`
|
||||
* Certain functions in the standard library are not always available
|
||||
|
||||
|
||||
7
Makefile
7
Makefile
@ -65,7 +65,8 @@ all: $(JANET_TARGET) $(JANET_LIBRARY)
|
||||
##### The bootstrap interpreter that compiles the core image #####
|
||||
##################################################################
|
||||
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) src/boot/boot.c) \
|
||||
JANET_BOOT_SOURCES=$(sort $(wildcard src/boot/*.c))
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
|
||||
build/core.gen.o \
|
||||
build/boot.gen.o
|
||||
|
||||
@ -77,7 +78,7 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/core_image.c: build/janet_boot
|
||||
JANET_PATH=$(JANET_PATH) JANET_INCLUDEDIR=$(INCLUDEDIR) build/janet_boot
|
||||
JANET_PATH=$(JANET_PATH) build/janet_boot
|
||||
|
||||
##########################################################
|
||||
##### The main interpreter program and shared object #####
|
||||
@ -229,9 +230,9 @@ install: $(JANET_TARGET)
|
||||
mkdir -p $(INCLUDEDIR)
|
||||
cp $(JANET_HEADERS) $(INCLUDEDIR)
|
||||
mkdir -p $(INCLUDEDIR)/janet
|
||||
mkdir -p $(JANET_PATH)
|
||||
ln -sf $(INCLUDEDIR)/janet.h $(INCLUDEDIR)/janet/janet.h
|
||||
ln -sf $(INCLUDEDIR)/janet.h $(JANET_PATH)/janet.h
|
||||
mkdir -p $(JANET_PATH)
|
||||
cp tools/cook.janet $(JANET_PATH)
|
||||
cp tools/highlight.janet $(JANET_PATH)
|
||||
cp tools/bars.janet $(JANET_PATH)
|
||||
|
||||
@ -23,13 +23,13 @@
|
||||
#include <janet.h>
|
||||
#include <assert.h>
|
||||
|
||||
int main() {
|
||||
#include "tests.h"
|
||||
|
||||
int array_test() {
|
||||
|
||||
int i;
|
||||
JanetArray *array1, *array2;
|
||||
|
||||
janet_init();
|
||||
|
||||
array1 = janet_array(10);
|
||||
array2 = janet_array(0);
|
||||
|
||||
@ -62,7 +62,5 @@ int main() {
|
||||
|
||||
assert(array1->count == 5);
|
||||
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
@ -21,16 +21,28 @@
|
||||
*/
|
||||
|
||||
#include <janet.h>
|
||||
#include "tests.h"
|
||||
|
||||
extern const unsigned char *janet_gen_boot;
|
||||
extern int32_t janet_gen_boot_size;
|
||||
|
||||
int main() {
|
||||
int status;
|
||||
JanetTable *env;
|
||||
|
||||
/* Init janet */
|
||||
janet_init();
|
||||
|
||||
/* Run tests */
|
||||
array_test();
|
||||
buffer_test();
|
||||
number_test();
|
||||
system_test();
|
||||
table_test();
|
||||
|
||||
/* C tests passed */
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
int status;
|
||||
JanetTable *env;
|
||||
env = janet_core_env();
|
||||
|
||||
/* Run bootstrap script to generate core image */
|
||||
|
||||
@ -23,13 +23,13 @@
|
||||
#include <janet.h>
|
||||
#include <assert.h>
|
||||
|
||||
int main() {
|
||||
#include "tests.h"
|
||||
|
||||
int buffer_test() {
|
||||
|
||||
int i;
|
||||
JanetBuffer *buffer1, *buffer2;
|
||||
|
||||
janet_init();
|
||||
|
||||
buffer1 = janet_buffer(100);
|
||||
buffer2 = janet_buffer(0);
|
||||
|
||||
@ -58,7 +58,5 @@ int main() {
|
||||
assert(buffer1->data[i] == buffer2->data[i]);
|
||||
}
|
||||
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
@ -25,6 +25,8 @@
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include "tests.h"
|
||||
|
||||
/* Check a subset of numbers against system implementation.
|
||||
* Note that this depends on the system implementation being correct,
|
||||
* which may not be the case for old or non compliant systems. Also,
|
||||
@ -36,14 +38,12 @@ static void test_valid_str(const char *str) {
|
||||
double cnum, jnum;
|
||||
jnum = 0.0;
|
||||
cnum = atof(str);
|
||||
err = janet_scan_number((const uint8_t *) str, strlen(str), &jnum);
|
||||
err = janet_scan_number((const uint8_t *) str, (int32_t) strlen(str), &jnum);
|
||||
assert(!err);
|
||||
assert(cnum == jnum);
|
||||
}
|
||||
|
||||
int main() {
|
||||
|
||||
janet_init();
|
||||
int number_test() {
|
||||
|
||||
test_valid_str("1.0");
|
||||
test_valid_str("1");
|
||||
@ -63,7 +63,5 @@ int main() {
|
||||
test_valid_str("0000000011111111111111111111111111");
|
||||
test_valid_str(".112312333333323123123123123123123");
|
||||
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
@ -24,7 +24,9 @@
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
|
||||
int main() {
|
||||
#include "tests.h"
|
||||
|
||||
int system_test() {
|
||||
|
||||
#ifdef JANET_32
|
||||
assert(sizeof(void *) == 4);
|
||||
@ -32,8 +34,6 @@ int main() {
|
||||
assert(sizeof(void *) == 8);
|
||||
#endif
|
||||
|
||||
janet_init();
|
||||
|
||||
/* Reflexive testing and nanbox testing */
|
||||
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
|
||||
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
|
||||
@ -48,7 +48,5 @@ int main() {
|
||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
@ -23,12 +23,12 @@
|
||||
#include <janet.h>
|
||||
#include <assert.h>
|
||||
|
||||
int main() {
|
||||
#include "tests.h"
|
||||
|
||||
int table_test() {
|
||||
|
||||
JanetTable *t1, *t2;
|
||||
|
||||
janet_init();
|
||||
|
||||
t1 = janet_table(10);
|
||||
t2 = janet_table(0);
|
||||
|
||||
@ -61,7 +61,5 @@ int main() {
|
||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
11
src/boot/tests.h
Normal file
11
src/boot/tests.h
Normal file
@ -0,0 +1,11 @@
|
||||
#ifndef TESTS_H_DNMBUYYL
|
||||
#define TESTS_H_DNMBUYYL
|
||||
|
||||
/* Tests */
|
||||
extern int array_test();
|
||||
extern int buffer_test();
|
||||
extern int number_test();
|
||||
extern int system_test();
|
||||
extern int table_test();
|
||||
|
||||
#endif /* end of include guard: TESTS_H_DNMBUYYL */
|
||||
@ -27,10 +27,9 @@
|
||||
|
||||
/* Create new userdata */
|
||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||
char *data = janet_gcalloc(JANET_MEMORY_ABSTRACT, sizeof(JanetAbstractHeader) + size);
|
||||
JanetAbstractHeader *header = (JanetAbstractHeader *)data;
|
||||
void *a = data + sizeof(JanetAbstractHeader);
|
||||
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_ABSTRACT,
|
||||
sizeof(JanetAbstractHead) + size);
|
||||
header->size = size;
|
||||
header->type = atype;
|
||||
return a;
|
||||
return (void *) & (header->data);
|
||||
}
|
||||
|
||||
@ -104,9 +104,6 @@
|
||||
(defn indexed? "Check if x is an array or tuple." [x]
|
||||
(def t (type x))
|
||||
(if (= t :array) true (= t :tuple)))
|
||||
(defn callable? "Check if x is a function or cfunction." [x]
|
||||
(def t (type x))
|
||||
(if (= t :function) true (= t :cfunction)))
|
||||
(defn true? "Check if x is true." [x] (= x true))
|
||||
(defn false? "Check if x is false." [x] (= x false))
|
||||
(defn nil? "Check if x is nil." [x] (= x nil))
|
||||
@ -311,7 +308,7 @@
|
||||
[i preds &]
|
||||
(default preds @['and])
|
||||
(if (>= i len)
|
||||
(tuple/prepend body 'do)
|
||||
['do ;body]
|
||||
(do
|
||||
(def {i bindings
|
||||
(+ i 1) verb
|
||||
|
||||
@ -54,7 +54,7 @@ void janet_debug_find(
|
||||
JanetFuncDef **def_out, int32_t *pc_out,
|
||||
const uint8_t *source, int32_t offset) {
|
||||
/* Scan the heap for right func def */
|
||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
||||
JanetGCObject *current = janet_vm_blocks;
|
||||
/* Keep track of the best source mapping we have seen so far */
|
||||
int32_t besti = -1;
|
||||
int32_t best_range = INT32_MAX;
|
||||
|
||||
@ -99,7 +99,7 @@ void janet_mark(Janet x) {
|
||||
}
|
||||
|
||||
static void janet_mark_string(const uint8_t *str) {
|
||||
janet_gc_mark(janet_string_raw(str));
|
||||
janet_gc_mark(janet_string_head(str));
|
||||
}
|
||||
|
||||
static void janet_mark_buffer(JanetBuffer *buffer) {
|
||||
@ -154,16 +154,16 @@ recur: /* Manual tail recursion */
|
||||
}
|
||||
|
||||
static void janet_mark_struct(const JanetKV *st) {
|
||||
if (janet_gc_reachable(janet_struct_raw(st)))
|
||||
if (janet_gc_reachable(janet_struct_head(st)))
|
||||
return;
|
||||
janet_gc_mark(janet_struct_raw(st));
|
||||
janet_gc_mark(janet_struct_head(st));
|
||||
janet_mark_kvs(st, janet_struct_capacity(st));
|
||||
}
|
||||
|
||||
static void janet_mark_tuple(const Janet *tuple) {
|
||||
if (janet_gc_reachable(janet_tuple_raw(tuple)))
|
||||
if (janet_gc_reachable(janet_tuple_head(tuple)))
|
||||
return;
|
||||
janet_gc_mark(janet_tuple_raw(tuple));
|
||||
janet_gc_mark(janet_tuple_head(tuple));
|
||||
janet_mark_many(tuple, janet_tuple_length(tuple));
|
||||
}
|
||||
|
||||
@ -244,15 +244,13 @@ recur:
|
||||
}
|
||||
|
||||
/* Deinitialize a block of memory */
|
||||
static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
||||
void *mem = ((char *)(block + 1));
|
||||
JanetAbstractHeader *h = (JanetAbstractHeader *)mem;
|
||||
switch (block->flags & JANET_MEM_TYPEBITS) {
|
||||
static void janet_deinit_block(JanetGCObject *mem) {
|
||||
switch (mem->flags & JANET_MEM_TYPEBITS) {
|
||||
default:
|
||||
case JANET_MEMORY_FUNCTION:
|
||||
break; /* Do nothing for non gc types */
|
||||
case JANET_MEMORY_SYMBOL:
|
||||
janet_symbol_deinit((const uint8_t *)mem + 2 * sizeof(int32_t));
|
||||
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_ARRAY:
|
||||
janet_array_deinit((JanetArray *) mem);
|
||||
@ -266,11 +264,13 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
||||
case JANET_MEMORY_BUFFER:
|
||||
janet_buffer_deinit((JanetBuffer *) mem);
|
||||
break;
|
||||
case JANET_MEMORY_ABSTRACT:
|
||||
if (h->type->gc) {
|
||||
janet_assert(!h->type->gc((void *)(h + 1), h->size), "finalizer failed");
|
||||
case JANET_MEMORY_ABSTRACT: {
|
||||
JanetAbstractHead *head = (JanetAbstractHead *)mem;
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case JANET_MEMORY_FUNCENV: {
|
||||
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
||||
if (0 == env->offset)
|
||||
@ -293,9 +293,9 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
||||
/* Iterate over all allocated memory, and free memory that is not
|
||||
* marked as reachable. Flip the gc color flag for next sweep. */
|
||||
void janet_sweep() {
|
||||
JanetGCMemoryHeader *previous = NULL;
|
||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
||||
JanetGCMemoryHeader *next;
|
||||
JanetGCObject *previous = NULL;
|
||||
JanetGCObject *current = janet_vm_blocks;
|
||||
JanetGCObject *next;
|
||||
while (NULL != current) {
|
||||
next = current->next;
|
||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||
@ -316,29 +316,26 @@ void janet_sweep() {
|
||||
|
||||
/* Allocate some memory that is tracked for garbage collection */
|
||||
void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
JanetGCMemoryHeader *mdata;
|
||||
size_t total = size + sizeof(JanetGCMemoryHeader);
|
||||
JanetGCObject *mem;
|
||||
|
||||
/* Make sure everything is inited */
|
||||
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
||||
void *mem = malloc(total);
|
||||
mem = malloc(size);
|
||||
|
||||
/* Check for bad malloc */
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
mdata = (JanetGCMemoryHeader *)mem;
|
||||
|
||||
/* Configure block */
|
||||
mdata->flags = type;
|
||||
mem->flags = type;
|
||||
|
||||
/* Prepend block to heap list */
|
||||
janet_vm_next_collection += (int32_t) size;
|
||||
mdata->next = janet_vm_blocks;
|
||||
janet_vm_blocks = mdata;
|
||||
mem->next = janet_vm_blocks;
|
||||
janet_vm_blocks = mem;
|
||||
|
||||
return (char *) mem + sizeof(JanetGCMemoryHeader);
|
||||
return (void *)mem;
|
||||
}
|
||||
|
||||
/* Run garbage collection */
|
||||
@ -423,10 +420,10 @@ int janet_gcunrootall(Janet root) {
|
||||
|
||||
/* Free all allocated memory */
|
||||
void janet_clear_memory(void) {
|
||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
||||
JanetGCObject *current = janet_vm_blocks;
|
||||
while (NULL != current) {
|
||||
janet_deinit_block(current);
|
||||
JanetGCMemoryHeader *next = current->next;
|
||||
JanetGCObject *next = current->next;
|
||||
free(current);
|
||||
current = next;
|
||||
}
|
||||
|
||||
@ -28,7 +28,7 @@
|
||||
#endif
|
||||
|
||||
/* The metadata header associated with an allocated block of memory */
|
||||
#define janet_gc_header(mem) ((JanetGCMemoryHeader *)(mem) - 1)
|
||||
#define janet_gc_header(mem) ((JanetGCObject *)(mem))
|
||||
|
||||
#define JANET_MEM_TYPEBITS 0xFF
|
||||
#define JANET_MEM_REACHABLE 0x100
|
||||
@ -40,13 +40,6 @@
|
||||
#define janet_gc_mark(m) (janet_gc_header(m)->flags |= JANET_MEM_REACHABLE)
|
||||
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
|
||||
|
||||
/* Memory header struct. Node of a linked list of memory blocks. */
|
||||
typedef struct JanetGCMemoryHeader JanetGCMemoryHeader;
|
||||
struct JanetGCMemoryHeader {
|
||||
JanetGCMemoryHeader *next;
|
||||
uint32_t flags;
|
||||
};
|
||||
|
||||
/* Memory types for the GC. Different from JanetType to include funcenv and funcdef. */
|
||||
enum JanetMemoryType {
|
||||
JANET_MEMORY_NONE,
|
||||
|
||||
@ -446,7 +446,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
int32_t i, count, flag;
|
||||
const Janet *tup = janet_unwrap_tuple(x);
|
||||
count = janet_tuple_length(tup);
|
||||
flag = janet_tuple_flag(tup);
|
||||
flag = janet_tuple_flag(tup) >> 16;
|
||||
pushbyte(st, LB_TUPLE);
|
||||
pushint(st, count);
|
||||
pushint(st, flag);
|
||||
@ -847,6 +847,9 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
janet_array_push(&st->lookup, janet_wrap_fiber(fiber));
|
||||
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
||||
int32_t frame = 0;
|
||||
int32_t stack = 0;
|
||||
@ -1087,7 +1090,7 @@ static const uint8_t *unmarshal_one(
|
||||
/* Tuple */
|
||||
Janet *tup = janet_tuple_begin(len);
|
||||
int32_t flag = readint(st, &data);
|
||||
janet_tuple_flag(tup) = flag;
|
||||
janet_tuple_flag(tup) |= flag << 16;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
data = unmarshal_one(st, data, tup + i, flags + 1);
|
||||
}
|
||||
|
||||
@ -348,7 +348,7 @@ static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
|
||||
static Janet close_tuple(JanetParser *p, JanetParseState *state, int32_t flag) {
|
||||
Janet *ret = janet_tuple_begin(state->argn);
|
||||
janet_tuple_flag(ret) = flag;
|
||||
janet_tuple_flag(ret) |= flag;
|
||||
for (int32_t i = state->argn - 1; i >= 0; i--)
|
||||
ret[i] = p->args[--p->argcount];
|
||||
return janet_wrap_tuple(janet_tuple_end(ret));
|
||||
|
||||
@ -629,11 +629,11 @@ void janet_buffer_format(
|
||||
}
|
||||
case 's': {
|
||||
const uint8_t *s = janet_getstring(argv, arg);
|
||||
size_t l = janet_string_length(s);
|
||||
int32_t l = janet_string_length(s);
|
||||
if (form[2] == '\0')
|
||||
janet_buffer_push_bytes(b, s, l);
|
||||
else {
|
||||
if (l != strlen((const char *) s))
|
||||
if (l != (int32_t) strlen((const char *) s))
|
||||
janet_panic("string contains zeros");
|
||||
if (!strchr(form, '.') && l >= 100) {
|
||||
janet_panic
|
||||
|
||||
@ -31,11 +31,11 @@
|
||||
|
||||
/* Begin building a string */
|
||||
uint8_t *janet_string_begin(int32_t length) {
|
||||
char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + length + 1);
|
||||
uint8_t *str = (uint8_t *)(data + 2 * sizeof(int32_t));
|
||||
janet_string_length(str) = length;
|
||||
str[length] = 0;
|
||||
return str;
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + length + 1);
|
||||
head->length = length;
|
||||
uint8_t *data = (uint8_t *)head->data;
|
||||
data[length] = 0;
|
||||
return data;
|
||||
}
|
||||
|
||||
/* Finish building a string */
|
||||
@ -46,14 +46,13 @@ const uint8_t *janet_string_end(uint8_t *str) {
|
||||
|
||||
/* Load a buffer as a string */
|
||||
const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
|
||||
int32_t hash = janet_string_calchash(buf, len);
|
||||
char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + len + 1);
|
||||
uint8_t *str = (uint8_t *)(data + 2 * sizeof(int32_t));
|
||||
memcpy(str, buf, len);
|
||||
str[len] = 0;
|
||||
janet_string_length(str) = len;
|
||||
janet_string_hash(str) = hash;
|
||||
return str;
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + len + 1);
|
||||
head->length = len;
|
||||
head->hash = janet_string_calchash(buf, len);
|
||||
uint8_t *data = (uint8_t *)head->data;
|
||||
memcpy(data, buf, len);
|
||||
data[len] = 0;
|
||||
return data;
|
||||
}
|
||||
|
||||
/* Compare two strings */
|
||||
|
||||
@ -29,18 +29,18 @@
|
||||
|
||||
/* Begin creation of a struct */
|
||||
JanetKV *janet_struct_begin(int32_t count) {
|
||||
|
||||
/* Calculate capacity as power of 2 after 2 * count. */
|
||||
int32_t capacity = janet_tablen(2 * count);
|
||||
if (capacity < 0) capacity = janet_tablen(count + 1);
|
||||
|
||||
size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(JanetKV));
|
||||
char *data = janet_gcalloc(JANET_MEMORY_STRUCT, s);
|
||||
JanetKV *st = (JanetKV *)(data + 4 * sizeof(int32_t));
|
||||
size_t size = sizeof(JanetStructHead) + capacity * sizeof(JanetKV);
|
||||
JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
|
||||
head->length = count;
|
||||
head->capacity = capacity;
|
||||
head->hash = 0;
|
||||
|
||||
JanetKV *st = (JanetKV *)(head->data);
|
||||
janet_memempty(st, capacity);
|
||||
janet_struct_length(st) = count;
|
||||
janet_struct_capacity(st) = capacity;
|
||||
janet_struct_hash(st) = 0;
|
||||
return st;
|
||||
}
|
||||
|
||||
|
||||
@ -25,6 +25,8 @@
|
||||
* checks, all symbols are interned so that there is a single copy of it in the
|
||||
* whole program. Equality is then just a pointer check. */
|
||||
|
||||
#include <string.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
@ -176,10 +178,10 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
||||
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
|
||||
if (success)
|
||||
return *bucket;
|
||||
newstr = (uint8_t *) janet_gcalloc(JANET_MEMORY_SYMBOL, 2 * sizeof(int32_t) + len + 1)
|
||||
+ (2 * sizeof(int32_t));
|
||||
janet_string_hash(newstr) = hash;
|
||||
janet_string_length(newstr) = len;
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1);
|
||||
head->hash = hash;
|
||||
head->length = len;
|
||||
newstr = (uint8_t *)(head->data);
|
||||
memcpy(newstr, str, len);
|
||||
newstr[len] = 0;
|
||||
janet_symcache_put((const uint8_t *)newstr, bucket);
|
||||
@ -188,9 +190,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
||||
|
||||
/* Get a symbol from a cstring */
|
||||
const uint8_t *janet_csymbol(const char *cstr) {
|
||||
int32_t len = 0;
|
||||
while (cstr[len]) len++;
|
||||
return janet_symbol((const uint8_t *)cstr, len);
|
||||
return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
|
||||
}
|
||||
|
||||
/* Store counter for genysm to avoid quadratic behavior */
|
||||
@ -234,13 +234,11 @@ const uint8_t *janet_symbol_gen(void) {
|
||||
hash,
|
||||
&status);
|
||||
} while (status && (inc_gensym(), 1));
|
||||
sym = (uint8_t *) janet_gcalloc(
|
||||
JANET_MEMORY_SYMBOL,
|
||||
2 * sizeof(int32_t) + sizeof(gensym_counter)) +
|
||||
(2 * sizeof(int32_t));
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(gensym_counter));
|
||||
head->length = sizeof(gensym_counter) - 1;
|
||||
head->hash = hash;
|
||||
sym = (uint8_t *)(head->data);
|
||||
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
||||
janet_string_length(sym) = sizeof(gensym_counter) - 1;
|
||||
janet_string_hash(sym) = hash;
|
||||
janet_symcache_put((const uint8_t *)sym, bucket);
|
||||
return (const uint8_t *)sym;
|
||||
}
|
||||
|
||||
@ -31,13 +31,12 @@
|
||||
* which should be filled with Janets. The memory will not be collected until
|
||||
* janet_tuple_end is called. */
|
||||
Janet *janet_tuple_begin(int32_t length) {
|
||||
char *data = janet_gcalloc(JANET_MEMORY_TUPLE, 5 * sizeof(int32_t) + length * sizeof(Janet));
|
||||
Janet *tuple = (Janet *)(data + (5 * sizeof(int32_t)));
|
||||
janet_tuple_length(tuple) = length;
|
||||
janet_tuple_sm_start(tuple) = -1;
|
||||
janet_tuple_sm_end(tuple) = -1;
|
||||
janet_tuple_flag(tuple) = 0;
|
||||
return tuple;
|
||||
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
|
||||
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
|
||||
head->sm_start = -1;
|
||||
head->sm_end = -1;
|
||||
head->length = length;
|
||||
return (Janet *)(head->data);
|
||||
}
|
||||
|
||||
/* Finish building a tuple */
|
||||
@ -106,26 +105,6 @@ static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_prepend(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
Janet *n = janet_tuple_begin(view.len - 1 + argc);
|
||||
memcpy(n - 1 + argc, view.items, sizeof(Janet) * view.len);
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
n[argc - i - 1] = argv[i];
|
||||
}
|
||||
return janet_wrap_tuple(janet_tuple_end(n));
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_append(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
Janet *n = janet_tuple_begin(view.len - 1 + argc);
|
||||
memcpy(n, view.items, sizeof(Janet) * view.len);
|
||||
memcpy(n + view.len, argv + 1, sizeof(Janet) * (argc - 1));
|
||||
return janet_wrap_tuple(janet_tuple_end(n));
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
@ -150,19 +129,6 @@ static const JanetReg tuple_cfuns[] = {
|
||||
"they default to 0 and the length of arrtup respectively."
|
||||
"Returns the new tuple.")
|
||||
},
|
||||
{
|
||||
"tuple/append", cfun_tuple_append,
|
||||
JDOC("(tuple/append tup & items)\n\n"
|
||||
"Returns a new tuple that is the result of appending "
|
||||
"each element in items to tup.")
|
||||
},
|
||||
{
|
||||
"tuple/prepend", cfun_tuple_prepend,
|
||||
JDOC("(tuple/prepend tup & items)\n\n"
|
||||
"Prepends each element in items to tuple and "
|
||||
"returns a new tuple. Items are prepended such that the "
|
||||
"last element in items is the first element in the new tuple.")
|
||||
},
|
||||
{
|
||||
"tuple/type", cfun_tuple_type,
|
||||
JDOC("(tuple/type tup)\n\n"
|
||||
|
||||
@ -210,6 +210,7 @@ extern "C" {
|
||||
#include <stdlib.h>
|
||||
#include <stdarg.h>
|
||||
#include <setjmp.h>
|
||||
#include <stddef.h>
|
||||
|
||||
/* Names of all of the types */
|
||||
extern const char *const janet_type_names[16];
|
||||
@ -262,15 +263,23 @@ typedef union Janet Janet;
|
||||
typedef struct Janet Janet;
|
||||
#endif
|
||||
|
||||
/* All of the janet types */
|
||||
/* Use type punning for GC objects */
|
||||
typedef struct JanetGCObject JanetGCObject;
|
||||
|
||||
/* All of the primary Janet GCed types */
|
||||
typedef struct JanetFunction JanetFunction;
|
||||
typedef struct JanetArray JanetArray;
|
||||
typedef struct JanetBuffer JanetBuffer;
|
||||
typedef struct JanetTable JanetTable;
|
||||
typedef struct JanetFiber JanetFiber;
|
||||
|
||||
/* Prefixed Janet types */
|
||||
typedef struct JanetTupleHead JanetTupleHead;
|
||||
typedef struct JanetStructHead JanetStructHead;
|
||||
typedef struct JanetStringHead JanetStringHead;
|
||||
typedef struct JanetAbstractHead JanetAbstractHead;
|
||||
|
||||
/* Other structs */
|
||||
typedef struct JanetAbstractHeader JanetAbstractHeader;
|
||||
typedef struct JanetFuncDef JanetFuncDef;
|
||||
typedef struct JanetFuncEnv JanetFuncEnv;
|
||||
typedef struct JanetKV JanetKV;
|
||||
@ -582,6 +591,14 @@ JANET_API int janet_checkint64(Janet x);
|
||||
|
||||
#define janet_checktypes(x, tps) ((1 << janet_type(x)) & (tps))
|
||||
|
||||
/* GC Object type pun. The lower 16 bits of flags are reserved for the garbage collector,
|
||||
* but the upper 16 can be used per type for custom flags. The current collector is a linked
|
||||
* list of blocks, which is naive but works. */
|
||||
struct JanetGCObject {
|
||||
int32_t flags;
|
||||
JanetGCObject *next;
|
||||
};
|
||||
|
||||
/* Fiber signal masks. */
|
||||
#define JANET_FIBER_MASK_ERROR 2
|
||||
#define JANET_FIBER_MASK_DEBUG 4
|
||||
@ -607,14 +624,15 @@ JANET_API int janet_checkint64(Janet x);
|
||||
/* A lightweight green thread in janet. Does not correspond to
|
||||
* operating system threads. */
|
||||
struct JanetFiber {
|
||||
Janet *data;
|
||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||
JanetGCObject gc; /* GC Object stuff */
|
||||
int32_t flags; /* More flags */
|
||||
int32_t frame; /* Index of the stack frame */
|
||||
int32_t stackstart; /* Beginning of next args */
|
||||
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
||||
int32_t capacity;
|
||||
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
||||
int32_t flags; /* Various flags */
|
||||
Janet *data;
|
||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||
};
|
||||
|
||||
/* Mark if a stack frame is a tail call for debugging */
|
||||
@ -637,25 +655,28 @@ struct JanetStackFrame {
|
||||
|
||||
/* A dynamic array type. */
|
||||
struct JanetArray {
|
||||
Janet *data;
|
||||
JanetGCObject gc;
|
||||
int32_t count;
|
||||
int32_t capacity;
|
||||
Janet *data;
|
||||
};
|
||||
|
||||
/* A byte buffer type. Used as a mutable string or string builder. */
|
||||
struct JanetBuffer {
|
||||
uint8_t *data;
|
||||
JanetGCObject gc;
|
||||
int32_t count;
|
||||
int32_t capacity;
|
||||
uint8_t *data;
|
||||
};
|
||||
|
||||
/* A mutable associative data type. Backed by a hashtable. */
|
||||
struct JanetTable {
|
||||
JanetKV *data;
|
||||
JanetTable *proto;
|
||||
JanetGCObject gc;
|
||||
int32_t count;
|
||||
int32_t capacity;
|
||||
int32_t deleted;
|
||||
JanetKV *data;
|
||||
JanetTable *proto;
|
||||
};
|
||||
|
||||
/* A key value pair in a struct or table */
|
||||
@ -664,6 +685,41 @@ struct JanetKV {
|
||||
Janet value;
|
||||
};
|
||||
|
||||
/* Prefix for a tuple */
|
||||
struct JanetTupleHead {
|
||||
JanetGCObject gc;
|
||||
int32_t length;
|
||||
int32_t hash;
|
||||
int32_t sm_start;
|
||||
int32_t sm_end;
|
||||
const Janet data[];
|
||||
};
|
||||
|
||||
/* Prefix for a struct */
|
||||
struct JanetStructHead {
|
||||
JanetGCObject gc;
|
||||
int32_t length;
|
||||
int32_t hash;
|
||||
int32_t capacity;
|
||||
const JanetKV data[];
|
||||
};
|
||||
|
||||
/* Prefix for a string */
|
||||
struct JanetStringHead {
|
||||
JanetGCObject gc;
|
||||
int32_t length;
|
||||
int32_t hash;
|
||||
const uint8_t data[];
|
||||
};
|
||||
|
||||
/* Prefix for an abstract value */
|
||||
struct JanetAbstractHead {
|
||||
JanetGCObject gc;
|
||||
const JanetAbstractType *type;
|
||||
size_t size;
|
||||
char data[];
|
||||
};
|
||||
|
||||
/* Some function definition flags */
|
||||
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
||||
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
||||
@ -683,6 +739,7 @@ struct JanetSourceMapping {
|
||||
|
||||
/* A function definition. Contains information needed to instantiate closures. */
|
||||
struct JanetFuncDef {
|
||||
JanetGCObject gc;
|
||||
int32_t *environments; /* Which environments to capture from parent. */
|
||||
Janet *constants;
|
||||
JanetFuncDef **defs;
|
||||
@ -704,6 +761,7 @@ struct JanetFuncDef {
|
||||
|
||||
/* A function environment */
|
||||
struct JanetFuncEnv {
|
||||
JanetGCObject gc;
|
||||
union {
|
||||
JanetFiber *fiber;
|
||||
Janet *values;
|
||||
@ -715,6 +773,7 @@ struct JanetFuncEnv {
|
||||
|
||||
/* A function */
|
||||
struct JanetFunction {
|
||||
JanetGCObject gc;
|
||||
JanetFuncDef *def;
|
||||
JanetFuncEnv *envs[];
|
||||
};
|
||||
@ -754,12 +813,6 @@ struct JanetAbstractType {
|
||||
void (*put)(void *data, Janet key, Janet value);
|
||||
};
|
||||
|
||||
/* Contains information about abstract types */
|
||||
struct JanetAbstractHeader {
|
||||
const JanetAbstractType *type;
|
||||
size_t size;
|
||||
};
|
||||
|
||||
struct JanetReg {
|
||||
const char *name;
|
||||
JanetCFunction cfun;
|
||||
@ -992,14 +1045,14 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
|
||||
/* Tuple */
|
||||
|
||||
#define JANET_TUPLE_FLAG_BRACKETCTOR 1
|
||||
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
|
||||
|
||||
#define janet_tuple_raw(t) ((int32_t *)(t) - 5)
|
||||
#define janet_tuple_length(t) (janet_tuple_raw(t)[0])
|
||||
#define janet_tuple_hash(t) ((janet_tuple_raw(t)[1]))
|
||||
#define janet_tuple_sm_start(t) ((janet_tuple_raw(t)[2]))
|
||||
#define janet_tuple_sm_end(t) ((janet_tuple_raw(t)[3]))
|
||||
#define janet_tuple_flag(t) ((janet_tuple_raw(t)[4]))
|
||||
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||
#define janet_tuple_sm_start(t) (janet_tuple_head(t)->sm_start)
|
||||
#define janet_tuple_sm_end(t) (janet_tuple_head(t)->sm_end)
|
||||
#define janet_tuple_flag(t) (janet_tuple_head(t)->gc.flags)
|
||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
||||
JANET_API const Janet *janet_tuple_n(const Janet *values, int32_t n);
|
||||
@ -1007,9 +1060,9 @@ JANET_API int janet_tuple_equal(const Janet *lhs, const Janet *rhs);
|
||||
JANET_API int janet_tuple_compare(const Janet *lhs, const Janet *rhs);
|
||||
|
||||
/* String/Symbol functions */
|
||||
#define janet_string_raw(s) ((int32_t *)(s) - 2)
|
||||
#define janet_string_length(s) (janet_string_raw(s)[0])
|
||||
#define janet_string_hash(s) ((janet_string_raw(s)[1]))
|
||||
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
|
||||
#define janet_string_length(s) (janet_string_head(s)->length)
|
||||
#define janet_string_hash(s) (janet_string_head(s)->hash)
|
||||
JANET_API uint8_t *janet_string_begin(int32_t length);
|
||||
JANET_API const uint8_t *janet_string_end(uint8_t *str);
|
||||
JANET_API const uint8_t *janet_string(const uint8_t *buf, int32_t len);
|
||||
@ -1039,11 +1092,10 @@ JANET_API const uint8_t *janet_symbol_gen(void);
|
||||
#define janet_ckeywordv(cstr) janet_wrap_keyword(janet_ckeyword(cstr))
|
||||
|
||||
/* Structs */
|
||||
#define janet_struct_raw(t) ((int32_t *)(t) - 4)
|
||||
#define janet_struct_length(t) (janet_struct_raw(t)[0])
|
||||
#define janet_struct_capacity(t) (janet_struct_raw(t)[1])
|
||||
#define janet_struct_hash(t) (janet_struct_raw(t)[2])
|
||||
/* Do something with the 4th header slot - flags? */
|
||||
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_length(t) (janet_struct_head(t)->length)
|
||||
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
|
||||
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
|
||||
JANET_API JanetKV *janet_struct_begin(int32_t count);
|
||||
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||
JANET_API const JanetKV *janet_struct_end(JanetKV *st);
|
||||
@ -1079,7 +1131,7 @@ JANET_API Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key
|
||||
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv);
|
||||
|
||||
/* Abstract */
|
||||
#define janet_abstract_header(u) ((JanetAbstractHeader *)(u) - 1)
|
||||
#define janet_abstract_header(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_type(u) (janet_abstract_header(u)->type)
|
||||
#define janet_abstract_size(u) (janet_abstract_header(u)->size)
|
||||
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);
|
||||
|
||||
@ -26,6 +26,11 @@
|
||||
(def errsym (keyword (gensym)))
|
||||
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defmacro assert-no-error
|
||||
[msg & forms]
|
||||
(def errsym (keyword (gensym)))
|
||||
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defn start-suite [x]
|
||||
(set suite-num x)
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
|
||||
@ -97,8 +97,8 @@
|
||||
# of the triangle to the leaves of the triangle.
|
||||
|
||||
(defn myfold [xs ys]
|
||||
(let [xs1 (tuple/prepend xs 0)
|
||||
xs2 (tuple/append xs 0)
|
||||
(let [xs1 [;xs 0]
|
||||
xs2 [0 ;xs]
|
||||
m1 (map + xs1 ys)
|
||||
m2 (map + xs2 ys)]
|
||||
(map max m1 m2)))
|
||||
@ -175,10 +175,14 @@
|
||||
(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
|
||||
(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
|
||||
|
||||
(def strct {:a @[nil]})
|
||||
(put (strct :a) 0 strct)
|
||||
(testmarsh strct "cyclic struct")
|
||||
|
||||
# Large functions
|
||||
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
||||
(array/push manydefs (tuple * 10000 3 5 7 9))
|
||||
(def f (compile (tuple/prepend manydefs 'do) *env*))
|
||||
(def f (compile ['do ;manydefs] *env*))
|
||||
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
||||
|
||||
# Some higher order functions and macros
|
||||
|
||||
@ -43,5 +43,23 @@
|
||||
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
|
||||
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
|
||||
|
||||
# More marshalling code
|
||||
|
||||
(defn check-image
|
||||
"Run a marshaling test using the make-image and load-image functions."
|
||||
[x msg]
|
||||
(assert-no-error msg (load-image (make-image x))))
|
||||
|
||||
(check-image (fn [] (fn [] 1)) "marshal nested functions")
|
||||
(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")
|
||||
(check-image (fiber/new (fn [] (fiber/new (fn [] 1)))) "marshal nested fibers")
|
||||
|
||||
(def issue-53-x
|
||||
(fiber/new
|
||||
(fn []
|
||||
(var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
|
||||
|
||||
(check-image issue-53-x "issue 53 regression")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user