#include "compile.h" #include #include #include #include static ssize_t byte_compile_form_internal(CompileEnvironment *env, AstNode *form, LispReg *target, FILE *stream, CompileError **err); static void push_error_raw(CompileError **list, CompileError *n) { if (list) { n->next = *list; *list = n; } } __attribute__((format(printf, 4, 5))) static void push_error_at_ast(CompileError **list, AstNode *form, CompileErrorType type, const char *fmt, ...) { if (list) { CompileError *err = malloc(sizeof(CompileError)); err->type = type; err->context = ast_prin1_node_to_string(form, NULL); va_list args; va_start(args, fmt); err->message = NULL; vasprintf(&err->message, fmt, args); va_end(args); err->line = form->line; err->col = form->col; push_error_raw(list, err); } } __attribute__((format(printf, 4, 5))) static void push_error_with_ctx(CompileError **list, const char *ctx, CompileErrorType type, const char *fmt, ...) { if (list) { CompileError *err = malloc(sizeof(CompileError)); err->type = type; if (ctx) { err->context = strdup(ctx); } else { err->context = NULL; } va_list args; va_start(args, fmt); err->message = NULL; vasprintf(&err->message, fmt, args); va_end(args); err->line = 0; // no position information err->col = 0; push_error_raw(list, err); } } CompileFormat COMPILE_FORMAT = COMPILE_FORMAT_BIN; typedef enum { ARG_U8, ARG_U16, ARG_U32, ARG_U64, ARG_I8, ARG_I16, ARG_I32, ARG_I64, ARG_REG, ARG_STR, ARG_BYTES, ARG_DOUBLE, ARG_BOOL, } InstArgType; static bool emit_next_arg_c(CompileError **err, FILE *stream, InstArgType type, va_list args) { if (type == ARG_STR || type == ARG_BYTES) { size_t len; if (type == ARG_BYTES) { len = va_arg(args, size_t); } const char *val = va_arg(args, const char *); if (type == ARG_STR) { len = strlen(val); } size_t escaped_len; char *escaped = ast_escape_string(val, len, &escaped_len); fputc('"', stream); fwrite(escaped, 1, escaped_len, stream); fputc('"', stream); free(escaped); return true; } else if (type == ARG_REG) { LispRegType type = va_arg(args, int); // LispRegType promotes to int if (type > N_REGISTTERS) { push_error_with_ctx(err, NULL, COMPILE_ERROR, "unknown register type: %ju", (uintmax_t) type); return false; } uint32_t which = va_arg(args, uint32_t); fprintf(stream, "%s%ju", REGISTER_NAMES[type], (uintmax_t) which); return true; } else if (type == ARG_DOUBLE) { double value = va_arg(args, double); fprintf(stream, "%f", value); return true; } else if (type == ARG_BOOL) { uint32_t value = va_arg(args, uint32_t); if (value) { fprintf(stream, "true"); } else { fprintf(stream, "false"); } return true; } uint64_t val; const char *format; switch (type) { case ARG_U8: // promoted case ARG_U16: // promoted case ARG_U32: val = va_arg(args, uint32_t); format = "%ju"; break; case ARG_U64: val = va_arg(args, uint64_t); format = "%ju"; break; case ARG_I8: case ARG_I16: case ARG_I32: val = va_arg(args, uint32_t); format = "%jd"; break; case ARG_I64: val = va_arg(args, uint64_t); format = "%jd"; break; default: // shouldn't happen abort(); break; } fprintf(stream, format, (uintmax_t) val); return true; } static bool emit_next_arg_bin(CompileError **err, FILE *stream, InstArgType type, va_list args) { if (type == ARG_STR || type == ARG_BYTES) { size_t len; if (type == ARG_BYTES) { len = va_arg(args, size_t); } const char *val = va_arg(args, const char *); if (type == ARG_STR) { len = strlen(val); } fwrite(&len, sizeof(len), 1, stream); fwrite(val, 1, len, stream); return true; } else if (type == ARG_REG) { LispRegType type = va_arg(args, int); // LispRegType promotes to int if (type > N_REGISTTERS) { push_error_with_ctx(err, NULL, COMPILE_ERROR, "unknown register type: %ju", (uintmax_t) type); return false; } uint32_t which = va_arg(args, uint32_t); fwrite(&type, sizeof(type), 1, stream); fwrite(&which, sizeof(which), 1, stream); return true; } else if (type == ARG_DOUBLE) { double val = va_arg(args, double); fwrite(&val, sizeof(val), 1, stream); return true; } size_t size; uint64_t val; switch (type) { case ARG_U8: case ARG_BOOL: case ARG_I8: size = 8; val = va_arg(args, uint32_t); break; case ARG_U16: case ARG_I16: size = 16; val = va_arg(args, uint32_t); break; case ARG_U32: case ARG_I32: size = 32; val = va_arg(args, uint32_t); break; case ARG_U64: case ARG_I64: size = 64; val = va_arg(args, uint64_t); break; default: // shouldn't happen abort(); break; } fwrite(((void *) &val) + sizeof(uint64_t) - size, size, 1, stream); return false; } // false on error, true on success static bool emit_instruction(CompileError **err, FILE *stream, LispInst inst, size_t nargs, ...) { if (inst > N_INSTRUCTIONS) { push_error_with_ctx(err, NULL, COMPILE_ERROR, "unknown instruction: %ju", (intmax_t) inst); return false; } switch (COMPILE_FORMAT) { case COMPILE_FORMAT_ASM: fprintf(stream, "%s%s", INSTRUCTION_NAMES[inst], nargs ? " " : ""); break; case COMPILE_FORMAT_BIN: fwrite(&inst, sizeof(inst), 1, stream); break; } bool success = true; va_list args; va_start(args, nargs); for (size_t i = 0; i < nargs; ++i) { InstArgType type = va_arg(args, InstArgType); switch (COMPILE_FORMAT) { case COMPILE_FORMAT_ASM: success = emit_next_arg_c(err, stream, type, args); if (i < nargs - 1) { fprintf(stream, ", "); } break; case COMPILE_FORMAT_BIN: success = emit_next_arg_bin(err, stream, type, args); break; } if (!success) { break; } } va_end(args); if (COMPILE_FORMAT == COMPILE_FORMAT_ASM) { fputc('\n', stream); } return success; } CompileError *compile_error_pop(CompileError **err) { CompileError *retval = *err; if (*err) { *err = (*err)->next; } return retval; } void compile_error_free_one(CompileError *err) { free(err->message); free(err->context); free(err); } void compile_error_free_all(CompileError **err) { while (*err) { CompileError *next = (*err)->next; compile_error_free_one(*err); *err = next; } } void compile_format_error(CompileError *err, const char *file, FILE *stream) { fprintf(stream, "error: "); if (file) { fprintf(stream, "%s: ", file); } if (err->line) { fprintf(stream, "%zu:%zu:", err->line, err->col); } fprintf(stream, "%s", err->message); if (err->context) { fprintf(stream, ":\n%s\n", err->context); } else { fputc('\n', stream); } } void destroy_function_entry(FunctionEntry *entry) { free(entry->name); free(entry->doc); for (size_t i = 0; i < entry->nkeys; ++i) { free(entry->keys[i]); } free(entry->keys); } void destroy_variable_entry(VariableEntry *entry) { free(entry->name); free(entry->doc); } void destroy_compile_lexenv(CompileLexenv *lexenv) { for (size_t i = 0; i < lexenv->nsymbols; ++i) { free(lexenv->symbols[i].name); } free(lexenv->symbols); for (size_t i = 0; i < lexenv->nvars; ++i) { free(lexenv->vars[i].name); } free(lexenv->vars); free(lexenv); } static void environment_enter_lexenv(CompileEnvironment *env, bool inherit) { CompileLexenv *n = malloc(sizeof(CompileLexenv)); n->vars = NULL; n->nvars = 0; n->symbols = NULL; n->nsymbols = 0; n->first_avaiable_saved = 0; n->next = env->lexenv_stack; if (inherit && env->lexenv_stack) { n->first_avaiable_saved += env->lexenv_stack->first_avaiable_saved; } n->inherit = inherit; env->lexenv_stack = n; } static void environment_leave_lexenv(CompileEnvironment *env) { if (env->lexenv_stack) { CompileLexenv *next = env->lexenv_stack->next; destroy_compile_lexenv(env->lexenv_stack); env->lexenv_stack = next; } } CompileEnvironment *make_compile_environment() { CompileEnvironment *env = malloc(sizeof(CompileEnvironment)); env->funcs = NULL; env->nfuncs = 0; env->vars = NULL; env->nvars = 0; env->lexenv_stack = NULL; environment_enter_lexenv(env, false); // toplevel lexenv return env; } void destroy_compile_environment(CompileEnvironment *env) { for (size_t i = 0; i < env->nfuncs; ++i) { destroy_function_entry(&env->funcs[i]); } for (size_t i = 0; i < env->nvars; ++i) { destroy_variable_entry(&env->vars[i]); } while (env->lexenv_stack) { CompileLexenv *next = env->lexenv_stack->next; destroy_compile_lexenv(env->lexenv_stack); env->lexenv_stack = next; } free(env); } static bool is_symbol_named(const char *name, AstNode *form) { return form->type == AST_TYPE_SYMBOL && strcmp(name, ((AstSymbolNode *) form)->name) == 0; } static bool is_function_call(AstNode *form) { return form->type == AST_TYPE_LIST && ((AstListNode *) form)->nchildren; } static bool is_function_call_named(const char *name, AstNode *form) { return is_function_call(form) && is_symbol_named(name, ((AstListNode *) form)->children[0]); } static FunctionEntry *lookup_function(CompileEnvironment *env, AstSymbolNode *name) { for (size_t i = 0; i < env->nfuncs; ++i) { FunctionEntry *cur = &env->funcs[i]; if (cur->name_len == name->name_length && strcmp(cur->name, name->name) == 0) { return cur; } } return NULL; } static VariableEntry *lookup_variable(CompileEnvironment *env, AstSymbolNode *name) { for (size_t i = 0; i < env->nvars; ++i) { VariableEntry *cur = &env->vars[i]; if (cur->name_len == name->name_length && strcmp(cur->name, name->name) == 0) { return cur; } } return NULL; } static bool is_property_symbol(AstNode *form) { return form->type == AST_TYPE_SYMBOL && ((AstSymbolNode *) form)->is_property; } static char *copy_symbol_name(AstSymbolNode *sym) { char *buf = malloc(sym->name_length + 1); memcpy(buf, sym->name, sym->name_length + 1); return buf; } static bool function_key_ok(AstSymbolNode *key, FunctionEntry *func) { if (func->allow_other_keys) { return true; } const char *name = key->is_property ? key->name + 1 : key->name; for (size_t i = 0; i < func->nkeys; ++i) { if (strcmp(name, func->keys[i]) == 0) { return true; } } return false; } // return false only if there is an error (not a warning) static bool function_arguments_ok(AstListNode *form, FunctionEntry *func, CompileError **err) { bool was_ok = true; size_t npositional = form->nchildren - 1; bool had_key = false; if (func->nkeys) { for (size_t i = 1; i < form->nchildren; ++i) { if (is_property_symbol(form->children[i])) { if (!function_key_ok((AstSymbolNode *) form->children[i], func)) { push_error_at_ast(err, form->children[i], COMPILE_WARNING, "unknown key for function %s", func->name); } if (i == form->nchildren - 1) { push_error_at_ast(err, form->children[i], COMPILE_ERROR, "no value provided to key"); was_ok = false; } had_key = true; // skip next arg ++i; npositional -= 2; } else if (had_key) { // positional argument after key argument was_ok = false; } } } if (npositional < func->nrequired) { push_error_at_ast(err, (AstNode *) form, COMPILE_ERROR, "function expects at least %zu argument(s), got %zu", func->nrequired, npositional); was_ok = false; } else if (!func->has_rest && npositional > func->nrequired + func->noptional) { push_error_at_ast(err, (AstNode *)form, COMPILE_ERROR, "function expects at most %zu argument(s), got %zu", func->nrequired + func->noptional, npositional); was_ok = false; } return was_ok; } static void intern_in_lexenv(CompileLexenv *lexenv, const char *name, LispReg *reg) { if (lexenv) { lexenv->symbols = realloc(lexenv->symbols, sizeof(*lexenv->symbols) * ++(lexenv->nsymbols)); lexenv->symbols[lexenv->nsymbols - 1].name = strdup(name); lexenv->symbols[lexenv->nsymbols - 1].reg = *reg; } } static LispReg *lookup_symbol_reg(CompileEnvironment *env, const char *name) { CompileLexenv *lexenv = env->lexenv_stack; while (lexenv) { for (size_t i = 0; i < lexenv->nsymbols; ++i) { if (strcmp(name, lexenv->symbols[i].name) == 0) { return &lexenv->symbols[i].reg; } } if (lexenv->inherit) { lexenv = lexenv->next; } else { lexenv = NULL; } } return NULL; } static LispReg *lookup_local_var(CompileEnvironment *env, const char *name) { CompileLexenv *lexenv = env->lexenv_stack; while (lexenv) { for (size_t i = 0; i < lexenv->nvars; ++i) { if (strcmp(name, lexenv->vars[i].name) == 0) { return &lexenv->vars[i].reg; } } if (lexenv->inherit) { lexenv = lexenv->next; } else { lexenv = NULL; } } return NULL; } static void next_open_saved_reg(CompileEnvironment *env, LispReg *out) { out->type = REG_SAVED; if (env->lexenv_stack) { out->which = env->lexenv_stack->first_avaiable_saved++; } else { out->which = 0; } } // return number of instructions emitted, or -1 on error static ssize_t intern_to_register(CompileEnvironment *env, FILE *stream, const char *name, size_t name_len, LispReg *target, CompileError **err) { CompileLexenv *lexenv = env->lexenv_stack; LispReg *cur_reg = lookup_symbol_reg(env, name); if (cur_reg) { if (SAME_REG(cur_reg, target)) { return 0; } if (!emit_instruction(err, stream, INST_MOV, 2, ARG_REG, target->type, target->which, ARG_REG, cur_reg->type, cur_reg->which)) { return -1; } } else { if (!emit_instruction(err, stream, INST_INTERN_LIT, 2, ARG_REG, target->type, target->which, ARG_BYTES, name_len, name)) { return -1; } if (target->type == REG_SAVED) { intern_in_lexenv(lexenv, name, target); } } return 1; } static ssize_t intern_and_save(CompileEnvironment *env, FILE *stream, const char *name, size_t name_len, LispReg *reg, CompileError **err) { CompileLexenv *lexenv = env->lexenv_stack; LispReg *cur_reg = lookup_symbol_reg(env, name); if (cur_reg) { *reg = *cur_reg; return 0; } next_open_saved_reg(env, reg); if (!emit_instruction(err, stream, INST_INTERN_LIT, 2, ARG_REG, reg->type, reg->which, ARG_BYTES, name_len, name)) { return -1; } intern_in_lexenv(lexenv, name, reg); return 1; } static void add_variable_to_lexenv(CompileLexenv *lexenv, const char *name, LispReg *reg) { for (size_t i = 0; i < lexenv->nvars; ++i) { if (strcmp(name, lexenv->vars[i].name) == 0) { lexenv->vars[i].reg = *reg; return; } } lexenv->vars = realloc(lexenv->vars, sizeof(*lexenv->vars) * ++lexenv->nvars); lexenv->vars[lexenv->nvars - 1].name = strdup(name); lexenv->vars[lexenv->nvars - 1].reg = *reg; } static ssize_t maybe_save_argument_reg(CompileEnvironment *env, LispReg *arg_reg, FILE *stream, CompileError **err) { LispReg new_reg; CompileLexenv *lexenv = env->lexenv_stack; while (lexenv) { for (size_t i = 0; i < lexenv->nvars; ++i) { if (SAME_REG(&lexenv->vars[i].reg, arg_reg)) { next_open_saved_reg(env, &new_reg); add_variable_to_lexenv(env->lexenv_stack, lexenv->vars[i].name, &new_reg); return emit_instruction(err, stream, INST_MOV, 2, ARG_REG, new_reg.type, new_reg.which, ARG_REG, arg_reg->type, arg_reg->which) ? 1 : -1; } } if (lexenv->inherit) { lexenv = lexenv->next; } else { lexenv = NULL; } } return 0; } static FunctionEntry *get_or_make_function_entry(CompileEnvironment *env, AstSymbolNode *name, bool warn_on_redef, CompileError **err, AstNode *form) { for (size_t i = 0; i < env->nfuncs; ++i) { if (name->name_length == env->funcs[i].name_len && strcmp(env->funcs[i].name, name->name) == 0) { if (warn_on_redef) { push_error_at_ast(err, form, COMPILE_WARNING, "function already defined"); } return &env->funcs[i]; } } env->funcs = realloc(env->funcs, sizeof(FunctionEntry) * ++env->nfuncs); FunctionEntry *ne = &env->funcs[env->nfuncs - 1]; ne->name = strdup(name->name); ne->name_len = name->name_length; ne->line = form->line; ne->col = form->col; return ne; } // true on success, false on error static bool parse_function_lambda_list(AstListNode *list, FunctionEntry *entry, CompileError **err) { entry->allow_other_keys = false; entry->keys = NULL; entry->nkeys = 0; entry->required = NULL; entry->nrequired = 0; entry->optional = NULL; entry->noptional = 0; entry->has_rest = false; if (list->parent.type == AST_TYPE_NULL) { return true; } bool found_opt = false; bool found_rest = false; bool found_key = false; bool found_allow_other_keys = false; // 0 = req, 1 = opt, 2 = key, 3 = rest int cur_mode = 0; for (size_t i = 0; i < list->nchildren; ++i) { if (list->children[i]->type != AST_TYPE_SYMBOL) { char *printed_rep = ast_prin1_node_to_string(list->children[i], NULL); push_error_at_ast(err, (AstNode *) list, COMPILE_ERROR, "function argument not a symbol %s", printed_rep); free(printed_rep); return false; } AstSymbolNode *arg = (AstSymbolNode *) list->children[i]; if (is_symbol_named("&optional", (AstNode *) arg)) { if (found_opt) { push_error_at_ast(err, (AstNode *) list, COMPILE_ERROR, "&optional appeared more than once"); return false; } found_opt = true; cur_mode = 1; } else if (is_symbol_named("&rest", (AstNode *) arg)) { if (found_rest) { push_error_at_ast(err, (AstNode *) list, COMPILE_ERROR, "&rest appeared more than once"); return false; } found_rest = true; cur_mode = 3; } else if (is_symbol_named("&key", (AstNode *) arg)) { if (found_key) { push_error_at_ast(err, (AstNode *) list, COMPILE_ERROR, "&key appeared more than once"); return false; } found_key = true; cur_mode = 2; } else if (is_symbol_named("&allow-other-keys", (AstNode *) arg)) { if (found_allow_other_keys) { push_error_at_ast(err, (AstNode *) list, COMPILE_ERROR, "&allow-other-keys appeared more than once"); return false; } found_allow_other_keys = true; } else if (cur_mode == 3) { // rest if (entry->has_rest) { push_error_at_ast(err, (AstNode *) list, COMPILE_ERROR, "there can only be 1 &rest variable"); return false; } entry->has_rest = true; entry->rest = copy_symbol_name(arg); } else { size_t *target_len; char ***target_var; switch (cur_mode) { case 0: // req target_len = &entry->nrequired; target_var = &entry->required; break; case 1: // opt target_len = &entry->noptional; target_var = &entry->optional; break; case 2: // key target_len = &entry->nkeys; target_var = &entry->keys; break; } *target_var = realloc(*target_var, sizeof(char *) * ++(*target_len)); (*target_var)[*target_len - 1] = copy_symbol_name(arg); } } if (!found_key && found_allow_other_keys) { push_error_at_ast(err, (AstNode *)list, COMPILE_WARNING, "&allow-other-keys appeared without &key"); } return true; } static FunctionEntry *parse_and_add_function(CompileEnvironment *env, AstListNode *form, CompileError **err) { if (form->nchildren < 2 || (form->children[2]->type != AST_TYPE_LIST && (form->children[2]->type != AST_TYPE_NULL))) { push_error_at_ast(err, (AstNode *) form, COMPILE_ERROR, "invalid arguments to defun"); return NULL; } AstSymbolNode *name = (AstSymbolNode *) form->children[1]; FunctionEntry *entry = get_or_make_function_entry(env, name, true, err, (AstNode *) form); if (!parse_function_lambda_list((AstListNode *) form->children[2], entry, err)) { return NULL; } if (form->nchildren >= 4 && form->children[3]->type == AST_TYPE_STRING) { AstStringNode *doc_node = (AstStringNode *) form->children[3]; entry->doc_len = doc_node->length; entry->doc = malloc(doc_node->length + 1); memcpy(entry->doc, doc_node->value, doc_node->length + 1); } return entry; } static ssize_t save_arg_register(CompileEnvironment *env, uint32_t which_arg, LispReg *target, FILE *stream, CompileError **err) { next_open_saved_reg(env, target); return emit_instruction(err, stream, INST_MOV, 2, ARG_REG, target->type, target->which, ARG_REG, REG_ARG, which_arg); } static ssize_t emit_generic_arg_list(CompileEnvironment *env, AstNode **args, size_t arg_count, bool ignore_ret_vals, FILE *stream, CompileError **err) { ssize_t ec = 0; uint32_t first_saved_arg; if (ignore_ret_vals) { first_saved_arg = env->first_available_val; } else { first_saved_arg = env->lexenv_stack->first_avaiable_saved; } size_t nused_saved = 0; // do these first because they clobber the arg registers, so we need to save // their output for (size_t i = 0; i < arg_count; ++i) { if (!args[i]) { continue; } LispReg reg = { .type = REG_SAVED, .which = first_saved_arg + nused_saved, }; switch (args[i]->type) { case AST_TYPE_LIST: case AST_TYPE_VECTOR: case AST_TYPE_QUOTE: { if (!ignore_ret_vals) { env->lexenv_stack->first_avaiable_saved = reg.which + 1; } ++nused_saved; ssize_t rv = byte_compile_form_internal(env, args[i], ignore_ret_vals ? NULL : ®, stream, err); if (rv < 0) { ec = -1; goto done; } ec += rv; } break; default: break; } } if (!ignore_ret_vals) { nused_saved = 0; for (size_t i = 0; i < arg_count; ++i) { LispReg reg = { .type = REG_ARG, .which = i, }; ec += maybe_save_argument_reg(env, ®, stream, err); if (!args[i]) { emit_instruction(err, stream, INST_NIL, 1, ARG_REG, reg.type, reg.which); ++ec; continue; } switch (args[i]->type) { case AST_TYPE_LIST: case AST_TYPE_VECTOR: case AST_TYPE_QUOTE: emit_instruction(err, stream, INST_MOV, 2, ARG_REG, reg.type, reg.which, ARG_REG, REG_SAVED, first_saved_arg + nused_saved++); ++ec; break; case AST_TYPE_SYMBOL: case AST_TYPE_INT: case AST_TYPE_FLOAT: case AST_TYPE_STRING: case AST_TYPE_NULL: { ssize_t rv = byte_compile_form_internal(env, args[i], ®, stream, err); if (rv < 0) { ec = -1; goto done; } ec += rv; } break; } } } done: env->lexenv_stack->first_avaiable_saved = first_saved_arg; return ec; } static void add_lambda_list_to_lexenv(CompileEnvironment *env, FunctionEntry *entry, FILE *stream, CompileError **err) { for (size_t i = 0; i < entry->nrequired; ++i) { LispReg target = { .type = REG_ARG, .which = i, }; add_variable_to_lexenv(env->lexenv_stack, entry->required[i], &target); } for (size_t i = 0; i < entry->noptional; ++i) { uint32_t pos = i + entry->nrequired; LispReg target = { .type = REG_ARG, .which = pos, }; add_variable_to_lexenv(env->lexenv_stack, entry->optional[i], &target); } for (size_t i = 0; i < entry->nkeys; ++i) { size_t pos = i + entry->nrequired + entry->noptional; LispReg target = { .type = REG_ARG, .which = pos, }; add_variable_to_lexenv(env->lexenv_stack, entry->keys[i], &target); } if (entry->rest) { size_t pos = entry->nrequired + entry->noptional + entry->nkeys; LispReg target = { .type = REG_ARG, .which = pos, }; add_variable_to_lexenv(env->lexenv_stack, entry->rest, &target); } } static ssize_t emit_newfunction_for_entry(CompileEnvironment *env, FunctionEntry *entry, size_t int_forms, LispReg *target, FILE *stream, CompileError **err) { ssize_t total_insts = entry->nkeys + 1; for (size_t i = 0; i < entry->nkeys; ++i) { LispReg arg_reg = { .type = REG_ARG, .which = i, }; total_insts += maybe_save_argument_reg(env, &arg_reg, stream, err); emit_instruction(err, stream, INST_INTERN_LIT, 2, ARG_REG, arg_reg.type, arg_reg.which, ARG_STR, entry->keys[i]); } emit_instruction(err, stream, INST_NEWFUNCTION_LIT, 7, ARG_REG, target->type, target->which, ARG_U32, (uint32_t) entry->nrequired, ARG_U32, (uint32_t) entry->noptional, ARG_U32, (uint32_t) entry->nkeys, ARG_BOOL, (uint8_t) entry->allow_other_keys, ARG_BOOL, (uint8_t) entry->has_rest, ARG_U64, (uint64_t) int_forms); return total_insts; } // return the form at ret_index static ssize_t compile_multi_form_internal(CompileEnvironment *env, ssize_t ret_index, AstNode **forms, size_t nforms, LispReg *target, FILE *stream, CompileError **err) { LispReg save_ret_reg; ssize_t int_nforms = 0; for (size_t i = 0; i < nforms; ++i) { ssize_t ec; if (i == ret_index && ret_index >= nforms - 1) { ec = byte_compile_form_internal(env, forms[i], target, stream, err); } else if (i == ret_index) { next_open_saved_reg(env, &save_ret_reg); ec = byte_compile_form_internal(env, forms[i], target ? &save_ret_reg : NULL, stream, err); } else { ec = byte_compile_form_internal(env, forms[i], NULL, stream, err); } if (ec < 0) { return -1; } int_nforms += ec; } if (ret_index < nforms - 1 && target) { ++int_nforms; emit_instruction(err, stream, INST_MOV, 2, ARG_REG, target->type, target->which, ARG_REG, save_ret_reg.type, save_ret_reg.which); } return int_nforms; } // might want to clean this up at some point static ssize_t compile_defun_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { AstSymbolNode *name = (AstSymbolNode *) form->children[1]; FunctionEntry *entry = lookup_function(env, name); if (!entry && !(entry = parse_and_add_function(env, form, err))) { return -1; } size_t first_form = 3; if (form->nchildren >= 4 && form->children[3]->type == AST_TYPE_STRING) { ++first_form; } size_t internal_len = 0; char *internal_code = NULL; FILE *int_stream = open_memstream(&internal_code, &internal_len); environment_enter_lexenv(env, false); add_lambda_list_to_lexenv(env, entry, int_stream, err); size_t nchild_forms = form->nchildren - first_form; LispReg ret_val_target = { .type = REG_RET, .which = 0, }; ssize_t int_nforms = compile_multi_form_internal(env, nchild_forms - 1, form->children + first_form, nchild_forms, &ret_val_target, int_stream, err); if (int_nforms < 0) { goto compile_error; } environment_leave_lexenv(env); fclose(int_stream); LispReg backup_target = { .type = REG_VAL, .which = env->first_available_val, }; if (!target) { target = &backup_target; } ssize_t surround_nforms = 0; surround_nforms += emit_newfunction_for_entry(env, entry, int_nforms + (int_nforms ? 2 : 0), target, stream, err); if (int_nforms) { emit_instruction(err, stream, INST_ENTER_LEXENV, 1, ARG_U64, (uint64_t) int_nforms + 1); emit_instruction(err, stream, INST_ENTER_BLOCK, 2, ARG_BYTES, entry->name_len, entry->name, ARG_U64, (uint64_t) int_nforms); fwrite(internal_code, 1, internal_len, stream); surround_nforms += 2; } free(internal_code); LispReg name_reg; surround_nforms += intern_and_save(env, stream, entry->name, entry->name_len, &name_reg, err); emit_instruction(err, stream, INST_SET_FUNCTION, 2, ARG_REG, target->type, target->which, ARG_REG, name_reg.type, name_reg.which); return int_nforms + surround_nforms + 6; compile_error: fclose(int_stream); free(internal_code); return -1; } static ssize_t compile_devar_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { return 0; } static ssize_t compile_progn_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { if (form->nchildren == 1 && target) { return emit_instruction(err, stream, INST_NIL, 1, ARG_REG, target->type, target->which) ? 1 : -1; } else if (form->nchildren > 1){ return compile_multi_form_internal(env, form->nchildren - 1, form->children + 1, form->nchildren - 1, target, stream, err); } return 0; } static ssize_t compile_if_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { if (form->nchildren == 1) { push_error_at_ast(err, (AstNode *) form, COMPILE_ERROR, "no condition for if form"); return -1; } LispReg cond_reg = { .type = REG_VAL, .which = env->first_available_val, }; ssize_t total_ec = 0; ssize_t ec; ec = byte_compile_form_internal(env, form->children[1], form->nchildren == 2 ? NULL : &cond_reg, stream, err); if (ec < 0) { return -1; } total_ec += ec; if (form->nchildren == 2) { if (target) { emit_instruction(err, stream, INST_NIL, 1, ARG_REG, target->type, target->which); ++total_ec; } return total_ec; } char *true_bytes; size_t true_len; size_t true_ninst = 0; FILE *true_stream = open_memstream(&true_bytes, &true_len); true_ninst = byte_compile_form_internal(env, form->children[2], target, true_stream, err); fclose(true_stream); if (true_ninst < 0) { free(true_bytes); return -1; } total_ec += true_ninst; emit_instruction(err, stream, INST_CJMP, 2, ARG_REG, cond_reg.type, cond_reg.which, ARG_I64, (int64_t) true_ninst + 1); ++total_ec; fwrite(true_bytes, 1, true_len, stream); free(true_bytes); char *false_bytes; size_t false_len; size_t false_ninst = 0; FILE *false_stream = open_memstream(&false_bytes, &false_len); size_t false_nforms = form->nchildren - 3; false_ninst = compile_multi_form_internal(env, false_nforms - 1, form->children + 3, false_nforms, target, false_stream, err); fclose(false_stream); if (false_ninst < 0) { free(false_bytes); return -1; } total_ec += false_ninst; emit_instruction(err, stream, INST_JMP, 1, ARG_I64, (int64_t) false_ninst); ++total_ec; fwrite(false_bytes, 1, false_len, stream); free(false_bytes); return total_ec; } static bool inst_func_eq(const char *func, const char *inst) { while (*func && *inst) { if (!(*func == '-' && *inst == '_') && tolower(*func) != tolower(*inst)) { return false; } ++func; ++inst; } return !*func && !*inst; } static LispInst find_instruction_by_func_name(const char *name) { for (size_t i = 0; i < N_INSTRUCTIONS; ++i) { if (inst_func_eq(name, INSTRUCTION_NAMES[i])) { return i; } } return N_INSTRUCTIONS; } static ssize_t compile_list_like_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { AstSymbolNode *name = (AstSymbolNode *) form->children[0]; LispInst inst = find_instruction_by_func_name(name->name); if (inst >= N_INSTRUCTIONS) { return -1; } ssize_t ec = emit_generic_arg_list(env, form->children + 1, form->nchildren - 1, !target, stream, err); if (target) { ec += emit_instruction(err, stream, inst, 2, ARG_REG, target->type, target->which, ARG_U64, (uint64_t) form->nchildren - 1); } return ec; } static ssize_t compile_special_binary_func_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { AstSymbolNode *name = (AstSymbolNode *) form->children[0]; if (form->nchildren != 3) { push_error_at_ast(err, (AstNode *)form, COMPILE_ERROR, "%s expects exactly 2 arguments", name->name); } LispInst inst = find_instruction_by_func_name(name->name); ssize_t arg_nforms = emit_generic_arg_list(env, form->children + 1, form->nchildren - 1, !target, stream, err); if (target) { emit_instruction(err, stream, inst, 3, ARG_REG, target->type, target->which, ARG_REG, REG_ARG, (uint32_t) 0, ARG_REG, REG_ARG, (uint32_t) 1); ++arg_nforms; } return arg_nforms; } static ssize_t compile_special_unary_func_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { AstSymbolNode *name = (AstSymbolNode *) form->children[0]; if (form->nchildren != 2) { push_error_at_ast(err, (AstNode *)form, COMPILE_ERROR, "%s expects exactly 1 argument", name->name); } LispInst inst = find_instruction_by_func_name(name->name); LispReg temp_reg = { .type = REG_VAL, .which = env->first_available_val, }; ssize_t arg_nforms = byte_compile_form_internal(env, form->children[1], !target ? NULL : &temp_reg, stream, err); if (target) { emit_instruction(err, stream, inst, 2, ARG_REG, target->type, target->which, ARG_REG, temp_reg.type, temp_reg.which); ++arg_nforms; } return arg_nforms; } static ssize_t compile_math_comparison_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { AstSymbolNode *name = (AstSymbolNode *) form->children[0]; if (form->nchildren != 3) { push_error_at_ast(err, (AstNode *)form, COMPILE_ERROR, "%s expects exactly 2 argument", name->name); } const char *real_name; if (name->name_length == 1) { switch (*name->name) { case '<': real_name = "NUM_LT"; break; case '=': real_name = "NUM_EQ"; break; case '>': real_name = "NUM_GT"; break; } } else if (*name->name == '<') { real_name = "NUM_LE"; } else if (*name->name == '>') { real_name = "NUM_GE"; } LispInst inst = find_instruction_by_func_name(real_name); ssize_t arg_nforms = emit_generic_arg_list(env, form->children + 1, form->nchildren - 1, !target, stream, err); if (target) { emit_instruction(err, stream, inst, 3, ARG_REG, target->type, target->which, ARG_REG, REG_ARG, (uint32_t) 0, ARG_REG, REG_ARG, (uint32_t) 1); ++arg_nforms; } return arg_nforms; } static ssize_t compile_math_arithmatic_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { const char *real_name; AstSymbolNode *name = (AstSymbolNode *) form->children[0]; switch (*name->name) { case '+': real_name = "add"; break; case '-': real_name = "sub"; break; case '*': real_name = "mul"; break; case '/': real_name = "div"; break; } LispInst inst = find_instruction_by_func_name(real_name); ssize_t ec = emit_generic_arg_list(env, form->children + 1, form->nchildren - 1, !target, stream, err); if (target) { ec += emit_instruction(err, stream, inst, 2, ARG_REG, target->type, target->which, ARG_U64, (uint64_t) form->nchildren - 1); } return ec; } static const struct { const char *name; ssize_t (*handler)(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err); } NATIVE_FUNCTIONS[] = { {"defun", compile_defun_call}, {"devar", compile_devar_call}, {"progn", compile_progn_call}, {"if", compile_if_call}, {"list", compile_list_like_call}, {"vector", compile_list_like_call}, {"+", compile_math_arithmatic_call}, {"-", compile_math_arithmatic_call}, {"*", compile_math_arithmatic_call}, {"/", compile_math_arithmatic_call}, {"<=", compile_math_comparison_call}, {"<", compile_math_comparison_call}, {"=", compile_math_comparison_call}, {">=", compile_math_comparison_call}, {">", compile_math_comparison_call}, {"eq", compile_special_binary_func_call}, {"int-div", compile_special_binary_func_call}, {"mod", compile_special_binary_func_call}, {"pow", compile_special_binary_func_call}, {"bitand", compile_special_binary_func_call}, {"bitor", compile_special_binary_func_call}, {"bitxor", compile_special_binary_func_call}, {"string", compile_special_unary_func_call}, {"int", compile_special_unary_func_call}, {"float", compile_special_unary_func_call}, {"intern", compile_special_unary_func_call}, {"type-of", compile_special_unary_func_call}, {"get-function", compile_special_unary_func_call}, {"get-value", compile_special_unary_func_call}, {"functionp", compile_special_unary_func_call}, {"boundp", compile_special_unary_func_call}, {"not", compile_special_unary_func_call}, {"car", compile_special_unary_func_call}, {"cdr", compile_special_unary_func_call}, {"recip", compile_special_unary_func_call}, {"sqrt", compile_special_unary_func_call}, {"ln", compile_special_unary_func_call}, {"exp", compile_special_unary_func_call}, {"sin", compile_special_unary_func_call}, {"cos", compile_special_unary_func_call}, {"tan", compile_special_unary_func_call}, {"asin", compile_special_unary_func_call}, {"acos", compile_special_unary_func_call}, {"atan", compile_special_unary_func_call}, {"bigneg", compile_special_unary_func_call}, {"lsh", compile_special_unary_func_call}, {"ash", compile_special_unary_func_call}, }; const size_t N_NATIVE_FUNCTIONS = sizeof(NATIVE_FUNCTIONS) / sizeof(NATIVE_FUNCTIONS[0]); static ssize_t compile_string_node(CompileEnvironment *env, AstStringNode *form, LispReg *target, FILE *stream, CompileError **err) { return emit_instruction(err, stream, INST_STRING, 2, ARG_REG, target->type, target->which, ARG_BYTES, form->length, form->value) ? 1 : -1; } static ssize_t compile_int_node(CompileEnvironment *env, AstIntNode *form, LispReg *target, FILE *stream, CompileError **err) { return emit_instruction(err, stream, INST_INT, 2, ARG_REG, target->type, target->which, ARG_U64, form->value) ? 1 : -1; } static ssize_t compile_float_node(CompileEnvironment *env, AstFloatNode *form, LispReg *target, FILE *stream, CompileError **err) { return emit_instruction(err, stream, INST_FLOAT, 2, ARG_REG, target->type, target->which, ARG_DOUBLE, form->value) ? 1 : -1; } static ssize_t compile_null_node(CompileEnvironment *env, AstNode *form, LispReg *target, FILE *stream, CompileError **err) { return emit_instruction(err, stream, INST_NIL, 1, ARG_REG, target->type, target->which) ? 1 : -1; } static ssize_t compile_quoted_symbol_node(CompileEnvironment *env, AstSymbolNode *form, LispReg *target, FILE *stream, CompileError **err) { return emit_instruction(err, stream, INST_INTERN_LIT, 2, ARG_REG, target->type, target->which, ARG_BYTES, form->name_length, form->name) ? 1 : -1; } static ssize_t compile_symbol_node(CompileEnvironment *env, AstSymbolNode *form, LispReg *target, FILE *stream, CompileError **err) { if (strcmp(form->name, "t") == 0) { return emit_instruction(err, stream, INST_T, 1, ARG_REG, target->type, target->which) ? 1 : -1; } else if (form->is_property) { return compile_quoted_symbol_node(env, form, target, stream, err); } LispReg *var_reg = lookup_local_var(env, form->name); if (var_reg) { if (SAME_REG(var_reg, target)) { return 0; } // if the target is not an arg register, we can just set the target to // the register that the variable is already in if (target->type != REG_ARG) { *target = *var_reg; return 0; } return emit_instruction(err, stream, INST_MOV, 2, ARG_REG, target->type, target->which, ARG_REG, var_reg->type, var_reg->which) ? 1 : -1; } else { // global variable if (!lookup_variable(env, form)) { // TODO add to queue to check later } LispReg sym_reg; ssize_t ec = intern_and_save(env, stream, form->name, form->name_length, &sym_reg, err); if (ec < 0) { return -1; } emit_instruction(err, stream, INST_GET_VALUE, 2, ARG_REG, target->type, target->which, ARG_REG, sym_reg.type, sym_reg.which); return ec + 1; } } static ssize_t compile_quoted_quote_node(CompileEnvironment *env, AstQuoteNode *form, LispReg *target, FILE *stream, CompileError **err) { // return (quote internal-form) LispReg arg_reg = { .type = REG_ARG, .which = 1, }; ssize_t ec = byte_compile_form_internal(env, (AstNode *) form->form, &arg_reg, stream, err); if (ec < 0) { return -1; } LispReg quote_sym_reg; const char *name; size_t name_len; switch (form->type) { case AST_QUOTE_COMMA: name = "bq-comma"; name_len = sizeof("bq-comma") - 1; break; case AST_QUOTE_SPLICE: name = "bq-splice"; name_len = sizeof("bq-splice") - 1; break; case AST_QUOTE_NORM: name = "quote"; name_len = sizeof("quote") - 1; break; case AST_QUOTE_BACK: name = "backquote"; name_len = sizeof("backquote") - 1; break; case AST_QUOTE_NONE: // shouldn't happen return 0; } ssize_t ec2 = intern_and_save(env, stream, name, name_len, "e_sym_reg, err); if (ec2 < 0) { return -1; } if (!emit_instruction(err, stream, INST_MOV, 2, ARG_REG, REG_ARG, (uint32_t) 0, ARG_REG, quote_sym_reg.type, quote_sym_reg.which)) { return -1; } if (!emit_instruction(err, stream, INST_LIST, 2, ARG_REG, target->type, target->which, ARG_U64, (uint64_t) 2)) { return -1; } return ec + ec2 + 2; } static ssize_t compile_quote_node(CompileEnvironment *env, AstQuoteNode *form, LispReg *target, FILE *stream, CompileError **err) { switch (form->type) { case AST_QUOTE_NORM: case AST_QUOTE_BACK: { env->quote = form->type; size_t ec = byte_compile_form_internal(env, form->form, target, stream, err); env->quote = AST_QUOTE_NONE; return ec; } case AST_QUOTE_COMMA: case AST_QUOTE_SPLICE: push_error_at_ast(err, (AstNode *) form, COMPILE_ERROR, "comma or splice not inside a backquote"); return -1; case AST_QUOTE_NONE: // shouldn't happen, do nothing return 0; } } static ssize_t compile_quoted_list_node(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { LispReg arg_reg = { .type = REG_ARG, }; size_t total_emitted = 0; for (size_t i = 0; i < form->nchildren; ++i) { arg_reg.which = i; ssize_t ec = byte_compile_form_internal(env, form->children[i], &arg_reg, stream, err); if (ec < 0) { return -1; } total_emitted += ec; } if (!emit_instruction(err, stream, INST_LIST, 2, ARG_REG, target->type, target->which, ARG_U64, form->nchildren)) { return -1; } return total_emitted + 1; } static ssize_t compile_backquote_quote_node(CompileEnvironment *env, AstQuoteNode *form, LispReg *target, FILE *stream, CompileError **err) { if (form->type == AST_QUOTE_COMMA) { env->quote = AST_QUOTE_NONE; ssize_t ec = byte_compile_form_internal(env, form->form, target, stream, err); env->quote = AST_QUOTE_BACK; return ec; } else if (form->type == AST_QUOTE_SPLICE) { // TODO handle this return 0; } return compile_quoted_quote_node(env, form, target, stream, err); } static ssize_t compile_vector_node(CompileEnvironment *env, AstVectorNode *form, LispReg *target, FILE *stream, CompileError **err) { env->quote = AST_QUOTE_NORM; LispReg arg_reg = { .type = REG_ARG, }; size_t total_emitted = 0; for (size_t i = 0; i < form->nchildren; ++i) { arg_reg.which = i; ssize_t ec = byte_compile_form_internal(env, form->children[i], &arg_reg, stream, err); if (ec < 0) { return -1; } total_emitted += ec; } if (!emit_instruction(err, stream, INST_VECTOR, 2, ARG_REG, target->type, target->which, ARG_U64, form->nchildren)) { return -1; } env->quote = AST_QUOTE_NONE; return total_emitted + 1; } static ssize_t compile_atom_node(CompileEnvironment *env, AstNode *form, LispReg *target, FILE *stream, CompileError **err) { switch (form->type) { case AST_TYPE_INT: return compile_int_node(env, (AstIntNode *) form, target, stream, err); case AST_TYPE_FLOAT: return compile_float_node(env, (AstFloatNode *)form, target, stream, err); case AST_TYPE_STRING: return compile_string_node(env, (AstStringNode *) form, target, stream, err); case AST_TYPE_NULL: return compile_null_node(env, form, target, stream, err); case AST_TYPE_SYMBOL: if (env->quote == AST_QUOTE_NONE) { return compile_symbol_node(env, (AstSymbolNode *) form, target, stream, err); } else { return compile_quoted_symbol_node(env, (AstSymbolNode *) form, target, stream, err); } case AST_TYPE_QUOTE: if (env->quote == AST_QUOTE_NONE) { return compile_quote_node(env, (AstQuoteNode *) form, target, stream, err); } else if (env->quote == AST_QUOTE_BACK) { return compile_backquote_quote_node(env, (AstQuoteNode *) form, target, stream,err); } else { return compile_quoted_quote_node(env, (AstQuoteNode *) form, target, stream, err); } case AST_TYPE_VECTOR: return compile_vector_node(env, (AstVectorNode *)form, target, stream, err); case AST_TYPE_LIST: if (env->quote == AST_QUOTE_NONE) { return compile_quoted_list_node(env, (AstListNode *) form, target, stream, err); } else { // probably an error, don't do anything though return 0; } } } static AstListNode *make_list_func_node(AstNode **nodes, size_t count) { AstListNode *node = malloc(sizeof(AstListNode)); node->parent.type = AST_TYPE_LIST; node->parent.line = 0; node->parent.col = 0; node->nchildren = count + 1; node->children = malloc(sizeof(AstNode *) * (count + 1)); node->children[0] = malloc(sizeof(AstSymbolNode)); node->children[0]->type = AST_TYPE_SYMBOL; node->children[0]->line = 0; node->children[0]->col = 0; ((AstSymbolNode *) node->children[0])->is_property = false; ((AstSymbolNode *) node->children[0])->name = "list"; ((AstSymbolNode *) node->children[0])->name_length = sizeof("list") - 1; ((AstSymbolNode *) node->children[0])->skip_free = true; memcpy(node->children + 1, nodes, count * sizeof(AstNode *)); return node; } static ssize_t compile_generic_function_call(CompileEnvironment *env, AstListNode *form, LispReg *target, FILE *stream, CompileError **err) { size_t emitted_count = 0; AstSymbolNode *name = (AstSymbolNode *) form->children[0]; FunctionEntry *entry = lookup_function(env, name); if (!entry) { push_error_at_ast(err, (AstNode *) form, COMPILE_ERROR, "unknown function"); } else if (!function_arguments_ok(form, entry, err)) { // arguments invalid, give up compiling form return -1; } ssize_t ec = 0; ec += emit_generic_arg_list(env, form->children + 1, form->nchildren - 1, false, stream, err); LispReg name_reg; ec += intern_and_save(env, stream, name->name, name->name_length, &name_reg, err); if (ec == -1) { return -1; } ec += emit_instruction(err, stream, INST_FUNCALL, 2, ARG_REG, name_reg.type, name_reg.which, ARG_U64, form->nchildren - 1); if (target && target->type != REG_VAL) { ec += emit_instruction(err, stream, INST_MOV, 2, ARG_REG, target->type, target->which, ARG_REG, REG_RET, (uint32_t) 0); } else if (target) { target->type = REG_RET; target->which = 0; } return ec; } static ssize_t byte_compile_form_internal(CompileEnvironment *env, AstNode *form, LispReg *target, FILE *stream, CompileError **err) { ssize_t extra_ins = 0; // if target is one of the arg registers and it contains a local variable, // we want to save it to a saved register if (target && target->type == REG_ARG) { extra_ins = maybe_save_argument_reg(env, target, stream, err); if (extra_ins < 0) { return -1; } } if (form->type != AST_TYPE_LIST) { if (!target && (form->type != AST_TYPE_QUOTE || ((AstQuoteNode *) form)->type == AST_TYPE_QUOTE)) { // no use in compiling a literal if the value will just be thrown out return 0; } return extra_ins + compile_atom_node(env, form, target, stream, err); } else if (env->quote != AST_QUOTE_NONE) { if (!target) { return 0; } return extra_ins + compile_quoted_list_node(env, (AstListNode *) form, target, stream, err); } else if (is_function_call(form)) { for (size_t i = 0; i < N_NATIVE_FUNCTIONS; ++i) { if (is_function_call_named(NATIVE_FUNCTIONS[i].name, form)) { return extra_ins + NATIVE_FUNCTIONS[i].handler(env, (AstListNode *) form, target, stream, err); } } return extra_ins + compile_generic_function_call(env, (AstListNode *) form, target, stream, err); } return extra_ins; } ssize_t byte_compile_form(CompileEnvironment *env, AstNode *form, FILE *stream, CompileError **err) { env->first_available_val = 0; env->quote = AST_QUOTE_NONE; size_t ninst = byte_compile_form_internal(env, form, NULL, stream, err); if (COMPILE_FORMAT == COMPILE_FORMAT_ASM) { fputc('\n', stream); } // reverse err if (err) { CompileError *cur_err = *err; CompileError *prev_err = NULL; while (cur_err) { CompileError *next = cur_err->next; cur_err->next = prev_err; prev_err = cur_err; cur_err = next; } *err = prev_err; } return ninst; } void load_toplevel_definition(CompileEnvironment *env, AstNode *form, CompileError **err) { if (is_function_call_named("defun", form)) { parse_and_add_function(env, (AstListNode *) form, err); } }