Add new debug meta-command ,error-message

* module/system/repl/error-handling.scm: use the error string to
  construct the <debug> instance.

* module/system/repl/command.scm: new debug command `error-message'
  that extracts the new <debug> field, available to stack commands as
  `message'.

* doc/ref/scheme-using.texi: documentation for new command.

* module/system/repl/debug.scm: <debug> stores the error string in a
  new field.

doc/ref/scheme-using.texi

@@ -311,6 +311,14 @@ Show local variables.
 Show locally-bound variables in the selected frame.
 @end deffn
 
+@deffn {REPL Command} error-message
+@deffnx {REPL Command} error
+Show error message.
+
+Display the message associated with the error that started the current
+debugging REPL.
+@end deffn
+
 @c FIXME: whenever we regain support for stepping, here are the docs..
 
 @c The commands in this subsection all apply only when the stack is

module/system/repl/command.scm

@@ -55,7 +55,7 @@
 	      (disassemble x) (disassemble-file xx))
     (profile  (time t) (profile pr) (trace tr))
     (debug    (backtrace bt) (up) (down) (frame fr)
-              (procedure proc) (locals))
+              (procedure proc) (locals) (error-message error))
     (inspect  (inspect i) (pretty-print pp))
     (system   (gc) (statistics stat) (option o)
               (quit q continue cont))))
@@ -463,6 +463,8 @@ Trace execution."
                  (letrec-syntax
                      ((#,(datum->syntax #'repl 'frames)
                        (identifier-syntax (debug-frames debug)))
+                      (#,(datum->syntax #'repl 'message)
+                       (identifier-syntax (debug-error-message debug)))
                       (#,(datum->syntax #'repl 'index)
                        (identifier-syntax
                         (id (debug-index debug))
@@ -474,6 +476,14 @@ Trace execution."
                    body body* ...)
                  (format #t "Nothing to debug.~%"))))))))
 
+(define-stack-command (error-message repl)
+  "error-message
+Show error message.
+
+Display the message associated with the error that started the current
+debugging REPL."
+  (format #t "~a~%" (if (string? message) message "No error message")))
+
 (define-stack-command (backtrace repl #:optional count
                                  #:key (width 72) full?)
   "backtrace [COUNT] [#:width W] [#:full? F]

module/system/repl/debug.scm

@@ -30,7 +30,7 @@
   #:use-module ((system vm inspect) #:select ((inspect . %inspect)))
   #:use-module (system vm program)
   #:export (<debug>
-            make-debug debug? debug-frames debug-index
+            make-debug debug? debug-frames debug-index debug-error-message
             print-locals print-frame print-frames frame->module
             stack->vector narrow-stack->vector))
 
@@ -66,7 +66,7 @@
 ;;; accessors, and provides some helper functions.
 ;;;
 
-(define-record <debug> frames index)
+(define-record <debug> frames index error-message)
 
 
 

module/system/repl/error-handling.scm

@@ -32,6 +32,16 @@
 ;;; Error handling via repl debugging
 ;;;
 
+(define (error-string stack key args)
+  (with-output-to-string
+    (lambda ()
+      (pmatch args
+        ((,subr ,msg ,args . ,rest)
+         (display-error (vector-ref stack 0) (current-output-port)
+                        subr msg args rest))
+        (else
+         (format #t "Throw to key `~a' with args `~s'." key args))))))
+
 (define* (call-with-error-handling thunk #:key
                                    (on-error 'debug) (post-error 'catch)
                                    (pass-keys '(quit)))
@@ -92,15 +102,11 @@
                           ;; And one more frame, because %start-stack invoking
                           ;; the start-stack thunk has its own frame too.
                           0 (and tag 1)))
-                  (debug (make-debug stack 0)))
+                  (error-msg (error-string stack key args))
+                  (debug (make-debug stack 0 error-msg)))
              (with-saved-ports
               (lambda ()
-                (pmatch args
+                (format #t error-msg)
-                  ((,subr ,msg ,args . ,rest)
-                   (display-error (vector-ref stack 0) (current-output-port)
-                                  subr msg args rest))
-                  (else
-                   (format #t "Throw to key `~a' with args `~s'." key args)))
                 (format #t "Entering a new prompt.  ")
                 (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")
                 ((@ (system repl repl) start-repl) #:debug debug))))))