dler) (vector-ref handler 1))
  (define (exception-handler-pre-unwind handler) (vector-ref handler 2))

  (define %running-pre-unwind (make-fluid #f))
  (define (pre-unwind-handler-running? handler)
    (let lp ((depth 0))
      (let ((running (fluid-ref* %running-pre-unwind depth)))
        (and running
             (or (eq? running handler) (lp (1+ depth)))))))

  (define (dispatch-exception depth key args)
    (cond
     ((fluid-ref* %eh depth)
      => (lambda (handler)
           (let ((catch-key (exception-handler-catch-key handler)))
             (if (or (eqv? catch-key #t) (eq? catch-key key))
                 (let ((prompt-tag (exception-handler-prompt-tag handler))
                       (pre-unwind (exception-handler-pre-unwind handler)))
                   (cond
                    ((and pre-unwind
                          (not (pre-unwind-handler-running? handler)))
                     ;; Prevent errors from within the pre-unwind
                     ;; handler's invocation from being handled by this
                     ;; handler.
                     (with-fluid* %running-pre-unwind handler
                       (lambda ()
                         ;; FIXME: Currently the "running" flag only
                         ;; applies to the pre-unwind handler; the
                         ;; post-unwind handler is still called if the
                         ;; error is explicitly rethrown.  Instead it
                         ;; would be better to cause a recursive throw to
                         ;; skip all parts of this handler.  Unfortunately
                         ;; that is incompatible with existing semantics.
                         ;; We'll see if we can change that later on.
                         (apply pre-unwind key args)
                         (dispatch-exception depth key args))))
                    (prompt-tag
                     (apply abort-to-prompt prompt-tag key args))
                    (else
                     (dispatch-exception (1+ depth) key args))))
                 (dispatch-exception (1+ depth) key args)))))
     ((eq? key 'quit)
      (primitive-exit (cond
                       ((not (pair? args)) 0)
                       ((integer? (car args)) (car args))
                       ((not (car args)) 1)
                       (else 0))))
     (else
      (format (current-error-port) "guile: uncaught throw to ~a: ~a\n"
              key args)
      (primitive-exit 1))))

  (define (throw key . args)
    "Invoke the catch form matching @var{key}, passing @var{args} to the
@var{handler}.

@var{key} is a symbol. It will match catches of the same symbol or of @code{#t}.

If there is no handler at all, Guile prints an error and then exits."
    (unless (symbol? key)
      (throw 'wrong-type-arg "throw" "Wrong type argument in position ~a: ~a"
             (list 1 key) (list key)))
    (dispatch-exception 0 key args))

  (define* (catch k thunk handler #:optional pre-unwind-handler)
    "Invoke @var{thunk} in the dynamic context of @var{handler} for
exceptions matching @var{key}.  If thunk throws to the symbol
@var{key}, then @var{handler} is invoked this way:
@lisp
 (handler key args ...)
@end lisp

@var{key} is a symbol or @code{#t}.

@var{thunk} takes no arguments.  If @var{thunk} returns
normally, that is the return value of @code{catch}.

Handler is invoked outside the scope of its own @code{catch}.
If @var{handler} again throws to the same key, a new handler
from further up the call chain is invoked.

If the key is @code{#t}, then a throw to @emph{any} symbol will
match this call to @code{catch}.

If a @var{pre-unwind-handler} is given and @var{thunk} throws
an exception that matches @var{key}, Guile calls the
@var{pre-unwind-handler} before unwinding the dynamic state and
invoking the main @var{handler}.  @var{pre-unwind-handler} should
be a procedure with the same signature as @var{handler}, that
is @code{(lambda (key . args))}.  It is typically used to save
the stack at the point where the exception occurred, but can also
query other parts of the dynamic state at that point, such as
fluid values.

A @var{pre-unwind-handler} can exit either normally or non-locally.
If it exits normally, Guile unwinds the stack and dynamic context
and then calls the normal (third argument) handler.  If it exits
non-locally, that exit determines the continuation."
    (define (wrong-type-arg n val)
      (scm-error 'wrong-type-arg "catch"
                 "Wrong type argument in position ~a: ~a"
                 (list n val) (list val)))
    (unless (or (symbol? k) (eqv? k #t))
      (wrong-type-arg 1 k))
    (unless (procedure? handler)
      (wrong-type-arg 3 handler))
    (unless (or (not pre-unwind-handler) (procedure? pre-unwind-handler))
      (wrong-type-arg 4 pre-unwind-handler))
    (let ((tag (make-prompt-tag "catch")))
      (call-with-prompt
       tag
       (lambda ()
         (with-fluid* %eh (make-exception-handler k tag pre-unwind-handler)
           thunk))
       (lambda (cont k . args)
         (apply handler k args)))))

  (define (with-throw-handler k thunk pre-unwind-handler)
    "Add @var{handler} to the dynamic context as a throw handler
for key @var{k}, then invoke @var{thunk}."
    (if (not (or (symbol? k) (eqv? k #t)))
        (scm-error 'wrong-type-arg "with-throw-handler"
                   "Wrong type argument in position ~a: ~a"
                   (list 1 k) (list k)))
    (with-fluid* %eh (make-exception-handler k #f pre-unwind-handler)
      thunk))

  (hashq-remove! (%get-pre-modules-obarray) '%exception-handler)
  (define! 'catch catch)
  (define! 'with-throw-handler with-throw-handler)
  (define! 'throw throw))