andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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,
unless chain-loading.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-12-30 11:12:00 +01:00
parent cd2c1574c8
commit 71d4d7daab
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
4 changed files with 18 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
include/mes/symbols.h
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

1
mes/module/mes/boot-03.scm
View File

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

17
src/eval-apply.c
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;
@ -863,7 +865,13 @@ begin_expand:
goto eval;
begin_expand_primitive_load:
if ((R1->type == TNUMBER) && R1->value == 0)
0;
{
/* Chain-loading stdin. */
push_cc (input, R2, R0, cell_vm_return);
R1 = read_input_file_env (R0);
goto begin_expand_while;
continue; /* FIXME: M2-PLanet */
}
else if (R1->type == TSTRING)
input = set_current_input_port (open_input_file (R1));
else if (R1->type == TPORT)
@ -875,11 +883,10 @@ begin_expand:
assert_msg (0, "begin-expand-boom 0");
}
push_cc (input, R2, R0, cell_vm_return);
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 +965,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 ();

1
src/symbol.c
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*");