mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-05 00:40:48 -08:00
Bytecode functions can now be printed/read (M. Pasternacki)
This commit is contained in:
parent
9e747f5fc3
commit
b9b960f178
3 changed files with 74 additions and 12 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
40
src/c/read.d
40
src/c/read.d
|
|
@ -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();
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue