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

core: Upcase register names. 

* include/mes/mes.h (R0, R1, R2, R3, M0): Rename from lower case.
Update users.
This commit is contained in:
Jan Nieuwenhuizen 2019-10-20 22:32:53 +02:00
parent d9fccb532a
commit f4cbbf620c
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
7 changed files with 273 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
include/mes/mes.h
View File

@ -40,15 +40,15 @@ SCM g_symbols;
SCM g_symbol_max; SCM g_symbol_max;
/* a/env */ /* a/env */
SCM r0; SCM R0;
/* param 1 */ /* param 1 */
SCM r1; SCM R1;
/* save 2 */ /* save 2 */
SCM r2; SCM R2;
/* continuation */ /* continuation */
SCM r3; SCM R3;
/* current-module */ /* current-module */
SCM m0; SCM M0;
/* macro */ /* macro */
SCM g_macros; SCM g_macros;
SCM g_ports; SCM g_ports;

2
src/display.c
View File

@ -198,7 +198,7 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p)
if (TYPE (printer) == TREF) if (TYPE (printer) == TREF)
printer = REF (printer); printer = REF (printer);
if (TYPE (printer) == TCLOSURE || builtin_p (printer) == cell_t) if (TYPE (printer) == TCLOSURE || builtin_p (printer) == cell_t)
apply (printer, cons (x, cell_nil), r0); apply (printer, cons (x, cell_nil), R0);
else else
{ {
fdputs ("#<", fd); fdputs ("#<", fd);

462
src/eval-apply.c
View File

@ -137,8 +137,8 @@ SCM
call_lambda (SCM e, SCM x, SCM aa, SCM a) /*:((internal)) */ call_lambda (SCM e, SCM x, SCM aa, SCM a) /*:((internal)) */
{ {
SCM cl = cons (cons (cell_closure, x), x); SCM cl = cons (cons (cell_closure, x), x);
r1 = e; R1 = e;
r0 = cl; R0 = cl;
return cell_unspecified; return cell_unspecified;
} }
@ -180,13 +180,13 @@ macro_set_x (SCM name, SCM value) /*:((internal)) */
SCM SCM
push_cc (SCM p1, SCM p2, SCM a, SCM c) /*:((internal)) */ push_cc (SCM p1, SCM p2, SCM a, SCM c) /*:((internal)) */
{ {
SCM x = r3; SCM x = R3;
r3 = c; R3 = c;
r2 = p2; R2 = p2;
gc_push_frame (); gc_push_frame ();
r1 = p1; R1 = p1;
r0 = a; R0 = a;
r3 = x; R3 = x;
return cell_unspecified; return cell_unspecified;
} }
@ -263,7 +263,7 @@ expand_variable_ (SCM x, SCM formals, int top_p) /*:((internal)) */
&& CAR (x) != cell_symbol_current_module && CAR (x) != cell_symbol_current_module
&& CAR (x) != cell_symbol_primitive_load && !formal_p (CAR (x), formals)) && CAR (x) != cell_symbol_primitive_load && !formal_p (CAR (x), formals))
{ {
SCM v = module_variable (r0, CAR (x)); SCM v = module_variable (R0, CAR (x));
if (v != cell_f) if (v != cell_f)
CAR (x) = make_variable_ (v); CAR (x) = make_variable_ (v);
} }
@ -355,264 +355,264 @@ eval_apply ()
long c; long c;
eval_apply: eval_apply:
if (r3 == cell_vm_evlis2) if (R3 == cell_vm_evlis2)
goto evlis2; goto evlis2;
else if (r3 == cell_vm_evlis3) else if (R3 == cell_vm_evlis3)
goto evlis3; goto evlis3;
else if (r3 == cell_vm_eval_check_func) else if (R3 == cell_vm_eval_check_func)
goto eval_check_func; goto eval_check_func;
else if (r3 == cell_vm_eval2) else if (R3 == cell_vm_eval2)
goto eval2; goto eval2;
else if (r3 == cell_vm_apply2) else if (R3 == cell_vm_apply2)
goto apply2; goto apply2;
else if (r3 == cell_vm_if_expr) else if (R3 == cell_vm_if_expr)
goto if_expr; goto if_expr;
else if (r3 == cell_vm_begin_eval) else if (R3 == cell_vm_begin_eval)
goto begin_eval; goto begin_eval;
else if (r3 == cell_vm_eval_set_x) else if (R3 == cell_vm_eval_set_x)
goto eval_set_x; goto eval_set_x;
else if (r3 == cell_vm_macro_expand_car) else if (R3 == cell_vm_macro_expand_car)
goto macro_expand_car; goto macro_expand_car;
else if (r3 == cell_vm_return) else if (R3 == cell_vm_return)
goto vm_return; goto vm_return;
else if (r3 == cell_vm_macro_expand_cdr) else if (R3 == cell_vm_macro_expand_cdr)
goto macro_expand_cdr; goto macro_expand_cdr;
else if (r3 == cell_vm_eval_define) else if (R3 == cell_vm_eval_define)
goto eval_define; goto eval_define;
else if (r3 == cell_vm_macro_expand) else if (R3 == cell_vm_macro_expand)
goto macro_expand; goto macro_expand;
else if (r3 == cell_vm_macro_expand_lambda) else if (R3 == cell_vm_macro_expand_lambda)
goto macro_expand_lambda; goto macro_expand_lambda;
else if (r3 == cell_vm_eval_pmatch_car) else if (R3 == cell_vm_eval_pmatch_car)
goto eval_pmatch_car; goto eval_pmatch_car;
else if (r3 == cell_vm_begin_expand_macro) else if (R3 == cell_vm_begin_expand_macro)
goto begin_expand_macro; goto begin_expand_macro;
else if (r3 == cell_vm_macro_expand_define) else if (R3 == cell_vm_macro_expand_define)
goto macro_expand_define; goto macro_expand_define;
else if (r3 == cell_vm_begin_expand_eval) else if (R3 == cell_vm_begin_expand_eval)
goto begin_expand_eval; goto begin_expand_eval;
else if (r3 == cell_vm_call_with_current_continuation2) else if (R3 == cell_vm_call_with_current_continuation2)
goto call_with_current_continuation2; goto call_with_current_continuation2;
else if (r3 == cell_vm_macro_expand_set_x) else if (R3 == cell_vm_macro_expand_set_x)
goto macro_expand_set_x; goto macro_expand_set_x;
else if (r3 == cell_vm_eval_pmatch_cdr) else if (R3 == cell_vm_eval_pmatch_cdr)
goto eval_pmatch_cdr; goto eval_pmatch_cdr;
else if (r3 == cell_vm_macro_expand_define_macro) else if (R3 == cell_vm_macro_expand_define_macro)
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_evlis) else if (R3 == cell_vm_evlis)
goto evlis; goto evlis;
else if (r3 == cell_vm_apply) else if (R3 == cell_vm_apply)
goto apply; goto apply;
else if (r3 == cell_vm_eval) else if (R3 == cell_vm_eval)
goto eval; goto eval;
else if (r3 == cell_vm_eval_macro_expand_eval) else if (R3 == cell_vm_eval_macro_expand_eval)
goto eval_macro_expand_eval; goto eval_macro_expand_eval;
else if (r3 == cell_vm_eval_macro_expand_expand) else if (R3 == cell_vm_eval_macro_expand_expand)
goto eval_macro_expand_expand; goto eval_macro_expand_expand;
else if (r3 == cell_vm_begin) else if (R3 == cell_vm_begin)
goto begin; goto begin;
else if (r3 == cell_vm_begin_expand) else if (R3 == cell_vm_begin_expand)
goto begin_expand; goto begin_expand;
else if (r3 == cell_vm_begin_expand_primitive_load) else if (R3 == cell_vm_begin_expand_primitive_load)
goto begin_expand_primitive_load; goto begin_expand_primitive_load;
else if (r3 == cell_vm_if) else if (R3 == cell_vm_if)
goto vm_if; goto vm_if;
else if (r3 == cell_vm_call_with_values2) else if (R3 == cell_vm_call_with_values2)
goto call_with_values2; goto call_with_values2;
else if (r3 == cell_unspecified) else if (R3 == cell_unspecified)
return r1; return R1;
else else
error (cell_symbol_system_error, MAKE_STRING0 ("eval/apply unknown continuation")); error (cell_symbol_system_error, MAKE_STRING0 ("eval/apply unknown continuation"));
evlis: evlis:
if (r1 == cell_nil) if (R1 == cell_nil)
goto vm_return; goto vm_return;
if (TYPE (r1) != TPAIR) if (TYPE (R1) != TPAIR)
goto eval; goto eval;
push_cc (CAR (r1), r1, r0, cell_vm_evlis2); push_cc (CAR (R1), R1, R0, cell_vm_evlis2);
goto eval; goto eval;
evlis2: evlis2:
push_cc (CDR (r2), r1, r0, cell_vm_evlis3); push_cc (CDR (R2), R1, R0, cell_vm_evlis3);
goto evlis; goto evlis;
evlis3: evlis3:
r1 = cons (r2, r1); R1 = cons (R2, R1);
goto vm_return; goto vm_return;
apply: apply:
g_stack_array[g_stack + FRAME_PROCEDURE] = CAR (r1); g_stack_array[g_stack + FRAME_PROCEDURE] = CAR (R1);
t = TYPE (CAR (r1)); t = TYPE (CAR (R1));
if (t == TSTRUCT && builtin_p (CAR (r1)) == cell_t) if (t == TSTRUCT && builtin_p (CAR (R1)) == cell_t)
{ {
check_formals (CAR (r1), builtin_arity (CAR (r1)), CDR (r1)); check_formals (CAR (R1), builtin_arity (CAR (R1)), CDR (R1));
r1 = apply_builtin (CAR (r1), CDR (r1)); R1 = apply_builtin (CAR (R1), CDR (R1));
goto vm_return; goto vm_return;
} }
else if (t == TCLOSURE) else if (t == TCLOSURE)
{ {
cl = CLOSURE (CAR (r1)); cl = CLOSURE (CAR (R1));
body = CDDR (cl); body = CDDR (cl);
formals = CADR (cl); formals = CADR (cl);
args = CDR (r1); args = CDR (R1);
aa = CDAR (cl); aa = CDAR (cl);
aa = CDR (aa); aa = CDR (aa);
check_formals (CAR (r1), formals, CDR (r1)); check_formals (CAR (R1), formals, CDR (R1));
p = pairlis (formals, args, aa); p = pairlis (formals, args, aa);
call_lambda (body, p, aa, r0); call_lambda (body, p, aa, R0);
goto begin; goto begin;
} }
else if (t == TCONTINUATION) else if (t == TCONTINUATION)
{ {
v = CONTINUATION (CAR (r1)); v = CONTINUATION (CAR (R1));
if (LENGTH (v) != 0) if (LENGTH (v) != 0)
{ {
for (t = 0; t < LENGTH (v); t = t + 1) for (t = 0; t < LENGTH (v); t = t + 1)
g_stack_array[STACK_SIZE - LENGTH (v) + t] = vector_ref_ (v, t); g_stack_array[STACK_SIZE - LENGTH (v) + t] = vector_ref_ (v, t);
g_stack = STACK_SIZE - LENGTH (v); g_stack = STACK_SIZE - LENGTH (v);
} }
x = r1; x = R1;
gc_pop_frame (); gc_pop_frame ();
r1 = CADR (x); R1 = CADR (x);
goto eval_apply; goto eval_apply;
} }
else if (t == TSPECIAL) else if (t == TSPECIAL)
{ {
c = CAR (r1); c = CAR (R1);
if (c == cell_vm_apply) if (c == cell_vm_apply)
{ {
push_cc (cons (CADR (r1), CADDR (r1)), r1, r0, cell_vm_return); push_cc (cons (CADR (R1), CADDR (R1)), R1, R0, cell_vm_return);
goto apply; goto apply;
} }
else if (c == cell_vm_eval) else if (c == cell_vm_eval)
{ {
push_cc (CADR (r1), r1, CADDR (r1), cell_vm_return); push_cc (CADR (R1), R1, CADDR (R1), cell_vm_return);
goto eval; goto eval;
} }
else if (c == cell_vm_begin_expand) else if (c == cell_vm_begin_expand)
{ {
push_cc (cons (CADR (r1), cell_nil), r1, CADDR (r1), cell_vm_return); push_cc (cons (CADR (R1), cell_nil), R1, CADDR (R1), cell_vm_return);
goto begin_expand; goto begin_expand;
} }
else if (c == cell_call_with_current_continuation) else if (c == cell_call_with_current_continuation)
{ {
r1 = CDR (r1); R1 = CDR (R1);
goto call_with_current_continuation; goto call_with_current_continuation;
} }
else else
check_apply (cell_f, CAR (r1)); check_apply (cell_f, CAR (R1));
} }
else if (t == TSYMBOL) else if (t == TSYMBOL)
{ {
if (CAR (r1) == cell_symbol_call_with_values) if (CAR (R1) == cell_symbol_call_with_values)
{ {
r1 = CDR (r1); R1 = CDR (R1);
goto call_with_values; goto call_with_values;
} }
if (CAR (r1) == cell_symbol_current_module) if (CAR (R1) == cell_symbol_current_module)
{ {
r1 = r0; R1 = R0;
goto vm_return; goto vm_return;
} }
if (CAR (r1) == cell_symbol_boot_module) if (CAR (R1) == cell_symbol_boot_module)
{ {
r1 = m0; R1 = M0;
goto vm_return; goto vm_return;
} }
} }
else if (t == TPAIR) else if (t == TPAIR)
{ {
if (CAAR (r1) == cell_symbol_lambda) if (CAAR (R1) == cell_symbol_lambda)
{ {
formals = CADR (CAR (r1)); formals = CADR (CAR (R1));
args = CDR (r1); args = CDR (R1);
body = CDDR (CAR (r1)); body = CDDR (CAR (R1));
p = pairlis (formals, CDR (r1), r0); p = pairlis (formals, CDR (R1), R0);
check_formals (r1, formals, args); check_formals (R1, formals, args);
call_lambda (body, p, p, r0); call_lambda (body, p, p, R0);
goto begin; goto begin;
} }
} }
push_cc (CAR (r1), r1, r0, cell_vm_apply2); push_cc (CAR (R1), R1, R0, cell_vm_apply2);
goto eval; goto eval;
apply2: apply2:
check_apply (r1, CAR (r2)); check_apply (R1, CAR (R2));
r1 = cons (r1, CDR (r2)); R1 = cons (R1, CDR (R2));
goto apply; goto apply;
eval: eval:
t = TYPE (r1); t = TYPE (R1);
if (t == TPAIR) if (t == TPAIR)
{ {
c = CAR (r1); c = CAR (R1);
if (c == cell_symbol_pmatch_car) if (c == cell_symbol_pmatch_car)
{ {
push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_car); push_cc (CADR (R1), R1, R0, cell_vm_eval_pmatch_car);
goto eval; goto eval;
eval_pmatch_car: eval_pmatch_car:
x = r1; x = R1;
gc_pop_frame (); gc_pop_frame ();
r1 = CAR (x); R1 = CAR (x);
goto eval_apply; goto eval_apply;
} }
else if (c == cell_symbol_pmatch_cdr) else if (c == cell_symbol_pmatch_cdr)
{ {
push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_cdr); push_cc (CADR (R1), R1, R0, cell_vm_eval_pmatch_cdr);
goto eval; goto eval;
eval_pmatch_cdr: eval_pmatch_cdr:
x = r1; x = R1;
gc_pop_frame (); gc_pop_frame ();
r1 = CDR (x); R1 = CDR (x);
goto eval_apply; goto eval_apply;
} }
else if (c == cell_symbol_quote) else if (c == cell_symbol_quote)
{ {
x = r1; x = R1;
gc_pop_frame (); gc_pop_frame ();
r1 = CADR (x); R1 = CADR (x);
goto eval_apply; goto eval_apply;
} }
else if (c == cell_symbol_begin) else if (c == cell_symbol_begin)
goto begin; goto begin;
else if (c == cell_symbol_lambda) else if (c == cell_symbol_lambda)
{ {
r1 = make_closure_ (CADR (r1), CDDR (r1), r0); R1 = make_closure_ (CADR (R1), CDDR (R1), R0);
goto vm_return; goto vm_return;
} }
else if (c == cell_symbol_if) else if (c == cell_symbol_if)
{ {
r1 = CDR (r1); R1 = CDR (R1);
goto vm_if; goto vm_if;
} }
else if (c == cell_symbol_set_x) else if (c == cell_symbol_set_x)
{ {
push_cc (CAR (CDDR (r1)), r1, r0, cell_vm_eval_set_x); push_cc (CAR (CDDR (R1)), R1, R0, cell_vm_eval_set_x);
goto eval; goto eval;
eval_set_x: eval_set_x:
r1 = set_env_x (CADR (r2), r1, r0); R1 = set_env_x (CADR (R2), R1, R0);
goto vm_return; goto vm_return;
} }
else if (c == cell_vm_macro_expand) else if (c == cell_vm_macro_expand)
{ {
push_cc (CADR (r1), r1, r0, cell_vm_eval_macro_expand_eval); push_cc (CADR (R1), R1, R0, cell_vm_eval_macro_expand_eval);
goto eval; goto eval;
eval_macro_expand_eval: eval_macro_expand_eval:
push_cc (r1, r2, r0, cell_vm_eval_macro_expand_expand); push_cc (R1, R2, R0, cell_vm_eval_macro_expand_expand);
goto macro_expand; goto macro_expand;
eval_macro_expand_expand: eval_macro_expand_expand:
goto vm_return; goto vm_return;
} }
else else
{ {
if (TYPE (r1) == TPAIR && (CAR (r1) == cell_symbol_define || CAR (r1) == cell_symbol_define_macro)) if (TYPE (R1) == TPAIR && (CAR (R1) == cell_symbol_define || CAR (R1) == cell_symbol_define_macro))
{ {
global_p = CAAR (r0) != cell_closure; global_p = CAAR (R0) != cell_closure;
macro_p = CAR (r1) == cell_symbol_define_macro; macro_p = CAR (R1) == cell_symbol_define_macro;
if (global_p != 0) if (global_p != 0)
{ {
name = CADR (r1); name = CADR (R1);
if (TYPE (CADR (r1)) == TPAIR) if (TYPE (CADR (R1)) == TPAIR)
name = CAR (name); name = CAR (name);
if (macro_p != 0) if (macro_p != 0)
{ {
@ -622,287 +622,287 @@ eval:
} }
else else
{ {
entry = module_variable (r0, name); entry = module_variable (R0, name);
if (entry == cell_f) if (entry == cell_f)
module_define_x (m0, name, cell_f); module_define_x (M0, name, cell_f);
} }
} }
r2 = r1; R2 = R1;
if (TYPE (CADR (r1)) != TPAIR) if (TYPE (CADR (R1)) != TPAIR)
{ {
push_cc (CAR (CDDR (r1)), r2, cons (cons (CADR (r1), CADR (r1)), r0), cell_vm_eval_define); push_cc (CAR (CDDR (R1)), R2, cons (cons (CADR (R1), CADR (R1)), R0), cell_vm_eval_define);
goto eval; goto eval;
} }
else else
{ {
p = pairlis (CADR (r1), CADR (r1), r0); p = pairlis (CADR (R1), CADR (R1), R0);
formals = CDR (CADR (r1)); formals = CDR (CADR (R1));
body = CDDR (r1); body = CDDR (R1);
if (macro_p || global_p) if (macro_p || global_p)
expand_variable (body, formals); expand_variable (body, formals);
r1 = cons (cell_symbol_lambda, cons (formals, body)); R1 = cons (cell_symbol_lambda, cons (formals, body));
push_cc (r1, r2, p, cell_vm_eval_define); push_cc (R1, R2, p, cell_vm_eval_define);
goto eval; goto eval;
} }
eval_define: eval_define:
name = CADR (r2); name = CADR (R2);
if (TYPE (CADR (r2)) == TPAIR) if (TYPE (CADR (R2)) == TPAIR)
name = CAR (name); name = CAR (name);
if (macro_p != 0) if (macro_p != 0)
{ {
entry = macro_get_handle (name); entry = macro_get_handle (name);
r1 = MAKE_MACRO (name, r1); R1 = MAKE_MACRO (name, R1);
set_cdr_x (entry, r1); set_cdr_x (entry, R1);
} }
else if (global_p != 0) else if (global_p != 0)
{ {
entry = module_variable (r0, name); entry = module_variable (R0, name);
set_cdr_x (entry, r1); set_cdr_x (entry, R1);
} }
else else
{ {
entry = cons (name, r1); entry = cons (name, R1);
aa = cons (entry, cell_nil); aa = cons (entry, cell_nil);
set_cdr_x (aa, cdr (r0)); set_cdr_x (aa, cdr (R0));
set_cdr_x (r0, aa); set_cdr_x (R0, aa);
cl = module_variable (r0, cell_closure); cl = module_variable (R0, cell_closure);
set_cdr_x (cl, aa); set_cdr_x (cl, aa);
} }
r1 = cell_unspecified; R1 = cell_unspecified;
goto vm_return; goto vm_return;
} }
push_cc (CAR (r1), r1, r0, cell_vm_eval_check_func); push_cc (CAR (R1), R1, R0, cell_vm_eval_check_func);
gc_check (); gc_check ();
goto eval; goto eval;
eval_check_func: eval_check_func:
push_cc (CDR (r2), r2, r0, cell_vm_eval2); push_cc (CDR (R2), R2, R0, cell_vm_eval2);
goto evlis; goto evlis;
eval2: eval2:
r1 = cons (CAR (r2), r1); R1 = cons (CAR (R2), R1);
goto apply; goto apply;
} }
} }
else if (t == TSYMBOL) else if (t == TSYMBOL)
{ {
if (r1 == cell_symbol_boot_module) if (R1 == cell_symbol_boot_module)
goto vm_return; goto vm_return;
if (r1 == cell_symbol_current_module) if (R1 == cell_symbol_current_module)
goto vm_return; goto vm_return;
if (r1 == cell_symbol_begin) if (R1 == cell_symbol_begin)
{ {
r1 = cell_begin; R1 = cell_begin;
goto vm_return; goto vm_return;
} }
r1 = assert_defined (r1, module_ref (r0, r1)); R1 = assert_defined (R1, module_ref (R0, R1));
goto vm_return; goto vm_return;
} }
else if (t == TVARIABLE) else if (t == TVARIABLE)
{ {
r1 = CDR (VARIABLE (r1)); R1 = CDR (VARIABLE (R1));
goto vm_return; goto vm_return;
} }
else if (t == TBROKEN_HEART) else if (t == TBROKEN_HEART)
error (cell_symbol_system_error, r1); error (cell_symbol_system_error, R1);
else else
goto vm_return; goto vm_return;
macro_expand: macro_expand:
if (TYPE (r1) != TPAIR || CAR (r1) == cell_symbol_quote) if (TYPE (R1) != TPAIR || CAR (R1) == cell_symbol_quote)
goto vm_return; goto vm_return;
if (CAR (r1) == cell_symbol_lambda) if (CAR (R1) == cell_symbol_lambda)
{ {
push_cc (CDDR (r1), r1, r0, cell_vm_macro_expand_lambda); push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_lambda);
goto macro_expand; goto macro_expand;
macro_expand_lambda: macro_expand_lambda:
CDDR (r2) = r1; CDDR (R2) = R1;
r1 = r2; R1 = R2;
goto vm_return; goto vm_return;
} }
if (TYPE (r1) == TPAIR && (macro = get_macro (CAR (r1))) != cell_f) if (TYPE (R1) == TPAIR && (macro = get_macro (CAR (R1))) != cell_f)
{ {
r1 = cons (macro, CDR (r1)); R1 = cons (macro, CDR (R1));
push_cc (r1, cell_nil, r0, cell_vm_macro_expand); push_cc (R1, cell_nil, R0, cell_vm_macro_expand);
goto apply; goto apply;
} }
if (CAR (r1) == cell_symbol_define || CAR (r1) == cell_symbol_define_macro) if (CAR (R1) == cell_symbol_define || CAR (R1) == cell_symbol_define_macro)
{ {
push_cc (CDDR (r1), r1, r0, cell_vm_macro_expand_define); push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_define);
goto macro_expand; goto macro_expand;
macro_expand_define: macro_expand_define:
CDDR (r2) = r1; CDDR (R2) = R1;
r1 = r2; R1 = R2;
if (CAR (r1) == cell_symbol_define_macro) if (CAR (R1) == cell_symbol_define_macro)
{ {
push_cc (r1, r1, r0, cell_vm_macro_expand_define_macro); push_cc (R1, R1, R0, cell_vm_macro_expand_define_macro);
goto eval; goto eval;
macro_expand_define_macro: macro_expand_define_macro:
r1 = r2; R1 = R2;
} }
goto vm_return; goto vm_return;
} }
if (CAR (r1) == cell_symbol_set_x) if (CAR (R1) == cell_symbol_set_x)
{ {
push_cc (CDDR (r1), r1, r0, cell_vm_macro_expand_set_x); push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_set_x);
goto macro_expand; goto macro_expand;
macro_expand_set_x: macro_expand_set_x:
CDDR (r2) = r1; CDDR (R2) = R1;
r1 = r2; R1 = R2;
goto vm_return; goto vm_return;
} }
if (TYPE (r1) == TPAIR if (TYPE (R1) == TPAIR
&& TYPE (CAR (r1)) == TSYMBOL && TYPE (CAR (R1)) == TSYMBOL
&& CAR (r1) != cell_symbol_begin && CAR (R1) != cell_symbol_begin
&& ((macro = macro_get_handle (cell_symbol_portable_macro_expand)) != cell_f) && ((macro = macro_get_handle (cell_symbol_portable_macro_expand)) != cell_f)
&& ((expanders = module_ref (r0, cell_symbol_sc_expander_alist)) != cell_undefined) && ((expanders = module_ref (R0, cell_symbol_sc_expander_alist)) != cell_undefined)
&& ((macro = assq (CAR (r1), expanders)) != cell_f)) && ((macro = assq (CAR (R1), expanders)) != cell_f))
{ {
sc_expand = module_ref (r0, cell_symbol_macro_expand); sc_expand = module_ref (R0, cell_symbol_macro_expand);
r2 = r1; R2 = R1;
if (sc_expand != cell_undefined && sc_expand != cell_f) if (sc_expand != cell_undefined && sc_expand != cell_f)
{ {
r1 = cons (sc_expand, cons (r1, cell_nil)); R1 = cons (sc_expand, cons (R1, cell_nil));
goto apply; goto apply;
} }
} }
push_cc (CAR (r1), r1, r0, cell_vm_macro_expand_car); push_cc (CAR (R1), R1, R0, cell_vm_macro_expand_car);
goto macro_expand; goto macro_expand;
macro_expand_car: macro_expand_car:
CAR (r2) = r1; CAR (R2) = R1;
r1 = r2; R1 = R2;
if (CDR (r1) == cell_nil) if (CDR (R1) == cell_nil)
goto vm_return; goto vm_return;
push_cc (CDR (r1), r1, r0, cell_vm_macro_expand_cdr); push_cc (CDR (R1), R1, R0, cell_vm_macro_expand_cdr);
goto macro_expand; goto macro_expand;
macro_expand_cdr: macro_expand_cdr:
CDR (r2) = r1; CDR (R2) = R1;
r1 = r2; R1 = R2;
goto vm_return; goto vm_return;
begin: begin:
x = cell_unspecified; x = cell_unspecified;
while (r1 != cell_nil) while (R1 != cell_nil)
{ {
gc_check (); gc_check ();
if (TYPE (r1) == TPAIR) if (TYPE (R1) == TPAIR)
{ {
if (CAAR (r1) == cell_symbol_primitive_load) if (CAAR (R1) == cell_symbol_primitive_load)
{ {
program = cons (CAR (r1), cell_nil); program = cons (CAR (R1), cell_nil);
push_cc (program, r1, r0, cell_vm_begin_primitive_load); push_cc (program, R1, R0, cell_vm_begin_primitive_load);
goto begin_expand; goto begin_expand;
begin_primitive_load: begin_primitive_load:
CAR (r2) = r1; CAR (R2) = R1;
r1 = r2; R1 = R2;
} }
} }
if (TYPE (r1) == TPAIR && TYPE (CAR (r1)) == TPAIR) if (TYPE (R1) == TPAIR && TYPE (CAR (R1)) == TPAIR)
{ {
if (CAAR (r1) == cell_symbol_begin) if (CAAR (R1) == cell_symbol_begin)
r1 = append2 (CDAR (r1), CDR (r1)); R1 = append2 (CDAR (R1), CDR (R1));
} }
if (CDR (r1) == cell_nil) if (CDR (R1) == cell_nil)
{ {
r1 = CAR (r1); R1 = CAR (R1);
goto eval; goto eval;
} }
push_cc (CAR (r1), r1, r0, cell_vm_begin_eval); push_cc (CAR (R1), R1, R0, cell_vm_begin_eval);
goto eval; goto eval;
begin_eval: begin_eval:
x = r1; x = R1;
r1 = CDR (r2); R1 = CDR (R2);
} }
r1 = x; R1 = x;
goto vm_return; goto vm_return;
begin_expand: begin_expand:
x = cell_unspecified; x = cell_unspecified;
while (r1 != cell_nil) while (R1 != cell_nil)
{ {
gc_check (); gc_check ();
if (TYPE (r1) == TPAIR) if (TYPE (R1) == TPAIR)
{ {
if (TYPE (CAR (r1)) == TPAIR && CAAR (r1) == cell_symbol_begin) if (TYPE (CAR (R1)) == TPAIR && CAAR (R1) == cell_symbol_begin)
r1 = append2 (CDAR (r1), CDR (r1)); R1 = append2 (CDAR (R1), CDR (R1));
if (CAAR (r1) == cell_symbol_primitive_load) if (CAAR (R1) == cell_symbol_primitive_load)
{ {
push_cc (CADR (CAR (r1)), r1, r0, cell_vm_begin_expand_primitive_load); push_cc (CADR (CAR (R1)), R1, R0, cell_vm_begin_expand_primitive_load);
goto eval; goto eval;
begin_expand_primitive_load: begin_expand_primitive_load:
if (TYPE (r1) == TNUMBER && VALUE (r1) == 0) if (TYPE (R1) == TNUMBER && VALUE (R1) == 0)
0; 0;
else if (TYPE (r1) == TSTRING) else if (TYPE (R1) == TSTRING)
input = set_current_input_port (open_input_file (r1)); input = set_current_input_port (open_input_file (R1));
else if (TYPE (r1) == TPORT) else if (TYPE (R1) == TPORT)
input = set_current_input_port (r1); input = set_current_input_port (R1);
else else
assert_msg (0, "0"); assert_msg (0, "0");
push_cc (input, r2, r0, cell_vm_return); push_cc (input, R2, R0, cell_vm_return);
x = read_input_file_env (r0); x = read_input_file_env (R0);
if (g_debug > 5) if (g_debug > 5)
module_printer (m0); module_printer (M0);
gc_pop_frame (); gc_pop_frame ();
input = r1; input = R1;
r1 = x; R1 = x;
set_current_input_port (input); set_current_input_port (input);
r1 = cons (cell_symbol_begin, r1); R1 = cons (cell_symbol_begin, R1);
CAR (r2) = r1; CAR (R2) = R1;
r1 = r2; R1 = R2;
continue; continue;
} }
} }
push_cc (CAR (r1), r1, r0, cell_vm_begin_expand_macro); push_cc (CAR (R1), R1, R0, cell_vm_begin_expand_macro);
goto macro_expand; goto macro_expand;
begin_expand_macro: begin_expand_macro:
if (r1 != CAR (r2)) if (R1 != CAR (R2))
{ {
CAR (r2) = r1; CAR (R2) = R1;
r1 = r2; R1 = R2;
continue; continue;
} }
r1 = r2; R1 = R2;
expand_variable (CAR (r1), cell_nil); expand_variable (CAR (R1), cell_nil);
push_cc (CAR (r1), r1, r0, cell_vm_begin_expand_eval); push_cc (CAR (R1), R1, R0, cell_vm_begin_expand_eval);
goto eval; goto eval;
begin_expand_eval: begin_expand_eval:
x = r1; x = R1;
r1 = CDR (r2); R1 = CDR (R2);
} }
r1 = x; R1 = x;
goto vm_return; goto vm_return;
vm_if: vm_if:
push_cc (CAR (r1), r1, r0, cell_vm_if_expr); push_cc (CAR (R1), R1, R0, cell_vm_if_expr);
goto eval; goto eval;
if_expr: if_expr:
x = r1; x = R1;
r1 = r2; R1 = R2;
if (x != cell_f) if (x != cell_f)
{ {
r1 = CADR (r1); R1 = CADR (R1);
goto eval; goto eval;
} }
if (CDDR (r1) != cell_nil) if (CDDR (R1) != cell_nil)
{ {
r1 = CAR (CDDR (r1)); R1 = CAR (CDDR (R1));
goto eval; goto eval;
} }
r1 = cell_unspecified; R1 = cell_unspecified;
goto vm_return; goto vm_return;
call_with_current_continuation: call_with_current_continuation:
@ -914,35 +914,35 @@ call_with_current_continuation:
vector_set_x_ (v, t - g_stack, g_stack_array[t]); vector_set_x_ (v, t - g_stack, g_stack_array[t]);
CONTINUATION (x) = v; CONTINUATION (x) = v;
gc_pop_frame (); gc_pop_frame ();
push_cc (cons (CAR (r1), cons (x, cell_nil)), x, r0, cell_vm_call_with_current_continuation2); push_cc (cons (CAR (R1), cons (x, cell_nil)), x, R0, cell_vm_call_with_current_continuation2);
goto apply; goto apply;
call_with_current_continuation2: call_with_current_continuation2:
v = make_vector__ (STACK_SIZE - g_stack); v = make_vector__ (STACK_SIZE - g_stack);
for (t = g_stack; t < STACK_SIZE; t = t + 1) for (t = g_stack; t < STACK_SIZE; t = t + 1)
vector_set_x_ (v, t - g_stack, g_stack_array[t]); vector_set_x_ (v, t - g_stack, g_stack_array[t]);
CONTINUATION (r2) = v; CONTINUATION (R2) = v;
goto vm_return; goto vm_return;
call_with_values: call_with_values:
push_cc (cons (CAR (r1), cell_nil), r1, r0, cell_vm_call_with_values2); push_cc (cons (CAR (R1), cell_nil), R1, R0, cell_vm_call_with_values2);
goto apply; goto apply;
call_with_values2: call_with_values2:
if (TYPE (r1) == TVALUES) if (TYPE (R1) == TVALUES)
r1 = CDR (r1); R1 = CDR (R1);
r1 = cons (CADR (r2), r1); R1 = cons (CADR (R2), R1);
goto apply; goto apply;
vm_return: vm_return:
x = r1; x = R1;
gc_pop_frame (); gc_pop_frame ();
r1 = x; R1 = x;
goto eval_apply; goto eval_apply;
} }
SCM SCM
apply (SCM f, SCM x, SCM a) /*:((internal)) */ apply (SCM f, SCM x, SCM a) /*:((internal)) */
{ {
push_cc (cons (f, x), cell_unspecified, r0, cell_unspecified); push_cc (cons (f, x), cell_unspecified, R0, cell_unspecified);
r3 = cell_vm_apply; R3 = cell_vm_apply;
return eval_apply (); return eval_apply ();
} }

22
src/gc.c
View File

@ -271,7 +271,7 @@ gc_ () /*:((internal)) */
g_symbols = gc_copy (g_symbols); g_symbols = gc_copy (g_symbols);
g_macros = gc_copy (g_macros); g_macros = gc_copy (g_macros);
g_ports = gc_copy (g_ports); g_ports = gc_copy (g_ports);
m0 = gc_copy (m0); M0 = gc_copy (M0);
for (i = g_stack; i < STACK_SIZE; i = i + 1) for (i = g_stack; i < STACK_SIZE; i = i + 1)
g_stack_array[i] = gc_copy (g_stack_array[i]); g_stack_array[i] = gc_copy (g_stack_array[i]);
gc_loop (1); gc_loop (1);
@ -286,7 +286,7 @@ gc ()
write_error_ (g_symbols); write_error_ (g_symbols);
eputs ("\n"); eputs ("\n");
eputs ("R0: "); eputs ("R0: ");
write_error_ (r0); write_error_ (R0);
eputs ("\n"); eputs ("\n");
} }
gc_push_frame (); gc_push_frame ();
@ -298,7 +298,7 @@ gc ()
write_error_ (g_symbols); write_error_ (g_symbols);
eputs ("\n"); eputs ("\n");
eputs ("R0: "); eputs ("R0: ");
write_error_ (r0); write_error_ (R0);
eputs ("\n"); eputs ("\n");
} }
} }
@ -309,10 +309,10 @@ gc_push_frame () /*:((internal)) */
if (g_stack < 5) if (g_stack < 5)
assert_msg (0, "STACK FULL"); assert_msg (0, "STACK FULL");
g_stack_array[g_stack - 1] = cell_f; g_stack_array[g_stack - 1] = cell_f;
g_stack_array[g_stack - 2] = r0; g_stack_array[g_stack - 2] = R0;
g_stack_array[g_stack - 3] = r1; g_stack_array[g_stack - 3] = R1;
g_stack_array[g_stack - 4] = r2; g_stack_array[g_stack - 4] = R2;
g_stack_array[g_stack - 5] = r3; g_stack_array[g_stack - 5] = R3;
g_stack = g_stack - 5; g_stack = g_stack - 5;
return g_stack; return g_stack;
} }
@ -320,10 +320,10 @@ gc_push_frame () /*:((internal)) */
SCM SCM
gc_peek_frame () /*:((internal)) */ gc_peek_frame () /*:((internal)) */
{ {
r3 = g_stack_array[g_stack]; R3 = g_stack_array[g_stack];
r2 = g_stack_array[g_stack + 1]; R2 = g_stack_array[g_stack + 1];
r1 = g_stack_array[g_stack + 2]; R1 = g_stack_array[g_stack + 2];
r0 = g_stack_array[g_stack + 3]; R0 = g_stack_array[g_stack + 3];
return g_stack_array[g_stack + FRAME_PROCEDURE]; return g_stack_array[g_stack + FRAME_PROCEDURE];
} }

34
src/mes.c
View File

@ -201,8 +201,8 @@ error (SCM key, SCM x)
{ {
#if !__MESC_MES__ #if !__MESC_MES__
SCM throw; SCM throw;
if ((throw = module_ref (r0, cell_symbol_throw)) != cell_undefined) if ((throw = module_ref (R0, cell_symbol_throw)) != cell_undefined)
return apply (throw, cons (key, cons (x, cell_nil)), r0); return apply (throw, cons (key, cons (x, cell_nil)), R0);
#endif #endif
display_error_ (key); display_error_ (key);
eputs (": "); eputs (": ");
@ -304,11 +304,11 @@ SCM
mes_g_stack (SCM a) /*:((internal)) */ mes_g_stack (SCM a) /*:((internal)) */
{ {
g_stack = STACK_SIZE; g_stack = STACK_SIZE;
r0 = a; R0 = a;
r1 = MAKE_CHAR (0); R1 = MAKE_CHAR (0);
r2 = MAKE_CHAR (0); R2 = MAKE_CHAR (0);
r3 = MAKE_CHAR (0); R3 = MAKE_CHAR (0);
return r0; return R0;
} }
SCM SCM
@ -436,9 +436,9 @@ open_boot ()
SCM SCM
read_boot () /*:((internal)) */ read_boot () /*:((internal)) */
{ {
r2 = read_input_file_env (r0); R2 = read_input_file_env (R0);
__stdin = STDIN; __stdin = STDIN;
return r2; return R2;
} }
void void
@ -469,14 +469,14 @@ main (int argc, char **argv, char **envp)
SCM a = mes_environment (argc, argv); SCM a = mes_environment (argc, argv);
a = mes_builtins (a); a = mes_builtins (a);
a = init_time (a); a = init_time (a);
m0 = make_initial_module (a); M0 = make_initial_module (a);
g_macros = make_hash_table_ (0); g_macros = make_hash_table_ (0);
if (g_debug > 5) if (g_debug > 5)
module_printer (m0); module_printer (M0);
SCM program = read_boot (); SCM program = read_boot ();
push_cc (r2, cell_unspecified, r0, cell_unspecified); push_cc (R2, cell_unspecified, R0, cell_unspecified);
if (g_debug > 2) if (g_debug > 2)
{ {
@ -487,20 +487,20 @@ main (int argc, char **argv, char **envp)
if (g_debug > 3) if (g_debug > 3)
{ {
eputs ("program: "); eputs ("program: ");
write_error_ (r1); write_error_ (R1);
eputs ("\n"); eputs ("\n");
} }
r3 = cell_vm_begin_expand; R3 = cell_vm_begin_expand;
r1 = eval_apply (); R1 = eval_apply ();
if (g_debug != 0) if (g_debug != 0)
{ {
write_error_ (r1); write_error_ (R1);
eputs ("\n"); eputs ("\n");
} }
if (g_debug != 0) if (g_debug != 0)
{ {
if (g_debug > 5) if (g_debug > 5)
module_printer (m0); module_printer (M0);
eputs ("\ngc stats: ["); eputs ("\ngc stats: [");
eputs (itoa (g_free)); eputs (itoa (g_free));

12
src/module.c
View File

@ -52,10 +52,10 @@ make_initial_module (SCM a) /*:((internal)) */
values = cons (name, values); values = cons (name, values);
values = cons (cell_symbol_module, values); values = cons (cell_symbol_module, values);
SCM module = make_struct (module_type, values, cstring_to_symbol ("module-printer")); SCM module = make_struct (module_type, values, cstring_to_symbol ("module-printer"));
r0 = cell_nil; R0 = cell_nil;
r0 = cons (CADR (a), r0); R0 = cons (CADR (a), R0);
r0 = cons (CAR (a), r0); R0 = cons (CAR (a), R0);
m0 = module; M0 = module;
while (TYPE (a) == TPAIR) while (TYPE (a) == TPAIR)
{ {
module_define_x (module, CAAR (a), CDAR (a)); module_define_x (module, CAAR (a), CDAR (a));
@ -91,7 +91,7 @@ module_variable (SCM module, SCM name)
SCM x = assq (name, locals); SCM x = assq (name, locals);
if (x == cell_f) if (x == cell_f)
{ {
module = m0; module = M0;
SCM globals = struct_ref_ (module, 5); SCM globals = struct_ref_ (module, 5);
x = hashq_get_handle (globals, name, cell_f); x = hashq_get_handle (globals, name, cell_f);
} }
@ -110,7 +110,7 @@ module_ref (SCM module, SCM name)
SCM SCM
module_define_x (SCM module, SCM name, SCM value) module_define_x (SCM module, SCM name, SCM value)
{ {
module = m0; module = M0;
SCM globals = struct_ref_ (module, 5); SCM globals = struct_ref_ (module, 5);
return hashq_set_x (globals, name, value); return hashq_set_x (globals, name, value);
} }

4
src/reader.c
View File

@ -37,8 +37,8 @@ read_input_file_env_ (SCM e, SCM a)
SCM SCM
read_input_file_env (SCM a) read_input_file_env (SCM a)
{ {
//r0 = a; //R0 = a;
//return read_input_file_env_ (read_env (r0), r0); //return read_input_file_env_ (read_env (R0), R0);
return read_input_file_env_ (read_env (cell_nil), cell_nil); return read_input_file_env_ (read_env (cell_nil), cell_nil);
} }