Improved presentation of interpreted forms in the backtraces. These forms can now be inspected.

src/CHANGELOG

@@ -113,6 +113,28 @@ ECL 0.9k:
    macroexpanding a form, this error is printed out and COMPILE-FILE returns
    (VALUES NIL T T). Formerly this error would be ignored.
 
+ - Interpreted forms now appear as SI:BYTECODES in the backtrace. It is
+   possible to inspect these forms using :lambda-expression
+	> (cos 'a)
+	In function COS, the value of argument is
+	        A
+	which is not of expected type NUMBER
+	Broken at SI:BYTECODES.Available restarts:
+	1. (USE-VALUE) Supply a new value of type NUMBER.
+	Broken at SI:BYTECODES.
+	>> :b
+	Backtrace: SI:BYTECODES > si:bytecodes
+	>> :disassemble
+	Evaluated form:
+	   0	PUSH	'A
+	   2	CALLG	1,COS
+	   5	EXIT
+	>> :lambda-expression
+	(COS 'A)
+   Similarly, :lambda-expression also works for other functions that keep
+   this information.
+
+
 * CLOS:
 
  - When caching generic function calls, ECL now uses a thread-local hash table

src/c/cfun.d

@@ -114,7 +114,7 @@ cl_function_lambda_expression(cl_object fun)
 		    output = Cnil;
 		else if (name == Cnil)
 		    output = cl_cons(@'lambda', output);
-		else
+		else if (name != @'si::bytecodes')
 		    output = @list*(3, @'ext::lambda-block', name, output);
 		break;
 	case t_cfun:

src/c/compiler.d

@@ -2568,7 +2568,8 @@ si_make_lambda(cl_object name, cl_object rest)
 		compile_form(form, FLAG_VALUES);
 		asm_op(OP_EXIT);
 		bytecodes = asm_end(handle);
-		bytecodes->bytecodes.name = @'eval';
+		bytecodes->bytecodes.name = @'si::bytecodes';
+		bytecodes->bytecodes.definition = form;
 	} CL_UNWIND_PROTECT_EXIT {
 		/* Clear up */
 		ENV = old_c_env;

src/c/disassembler.d

@@ -69,8 +69,11 @@ disassemble_lambda(cl_object bytecodes) {
 
 	bds_bind(@'*print-pretty*', Cnil);
 
-	if (bytecodes->bytecodes.name == OBJNULL)
+	if (bytecodes->bytecodes.name == OBJNULL ||
+	    bytecodes->bytecodes.name == @'si::bytecodes') {
+		print_noarg("\nEvaluated form:");
 		goto NO_ARGS;
+	}
 
 	/* Name of LAMBDA */
 	print_arg("\nName:\t\t", bytecodes->bytecodes.name);

src/c/symbols_list.h

@@ -1697,5 +1697,7 @@ cl_symbols[] = {
 
 {SYS_ "PROPERTY-LIST", SI_ORDINARY, NULL, 1, OBJNULL},
 
+{SYS_ "BYTECODES", SI_ORDINARY, NULL, 1, OBJNULL},
+
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};

src/c/symbols_list2.h

@@ -1697,5 +1697,7 @@ cl_symbols[] = {
 
 {SYS_ "PROPERTY-LIST",NULL},
 
+{SYS_ "BYTECODES",NULL},
+
 /* Tag for end of list */
 {NULL,NULL}};

src/lsp/config.lsp.in

@@ -46,7 +46,7 @@ Returns, as a string, the location of the machine on which ECL runs."
 (defun lisp-implementation-version ()
   "Args:()
 Returns the version of your ECL as a string."
-  "@PACKAGE_VERSION@ (CVS 2008-05-20 14:05)")
+  "@PACKAGE_VERSION@ (CVS 2008-05-22 13:14)")
 
 (defun machine-type ()
   "Args: ()

src/lsp/top.lsp

@@ -241,6 +241,13 @@ rebinds this variable to NIL when control enters a break loop.")
 	~@
 	Disassemble the current function. Currently, only interpreted functions~@
 	can be disassembled.~%")
+      ((:le :lambda-expression) tpl-lambda-expression-command nil
+       ":l(ambda-)e(expression)	Show lisp code for current function"
+       ":lambda-expression				[Break command]~@
+	:le						[Abbreviation]~@
+	~@
+	Show the lisp code of the current function. Only works for interpreted~@
+        functions.~%")
       ((:v :variables) tpl-variables-command nil
        ":v(ariables)	Show local variables, functions, blocks, and tags"
        ":variables &optional no-values			[Break command]~@
@@ -557,6 +564,18 @@ under certain conditions; see file 'Copyright' for details.")
       (format t " Function cannot be disassembled.~%"))
     (values)))
 
+(defun tpl-lambda-expression-command (&optional no-values)
+  (let*((*print-level* 2)
+	(*print-length* 4)
+	(*print-pretty* t)
+	(*print-readably* nil)
+	(function (ihs-fun *ihs-current*))
+	(le (function-lambda-expression function)))
+    (if le
+	(pprint le)
+	(format t " No source code available for this function.~%"))
+    (values)))
+
 (defun reconstruct-bytecodes-lambda-list (data)
   (declare (si::c-local data))
   (let ((output '()))
@@ -740,7 +759,7 @@ under certain conditions; see file 'Copyright' for details.")
     (when (and (consp fname) (eq 'SETF (car fname)))
 	  (setq fname (second fname)))
     (or (eq fname 'EVAL)
-	(eq fname 'EVAL-WITH-ENV)
+	(eq fname 'BYTECODES)
 	(and (not (member (symbol-package fname) *break-hidden-packages*
 			  :TEST #'eq))
 	     (not (null fname))