core: Make primitive-load return properly.
* include/mes/symbols.h (cell_vm_primitive_load_return): New variable. (SYMBOL_MAX): Update. * mes/module/mes/boot-00.scm: Remove primitive-load chain-load hack. * mes/module/mes/boot-01.scm: Likewise. * mes/module/mes/boot-02.scm: Likewise. * mes/module/mes/boot-03.scm: Likewise. * src/eval-apply.c (eval_apply): Have primitive-load return properly.
This commit is contained in:
parent
3ad33b85e0
commit
aaa26001f3
|
@ -40,6 +40,7 @@ struct scm *cell_vm_begin_expand_eval;
|
||||||
struct scm *cell_vm_begin_expand_macro;
|
struct scm *cell_vm_begin_expand_macro;
|
||||||
struct scm *cell_vm_begin_expand_primitive_load;
|
struct scm *cell_vm_begin_expand_primitive_load;
|
||||||
struct scm *cell_vm_begin_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_begin_read_input_file;
|
||||||
struct scm *cell_vm_call_with_current_continuation2;
|
struct scm *cell_vm_call_with_current_continuation2;
|
||||||
struct scm *cell_vm_call_with_values2;
|
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_program;
|
||||||
struct scm *cell_symbol_test;
|
struct scm *cell_symbol_test;
|
||||||
|
|
||||||
// CONSTANT SYMBOL_MAX 113
|
// CONSTANT SYMBOL_MAX 114
|
||||||
#define SYMBOL_MAX 113
|
#define SYMBOL_MAX 114
|
||||||
|
|
||||||
// CONSTANT CELL_UNSPECIFIED 7
|
// CONSTANT CELL_UNSPECIFIED 7
|
||||||
#define CELL_UNSPECIFIED 7
|
#define CELL_UNSPECIFIED 7
|
||||||
|
|
|
@ -30,5 +30,3 @@
|
||||||
(define-macro (cond-expand . clauses)
|
(define-macro (cond-expand . clauses)
|
||||||
(cons 'begin (cond-expand-expander clauses)))
|
(cons 'begin (cond-expand-expander clauses)))
|
||||||
;; end boot-00.scm
|
;; end boot-00.scm
|
||||||
|
|
||||||
(primitive-load 0)
|
|
||||||
|
|
|
@ -66,5 +66,3 @@
|
||||||
(if (null? (cdr rest)) (car rest)
|
(if (null? (cdr rest)) (car rest)
|
||||||
(append2 (car rest) (apply append (cdr rest))))))
|
(append2 (car rest) (apply append (cdr rest))))))
|
||||||
;; end boot-01.scm
|
;; end boot-01.scm
|
||||||
|
|
||||||
(primitive-load 0)
|
|
||||||
|
|
|
@ -101,5 +101,3 @@
|
||||||
#t)
|
#t)
|
||||||
|
|
||||||
;; end boot-02.scm
|
;; end boot-02.scm
|
||||||
|
|
||||||
(primitive-load 0)
|
|
||||||
|
|
|
@ -166,6 +166,3 @@
|
||||||
(mes-use-module (mes let))
|
(mes-use-module (mes let))
|
||||||
(mes-use-module (mes scm))
|
(mes-use-module (mes scm))
|
||||||
;; end boot-03.scm
|
;; end boot-03.scm
|
||||||
|
|
||||||
(primitive-load 0)
|
|
||||||
(primitive-load 0)
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
/* -*-comment-start: "//";comment-end:""-*-
|
/* -*-comment-start: "//";comment-end:""-*-
|
||||||
* GNU Mes --- Maxwell Equations of Software
|
* GNU Mes --- Maxwell Equations of Software
|
||||||
* Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
* Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||||
*
|
*
|
||||||
* This file is part of GNU Mes.
|
* This file is part of GNU Mes.
|
||||||
*
|
*
|
||||||
|
@ -385,6 +385,8 @@ eval_apply:
|
||||||
goto macro_expand_define_macro;
|
goto macro_expand_define_macro;
|
||||||
else if (R3 == cell_vm_begin_primitive_load)
|
else if (R3 == cell_vm_begin_primitive_load)
|
||||||
goto 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)
|
else if (R3 == cell_vm_evlis)
|
||||||
goto evlis;
|
goto evlis;
|
||||||
|
@ -864,13 +866,6 @@ begin_expand:
|
||||||
input = set_current_input_port (open_input_file (R1));
|
input = set_current_input_port (open_input_file (R1));
|
||||||
else if (R1->type == TPORT)
|
else if (R1->type == TPORT)
|
||||||
input = set_current_input_port (R1);
|
input = set_current_input_port (R1);
|
||||||
else if ((R1->type == TNUMBER) && R1->value == -1)
|
|
||||||
{
|
|
||||||
eputs ("primitive-load: R1=-1 => RETURN\n");
|
|
||||||
display_error_ (R1);
|
|
||||||
gc_pop_frame ();
|
|
||||||
goto vm_return;
|
|
||||||
}
|
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
eputs ("begin_expand failed, R1=");
|
eputs ("begin_expand failed, R1=");
|
||||||
|
@ -878,11 +873,10 @@ begin_expand:
|
||||||
assert_msg (0, "begin-expand-boom 0");
|
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);
|
x = read_input_file_env (R0);
|
||||||
if (g_debug > 5)
|
if (g_debug > 5)
|
||||||
hash_table_printer (R0);
|
hash_table_printer (R0);
|
||||||
gc_pop_frame ();
|
|
||||||
input = R1;
|
input = R1;
|
||||||
R1 = x;
|
R1 = x;
|
||||||
set_current_input_port (input);
|
set_current_input_port (input);
|
||||||
|
@ -961,6 +955,10 @@ call_with_values2:
|
||||||
R1 = cons (R2->cdr->car, R1);
|
R1 = cons (R2->cdr->car, R1);
|
||||||
goto apply;
|
goto apply;
|
||||||
|
|
||||||
|
primitive_load_return:
|
||||||
|
gc_pop_frame ();
|
||||||
|
/* fall through */
|
||||||
|
|
||||||
vm_return:
|
vm_return:
|
||||||
x = R1;
|
x = R1;
|
||||||
gc_pop_frame ();
|
gc_pop_frame ();
|
||||||
|
|
|
@ -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_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_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_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_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_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*");
|
cell_vm_call_with_values2 = init_symbol (g_symbol, TSPECIAL, "*vm-call-with-values2*");
|
||||||
|
|
Loading…
Reference in New Issue