Some more work
This commit is contained in:
parent
3c3a9ff2d5
commit
7c642a5475
14
BYTECODE.md
14
BYTECODE.md
@ -36,8 +36,6 @@ lexenv register or "arg0" is the first argument register.
|
|||||||
| saved | 1 | Callee saved ragisters (val registers are clobbered by calls) |
|
| saved | 1 | Callee saved ragisters (val registers are clobbered by calls) |
|
||||||
| arg | 2 | Function argument registers (clobbered by calls) |
|
| arg | 2 | Function argument registers (clobbered by calls) |
|
||||||
| ret | 3 | Function return value registers (clobbered by calls) |
|
| ret | 3 | Function return value registers (clobbered by calls) |
|
||||||
| lexenv | 4 | Lexical environment registers |
|
|
||||||
| block | 5 | Block symbol registers |
|
|
||||||
|
|
||||||
### Instruction List
|
### Instruction List
|
||||||
|
|
||||||
@ -88,18 +86,20 @@ lexenv register or "arg0" is the first argument register.
|
|||||||
highest "ret" register written to is the number to use. Without this, assume
|
highest "ret" register written to is the number to use. Without this, assume
|
||||||
one return value.
|
one return value.
|
||||||
|
|
||||||
|
- GET\_RETVAL\_COUNT dest:reg
|
||||||
|
Place the count last set with RETVAL\_COUNT into DEST.
|
||||||
|
|
||||||
- ENTER\_LEXENV
|
- ENTER\_LEXENV
|
||||||
|
ENTER\_INHERITED\_LEXENV
|
||||||
LEAVE\_LEXENV
|
LEAVE\_LEXENV
|
||||||
Shift all the "lexenv" registers up by 1 and then create a new lexenv and
|
Push or restore the current lexical environment. An inherited lexenv does not
|
||||||
store it into "lexenv0". LEAVE\_LEXENV does the opposite, restoring the last
|
save or restore the "saved" registers.
|
||||||
pushed levenv.
|
|
||||||
|
|
||||||
- ENTER\_BLOCK sym:reg, count:u64
|
- ENTER\_BLOCK sym:reg, count:u64
|
||||||
LEAVE\_BLOCK sym:reg
|
LEAVE\_BLOCK sym:reg
|
||||||
Enter a new named block which is identified by the symbol in SYM. The block is
|
Enter a new named block which is identified by the symbol in SYM. The block is
|
||||||
COUNT instructions long. LEAVE\_BLOCK leaved the block identified by
|
COUNT instructions long. LEAVE\_BLOCK leaved the block identified by
|
||||||
SYM. Adding a new block pushes SYM onto the "block" registers, much like
|
SYM.
|
||||||
PUSH\_LEXENV (which see).
|
|
||||||
|
|
||||||
- SET\_VALUE sym:reg, value:reg
|
- SET\_VALUE sym:reg, value:reg
|
||||||
Set the value as a variable of SYM to VALUE.
|
Set the value as a variable of SYM to VALUE.
|
||||||
|
@ -227,8 +227,6 @@ static bool emit_instruction(CompileError **err, FILE *stream,
|
|||||||
success = emit_next_arg_c(err, stream, args);
|
success = emit_next_arg_c(err, stream, args);
|
||||||
if (i < nargs - 1) {
|
if (i < nargs - 1) {
|
||||||
fprintf(stream, ", ");
|
fprintf(stream, ", ");
|
||||||
} else {
|
|
||||||
fputc('\n', stream);
|
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case COMPILE_FORMAT_BIN:
|
case COMPILE_FORMAT_BIN:
|
||||||
@ -240,6 +238,9 @@ static bool emit_instruction(CompileError **err, FILE *stream,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
va_end(args);
|
va_end(args);
|
||||||
|
if (COMPILE_FORMAT == COMPILE_FORMAT_ASM) {
|
||||||
|
fputc('\n', stream);
|
||||||
|
}
|
||||||
return success;
|
return success;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -287,6 +288,7 @@ void destroy_function_entry(FunctionEntry *entry) {
|
|||||||
for (size_t i = 0; i < entry->nkeys; ++i) {
|
for (size_t i = 0; i < entry->nkeys; ++i) {
|
||||||
free(entry->keys[i]);
|
free(entry->keys[i]);
|
||||||
}
|
}
|
||||||
|
free(entry->keys);
|
||||||
}
|
}
|
||||||
|
|
||||||
void destroy_variable_entry(VariableEntry *entry) {
|
void destroy_variable_entry(VariableEntry *entry) {
|
||||||
@ -306,7 +308,7 @@ void destroy_compile_lexenv(CompileLexenv *lexenv) {
|
|||||||
free(lexenv);
|
free(lexenv);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void environment_enter_lexenv(CompileEnvironment *env) {
|
static void environment_enter_lexenv(CompileEnvironment *env, bool inherit) {
|
||||||
CompileLexenv *n = malloc(sizeof(CompileLexenv));
|
CompileLexenv *n = malloc(sizeof(CompileLexenv));
|
||||||
n->vars = NULL;
|
n->vars = NULL;
|
||||||
n->nvars = 0;
|
n->nvars = 0;
|
||||||
@ -314,9 +316,21 @@ static void environment_enter_lexenv(CompileEnvironment *env) {
|
|||||||
n->nsymbols = 0;
|
n->nsymbols = 0;
|
||||||
n->first_avaiable_saved = 0;
|
n->first_avaiable_saved = 0;
|
||||||
n->next = env->lexenv_stack;
|
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;
|
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 *make_compile_environment() {
|
||||||
CompileEnvironment *env = malloc(sizeof(CompileEnvironment));
|
CompileEnvironment *env = malloc(sizeof(CompileEnvironment));
|
||||||
env->funcs = NULL;
|
env->funcs = NULL;
|
||||||
@ -324,7 +338,7 @@ CompileEnvironment *make_compile_environment() {
|
|||||||
env->vars = NULL;
|
env->vars = NULL;
|
||||||
env->nvars = 0;
|
env->nvars = 0;
|
||||||
env->lexenv_stack = NULL;
|
env->lexenv_stack = NULL;
|
||||||
environment_enter_lexenv(env); // toplevel lexenv
|
environment_enter_lexenv(env, false); // toplevel lexenv
|
||||||
return env;
|
return env;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -354,7 +368,7 @@ static bool is_function_call(AstNode *form) {
|
|||||||
|
|
||||||
static bool is_function_call_named(const char *name, AstNode *form) {
|
static bool is_function_call_named(const char *name, AstNode *form) {
|
||||||
return is_function_call(form) &&
|
return is_function_call(form) &&
|
||||||
is_symbol_named(name, ((AstListNode *) form)->children[1]);
|
is_symbol_named(name, ((AstListNode *) form)->children[0]);
|
||||||
}
|
}
|
||||||
|
|
||||||
static FunctionEntry *lookup_function(CompileEnvironment *env,
|
static FunctionEntry *lookup_function(CompileEnvironment *env,
|
||||||
@ -386,6 +400,12 @@ static bool is_property_symbol(AstNode *form) {
|
|||||||
((AstSymbolNode *) form)->is_property;
|
((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) {
|
static bool function_key_ok(AstSymbolNode *key, FunctionEntry *func) {
|
||||||
if (func->allow_other_keys) {
|
if (func->allow_other_keys) {
|
||||||
return true;
|
return true;
|
||||||
@ -445,12 +465,16 @@ static void intern_in_lexenv(CompileLexenv *lexenv, const char *name,
|
|||||||
|
|
||||||
static LispReg *lookup_symbol_reg(CompileEnvironment *env, const char *name) {
|
static LispReg *lookup_symbol_reg(CompileEnvironment *env, const char *name) {
|
||||||
CompileLexenv *lexenv = env->lexenv_stack;
|
CompileLexenv *lexenv = env->lexenv_stack;
|
||||||
if (!lexenv) {
|
while (lexenv) {
|
||||||
return NULL;
|
for (size_t i = 0; i < lexenv->nsymbols; ++i) {
|
||||||
}
|
if (strcmp(name, lexenv->symbols[i].name) == 0) {
|
||||||
for (size_t i = 0; i < lexenv->nsymbols; ++i) {
|
return &lexenv->symbols[i].reg;
|
||||||
if (strcmp(name, lexenv->symbols[i].name) == 0) {
|
}
|
||||||
return &lexenv->symbols[i].reg;
|
}
|
||||||
|
if (lexenv->inherit) {
|
||||||
|
lexenv = lexenv->next;
|
||||||
|
} else {
|
||||||
|
lexenv = NULL;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return NULL;
|
return NULL;
|
||||||
@ -458,12 +482,16 @@ static LispReg *lookup_symbol_reg(CompileEnvironment *env, const char *name) {
|
|||||||
|
|
||||||
static LispReg *lookup_local_var(CompileEnvironment *env, const char *name) {
|
static LispReg *lookup_local_var(CompileEnvironment *env, const char *name) {
|
||||||
CompileLexenv *lexenv = env->lexenv_stack;
|
CompileLexenv *lexenv = env->lexenv_stack;
|
||||||
if (!lexenv) {
|
while (lexenv) {
|
||||||
return NULL;
|
for (size_t i = 0; i < lexenv->nvars; ++i) {
|
||||||
}
|
if (strcmp(name, lexenv->vars[i].name) == 0) {
|
||||||
for (size_t i = 0; i < lexenv->nvars; ++i) {
|
return &lexenv->vars[i].reg;
|
||||||
if (strcmp(name, lexenv->vars[i].name) == 0) {
|
}
|
||||||
return &lexenv->vars[i].reg;
|
}
|
||||||
|
if (lexenv->inherit) {
|
||||||
|
lexenv = lexenv->next;
|
||||||
|
} else {
|
||||||
|
lexenv = NULL;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return NULL;
|
return NULL;
|
||||||
@ -525,26 +553,313 @@ static ssize_t intern_and_save(CompileEnvironment *env, FILE *stream,
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static ssize_t compile_defun_call(CompileEnvironment *env, AstListNode *form,
|
static FunctionEntry *get_or_make_function_entry(CompileEnvironment *env,
|
||||||
FILE *stream, CompileError **err) {
|
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;
|
||||||
|
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 void add_variable_to_lexenv(CompileLexenv *lexenv, const char *name,
|
||||||
|
LispReg *reg) {
|
||||||
|
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 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 add_lambda_list_to_lexenv(CompileEnvironment *env,
|
||||||
|
FunctionEntry *entry,
|
||||||
|
FILE *stream,
|
||||||
|
CompileError **err) {
|
||||||
|
ssize_t total_int = 0;
|
||||||
|
for (size_t i = 0; i < entry->nrequired; ++i) {
|
||||||
|
LispReg target;
|
||||||
|
ssize_t ec = save_arg_register(env, i, &target, stream, err);
|
||||||
|
if (ec < 0) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
total_int += ec;
|
||||||
|
add_variable_to_lexenv(env->lexenv_stack, entry->required[i], &target);
|
||||||
|
}
|
||||||
|
for (size_t i = 0; i < entry->noptional; ++i) {
|
||||||
|
LispReg target;
|
||||||
|
size_t pos = i + entry->nrequired;
|
||||||
|
ssize_t ec = save_arg_register(env, pos, &target, stream, err);
|
||||||
|
if (ec < 0) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
total_int += ec;
|
||||||
|
add_variable_to_lexenv(env->lexenv_stack, entry->optional[i], &target);
|
||||||
|
}
|
||||||
|
for (size_t i = 0; i < entry->nkeys; ++i) {
|
||||||
|
LispReg target;
|
||||||
|
size_t pos = i + entry->nrequired + entry->noptional;
|
||||||
|
ssize_t ec = save_arg_register(env, pos, &target, stream, err);
|
||||||
|
if (ec < 0) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
total_int += ec;
|
||||||
|
add_variable_to_lexenv(env->lexenv_stack, entry->keys[i], &target);
|
||||||
|
}
|
||||||
|
if (entry->rest) {
|
||||||
|
LispReg target;
|
||||||
|
size_t pos = entry->nrequired + entry->noptional + entry->nkeys;
|
||||||
|
ssize_t ec = save_arg_register(env, pos, &target, stream, err);
|
||||||
|
if (ec < 0) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
total_int += ec;
|
||||||
|
add_variable_to_lexenv(env->lexenv_stack, entry->rest, &target);
|
||||||
|
}
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
ssize_t int_nforms = add_lambda_list_to_lexenv(env, entry, int_stream, err);
|
||||||
|
if (int_nforms < 0) {
|
||||||
|
goto compile_error;
|
||||||
|
}
|
||||||
|
for (size_t i = first_form; i < form->nchildren; ++i) {
|
||||||
|
ssize_t ec;
|
||||||
|
if (i < form->nchildren - 1) {
|
||||||
|
ec = byte_compile_form_internal(env, form->children[i], NULL,
|
||||||
|
int_stream, err);
|
||||||
|
} else {
|
||||||
|
LispReg ret_reg = {
|
||||||
|
.type = REG_RET,
|
||||||
|
.which = 0,
|
||||||
|
};
|
||||||
|
ec = byte_compile_form_internal(env, form->children[i], &ret_reg,
|
||||||
|
int_stream, err);
|
||||||
|
}
|
||||||
|
if (ec < 0) {
|
||||||
|
goto compile_error;
|
||||||
|
}
|
||||||
|
int_nforms += ec;
|
||||||
|
}
|
||||||
|
environment_leave_lexenv(env);
|
||||||
|
LispReg backup_target = {
|
||||||
|
.type = REG_VAL,
|
||||||
|
.which = env->first_available_var,
|
||||||
|
};
|
||||||
|
if (!target) {
|
||||||
|
target = &backup_target;
|
||||||
|
}
|
||||||
|
ssize_t ec = emit_instruction(err, stream, INST_NEWFUNCTION_LIT, 2,
|
||||||
|
ARG_REG, target->type, target->which,
|
||||||
|
// account for the block and lexenv instructions
|
||||||
|
ARG_U64, (uint64_t) int_nforms + 5);
|
||||||
|
if (ec < 0) {
|
||||||
|
goto compile_error;
|
||||||
|
}
|
||||||
|
ec = emit_instruction(err, stream, INST_ENTER_LEXENV, 0);
|
||||||
|
if (ec < 0) {
|
||||||
|
goto compile_error;
|
||||||
|
}
|
||||||
|
LispReg name_reg;
|
||||||
|
ec = intern_and_save(env, stream, entry->name, entry->name_len, &name_reg, err);
|
||||||
|
if (ec < 0) {
|
||||||
|
goto compile_error;
|
||||||
|
}
|
||||||
|
ec = emit_instruction(err, stream, INST_ENTER_BLOCK, 2,
|
||||||
|
ARG_REG, name_reg.type, name_reg.which,
|
||||||
|
ARG_U64, (uint64_t) int_nforms + 1);
|
||||||
|
if (ec < 0) {
|
||||||
|
goto compile_error;
|
||||||
|
}
|
||||||
|
fclose(int_stream);
|
||||||
|
fwrite(internal_code, 1, internal_len, stream);
|
||||||
|
free(internal_code);
|
||||||
|
ec = emit_instruction(err, stream, INST_LEAVE_BLOCK, 1,
|
||||||
|
ARG_REG, name_reg.type, name_reg.which);
|
||||||
|
if (ec < 0) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
ec = emit_instruction(err, stream, INST_LEAVE_LEXENV, 0);
|
||||||
|
if (ec < 0) {
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
return int_nforms + 5;
|
||||||
|
compile_error:
|
||||||
|
fclose(int_stream);
|
||||||
|
free(internal_code);
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
static ssize_t compile_devar_call(CompileEnvironment *env, AstListNode *form,
|
static ssize_t compile_devar_call(CompileEnvironment *env, AstListNode *form,
|
||||||
FILE *stream, CompileError **err) {
|
LispReg *target, FILE *stream,
|
||||||
|
CompileError **err) {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static const struct {
|
static const struct {
|
||||||
const char *name;
|
const char *name;
|
||||||
ssize_t (*handler)(CompileEnvironment *env, AstListNode *form, FILE *stream,
|
ssize_t (*handler)(CompileEnvironment *env, AstListNode *form,
|
||||||
CompileError **err);
|
LispReg *target, FILE *stream, CompileError **err);
|
||||||
} NATIVE_FUNCTIONS[] = {
|
} NATIVE_FUNCTIONS[] = {
|
||||||
{"defun", compile_defun_call},
|
{"defun", compile_defun_call},
|
||||||
{"defmacro", compile_defun_call},
|
|
||||||
{"devar", compile_devar_call},
|
{"devar", compile_devar_call},
|
||||||
{"defconst", compile_devar_call},
|
|
||||||
{"defparam", compile_devar_call},
|
|
||||||
};
|
};
|
||||||
const size_t N_NATIVE_FUNCTIONS = sizeof(NATIVE_FUNCTIONS) /
|
const size_t N_NATIVE_FUNCTIONS = sizeof(NATIVE_FUNCTIONS) /
|
||||||
sizeof(NATIVE_FUNCTIONS[0]);
|
sizeof(NATIVE_FUNCTIONS[0]);
|
||||||
@ -786,7 +1101,8 @@ static ssize_t compile_generic_function_call(CompileEnvironment *env,
|
|||||||
AstSymbolNode *name = (AstSymbolNode *) form->children[0];
|
AstSymbolNode *name = (AstSymbolNode *) form->children[0];
|
||||||
FunctionEntry *entry = lookup_function(env, name);
|
FunctionEntry *entry = lookup_function(env, name);
|
||||||
if (!entry) {
|
if (!entry) {
|
||||||
// TODO add to list to check later
|
push_error_at_ast(err, (AstNode *) form, COMPILE_ERROR,
|
||||||
|
"unknown function");
|
||||||
} else if (!function_arguments_ok(form, entry, err)) {
|
} else if (!function_arguments_ok(form, entry, err)) {
|
||||||
// arguments invalid, give up compiling form
|
// arguments invalid, give up compiling form
|
||||||
return -1;
|
return -1;
|
||||||
@ -813,6 +1129,7 @@ static ssize_t compile_generic_function_call(CompileEnvironment *env,
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
// TODO make sure that rest and key arguments go at the end
|
||||||
// then all the other types of arguments
|
// then all the other types of arguments
|
||||||
for (size_t i = 1; i < form->nchildren; ++i) {
|
for (size_t i = 1; i < form->nchildren; ++i) {
|
||||||
switch (form->children[i]->type) {
|
switch (form->children[i]->type) {
|
||||||
@ -869,7 +1186,7 @@ static ssize_t byte_compile_form_internal(CompileEnvironment *env,
|
|||||||
for (size_t i = 0; i < N_NATIVE_FUNCTIONS; ++i) {
|
for (size_t i = 0; i < N_NATIVE_FUNCTIONS; ++i) {
|
||||||
if (is_function_call_named(NATIVE_FUNCTIONS[i].name, form)) {
|
if (is_function_call_named(NATIVE_FUNCTIONS[i].name, form)) {
|
||||||
return NATIVE_FUNCTIONS[i].handler(env, (AstListNode *) form,
|
return NATIVE_FUNCTIONS[i].handler(env, (AstListNode *) form,
|
||||||
stream, err);
|
target, stream, err);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return compile_generic_function_call(env, (AstListNode *) form, stream, err);
|
return compile_generic_function_call(env, (AstListNode *) form, stream, err);
|
||||||
|
@ -40,12 +40,15 @@ typedef struct {
|
|||||||
char *name;
|
char *name;
|
||||||
size_t name_len;
|
size_t name_len;
|
||||||
size_t nrequired;
|
size_t nrequired;
|
||||||
|
char **required;
|
||||||
size_t noptional;
|
size_t noptional;
|
||||||
|
char **optional;
|
||||||
size_t nkeys;
|
size_t nkeys;
|
||||||
char **keys;
|
char **keys;
|
||||||
|
|
||||||
bool allow_other_keys;
|
bool allow_other_keys;
|
||||||
bool has_rest;
|
bool has_rest;
|
||||||
|
char *rest;
|
||||||
|
|
||||||
char *doc;
|
char *doc;
|
||||||
size_t doc_len;
|
size_t doc_len;
|
||||||
@ -81,6 +84,7 @@ typedef struct _CompileLexenv {
|
|||||||
} *symbols;
|
} *symbols;
|
||||||
uint32_t first_avaiable_saved;
|
uint32_t first_avaiable_saved;
|
||||||
size_t nsymbols;
|
size_t nsymbols;
|
||||||
|
bool inherit;
|
||||||
} CompileLexenv;
|
} CompileLexenv;
|
||||||
|
|
||||||
void destroy_compile_lexenv(CompileLexenv *lexenv);
|
void destroy_compile_lexenv(CompileLexenv *lexenv);
|
||||||
|
@ -16,7 +16,8 @@ const char *INSTRUCTION_NAMES[] = {
|
|||||||
[INST_FUNCALL] = "FUNCALL",
|
[INST_FUNCALL] = "FUNCALL",
|
||||||
[INST_RETVAL_COUNT] = "RETVAL_COUNT",
|
[INST_RETVAL_COUNT] = "RETVAL_COUNT",
|
||||||
[INST_ENTER_LEXENV] = "ENTER_LEXENV",
|
[INST_ENTER_LEXENV] = "ENTER_LEXENV",
|
||||||
[INST_LEAVE_ELEXENV] = "LEAVE_ELEXENV",
|
[INST_ENTER_INHERITED_LEXENV] = "ENTER_INHERITED_LEXENV",
|
||||||
|
[INST_LEAVE_LEXENV] = "LEAVE_LEXENV",
|
||||||
[INST_ENTER_BLOCK] = "ENTER_BLOCK",
|
[INST_ENTER_BLOCK] = "ENTER_BLOCK",
|
||||||
[INST_LEAVE_BLOCK] = "LEAVE_BLOCK",
|
[INST_LEAVE_BLOCK] = "LEAVE_BLOCK",
|
||||||
[INST_SET_VALUE] = "SET_VALUE",
|
[INST_SET_VALUE] = "SET_VALUE",
|
||||||
@ -54,6 +55,4 @@ const char *REGISTER_NAMES[] = {
|
|||||||
[REG_SAVED] = "saved",
|
[REG_SAVED] = "saved",
|
||||||
[REG_ARG] = "arg",
|
[REG_ARG] = "arg",
|
||||||
[REG_RET] = "ret",
|
[REG_RET] = "ret",
|
||||||
[REG_LEXENV] = "lexenv",
|
|
||||||
[REG_BLOCK] = "block",
|
|
||||||
};
|
};
|
||||||
|
@ -6,53 +6,54 @@
|
|||||||
typedef uint16_t LispInst;
|
typedef uint16_t LispInst;
|
||||||
|
|
||||||
|
|
||||||
#define INST_NIL ((LispInst) 0)
|
#define INST_NIL ((LispInst) 0)
|
||||||
#define INST_T ((LispInst) 1)
|
#define INST_T ((LispInst) 1)
|
||||||
#define INST_STRING ((LispInst) 2)
|
#define INST_STRING ((LispInst) 2)
|
||||||
#define INST_INT ((LispInst) 3)
|
#define INST_INT ((LispInst) 3)
|
||||||
#define INST_FLOAT ((LispInst) 4)
|
#define INST_FLOAT ((LispInst) 4)
|
||||||
#define INST_CONS ((LispInst) 5)
|
#define INST_CONS ((LispInst) 5)
|
||||||
#define INST_LIST ((LispInst) 6)
|
#define INST_LIST ((LispInst) 6)
|
||||||
#define INST_VECTOR ((LispInst) 7)
|
#define INST_VECTOR ((LispInst) 7)
|
||||||
#define INST_INTERN_LIT ((LispInst) 8)
|
#define INST_INTERN_LIT ((LispInst) 8)
|
||||||
#define INST_INTERN_DYN ((LispInst) 9)
|
#define INST_INTERN_DYN ((LispInst) 9)
|
||||||
#define INST_SYMBOL_NAME ((LispInst) 10)
|
#define INST_SYMBOL_NAME ((LispInst) 10)
|
||||||
#define INST_MOV ((LispInst) 11)
|
#define INST_MOV ((LispInst) 11)
|
||||||
#define INST_FUNCALL ((LispInst) 12)
|
#define INST_FUNCALL ((LispInst) 12)
|
||||||
#define INST_RETVAL_COUNT ((LispInst) 13)
|
#define INST_RETVAL_COUNT ((LispInst) 13)
|
||||||
#define INST_ENTER_LEXENV ((LispInst) 14)
|
#define INST_ENTER_LEXENV ((LispInst) 14)
|
||||||
#define INST_LEAVE_ELEXENV ((LispInst) 15)
|
#define INST_ENTER_INHERITED_LEXENV ((LispInst) 15)
|
||||||
#define INST_ENTER_BLOCK ((LispInst) 16)
|
#define INST_LEAVE_LEXENV ((LispInst) 16)
|
||||||
#define INST_LEAVE_BLOCK ((LispInst) 17)
|
#define INST_ENTER_BLOCK ((LispInst) 17)
|
||||||
#define INST_SET_VALUE ((LispInst) 18)
|
#define INST_LEAVE_BLOCK ((LispInst) 18)
|
||||||
#define INST_SET_FUNCTION ((LispInst) 19)
|
#define INST_SET_VALUE ((LispInst) 19)
|
||||||
#define INST_GET_VALUE ((LispInst) 20)
|
#define INST_SET_FUNCTION ((LispInst) 20)
|
||||||
#define INST_GET_FUNCTION ((LispInst) 21)
|
#define INST_GET_VALUE ((LispInst) 21)
|
||||||
#define INST_NEWFUNCTION_LIT ((LispInst) 22)
|
#define INST_GET_FUNCTION ((LispInst) 22)
|
||||||
#define INST_NEWFUNCTION_DYN ((LispInst) 23)
|
#define INST_NEWFUNCTION_LIT ((LispInst) 23)
|
||||||
#define INST_PUT ((LispInst) 24)
|
#define INST_NEWFUNCTION_DYN ((LispInst) 24)
|
||||||
#define INST_GET ((LispInst) 25)
|
#define INST_PUT ((LispInst) 25)
|
||||||
#define INST_AND ((LispInst) 26)
|
#define INST_GET ((LispInst) 26)
|
||||||
#define INST_OR ((LispInst) 27)
|
#define INST_AND ((LispInst) 27)
|
||||||
#define INST_XOR ((LispInst) 28)
|
#define INST_OR ((LispInst) 28)
|
||||||
#define INST_NOT ((LispInst) 29)
|
#define INST_XOR ((LispInst) 29)
|
||||||
#define INST_CJMP ((LispInst) 30)
|
#define INST_NOT ((LispInst) 30)
|
||||||
#define INST_CAR ((LispInst) 31)
|
#define INST_CJMP ((LispInst) 31)
|
||||||
#define INST_CDR ((LispInst) 32)
|
#define INST_CAR ((LispInst) 32)
|
||||||
#define INST_SETCAR ((LispInst) 33)
|
#define INST_CDR ((LispInst) 33)
|
||||||
#define INST_SETCDR ((LispInst) 34)
|
#define INST_SETCAR ((LispInst) 34)
|
||||||
#define INST_GETELT_LIT ((LispInst) 35)
|
#define INST_SETCDR ((LispInst) 35)
|
||||||
#define INST_GETELT_DYN ((LispInst) 36)
|
#define INST_GETELT_LIT ((LispInst) 36)
|
||||||
#define INST_SETELT_LIT ((LispInst) 37)
|
#define INST_GETELT_DYN ((LispInst) 37)
|
||||||
#define INST_SETELT_DYN ((LispInst) 38)
|
#define INST_SETELT_LIT ((LispInst) 38)
|
||||||
#define INST_EQ_TWO ((LispInst) 39)
|
#define INST_SETELT_DYN ((LispInst) 39)
|
||||||
#define INST_EQ_N ((LispInst) 40)
|
#define INST_EQ_TWO ((LispInst) 40)
|
||||||
#define INST_NUM_GT ((LispInst) 41)
|
#define INST_EQ_N ((LispInst) 41)
|
||||||
#define INST_NUM_GE ((LispInst) 42)
|
#define INST_NUM_GT ((LispInst) 42)
|
||||||
#define INST_NUM_EQ ((LispInst) 43)
|
#define INST_NUM_GE ((LispInst) 43)
|
||||||
#define INST_NUM_LE ((LispInst) 44)
|
#define INST_NUM_EQ ((LispInst) 44)
|
||||||
#define INST_NUM_LT ((LispInst) 45)
|
#define INST_NUM_LE ((LispInst) 45)
|
||||||
#define N_INSTRUCTIONS ((LispInst) 46)
|
#define INST_NUM_LT ((LispInst) 46)
|
||||||
|
#define N_INSTRUCTIONS ((LispInst) 47)
|
||||||
|
|
||||||
extern const char *INSTRUCTION_NAMES[];
|
extern const char *INSTRUCTION_NAMES[];
|
||||||
|
|
||||||
@ -66,9 +67,7 @@ typedef struct {
|
|||||||
#define REG_SAVED ((LispRegType) 1)
|
#define REG_SAVED ((LispRegType) 1)
|
||||||
#define REG_ARG ((LispRegType) 2)
|
#define REG_ARG ((LispRegType) 2)
|
||||||
#define REG_RET ((LispRegType) 3)
|
#define REG_RET ((LispRegType) 3)
|
||||||
#define REG_LEXENV ((LispRegType) 4)
|
#define N_REGISTTERS 4
|
||||||
#define REG_BLOCK ((LispRegType) 5)
|
|
||||||
#define N_REGISTTERS 6
|
|
||||||
|
|
||||||
extern const char *REGISTER_NAMES[];
|
extern const char *REGISTER_NAMES[];
|
||||||
|
|
||||||
|
@ -1 +1,3 @@
|
|||||||
(format t '(abc) [a])
|
(defun name_here ()
|
||||||
|
"Test defun"
|
||||||
|
"a")
|
||||||
|
Loading…
Reference in New Issue
Block a user