Commit 991bc3ab authored by Juan Jose Garcia Ripoll's avatar Juan Jose Garcia Ripoll
Browse files

Changed reader/writer syntax for bytecodes so that shared constants remain shared.

parent bc0c5db5
......@@ -20,28 +20,24 @@
#include <ecl/bytecodes.h>
void
_ecl_write_bclosure(cl_object x, cl_object stream)
_ecl_write_bytecodes(cl_object x, cl_object stream)
{
if (ecl_print_readably()) {
cl_index i;
cl_object lex = x->bclosure.lex;
cl_object lex = Cnil;
cl_object code_l=Cnil, data_l=Cnil;
x = x->bclosure.code;
for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
code_l = ecl_cons(MAKE_FIXNUM(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
data_l = cl_funcall(3, @'concatenate', @'list',
x->bytecodes.data);
writestr_stream("#Y", stream);
si_write_ugly_object(cl_list(7, x->bytecodes.name, lex,
Cnil /* x->bytecodes.definition */,
code_l, data_l,
code_l, x->bytecodes.data,
x->bytecodes.file,
x->bytecodes.file_position),
stream);
} else {
cl_object name = x->bytecodes.name;
writestr_stream("#<bytecompiled-closure ", stream);
writestr_stream("#<bytecompiled-function ", stream);
if (name != Cnil)
si_write_ugly_object(name, stream);
else
......@@ -51,26 +47,20 @@ _ecl_write_bclosure(cl_object x, cl_object stream)
}
void
_ecl_write_bytecodes(cl_object x, cl_object stream)
_ecl_write_bclosure(cl_object x, cl_object stream)
{
if (ecl_print_readably()) {
cl_index i;
cl_object lex = Cnil;
cl_object code_l=Cnil, data_l=Cnil;
for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
code_l = ecl_cons(MAKE_FIXNUM(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
data_l = cl_funcall(3, @'concatenate', @'list',
x->bytecodes.data);
writestr_stream("#Y", stream);
si_write_ugly_object(cl_list(7, x->bytecodes.name, lex,
Cnil /* x->bytecodes.definition */,
code_l, data_l,
x->bytecodes.file,
x->bytecodes.file_position),
stream);
cl_object lex = x->bclosure.lex;
if (Null(lex)) {
_ecl_write_bytecodes(x->bclosure.code, stream);
} else {
writestr_stream("#Y", stream);
si_write_ugly_object(cl_list(2, x->bclosure.code, lex),
stream);
}
} else {
cl_object name = x->bytecodes.name;
writestr_stream("#<bytecompiled-function ", stream);
writestr_stream("#<bytecompiled-closure ", stream);
if (name != Cnil)
si_write_ugly_object(name, stream);
else
......
......@@ -715,6 +715,16 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d)
FEreader_error("Reader macro #Y should be followed by a list",
in, 0);
}
if (ecl_length(x) == 2) {
rv = ecl_alloc_object(t_bclosure);
rv->bclosure.code = ECL_CONS_CAR(x);
x = ECL_CONS_CDR(x);
rv->bclosure.lex = ECL_CONS_CAR(x);
rv->bclosure.entry = _ecl_bclosure_dispatch_vararg;
@(return rv);
}
rv = ecl_alloc_object(t_bytecodes);
rv->bytecodes.name = ECL_CONS_CAR(x);
......@@ -735,9 +745,8 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d)
nth = ECL_CONS_CAR(x);
x = ECL_CONS_CDR(x);
rv->bytecodes.data =
cl_funcall(4, @'make-array', cl_list_length(nth),
@':initial-contents', nth);
rv->bytecodes.data = nth;
if (ECL_ATOM(x)) {
nth = Cnil;
} else {
......@@ -754,14 +763,6 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d)
rv->bytecodes.file_position = nth;
rv->bytecodes.entry = _ecl_bytecodes_dispatch_vararg;
if (lex != Cnil) {
cl_object x = ecl_alloc_object(t_bclosure);
x->bclosure.code = rv;
x->bclosure.lex = lex;
x->bclosure.entry = _ecl_bclosure_dispatch_vararg;
rv = x;
}
@(return rv);
}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment