mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-09 14:40:37 -07:00
[nucl] clean up the file (move things around)
This commit is contained in:
Daniel Kochmański
parent
d038931e1b
commit
ac33b8698e
1 changed files with 57 additions and 78 deletions
135
src/c/nucl.c
135
src/c/nucl.c
|
|
@ -107,19 +107,54 @@ void nucl_test (void)
|
|||
}
|
||||
|
||||
|
||||
/* -- Allocators ------------------------------------------------------------ */
|
||||
|
||||
cl_object
|
||||
nucl_alloc_base_string(cl_index s)
|
||||
{
|
||||
cl_object x = ecl_alloc_compact_object(t_base_string, s+1);
|
||||
x->base_string.self = ECL_COMPACT_OBJECT_EXTRA(x);
|
||||
x->base_string.self[s] = '\0';
|
||||
x->base_string.elttype = ecl_aet_bc;
|
||||
x->base_string.flags = 0; /* no fill pointer, not adjustable */
|
||||
x->base_string.displaced = ECL_NIL;
|
||||
x->base_string.dim = x->base_string.fillp = s;
|
||||
return x;
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_alloc_symbol(cl_object name, cl_object value)
|
||||
{
|
||||
cl_object x = ecl_alloc_object(t_symbol);
|
||||
x->symbol.name = name;
|
||||
x->symbol.cname = ECL_NIL;
|
||||
#ifdef ECL_THREADS
|
||||
x->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
|
||||
#endif
|
||||
ECL_SET(x,value);
|
||||
ECL_FMAKUNBOUND(x);
|
||||
x->symbol.undef_entry = NULL; /* ecl_undefined_function_entry */
|
||||
x->symbol.macfun = ECL_NIL;
|
||||
x->symbol.sfdef = ECL_NIL;
|
||||
x->symbol.plist = ECL_NIL;
|
||||
x->symbol.hpack = ECL_NIL;
|
||||
x->symbol.stype = ecl_stp_ordinary;
|
||||
#ifdef NUCL
|
||||
/* Rethink finalization(!) */
|
||||
ecl_set_finalizer_unprotected(x, ECL_T);
|
||||
#endif
|
||||
return x;
|
||||
}
|
||||
|
||||
/* -- Special variables ----------------------------------------------------- */
|
||||
#define DEFINE_SPECIAL(var,name,value) \
|
||||
static cl_object var = \
|
||||
ecl_cast_ptr(cl_object, &ecl_constexpr_symbol(ecl_stp_special, name, value))
|
||||
|
||||
DEFINE_SPECIAL(nucl_ostrm, "*ISTRM*", ECL_NIL); /* standard input */
|
||||
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 */
|
||||
DEFINE_SPECIAL(nucl_cmpp, "*cmpp*", ECL_NIL); /* compilep */
|
||||
|
||||
|
||||
/* -- Since now on we will often use the stack, so here are some operators - */
|
||||
/* -- Stack manipulation --------------------------------------------------- */
|
||||
|
||||
DEFINE_SPECIAL(nucl_fp, "*FP*", ECL_NIL); /* stack frame */
|
||||
|
||||
#define open_nucl_frame(name) \
|
||||
const cl_env_ptr the_env = ecl_process_env(); \
|
||||
|
|
@ -190,45 +225,6 @@ nucl_stack_clear(void)
|
|||
while(size--) ecl_stack_frame_pop(frame);
|
||||
}
|
||||
|
||||
/* And constructors */
|
||||
|
||||
cl_object
|
||||
nucl_alloc_base_string(cl_index s)
|
||||
{
|
||||
cl_object x = ecl_alloc_compact_object(t_base_string, s+1);
|
||||
x->base_string.self = ECL_COMPACT_OBJECT_EXTRA(x);
|
||||
x->base_string.self[s] = '\0';
|
||||
x->base_string.elttype = ecl_aet_bc;
|
||||
x->base_string.flags = 0; /* no fill pointer, not adjustable */
|
||||
x->base_string.displaced = ECL_NIL;
|
||||
x->base_string.dim = x->base_string.fillp = s;
|
||||
return x;
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_alloc_symbol(cl_object name, cl_object value)
|
||||
{
|
||||
cl_object x = ecl_alloc_object(t_symbol);
|
||||
x->symbol.name = name;
|
||||
x->symbol.cname = ECL_NIL;
|
||||
#ifdef ECL_THREADS
|
||||
x->symbol.binding = ECL_MISSING_SPECIAL_BINDING;
|
||||
#endif
|
||||
ECL_SET(x,value);
|
||||
ECL_FMAKUNBOUND(x);
|
||||
x->symbol.undef_entry = NULL; /* ecl_undefined_function_entry */
|
||||
x->symbol.macfun = ECL_NIL;
|
||||
x->symbol.sfdef = ECL_NIL;
|
||||
x->symbol.plist = ECL_NIL;
|
||||
x->symbol.hpack = ECL_NIL;
|
||||
x->symbol.stype = ecl_stp_ordinary;
|
||||
#ifdef NUCL
|
||||
/* Rethink finalization(!) */
|
||||
ecl_set_finalizer_unprotected(x, ECL_T);
|
||||
#endif
|
||||
return x;
|
||||
}
|
||||
|
||||
/* ( lisp* -- list ) */
|
||||
cl_object nucl_stack_to_list(void)
|
||||
{
|
||||
|
|
@ -315,6 +311,8 @@ cl_object nucl_stack_to_hexnum(void)
|
|||
/* -- Lali-ho I/O starts here ----------------------------------------------- */
|
||||
|
||||
cl_object ecl_make_nucl_stream(FILE *f);
|
||||
DEFINE_SPECIAL(nucl_ostrm, "*ISTRM*", ECL_NIL); /* standard input */
|
||||
DEFINE_SPECIAL(nucl_istrm, "*OSTRM*", ECL_NIL); /* standard output */
|
||||
|
||||
void
|
||||
init_nucl_io(void)
|
||||
|
|
@ -542,9 +540,12 @@ rparen_reader(int narg, cl_object strm, cl_object c)
|
|||
static cl_object
|
||||
symbol_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
cl_object string, symbol;
|
||||
default_reader(2, strm, c);
|
||||
cl_object name = nucl_stack_to_string();
|
||||
return nucl_alloc_symbol(name, OBJNULL);
|
||||
nucl_stack_to_string();
|
||||
string = nucl_stack_pop();
|
||||
symbol = nucl_alloc_symbol(string, OBJNULL);
|
||||
return nucl_stack_push(symbol);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -685,7 +686,10 @@ nucl_accept(cl_object strm, cl_object delim)
|
|||
}
|
||||
|
||||
|
||||
/* -- Dictionary ------------------------------------------------------------ */
|
||||
/* -- F42 starts here ------------------------------------------------------- */
|
||||
|
||||
DEFINE_SPECIAL(nucl_dt, "*DT*", ECL_NIL); /* dictionary */
|
||||
DEFINE_SPECIAL(nucl_cmpp, "*CMPP*", ECL_NIL); /* compilep */
|
||||
|
||||
static void
|
||||
init_nucl_dictionary(void)
|
||||
|
|
@ -743,24 +747,6 @@ nucl_search_dictionary(cl_object name)
|
|||
return ECL_UNBOUND;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
nucl_extend_dictionary(cl_object name, cl_object value)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_core.first_env;
|
||||
cl_object entry = nucl_search_dictionary(name);
|
||||
cl_object dict = ECL_SYM_VAL(the_env, nucl_dt);
|
||||
if(entry != ECL_UNBOUND) {
|
||||
/* Design decision: error, overwrite or shadow? Separate ops? A Flag? */
|
||||
ECL_SETQ(the_env,entry,value);
|
||||
return entry;
|
||||
}
|
||||
ecl_internal_error("sorry! allocate me.");
|
||||
/* Allocate on a heap, because make_dict_entry would allocate on a stack. */
|
||||
entry = nucl_alloc_symbol(name,value);
|
||||
ecl_stack_push(dict, entry);
|
||||
return entry;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
nucl_append_dictionary(cl_object symbol, cl_object value)
|
||||
{
|
||||
|
|
@ -771,14 +757,6 @@ nucl_append_dictionary(cl_object symbol, cl_object value)
|
|||
return symbol;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
word_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
default_reader(2, strm, c);
|
||||
cl_object string = nucl_stack_to_string();
|
||||
return nucl_search_dictionary(string);
|
||||
}
|
||||
|
||||
cl_object nucl_eval_word(int narg, cl_object word) {
|
||||
cl_object value = word->symbol.value;
|
||||
cl_object strm = nucl_stdout();
|
||||
|
|
@ -796,6 +774,7 @@ cl_object nucl_eval_word(int narg, cl_object word) {
|
|||
default:
|
||||
_ecl_funcall2(value, word);
|
||||
}
|
||||
return ECL_NIL;
|
||||
}
|
||||
|
||||
cl_object nucl_word_def(int narg, cl_object op) {
|
||||
|
|
@ -919,9 +898,6 @@ void init_nucl_dictionary_entries()
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* -- REPL ------------------------------------------------------------------ */
|
||||
|
||||
cl_object nucl_read_command (cl_object istrm)
|
||||
{
|
||||
cl_object result = limited_reader(istrm, ECL_CODE_CHAR('\n'));
|
||||
|
|
@ -970,6 +946,9 @@ void nucl_repl (void)
|
|||
nucl_write_cstr(ostrm, "... bye\n");
|
||||
}
|
||||
|
||||
|
||||
/* -- Entry point ----------------------------------------------------------- */
|
||||
|
||||
int main() {
|
||||
cl_env_ptr the_env = ecl_core.first_env;
|
||||
ecl_boot();
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue