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

core: Implement stack and frame. 

* src/lib.c (frame_printer make_frame_type, make_frame,
make_stack_type, make_stack, stack_length, stack_ref): New function.
This commit is contained in:
Jan Nieuwenhuizen 2018-10-20 18:23:20 +02:00
parent 46ce2c71cd
commit b7819a3c7d
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
4 changed files with 107 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
scaffold/mini-mes.c
View File

@ -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, "<hashq-table>",0};
struct scm scm_symbol_record_type = {TSYMBOL, "<record-type>",0};
struct scm scm_symbol_frame = {TSYMBOL, "<frame>",0};
struct scm scm_symbol_module = {TSYMBOL, "<module>",0};
struct scm scm_symbol_stack = {TSYMBOL, "<stack>",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;

1
src/gc.c
View File

@ -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<STACK_SIZE; i++)
g_stack_array[i]= gc_copy (g_stack_array[i]);
gc_loop (1);

78
src/lib.c
View File

@ -268,6 +268,84 @@ exit_ (SCM x) ///((name . "exit"))
exit (VALUE (x));
}
#if !MES_MINI
SCM
frame_printer (SCM frame)
{
fdputs ("#<", g_stdout); display_ (struct_ref_ (frame, 2));
fdputc (' ', g_stdout);
fdputs ("procedure: ", g_stdout); display_ (struct_ref_ (frame, 3));
fdputc ('>', 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<size; i++)
{
SCM frame = make_frame (stack, i);
vector_set_x_ (frames, i, frame);
}
SCM values = cell_nil;
values = cons (frames, values);
values = cons (cell_symbol_stack, values);
return make_struct (stack_type, values, cell_unspecified);
}
SCM
stack_length (SCM stack)
{
SCM frames = struct_ref_ (stack, 3);
return vector_length (frames);
}
SCM
stack_ref (SCM stack, SCM index)
{
SCM frames = struct_ref_ (stack, 3);
return vector_ref (frames, index);
}
#endif // !MES_MINI
SCM
xassq (SCM x, SCM a) ///for speed in core only
{

12
src/mes.c
View File

@ -46,6 +46,8 @@ SCM g_continuations = 0;
SCM g_symbols = 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
@ -202,8 +204,11 @@ struct scm scm_symbol_unbound_variable = {TSYMBOL, "unbound-variable",0};
struct scm scm_symbol_hashq_table = {TSYMBOL, "<hashq-table>",0};
struct scm scm_symbol_record_type = {TSYMBOL, "<record-type>",0};
struct scm scm_symbol_frame = {TSYMBOL, "<frame>",0};
struct scm scm_symbol_module = {TSYMBOL, "<module>",0};
struct scm scm_symbol_stack = {TSYMBOL, "<stack>",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