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 --- src/native.c | 291 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 291 insertions(+) create mode 100644 src/native.c (limited to 'src/native.c') 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)); +} -- cgit v1.2.3