diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c index 0391b556..e1366dd1 100644 --- a/scaffold/mini-mes.c +++ b/scaffold/mini-mes.c @@ -50,6 +50,8 @@ SCM g_macros = 0; SCM g_ports = 0; SCM g_stack = 0; SCM *g_stack_array = 0; +#define FRAME_SIZE 5 +#define FRAME_PROCEDURE 4 // a/env SCM r0 = 0; // param 1 @@ -58,6 +60,8 @@ SCM r1 = 0; SCM r2 = 0; // continuation SCM r3 = 0; +// current-module +SCM m0 = 0; enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TPORT, TREF, TSPECIAL, TSTRING, TSTRUCT, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART}; @@ -136,8 +140,11 @@ struct scm scm_symbol_unbound_variable = {TSYMBOL, "unbound-variable",0}; struct scm scm_symbol_hashq_table = {TSYMBOL, "",0}; struct scm scm_symbol_record_type = {TSYMBOL, "",0}; +struct scm scm_symbol_frame = {TSYMBOL, "",0}; struct scm scm_symbol_module = {TSYMBOL, "",0}; +struct scm scm_symbol_stack = {TSYMBOL, "",0}; struct scm scm_symbol_buckets = {TSYMBOL, "buckets",0}; +struct scm scm_symbol_procedure = {TSYMBOL, "procedure",0}; struct scm scm_symbol_size = {TSYMBOL, "size",0}; struct scm scm_symbol_argv = {TSYMBOL, "%argv",0}; @@ -807,6 +814,19 @@ make_tmps (struct scm* cells) #endif #include "lib.c" +SCM frame_printer (SCM frame) +{ +} +SCM make_stack (SCM stack) +{ +} +SCM stack_length (SCM stack) +{ +} +SCM stack_ref (SCM stack, SCM index) +{ +} + // Jam Collector SCM g_symbol_max; diff --git a/src/gc.c b/src/gc.c index fc2cd5c3..7dfb5831 100644 --- a/src/gc.c +++ b/src/gc.c @@ -202,6 +202,7 @@ gc_ () ///((internal)) g_symbols = gc_copy (g_symbols); g_macros = gc_copy (g_macros); g_ports = gc_copy (g_ports); + m0 = gc_copy (m0); for (long i=g_stack; i', g_stdout); +} + +SCM +make_frame_type () ///((internal)) +{ + SCM record_type = cell_symbol_record_type; // FIXME + SCM fields = cell_nil; + fields = cons (cell_symbol_procedure, fields); + fields = cons (fields, cell_nil); + fields = cons (cell_symbol_frame, fields); + return make_struct (record_type, fields, cell_unspecified); +} + +SCM +make_frame (SCM stack, long index) +{ + SCM frame_type = make_frame_type (); + long array_index = (STACK_SIZE-(index*FRAME_SIZE)); + SCM procedure = g_stack_array[array_index+FRAME_PROCEDURE]; + if (!procedure) + procedure = cell_f; + SCM values = cell_nil; + values = cons (procedure, values); + values = cons (cell_symbol_frame, values); + return make_struct (frame_type, values, cell_frame_printer); +} + +SCM +make_stack_type () ///((internal)) +{ + SCM record_type = cell_symbol_record_type; // FIXME + SCM fields = cell_nil; + fields = cons (cstring_to_symbol ("frames"), fields); + fields = cons (fields, cell_nil); + fields = cons (cell_symbol_stack, fields); + return make_struct (record_type, fields, cell_unspecified); +} + +SCM +make_stack (SCM stack) ///((arity . n)) +{ + SCM stack_type = make_stack_type (); + long size = (STACK_SIZE-g_stack) / FRAME_SIZE; + SCM frames = make_vector__ (size); + for (long i=0; i",0}; struct scm scm_symbol_record_type = {TSYMBOL, "",0}; +struct scm scm_symbol_frame = {TSYMBOL, "",0}; struct scm scm_symbol_module = {TSYMBOL, "",0}; +struct scm scm_symbol_stack = {TSYMBOL, "",0}; struct scm scm_symbol_buckets = {TSYMBOL, "buckets",0}; +struct scm scm_symbol_procedure = {TSYMBOL, "procedure",0}; struct scm scm_symbol_size = {TSYMBOL, "size",0}; struct scm scm_symbol_argv = {TSYMBOL, "%argv",0}; @@ -701,16 +706,15 @@ gc_peek_frame () ///((internal)) r2 = g_stack_array[g_stack+1]; r1 = g_stack_array[g_stack+2]; r0 = g_stack_array[g_stack+3]; - m0 = g_stack_array[g_stack+4]; - return m0; + return g_stack_array[g_stack+FRAME_PROCEDURE]; } SCM gc_pop_frame () ///((internal)) { - gc_peek_frame (); + SCM x = gc_peek_frame (); g_stack += 5; - return m0; + return x; } SCM