From f17bd95ad7c4ec76aea4d1ea73b702f61cac84a8 Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Tue, 21 Apr 2026 22:20:23 -0400 Subject: Liberation from libc --- Makefile | 23 ++-- flake.nix | 4 + include/lcq/pit/runtime.h | 13 ++- include/lcq/pit/types.h | 2 +- include/lcq/pit/utils.h | 39 +++++-- src/lexer.c | 49 +++----- src/library.c | 147 +---------------------- src/main.c | 4 +- src/native.c | 291 ++++++++++++++++++++++++++++++++++++++++++++++ src/parser.c | 8 +- src/runtime.c | 220 +++++++++-------------------------- src/utils.c | 137 +++++++++++++++++----- 12 files changed, 536 insertions(+), 401 deletions(-) create mode 100644 src/native.c diff --git a/Makefile b/Makefile index 1336a2a..d92724a 100644 --- a/Makefile +++ b/Makefile @@ -2,15 +2,18 @@ CC ?= gcc AR ?= ar CHK_SOURCES ?= src/main.c $(SRCS) CPPFLAGS ?= -MMD -MP -CFLAGS ?= -march=native --std=c99 -g -Ideps/ -Isrc/ -Iinclude/ -Wall -Wextra -Wpedantic -Wconversion -Wformat-security -Wshadow -Wpointer-arith -Wstrict-prototypes -Wmissing-prototypes -Wnull-dereference -Wfloat-equal -Wundef -Wpointer-arith -Wbad-function-cast -Wlogical-op -Wmissing-braces -Wcast-align -Wstrict-overflow=5 -ftrapv +CFLAGS ?= --std=c99 -g -Ideps/ -Isrc/ -Iinclude/ -Wall -Wextra -Wpedantic -Wconversion -Wformat-security -Wshadow -Wpointer-arith -Wstrict-prototypes -Wmissing-prototypes -Wnull-dereference -Wfloat-equal -Wundef -Wpointer-arith -Wbad-function-cast -Wlogical-op -Wmissing-braces -Wcast-align -Wstrict-overflow=5 -ftrapv LDFLAGS ?= -g -static BUILD = build_$(CC) -SRCS := src/utils.c src/lexer.c src/parser.c src/runtime.c src/library.c -OBJECTS := $(SRCS:src/%.c=$(BUILD)/%.o) +SRCS_CORE := src/utils.c src/lexer.c src/parser.c src/runtime.c src/library.c +OBJECTS_CORE := $(SRCS_CORE:src/%.c=$(BUILD)/%.o) +LIB_CORE := libcolonq-pit.a +SRCS_NATIVE := src/native.c +OBJECTS_NATIVE := $(SRCS_NATIVE:src/%.c=$(BUILD)/%.o) +LIB_NATIVE := libcolonq-pit-native.a EXE := pit -LIB := libcolonq-pit.a prefix ?= /usr/local exec_prefix ?= $(prefix) @@ -20,12 +23,15 @@ libdir ?= $(exec_prefix)/lib .PHONY: all clean install check-syntax -all: $(EXE) $(LIB) +all: $(EXE) $(LIB) $(LIB_NATIVE) -$(EXE): $(BUILD)/main.o $(LIB) +$(EXE): $(BUILD)/main.o $(LIB_NATIVE) $(LIB_CORE) $(CC) -o $@ $^ $(LDFLAGS) -$(LIB): $(OBJECTS) +$(LIB_CORE): $(OBJECTS_CORE) + ar rcs $@ $^ + +$(LIB_NATIVE): $(OBJECTS_NATIVE) ar rcs $@ $^ $(BUILD): @@ -52,4 +58,5 @@ check-syntax: TAGS gcc $(CFLAGS) -fsyntax-only $(CHK_SOURCES) -include $(BUILD)/main.d --include $(OBJECTS:.o=.d) +-include $(OBJECTS_CORE:.o=.d) +-include $(OBJECTS_NATIVE:.o=.d) diff --git a/flake.nix b/flake.nix index fe3e803..f944dc4 100644 --- a/flake.nix +++ b/flake.nix @@ -18,6 +18,9 @@ make prefix=$out install ''; }; + wasm32-clang = pkgs.writeShellScriptBin "wasm32-clang" '' + ${pkgs.llvmPackages.clang-unwrapped}/bin/clang -I${pkgs.llvmPackages.clang}/resource-root/include --target=wasm32-unknown-unknown "$@" + ''; in { packages = { inherit pit; @@ -30,6 +33,7 @@ pkgs.musl pkgs.valgrind pkgs.universal-ctags + wasm32-clang ]; }; } diff --git a/include/lcq/pit/runtime.h b/include/lcq/pit/runtime.h index f946a71..1cf8549 100644 --- a/include/lcq/pit/runtime.h +++ b/include/lcq/pit/runtime.h @@ -27,7 +27,7 @@ typedef struct { i64 capacity, next; pit_value data[]; } pit_values; -pit_values *pit_values_new(i64 capacity); +pit_values *pit_values_new(u8 *buf, i64 buf_len); void pit_values_push(struct pit_runtime *rt, pit_values *s, pit_value x); pit_value pit_values_pop(struct pit_runtime *rt, pit_values *s); @@ -77,7 +77,7 @@ typedef struct { i64 capacity, next; pit_runtime_eval_program_entry data[]; } pit_runtime_eval_program; -pit_runtime_eval_program *pit_runtime_eval_program_new(i64 capacity); +pit_runtime_eval_program *pit_runtime_eval_program_new(u8 *buf, i64 buf_len); void pit_runtime_eval_program_push_literal(struct pit_runtime *rt, pit_runtime_eval_program *s, pit_value x); void pit_runtime_eval_program_push_apply(struct pit_runtime *rt, pit_runtime_eval_program *s, i64 arity); @@ -101,7 +101,7 @@ typedef struct pit_runtime { i64 source_line, source_column; /* for error reporting only; line and column of token start */ i64 error_line, error_column; /* line and column of token start at time of error */ } pit_runtime; -pit_runtime *pit_runtime_new(void); +pit_runtime *pit_runtime_new(u8 *buf, i64 len); void pit_runtime_freeze(pit_runtime *rt); /* freeze the runtime at the current point - everything currently defined becomes immutable */ void pit_runtime_reset(pit_runtime *rt); /* restore the runtime to the frozen point, resetting everything that has happened since */ @@ -109,8 +109,8 @@ bool pit_runtime_print_error(pit_runtime *rt); /* return true if an error has oc i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable); /* if readable is true, try to produce output that can be machine-read (quotes on strings, etc) */ #define pit_trace(rt, v) pit_trace_(rt, "Trace [" __FILE__ ":" PIT_STR(__LINE__) "] %s\n", v) -void pit_trace_(pit_runtime *rt, const char *format, pit_value v); -void pit_error(pit_runtime *rt, const char *format, ...); +void pit_trace_(pit_runtime *rt, char *format, pit_value v); +void pit_error(pit_runtime *rt, char *format, ...); /* working with small values */ pit_value pit_value_new(pit_runtime *rt, enum pit_value_sort s, u64 data); @@ -220,4 +220,7 @@ void pit_collect_garbage(pit_runtime *rt); pit_value pit_load_file(pit_runtime *rt, char *path); void pit_repl(pit_runtime *rt); +/* test entrypoint */ +int pit_runtime_test(u8 *out, i64 out_len, u8 *buf, i64 len); + #endif diff --git a/include/lcq/pit/types.h b/include/lcq/pit/types.h index 384dc77..eb4fe64 100644 --- a/include/lcq/pit/types.h +++ b/include/lcq/pit/types.h @@ -3,12 +3,12 @@ #include #include +#include typedef int8_t i8; typedef int16_t i16; typedef int32_t i32; typedef int64_t i64; - typedef uint8_t u8; typedef uint16_t u16; typedef uint32_t u32; diff --git a/include/lcq/pit/utils.h b/include/lcq/pit/utils.h index 6c297ea..b864637 100644 --- a/include/lcq/pit/utils.h +++ b/include/lcq/pit/utils.h @@ -1,22 +1,47 @@ #ifndef LCOLONQ_PIT_UTILS_H #define LCOLONQ_PIT_UTILS_H -#include +#include #include +/* ctype */ +static inline bool pit_ctype_isdigit(int a) { return a >= '0' && a <= '9'; } +static inline bool pit_ctype_islower(int a) { return a >= 'a' && a <= 'z'; } +static inline bool pit_ctype_isupper(int a) { return a >= 'A' && a <= 'Z'; } +static inline bool pit_ctype_isalpha(int a) { return pit_ctype_islower(a) || pit_ctype_isupper(a); } +static inline bool pit_ctype_isprint(int a) { return a >= 0x20 && a <= 0x7f; } +static inline bool pit_ctype_isspace(int a) { return a == ' ' || a == '\r' || a == '\n' || a == '\t'; } + +/* string */ +static inline size_t pit_string_strlen(char *s) { + size_t idx = 0; + while (s[idx] != 0) ++idx; + return idx; +} +static inline u8 *pit_string_memcpy(u8 *dest, u8 *src, size_t n) { + size_t i = 0; + for (; i < n; ++i) dest[i] = src[i]; + return dest; +} +int pit_string_vsnprintf(char *str, size_t size, char *format, va_list ap); +int pit_string_snprintf(char *buf, size_t len, char *format, ...); + /* assorted utilities and debugging tools */ -#define PIT_STRSTR(x) #x -#define PIT_STR(x) PIT_STRSTR(x) -void pit_panic(const char *format, ...); -void pit_debug(const char *format, ...); -#define pit_mul(result, a, b) if (ckd_mul(result, a, b)) pit_panic("integer overflow during multiplication%s",""); +#define pit_mul(result, a, b) *result = (i64) (a) * (i64) (b) /* arenas */ +static inline uintptr_t pit_align_down(uintptr_t addr, uintptr_t align) { + return addr & ~(align - 1); /* easy! just zero the low bits */ +} +static inline uintptr_t pit_align_up(uintptr_t addr, uintptr_t align) { + return (addr + align - 1) /* increment past the next aligned address... */ + & ~(align - 1); /* ...and then zero the low bits */ +} typedef struct { i64 elem_size, capacity, next, back; u8 data[]; } pit_arena; -pit_arena *pit_arena_new(i64 len, i64 elem_size); +pit_arena *pit_arena_new(u8 *buf, i64 buf_len, i64 elem_size); void pit_arena_reset(pit_arena *a); i64 pit_arena_alloc_idx(pit_arena *a); i64 pit_arena_alloc_bulk_idx(pit_arena *a, i64 num); diff --git a/src/lexer.c b/src/lexer.c index 3a741b4..adfe8d3 100644 --- a/src/lexer.c +++ b/src/lexer.c @@ -1,8 +1,3 @@ -#include -#include -#include -#include - #include #include #include @@ -29,14 +24,13 @@ static bool is_more_input(pit_lexer *st) { } static int is_symchar(int c) { - return c != '(' && c != ')' && c != '.' && c != '\'' && c != '"' && isprint(c) && !isspace(c); + return c != '(' && c != ')' && c != '.' && c != '\'' && c != '"' && pit_ctype_isprint(c) && !pit_ctype_isspace(c); } static int is_hexdigit(int c) { - return isdigit(c) || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F'); + return pit_ctype_isdigit(c) || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F'); } - static char peek(pit_lexer *st) { if (is_more_input(st)) return st->input[st->end]; else return 0; @@ -63,16 +57,6 @@ static bool match(pit_lexer *st, int (*f)(int)) { } else return false; } -void pit_lex_cstr(pit_lexer *ret, char *buf) { - ret->input = buf; - ret->len = (i64) strlen(buf); - ret->start = 0; - ret->end = 0; - ret->line = ret->start_line = 1; - ret->column = ret->start_column = 0; - ret->error = NULL; -} - void pit_lex_bytes(pit_lexer *ret, char *buf, i64 len) { ret->len = len; ret->input = buf; @@ -82,21 +66,6 @@ void pit_lex_bytes(pit_lexer *ret, char *buf, i64 len) { ret->column = ret->start_column = 0; ret->error = NULL; } -i64 pit_lex_file(pit_lexer *ret, char *path) { - FILE *f = fopen(path, "r"); - if (f == NULL) { return -1; } - fseek(f, 0, SEEK_END); - i64 len = ftell(f); - fseek(f, 0, SEEK_SET); - char *buf = calloc((size_t) len, sizeof(char)); - if ((size_t) len != fread(buf, sizeof(char), (size_t) len, f)) { - fclose(f); - return -1; - } - fclose(f); - pit_lex_bytes(ret, buf, len); - return 0; -} pit_lex_token pit_lex_next(pit_lexer *st) { restart: @@ -124,8 +93,8 @@ restart: advance(st); return PIT_LEX_TOKEN_STRING_LITERAL; default: - if (isspace(c)) goto restart; - if (isdigit(c)) { + if (pit_ctype_isspace(c)) goto restart; + if (pit_ctype_isdigit(c)) { if (c == '0') { int next = peek(st); if (next != 'x' && next != 'o' && next != 'b') return PIT_LEX_TOKEN_INTEGER_LITERAL; @@ -139,3 +108,13 @@ restart: } } } + +void pit_lex_cstr(pit_lexer *ret, char *buf) { + ret->input = buf; + ret->len = (i64) pit_string_strlen(buf); + ret->start = 0; + ret->end = 0; + ret->line = ret->start_line = 1; + ret->column = ret->start_column = 0; + ret->error = NULL; +} diff --git a/src/library.c b/src/library.c index 7966bc4..819858d 100644 --- a/src/library.c +++ b/src/library.c @@ -1,7 +1,3 @@ -#include -#include -#include - #include #include #include @@ -94,7 +90,7 @@ static pit_value impl_m_defstruct(pit_runtime *rt, pit_value args) { if (nm_len < 0) return PIT_NIL; nm_str[nm_len] = 0; /* constructor */ - snprintf(buf, sizeof(buf), ":%s", nm_str); + pit_string_snprintf(buf, sizeof(buf), ":%s", nm_str); aargs = pit_cons(rt, pit_intern_cstr(rt, buf), pit_cons(rt, pit_intern_cstr(rt, "array"), PIT_NIL)); fields = pit_cdr(rt, args); while (fields != PIT_NIL) { @@ -104,14 +100,14 @@ static pit_value impl_m_defstruct(pit_runtime *rt, pit_value args) { ); if (field_len < 0) return PIT_NIL; field_str[field_len] = 0; - snprintf(buf, sizeof(buf), ":%s", field_str); + pit_string_snprintf(buf, sizeof(buf), ":%s", field_str); aargs = pit_cons(rt, pit_list(rt, 3, pit_intern_cstr(rt, "plist/get"), pit_intern_cstr(rt, buf), pit_intern_cstr(rt, "kwargs")), aargs ); fields = pit_cdr(rt, fields); } - snprintf(buf, sizeof(buf), "%s/new", nm_str); + pit_string_snprintf(buf, sizeof(buf), "%s/new", nm_str); df = pit_list(rt, 4, pit_intern_cstr(rt, "defun!"), pit_intern_cstr(rt, buf), @@ -130,7 +126,7 @@ static pit_value impl_m_defstruct(pit_runtime *rt, pit_value args) { if (field_len < 0) return PIT_NIL; field_str[field_len] = 0; /* getter */ - snprintf(buf, sizeof(buf), "%s/get-%s", nm_str, field_str); + pit_string_snprintf(buf, sizeof(buf), "%s/get-%s", nm_str, field_str); df = pit_list(rt, 4, pit_intern_cstr(rt, "defun!"), pit_intern_cstr(rt, buf), @@ -143,7 +139,7 @@ static pit_value impl_m_defstruct(pit_runtime *rt, pit_value args) { ); ret = pit_cons(rt, df, ret); /* setter */ - snprintf(buf, sizeof(buf), "%s/set-%s!", nm_str, field_str); + pit_string_snprintf(buf, sizeof(buf), "%s/set-%s!", nm_str, field_str); df = pit_list(rt, 4, pit_intern_cstr(rt, "defun!"), pit_intern_cstr(rt, buf), @@ -805,45 +801,6 @@ void pit_install_library_essential(pit_runtime *rt) { pit_fset(rt, pit_intern_cstr(rt, "bitwise/rshift"), pit_nativefunc_new(rt, impl_bitwise_rshift)); } -static pit_value impl_diagnostics(pit_runtime *rt, pit_value args) { - (void) args; - fprintf(stderr, "value allocs: %ld\n", rt->heap->next); - return PIT_NIL; -} -static pit_value impl_print(pit_runtime *rt, pit_value args) { - pit_value x = pit_car(rt, args); - char buf[1024] = {0}; - pit_dump(rt, buf, sizeof(buf), x, true); - buf[1023] = 0; - puts(buf); - return x; -} -static pit_value impl_princ(pit_runtime *rt, pit_value args) { - pit_value x = pit_car(rt, args); - char buf[1024] = {0}; - pit_dump(rt, buf, sizeof(buf), x, false); - buf[1023] = 0; - puts(buf); - return x; -} -static pit_value impl_load(pit_runtime *rt, pit_value args) { - pit_value path = pit_car(rt, args); - char pathbuf[1024] = {0}; - i64 len = pit_as_bytes(rt, path, (u8 *) pathbuf, sizeof(pathbuf) - 1); - if (len < 0) { pit_error(rt, "path was not a string"); return PIT_NIL; } - pathbuf[len] = 0; - return pit_load_file(rt, pathbuf); -} -void pit_install_library_io(pit_runtime *rt) { - /* diagnostics */ - pit_fset(rt, pit_intern_cstr(rt, "diagnostics!"), pit_nativefunc_new(rt, impl_diagnostics)); - /* stream IO */ - pit_fset(rt, pit_intern_cstr(rt, "print!"), pit_nativefunc_new(rt, impl_print)); - pit_fset(rt, pit_intern_cstr(rt, "princ!"), pit_nativefunc_new(rt, impl_princ)); - /* disk IO */ - pit_fset(rt, pit_intern_cstr(rt, "load!"), pit_nativefunc_new(rt, impl_load)); -} - static pit_value impl_plist_get(pit_runtime *rt, pit_value args) { pit_value k = pit_car(rt, args); pit_value vs = pit_car(rt, pit_cdr(rt, args)); @@ -870,97 +827,3 @@ void pit_install_library_alist(pit_runtime *rt) { /* association lists */ pit_fset(rt, pit_intern_cstr(rt, "alist/get"), pit_nativefunc_new(rt, impl_alist_get)); } - -struct bytestring { - i64 len, cap; - u8 *data; -}; -static pit_value impl_bs_new(pit_runtime *rt, pit_value args) { - (void) args; - i64 cap = 256; - struct bytestring *bs = malloc(sizeof(struct bytestring)); - bs->len = 0; - bs->cap = cap; - bs->data = calloc((size_t) cap, 1); - return pit_nativedata_new(rt, pit_intern_cstr(rt, "bs"), (void *) bs); -} -static pit_value impl_bs_delete(pit_runtime *rt, pit_value args) { - pit_value v = pit_car(rt, args); - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); - if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; } - if (h->hsort != PIT_VALUE_HEAVY_SORT_NATIVEDATA) { - pit_error(rt, "invalid use of value as bytestring nativedata"); - return PIT_NIL; - } - if (!pit_eq(h->in.nativedata.tag, pit_intern_cstr(rt, "bs"))) { - pit_error(rt, "native value is not a bytestring"); - return PIT_NIL; - } - if (!h->in.nativedata.data) { - pit_error(rt, "bytestring was already freed"); - return PIT_NIL; - } - struct bytestring *bs = h->in.nativedata.data; - if (bs->data) free(bs->data); - bs->data = NULL; - free(bs); - h->in.nativedata.data = NULL; - return PIT_T; -} -static pit_value impl_bs_grow(pit_runtime *rt, pit_value args) { - pit_value vsz = pit_car(rt, args); - pit_value v = pit_car(rt, pit_cdr(rt, args)); - struct bytestring *bs = pit_nativedata_get(rt, pit_intern_cstr(rt, "bs"), v); - if (!bs) return PIT_NIL; - i64 sz = pit_as_integer(rt, vsz); - if (sz > bs->len) { - if (sz > bs->cap) { - while (bs->cap < sz) bs->cap <<= 1; - bs->data = realloc(bs->data, (size_t) bs->cap); - } - bs->len = sz; - } - return v; -} -static pit_value impl_bs_spit(pit_runtime *rt, pit_value args) { - pit_value path = pit_car(rt, args); - char pathbuf[1024] = {0}; - i64 len = pit_as_bytes(rt, path, (u8 *) pathbuf, sizeof(pathbuf) - 1); - if (len < 0) { pit_error(rt, "path was not a string"); return PIT_NIL; } - pathbuf[len] = 0; - pit_value v = pit_car(rt, pit_cdr(rt, args)); - struct bytestring *bs = pit_nativedata_get(rt, pit_intern_cstr(rt, "bs"), v); - if (!bs) return PIT_NIL; - FILE *f = fopen(pathbuf, "w+"); - if (!f) { pit_error(rt, "failed to open file: %s", pathbuf); return PIT_NIL; } - size_t written = fwrite(bs->data, 1, (size_t) bs->len, f); - fclose(f); - if (written != (size_t) bs->len) { - pit_error(rt, "failed to write bytestring to file: %s", pathbuf); - return PIT_NIL; - } - return v; -} -static pit_value impl_bs_write8(pit_runtime *rt, pit_value args) { - pit_value v = pit_car(rt, args); - pit_value vidx = pit_car(rt, pit_cdr(rt, args)); - pit_value vx = pit_car(rt, pit_cdr(rt, pit_cdr(rt, args))); - struct bytestring *bs = pit_nativedata_get(rt, pit_intern_cstr(rt, "bs"), v); - if (!bs) return PIT_NIL; - i64 idx = pit_as_integer(rt, vidx); - u8 x = (u8) pit_as_integer(rt, vx); - if (idx >= bs->len) { - pit_error(rt, "index %d out of bounds in bytestring (length %d)", idx, bs->len); - return PIT_NIL; - } - bs->data[idx] = x; - return v; -} -void pit_install_library_bytestring(pit_runtime *rt) { - /* bytestrings */ - pit_fset(rt, pit_intern_cstr(rt, "bs/new!"), pit_nativefunc_new(rt, impl_bs_new)); - pit_fset(rt, pit_intern_cstr(rt, "bs/delete!"), pit_nativefunc_new(rt, impl_bs_delete)); - pit_fset(rt, pit_intern_cstr(rt, "bs/grow!"), pit_nativefunc_new(rt, impl_bs_grow)); - pit_fset(rt, pit_intern_cstr(rt, "bs/spit!"), pit_nativefunc_new(rt, impl_bs_spit)); - pit_fset(rt, pit_intern_cstr(rt, "bs/write8!"), pit_nativefunc_new(rt, impl_bs_write8)); -} diff --git a/src/main.c b/src/main.c index d2ba8aa..7517763 100644 --- a/src/main.c +++ b/src/main.c @@ -8,7 +8,9 @@ #include int main(int argc, char **argv) { - pit_runtime *rt = pit_runtime_new(); + i64 sz = 256 * 1024 * 1024; + u8 *buf = malloc((size_t) sz); + pit_runtime *rt = pit_runtime_new(buf, sz); pit_install_library_essential(rt); pit_install_library_io(rt); pit_install_library_plist(rt); diff --git a/src/native.c b/src/native.c new file mode 100644 index 0000000..c30833b --- /dev/null +++ b/src/native.c @@ -0,0 +1,291 @@ +#include +#include +#include + +#include +#include +#include +#include + +i64 pit_lex_file(pit_lexer *ret, char *path) { + FILE *f = fopen(path, "r"); + if (f == NULL) { return -1; } + fseek(f, 0, SEEK_END); + i64 len = ftell(f); + fseek(f, 0, SEEK_SET); + char *buf = calloc((size_t) len, sizeof(char)); + if ((size_t) len != fread(buf, sizeof(char), (size_t) len, f)) { + fclose(f); + return -1; + } + fclose(f); + pit_lex_bytes(ret, buf, len); + return 0; +} + +bool pit_runtime_print_error(pit_runtime *rt) { + if (!pit_eq(rt->error, PIT_NIL)) { + char buf[1024] = {0}; + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, rt->error, false); + buf[end] = 0; + fprintf(stderr, "error at line %ld, column %ld: %s\n", rt->error_line, rt->error_column, buf); + return true; + } + return false; +} + +void pit_trace_(pit_runtime *rt, char *format, pit_value v) { + char buf[1024] = {0}; + i64 end = pit_dump(rt, buf, sizeof(buf) - 1, v, true); + buf[end] = 0; + fprintf(stderr, format, buf); +} + +pit_value pit_bytes_new_file(pit_runtime *rt, char *path) { + if (rt->error != PIT_NIL) return PIT_NIL; + FILE *f = fopen(path, "r"); + if (f == NULL) { + pit_error(rt, "failed to open file: %s", path); + return PIT_NIL; + } + fseek(f, 0, SEEK_END); + i64 len = ftell(f); + fseek(f, 0, SEEK_SET); + u8 *dest = pit_arena_alloc_bulk(rt->heap, len); + if (!dest) { pit_error(rt, "failed to allocate bytes"); fclose(f); return PIT_NIL; } + if ((size_t) len != fread(dest, sizeof(char), (size_t) len, f)) { + fclose(f); + pit_error(rt, "failed to read file: %s", path); + return PIT_NIL; + } + fclose(f); + pit_value ret = pit_heavy_new(rt); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); + if (!h) { pit_error(rt, "failed to create new heavy value for bytes"); return PIT_NIL; } + h->hsort = PIT_VALUE_HEAVY_SORT_BYTES; + h->in.bytes.data = dest; + h->in.bytes.len = len; + return ret; +} + +static void check_invariants(pit_runtime *rt) { + if (rt->scratch->next != 0) { + pit_error(rt, "leaked scratch memory! %ld", rt->scratch->next); + } + if (rt->scratch->next != 0) { + pit_error(rt, "leaked scratch memory! %ld", rt->scratch->next); + } +} +pit_value pit_load_file(pit_runtime *rt, char *path) { + pit_lexer lex; + pit_parser parse; + bool eof = false; + pit_value p = PIT_NIL; + pit_value ret = PIT_NIL; + if (pit_lex_file(&lex, path) < 0) { + pit_error(rt, "failed to lex file: %s", path); + return PIT_NIL; + } + pit_parser_from_lexer(&parse, &lex); + while (p = pit_parse(rt, &parse, &eof), !eof) { + check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL; + ret = pit_eval(rt, p); + check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL; + pit_collect_garbage(rt); + check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL; + } + check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL; + return ret; +} + +void pit_repl(pit_runtime *rt) { + size_t bufcap = 8; + char *buf = malloc(bufcap); + i64 len = 0; + pit_runtime_freeze(rt); + check_invariants(rt); if (pit_runtime_print_error(rt)) exit(1); + setbuf(stdout, NULL); + printf("> "); + while ((buf[len++] = (char) getchar()) != EOF) { + if (len >= (i64) bufcap) { + bufcap *= 2; + buf = realloc(buf, bufcap); + } + pit_value res; + pit_lexer lex; + pit_parser parse; + bool eof = false; + pit_value p = PIT_NIL; + i64 depth = 0; + bool lex_error = false; + pit_lex_token tok = PIT_LEX_TOKEN_EOF; + if (buf[len - 1] != '\n') continue; + pit_lex_bytes(&lex, buf, len); + while (!lex_error && (tok = pit_lex_next(&lex)) != PIT_LEX_TOKEN_EOF) { + switch (tok) { + case PIT_LEX_TOKEN_ERROR: lex_error = true; break; + case PIT_LEX_TOKEN_LPAREN: depth += 1; break; + case PIT_LEX_TOKEN_RPAREN: depth -= 1; break; + default: break; + } + } + if (lex_error || depth > 0) continue; + buf[len - 1] = 0; + pit_lex_bytes(&lex, buf, len); + pit_parser_from_lexer(&parse, &lex); + while (p = pit_parse(rt, &parse, &eof), !eof) { + check_invariants(rt); + res = pit_eval(rt, p); + check_invariants(rt); + } + if (pit_runtime_print_error(rt)) { + rt->error = PIT_NIL; + printf("> "); + } else { + char dumpbuf[1024] = {0}; + pit_dump(rt, dumpbuf, sizeof(dumpbuf) - 1, res, true); + pit_collect_garbage(rt); + printf("%s\n> ", dumpbuf); + } + len = 0; + } + if (len >= (i64) sizeof(buf)) { + fprintf(stderr, "expression exceeded REPL buffer size\n"); + } else { + printf("bye!\n"); + } + free(buf); +} + +static pit_value impl_diagnostics(pit_runtime *rt, pit_value args) { + (void) args; + fprintf(stderr, "value allocs: %ld\n", rt->heap->next); + return PIT_NIL; +} +static pit_value impl_print(pit_runtime *rt, pit_value args) { + pit_value x = pit_car(rt, args); + char buf[1024] = {0}; + pit_dump(rt, buf, sizeof(buf), x, true); + buf[1023] = 0; + puts(buf); + return x; +} +static pit_value impl_princ(pit_runtime *rt, pit_value args) { + pit_value x = pit_car(rt, args); + char buf[1024] = {0}; + pit_dump(rt, buf, sizeof(buf), x, false); + buf[1023] = 0; + puts(buf); + return x; +} +static pit_value impl_load(pit_runtime *rt, pit_value args) { + pit_value path = pit_car(rt, args); + char pathbuf[1024] = {0}; + i64 len = pit_as_bytes(rt, path, (u8 *) pathbuf, sizeof(pathbuf) - 1); + if (len < 0) { pit_error(rt, "path was not a string"); return PIT_NIL; } + pathbuf[len] = 0; + return pit_load_file(rt, pathbuf); +} +void pit_install_library_io(pit_runtime *rt) { + /* diagnostics */ + pit_fset(rt, pit_intern_cstr(rt, "diagnostics!"), pit_nativefunc_new(rt, impl_diagnostics)); + /* stream IO */ + pit_fset(rt, pit_intern_cstr(rt, "print!"), pit_nativefunc_new(rt, impl_print)); + pit_fset(rt, pit_intern_cstr(rt, "princ!"), pit_nativefunc_new(rt, impl_princ)); + /* disk IO */ + pit_fset(rt, pit_intern_cstr(rt, "load!"), pit_nativefunc_new(rt, impl_load)); +} + +struct bytestring { + i64 len, cap; + u8 *data; +}; +static pit_value impl_bs_new(pit_runtime *rt, pit_value args) { + (void) args; + i64 cap = 256; + struct bytestring *bs = malloc(sizeof(struct bytestring)); + bs->len = 0; + bs->cap = cap; + bs->data = calloc((size_t) cap, 1); + return pit_nativedata_new(rt, pit_intern_cstr(rt, "bs"), (void *) bs); +} +static pit_value impl_bs_delete(pit_runtime *rt, pit_value args) { + pit_value v = pit_car(rt, args); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; } + if (h->hsort != PIT_VALUE_HEAVY_SORT_NATIVEDATA) { + pit_error(rt, "invalid use of value as bytestring nativedata"); + return PIT_NIL; + } + if (!pit_eq(h->in.nativedata.tag, pit_intern_cstr(rt, "bs"))) { + pit_error(rt, "native value is not a bytestring"); + return PIT_NIL; + } + if (!h->in.nativedata.data) { + pit_error(rt, "bytestring was already freed"); + return PIT_NIL; + } + struct bytestring *bs = h->in.nativedata.data; + if (bs->data) free(bs->data); + bs->data = NULL; + free(bs); + h->in.nativedata.data = NULL; + return PIT_T; +} +static pit_value impl_bs_grow(pit_runtime *rt, pit_value args) { + pit_value vsz = pit_car(rt, args); + pit_value v = pit_car(rt, pit_cdr(rt, args)); + struct bytestring *bs = pit_nativedata_get(rt, pit_intern_cstr(rt, "bs"), v); + if (!bs) return PIT_NIL; + i64 sz = pit_as_integer(rt, vsz); + if (sz > bs->len) { + if (sz > bs->cap) { + while (bs->cap < sz) bs->cap <<= 1; + bs->data = realloc(bs->data, (size_t) bs->cap); + } + bs->len = sz; + } + return v; +} +static pit_value impl_bs_spit(pit_runtime *rt, pit_value args) { + pit_value path = pit_car(rt, args); + char pathbuf[1024] = {0}; + i64 len = pit_as_bytes(rt, path, (u8 *) pathbuf, sizeof(pathbuf) - 1); + if (len < 0) { pit_error(rt, "path was not a string"); return PIT_NIL; } + pathbuf[len] = 0; + pit_value v = pit_car(rt, pit_cdr(rt, args)); + struct bytestring *bs = pit_nativedata_get(rt, pit_intern_cstr(rt, "bs"), v); + if (!bs) return PIT_NIL; + FILE *f = fopen(pathbuf, "w+"); + if (!f) { pit_error(rt, "failed to open file: %s", pathbuf); return PIT_NIL; } + size_t written = fwrite(bs->data, 1, (size_t) bs->len, f); + fclose(f); + if (written != (size_t) bs->len) { + pit_error(rt, "failed to write bytestring to file: %s", pathbuf); + return PIT_NIL; + } + return v; +} +static pit_value impl_bs_write8(pit_runtime *rt, pit_value args) { + pit_value v = pit_car(rt, args); + pit_value vidx = pit_car(rt, pit_cdr(rt, args)); + pit_value vx = pit_car(rt, pit_cdr(rt, pit_cdr(rt, args))); + struct bytestring *bs = pit_nativedata_get(rt, pit_intern_cstr(rt, "bs"), v); + if (!bs) return PIT_NIL; + i64 idx = pit_as_integer(rt, vidx); + u8 x = (u8) pit_as_integer(rt, vx); + if (idx >= bs->len) { + pit_error(rt, "index %d out of bounds in bytestring (length %d)", idx, bs->len); + return PIT_NIL; + } + bs->data[idx] = x; + return v; +} +void pit_install_library_bytestring(pit_runtime *rt) { + /* bytestrings */ + pit_fset(rt, pit_intern_cstr(rt, "bs/new!"), pit_nativefunc_new(rt, impl_bs_new)); + pit_fset(rt, pit_intern_cstr(rt, "bs/delete!"), pit_nativefunc_new(rt, impl_bs_delete)); + pit_fset(rt, pit_intern_cstr(rt, "bs/grow!"), pit_nativefunc_new(rt, impl_bs_grow)); + pit_fset(rt, pit_intern_cstr(rt, "bs/spit!"), pit_nativefunc_new(rt, impl_bs_spit)); + pit_fset(rt, pit_intern_cstr(rt, "bs/write8!"), pit_nativefunc_new(rt, impl_bs_write8)); +} diff --git a/src/parser.c b/src/parser.c index 7d66061..5dc57db 100644 --- a/src/parser.c +++ b/src/parser.c @@ -1,7 +1,3 @@ -#include -#include -#include - #include #include #include @@ -33,7 +29,7 @@ static bool match(pit_parser *st, pit_lex_token t) { static void get_token_string(pit_parser *st, char *buf, i64 len) { i64 diff = st->cur.end - st->cur.start; i64 tlen = diff >= len ? len - 1 : diff; - memcpy(buf, st->lexer->input + st->cur.start, (size_t) tlen); + pit_string_memcpy((u8 *) buf, (u8 *) st->lexer->input + st->cur.start, (size_t) tlen); buf[tlen] = 0; } @@ -154,7 +150,7 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { case PIT_LEX_TOKEN_STRING_LITERAL: { char buf[256] = {0}; get_token_string(st, buf, sizeof(buf)); - i64 len = (i64) strlen(buf); + i64 len = (i64) pit_string_strlen(buf); i64 cur = 0; for (i64 i = 1; i < len; ++i) { if (buf[i] == '\\' && i + 1 < len) buf[cur++] = buf[++i]; diff --git a/src/runtime.c b/src/runtime.c index 6f3759f..7c15a0a 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -1,10 +1,3 @@ -#include -#include -#include -#include -#include -#include - #include #include #include @@ -29,17 +22,22 @@ u64 pit_value_data(pit_value v) { return v & 0x1ffffffffffff; } -pit_runtime *pit_runtime_new() { - pit_runtime *ret = malloc(sizeof(*ret)); - ret->heap = pit_arena_new(64 * 1024 * 1024, sizeof(pit_value_heavy)); - ret->backbuffer = pit_arena_new(64 * 1024 * 1024, sizeof(pit_value_heavy)); - ret->symtab = pit_arena_new(1024 * 1024, sizeof(pit_symtab_entry)); +pit_runtime *pit_runtime_new(u8 *buf, i64 len) { + pit_arena *a = pit_arena_new(buf, len, sizeof(u8)); + pit_runtime *ret = pit_arena_alloc_back(a, sizeof(*ret)); + i64 heap_size = 64 * 1024 * 1024; + i64 symtab_size = 1024 * 1024; + i64 scratch_size = 1024 * 1024; + i64 stack_size = 64 * 1024; + ret->heap = pit_arena_new(pit_arena_alloc_back(a, heap_size), heap_size, sizeof(pit_value_heavy)); + ret->backbuffer = pit_arena_new(pit_arena_alloc_back(a, heap_size), heap_size, sizeof(pit_value_heavy)); + ret->symtab = pit_arena_new(pit_arena_alloc_back(a, symtab_size), symtab_size, sizeof(pit_symtab_entry)); ret->symtab_len = 0; - ret->scratch = pit_arena_new(1024 * 1024, sizeof(u8)); - ret->expr_stack = pit_values_new(64 * 1024); - ret->result_stack = pit_values_new(64 * 1024); - ret->program = pit_runtime_eval_program_new(64 * 1024); - ret->saved_bindings = pit_values_new(64 * 1024); + ret->scratch = pit_arena_new(pit_arena_alloc_back(a, scratch_size), scratch_size, sizeof(u8)); + ret->expr_stack = pit_values_new(pit_arena_alloc_back(a, stack_size), stack_size); + ret->result_stack = pit_values_new(pit_arena_alloc_back(a, stack_size), stack_size); + ret->program = pit_runtime_eval_program_new(pit_arena_alloc_back(a, stack_size), stack_size); + ret->saved_bindings = pit_values_new(pit_arena_alloc_back(a, stack_size), stack_size); ret->frozen_values = 0; ret->frozen_symtab = 0; ret->error = PIT_NIL; @@ -61,16 +59,6 @@ void pit_runtime_reset(pit_runtime *rt) { rt->heap->next = rt->frozen_values; rt->symtab->next = rt->frozen_symtab; } -bool pit_runtime_print_error(pit_runtime *rt) { - if (!pit_eq(rt->error, PIT_NIL)) { - char buf[1024] = {0}; - i64 end = pit_dump(rt, buf, sizeof(buf) - 1, rt->error, false); - buf[end] = 0; - fprintf(stderr, "error at line %ld, column %ld: %s\n", rt->error_line, rt->error_column, buf); - return true; - } - return false; -} #define CHECK_BUF if (buf >= end) { return buf - start; } #define CHECK_BUF_LABEL(label) if (buf >= end) { goto label; } @@ -79,9 +67,9 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { if (len <= 0) return 0; switch (pit_value_sort(v)) { case PIT_VALUE_SORT_DOUBLE: - return snprintf(buf, (size_t) len, "%lf", pit_as_double(rt, v)); + return pit_string_snprintf(buf, (size_t) len, "%lf", pit_as_double(rt, v)); case PIT_VALUE_SORT_INTEGER: - return snprintf(buf, (size_t) len, "%ld", pit_as_integer(rt, v)); + return pit_string_snprintf(buf, (size_t) len, "%ld", pit_as_integer(rt, v)); case PIT_VALUE_SORT_SYMBOL: { pit_symtab_entry *ent = pit_symtab_lookup(rt, v); if (ent @@ -94,7 +82,7 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { } return i; } else { - return snprintf(buf, (size_t) len, "", pit_as_symbol(rt, v)); + return pit_string_snprintf(buf, (size_t) len, "", pit_as_symbol(rt, v)); } } case PIT_VALUE_SORT_REF: { @@ -102,7 +90,7 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { char *end = buf + len; char *start = buf; h = pit_deref(rt, r); - if (!h) snprintf(buf, (size_t) len, "", r); + if (!h) pit_string_snprintf(buf, (size_t) len, "", r); else { switch (h->hsort) { case PIT_VALUE_HEAVY_SORT_CELL: { @@ -119,7 +107,7 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { CHECK_BUF_LABEL(list_end); *(buf++) = ' '; CHECK_BUF_LABEL(list_end); buf += pit_dump(rt, buf, end - buf, pit_car(rt, cur), readable); } else { - CHECK_BUF_LABEL(list_end); buf += snprintf(buf, (size_t) (end - buf), " . "); + CHECK_BUF_LABEL(list_end); buf += pit_string_snprintf(buf, (size_t) (end - buf), " . "); CHECK_BUF_LABEL(list_end); buf += pit_dump(rt, buf, end - buf, cur, readable); } } while (!pit_eq((cur = pit_cdr(rt, cur)), PIT_NIL)); @@ -158,7 +146,7 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { return i; } default: - return snprintf(buf, (size_t) len, "", r); + return pit_string_snprintf(buf, (size_t) len, "", r); } } break; @@ -167,19 +155,12 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { return 0; } -void pit_trace_(pit_runtime *rt, const char *format, pit_value v) { - char buf[1024] = {0}; - i64 end = pit_dump(rt, buf, sizeof(buf) - 1, v, true); - buf[end] = 0; - fprintf(stderr, format, buf); -} - -void pit_error(pit_runtime *rt, const char *format, ...) { +void pit_error(pit_runtime *rt, char *format, ...) { if (rt->error == PIT_NIL) { /* only record the first error encountered */ char buf[1024] = {0}; va_list vargs; va_start(vargs, format); - vsnprintf(buf, sizeof(buf), format, vargs); + pit_string_snprintf(buf, sizeof(buf), format, vargs); va_end(vargs); rt->error = PIT_T; /* we set the error now to prevent infinite recursion */ rt->error = pit_bytes_new_cstr(rt, buf); /* in case this errs also */ @@ -379,7 +360,7 @@ bool pit_equal(pit_runtime *rt, pit_value a, pit_value b) { pit_value pit_bytes_new(pit_runtime *rt, u8 *buf, i64 len) { u8 *dest = pit_arena_alloc_back(rt->heap, len); if (!dest) { pit_error(rt, "failed to allocate bytes"); return PIT_NIL; } - memcpy(dest, buf, (size_t) len); + pit_string_memcpy(dest, buf, (size_t) len); pit_value ret = pit_heavy_new(rt); pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for bytes"); return PIT_NIL; } @@ -389,33 +370,7 @@ pit_value pit_bytes_new(pit_runtime *rt, u8 *buf, i64 len) { return ret; } pit_value pit_bytes_new_cstr(pit_runtime *rt, char *s) { - return pit_bytes_new(rt, (u8 *) s, (i64) strlen(s)); -} -pit_value pit_bytes_new_file(pit_runtime *rt, char *path) { - if (rt->error != PIT_NIL) return PIT_NIL; - FILE *f = fopen(path, "r"); - if (f == NULL) { - pit_error(rt, "failed to open file: %s", path); - return PIT_NIL; - } - fseek(f, 0, SEEK_END); - i64 len = ftell(f); - fseek(f, 0, SEEK_SET); - u8 *dest = pit_arena_alloc_bulk(rt->heap, len); - if (!dest) { pit_error(rt, "failed to allocate bytes"); fclose(f); return PIT_NIL; } - if ((size_t) len != fread(dest, sizeof(char), (size_t) len, f)) { - fclose(f); - pit_error(rt, "failed to read file: %s", path); - return PIT_NIL; - } - fclose(f); - pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); - if (!h) { pit_error(rt, "failed to create new heavy value for bytes"); return PIT_NIL; } - h->hsort = PIT_VALUE_HEAVY_SORT_BYTES; - h->in.bytes.data = dest; - h->in.bytes.len = len; - return ret; + return pit_bytes_new(rt, (u8 *) s, (i64) pit_string_strlen(s)); } /* return true if v is a reference to bytes that are the same as those in buf */ bool pit_bytes_match(pit_runtime *rt, pit_value v, u8 *buf, i64 len) { @@ -465,7 +420,7 @@ pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len) { return pit_symbol_new(rt, idx); } pit_value pit_intern_cstr(pit_runtime *rt, char *nm) { - return pit_intern(rt, (u8 *) nm, (i64) strlen(nm)); + return pit_intern(rt, (u8 *) nm, (i64) pit_string_strlen(nm)); } pit_value pit_symbol_name(pit_runtime *rt, pit_value sym) { pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); @@ -478,7 +433,7 @@ bool pit_symbol_name_match(pit_runtime *rt, pit_value sym, u8 *buf, i64 len) { return pit_bytes_match(rt, ent->name, buf, len); } bool pit_symbol_name_match_cstr(pit_runtime *rt, pit_value sym, char *s) { - return pit_symbol_name_match(rt, sym, (u8 *) s, (i64) strlen(s)); + return pit_symbol_name_match(rt, sym, (u8 *) s, (i64) pit_string_strlen(s)); } pit_symtab_entry *pit_symtab_lookup(pit_runtime *rt, pit_value sym) { pit_symbol s = pit_as_symbol(rt, sym); @@ -624,7 +579,7 @@ pit_value pit_array_from_buf(pit_runtime *rt, pit_value *xs, i64 len) { pit_value ret = pit_array_new(rt, len); pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to deref heavy value for array"); return PIT_NIL; } - memcpy(h->in.array.data, xs, (size_t) len * (size_t) sizeof(pit_value)); + pit_string_memcpy((u8 *) h->in.array.data, (u8 *) xs, (size_t) len * (size_t) sizeof(pit_value)); return ret; } i64 pit_array_len(pit_runtime *rt, pit_value arr) { @@ -944,9 +899,14 @@ void *pit_nativedata_get(pit_runtime *rt, pit_value tag, pit_value v) { return h->in.nativedata.data; } -pit_values *pit_values_new(i64 capacity) { - i64 cap = capacity / (i64) sizeof(pit_value); - pit_values *ret = malloc(sizeof(*ret) + (size_t) cap * sizeof(pit_value)); +pit_values *pit_values_new(u8 *buf, i64 buf_len) { + uintptr_t base = (uintptr_t) buf; + uintptr_t aligned = pit_align_up(base, sizeof(void *)); + pit_values *ret = (pit_values *) aligned; + uintptr_t data = aligned + sizeof(pit_values); + i64 offset = (i64) data - (i64) base; + i64 remaining = (i64) (buf_len - offset); + i64 cap = remaining / (i64) sizeof(pit_value); ret->next = 0; ret->capacity = cap; return ret; @@ -961,9 +921,14 @@ pit_value pit_values_pop(pit_runtime *rt, pit_values *s) { return s->data[--s->next]; } -pit_runtime_eval_program *pit_runtime_eval_program_new(i64 capacity) { - i64 cap = capacity / (i64) sizeof(pit_runtime_eval_program_entry); - pit_runtime_eval_program *ret = malloc(sizeof(*ret) + (size_t) cap * sizeof(pit_runtime_eval_program_entry)); +pit_runtime_eval_program *pit_runtime_eval_program_new(u8 *buf, i64 buf_len) { + uintptr_t base = (uintptr_t) buf; + uintptr_t aligned = pit_align_up(base, sizeof(void *)); + pit_runtime_eval_program *ret = (pit_runtime_eval_program *) aligned; + uintptr_t data = aligned + sizeof(pit_arena); + i64 offset = (i64) data - (i64) base; + i64 remaining = (i64) (buf_len - offset); + i64 cap = remaining / (i64) sizeof(pit_runtime_eval_program_entry); ret->next = 0; ret->capacity = cap; return ret; @@ -1240,93 +1205,18 @@ void pit_collect_garbage(pit_runtime *rt) { rt->backbuffer = fromspace; } -static void check_invariants(pit_runtime *rt) { - if (rt->scratch->next != 0) { - pit_error(rt, "leaked scratch memory! %ld", rt->scratch->next); - } - if (rt->scratch->next != 0) { - pit_error(rt, "leaked scratch memory! %ld", rt->scratch->next); - } -} - -pit_value pit_load_file(pit_runtime *rt, char *path) { +int pit_runtime_test(u8 *out, i64 out_len, u8 *buf, i64 len) { + pit_runtime *rt = pit_runtime_new(buf, len); + pit_install_library_essential(rt); + pit_install_library_plist(rt); + pit_install_library_alist(rt); pit_lexer lex; pit_parser parse; - bool eof = false; - pit_value p = PIT_NIL; - pit_value ret = PIT_NIL; - if (pit_lex_file(&lex, path) < 0) { - pit_error(rt, "failed to lex file: %s", path); - return PIT_NIL; - } + pit_lex_cstr(&lex, "(cons (list 1 2 3) (cons '(a b c) 21))"); pit_parser_from_lexer(&parse, &lex); - while (p = pit_parse(rt, &parse, &eof), !eof) { - check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL; - ret = pit_eval(rt, p); - check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL; - pit_collect_garbage(rt); - check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL; - } - check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL; - fprintf(stderr, "value allocs at exit: %ld\n", rt->heap->next); - return ret; -} - -void pit_repl(pit_runtime *rt) { - size_t bufcap = 8; - char *buf = malloc(bufcap); - i64 len = 0; - pit_runtime_freeze(rt); - check_invariants(rt); if (pit_runtime_print_error(rt)) exit(1); - setbuf(stdout, NULL); - printf("> "); - while ((buf[len++] = (char) getchar()) != EOF) { - if (len >= (i64) bufcap) { - bufcap *= 2; - buf = realloc(buf, bufcap); - } - pit_value res; - pit_lexer lex; - pit_parser parse; - bool eof = false; - pit_value p = PIT_NIL; - i64 depth = 0; - bool lex_error = false; - pit_lex_token tok = PIT_LEX_TOKEN_EOF; - if (buf[len - 1] != '\n') continue; - pit_lex_bytes(&lex, buf, len); - while (!lex_error && (tok = pit_lex_next(&lex)) != PIT_LEX_TOKEN_EOF) { - switch (tok) { - case PIT_LEX_TOKEN_ERROR: lex_error = true; break; - case PIT_LEX_TOKEN_LPAREN: depth += 1; break; - case PIT_LEX_TOKEN_RPAREN: depth -= 1; break; - default: break; - } - } - if (lex_error || depth > 0) continue; - buf[len - 1] = 0; - pit_lex_bytes(&lex, buf, len); - pit_parser_from_lexer(&parse, &lex); - while (p = pit_parse(rt, &parse, &eof), !eof) { - check_invariants(rt); - res = pit_eval(rt, p); - check_invariants(rt); - } - if (pit_runtime_print_error(rt)) { - rt->error = PIT_NIL; - printf("> "); - } else { - char dumpbuf[1024] = {0}; - pit_dump(rt, dumpbuf, sizeof(dumpbuf) - 1, res, true); - pit_collect_garbage(rt); - printf("%s\n> ", dumpbuf); - } - len = 0; - } - if (len >= (i64) sizeof(buf)) { - fprintf(stderr, "expression exceeded REPL buffer size\n"); - } else { - printf("bye!\n"); - } - free(buf); + bool eof = false; + pit_value p = pit_parse(rt, &parse, &eof); + pit_value res = pit_eval(rt, p); + pit_dump(rt, (char *) out, out_len, res, false); + return 0; } diff --git a/src/utils.c b/src/utils.c index 5f9d49e..7f2831b 100644 --- a/src/utils.c +++ b/src/utils.c @@ -1,41 +1,116 @@ -#include -#include -#include - #include -void pit_panic(const char *format, ...) { - va_list vargs; - va_start(vargs, format); - vfprintf(stderr, format, vargs); - va_end(vargs); - exit(1); -} - -void pit_debug(const char *format, ...) { - va_list vargs; - va_start(vargs, format); - vfprintf(stderr, format, vargs); - va_end(vargs); +enum vsnprintf_mode { + VSNPRINTF_MODE_NORMAL, + VSNPRINTF_MODE_FLAGS, + VSNPRINTF_MODE_WIDTH, + VSNPRINTF_MODE_PRECISION, + VSNPRINTF_MODE_LENGTH_MOD, + VSNPRINTF_MODE_CONVERSION_SPEC +}; +#define SCRATCH_LEN 256 +#define WRITE(c) { buf[idx++] = c; if (idx >= len - 1) goto done; } +#define WRITE_SCRATCH(c) { scratch[sidx++] = c; if (sidx >= SCRATCH_LEN) goto error; } +int pit_string_vsnprintf(char *buf, size_t len, char *format, va_list ap) { + // vsnprintf + size_t idx = 0; + size_t flen = pit_string_strlen(format); + size_t fidx = 0; + enum vsnprintf_mode mode = VSNPRINTF_MODE_NORMAL; + size_t sidx = 0; + char scratch[SCRATCH_LEN] = {0}; + char length_mod = 0; + for (; fidx < flen && idx < len - 1; ++fidx) { + char c = format[fidx]; + sidx = 0; + switch (mode) { + case VSNPRINTF_MODE_NORMAL: + if (c == '%') { + mode = VSNPRINTF_MODE_FLAGS; + } else WRITE(c); + break; + case VSNPRINTF_MODE_FLAGS: + case VSNPRINTF_MODE_WIDTH: + case VSNPRINTF_MODE_PRECISION: + case VSNPRINTF_MODE_LENGTH_MOD: + switch (c) { + case 'l': length_mod = 'l'; mode = VSNPRINTF_MODE_CONVERSION_SPEC; continue; + } + // fallthrough + case VSNPRINTF_MODE_CONVERSION_SPEC: + switch (c) { + case '%': WRITE('%'); mode = VSNPRINTF_MODE_NORMAL; break; + case 'd': { + long arg = 0; + if (length_mod == 'l') arg = va_arg(ap, long); else arg = va_arg(ap, int); + if (arg == 0) { WRITE('0') } + else { + while (arg != 0) { WRITE_SCRATCH('0' + (char) (arg % 10)); arg /= 10; } + while (sidx > 0) { WRITE(scratch[sidx - 1]); sidx -= 1; } + } + mode = VSNPRINTF_MODE_NORMAL; + break; + } + case 'f': { + double arg = 0.0; + if (length_mod == 'l') + arg = va_arg(ap, double); + else + arg = va_arg(ap, double); + long wholepart = (long) arg; + double fracpart = arg - (double) wholepart; + if (wholepart == 0) { WRITE('0') } + else { + while (wholepart != 0) { WRITE_SCRATCH('0' + (char) (wholepart % 10)); wholepart /= 10; } + while (sidx > 0) { WRITE(scratch[sidx - 1]); sidx -= 1; } + } + WRITE('.'); + for (int i = 0; i < 6; ++i) { + fracpart *= 10.0; + wholepart = (long) fracpart; + fracpart -= (double) wholepart; + WRITE('0' + (char) wholepart); + } + mode = VSNPRINTF_MODE_NORMAL; + break; + } + case 's': { + char *arg = va_arg(ap, char *); + while (*arg != 0) { WRITE(*arg); arg += 1; } + mode = VSNPRINTF_MODE_NORMAL; + break; + } + default: goto error; + } + break; + } + } +done: + buf[idx] = 0; + return (int) idx; +error: + return -1; } - -static uintptr_t pit_align_down(uintptr_t addr, uintptr_t align) { - return addr & ~(align - 1); /* easy! just zero the low bits */ -} -static uintptr_t pit_align_up(uintptr_t addr, uintptr_t align) { - return (addr + align - 1) /* increment past the next aligned address... */ - & ~(align - 1); /* ...and then zero the low bits */ +int pit_string_snprintf(char *buf, size_t len, char *format, ...) { + va_list ap; + va_start(ap, format); + int ret = pit_string_vsnprintf(buf, len, format, ap); + va_end(ap); + return ret; } -pit_arena *pit_arena_new(i64 capacity, i64 elem_size) { - i64 byte_len = 0; - pit_mul(&byte_len, elem_size, capacity); - pit_arena *a = (pit_arena *) malloc(sizeof(pit_arena) + (size_t) byte_len); - if (!a || byte_len <= 0) return NULL; +pit_arena *pit_arena_new(u8 *buf, i64 buf_len, i64 elem_size) { + uintptr_t base = (uintptr_t) buf; + uintptr_t aligned = pit_align_up(base, sizeof(void *)); + pit_arena *a = (pit_arena *) aligned; + uintptr_t data = aligned + sizeof(pit_arena); + i64 offset = (i64) data - (i64) base; + i64 remaining = (i64) pit_align_down((uintptr_t) (buf_len - offset), sizeof(void *)); + if (!a || remaining <= 0) return NULL; a->elem_size = elem_size; - a->capacity = byte_len / elem_size; + a->capacity = remaining / elem_size; a->next = 0; - a->back = byte_len; + a->back = remaining; return a; } void pit_arena_reset(pit_arena *a) { -- cgit v1.2.3