Bytecode functions can now be printed/read (M. Pasternacki)

This commit is contained in:
jjgarcia 2005-05-10 08:10:52 +00:00
parent 9e747f5fc3
commit b9b960f178
3 changed files with 74 additions and 12 deletions

View file

@ -1,6 +1,10 @@
ECL 0.9f
========
* Platforms:
- Cygwin support has been fixed and it now supports DLLs (M. Goffioul).
* Errors fixed:
- The reader macros for lists, ##, #C, #P and #' did not behave as expected
@ -129,6 +133,9 @@ ECL 0.9f
- ECL now accepts a double dash, '--', as a command line option. Anything
after the double dash is interpreted as a lisp command.
- Bytecode functions can now be printed readably as #Y(...). The appropiate
reader macro has been also implemented (M. Pasternacki)
* ANSI Compatibility:
- DEFSETF forms are enclosed in a block with the name of the accessor.

View file

@ -24,6 +24,7 @@
#endif
#include "ecl.h"
#include "internal.h"
#include "bytecodes.h"
#if defined(ECL_CMU_FORMAT)
# define si_write_object_recursive(x,y) si_write_object(x,y)
@ -1339,18 +1340,32 @@ si_write_ugly_object(cl_object x, cl_object stream)
si_write_ugly_object(namestring, stream);
break;
}
case t_bytecodes: {
cl_object name = x->bytecodes.name;
if (ecl_print_readably()) FEprint_not_readable(x);
write_str("#<bytecompiled-function ", stream);
if (name != Cnil)
si_write_ugly_object(name, stream);
else
write_addr(x, stream);
write_ch('>', stream);
break;
}
case t_cfun:
case t_bytecodes:
if ( ecl_print_readably() ) {
cl_index i;
cl_object code_l=Cnil, data_l=Cnil;
for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
code_l = make_cons(MAKE_FIXNUM(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
for ( i=x->bytecodes.data_size-1 ; i<(cl_index)(-1l) ; i-- )
data_l = make_cons(x->bytecodes.data[i], data_l);
write_str("#Y", stream);
si_write_ugly_object(
cl_list(6, x->bytecodes.name, x->bytecodes.lex,
x->bytecodes.specials, Cnil /* x->bytecodes.definition */,
code_l, data_l),
stream);
} else {
cl_object name = x->bytecodes.name;
write_str("#<bytecompiled-function ", stream);
if (name != Cnil)
si_write_ugly_object(name, stream);
else
write_addr(x, stream);
write_ch('>', stream);
}
break;
case t_cfun:
if (ecl_print_readably()) FEprint_not_readable(x);
write_str("#<compiled-function ", stream);
if (x->cfun.name != Cnil)

View file

@ -23,6 +23,7 @@
#include "ecl.h"
#include "internal.h"
#include "ecl-inl.h"
#include "bytecodes.h"
#define cat(rtbl,c) ((rtbl)->readtable.table[c].syntax_type)
#define read_suppress (SYM_VAL(@'*read-suppress*') != Cnil)
@ -718,6 +719,44 @@ sharp_single_quote_reader(cl_object in, cl_object c, cl_object d)
@(return c)
}
static cl_object
sharp_Y_reader(cl_object in, cl_object c, cl_object d)
{
cl_index i;
cl_object x, rv, nth;
if (d != Cnil && !read_suppress)
extra_argument('C', in, d);
x = read_object(in);
if (x == OBJNULL)
FEend_of_file(in);
if (read_suppress)
@(return Cnil);
if (type_of(x) != t_cons || length(x) != 6)
FEreader_error("Reader macro #Y should be followed by a list",
in, 0);
rv = cl_alloc_object(t_bytecodes);
rv->bytecodes.name = CAR(x); x = CDR(x);
rv->bytecodes.lex = CAR(x); x = CDR(x);
rv->bytecodes.specials = CAR(x); x = CDR(x);
rv->bytecodes.definition = CAR(x); x = CDR(x);
rv->bytecodes.code_size = fixint(cl_list_length(CAR(x)));
rv->bytecodes.code = cl_alloc(rv->bytecodes.code_size * sizeof(uint16_t));
for ( i=0, nth=CAR(x) ; !endp(nth) ; i++, nth=CDR(nth) )
((cl_opcode*)(rv->bytecodes.code))[i] = fixint(CAR(nth));
x = CDR(x);
rv->bytecodes.data_size = fixint(cl_list_length(CAR(x)));
rv->bytecodes.data = cl_alloc(rv->bytecodes.data_size * sizeof(cl_object));
for ( i=0, nth=CAR(x) ; !endp(nth) ; i++, nth=CDR(nth) )
((cl_object*)(rv->bytecodes.data))[i] = CAR(nth);
@(return rv);
}
#define QUOTE 1
#define EVAL 2
#define LIST 3
@ -1897,6 +1936,7 @@ init_read(void)
= make_cf3(sharp_whitespace_reader);
dtab[')'] = make_cf3(sharp_right_parenthesis_reader);
*/
dtab['Y'] = dtab['y'] = make_cf3(sharp_Y_reader);
init_backq();