/* * main.c — REPL, script mode, -e mode */ #include "lumbda.h" #include "jit.h" /* ═══════════════════════════════════════════════════════════════════════════ * Find stdlib.lsp relative to the executable * ═══════════════════════════════════════════════════════════════════════════ */ static char *find_stdlib(const char *argv0) { /* Try relative to executable: ../stdlib.lsp */ char path[4096]; /* Try via /proc/self/exe on Linux */ ssize_t n = readlink("/proc/self/exe", path, sizeof(path) - 1); if (n > 0) { path[n] = '\0'; /* Go up one directory (from c/lumbda to lumbda/) */ char *slash = strrchr(path, '/'); if (slash) { *slash = '\0'; slash = strrchr(path, '/'); if (slash) { slash[1] = '\0'; strcat(path, "stdlib.lsp"); if (access(path, R_OK) == 0) return ul_strdup(path); } } } /* Try current directory */ if (access("stdlib.lsp", R_OK) == 0) return ul_strdup("stdlib.lsp"); /* Try relative to argv0 */ if (argv0) { const char *slash = strrchr(argv0, '/'); if (slash) { size_t dir_len = slash - argv0; snprintf(path, sizeof(path), "%.*s/../stdlib.lsp", (int)dir_len, argv0); if (access(path, R_OK) == 0) return ul_strdup(path); } } return NULL; } /* ═══════════════════════════════════════════════════════════════════════════ * REPL * ═══════════════════════════════════════════════════════════════════════════ */ static void repl(Env *env) { char *version_str = show(env_lookup(env, intern("*version*")), true); printf("lumbda %s (C) — (exit) to quit, (load \"file.lsp\") to load\n", version_str); ul_free(version_str); char buf[16384]; buf[0] = '\0'; size_t buf_len = 0; while (1) { printf(buf_len > 0 ? " " : "λ> "); fflush(stdout); char line[4096]; if (!fgets(line, sizeof(line), stdin)) { if (buf_len > 0) { buf[0] = '\0'; buf_len = 0; printf("\n"); continue; } printf("\n"); break; } size_t line_len = strlen(line); if (buf_len + line_len >= sizeof(buf) - 1) { buf[0] = '\0'; buf_len = 0; continue; } memcpy(buf + buf_len, line, line_len); buf_len += line_len; buf[buf_len] = '\0'; /* Check for balanced parens */ int depth = 0; for (size_t i = 0; i < buf_len; i++) { if (buf[i] == '(') depth++; else if (buf[i] == ')') depth--; } if (depth > 0) continue; /* Try to parse */ int count; Value *exprs; TRY(ctx) { exprs = read_all(buf, &count, false); } CATCH { if (depth > 0) continue; buf[0] = '\0'; buf_len = 0; continue; } ENDTRY; if (count == 0) { buf[0] = '\0'; buf_len = 0; continue; } for (int i = 0; i < count; i++) { TRY(ctx) { Value result = leval(exprs[i], env); if (!IS_VOID(result)) { print_value(result, false, stdout); printf("\n"); } } CATCH { fprintf(stderr, "error: %s\n", ctx.message); } ENDTRY; } ul_free(exprs); buf[0] = '\0'; buf_len = 0; } } /* ═══════════════════════════════════════════════════════════════════════════ * Main * ═══════════════════════════════════════════════════════════════════════════ */ int main(int argc, char **argv) { int stack_anchor; #ifdef USE_BOEHM_GC /* GC_INIT registers our stack base for conservative scan. Without it, * roots can be missed on some Linux configs. * * lumbda_gc_init registers a custom mark kind for NaN-boxed Value * buffers (see gc.c). Boehm's conservative scan treats NaN-boxed * Values as plain bit patterns & misses the embedded pointers, so * any allocation that carries Values (Pair, Env bindings, Vector * data[], CodeObj instrs[], ValueStack data[], etc.) routes through * lumbda_value_malloc / ul_malloc_values which tags the block with * our kind. Our mark proc then walks the words & pushes each * pointer-bearing tag's payload onto Boehm's mark stack. * * lumbda_gc_set_stack_base hands gc.c the top-of-stack so its * push_other_roots callback can scan the same range for on-stack * NaN-boxed Values that Boehm's pure conservative scan misses. */ GC_INIT(); lumbda_gc_init(); lumbda_gc_set_stack_base(&stack_anchor); #else (void)stack_anchor; #endif init_symbols(); Env *g = make_global_env(); /* Load prelude */ { int count; Value *exprs = read_all(PRELUDE, &count, false); for (int i = 0; i < count; i++) leval(exprs[i], g); ul_free(exprs); } /* Parse args */ int argi = 1; /* Default stays tree-walker for now. Flipping to --fast as default * exposed a cumulative-state buffer overflow in the bytecode * compiler that only triggers across the full 189-test functional * suite, not in isolated scripts. Tracked as a TODO. For deeply * recursive workloads (e.g. ackermann(3,8)) pass --fast explicitly * or `ulimit -s unlimited` before invoking the tree-walker. */ bool fast = false; bool help = false; bool version = false; bool jit = false; const char *eval_expr = NULL; while (argi < argc) { if (strcmp(argv[argi], "--jit") == 0 || strcmp(argv[argi], "-j") == 0) { jit = true; argi++; } else if (strcmp(argv[argi], "--fast") == 0 || strcmp(argv[argi], "-f") == 0) { fast = true; argi++; } else if (strcmp(argv[argi], "--help") == 0 || strcmp(argv[argi], "-h") == 0) { help = true; argi++; } else if (strcmp(argv[argi], "--version") == 0 || strcmp(argv[argi], "-v") == 0) { version = true; argi++; } else if (strcmp(argv[argi], "-e") == 0 && argi + 1 < argc) { eval_expr = argv[argi + 1]; argi += 2; } else { break; } } if (help) { printf("lumbda — a Scheme interpreter in C\n\n" "Usage: lumbda [options] [script.lsp] [args...]\n" " lumbda -e '(+ 1 2)'\n" " lumbda (interactive REPL)\n\n" "Options:\n" " -e EXPR evaluate expression and print result\n" " -f, --fast auto-compile all defines (bytecode VM;\n" " required for deep recursion, e.g. ackermann(3,8))\n" " -j, --jit enable x86_64 JIT compiler for eligible functions\n" " -h, --help show this help\n" " -v, --version show version\n\n" "Features: R7RS core, bytecode compiler, macros, syntax-rules,\n" " modules, rationals, string ports, x86_64 JIT.\n"); return 0; } if (version) { printf("lumbda 1.0.0 (C)\n"); return 0; } if (fast) g_auto_compile = true; if (jit) g_jit_enabled = true; /* Load stdlib.lsp if it exists */ char *stdlib_path = find_stdlib(argv[0]); if (stdlib_path) { TRY(ctx) { load_file(stdlib_path, g); } CATCH { /* Ignore stdlib load errors — it's optional */ } ENDTRY; ul_free(stdlib_path); } /* -e mode */ if (eval_expr) { TRY(ctx) { int count; Value *exprs = read_all(eval_expr, &count, false); for (int i = 0; i < count; i++) { Value result = leval(exprs[i], g); if (!IS_VOID(result)) { print_value(result, false, stdout); printf("\n"); } } ul_free(exprs); } CATCH { fprintf(stderr, "error: %s\n", g_error_ctx ? g_error_ctx->message : "unknown"); return 1; } ENDTRY; return 0; } /* Script mode */ if (argi < argc) { const char *path = argv[argi]; /* Set *argv* */ int script_argc = argc - argi - 1; Value *script_argv = (Value *)ul_malloc(sizeof(Value) * script_argc); for (int i = 0; i < script_argc; i++) { script_argv[i] = make_string_from_cstr(argv[argi + 1 + i]); } env_define(g, intern("*argv*"), list_to_value(script_argv, script_argc)); ul_free(script_argv); TRY(ctx) { load_file(path, g); } CATCH { fprintf(stderr, "error: %s\n", ctx.message); return 1; } ENDTRY; return 0; } /* REPL mode */ ErrorContext root_ctx; root_ctx.call_stack_depth = 0; root_ctx.error_obj = VAL_NIL; root_ctx.source_line = 0; g_error_ctx = &root_ctx; if (setjmp(root_ctx.jmp) != 0) { fprintf(stderr, "fatal error: %s\n", root_ctx.message); return 1; } repl(g); return 0; }