mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-10 23:20:23 -07:00
741a01da09
The syntax had been changed in commit
991bc3ab78, but the reader macro
became broken in the process and commit
835e85bc99 removed the broken
parts. Since the reason for the change in the syntax is unclear,
go back to the old syntax.
68 lines
2.1 KiB
C
68 lines
2.1 KiB
C
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
|
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
|
|
|
/*
|
|
* write_list.d - ugly printer for bytecodes and functions
|
|
*
|
|
* Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
|
|
* Copyright (c) 1990 Giuseppe Attardi
|
|
* Copyright (c) 2001 Juan Jose Garcia Ripoll
|
|
*
|
|
* See file 'LICENSE' for the copyright details.
|
|
*
|
|
*/
|
|
|
|
#include <ecl/ecl.h>
|
|
#include <ecl/internal.h>
|
|
#include <ecl/bytecodes.h>
|
|
|
|
void
|
|
_ecl_write_bytecodes_readably(cl_object x, cl_object stream, cl_object lex)
|
|
{
|
|
cl_index i;
|
|
cl_object code_l = ECL_NIL;
|
|
/* INV: We don't write the definition of the closure, hence we don't
|
|
* need to write the macros it closes over either */
|
|
for (; !Null(lex); lex = ECL_CONS_CDR(lex)) {
|
|
cl_object record = ECL_CONS_CAR(lex);
|
|
if (!ECL_CONSP(record) || (ECL_CONS_CAR(record) != @'si::macro' &&
|
|
ECL_CONS_CAR(record) != @'si::symbol-macro'))
|
|
break;
|
|
}
|
|
for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
|
|
code_l = ecl_cons(ecl_make_fixnum(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
|
|
writestr_stream("#Y", stream);
|
|
si_write_ugly_object(cl_list(7, x->bytecodes.name, lex,
|
|
ECL_NIL /* x->bytecodes.definition */,
|
|
code_l, x->bytecodes.data,
|
|
x->bytecodes.file,
|
|
x->bytecodes.file_position),
|
|
stream);
|
|
}
|
|
|
|
void
|
|
_ecl_write_bytecodes(cl_object x, cl_object stream)
|
|
{
|
|
if (ecl_print_readably()) {
|
|
_ecl_write_bytecodes_readably(x, stream, ECL_NIL);
|
|
} else {
|
|
_ecl_write_unreadable(x, "bytecompiled-function", x->bytecodes.name, stream);
|
|
}
|
|
}
|
|
|
|
void
|
|
_ecl_write_bclosure(cl_object x, cl_object stream)
|
|
{
|
|
if (ecl_print_readably()) {
|
|
_ecl_write_bytecodes_readably(x->bclosure.code, stream, x->bclosure.lex);
|
|
} else {
|
|
cl_object name = x->bytecodes.name;
|
|
writestr_stream("#<bytecompiled-closure ", stream);
|
|
if (name != ECL_NIL) {
|
|
si_write_ugly_object(name, stream);
|
|
} else {
|
|
_ecl_write_addr((void *)x, stream);
|
|
}
|
|
ecl_write_char('>', stream);
|
|
}
|
|
}
|