From 27ab3bdab9b9499046f0a1e380024a88d6d6275b Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Thu, 21 Aug 2008 14:56:48 +0000
Subject: 	* interp/g-error.boot (systemErrorHandler): New. 	*
 interp/sys-driver.boot (restart): Use it.

---
 src/interp/g-error.boot    | 14 ++++++++++++++
 src/interp/sys-driver.boot |  5 +++++
 2 files changed, 19 insertions(+)

(limited to 'src/interp')

diff --git a/src/interp/g-error.boot b/src/interp/g-error.boot
index 32ed1d72..2d7747d5 100644
--- a/src/interp/g-error.boot
+++ b/src/interp/g-error.boot
@@ -194,3 +194,17 @@ throwMessage(:msg) ==
   if $printMsgsToFile then sayMSG2File msg'
   spadThrow()
 
+
+++ Error handler for Lisp systems that support Common Lisp conditions.
+++ We don't want users to get dropped into the Lisp debugger.
+systemErrorHandler c ==
+  $NeedToSignalSessionManager := true
+  $BreakMode = "validate" => 
+    systemError ERROR_-FORMAT('"~a",[c])
+  not $inLispVM and $BreakMode in '(nobreak query resume) =>
+    $inLispVM := true
+    systemError ERROR_-FORMAT('"~a",[c])
+  $BreakMode = "letPrint2" =>
+    $BreakMode := nil
+    THROW("letPrint2",nil)
+
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index 1274564f..12f0a022 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -165,7 +165,12 @@ restart() ==
   $currentLine := nil
   openDatabases()
   readSpadProfileIfThere()
+)if %hasFeature KEYWORD::GCL
   spad()
+)else
+  SETQ(_*DEBUGGER_-HOOK_*,LAMBDA(c h, systemErrorHandler c))
+  !(handler-bind ((error #'|systemErrorHandler|)) (|spad|))
+)endif
 
 --%    
 
-- 
cgit v1.2.3