Merge remote-tracking branch 'upstream/master' into ta-with-marshal

CHANGELOG.md

@@ -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.

CONTRIBUTING.md

@@ -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
 

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)

src/boot/array_test.c

@@ -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;
 }

src/boot/boot.c

@@ -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 */

src/boot/buffer_test.c

@@ -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;
 }

src/boot/number_test.c

@@ -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() {
+int number_test() {
-
-    janet_init();
 
     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;
 }

src/boot/system_test.c

@@ -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;
 }

src/boot/table_test.c

@@ -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;
 }

src/boot/tests.h

@@ -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 */

src/core/abstract.c

@@ -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);
+    JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_ABSTRACT,
-    JanetAbstractHeader *header = (JanetAbstractHeader *)data;
+            sizeof(JanetAbstractHead) + size);
-    void *a = data + sizeof(JanetAbstractHeader);
     header->size = size;
     header->type = atype;
-    return a;
+    return (void *) & (header->data);
 }

src/core/core.janet

@@ -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

src/core/debug.c

@@ -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;

src/core/gc.c

@@ -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) {
+static void janet_deinit_block(JanetGCObject *mem) {
-    void *mem = ((char *)(block + 1));
+    switch (mem->flags & JANET_MEM_TYPEBITS) {
-    JanetAbstractHeader *h = (JanetAbstractHeader *)mem;
-    switch (block->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:
+        case JANET_MEMORY_ABSTRACT: {
-            if (h->type->gc) {
+            JanetAbstractHead *head = (JanetAbstractHead *)mem;
-                janet_assert(!h->type->gc((void *)(h + 1), h->size), "finalizer failed");
+            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;
+    JanetGCObject *previous = NULL;
-    JanetGCMemoryHeader *current = janet_vm_blocks;
+    JanetGCObject *current = janet_vm_blocks;
-    JanetGCMemoryHeader *next;
+    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;
+    JanetGCObject *mem;
-    size_t total = size + sizeof(JanetGCMemoryHeader);
 
     /* 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;
+    mem->next = janet_vm_blocks;
-    janet_vm_blocks = mdata;
+    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;
     }

src/core/gc.h

@@ -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,

src/core/marsh.c

@@ -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);
                 }

src/core/parse.c

@@ -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));

src/core/pp.c

@@ -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

src/core/string.c

@@ -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);
+    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + length + 1);
-    uint8_t *str = (uint8_t *)(data + 2 * sizeof(int32_t));
+    head->length = length;
-    janet_string_length(str) = length;
+    uint8_t *data = (uint8_t *)head->data;
-    str[length] = 0;
+    data[length] = 0;
-    return str;
+    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);
+    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + len + 1);
-    char *data = janet_gcalloc(JANET_MEMORY_STRING, 2 * sizeof(int32_t) + len + 1);
+    head->length = len;
-    uint8_t *str = (uint8_t *)(data + 2 * sizeof(int32_t));
+    head->hash = janet_string_calchash(buf, len);
-    memcpy(str, buf, len);
+    uint8_t *data = (uint8_t *)head->data;
-    str[len] = 0;
+    memcpy(data, buf, len);
-    janet_string_length(str) = len;
+    data[len] = 0;
-    janet_string_hash(str) = hash;
+    return data;
-    return str;
 }
 
 /* Compare two strings */

src/core/struct.c

@@ -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));
+    size_t size = sizeof(JanetStructHead) + capacity * sizeof(JanetKV);
-    char *data = janet_gcalloc(JANET_MEMORY_STRUCT, s);
+    JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
-    JanetKV *st = (JanetKV *)(data + 4 * sizeof(int32_t));
+    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;
 }
 

src/core/symcache.c

@@ -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)
+    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1);
-             + (2 * sizeof(int32_t));
+    head->hash = hash;
-    janet_string_hash(newstr) = hash;
+    head->length = len;
-    janet_string_length(newstr) = 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;
+    return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
-    while (cstr[len]) len++;
-    return janet_symbol((const uint8_t *)cstr, len);
 }
 
 /* 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(
+    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(gensym_counter));
-              JANET_MEMORY_SYMBOL,
+    head->length = sizeof(gensym_counter) - 1;
-              2 * sizeof(int32_t) + sizeof(gensym_counter)) +
+    head->hash = hash;
-          (2 * sizeof(int32_t));
+    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;
 }

src/core/tuple.c

@@ -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));
+    size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
-    Janet *tuple = (Janet *)(data + (5 * sizeof(int32_t)));
+    JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
-    janet_tuple_length(tuple) = length;
+    head->sm_start = -1;
-    janet_tuple_sm_start(tuple) = -1;
+    head->sm_end = -1;
-    janet_tuple_sm_end(tuple) = -1;
+    head->length = length;
-    janet_tuple_flag(tuple) = 0;
+    return (Janet *)(head->data);
-    return tuple;
 }
 
 /* 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"

src/include/janet.h

@@ -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;
+    JanetGCObject gc; /* GC Object stuff */
-    JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
+    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;
+    JanetGCObject gc;
-    JanetTable *proto;
     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_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
-#define janet_tuple_length(t) (janet_tuple_raw(t)[0])
+#define janet_tuple_length(t) (janet_tuple_head(t)->length)
-#define janet_tuple_hash(t) ((janet_tuple_raw(t)[1]))
+#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
-#define janet_tuple_sm_start(t) ((janet_tuple_raw(t)[2]))
+#define janet_tuple_sm_start(t) (janet_tuple_head(t)->sm_start)
-#define janet_tuple_sm_end(t) ((janet_tuple_raw(t)[3]))
+#define janet_tuple_sm_end(t) (janet_tuple_head(t)->sm_end)
-#define janet_tuple_flag(t) ((janet_tuple_raw(t)[4]))
+#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_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
-#define janet_string_length(s) (janet_string_raw(s)[0])
+#define janet_string_length(s) (janet_string_head(s)->length)
-#define janet_string_hash(s) ((janet_string_raw(s)[1]))
+#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_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
-#define janet_struct_length(t) (janet_struct_raw(t)[0])
+#define janet_struct_length(t) (janet_struct_head(t)->length)
-#define janet_struct_capacity(t) (janet_struct_raw(t)[1])
+#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
-#define janet_struct_hash(t) (janet_struct_raw(t)[2])
+#define janet_struct_hash(t) (janet_struct_head(t)->hash)
-/* Do something with the 4th header slot - flags? */
 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);

test/helper.janet

@@ -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  "))

test/suite1.janet

@@ -97,8 +97,8 @@
 # of the triangle to the leaves of the triangle.
 
 (defn myfold [xs ys]
-  (let [xs1 (tuple/prepend xs 0)
+  (let [xs1 [;xs 0]
-        xs2 (tuple/append 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

test/suite4.janet

@@ -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)