mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-12 04:11:18 -08:00
Code Issues Projects Releases Packages Wiki Activity

Fixed problems with STEP and forms that have to be evaluated at compilation time, such as toplevel PROGN, EVAL-WHEN, etc.

Browse source
This commit is contained in:
jjgarcia 2003-11-26 18:40:46 +00:00
parent 72a90f9e90
commit 58cf3c6b9d
3 changed files with 19 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

17
src/c/compiler.d
View file

@ -1970,13 +1970,15 @@ compile_form(cl_object stmt, int flags) {
stmt = CAR(stmt);
goto QUOTED;
}
if (ENV->stepping)
asm_op2c(OP_STEPIN, stmt);
for (l = database; l->symbol != OBJNULL; l++)
if (l->symbol == function) {
ENV->lexical_level += l->lexical_increment;
if (ENV->stepping && function != @'function' &&
ENV->lexical_level)
asm_op2c(OP_STEPIN, stmt);
new_flags = (*(l->compiler))(CDR(stmt), flags);
if (ENV->stepping)
if (ENV->stepping && function != @'function' &&
ENV->lexical_level)
asm_op(OP_STEPOUT);
goto OUTPUT;
}
@ -1997,6 +1999,8 @@ for special form ~S.", 1, function);
/*
* Finally resort to ordinary function calls.
*/
if (ENV->stepping)
asm_op2c(OP_STEPIN, stmt);
new_flags = c_call(stmt, flags);
OUTPUT:
/*
@ -2030,8 +2034,12 @@ static int
compile_body(cl_object body, int flags) {
if (ENV->lexical_level == 0 && !endp(body)) {
while (!endp(CDR(body))) {
cl_index handle = asm_begin();
struct cl_compiler_env *old_c_env = ENV;
struct cl_compiler_env new_c_env = *old_c_env;
cl_index handle;
cl_object bytecodes;
ENV = &new_c_env;
handle = asm_begin();
compile_form(CAR(body), FLAG_VALUES);
asm_op(OP_EXIT);
VALUES(0) = Cnil;
@ -2039,6 +2047,7 @@ compile_body(cl_object body, int flags) {
bytecodes = asm_end(handle);
interpret(bytecodes, bytecodes->bytecodes.code);
asm_clear(handle);
ENV = old_c_env;
#ifdef GBC_BOEHM
GC_free(bytecodes->bytecodes.code);
GC_free(bytecodes->bytecodes.data);

3
src/c/disassembler.d
View file

@ -686,7 +686,8 @@ disassemble(cl_object bytecodes, cl_opcode *vector) {
goto NOARG;
case OP_PUSHNIL: string = "PUSH\t'NIL";
goto NOARG;
case OP_STEPIN: string = "STEP\tIN";
case OP_STEPIN: string = "STEP\tIN,";
o = GET_DATA(vector, bytecodes);
goto ARG;
case OP_STEPOUT: string = "STEP\tOUT";
goto NOARG;

4
src/c/interpreter.d
View file

@ -1310,6 +1310,7 @@ interpret(cl_object bytecodes, void *pc) {
case OP_STEPIN: {
cl_object form = GET_DATA(vector, bytecodes);
cl_object a = SYM_VAL(@'si::*step-action*');
int n = cl_stack_push_values();
if (a == Ct) {
/* We are stepping in, but must first ask the user
* what to do. */
@ -1326,6 +1327,7 @@ interpret(cl_object bytecodes, void *pc) {
/* We are not inside a STEP form. This should
* actually never happen. */
}
cl_stack_pop_values(n);
break;
}
case OP_STEPCALL: {
@ -1341,6 +1343,7 @@ interpret(cl_object bytecodes, void *pc) {
}
case OP_STEPOUT: {
cl_object a = SYM_VAL(@'si::*step-action*');
int n = cl_stack_push_values();
if (a == Ct) {
/* We exit one stepping level */
ECL_SETQ(@'si::*step-level*',
@ -1354,6 +1357,7 @@ interpret(cl_object bytecodes, void *pc) {
} else {
/* Not stepping, nothing to be done. */
}
cl_stack_pop_values(n);
break;
}
default: