core: Make primitive-load return properly.

* include/mes/symbols.h (cell_vm_primitive_load_return): New variable.
(SYMBOL_MAX): Update.
* src/eval-apply.c (eval_apply): Have primitive-load return properly.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-12-30 11:12:00 +01:00
parent 731b51ac35
commit 5c9f10a6a2
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
4 changed files with 14 additions and 5 deletions

View File

@ -40,6 +40,7 @@ struct scm *cell_vm_begin_expand_eval;
struct scm *cell_vm_begin_expand_macro;
struct scm *cell_vm_begin_expand_primitive_load;
struct scm *cell_vm_begin_primitive_load;
struct scm *cell_vm_primitive_load_return;
struct scm *cell_vm_begin_read_input_file;
struct scm *cell_vm_call_with_current_continuation2;
struct scm *cell_vm_call_with_values2;
@ -136,8 +137,8 @@ struct scm *cell_type_broken_heart;
struct scm *cell_symbol_program;
struct scm *cell_symbol_test;
// CONSTANT SYMBOL_MAX 113
#define SYMBOL_MAX 113
// CONSTANT SYMBOL_MAX 114
#define SYMBOL_MAX 114
// CONSTANT CELL_UNSPECIFIED 7
#define CELL_UNSPECIFIED 7

View File

@ -168,4 +168,3 @@
;; end boot-03.scm
(primitive-load 0)
(primitive-load 0)

View File

@ -389,6 +389,8 @@ eval_apply:
goto macro_expand_define_macro;
else if (R3 == cell_vm_begin_primitive_load)
goto begin_primitive_load;
else if (R3 == cell_vm_primitive_load_return)
goto primitive_load_return;
else if (R3 == cell_vm_evlis)
goto evlis;
@ -875,11 +877,13 @@ begin_expand:
assert_msg (0, "begin-expand-boom 0");
}
push_cc (input, R2, R0, cell_vm_return);
if (global_p == 1)
push_cc (input, R2, R0, cell_vm_return);
else
push_cc (input, R2, R0, cell_vm_primitive_load_return);
x = read_input_file_env (R0);
if (g_debug > 5)
hash_table_printer (R0);
gc_pop_frame ();
input = R1;
R1 = x;
set_current_input_port (input);
@ -958,6 +962,10 @@ call_with_values2:
R1 = cons (R2->cdr->car, R1);
goto apply;
primitive_load_return:
gc_pop_frame ();
/* fall through */
vm_return:
x = R1;
gc_pop_frame ();

View File

@ -76,6 +76,7 @@ init_symbols_ () /*:((internal)) */
cell_vm_begin_expand_macro = init_symbol (g_symbol, TSPECIAL, "*vm:begin-expand-macro*");
cell_vm_begin_expand_primitive_load = init_symbol (g_symbol, TSPECIAL, "*vm:core:begin-expand-primitive-load*");
cell_vm_begin_primitive_load = init_symbol (g_symbol, TSPECIAL, "*vm:core:begin-primitive-load*");
cell_vm_primitive_load_return = init_symbol (g_symbol, TSPECIAL, "*vm:core:primitive-load-return*");
cell_vm_begin_read_input_file = init_symbol (g_symbol, TSPECIAL, "*vm-begin-read-input-file*");
cell_vm_call_with_current_continuation2 = init_symbol (g_symbol, TSPECIAL, "*vm-call-with-current-continuation2*");
cell_vm_call_with_values2 = init_symbol (g_symbol, TSPECIAL, "*vm-call-with-values2*");