diff options
| -rw-r--r-- | chickadee.scm | 4 | ||||
| -rw-r--r-- | chickadee/cli/play.scm | 45 | ||||
| -rw-r--r-- | chickadee/game-loop.scm | 23 | ||||
| -rw-r--r-- | doc/api.texi | 11 |
4 files changed, 39 insertions, 44 deletions
diff --git a/chickadee.scm b/chickadee.scm index c8ad719..8dc0400 100644 --- a/chickadee.scm +++ b/chickadee.scm @@ -387,8 +387,8 @@ border is disabled, otherwise it is enabled.") (with-projection (atomic-box-ref default-projection) (draw alpha))) (sdl2:swap-gl-window (unwrap-window window))) - (define (on-error stack key args) - (error stack key args) + (define (on-error e stack) + (error e stack) ;; Flush all input events that have occurred while in the error ;; state. (while (poll-event) #t)) diff --git a/chickadee/cli/play.scm b/chickadee/cli/play.scm index 7745008..4e18b31 100644 --- a/chickadee/cli/play.scm +++ b/chickadee/cli/play.scm @@ -21,6 +21,7 @@ #:use-module (chickadee async-repl) #:use-module (chickadee cli) #:use-module (chickadee config) + #:use-module (ice-9 exceptions) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -195,29 +196,24 @@ Resume the game loop without entering a debugger." (repl-opt (set! repl (make-async-repl)) (start-async-repl repl abort-game))))))))) - (define (handle-error stack key args) + (define (handle-error e stack) ;; Setup the REPL debug object. - (let* ((tag (and (pair? (fluid-ref %stacks)) - (cdr (fluid-ref %stacks)))) - (stack (narrow-stack->vector - stack - ;; Take the stack from the given frame, cutting 0 - ;; frames. - 0 - ;; Narrow the end of the stack to the most recent - ;; start-stack. - ;;tag - ;; And one more frame, because %start-stack - ;; invoking the start-stack thunk has its own frame - ;; too. - 0 (and tag 1) - )) - (error-string (call-with-output-string - (lambda (port) - (let ((frame (and (< 0 (vector-length stack)) - (vector-ref stack 0)))) - (print-exception port frame key args)))))) - (set! debug (make-debug stack 0 error-string)) + (let* ((frame (stack-ref stack 0)) + (error-string + (format #f "~a: In procedure: ~a:~%In procedure: ~a: ~a~%" + (match (frame-source frame) + ((_ file-name line . column) + (format #f "~a:~a:~a" (basename file-name) line column)) + (_ "unknown")) + (frame-procedure-name frame) + (if (exception-with-origin? e) + (exception-origin e) + "unknown") + (if (and (exception-with-message? e) + (exception-with-irritants? e)) + (apply format #f (exception-message e) (exception-irritants e)) + "")))) + (set! debug (make-debug (narrow-stack->vector stack 0) 0 error-string)) ;; Just update the REPL endlessly until the developer says to ;; resume. (let* ((window (current-window)) @@ -264,7 +260,10 @@ Resume the game loop without entering a debugger." button) #:controller-move (trampoline controller-move controller axis value) - #:error (if repl handle-error #f)) + #:error (if (or (assq-ref opts 'repl) + (assq-ref opts 'repl-server)) + handle-error + #f)) (when (async-repl? repl) (close-async-repl repl)))) diff --git a/chickadee/game-loop.scm b/chickadee/game-loop.scm index 76e649a..d0bd287 100644 --- a/chickadee/game-loop.scm +++ b/chickadee/game-loop.scm @@ -26,17 +26,19 @@ ;;; (define (call-with-error-handling handler thunk) + "Call THUNK and respond to any exceptions with HANDLER. Return #t if +an error was handled." (if handler (let ((stack #f)) - (catch #t - (lambda () - (thunk) - #f) - (lambda (key . args) - (handler stack key args) - #t) - (lambda (key . args) - (set! stack (make-stack #t 3))))) + (define (pre-unwind-handler . args) + (set! stack (make-stack #t 4))) + (define (throw-handler) + (with-throw-handler #t thunk pre-unwind-handler) + #f) + (define (exception-handler e) + (handler e stack) + #t) + (with-exception-handler exception-handler throw-handler #:unwind? #t)) (begin (thunk) #f))) @@ -44,9 +46,6 @@ (define-syntax-rule (with-error-handling handler body ...) (call-with-error-handling handler (lambda () body ...))) -(define (default-error-handler stack key args) - (apply throw key args)) - ;;; ;;; Game loop kernel diff --git a/doc/api.texi b/doc/api.texi index bebef33..9ed9eff 100644 --- a/doc/api.texi +++ b/doc/api.texi @@ -290,22 +290,19 @@ values are: @end enumerate @item -@var{error}: Called with three arguments when an error occurs: +@var{error}: Called with two arguments when an error occurs: @enumerate @item -@var{stack}: The call stack at the point of error. +@var{exception}: The exception object. @item -@var{key}: The exception key. - -@item -@var{args}: The arguments thrown with the exception. +@var{stack}: The call stack at the point of the exception. @end enumerate -The default behavior is to re-throw the error. +If no error handler is specified, exceptions will simply be re-raised. @end itemize |