From 58cf3c6b9dfd53a0a0eb13ad941b2ae4026a5c2f Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Wed, 26 Nov 2003 18:40:46 +0000
Subject: [PATCH] Fixed problems with STEP and forms that have to be evaluated
 at compilation time, such as toplevel PROGN, EVAL-WHEN, etc.

---
 src/c/compiler.d     | 17 +++++++++++++----
 src/c/disassembler.d |  3 ++-
 src/c/interpreter.d  |  4 ++++
 3 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/src/c/compiler.d b/src/c/compiler.d
index a2d03b8bb..08d709b7f 100644
--- a/src/c/compiler.d
+++ b/src/c/compiler.d
@@ -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);
diff --git a/src/c/disassembler.d b/src/c/disassembler.d
index c47fa55c7..bc94a5481 100644
--- a/src/c/disassembler.d
+++ b/src/c/disassembler.d
@@ -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;
diff --git a/src/c/interpreter.d b/src/c/interpreter.d
index 30a488664..53a773bdc 100644
--- a/src/c/interpreter.d
+++ b/src/c/interpreter.d
@@ -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: