mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-15 15:21:03 -08:00
Code Issues Projects Releases Packages Wiki Activity

[nucl] liberate stack frames from stack allocation terror

Browse source
This commit is contained in:
Daniel Kochmański 2025-05-30 12:59:55 +02:00
parent 8eb45e7041
commit fcd91a20c2
1 changed files with 56 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

86
src/c/nucl.c
View file

@ -146,6 +146,24 @@ nucl_alloc_symbol(cl_object name, cl_object value)
return x;
}
cl_object
nucl_alloc_readtable(void) {
cl_object rtable = ecl_alloc_object(t_readtable);
struct ecl_readtable_entry *rtab = (struct ecl_readtable_entry *)
ecl_alloc(RTABSIZE * sizeof(struct ecl_readtable_entry));
rtable->readtable.locked = 0;
rtable->readtable.read_case = ecl_case_preserve; /* enum ecl_readtable_case */
rtable->readtable.table = rtab;
for (int i = 0; i < RTABSIZE; i++) {
rtab[i].syntax_type = cat_constituent; /* enum ecl_chattrib */
rtab[i].dispatch = ECL_NIL;
}
#ifdef ECL_UNICODE
rtable->readtable.hash = ECL_NIL;
#endif
return rtable;
}
/* -- Special variables ----------------------------------------------------- */
#define DEFINE_SPECIAL(var,name,value) \
static cl_object var = \
@ -156,16 +174,27 @@ nucl_alloc_symbol(cl_object name, cl_object value)
DEFINE_SPECIAL(nucl_fp, "*FP*", ECL_NIL); /* stack frame */
#define open_nucl_frame(name) \
const cl_env_ptr the_env = ecl_process_env(); \
struct ecl_stack_frame nucl_frame_aux; \
cl_object name = ecl_cast_ptr(cl_object, &nucl_frame_aux); \
ecl_stack_frame_open(the_env, name, 0); \
ecl_bds_bind(the_env, nucl_fp, name);
static struct ecl_stack_frame nucl_frames[64];
static cl_index sfi = 0;
cl_object
open_nucl_frame(void) {
const cl_env_ptr the_env = ecl_process_env();
if(sfi==64) ecl_internal_error("Stack frame overflow :3");
cl_object f = ecl_cast_ptr(cl_object, &nucl_frames[sfi++]);
ecl_stack_frame_open(the_env, f, 0);
ecl_bds_bind(the_env, nucl_fp, f);
return f;
}
#define close_nucl_frame(name) \
ecl_bds_unwind1(the_env); \
ecl_stack_frame_close(name);
void
close_nucl_frame(void) {
const cl_env_ptr the_env = ecl_process_env();
if(sfi==0) ecl_internal_error("Stack frame underflow :3");
cl_object f = ECL_SYM_VAL(the_env, nucl_fp);
ecl_bds_unwind1(the_env);
ecl_stack_frame_close(f);
sfi--;
}
static cl_object
nucl_stack_frame(void)
@ -362,7 +391,7 @@ nucl_write_string(cl_object strm, cl_object s)
void
nucl_write_fixnum(cl_object strm, cl_object s)
{
open_nucl_frame(frame);
cl_object frame = open_nucl_frame();
cl_object c=ECL_NIL;
cl_fixnum value = ecl_fixnum(s), dig;
if(value<0) value = -value;
@ -376,7 +405,7 @@ nucl_write_fixnum(cl_object strm, cl_object s)
loop_across_frame_filo(elt, frame) {
si_write_char(strm, elt);
} end_loop_across_frame();
close_nucl_frame(frame);
close_nucl_frame();
}
cl_object
@ -607,24 +636,20 @@ ecl_def_function(_mixnum_reader, mixnum_reader, static, const);
void
init_nucl_reader(void)
{
rtable = ecl_alloc_object(t_readtable);
struct ecl_readtable_entry *rtab = (struct ecl_readtable_entry *)
ecl_alloc(RTABSIZE * sizeof(struct ecl_readtable_entry));
rtable->readtable.locked = 0;
rtable->readtable.read_case = ecl_case_preserve; /* enum ecl_readtable_case */
rtable->readtable.table = rtab;
rtable = nucl_alloc_readtable(); /* FIXME initializes global var */
struct ecl_readtable_entry *rtab = rtable->readtable.table;
for (int i = 0; i < RTABSIZE; i++) {
rtab[i].syntax_type = cat_constituent; /* enum ecl_chattrib */
rtab[i].syntax_type = cat_constituent;
rtab[i].dispatch = _symbol_reader;
}
for (char *s="123456789"; *s!='\0'; s++)
rtab[*s].dispatch = _fixnum_reader;
rtab['0'].dispatch = _hexnum_reader;
rtab['-'].dispatch = _mixnum_reader;
rtab['+'].dispatch = _mixnum_reader;
#ifdef ECL_UNICODE
rtable->readtable.hash = ECL_NIL;
#endif
nucl_readtable_set(rtable, '\t', cat_whitespace, ECL_NIL);
nucl_readtable_set(rtable, '\n', cat_whitespace, ECL_NIL);
@ -655,13 +680,13 @@ skip_whitespace(cl_object strm, cl_object delim)
static cl_object
nucl_accept(cl_object strm, cl_object delim)
{
open_nucl_frame(frame);
cl_object frame = open_nucl_frame();
struct ecl_readtable_entry *entry = NULL;
cl_object ch = ECL_NIL;
cl_object result = ECL_NIL;
ch = skip_whitespace(strm, delim);
if (ch == ECL_EOF || ecl_eql(delim, ch)) {
close_nucl_frame(frame);
close_nucl_frame();
return ch;
}
entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
@ -681,7 +706,7 @@ nucl_accept(cl_object strm, cl_object delim)
default:
ecl_internal_error("Expecting too much, aren't we?");
}
close_nucl_frame(frame);
close_nucl_frame();
return result;
}
@ -860,10 +885,10 @@ cl_object nucl_word_pd(int narg, cl_object op) {
cl_object nucl_word_dp(int narg, cl_object op) {
cl_object strm = nucl_stdout();
cl_index ssize = nucl_stack_size();
cl_object size = ecl_make_fixnum(ssize);
nucl_write_cstr(strm, "[");
nucl_write_object(strm, size);
nucl_write_cstr(strm, "] ");
/* cl_object size = ecl_make_fixnum(ssize); */
/* nucl_write_cstr(strm, "["); */
/* nucl_write_object(strm, size); */
/* nucl_write_cstr(strm, "] "); */
if(ssize == 0) {
nucl_write_cstr(strm, "error: stack underflow");
return ECL_NIL;
@ -927,6 +952,7 @@ cl_object nucl_execute_command (cl_object command)
void nucl_repl (void)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object result, command, ostrm, istrm;
cl_index idx;
init_nucl_io();
@ -937,7 +963,7 @@ void nucl_repl (void)
ostrm = nucl_stdout();
istrm = nucl_stdin();
open_nucl_frame(frame); /* top level frame */
cl_object frame = open_nucl_frame(); /* top level frame */
do {
if(Null(ECL_SYM_VAL(the_env, nucl_cmpp)))
nucl_write_cstr(ostrm, "nucl> ");
@ -949,7 +975,7 @@ void nucl_repl (void)
if(Null(ECL_SYM_VAL(the_env, nucl_cmpp)))
nucl_write_cstr(ostrm, "... ok\n");
} while(result != ECL_EOF);
close_nucl_frame(frame);
close_nucl_frame();
nucl_write_cstr(ostrm, "... bye\n");
}