The following message is a courtesy copy of an article
that has been posted to comp.lang.lisp as well.
Excuse crossposting please, it now seems that it's just a lisp question, and
not sbcl related. So, those who were already following can skip the first
part.
;;PART 1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I am one of the developers of a computer algebra system called FriCAS/axiom.
It is originally gcl-based, but meanwhile sbcl support is pretty good. I have
one annoying problem, however, and hope you can help me a little. Please bear
with me, my lisp skills are of rather basic nature, I have no knowledge at all
of things like error handling...
Problem statement:
=================
in gcl based axiom, hitting Ctrl-c in the interpreter will print
>> System error:
Console interrupt.
and resume, while in sbcl, one falls into the debugger. I would like to switch
that off. More precisely, gcl based axiom supports a variety of settings:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(1) -> )set break
-------------------------- The breakmode Option ---------------------------
Description: execute break processing on error
The breakmode option may be followed by any one of the following:
-> nobreak
break
query
resume
fastlinks
The current setting is indicated within the list.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
As far as I know, this setting is stored in the variable |$BreakMode|
Current knowledge:
=================
Meanwhile I know from our chief maintainer Waldek:
> FriCAS takes over gcl exception handling, for other Lisps we use Ansi
> condition system to catch errors.
(I have no idea what the "ANSI condition system" is, I must admit)
The code handling errors is below, I believe that I'm interested in the very
last eval-when. Concerning $inLispVM, there is a comment:
The $inLispVM is set to NIL in spad. LispVM is a non-common lisp that runs on
IBM/370 mainframes. This is probably dead code. It appears that this list has
the same structure as an argument to the LispVM rdefiostream function.
(Note that (boundp $inLispVM) gives T)
;;PART 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Assuming that *debugger-hook* is the way to go, I tried the following in
spaderror.lisp:
#-(or :GCL :CCL)
(eval-when (load eval)
(setq *debugger-hook*
(lambda (a b)
(|systemError| (error-format a)))))
This seems to be roughly working. I guess it remains to copy the semantics of
the form below. Help is greatly appreciated:
1) I do not know what embed/unembed does. Definitions at the end of this
message
2) I guess that I only need to implement the
(and (boundp '|$inLispVM|) (boundp '|$BreakMode|))
branch of the if, or could it happen that '|$BreakMode| is not bound?
3) are |validate|, |trapNumerics| dead code?
Martin
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parts of spaderror.lisp, containing the error handler for gcl.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#+:GCL
(eval-when
(load eval)
(unembed 'system:universal-error-handler)
(embed 'system:universal-error-handler
'(lambda (type correctable? op
continue-string error-string &rest args)
(block
nil
(setq |$NeedToSignalSessionManager| T)
(if (and (boundp '|$inLispVM|) (boundp '|$BreakMode|))
(progn
(cond ((eq |$BreakMode| '|validate|)
(|systemError| (error-format error-string args)))
((and (eq |$BreakMode| '|trapNumerics|)
(eq type :ERROR))
(setq |$BreakMode| nil)
(throw '|trapNumerics| |$numericFailure|))
((and (eq |$BreakMode| '|trapNumerics|)
(boundp '|$oldBreakMode|)
(setq |$BreakMode| |$oldBreakMode|)
nil)) ;; resets error handler
((and (null |$inLispVM|)
(memq |$BreakMode| '(|nobreak| |query| |resume|)))
(let ((|$inLispVM| T)) ;; turn off handler
(return
(|systemError| (error-format error-string args)))))
((eq |$BreakMode| '|letPrint2|)
(setq |$BreakMode| nil)
(throw '|letPrint2| nil)))))
(apply system:universal-error-handler type correctable? op
continue-string error-string args )))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parts of vmlisp.lisp, containing definitions for embed and unembed
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 46.0 Call tracing
(defun EMBEDDED () (mapcar #'car *embedded-functions*))
(defun EMBED (CURRENT-BINDING NEW-DEFINITION)
(PROG
#+:CCL (OP BV BODY OLD-DEF *COMP)
#-:CCL (OP BV BODY OLD-DEF)
(COND
( (NOT (IDENTP CURRENT-BINDING))
(SETQ CURRENT-BINDING
(error (format nil "invalid argument ~s to EMBED"
CURRENT-BINDING))) ) )
(SETQ OLD-DEF (symbol-function CURRENT-BINDING))
(SETQ NEW-DEFINITION
(COND
( (NOT (consp NEW-DEFINITION))
NEW-DEFINITION )
( (AND
(DCQ (OP BV . BODY) NEW-DEFINITION)
(OR (EQ OP 'LAMBDA) (EQ OP 'MLAMBDA)))
(COND
( (NOT (MEMQ CURRENT-BINDING (FLAT-BV-LIST BV)))
`(,OP ,BV ((LAMBDA (,CURRENT-BINDING) . ,BODY) ',OLD-DEF))
)
( 'T
NEW-DEFINITION ) ) )
( 'T
`((LAMBDA (,CURRENT-BINDING) ,NEW-DEFINITION) ',OLD-DEF)))
)
(SETF NEW-DEFINITION (COERCE NEW-DEFINITION 'FUNCTION))
(SETF (symbol-function CURRENT-BINDING) NEW-DEFINITION)
#+:CCL (IF (CONSP NEW-DEFINITION) (SETQ NEW-DEFINITION (CDR NEW-DEFINITION)))
(push (LIST CURRENT-BINDING NEW-DEFINITION OLD-DEF) *embedded-functions*)
(RETURN CURRENT-BINDING) ) )
(defun UNEMBED (CURRENT-BINDING)
(PROG
#+:CCL (TMP E-LIST CUR-DEF *COMP)
#-:CCL (TMP E-LIST CUR-DEF)
(SETQ E-LIST *embedded-functions*)
(SETQ CUR-DEF (symbol-function CURRENT-BINDING))
#+:CCL (IF (CONSP CUR-DEF) (SETQ CUR-DEF (CDR CUR-DEF)))
(COND
( (NOT (consp E-LIST))
NIL )
( (ECQ ((CURRENT-BINDING CUR-DEF)) E-LIST)
(SETF (symbol-function CURRENT-BINDING) (QCADDAR E-LIST))
(SETQ *embedded-functions* (QCDR E-LIST))
(RETURN CURRENT-BINDING) )
( 'T
(SEQ
(SETQ TMP E-LIST)
LP (COND
( (NOT (consp (QCDR TMP)))
(EXIT NIL) )
( (NULL (ECQ ((CURRENT-BINDING CUR-DEF)) (QCDR TMP)))
(SETQ TMP (QCDR TMP))
(GO LP) )
( 'T
(SETF (symbol-function CURRENT-BINDING) (QCAR (QCDDADR TMP)))
(RPLACD TMP (QCDDR TMP))
(RETURN CURRENT-BINDING) ) ) ) ) )
(RETURN NIL) ))
|