From 7d68d653316e268d1eec52d0ec86e4289dcc075f Mon Sep 17 00:00:00 2001
From: jgarcia <jgarcia>
Date: Sat, 13 Oct 2007 10:11:53 +0000
Subject: [PATCH] Do not print \*current-form\* when there is none

---
 src/c/error.d        | 19 ++++++++++++++-----
 src/c/symbols_list.h |  2 +-
 2 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/src/c/error.d b/src/c/error.d
index e68d90826..cdfe97526 100644
--- a/src/c/error.d
+++ b/src/c/error.d
@@ -82,16 +82,25 @@ CEerror(const char *err, int narg, ...)
 void
 FEprogram_error(const char *s, int narg, ...)
 {
-	cl_object form, real_args;
+  cl_object form, real_args, text;
 	cl_va_list args;
 	cl_va_start(args, narg, narg, 0);
-	real_args = @list(3, SYM_VAL(@'si::*current-form*'),
-			  make_constant_base_string(s),
-			  cl_grab_rest_args(args));
+	text = make_constant_base_string(s);
+	real_args = cl_grab_rest_args(args);
+	if (cl_boundp(@'si::*current-form*') != Cnil) {
+	    /* When FEprogram_error is invoked from the compiler, we can
+	     * provide information about the offending form.
+	     */
+	    cl_object stmt = SYM_VAL(@'si::*current-form*');
+	    if (stmt != Cnil) {
+		real_args = @list(3, stmt, text, real_args);
+		text = make_constant_base_string("In form~%~S~%~?");
+	    }
+	}
 	si_signal_simple_error(4, 
 			       @'program-error', /* condition name */
 			       Cnil, /* not correctable */
-			       make_constant_base_string("In form~%~S~%~?"),
+			       text,
 			       real_args);
 }
 
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 6fcaa3c60..770a99ed7 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1657,7 +1657,7 @@ cl_symbols[] = {
 
 {SYS_ "GC-STATS", SI_ORDINARY, si_gc_stats, 1, OBJNULL},
 
-{SYS_ "*CURRENT-FORM*", SI_SPECIAL, NULL, -1, Cnil},
+{SYS_ "*CURRENT-FORM*", SI_SPECIAL, NULL, -1, OBJNULL},
 
 {SYS_ "CODE-BLOCK", SI_ORDINARY, NULL, -1, OBJNULL},