From 0a2f13b5239aa97e3907d18cf4dd6f03c3868fcf Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Sun, 8 Nov 2009 02:13:02 -0600 Subject: [PATCH] Added built-in structure types and interpreter core (w/o bytecode). Improved timing resolution by using clock_gettime() instead of clock(). Also gave project a name: Rosella. Play on 'Parrot' (Perl 6 VM). --- Makefile | 19 ++-- builtin.c | 181 ++++++++++++++++++++++++++++++ builtin.h | 46 ++++++++ doc/bytecode.txt | 8 +- gc.c | 80 +++++++++---- gc.h | 41 ++++--- gc_test.c | 239 --------------------------------------- interp.c | 233 ++++++++++++++++++++++++++++++++++++++ interp.h | 10 ++ rosella.c | 285 +++++++++++++++++++++++++++++++++++++++++++++++ 10 files changed, 853 insertions(+), 289 deletions(-) create mode 100644 builtin.c create mode 100644 builtin.h delete mode 100644 gc_test.c create mode 100644 interp.c create mode 100644 interp.h create mode 100644 rosella.c diff --git a/Makefile b/Makefile index a9f9ffe..1453ba0 100644 --- a/Makefile +++ b/Makefile @@ -1,30 +1,33 @@ -CFLAGS = -std=c99 +CFLAGS = -std=c99 +LDFLAGS = -lrt ifeq ($(DEBUG),yes) CFLAGS += -g PROFILE = no -dummy := $(shell rm -f gc_test *.gcda *.gcno *.o) +dummy := $(shell rm -f rosella *.gcda *.gcno *.o) else CFLAGS += -O3 -DNDEBUG -march=nocona endif -all: gc_test +all: rosella .PHONY: all clean ifneq ($(PROFILE),no) -CFLAGS += -fprofile-generate +CFLAGS += -fprofile-generate LDFLAGS += -fprofile-generate endif ifneq (,$(wildcard *.gcda)) CFLAGS += -fprofile-use -dummy := $(shell rm -f gc_test *.o) +dummy := $(shell rm -f rosella *.o) endif clean: - -rm -f gc_test *.o *.gcda *.gcno + -rm -f rosella *.o *.gcda *.gcno -gc_test: gc_test.o gc.o +rosella: rosella.o gc.o builtin.o interp.o -gc_test.o: gc_test.c gc.h +rosella.o: rosella.c gc.h builtin.h interp.h gc.o: gc.c gc.h +builtin.o: builtin.c builtin.h gc.h +interp.o: interp.c interp.h gc.h builtin.h diff --git a/builtin.c b/builtin.c new file mode 100644 index 0000000..9444f37 --- /dev/null +++ b/builtin.c @@ -0,0 +1,181 @@ +#include +#include +#include +#include +#include + +#include "gc.h" +#include "builtin.h" + +static gc_root_t builtin_list; + +/* Returns a byte string w/ bytes from 's' (excl. terminating NUL). */ +static value_t string_to_value(const char *s); + +/* Return value is a new C string which must be free()'d by caller. */ +static char *value_to_string(value_t v); + +/* Like strcmp(), but for byte strings. */ +static int byte_strcmp(value_t s1, value_t s2); + +void builtin_init(void) +{ + gc_root_t ms_root, tmp_root; + + register_gc_root(&builtin_list, NIL); + +#define SS(x) STRUCTURE_SLOT_ ## x + + /* (Meta-)Structure: Instances of this structure describe structures. */ + register_gc_root(&ms_root, make_struct(NIL, STRUCTURE_SLOTS)); + register_builtin(BI_STRUCTURE, ms_root.value); + + /* Metastruct is both a structure and a structure description, + * and thus is an instance of itself. */ + _get_struct(ms_root.value)->type = ms_root.value; + /* Slot 1: Name */ + _get_struct(ms_root.value)->slots[SS(NAME)] = string_to_value("structure"); + /* Slot 2: Super/parent structure type, or NIL */ + _get_struct(ms_root.value)->slots[SS(SUPER)] = NIL; + /* Slot 3: Vector of slot names; size == total number of slots (excl. type) */ + _get_struct(ms_root.value)->slots[SS(SLOTS)] = make_vector(STRUCTURE_SLOTS, NIL); + { + gc_root_t vec_root; + register_gc_root(&vec_root, _get_struct(ms_root.value)->slots[SS(SLOTS)]); + _get_vector(vec_root.value)->elements[SS(NAME)] = string_to_value("name"); + _get_vector(vec_root.value)->elements[SS(SUPER)] = string_to_value("super"); + _get_vector(vec_root.value)->elements[SS(SLOTS)] = string_to_value("slots"); + _get_vector(vec_root.value)->elements[SS(CALLABLE)] = string_to_value("callable"); + unregister_gc_root(&vec_root); + } + /* Slot 4: Callable object used as proxy when structure is APPLY'd. */ + /* Can be LAMBDA or callable structure instance. */ + _get_struct(ms_root.value)->slots[SS(CALLABLE)] = NIL; + +#define TS(x) TEMPLATE_SLOT_ ## x + + /* Template: Instances of this structure describe what a LAMBDA + * will look like when instanciated with the 'lambda' bytecode. */ + register_gc_root(&tmp_root, make_struct(ms_root.value, STRUCTURE_SLOTS)); + register_builtin(BI_TEMPLATE, tmp_root.value); + + /* Slot 1: Name */ + _get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("template"); + /* Slot 2: Super/parent structure type, or NIL */ + _get_struct(tmp_root.value)->slots[SS(SUPER)] = NIL; + /* Slot 3: Vector of slot names; size == total number of slots */ + _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(TEMPLATE_SLOTS, NIL); + { + gc_root_t vec_root; + register_gc_root(&vec_root, _get_struct(tmp_root.value)->slots[SS(SLOTS)]); + _get_vector(vec_root.value)->elements[TS(GLOBAL_VARS)] = string_to_value("global-vars"); + _get_vector(vec_root.value)->elements[TS(INSTANCE_VARS)] = string_to_value("instance-vars"); + _get_vector(vec_root.value)->elements[TS(FRAME_VARS)] = string_to_value("frame-vars"); + _get_vector(vec_root.value)->elements[TS(BYTE_CODE)] = string_to_value("byte-code"); + _get_vector(vec_root.value)->elements[TS(TAIL_CALL)] = string_to_value("tail-call"); + _get_vector(vec_root.value)->elements[TS(ARG_LIST)] = string_to_value("argument-list"); + _get_vector(vec_root.value)->elements[TS(CONTINUATION)] = string_to_value("continuation"); + _get_vector(vec_root.value)->elements[TS(CONTEXT)] = string_to_value("context"); + unregister_gc_root(&vec_root); + } + /* Slot 4: Callable object used as proxy when structure is apply'd. */ + _get_struct(tmp_root.value)->slots[SS(CALLABLE)] = NIL; + + unregister_gc_root(&tmp_root); + +#undef TS +#define LS(x) LAMBDA_SLOT_ ## x + + /* Lambda: Instances of this structure are fundamental callable objects. */ + register_gc_root(&tmp_root, make_struct(ms_root.value, STRUCTURE_SLOTS)); + register_builtin(BI_LAMBDA, tmp_root.value); + + /* Slot 1: Name */ + _get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("lambda"); + /* Slot 2: Super/parent structure type, or NIL */ + _get_struct(tmp_root.value)->slots[SS(SUPER)] = NIL; + /* Slot 3: Vector of slot names; size == total number of slots */ + _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(LAMBDA_SLOTS, NIL); + { + gc_root_t vec_root; + register_gc_root(&vec_root, _get_struct(tmp_root.value)->slots[SS(SLOTS)]); + _get_vector(vec_root.value)->elements[LS(GLOBAL_VARS)] = string_to_value("global-vars"); + _get_vector(vec_root.value)->elements[LS(INSTANCE_VARS)] = string_to_value("instance-vars"); + _get_vector(vec_root.value)->elements[LS(FRAME_VARS)] = string_to_value("frame-vars"); + _get_vector(vec_root.value)->elements[LS(BYTE_CODE)] = string_to_value("byte-code"); + _get_vector(vec_root.value)->elements[LS(TAIL_CALL)] = string_to_value("tail-call"); + _get_vector(vec_root.value)->elements[LS(ARG_LIST)] = string_to_value("argument-list"); + _get_vector(vec_root.value)->elements[LS(CONTINUATION)] = string_to_value("continuation"); + _get_vector(vec_root.value)->elements[LS(CONTEXT)] = string_to_value("context"); + unregister_gc_root(&vec_root); + } + /* Slot 4: Callable object used as proxy when structure is apply'd. */ + _get_struct(tmp_root.value)->slots[SS(CALLABLE)] = NIL; + + unregister_gc_root(&tmp_root); + +#undef LS +#undef SS + + unregister_gc_root(&ms_root); +} + +void register_builtin(const char *name, value_t value) +{ + gc_root_t name_root; + + register_gc_root(&name_root, string_to_value(name)); + builtin_list.value = cons(value, builtin_list.value); + builtin_list.value = cons(name_root.value, builtin_list.value); + unregister_gc_root(&name_root); +} + +value_t lookup_builtin(const char *name) +{ + value_t name_val = string_to_value(name); + + for (value_t list = builtin_list.value; !is_nil(list); + list = _CDDR(list)) + { + if (byte_strcmp(_CAR(list), name_val) == 0) + { + return _CADR(list); + } + } + + return FALSE_VALUE; +} + +static value_t string_to_value(const char *s) +{ + size_t len = strlen(s); + value_t v = make_byte_string(len, '\0'); + memcpy(_get_byte_string(v)->bytes, s, len); + return v; +} + +static char *value_to_string(value_t v) +{ + byte_string_t *str = get_byte_string(v); + char *s = (char*)malloc(str->size + 1); + + memcpy(s, str->bytes, str->size); + s[str->size] = '\0'; + + return s; +} + +static int byte_strcmp(value_t s1, value_t s2) +{ + byte_string_t *str1 = get_byte_string(s1); + byte_string_t *str2 = get_byte_string(s2); + + if (str1->size < str2->size) + return -1; + else if (str1->size > str2->size) + return 1; + else + return memcmp(str1->bytes, str2->bytes, str1->size); +} + +/* vim:set sw=2 expandtab: */ diff --git a/builtin.h b/builtin.h new file mode 100644 index 0000000..daea672 --- /dev/null +++ b/builtin.h @@ -0,0 +1,46 @@ +#ifndef BUILTIN_H_85dfb9ef1b9889cd01b60306e12f5e8e +#define BUILTIN_H_85dfb9ef1b9889cd01b60306e12f5e8e + +#include +#include +#include + +#include "gc.h" + +/* Names of fundamental builtin values */ +#define BI_STRUCTURE "structure" +#define BI_TEMPLATE "template" +#define BI_LAMBDA "lambda" + +#define STRUCTURE_SLOT_NAME 0 +#define STRUCTURE_SLOT_SUPER 1 +#define STRUCTURE_SLOT_SLOTS 2 +#define STRUCTURE_SLOT_CALLABLE 3 +#define STRUCTURE_SLOTS 4 + +#define TEMPLATE_SLOT_GLOBAL_VARS 0 +#define TEMPLATE_SLOT_INSTANCE_VARS 1 +#define TEMPLATE_SLOT_FRAME_VARS 2 +#define TEMPLATE_SLOT_BYTE_CODE 3 +#define TEMPLATE_SLOT_TAIL_CALL 4 +#define TEMPLATE_SLOT_ARG_LIST 5 +#define TEMPLATE_SLOT_CONTINUATION 6 +#define TEMPLATE_SLOT_CONTEXT 7 +#define TEMPLATE_SLOTS 8 + +#define LAMBDA_SLOT_GLOBAL_VARS 0 +#define LAMBDA_SLOT_INSTANCE_VARS 1 +#define LAMBDA_SLOT_FRAME_VARS 2 +#define LAMBDA_SLOT_BYTE_CODE 3 +#define LAMBDA_SLOT_TAIL_CALL 4 +#define LAMBDA_SLOT_ARG_LIST 5 +#define LAMBDA_SLOT_CONTINUATION 6 +#define LAMBDA_SLOT_CONTEXT 7 +#define LAMBDA_SLOTS 8 + +void builtin_init(void); +void register_builtin(const char *name, value_t value); +value_t lookup_builtin(const char *name); + +#endif +/* vim:set sw=2 expandtab: */ diff --git a/doc/bytecode.txt b/doc/bytecode.txt index 8d37b23..c7115b4 100644 --- a/doc/bytecode.txt +++ b/doc/bytecode.txt @@ -125,8 +125,8 @@ in: fN (1NNNNNNN) [frame, N < 120] -- (11111NNN) [reserved, N < 5] argv (11111101) [argument list] - ctx (11111110) [dynamic context] - k (11111111) [continuation] + k (11111110) [continuation] + ctx (11111111) [dynamic context] out: fN (1NNNNNNN) [0 <= N < 120] @@ -138,8 +138,8 @@ lambda:[ code: byte-string containing sequence of 4-byte instruction words tail-call: in-ref of lambda to tail-call arguments: in-ref of argument list to pass to tail-call - context: in-ref of dynamic context to pass to tail-call continuation: in-ref of continuation to pass to tail-call + context: in-ref of dynamic context to pass to tail-call ] template:[ @@ -149,8 +149,8 @@ template:[ code: linked tail-call: copied verbatim arguments: copied verbatim - context: copied verbatim continuation: copied verbatim + context: copied verbatim ] Protocol: diff --git a/gc.c b/gc.c index aea301d..fef2f43 100644 --- a/gc.c +++ b/gc.c @@ -1,3 +1,5 @@ +#define _POSIX_C_SOURCE 199309L + #include #include #include @@ -13,7 +15,7 @@ gc_stats_t gc_stats; /* Helper macros to reduce duplication */ #define VECTOR_BYTES(nelem) (sizeof(vector_t) + (sizeof(value_t) * (nelem))) #define BYTESTR_BYTES(size) (sizeof(byte_string_t) + (size)) -#define STRUCT_BYTES(nslots) VECTOR_BYTES(nslots) +#define STRUCT_BYTES(nslots) (sizeof(struct_t) + (sizeof(value_t) * (nslots))) /* Alignment must ensure each object has enough room to hold a forwarding object */ #define GC_ALIGNMENT ((size_t)(sizeof(object_t))) @@ -182,20 +184,14 @@ value_t make_struct(value_t type, size_t nslots) gc_root_t type_root; struct_t *s; - assert(nslots >= 1); - - /* Ensure that there is always a slot for the type */ - if (nslots < 1) - nslots = 1; - register_gc_root(&type_root, type); s = (struct_t*)gc_alloc(STRUCT_BYTES(nslots)); - s->tag = TYPE_TAG_VECTOR; + s->tag = TYPE_TAG_STRUCT; + s->type = type_root.value; s->nslots = nslots; - s->slots[0] = type_root.value; - for (int i = 1; i < nslots; ++i) + for (int i = 0; i < nslots; ++i) s->slots[i] = NIL; unregister_gc_root(&type_root); @@ -275,7 +271,7 @@ static will_t *get_will(value_t v) abort(); } -intptr_t get_fixnum(value_t v) +fixnum_t get_fixnum(value_t v) { if (is_fixnum(v)) return _get_fixnum(v); @@ -298,11 +294,11 @@ static inline size_t gc_align(size_t nbytes) static int gc_range_of(void *object) { - if (((uintptr_t)object >= (uintptr_t)gc_ranges[0]) && - ((uintptr_t)object < (uintptr_t)gc_ranges[1])) + if (((value_t)object >= (value_t)gc_ranges[0]) && + ((value_t)object < (value_t)gc_ranges[1])) return 0; - if (((uintptr_t)object >= (uintptr_t)gc_ranges[1]) && - ((uintptr_t)object < (uintptr_t)gc_ranges[2])) + if (((value_t)object >= (value_t)gc_ranges[1]) && + ((value_t)object < (value_t)gc_ranges[2])) return 1; return -1; } @@ -330,8 +326,10 @@ void gc_init(size_t min_size, size_t max_size) gc_range_end = gc_free_ptr + gc_soft_limit; gc_stats.collections = 0; - gc_stats.total_ticks = 0; + gc_stats.total_ns = 0; + gc_stats.total_freed = 0; gc_stats.high_water = 0; + gc_stats.max_ns = 0; gc_weak_box_list = NIL; gc_will_list = NIL; @@ -383,12 +381,14 @@ static void transfer_object(value_t *value) switch (obj->tag) { case TYPE_TAG_VECTOR: - case TYPE_TAG_STRUCT: nbytes = VECTOR_BYTES(((const vector_t*)obj)->size); break; case TYPE_TAG_BYTESTR: nbytes = BYTESTR_BYTES(((const byte_string_t*)obj)->size); break; + case TYPE_TAG_STRUCT: + nbytes = STRUCT_BYTES(((const struct_t*)obj)->nslots); + break; case TYPE_TAG_WEAK_BOX: nbytes = sizeof(weak_box_t); break; @@ -415,7 +415,6 @@ static void transfer_object(value_t *value) } } -/* Also works on structs, which share the same layout */ static size_t transfer_vector(vector_t *vec) { for (size_t i = 0; i < vec->size; ++i) @@ -424,6 +423,16 @@ static size_t transfer_vector(vector_t *vec) return VECTOR_BYTES(vec->size); } +static size_t transfer_struct(struct_t *s) +{ + transfer_object(&s->type); + + for (size_t i = 0; i < s->nslots; ++i) + transfer_object(&s->slots[i]); + + return STRUCT_BYTES(s->nslots); +} + static size_t transfer_pair(pair_t *p) { transfer_object(&p->car); @@ -447,10 +456,11 @@ static size_t transfer_children(object_t *obj) switch (obj->tag) { case TYPE_TAG_VECTOR: - case TYPE_TAG_STRUCT: return transfer_vector((vector_t*)obj); case TYPE_TAG_BYTESTR: return BYTESTR_BYTES(((const byte_string_t*)obj)->size); + case TYPE_TAG_STRUCT: + return transfer_struct((struct_t*)obj); case TYPE_TAG_WEAK_BOX: return sizeof(weak_box_t); case TYPE_TAG_WILL: @@ -567,18 +577,26 @@ static void process_wills(void) } } +#define GC_DEFLATE_SIZE (64*1024) + static void update_soft_limit(size_t min_free) { size_t bytes_used = gc_free_ptr - gc_ranges[gc_current_range]; size_t min_limit = bytes_used + min_free; - size_t new_limit = (5 * min_limit) / 3; + size_t new_limit = (4 * min_limit) / 3; if (new_limit > gc_max_size) new_limit = gc_max_size; -#if 0 +#if 1 else if (new_limit < gc_min_size) new_limit = gc_min_size; + if (gc_soft_limit > GC_DEFLATE_SIZE) + { + if (new_limit < (gc_soft_limit - GC_DEFLATE_SIZE)) + new_limit = gc_soft_limit - GC_DEFLATE_SIZE; + } + gc_soft_limit = new_limit; #else if (new_limit > gc_soft_limit) @@ -598,9 +616,11 @@ static void _collect_garbage(size_t min_free) { if (gc_enabled) { + struct timespec start_time; char *object_ptr; - gc_stats.total_ticks -= clock(); + clock_gettime(CLOCK_MONOTONIC, &start_time); + gc_stats.total_freed -= gc_free_space(); ++gc_stats.collections; //debug(("Collecting garbage...\n")); @@ -632,7 +652,21 @@ static void _collect_garbage(size_t min_free) //debug(("Finished collection with %d bytes to spare (out of %d bytes).\n", gc_free_space(), gc_soft_limit)); - gc_stats.total_ticks += clock(); + { + struct timespec end_time; + nsec_t nsec; + + clock_gettime(CLOCK_MONOTONIC, &end_time); + + nsec = (end_time.tv_sec - start_time.tv_sec) * 1000000000LL; + nsec += (end_time.tv_nsec - start_time.tv_nsec); + + gc_stats.total_ns += nsec; + gc_stats.total_freed += gc_free_space(); + + if (nsec > gc_stats.max_ns) + gc_stats.max_ns = nsec; + } } update_soft_limit(min_free); diff --git a/gc.h b/gc.h index a010a29..f63a618 100644 --- a/gc.h +++ b/gc.h @@ -5,6 +5,7 @@ #include #include #include +#include #ifndef NDEBUG # define debug(printf_args) ((void)printf printf_args) @@ -13,6 +14,7 @@ #endif typedef uintptr_t value_t; +typedef intptr_t fixnum_t; /* NIL: 00000000 00000000 00000000 00000000 */ /* Object: aaaaaaaa aaaaaaaa aaaaaaaa aaaaaa00 (where aa... >= 1024) */ @@ -38,6 +40,16 @@ typedef uintptr_t value_t; #define TYPE_TAG_WEAK_BOX TYPE_TAG(4) #define TYPE_TAG_WILL TYPE_TAG(5) +#define CAR(x) (get_pair(x)->car) +#define CDR(x) (get_pair(x)->cdr) +#define CADR(x) CAR(CDR(x)) +#define CDDR(x) CDR(CDR(x)) + +#define _CAR(x) (_get_pair(x)->car) +#define _CDR(x) (_get_pair(x)->cdr) +#define _CADR(x) _CAR(_CDR(x)) +#define _CDDR(x) _CDR(_CDR(x)) + typedef struct object { value_t tag; @@ -75,7 +87,8 @@ typedef struct byte_string typedef struct structure { value_t tag; /* TYPE_TAG_STRUCT */ - size_t nslots; /* Includes slots[0], the struct subtype */ + value_t type; + size_t nslots; value_t slots[0]; } struct_t; @@ -101,11 +114,15 @@ typedef struct gc_root struct gc_root *next; } gc_root_t; +typedef uint64_t nsec_t; + typedef struct gc_stats { - int collections; - clock_t total_ticks; - size_t high_water; + int collections; + nsec_t total_ns; + uint64_t total_freed; + size_t high_water; + nsec_t max_ns; } gc_stats_t; extern gc_stats_t gc_stats; @@ -124,8 +141,7 @@ vector_t *get_vector(value_t v); value_t make_byte_string(size_t size, int default_value); byte_string_t *get_byte_string(value_t v); -/* Precondition: slots >= 1; this includes the struct type tag, slots[0]. */ -value_t make_struct(value_t type, size_t slots); +value_t make_struct(value_t type, size_t nslots); struct_t *get_struct(value_t v); value_t make_weak_box(value_t value); @@ -138,7 +154,7 @@ bool are_finalizers_pending(void); /* If *value == #f on return there are no more finalizers. */ void get_next_finalizer(value_t *value, value_t *finalizer); -intptr_t get_fixnum(value_t v); +fixnum_t get_fixnum(value_t v); /****************************************************************************/ @@ -253,11 +269,6 @@ static inline struct_t *_get_struct(value_t v) return (struct_t*)_get_object(v); } -static inline size_t struct_type(value_t v) -{ - return get_struct(v)->slots[0]; -} - static inline bool is_weak_box(value_t v) { return is_object(v) && (_get_object(v)->tag == TYPE_TAG_WEAK_BOX); @@ -278,14 +289,14 @@ static inline bool is_fixnum(value_t v) return (v & 1) != 0; } -static inline value_t make_fixnum(intptr_t n) +static inline value_t make_fixnum(fixnum_t n) { return (value_t)(n << 1) | 1; } -static inline intptr_t _get_fixnum(value_t n) +static inline fixnum_t _get_fixnum(value_t n) { - return ((intptr_t)n) >> 1; + return ((fixnum_t)n) >> 1; } void gc_init(size_t min_size, size_t max_size); diff --git a/gc_test.c b/gc_test.c deleted file mode 100644 index 041b966..0000000 --- a/gc_test.c +++ /dev/null @@ -1,239 +0,0 @@ -#include - -#include -#include -#include -#include -#include -#include - -#include "gc.h" - -void out_of_memory(void) -{ - fprintf(stderr, "Out of memory!\n"); - abort(); -} - -static void print_value(value_t v); -static inline void comma(void) { fputs(", ", stdout); } -static inline void nl(void) { putchar('\n'); } - -int main(int argc, char **argv) -{ - gc_root_t list_root, tmp_root; - int count = 0; - - gc_init(1024, 256*1024*1024); - - srand((unsigned int)time(NULL)); - - register_gc_root(&list_root, NIL); - register_gc_root(&tmp_root, NIL); - - tmp_root.value = cons(make_fixnum(1), cons(make_fixnum(2), NIL)); - list_root.value = make_weak_box(tmp_root.value); - - register_finalizer(tmp_root.value, make_fixnum(10)); - - print_value(list_root.value); comma(); - { - value_t v, f; - - get_next_finalizer(&v, &f); - - print_value(v); comma(); - print_value(f); nl(); nl(); - } - - collect_garbage(0); - - print_value(list_root.value); comma(); - { - value_t v, f; - - get_next_finalizer(&v, &f); - - print_value(v); comma(); - print_value(f); nl(); nl(); - } - - tmp_root.value = NIL; - - print_value(list_root.value); comma(); - { - value_t v, f; - - get_next_finalizer(&v, &f); - - print_value(v); comma(); - print_value(f); nl(); nl(); - } - - collect_garbage(0); - - print_value(list_root.value); comma(); - { - value_t v, f; - - get_next_finalizer(&v, &f); - - print_value(v); comma(); - print_value(f); nl(); nl(); - } - -#if 0 - while (1) - { - int r = rand() & 0x3fff; - - if (r == 0) - list_root.value = make_fixnum(rand()); - else - { - switch (r & 7) - { - case 0: - list_root.value = cons(make_fixnum(rand()), list_root.value); - break; - case 1: - list_root.value = cons(list_root.value, make_byte_string(256, '\0')); - break; - case 2: - list_root.value = make_box(list_root.value); - break; - case 3: - list_root.value = cons(list_root.value, cons(make_fixnum(-1), NIL)); - get_pair(get_pair(list_root.value)->cdr)->cdr = list_root.value; - break; - case 4: - case 5: - case 6: - case 7: - { - value_t s = make_struct(NIL, 5); - _get_struct(s)->slots[1+(r & 3)] = list_root.value; - list_root.value = s; - } - break; - } - } - - if (++count >= 10000000) - { - const double total_time = gc_stats.total_ticks / (double)CLOCKS_PER_SEC; - - fprintf(stderr, "%0.3f sec / %d GCs => %0.3f usec/GC; peak was %u bytes.\n", - total_time, - gc_stats.collections, - (1000000 * total_time) / gc_stats.collections, - gc_stats.high_water); - - gc_stats.collections = 0; - gc_stats.total_ticks = 0; - gc_stats.high_water = 0; - count = 0; - - break; - } - } -#endif - - unregister_gc_root(&list_root); - - return 0; -} - -static void print_value(value_t v) -{ - if (v == NIL) - { - fputs("nil", stdout); - } - else if (v == FALSE_VALUE) - { - fputs("#f", stdout); - } - else if (v == TRUE_VALUE) - { - fputs("#t", stdout); - } - else if (is_fixnum(v)) - { - printf("%d", (int)get_fixnum(v)); - } - else if (is_box(v)) - { - fputs("#&", stdout); - print_value(_get_box(v)->value); - } - else if (is_pair(v)) - { - putchar('('); - - print_value(_get_pair(v)->car); - v = _get_pair(v)->cdr; - - while (is_pair(v)) - { - putchar(' '); - print_value(_get_pair(v)->car); - v = _get_pair(v)->cdr; - } - - if (v != NIL) - { - fputs(" . ", stdout); - print_value(v); - } - - putchar(')'); - } - else if (is_vector(v)) - { - fputs("#(", stdout); - - for (size_t i = 0; i < _get_vector(v)->size; ++i) - { - if (i != 0) putchar(' '); - print_value(_get_vector(v)->elements[i]); - } - - putchar(')'); - } - else if (is_byte_string(v)) - { - fputs("#B(", stdout); - - for (size_t i = 0; i < _get_byte_string(v)->size; ++i) - { - if (i != 0) putchar(' '); - printf("%d", (int)_get_byte_string(v)->bytes[i]); - } - - putchar(')'); - } - else if (is_struct(v)) - { - fputs("#S(", stdout); - - for (size_t i = 0; i < _get_struct(v)->nslots; ++i) - { - if (i != 0) putchar(' '); - print_value(_get_struct(v)->slots[i]); - } - - putchar(')'); - } - else if (is_weak_box(v)) - { - fputs("#W&", stdout); - print_value(_get_weak_box(v)->value); - } - else - { - fputs("#", stdout); - } -} - -/* vim:set sw=2 expandtab: */ diff --git a/interp.c b/interp.c new file mode 100644 index 0000000..4c431ec --- /dev/null +++ b/interp.c @@ -0,0 +1,233 @@ +#include +#include +#include + +#include "builtin.h" +#include "gc.h" + +/* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */ +#define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s]) +#define _LAMBDA_SLOT(v,s) _SLOT_VALUE(LAMBDA, v, s) + +typedef struct interp_state +{ + gc_root_t lambda; + gc_root_t frame; + gc_root_t argv; + gc_root_t k; + gc_root_t ctx; +} interp_state_t; + +/* Quick references to main builtins */ +static gc_root_t structure_type_root; +static gc_root_t template_type_root; +static gc_root_t lambda_type_root; + +/* Local helper routines */ +static bool struct_is_a(value_t s, value_t type); +static void translate_callable(interp_state_t *state); +static void run_byte_code(interp_state_t *state); +static void perform_tail_call(interp_state_t *state); +static value_t get_input(const interp_state_t *state, fixnum_t var); +static void set_output(const interp_state_t *state, fixnum_t var, value_t val); +static void register_state(interp_state_t *state, value_t lambda, value_t argv); +static void unregister_state(interp_state_t *state); + +void interpreter_init(void) +{ + register_gc_root(&structure_type_root, lookup_builtin(BI_STRUCTURE)); + register_gc_root(&template_type_root, lookup_builtin(BI_TEMPLATE)); + register_gc_root(&lambda_type_root, lookup_builtin(BI_LAMBDA)); +} + +value_t run_interpreter(value_t lambda, value_t argv) +{ + static bool run_finalizers = true; + interp_state_t state; + + register_state(&state, lambda, argv); + + /* Keep going until something attempt to tail-call NIL, the original 'k', indicating completion. */ + while (!is_nil(state.lambda.value)) + { + /* 'lambda' may be a callable structure; if so, follow the 'callable' proxies and update argv. */ + translate_callable(&state); + + /* + * Now 'lambda' really is a lambda structure instance. + */ + + /* Allocate frame variables */ + state.frame.value = make_vector(get_fixnum(_LAMBDA_SLOT(state.lambda.value, FRAME_VARS)), NIL); + + run_byte_code(&state); + perform_tail_call(&state); + + if (run_finalizers) + { + value_t v, f; + get_next_finalizer(&v, &f); + + if (is_object(v)) + { + gc_root_t f_root; + + register_gc_root(&f_root, f); + run_finalizers = false; + + /* Note that recursion is limited to a single level by the static variable. */ + run_interpreter(f_root.value, cons(v, NIL)); + + run_finalizers = true; + unregister_gc_root(&f_root); + } + } + } + + unregister_state(&state); + + /* The arguments passed to NIL continuation are the final return value. */ + return state.argv.value; +} + +/* TODO: Check for cycles (besides 'structure') and permit derivatives of 'structure'. */ +static bool struct_is_a(value_t s, value_t type) +{ + /* To prevent unbounded loops w/ cyclic 'parent' links. */ + int ttl = 256; + + if (!is_struct(s)) + return false; + + for (value_t t = _get_struct(s)->type; t != type; t = _SLOT_VALUE(STRUCTURE, t, SUPER), --ttl) + { + if (is_nil(t)) + return false; + + if (get_struct(t)->type != structure_type_root.value) + abort(); + + if (ttl <= 0) + abort(); + } + + return true; +} + +static void translate_callable(interp_state_t *state) +{ + while (!struct_is_a(state->lambda.value, lambda_type_root.value)) + { + if (!struct_is_a(get_struct(state->lambda.value)->type, structure_type_root.value)) + abort(); + + /* Prepend structure instance to argument list, per proxy protocol. */ + state->argv.value = cons(state->lambda.value, state->argv.value); + + /* Follow link to next callable. */ + state->lambda.value = _SLOT_VALUE(STRUCTURE, _get_struct(state->lambda.value)->type, CALLABLE); + } +} + +static void run_byte_code(interp_state_t *state) +{ + /* TODO */ +} + +static void perform_tail_call(interp_state_t *state) +{ + value_t new_lambda, new_argv, new_ctx, new_k; + + new_lambda = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, TAIL_CALL))); + new_argv = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, ARG_LIST))); + new_k = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, CONTINUATION))); + new_ctx = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, CONTEXT))); + + state->lambda.value = new_lambda; + state->argv.value = new_argv; + state->k.value = new_k; + state->ctx.value = new_ctx; +} + +static value_t get_input(const interp_state_t *state, fixnum_t var) +{ + if (var >= 256) + abort(); + else if (var == 255) + return state->ctx.value; + else if (var == 254) + return state->k.value; + else if (var == 253) + return state->argv.value; + else if (var >= 248) + abort(); /* reserved */ + else if (var >= 128) + { + vector_t *vec = _get_vector(state->frame.value); + var -= 128; + + if (var >= vec->size) + abort(); + + return vec->elements[var]; + } + else if (var >= 64) + { + vector_t *vec = get_vector(_LAMBDA_SLOT(state->lambda.value, INSTANCE_VARS)); + var -= 64; + + if (var >= vec->size) + abort(); + + return vec->elements[var]; + } + else if (var >= 1) + { + vector_t *vec = get_vector(_LAMBDA_SLOT(state->lambda.value, GLOBAL_VARS)); + var -= 1; + + if (var >= vec->size) + abort(); + + return vec->elements[var]; + } + else if (var == 0) + return NIL; + else + abort(); +} + +static void set_output(const interp_state_t *state, fixnum_t var, value_t val) +{ + vector_t *vec = _get_vector(state->frame.value); + + if (var < 128) + abort(); + + var -= 128; + + if (var >= vec->size) + abort(); + + vec->elements[var] = val; +} + +static void register_state(interp_state_t *state, value_t lambda, value_t argv) +{ + register_gc_root(&state->lambda, lambda); + register_gc_root(&state->frame, NIL); + register_gc_root(&state->argv, argv); + register_gc_root(&state->k, NIL); + register_gc_root(&state->ctx, NIL); +} + +static void unregister_state(interp_state_t *state) +{ + unregister_gc_root(&state->lambda); + unregister_gc_root(&state->frame); + unregister_gc_root(&state->argv); + unregister_gc_root(&state->k); + unregister_gc_root(&state->ctx); +} + +/* vim:set sw=2 expandtab: */ diff --git a/interp.h b/interp.h new file mode 100644 index 0000000..e29bd35 --- /dev/null +++ b/interp.h @@ -0,0 +1,10 @@ +#ifndef INTERP_H_9c7eea5c5cd0f7a32b79a8ca0ab2969f +#define INTERP_H_9c7eea5c5cd0f7a32b79a8ca0ab2969f + +#include "gc.h" + +void interpreter_init(void); +value_t run_interpreter(value_t lambda, value_t argv); + +#endif +/* vim:set sw=2 expandtab: */ diff --git a/rosella.c b/rosella.c new file mode 100644 index 0000000..78c9abd --- /dev/null +++ b/rosella.c @@ -0,0 +1,285 @@ +#include + +#include +#include +#include +#include +#include +#include +#include + +#include "gc.h" +#include "builtin.h" +#include "interp.h" + +static void test_builtins(void); +static void test_weak_boxes_and_wills(void); +static void test_garbage_collection(void); +static void print_value(value_t v); +static void print_gc_stats(void); + +static inline void comma(void) { fputs(", ", stdout); } +static inline void nl(void) { putchar('\n'); } + +void out_of_memory(void) +{ + fprintf(stderr, "Out of memory!\n\n"); + print_gc_stats(); + abort(); +} + +int main(int argc, char **argv) +{ + srand((unsigned int)time(NULL)); + + gc_init(1024, 256*1024*1024); + + builtin_init(); + interpreter_init(); + + test_builtins(); + test_weak_boxes_and_wills(); + test_garbage_collection(); + + return 0; +} + +static void test_builtins(void) +{ + print_value(lookup_builtin(BI_STRUCTURE)); nl(); nl(); + print_value(lookup_builtin(BI_TEMPLATE)); nl(); nl(); + print_value(lookup_builtin(BI_LAMBDA)); nl(); nl(); +} + +static void print_weak_box_results(value_t box) +{ + value_t v, f; + print_value(box); comma(); + get_next_finalizer(&v, &f); + print_value(v); comma(); print_value(f); nl(); +} + +static void test_weak_boxes_and_wills(void) +{ + gc_root_t box_root, tmp_root; + + register_gc_root(&box_root, NIL); + register_gc_root(&tmp_root, NIL); + + tmp_root.value = cons(make_fixnum(1), cons(make_fixnum(2), NIL)); + box_root.value = make_weak_box(tmp_root.value); + + register_finalizer(tmp_root.value, make_fixnum(10)); + print_weak_box_results(box_root.value); + + collect_garbage(0); + print_weak_box_results(box_root.value); + + tmp_root.value = NIL; + print_weak_box_results(box_root.value); + + collect_garbage(0); + print_weak_box_results(box_root.value); + + collect_garbage(0); + print_weak_box_results(box_root.value); + + unregister_gc_root(&box_root); + unregister_gc_root(&tmp_root); +} + +static void test_garbage_collection(void) +{ + gc_root_t root; + int count = 0; + + register_gc_root(&root, NIL); + + while (1) + { + int r = rand() & 0xffff; + + if (r == 0) + root.value = make_fixnum(rand()); + else + { + switch (r & 7) + { + case 0: + root.value = cons(make_fixnum(rand()), root.value); + break; + case 1: + root.value = cons(root.value, make_byte_string(256, '\0')); + break; + case 2: + root.value = make_box(root.value); + break; + case 3: + root.value = cons(root.value, cons(make_fixnum(-1), NIL)); + get_pair(get_pair(root.value)->cdr)->cdr = root.value; + break; + case 4: + case 5: + case 6: + case 7: + { + value_t s = make_struct(NIL, 4); + _get_struct(s)->slots[r & 3] = root.value; + root.value = s; + } + break; + } + } + + if (++count >= 50000000) + { + nl(); + print_gc_stats(); + + gc_stats.collections = 0; + gc_stats.total_ns = 0; + gc_stats.total_freed = 0; + gc_stats.high_water = 0; + gc_stats.max_ns = 0; + count = 0; + + break; + } + } + + unregister_gc_root(&root); +} + +static bool all_print(const char *s, size_t len) +{ + for (size_t i = 0; i < len; ++i) + { + if (s[i] == '"' || !isprint(s[i])) + return false; + } + return true; +} + +static void print_value(value_t v) +{ + if (v == NIL) + { + fputs("nil", stdout); + } + else if (v == FALSE_VALUE) + { + fputs("#f", stdout); + } + else if (v == TRUE_VALUE) + { + fputs("#t", stdout); + } + else if (is_fixnum(v)) + { + printf("%d", (int)get_fixnum(v)); + } + else if (is_box(v)) + { + fputs("#&", stdout); + print_value(_get_box(v)->value); + } + else if (is_pair(v)) + { + putchar('('); + + print_value(_get_pair(v)->car); + v = _get_pair(v)->cdr; + + while (is_pair(v)) + { + putchar(' '); + print_value(_get_pair(v)->car); + v = _get_pair(v)->cdr; + } + + if (v != NIL) + { + fputs(" . ", stdout); + print_value(v); + } + + putchar(')'); + } + else if (is_vector(v)) + { + fputs("#(", stdout); + + for (size_t i = 0; i < _get_vector(v)->size; ++i) + { + if (i != 0) putchar(' '); + print_value(_get_vector(v)->elements[i]); + } + + putchar(')'); + } + else if (is_byte_string(v)) + { + byte_string_t *str = _get_byte_string(v); + + if (all_print(str->bytes, str->size)) + { + putchar('"'); + fwrite(str->bytes, str->size, 1, stdout); + putchar('"'); + } + else + { + fputs("#B(", stdout); + + for (size_t i = 0; i < str->size; ++i) + { + if (i != 0) putchar(' '); + printf("%d", (int)str->bytes[i]); + } + + putchar(')'); + } + } + else if (is_struct(v)) + { + struct_t *meta = get_struct(_get_struct(v)->type); + byte_string_t *str = get_byte_string(meta->slots[0]); + + fputs("#S(", stdout); + fwrite(str->bytes, str->size, 1, stdout); + + for (size_t i = 0; i < _get_struct(v)->nslots; ++i) + { + putchar(' '); + print_value(_get_struct(v)->slots[i]); + } + + putchar(')'); + } + else if (is_weak_box(v)) + { + fputs("#W&", stdout); + print_value(_get_weak_box(v)->value); + } + else + { + fputs("#", stdout); + } +} + +static void print_gc_stats(void) +{ + const double total_time = gc_stats.total_ns / 1.0e9; + const double max_time = gc_stats.max_ns / 1.0e9; + + fprintf(stderr, "%lld bytes freed in %0.6f sec => %0.3f MB/sec. (%d GCs.)\n", + gc_stats.total_freed, + total_time, + (gc_stats.total_freed / total_time) / (1024*1024), + gc_stats.collections); + + fprintf(stderr, "Max GC time was %0.6f sec, avg. %0.6f sec; peak heap size was %d bytes.\n", + max_time, (total_time / gc_stats.collections), gc_stats.high_water); +} + +/* vim:set sw=2 expandtab: */