diff --git a/am/bootstrap.am b/am/bootstrap.am
index 139649bde..2d0120634 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -1,5 +1,5 @@
 ##  	Copyright (C) 2009, 2010, 2011, 2012, 2013,
-##        2014, 2015, 2017 Free Software Foundation, Inc.
+##        2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 ##
 ##   This file is part of GNU Guile.
 ##
@@ -84,7 +84,6 @@ SOURCES =					\
   language/cps/handle-interrupts.scm		\
   language/cps/licm.scm				\
   language/cps/peel-loops.scm			\
-  language/cps/prune-bailouts.scm		\
   language/cps/prune-top-level-scopes.scm	\
   language/cps/reify-primitives.scm		\
   language/cps/renumber.scm			\
diff --git a/module/Makefile.am b/module/Makefile.am
index 535b5d8d3..b582bbb2d 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with automake to produce Makefile.in.
 ##
 ##  	Copyright (C) 2009, 2010, 2011, 2012, 2013,
-##        2014, 2015, 2017 Free Software Foundation, Inc.
+##        2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -142,7 +142,6 @@ SOURCES =					\
   language/cps/licm.scm				\
   language/cps/optimize.scm			\
   language/cps/peel-loops.scm			\
-  language/cps/prune-bailouts.scm		\
   language/cps/prune-top-level-scopes.scm	\
   language/cps/reify-primitives.scm		\
   language/cps/renumber.scm			\
diff --git a/module/language/cps.scm b/module/language/cps.scm
index 771d65649..55b34c949 100644
--- a/module/language/cps.scm
+++ b/module/language/cps.scm
@@ -127,7 +127,7 @@
             $kreceive $kargs $kfun $ktail $kclause
 
             ;; Terms.
-            $continue $branch $prompt
+            $continue $branch $prompt $throw
 
             ;; Expressions.
             $const $prim $fun $rec $closure
@@ -181,6 +181,7 @@
 (define-cps-type $continue k src exp)
 (define-cps-type $branch kf kt src op param args)
 (define-cps-type $prompt k kh src escape? tag)
+(define-cps-type $throw src op param args)
 
 ;; Expressions.
 (define-cps-type $const val)
@@ -231,7 +232,13 @@
     ((_ ($branch kf kt src op param args))
      (make-$branch kf kt src op param args))
     ((_ ($prompt k kh src escape? tag))
-     (make-$prompt k kh src escape? tag))))
+     (make-$prompt k kh src escape? tag))
+    ((_ ($throw src op param (unquote args)))
+     (make-$throw src op param args))
+    ((_ ($throw src op param (arg ...)))
+     (make-$throw src op param (list arg ...)))
+    ((_ ($throw src op param args))
+     (make-$throw src op param args))))
 
 (define-syntax build-exp
   (syntax-rules (unquote
@@ -292,6 +299,8 @@
      (build-term ($branch kf kt (src exp) op param arg)))
     (('prompt k kh escape? tag)
      (build-term ($prompt k kh (src exp) escape? tag)))
+    (('throw op param arg ...)
+     (build-term ($throw (src exp) op param arg)))
 
     ;; Expressions.
     (('unspecified)
@@ -339,6 +348,8 @@
      `(branch ,kf ,kt ,op ,param ,@args))
     (($ $prompt k kh src escape? tag)
      `(prompt ,k ,kh ,escape? ,tag))
+    (($ $throw src op param args)
+     `(throw ,op ,param ,@args))
 
     ;; Expressions.
     (($ $const val)
diff --git a/module/language/cps/closure-conversion.scm b/module/language/cps/closure-conversion.scm
index 32472f19d..2e5a910ed 100644
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -95,6 +95,8 @@ conts."
          (add-uses args uses))
         (($ $kargs _ _ ($ $prompt k kh src escape? tag))
          (add-use tag uses))
+        (($ $kargs _ _ ($ $throw src op param args))
+         (add-uses args uses))
         (_ uses)))
     conts
     empty-intset)))
@@ -119,7 +121,8 @@ conts."
       (($ $kclause arity kbody kalt) (ref2 kbody kalt))
       (($ $kargs _ _ ($ $continue k)) (ref1 k))
       (($ $kargs _ _ ($ $branch kf kt)) (ref2 kf kt))
-      (($ $kargs _ _ ($ $prompt k kh)) (ref2 k kh))))
+      (($ $kargs _ _ ($ $prompt k kh)) (ref2 k kh))
+      (($ $kargs _ _ ($ $throw)) (ref0))))
   (let*-values (((single multiple) (values empty-intset empty-intset))
                 ((single multiple) (intset-fold add-ref body single multiple)))
     (intset-subtract (persistent-intset single)
@@ -253,7 +256,9 @@ shared closures to use the appropriate 'self' variable, if possible."
         (($ $branch kf kt src op param args)
          ($branch kf kt src op param ,(map subst args)))
         (($ $prompt k kh src escape? tag)
-         ($prompt k kh src escape? (subst tag)))))
+         ($prompt k kh src escape? (subst tag)))
+        (($ $throw src op param args)
+         ($throw src op param ,(map subst args)))))
 
     (define (visit-rec labels vars cps)
       (define (compute-env label bound self rec-bound rec-labels env)
@@ -378,7 +383,9 @@ references."
                      (($ $branch kf kt src op param args)
                       (add-uses args uses))
                      (($ $prompt k kh src escape? tag)
-                      (add-use tag uses)))))
+                      (add-use tag uses))
+                     (($ $throw src op param args)
+                      (add-uses args uses)))))
                  (($ $kfun src meta self)
                   (values (add-def self defs) uses))
                  (_ (values defs uses))))
@@ -726,6 +733,13 @@ bound to @var{var}, and continue to @var{k}."
                (build-term
                  ($continue k src ($values args)))))))
 
+        (($ $branch kf kt src op param args)
+         (convert-args cps args
+           (lambda (cps args)
+             (with-cps cps
+               (build-term
+                 ($branch kf kt src op param args))))))
+
         (($ $prompt k kh src escape? tag)
          (convert-arg cps tag
            (lambda (cps tag)
@@ -733,12 +747,12 @@ bound to @var{var}, and continue to @var{k}."
                (build-term
                  ($prompt k kh src escape? tag))))))
 
-        (($ $branch kf kt src op param args)
+        (($ $throw src op param args)
          (convert-args cps args
            (lambda (cps args)
              (with-cps cps
                (build-term
-                 ($branch kf kt src op param args))))))))
+                 ($throw src op param args))))))))
 
     (intset-fold (lambda (label cps)
                    (match (intmap-ref cps label (lambda (_) #f))
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm
index 552f0a41b..79459cf0e 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -125,9 +125,7 @@
          (for-each (match-lambda
                     ((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
                    (lookup-parallel-moves label allocation))
-         (emit-return-values asm (1+ (length args))))
-        (($ $primcall (or 'throw 'throw/value 'throw/value+data))
-         (compile-effect label exp #f))))
+         (emit-return-values asm (1+ (length args))))))
 
     (define (compile-value label exp dst)
       (match exp
@@ -398,12 +396,15 @@
         (($ $primcall 'atomic-box-set! #f (box val))
          (emit-atomic-box-set! asm (from-sp (slot box)) (from-sp (slot val))))
         (($ $primcall 'handle-interrupts #f ())
-         (emit-handle-interrupts asm))
-        (($ $primcall 'throw #f (key args))
+         (emit-handle-interrupts asm))))
+
+    (define (compile-throw op param args)
+      (match (vector op param args)
+        (#('throw #f (key args))
          (emit-throw asm (from-sp (slot key)) (from-sp (slot args))))
-        (($ $primcall 'throw/value param (val))
+        (#('throw/value param (val))
          (emit-throw/value asm (from-sp (slot val)) param))
-        (($ $primcall 'throw/value+data param (val))
+        (#('throw/value+data param (val))
          (emit-throw/value+data asm (from-sp (slot val)) param))))
 
     (define (compile-prompt label k kh escape? tag)
@@ -632,7 +633,11 @@
         (($ $prompt k kh src escape? tag)
          (when src
            (emit-source asm src))
-         (compile-prompt label (skip-elided-conts k) kh escape? tag))))
+         (compile-prompt label (skip-elided-conts k) kh escape? tag))
+        (($ $throw src op param args)
+         (when src
+           (emit-source asm src))
+         (compile-throw op param args))))
 
     (define (compile-cont label cont)
       (match cont
diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm
index 8266a2383..b24d2cbe5 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -62,7 +62,8 @@ predecessor."
       (($ $kclause arity kbody kalt) (ref2 kbody kalt))
       (($ $kargs names syms ($ $continue k)) (ref1 k))
       (($ $kargs names syms ($ $branch kf kt)) (ref2 kf kt))
-      (($ $kargs names syms ($ $prompt k kh)) (ref2 k kh))))
+      (($ $kargs names syms ($ $prompt k kh)) (ref2 k kh))
+      (($ $kargs names syms ($ $throw)) (ref0))))
   (let*-values (((single multiple) (values empty-intset empty-intset))
                 ((single multiple) (intmap-fold add-ref conts single multiple)))
     (intset-subtract (persistent-intset single)
@@ -194,6 +195,8 @@ $call, and are always called with a compatible arity."
          (exclude-vars functions args))
         (($ $kargs _ _ ($ $prompt k kh src escape? tag))
          (exclude-var functions tag))
+        (($ $kargs _ _ ($ $throw src op param args))
+         (exclude-vars functions args))
         (_ functions)))
     (intmap-fold visit-cont conts functions)))
 
@@ -456,7 +459,7 @@ function set."
     (match term
       (($ $continue k src exp)
        (visit-exp cps k src exp))
-      ((or ($ $branch) ($ $prompt))
+      ((or ($ $branch) ($ $prompt) ($ $throw))
        (with-cps cps term))))
 
   ;; Renumbering is not strictly necessary but some passes may not be
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index 3591485aa..2b1a229ca 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -116,9 +116,10 @@ false.  It could be that both true and false proofs are available."
       (match (intmap-ref conts label)
         (($ $kargs names vars term)
          (match term
-           (($ $continue k) (propagate1 k))
+           (($ $continue k)   (propagate1 k))
            (($ $branch kf kt) (propagate-branch kf kt))
-           (($ $prompt k kh) (propagate2 k kh))))
+           (($ $prompt k kh)  (propagate2 k kh))
+           (($ $throw)        (propagate0))))
         (($ $kreceive arity k)
          (propagate1 k))
         (($ $kfun src meta self tail clause)
@@ -166,8 +167,10 @@ false.  It could be that both true and false proofs are available."
                       (match (intmap-ref conts k)
                         (($ $kargs names vars) vars)
                         (_ #f)))
-                     ((or ($ $branch) ($ $prompt))
-                      '())))))
+                     (($ $branch)
+                      '())
+                     ((or ($ $prompt) ($ $throw))
+                      #f)))))
                (compute-function-body conts kfun)))
 
 (define (compute-singly-referenced succs)
@@ -219,7 +222,7 @@ false.  It could be that both true and false proofs are available."
              (($ $values args) #f)))
           (($ $branch kf kt src op param args)
            (cons* op param (subst-vars var-substs args)))
-          (($ $prompt) #f)))
+          ((or ($ $prompt) ($ $throw)) #f)))
 
       (define (add-auxiliary-definitions! label var-substs term-key)
         (let ((defs (and=> (intmap-ref defs label)
@@ -402,7 +405,10 @@ false.  It could be that both true and false proofs are available."
             ($continue k src ,(visit-exp exp))))))
       (($ $prompt k kh src escape? tag)
        (build-term
-         ($prompt k kh src escape? (subst-var tag))))))
+         ($prompt k kh src escape? (subst-var tag))))
+      (($ $throw src op param args)
+       (build-term
+         ($throw src op param ,(map subst-var args))))))
 
   (intmap-map
    (lambda (label cont)
diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index 7fdbfcfa8..0de6101d7 100644
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -80,12 +80,10 @@ sites."
                                      (causes-effect? fx &allocation))
                                 (values (intset-add! known k) unknown)
                                 (values known (intset-add! unknown k)))))
-                         (($ $kargs _ _ ($ $branch))
-                          ;; Branches pass no values to their
-                          ;; continuations.
-                          (values known unknown))
-                         (($ $kargs _ _ ($ $prompt))
-                          ;; Likewise for prompts.
+                         (($ $kargs _ _ (or ($ $branch) ($ $prompt) ($ $throw)))
+                          ;; Branches and prompts pass no values to
+                          ;; their continuations, and throw terms don't
+                          ;; continue at all.
                           (values known unknown))
                          (($ $kreceive arity kargs)
                           (values known (intset-add! unknown kargs)))
@@ -149,8 +147,6 @@ sites."
                       (intset-add live-labels kfun)
                       live-labels)
                   live-vars)))))
-        (($ $prompt escape? tag handler)
-         (values live-labels (adjoin-var tag live-vars)))
         (($ $call proc args)
          (values live-labels (adjoin-vars args (adjoin-var proc live-vars))))
         (($ $callk kfun proc args)
@@ -247,6 +243,10 @@ sites."
             ;; aborts and remove corresponding "unwind" primcalls.
             (values (intset-add live-labels label)
                     (adjoin-var tag live-vars)))
+           (($ $kargs _ _ ($ $throw src op param args))
+            ;; A reachable "throw" is always live.
+            (values (intset-add live-labels label)
+                    (adjoin-vars args live-vars)))
            (($ $kreceive arity kargs)
             (values live-labels live-vars))
            (($ $kclause arity kargs kalt)
@@ -356,6 +356,8 @@ sites."
            ;; (eventually).
            (values cps (build-term ($continue kf src ($values ()))))))
       (($ $prompt)
+       (values cps term))
+      (($ $throw)
        (values cps term))))
   (define (visit-cont label cont cps)
     (match cont
diff --git a/module/language/cps/devirtualize-integers.scm b/module/language/cps/devirtualize-integers.scm
index 350e2ae8e..731089ecc 100644
--- a/module/language/cps/devirtualize-integers.scm
+++ b/module/language/cps/devirtualize-integers.scm
@@ -76,7 +76,9 @@
            (($ $branch kf kt src op param args)
             (add-uses use-counts args))
            (($ $prompt k kh src escape? tag)
-            (add-use use-counts tag))))
+            (add-use use-counts tag))
+           (($ $throw src op param args)
+            (add-uses use-counts args))))
         (_ use-counts)))
     cps
     (transient-intmap))))
@@ -116,10 +118,7 @@ the trace should be referenced outside of it."
           vars))))
     (define (bailout? k)
       (match (intmap-ref cps k)
-        (($ $kargs _ _
-            ($ $continue _ _
-               ($ $primcall (or 'throw 'throw/value 'throw/value+data))))
-         #t)
+        (($ $kargs _ _ ($ $throw)) #t)
         (_ #f)))
     (match (intmap-ref cps label)
       ;; We know the initial label is a $kargs, and we won't follow the
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index 62cefa0d2..473b280ba 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -614,6 +614,9 @@ the LABELS that are clobbered by the effects of LABEL."
         ;; what nonlocal predecessors of the handler do, so we
         ;; conservatively assume &all-effects.
         &all-effects)
+       (($ $kargs names syms ($ $throw))
+        ;; A reachable "throw" term can never be elided.
+        &all-effects)
        (($ $kreceive arity kargs)
         (match arity
           (($ $arity _ () #f () #f) &type-check)
diff --git a/module/language/cps/licm.scm b/module/language/cps/licm.scm
index b1af1c831..c0768cfc5 100644
--- a/module/language/cps/licm.scm
+++ b/module/language/cps/licm.scm
@@ -204,7 +204,7 @@
                                      ($values fresh-vars))))))
                     (values cps cont loop-vars loop-effects
                             pre-header-label always-reached?)))))))))
-         (($ $branch)
+         ((or ($ $branch) ($ $throw))
           (let* ((cont (build-cont ($kargs names vars ,term)))
                  (always-reached? #f))
             (values cps cont loop-vars loop-effects
diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm
index 8914356c8..5bbd75f1d 100644
--- a/module/language/cps/optimize.scm
+++ b/module/language/cps/optimize.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014, 2015, 2017 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -31,7 +31,6 @@
   #:use-module (language cps licm)
   #:use-module (language cps peel-loops)
   #:use-module (language cps prune-top-level-scopes)
-  #:use-module (language cps prune-bailouts)
   #:use-module (language cps rotate-loops)
   #:use-module (language cps self-references)
   #:use-module (language cps simplify)
@@ -92,7 +91,6 @@
   (prune-top-level-scopes #:prune-top-level-scopes? #t)
   (simplify #:simplify? #t)
   (contify #:contify? #t)
-  (prune-bailouts #:prune-bailouts? #t)
   (simplify #:simplify? #t)
   (devirtualize-integers #:devirtualize-integers? #t)
   (peel-loops #:peel-loops? #t)
@@ -120,7 +118,6 @@
    #:prune-top-level-scopes? #t
    #:contify? #t
    #:specialize-primcalls? #t
-   #:prune-bailouts? #t
    #:peel-loops? #t
    #:cse? #t
    #:type-fold? #t
diff --git a/module/language/cps/peel-loops.scm b/module/language/cps/peel-loops.scm
index e8144fdd8..3350c4031 100644
--- a/module/language/cps/peel-loops.scm
+++ b/module/language/cps/peel-loops.scm
@@ -152,7 +152,9 @@
          op param ,(map rename-var args)))
       (($ $prompt k kh src escape? tag)
        ($prompt (rename-label k) (rename-label kh) src
-         escape? (rename-var tag)))))
+         escape? (rename-var tag)))
+      (($ $throw src op param args)
+       ($throw src op param ,(map rename-var args)))))
   (rewrite-cont cont
     (($ $kargs names vars term)
      ($kargs names (map rename-var vars) ,(rename-term term)))
diff --git a/module/language/cps/prune-bailouts.scm b/module/language/cps/prune-bailouts.scm
deleted file mode 100644
index 5d2f7c3b5..000000000
--- a/module/language/cps/prune-bailouts.scm
+++ /dev/null
@@ -1,70 +0,0 @@
-;;; Continuation-passing style (CPS) intermediate language (IL)
-
-;; Copyright (C) 2013, 2014, 2015, 2017 Free Software Foundation, Inc.
-
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-;;; Commentary:
-;;;
-;;; A pass that prunes successors of expressions that bail out.
-;;;
-;;; Code:
-
-(define-module (language cps prune-bailouts)
-  #:use-module (ice-9 match)
-  #:use-module (language cps)
-  #:use-module (language cps utils)
-  #:use-module (language cps with-cps)
-  #:use-module (language cps intmap)
-  #:use-module (language cps intset)
-  #:export (prune-bailouts))
-
-(define (compute-tails conts)
-  "For each LABEL->CONT entry in the intmap CONTS, compute a
-LABEL->TAIL-LABEL indicating the tail continuation of each expression's
-containing function.  In some cases TAIL-LABEL might not be available,
-for example if there is a stale $kfun pointing at a body, or for
-unreferenced terms.  In that case TAIL-LABEL is either absent or #f."
-  (intmap-fold
-   (lambda (label cont out)
-     (match cont
-       (($ $kfun src meta self tail clause)
-        (intset-fold (lambda (label out)
-                       (intmap-add out label tail (lambda (old new) #f)))
-                     (compute-function-body conts label)
-                     out))
-       (_ out)))
-   conts
-   empty-intmap))
-
-(define (prune-bailouts conts)
-  (let ((tails (compute-tails conts)))
-    (persistent-intmap
-     (intmap-fold
-      (lambda (label cont out)
-        (match cont
-          (($ $kargs names vars
-              ($ $continue k src
-                 (and exp ($ $primcall
-                             (or 'throw 'throw/value 'throw/value+data)))))
-           (match (intmap-ref tails k (lambda (_) #f))
-             (#f out)
-             (ktail
-              (with-cps out
-                (setk label ($kargs names vars
-                              ($continue ktail src ,exp)))))))
-          (_ out)))
-      conts
-      conts))))
diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm
index afd6f71a3..51feb6d2b 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -98,14 +98,12 @@
     (build-term
       ($continue k src ($primcall 'builtin-ref idx ())))))
 
-(define (reify-clause cps ktail)
+(define (reify-clause cps)
   (with-cps cps
     (let$ body
           (with-cps-constants ((wna 'wrong-number-of-args)
                                (args '(#f "Wrong number of arguments" () #f)))
-            (build-term
-              ($continue ktail #f
-                ($primcall 'throw #f (wna args))))))
+            (build-term ($throw #f 'throw #f (wna args)))))
     (letk kbody ($kargs () () ,body))
     (letk kclause ($kclause ('() '() #f '() #f) kbody #f))
     kclause))
@@ -233,7 +231,7 @@
     (match cont
       (($ $kfun src meta self tail #f)
        (with-cps cps
-         (let$ clause (reify-clause tail))
+         (let$ clause (reify-clause))
          (setk label ($kfun src meta self tail clause))))
       (($ $kargs names vars ($ $continue k src ($ $prim name)))
        (with-cps cps
diff --git a/module/language/cps/renumber.scm b/module/language/cps/renumber.scm
index 8adbba93a..8b4996ed7 100644
--- a/module/language/cps/renumber.scm
+++ b/module/language/cps/renumber.scm
@@ -94,7 +94,9 @@
                             (visit2 kf kt order visited)
                             (visit2 kt kf order visited)))
                        (($ $prompt k kh)
-                        (visit2 k kh order visited))))
+                        (visit2 k kh order visited))
+                       (($ $throw)
+                        (values order visited))))
                     (($ $kreceive arity k) (visit k order visited))
                     (($ $kclause arity kbody kalt)
                      (if kalt
@@ -206,7 +208,9 @@
                     op param ,(map rename-var args)))
                  (($ $prompt k kh src escape? tag)
                   ($prompt (rename-label k) (rename-label kh) src
-                    escape? (rename-var tag))))))
+                    escape? (rename-var tag)))
+                 (($ $throw src op param args)
+                  ($throw src op param ,(map rename-var args))))))
            (($ $kreceive ($ $arity req () rest () #f) k)
             ($kreceive req rest (rename-label k)))
            (($ $ktail)
diff --git a/module/language/cps/rotate-loops.scm b/module/language/cps/rotate-loops.scm
index 4c330f90a..48be0d901 100644
--- a/module/language/cps/rotate-loops.scm
+++ b/module/language/cps/rotate-loops.scm
@@ -122,7 +122,9 @@ corresponding var from REPLACEMENTS; otherwise return VAR."
            (($ $branch kf kt src op param args)
             ($branch kf kt src op param ,(rename* args)))
            (($ $prompt k kh src escape? tag)
-            ($prompt k kh src escape? (rename tag)))))
+            ($prompt k kh src escape? (rename tag)))
+           (($ $throw src op param args)
+            ($throw src op param ,(rename* args)))))
        (define (attach-trampoline cps label src names vars args)
          (with-cps cps
            (letk ktramp-out ,(make-trampoline join-label src args))
diff --git a/module/language/cps/self-references.scm b/module/language/cps/self-references.scm
index 10fcb7f53..63c9d613b 100644
--- a/module/language/cps/self-references.scm
+++ b/module/language/cps/self-references.scm
@@ -55,7 +55,9 @@
       (($ $branch kf kt src op param args)
        ($branch kf kt src op param ,(map subst args)))
       (($ $prompt k kh src escape? tag)
-       ($prompt k kh src escape? (subst tag)))))
+       ($prompt k kh src escape? (subst tag)))
+      (($ $throw src op param args)
+       ($throw src op param ,(map subst args)))))
 
   (define (visit-label label cps)
     (match (intmap-ref cps label)
diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm
index a1ac5c9cd..c50372b90 100644
--- a/module/language/cps/simplify.scm
+++ b/module/language/cps/simplify.scm
@@ -82,6 +82,8 @@
        (ref* args))
       (($ $kargs _ _ ($ $prompt k kh src escape? tag))
        (ref tag))
+      (($ $kargs _ _ ($ $throw src op param args))
+       (ref* args))
       (_
        (values single multiple))))
   (let*-values (((single multiple) (values empty-intset empty-intset))
@@ -190,7 +192,8 @@
       (($ $kclause arity kbody kalt) (ref2 kbody kalt))
       (($ $kargs names syms ($ $continue k)) (ref1 k))
       (($ $kargs names syms ($ $branch kf kt)) (ref2 kf kt))
-      (($ $kargs names syms ($ $prompt k kh)) (ref2 k kh))))
+      (($ $kargs names syms ($ $prompt k kh)) (ref2 k kh))
+      (($ $kargs names syms ($ $throw)) (ref0))))
   (let*-values (((single multiple) (values empty-intset empty-intset))
                 ((single multiple) (intset-fold add-ref body single multiple)))
     (intset-subtract (persistent-intset single)
@@ -260,7 +263,9 @@
             (($ $branch kf kt src op param args)
              ($branch kf kt src op param ,(map subst args)))
             (($ $prompt k kh src escape? tag)
-             ($prompt k kh src escape? (subst tag))))))
+             ($prompt k kh src escape? (subst tag)))
+            (($ $throw src op param args)
+             ($throw src op param ,(map subst args))))))
     (transform-conts
      (lambda (label cont)
        (rewrite-cont cont
diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index 76cb48d76..d74b20da0 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -160,6 +160,8 @@ by a label, respectively."
          (return empty-intset (vars->intset args)))
         (($ $kargs _ _ ($ $prompt k kh src escape? tag))
          (return empty-intset (intset tag)))
+        (($ $kargs _ _ ($ $throw src op param args))
+         (return empty-intset (vars->intset args)))
         (($ $kclause arity body alt)
          (return (get-defs body) empty-intset))
         (($ $kreceive arity kargs)
@@ -223,6 +225,7 @@ body continuation in the prompt."
         ((intset-ref labels label) labels)
         (else
          (match (intmap-ref conts label)
+           ;; fixme: remove me?
            (($ $ktail)
             ;; Possible for bailouts; never reached and not part of
             ;; prompt body.
@@ -231,8 +234,6 @@ body continuation in the prompt."
             (let ((labels (intset-add! labels label)))
               (match cont
                 (($ $kreceive arity k) (visit-cont k level labels))
-                (($ $kargs names syms ($ $prompt k kh src escape? tag))
-                 (visit-cont kh level (visit-cont k (1+ level) labels)))
                 (($ $kargs names syms ($ $continue k src ($ $primcall 'wind)))
                  (visit-cont k (1+ level) labels))
                 (($ $kargs names syms ($ $continue k src ($ $primcall 'unwind)))
@@ -240,7 +241,10 @@ body continuation in the prompt."
                 (($ $kargs names syms ($ $continue k src exp))
                  (visit-cont k level labels))
                 (($ $kargs names syms ($ $branch kf kt))
-                 (visit-cont kf level (visit-cont kt level labels))))))))))))
+                 (visit-cont kf level (visit-cont kt level labels)))
+                (($ $kargs names syms ($ $prompt k kh src escape? tag))
+                 (visit-cont kh level (visit-cont k (1+ level) labels)))
+                (($ $kargs names syms ($ $throw)) labels))))))))))
   (define (visit-prompt label handler succs)
     (let ((body (compute-prompt-body label)))
       (define (out-or-back-edge? label)
@@ -741,10 +745,6 @@ are comparable with eqv?.  A tmp slot may be used."
   (intmap-fold
    (lambda (label cont representations)
      (match cont
-       (($ $kargs _ _ ($ $branch))
-        representations)
-       (($ $kargs _ _ ($ $prompt))
-        representations)
        (($ $kargs _ _ ($ $continue k _ exp))
         (match (get-defs k)
           (() representations)
@@ -780,6 +780,8 @@ are comparable with eqv?.  A tmp slot may be used."
                       (intmap-add representations var
                                   (intmap-ref representations arg)))
                     representations args vars))))))
+       (($ $kargs _ _ (or ($ $branch) ($ $prompt) ($ $throw)))
+        representations)
        (($ $kfun src meta self)
         (intmap-add representations self 'scm))
        (($ $kclause arity body alt)
diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm
index 9c0b89548..578a04289 100644
--- a/module/language/cps/specialize-numbers.scm
+++ b/module/language/cps/specialize-numbers.scm
@@ -339,7 +339,9 @@ BITS indicating the significant bits needed for a variable.  BITS may be
                    (($ $branch kf kt src op param args)
                     (add-unknown-uses out args))
                    (($ $prompt k kh src escape? tag)
-                    (add-unknown-use out tag)))))
+                    (add-unknown-use out tag))
+                   (($ $throw src op param args)
+                    (add-unknown-uses out args)))))
               (_ out)))))))))
 
 (define (specialize-operations cps)
diff --git a/module/language/cps/split-rec.scm b/module/language/cps/split-rec.scm
index a38a889d8..d58db1652 100644
--- a/module/language/cps/split-rec.scm
+++ b/module/language/cps/split-rec.scm
@@ -94,7 +94,9 @@ references."
                      (($ $branch kf kt src op param args)
                       (add-uses args uses))
                      (($ $prompt k kh src escape? tag)
-                      (add-use tag uses)))))
+                      (add-use tag uses))
+                     (($ $throw src op param args)
+                      (add-uses args uses)))))
                  (($ $kfun src meta self)
                   (values (add-def self defs) uses))
                  (_ (values defs uses))))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index ec74e6700..0c9ce845c 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1775,9 +1775,9 @@ minimum, and maximum."
 
 (define (successor-count cont)
   (match cont
+    (($ $kargs _ _ ($ $throw)) 0)
     (($ $kargs _ _ ($ $continue)) 1)
-    (($ $kargs _ _ ($ $branch)) 2)
-    (($ $kargs _ _ ($ $prompt)) 2)
+    (($ $kargs _ _ (or ($ $branch) ($ $prompt))) 2)
     (($ $kfun src meta self tail clause) (if clause 1 0))
     (($ $kclause arity body alt) (if alt 2 1))
     (($ $kreceive) 1)
@@ -1977,6 +1977,8 @@ maximum, where type is a bitset as a fixnum."
         (($ $kargs names vars ($ $prompt k kh src escape? tag))
          ;; The "normal" continuation enters the prompt.
          (propagate2 k types kh types))
+        (($ $kargs names vars ($ $throw))
+         (propagate0))
         (($ $kreceive arity k)
          (match (intmap-ref conts k)
            (($ $kargs names vars)
diff --git a/module/language/cps/utils.scm b/module/language/cps/utils.scm
index d8e47e12f..77431b898 100644
--- a/module/language/cps/utils.scm
+++ b/module/language/cps/utils.scm
@@ -205,7 +205,9 @@ disjoint, an error will be signalled."
               (($ $branch kf kt)
                (visit-cont kf (visit-cont kt labels)))
               (($ $prompt k kh)
-               (visit-cont k (visit-cont kh labels))))))))))))
+               (visit-cont k (visit-cont kh labels)))
+              (($ $throw)
+               labels))))))))))
 
 (define* (compute-reachable-functions conts #:optional (kfun 0))
   "Compute a mapping LABEL->LABEL..., where each key is a reachable
@@ -262,7 +264,8 @@ intset."
              (match term
                (($ $continue k) (propagate1 k))
                (($ $branch kf kt) (propagate2 kf kt))
-               (($ $prompt k kh) (propagate2 k kh))))
+               (($ $prompt k kh) (propagate2 k kh))
+               (($ $throw) (propagate0))))
             (($ $kreceive arity k)
              (propagate1 k))
             (($ $kfun src meta self tail clause)
@@ -296,7 +299,8 @@ intset."
        (match term
          (($ $continue k)   (add-pred k preds))
          (($ $branch kf kt) (add-pred kf (add-pred kt preds)))
-         (($ $prompt k kh)  (add-pred k (add-pred kh preds)))))))
+         (($ $prompt k kh)  (add-pred k (add-pred kh preds)))
+         (($ $throw)        preds)))))
   (persistent-intmap
    (intset-fold add-preds labels
                 (intset->intmap (lambda (label) '()) labels))))
diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm
index 9020c5efc..fa3db514b 100644
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -107,7 +107,9 @@ definitions that are available at LABEL."
              (($ $branch kf kt)
               (propagate2 kf kt out))
              (($ $prompt k kh)
-              (propagate2 k kh out)))))
+              (propagate2 k kh out))
+             (($ $throw)
+              (propagate0 out)))))
         (($ $kreceive arity k)
          (propagate1 k in))
         (($ $kfun src meta self tail clause)
@@ -206,6 +208,9 @@ definitions that are available at LABEL."
          first-order)
         (($ $prompt k kh src escape? tag)
          (check-use tag)
+         first-order)
+        (($ $throw src op param args)
+         (for-each check-use args)
          first-order)))
     (intmap-fold
      (lambda (label bound first-order)
@@ -300,7 +305,9 @@ definitions that are available at LABEL."
          (cont (error "bad prompt body" cont)))
        (match (intmap-ref conts kh)
          (($ $kreceive) #t)
-         (cont (error "bad prompt handler" cont))))))
+         (cont (error "bad prompt handler" cont))))
+      (($ $throw)
+       #t)))
   (let ((reachable (compute-reachable-labels conts kfun)))
     (intmap-for-each
      (lambda (label cont)
diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm
index dbdc45cef..3424d6cf4 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -694,18 +694,15 @@
                  ((key . args)
                   (with-cps cps
                     (letv arglist)
-                    (let$ k (adapt-arity k src 0))
                     (letk kargs ($kargs ('arglist) (arglist)
-                                  ($continue k src
-                                    ($primcall 'throw #f (key arglist)))))
+                                  ($throw src 'throw #f (key arglist))))
                     ($ (build-list kargs src args))))))))
          (define (specialize op param . args)
            (convert-args cps args
              (lambda (cps args)
                (with-cps cps
-                 (let$ k (adapt-arity k src 0))
                  (build-term
-                   ($continue k src ($primcall op param args)))))))
+                   ($throw src op param args))))))
          (match args
            ((($ <const> _ key) ($ <const> _ subr) ($ <const> _ msg) args data)
             ;; Specialize `throw' invocations corresponding to common