From 422dfbcc2ec80b46f29632e793df25a3fa5e19db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Fri, 30 May 2025 12:59:55 +0200 Subject: [PATCH] [nucl] liberate stack frames from stack allocation terror --- src/c/nucl.c | 86 ++++++++++++++++++++++++++++++++++------------------ 1 file changed, 56 insertions(+), 30 deletions(-) diff --git a/src/c/nucl.c b/src/c/nucl.c index d1f80379b..299e16330 100644 --- a/src/c/nucl.c +++ b/src/c/nucl.c @@ -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"); }