diff --git a/src/c/nucl.c b/src/c/nucl.c index 6dc2eef73..9a2f40f99 100644 --- a/src/c/nucl.c +++ b/src/c/nucl.c @@ -81,6 +81,32 @@ void smoke_bytecodes (void) ecl_stack_frame_close(f); } +void nucl_test (void) +{ + cl_env_ptr the_env = ecl_core.first_env; + printf("\n[:handler t :restart t] -----------------------\n"); + ECL_CATCH_BEGIN(the_env, ecl_ct_resume_tag); { + ecl_call_with_handler(_nucl_extinguisher, _nucl_flamethrower); + } ECL_CATCH_END; + printf("-----------------------------------------------\n\n"); + + printf("\n[:handler t :restart nil] ---------------------\n"); + ecl_call_with_handler(_nucl_extinguisher, _nucl_flamethrower); + printf("-----------------------------------------------\n\n"); + + printf("\n[:handler nil] --------------------------------\n"); + nucl_flamethrower(0); + printf("-----------------------------------------------\n\n"); + + cl_object handlers = ecl_cons_stack(_nucl_extinguisher, ECL_NIL); + ECL_SETQ(the_env, ECL_SIGNAL_HANDLERS, handlers); + + printf("\n[:bytecodes t] --------------------------------\n"); + smoke_bytecodes(); + printf("-----------------------------------------------\n\n"); +} + + /* -- Special variables ----------------------------------------------------- */ #define DEFINE_SPECIAL(var,name,value) \ static cl_object var = \ @@ -91,53 +117,7 @@ DEFINE_SPECIAL(nucl_istrm, "*OSTRM*", ECL_NIL); /* standard output */ DEFINE_SPECIAL(nucl_fp, "*FP*", ECL_NIL); /* stack frame */ DEFINE_SPECIAL(nucl_dt, "*DT*", ECL_NIL); /* dictionary */ -/* -- Early printing routines ----------------------------------------------- */ -cl_object ecl_make_nucl_stream(FILE *f); - -void -init_nucl_io(void) -{ - const cl_env_ptr the_env = ecl_process_env(); - cl_object ostrm = ecl_make_nucl_stream(stdout); - cl_object istrm = ecl_make_nucl_stream(stdin); - ECL_SETQ(the_env, nucl_ostrm, ostrm); - ECL_SETQ(the_env, nucl_istrm, istrm); -} - -#define ECL_EOF ECL_DUMMY_TAG - -cl_object -nucl_stdout(void) -{ - const cl_env_ptr the_env = ecl_process_env(); - return ECL_SYM_VAL(the_env, nucl_ostrm); -} - - -cl_object -nucl_stdin(void) -{ - const cl_env_ptr the_env = ecl_process_env(); - return ECL_SYM_VAL(the_env, nucl_istrm); -} - -cl_object -nucl_write_cstr(cl_object strm, const char *s) -{ - while(*s != '\0') - si_write_char(strm, ECL_CODE_CHAR(*s++)); -} - -void -nucl_write_string(cl_object strm, cl_object s) -{ - int aux; - for(aux=0; auxstring.fillp; aux++) - (s->d.t == t_string) - ? si_write_char(strm, ECL_CODE_CHAR(s->string.self[aux])) - : si_write_char(strm, ECL_CODE_CHAR(s->base_string.self[aux])); -} - + /* -- Since now on we will often use the stack, so here are some operators - */ #define open_nucl_frame(name) \ @@ -329,56 +309,15 @@ cl_object nucl_stack_to_hexnum(void) return nucl_stack_push(self); } -/* Yeah! */ -cl_object nucl_call_word(int narg, cl_object op) { - cl_object strm = nucl_stdout(); - if (op == ECL_UNBOUND) - nucl_write_cstr(strm, ">>> nucl_call_word: undefined.\n"); - else - _ecl_funcall2(op->symbol.value, op); - return op; -} - -cl_object nucl_word_df(int narg, cl_object op) { - cl_index size = nucl_stack_size(); - cl_object strm = nucl_stdout(); - nucl_write_cstr(strm, ">>> nucl_call_word: define word.\n"); - return ecl_make_fixnum(size); -} - -cl_object nucl_word_ps(int narg, cl_object op) { - cl_index size = nucl_stack_size(); - cl_object strm = nucl_stdout(); - nucl_write_cstr(strm, ">>> nucl_call_word: print stack.\n"); - return ecl_make_fixnum(size); -} - -ecl_def_function(_nucl_word_df, nucl_word_df, static, const); -ecl_def_function(_nucl_word_ps, nucl_word_ps, static, const); - - -/* Our dictionary is based on symbols. Each symbol in a dictionary has a name - and a value. We may need to rethink it at some point. */ - -#define make_dict_entry(name,value) \ - ecl_cast_ptr(cl_object, &ecl_constexpr_symbol(ecl_stp_special, name, value)) - -static cl_object nucl_dictionary_default_entries[] = { - make_dict_entry(":", _nucl_word_df), - make_dict_entry("!", _nucl_word_ps), - NULL, -}; + +/* -- Dictionary ------------------------------------------------------------ */ static void init_nucl_dictionary(void) { const cl_env_ptr the_env = ecl_process_env(); - cl_object dict = ecl_make_stack(2); + cl_object dict = ecl_make_stack(0); ECL_SETQ(the_env, nucl_dt, dict); - cl_object *iterator = nucl_dictionary_default_entries; - for(; *iterator != NULL; iterator++) { - ecl_stack_push(dict, *iterator); - } } static void @@ -430,8 +369,65 @@ nucl_extend_dictionary(cl_object name, cl_object value) return entry; } +static cl_object +nucl_append_dictionary(cl_object entry) +{ + cl_env_ptr the_env = ecl_core.first_env; + cl_object dict = ECL_SYM_VAL(the_env, nucl_dt); + ecl_stack_push(dict, entry); + return entry; +} + + /* -- Lali-ho I/O starts here ----------------------------------------------- */ +cl_object ecl_make_nucl_stream(FILE *f); + +void +init_nucl_io(void) +{ + const cl_env_ptr the_env = ecl_process_env(); + cl_object ostrm = ecl_make_nucl_stream(stdout); + cl_object istrm = ecl_make_nucl_stream(stdin); + ECL_SETQ(the_env, nucl_ostrm, ostrm); + ECL_SETQ(the_env, nucl_istrm, istrm); +} + +#define ECL_EOF ECL_DUMMY_TAG + +cl_object +nucl_stdout(void) +{ + const cl_env_ptr the_env = ecl_process_env(); + return ECL_SYM_VAL(the_env, nucl_ostrm); +} + + +cl_object +nucl_stdin(void) +{ + const cl_env_ptr the_env = ecl_process_env(); + return ECL_SYM_VAL(the_env, nucl_istrm); +} + +cl_object +nucl_write_cstr(cl_object strm, const char *s) +{ + while(*s != '\0') + si_write_char(strm, ECL_CODE_CHAR(*s++)); +} + +/* Ad-hoc printer */ +void +nucl_write_string(cl_object strm, cl_object s) +{ + int aux; + for(aux=0; auxstring.fillp; aux++) + (s->d.t == t_string) + ? si_write_char(strm, ECL_CODE_CHAR(s->string.self[aux])) + : si_write_char(strm, ECL_CODE_CHAR(s->base_string.self[aux])); +} + void nucl_write_fixnum(cl_object strm, cl_object s) { @@ -452,25 +448,6 @@ nucl_write_fixnum(cl_object strm, cl_object s) close_nucl_frame(frame); } -void -nucl_read_until(cl_object strm, cl_fixnum delim) -{ - cl_object frame = nucl_stack_frame(); - cl_object ch = ECL_NIL; - while (!Null(ch = si_read_char(strm, ECL_NIL))) { - nucl_stack_push(ch); - if(ECL_CHAR_CODE(ch) == delim) break; - } -} - -cl_object -nucl_read_line(cl_object strm) -{ - nucl_read_until(strm, '\n'); - return nucl_stack_to_string(); -} - -/* Ad-hoc printer */ cl_object nucl_write_object(cl_object strm, cl_object self) { @@ -534,6 +511,24 @@ nucl_write_object(cl_object strm, cl_object self) } /* Ad-hoc reader */ +void +nucl_read_until(cl_object strm, cl_fixnum delim) +{ + cl_object frame = nucl_stack_frame(); + cl_object ch = ECL_NIL; + while (!Null(ch = si_read_char(strm, ECL_NIL))) { + nucl_stack_push(ch); + if(ECL_CHAR_CODE(ch) == delim) break; + } +} + +cl_object +nucl_read_line(cl_object strm) +{ + nucl_read_until(strm, '\n'); + return nucl_stack_to_string(); +} + static cl_object rtable = ECL_NIL; static cl_object nucl_accept(cl_object strm, cl_object delim); @@ -765,40 +760,65 @@ nucl_accept(cl_object strm, cl_object delim) return result; } -void -smoke_stream (void) -{ - cl_object ostrm = ecl_make_nucl_stream(stdout); - cl_object istrm = ecl_make_nucl_stream(stdin); - cl_object line = ECL_NIL; - char *string = "Hello World> ", c; - int i; - printf(">>> smoke_stream: stream is %p\n", ostrm); - nucl_write_cstr(ostrm, string); - line = nucl_read_line(istrm); - nucl_write_object(ostrm, line); - ecl_dealloc(line); + +/* -- Default words --------------------------------------------------------- */ +cl_object nucl_call_word(int narg, cl_object op) { + cl_object strm = nucl_stdout(); + (op == ECL_UNBOUND) + ? nucl_write_cstr(strm, ">>> nucl_call_word: undefined.\n") + : _ecl_funcall2(op->symbol.value, op); + return op; } -void -smoke_accept (void) -{ - cl_object ostrm, istrm, result; - - init_nucl_io(); - init_nucl_reader(); - init_nucl_dictionary(); - - ostrm = nucl_stdout(); - istrm = nucl_stdin(); - - printf(">>> smoke_accept: readtable is %p\n", rtable); - nucl_write_cstr(ostrm, "token> "); - result = nucl_accept(istrm, ECL_NIL); - nucl_write_object(ostrm, result); - printf("\n"); +cl_object nucl_word_df(int narg, cl_object op) { + cl_index size = nucl_stack_size(); + cl_object strm = nucl_stdout(); + nucl_write_cstr(strm, ">>> nucl_call_word: define word.\n"); + return ecl_make_fixnum(size); } +cl_object nucl_word_ps(int narg, cl_object op) { + cl_index ssize = nucl_stack_size(); + cl_object size = ecl_make_fixnum(ssize); + cl_object strm = nucl_stdout(); + cl_object frame = nucl_stack_frame(); + nucl_write_cstr(strm, "["); + nucl_write_object(strm, size); + nucl_write_cstr(strm, "] "); + loop_across_frame_fifo(elt, frame) { + nucl_write_object(strm, elt); + if(--size) nucl_write_cstr(strm, " "); + } end_loop_across_frame(); + return size; +} + +ecl_def_function(_nucl_word_df, nucl_word_df, static, const); +ecl_def_function(_nucl_word_ps, nucl_word_ps, static, const); + + +/* Our dictionary is based on symbols. Each symbol in a dictionary has a name + and a value. We may need to rethink it at some point. */ + +#define make_dict_entry(name,value) \ + ecl_cast_ptr(cl_object, &ecl_constexpr_symbol(ecl_stp_special, name, value)) + +static cl_object nucl_dictionary_default_entries[] = { + make_dict_entry(":", _nucl_word_df), + make_dict_entry("!", _nucl_word_ps), + NULL, +}; + +void init_nucl_dictionary_entries() +{ + const cl_env_ptr the_env = ecl_process_env(); + cl_object dict = ECL_SYM_VAL(the_env, nucl_dt); + cl_object *iterator = nucl_dictionary_default_entries; + for(; *iterator != NULL; iterator++) { + ecl_stack_push(dict, *iterator); + } +} + + /* -- REPL ------------------------------------------------------------------ */ cl_object nucl_read_command (cl_object istrm) @@ -828,6 +848,7 @@ void nucl_repl (void) init_nucl_io(); init_nucl_reader(); init_nucl_dictionary(); + init_nucl_dictionary_entries(); ostrm = nucl_stdout(); istrm = nucl_stdin(); @@ -844,39 +865,6 @@ void nucl_repl (void) nucl_write_cstr(ostrm, "... bye\n"); } -void nucl_test (void) -{ - cl_env_ptr the_env = ecl_core.first_env; - printf("\n[:handler t :restart t] -----------------------\n"); - ECL_CATCH_BEGIN(the_env, ecl_ct_resume_tag); { - ecl_call_with_handler(_nucl_extinguisher, _nucl_flamethrower); - } ECL_CATCH_END; - printf("-----------------------------------------------\n\n"); - - printf("\n[:handler t :restart nil] ---------------------\n"); - ecl_call_with_handler(_nucl_extinguisher, _nucl_flamethrower); - printf("-----------------------------------------------\n\n"); - - printf("\n[:handler nil] --------------------------------\n"); - nucl_flamethrower(0); - printf("-----------------------------------------------\n\n"); - - cl_object handlers = ecl_cons_stack(_nucl_extinguisher, ECL_NIL); - ECL_SETQ(the_env, ECL_SIGNAL_HANDLERS, handlers); - - printf("\n[:bytecodes t] --------------------------------\n"); - smoke_bytecodes(); - printf("-----------------------------------------------\n\n"); - - printf("\n[:stream t] --------------------------------\n"); - smoke_stream(); - printf("-----------------------------------------------\n\n"); - - printf("\n[:accept t] --------------------------------\n"); - smoke_accept(); - printf("-----------------------------------------------\n\n"); -} - int main() { cl_env_ptr the_env = ecl_core.first_env; ecl_boot();