mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-10 15:10:25 -07:00
[nucl] use the data stack
This commit is contained in:
Daniel Kochmański
parent
5eec810592
commit
3db21bec37
1 changed files with 104 additions and 50 deletions
154
src/c/nucl.c
154
src/c/nucl.c
|
|
@ -83,6 +83,52 @@ void smoke_bytecodes (void)
|
|||
cl_object ecl_make_nucl_stream(FILE *f);
|
||||
|
||||
/* -- Lali-ho I/O starts here ----------------------------------------------- */
|
||||
|
||||
/* GC won't catch pointers from constexpr symbols unless registered as root. */
|
||||
static cl_object nucl_fp = ecl_cast_ptr(cl_object,&(ecl_constexpr_symbol(ecl_stp_special, "*FP*", ECL_NIL)));
|
||||
|
||||
#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);
|
||||
|
||||
#define close_nucl_frame(name) \
|
||||
ecl_bds_unwind1(the_env); \
|
||||
ecl_stack_frame_close(name);
|
||||
|
||||
static cl_object
|
||||
nucl_stack_frame(void)
|
||||
{
|
||||
const cl_env_ptr the_env = ecl_process_env();
|
||||
return ECL_SYM_VAL(the_env, nucl_fp);
|
||||
}
|
||||
|
||||
static cl_index
|
||||
nucl_frame_size(cl_object fp)
|
||||
{
|
||||
return fp->frame.size;
|
||||
}
|
||||
|
||||
static void
|
||||
nucl_stack_push(cl_object object)
|
||||
{
|
||||
cl_object frame = nucl_stack_frame();
|
||||
frame->frame.size++;
|
||||
frame->frame.sp++;
|
||||
ecl_stack_frame_push(frame, object);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
nucl_stack_pop(void)
|
||||
{
|
||||
cl_object frame = nucl_stack_frame();
|
||||
frame->frame.size--;
|
||||
frame->frame.sp--;
|
||||
return ECL_STACK_POP_UNSAFE(frame->frame.env);
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_alloc_base_string(cl_index s)
|
||||
{
|
||||
|
|
@ -98,34 +144,38 @@ nucl_alloc_base_string(cl_index s)
|
|||
}
|
||||
|
||||
cl_object
|
||||
nucl_stack_to_string(cl_object stack)
|
||||
nucl_stack_to_string(void)
|
||||
{
|
||||
cl_index size = stack->vector.fillp, idx;
|
||||
cl_object frame = nucl_stack_frame();
|
||||
cl_index size = nucl_frame_size(frame), idx=0;
|
||||
cl_object self = nucl_alloc_base_string(size);
|
||||
for(idx=0; idx<size; idx++)
|
||||
self->base_string.self[idx] = ECL_CHAR_CODE(stack->vector.self.t[idx]);
|
||||
loop_across_frame_fifo(elt, frame) {
|
||||
self->base_string.self[idx++] = ECL_CHAR_CODE(elt);
|
||||
} end_loop_across_frame();
|
||||
return self;
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_stack_to_list(cl_object stack)
|
||||
nucl_stack_to_list(void)
|
||||
{
|
||||
cl_index size = stack->vector.fillp, idx;
|
||||
cl_object frame = nucl_stack_frame();
|
||||
cl_index size = nucl_frame_size(frame), idx=0;
|
||||
cl_object self = ECL_NIL;
|
||||
loop_across_stack_filo(elt, stack) {
|
||||
loop_across_frame_filo(elt, frame) {
|
||||
self = ecl_cons(elt, self);
|
||||
} end_loop_across_stack();
|
||||
} end_loop_across_frame();
|
||||
return self;
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_stack_to_fixnum(cl_object stack)
|
||||
nucl_stack_to_fixnum(void)
|
||||
{
|
||||
cl_index size = stack->vector.fillp, idx;
|
||||
cl_object frame = nucl_stack_frame();
|
||||
cl_index size = nucl_frame_size(frame);
|
||||
cl_object self = ECL_NIL;
|
||||
intmax_t acc = 0;
|
||||
int dig;
|
||||
loop_across_stack_fifo(elt, stack) {
|
||||
loop_across_frame_fifo(elt, frame) {
|
||||
acc *= 10;
|
||||
switch(ECL_CHAR_CODE(elt)) {
|
||||
case '0': case '1': case '2': case '3': case '4':
|
||||
|
|
@ -137,18 +187,19 @@ nucl_stack_to_fixnum(cl_object stack)
|
|||
}
|
||||
if (acc>MOST_POSITIVE_FIXNUM)
|
||||
ecl_internal_error("Integer is too big!");
|
||||
} end_loop_across_stack();
|
||||
} end_loop_across_frame();
|
||||
return ecl_make_fixnum((cl_fixnum)acc);
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_stack_to_hexnum(cl_object stack)
|
||||
nucl_stack_to_hexnum(void)
|
||||
{
|
||||
cl_index size = stack->vector.fillp, idx;
|
||||
cl_object frame = nucl_stack_frame();
|
||||
cl_index size = nucl_frame_size(frame);
|
||||
cl_object self = ECL_NIL;
|
||||
intmax_t acc = 0;
|
||||
int dig;
|
||||
loop_across_stack_fifo(elt, stack) {
|
||||
loop_across_frame_fifo(elt, frame) {
|
||||
acc *= 16;
|
||||
switch(ECL_CHAR_CODE(elt)) {
|
||||
case '0': case '1': case '2': case '3': case '4':
|
||||
|
|
@ -166,7 +217,7 @@ nucl_stack_to_hexnum(cl_object stack)
|
|||
}
|
||||
if (acc>MOST_POSITIVE_FIXNUM)
|
||||
ecl_internal_error("Integer is too big!");
|
||||
} end_loop_across_stack();
|
||||
} end_loop_across_frame();
|
||||
return ecl_make_fixnum((cl_fixnum)acc);
|
||||
}
|
||||
|
||||
|
|
@ -190,37 +241,39 @@ nucl_write_string(cl_object strm, cl_object s)
|
|||
void
|
||||
nucl_write_fixnum(cl_object strm, cl_object s)
|
||||
{
|
||||
cl_object stack = ecl_make_stack(0), c=ECL_NIL;
|
||||
open_nucl_frame(frame);
|
||||
cl_object c=ECL_NIL;
|
||||
cl_fixnum value = ecl_fixnum(s), dig;
|
||||
if(value<0) value = -value;
|
||||
do {
|
||||
dig = value%10;
|
||||
ecl_stack_push(stack, ECL_CODE_CHAR(dig+'0'));
|
||||
nucl_stack_push(ECL_CODE_CHAR(dig+'0'));
|
||||
value /= 10;
|
||||
} while(value!=0);
|
||||
if(ecl_fixnum(s) < 0)
|
||||
ecl_stack_push(stack, ECL_CODE_CHAR('-'));
|
||||
loop_across_stack_filo(elt, stack) {
|
||||
nucl_stack_push(ECL_CODE_CHAR('-'));
|
||||
loop_across_frame_filo(elt, frame) {
|
||||
si_write_char(strm, elt);
|
||||
} end_loop_across_stack();
|
||||
} end_loop_across_frame();
|
||||
close_nucl_frame(frame);
|
||||
}
|
||||
|
||||
cl_object
|
||||
void
|
||||
nucl_read_until(cl_object strm, cl_fixnum delim)
|
||||
{
|
||||
cl_object stack = ecl_make_stack(0), c=ECL_NIL;
|
||||
while (!Null(c = si_read_char(strm, ECL_NIL))) {
|
||||
ecl_stack_push(stack, c);
|
||||
if(ECL_CHAR_CODE(c) == delim) break;
|
||||
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;
|
||||
}
|
||||
return stack;
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_read_line(cl_object strm)
|
||||
{
|
||||
cl_object stack = nucl_read_until(strm, '\n');
|
||||
return nucl_stack_to_string(stack);
|
||||
nucl_read_until(strm, '\n');
|
||||
return nucl_stack_to_string();
|
||||
}
|
||||
|
||||
/* Ad-hoc printer */
|
||||
|
|
@ -316,24 +369,23 @@ default_reader(int narg, cl_object strm, cl_object ch)
|
|||
simpler interpretation -- digit first means a fixnum, otherwise a symbol.
|
||||
If the first digit is 0, then it must be a hexadecimal number, i.e 0xff. */
|
||||
struct ecl_readtable_entry *entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
cl_object stack = ecl_make_stack(0);
|
||||
ecl_stack_push(stack, ch);
|
||||
nucl_stack_push(ch);
|
||||
while (!Null(ch = si_read_char(strm, ECL_NIL))) {
|
||||
entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
switch (entry->syntax_type) {
|
||||
case cat_constituent:
|
||||
ecl_stack_push(stack, ch);
|
||||
nucl_stack_push(ch);
|
||||
break;
|
||||
case cat_terminating:
|
||||
si_unread_char(strm, ch);
|
||||
return stack;
|
||||
return ECL_NIL;
|
||||
case cat_whitespace:
|
||||
return stack;
|
||||
return ECL_NIL;
|
||||
default:
|
||||
ecl_internal_error("Expecting too much, aren't we?");
|
||||
}
|
||||
}
|
||||
return stack;
|
||||
return ECL_NIL;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -345,7 +397,8 @@ comment_reader(int narg, cl_object strm, cl_object c)
|
|||
static cl_object
|
||||
lparen_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
cl_object stack = ecl_make_stack(0), object;
|
||||
open_nucl_frame(frame);
|
||||
cl_object object;
|
||||
cl_object delim = ECL_CODE_CHAR(')');
|
||||
do {
|
||||
object = nucl_accept(strm, delim);
|
||||
|
|
@ -354,9 +407,11 @@ lparen_reader(int narg, cl_object strm, cl_object c)
|
|||
else if(ecl_eql(object, delim))
|
||||
break;
|
||||
else
|
||||
ecl_stack_push(stack, object);
|
||||
nucl_stack_push(object);
|
||||
} while(1);
|
||||
return nucl_stack_to_list(stack);
|
||||
object = nucl_stack_to_list();
|
||||
close_nucl_frame(frame);
|
||||
return object;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -368,25 +423,24 @@ 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 stack = default_reader(2, strm, c);
|
||||
cl_object string = nucl_stack_to_string(stack);
|
||||
default_reader(2, strm, c);
|
||||
cl_object string = nucl_stack_to_string();
|
||||
return ecl_cons(ECL_CODE_CHAR('T'), string);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
string_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
cl_object stack = nucl_read_until(strm, ECL_CHAR_CODE(c));
|
||||
ecl_stack_popu(stack);
|
||||
return nucl_stack_to_string(stack);
|
||||
nucl_read_until(strm, ECL_CHAR_CODE(c));
|
||||
nucl_stack_pop(); /* remove delimiter */
|
||||
return nucl_stack_to_string();
|
||||
}
|
||||
|
||||
static cl_object
|
||||
fixnum_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
cl_object stack = default_reader(2, strm, c);
|
||||
cl_object result = nucl_stack_to_fixnum(stack);
|
||||
return result;
|
||||
default_reader(2, strm, c);
|
||||
return nucl_stack_to_fixnum();
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -399,9 +453,8 @@ hexnum_reader(int narg, cl_object strm, cl_object c)
|
|||
si_unread_char(strm, ch);
|
||||
return ecl_make_fixnum(0);
|
||||
} else {
|
||||
cl_object stack = default_reader(2, strm, c);
|
||||
cl_object result = nucl_stack_to_hexnum(stack);
|
||||
return result;
|
||||
default_reader(2, strm, c);
|
||||
return nucl_stack_to_hexnum();
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -485,8 +538,8 @@ skip_whitespace(cl_object strm, cl_object delim)
|
|||
static cl_object
|
||||
nucl_accept(cl_object strm, cl_object delim)
|
||||
{
|
||||
open_nucl_frame(frame);
|
||||
struct ecl_readtable_entry *entry = NULL;
|
||||
cl_object stack = ecl_make_stack(0);
|
||||
cl_object ch = ECL_NIL;
|
||||
cl_object result = ECL_NIL;
|
||||
ch = skip_whitespace(strm, delim);
|
||||
|
|
@ -509,6 +562,7 @@ nucl_accept(cl_object strm, cl_object delim)
|
|||
default:
|
||||
ecl_internal_error("Expecting too much, aren't we?");
|
||||
}
|
||||
close_nucl_frame(frame);
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue