diff --git a/c/externs.h b/c/externs.h
index 9fb275714b..5abaa41c49 100644
--- a/c/externs.h
+++ b/c/externs.h
@@ -350,6 +350,7 @@ extern void S_handle_arg_error PROTO((void));
 extern void S_handle_nonprocedure_symbol PROTO((void));
 extern void S_handle_values_error PROTO((void));
 extern void S_handle_mvlet_error PROTO((void));
+extern void S_handle_event_detour PROTO((void));
 extern void S_register_scheme_signal PROTO((iptr sig));
 extern void S_fire_collector PROTO((void));
 extern NORETURN void S_noncontinuable_interrupt PROTO((void));
diff --git a/c/globals.h b/c/globals.h
index 94b240e65d..4a10b7356e 100644
--- a/c/globals.h
+++ b/c/globals.h
@@ -117,6 +117,7 @@ EXTERN struct S_G_struct {
     ptr nuate_id;
     ptr null_continuation_id;
     ptr collect_request_pending_id;
+    ptr event_and_resume_id;
 
   /* gc.c */
     ptr guardians[static_generation+1];
diff --git a/c/prim.c b/c/prim.c
index ec25d2ccba..2cfd4ce999 100644
--- a/c/prim.c
+++ b/c/prim.c
@@ -135,6 +135,7 @@ static void create_c_entry_vector() {
     install_c_entry(CENTRY_handle_values_error, proc2ptr(S_handle_values_error));
     install_c_entry(CENTRY_handle_mvlet_error, proc2ptr(S_handle_mvlet_error));
     install_c_entry(CENTRY_handle_arg_error, proc2ptr(S_handle_arg_error));
+    install_c_entry(CENTRY_handle_event_detour, proc2ptr(S_handle_event_detour));
     install_c_entry(CENTRY_foreign_entry, proc2ptr(S_foreign_entry));
     install_c_entry(CENTRY_install_library_entry, proc2ptr(scheme_install_library_entry));
     install_c_entry(CENTRY_get_more_room, proc2ptr(S_get_more_room));
diff --git a/c/schsig.c b/c/schsig.c
index 82d37438f9..9fe6235023 100644
--- a/c/schsig.c
+++ b/c/schsig.c
@@ -458,6 +458,23 @@ void S_handle_mvlet_error() {
     handle_call_error(tc, ERROR_MVLET, Sfalse);
 }
 
+void S_handle_event_detour() {
+    ptr tc = get_thread_context();
+    ptr resume_proc = CP(tc);
+    ptr resume_args = Snil;
+    iptr argcnt, i;
+
+    argcnt = (iptr)AC0(tc);
+    for (i = argcnt; i > 0; i--) {
+      resume_args = Scons(S_get_scheme_arg(tc, i), resume_args);
+    }
+
+    CP(tc) = S_symbol_value(S_G.event_and_resume_id);
+    S_put_scheme_arg(tc, 1, resume_proc);
+    S_put_scheme_arg(tc, 2, resume_args);
+    AC0(tc) = (ptr)2;
+}
+
 static void keyboard_interrupt(ptr tc) {
   KEYBOARDINTERRUPTPENDING(tc) = Strue;
   SOMETHINGPENDING(tc) = Strue;
@@ -692,6 +709,9 @@ void S_schsig_init() {
 
         S_protect(&S_G.error_id);
         S_G.error_id = S_intern((const unsigned char *)"$c-error");
+
+        S_protect(&S_G.event_and_resume_id);
+        S_G.event_and_resume_id = S_intern((const unsigned char *)"$event-and-resume");
     }
 
 
diff --git a/makefiles/Mf-install.in b/makefiles/Mf-install.in
index bc93bee18a..9ea19706b1 100644
--- a/makefiles/Mf-install.in
+++ b/makefiles/Mf-install.in
@@ -62,7 +62,7 @@ InstallLZ4Target=
 #                 no changes should be needed below this point                #
 ###############################################################################
 
-Version=csv9.5.3.17
+Version=csv9.5.3.18
 Include=boot/$m
 PetiteBoot=boot/$m/petite.boot
 SchemeBoot=boot/$m/scheme.boot
diff --git a/s/cmacros.ss b/s/cmacros.ss
index 73d7fad1ea..fb947c4a76 100644
--- a/s/cmacros.ss
+++ b/s/cmacros.ss
@@ -328,7 +328,7 @@
                  [(_ foo e1 e2) e1] ...
                  [(_ bar e1 e2) e2]))))])))
 
-(define-constant scheme-version #x09050311)
+(define-constant scheme-version #x09050312)
 
 (define-syntax define-machine-types
   (lambda (x)
@@ -2555,6 +2555,7 @@
      (domvleterr #f 0 #f #f)
      (doargerr #f 0 #f #f)
      (get-room #f 0 #f #f)
+     (event-detour #f 0 #f #f)
      (map1 #f 2 #f #t)
      (map2 #f 3 #f #t)
      (for-each1 #f 2 #f #t)
@@ -2786,6 +2787,7 @@
      handle-values-error
      handle-mvlet-error
      handle-arg-error
+     handle-event-detour
      foreign-entry
      install-library-entry
      get-more-room
diff --git a/s/cpnanopass.ss b/s/cpnanopass.ss
index 386ab39fb9..6b45a16c05 100644
--- a/s/cpnanopass.ss
+++ b/s/cpnanopass.ss
@@ -620,6 +620,10 @@
       (lambda ()
         (make-libspec-label 'call-error (lookup-libspec call-error)
           (reg-list %ret %cp))))
+    (define make-Levent-detour
+      (lambda ()
+        (make-libspec-label 'event-detour (lookup-libspec event-detour)
+          (reg-cons* %ret %cp %ac0 arg-registers))))
 
     (module (frame-vars get-fv)
       (define-threaded frame-vars)
@@ -10766,29 +10770,22 @@
                   (tail ,tl)
                   ,(f `(seq (label ,(car l*)) ,(car tl*)) (cdr l*) (cdr tl*)))))]))
 
-    (define-pass np-insert-trap-check : L11 (ir) -> L11.5 ()
-      (Effect : Effect (ir) -> Effect ()
-        [(trap-check ,ioc)
-         `(seq
-            (set! ,(ref-reg %trap) ,(%inline -/eq ,(ref-reg %trap) (immediate 1)))
-            (if (inline ,(make-info-condition-code 'eq? #f #t) ,%condition-code)
-                ,(%seq
-                   (pariah)
-                   (mvcall ,(make-info-call #f #f #f #t #f) #f
-                     (literal ,(make-info-literal #f 'library
-                                 (if ioc
-                                     (lookup-does-not-expect-headroom-libspec event)
-                                     (lookup-libspec event))
-                                 0))
-                     ()))
-                (nop)))]))
-
-    (define-pass np-flatten-case-lambda : L11.5 (ir) -> L12 ()
+    (define-pass np-flatten-case-lambda : L11 (ir) -> L12 ()
       (definitions
         (define Ldoargerr (make-Ldoargerr))
         (define Ldomvleterr (make-Ldomvleterr))
+        (define Levent-detour (make-Levent-detour))
         (define flatten-clauses
-          (lambda (info cl* dcl*)
+          (lambda (info cl* dcl* detour-trap-check?)
+            (define (maybe-drop-trap-check tl)
+              (if detour-trap-check?
+                  (nanopass-case (L11 Tail) tl
+                    [(seq (trap-check ,ioc) ,tl) tl]
+                    [(seq (overflow-check) ,tl)
+                     (with-output-language (L11 Tail)
+                       `(seq (overflow-check) ,(maybe-drop-trap-check tl)))]
+                    [else ($oops who "expected trap check at ~s" tl)])
+                  tl))
             (let ([libspec (info-lambda-libspec info)])
               (with-output-language (L12 Tail)
                 (when libspec
@@ -10803,10 +10800,10 @@
                       (if (null? cl*)
                           (values local* (or tlbody (%constant svoid)))
                           (if (or libspec (direct-call-label-referenced (car dcl*)))
-                              (nanopass-case (L11.5 CaseLambdaClause) (car cl*)
+                              (nanopass-case (L11 CaseLambdaClause) (car cl*)
                                 [(clause (,x* ...) (,local1* ...) ,mcp ,interface ,tlbody1)
                                  (loop (cdr cl*) (cdr dcl*) (maybe-cons mcp (append x* local1* local*))
-                                   (let ([tlbody1 `(entry-point (,x* ...) ,(car dcl*) ,mcp ,(Tail tlbody1))])
+                                   (let ([tlbody1 `(entry-point (,x* ...) ,(car dcl*) ,mcp ,(Tail (maybe-drop-trap-check tlbody1)))])
                                      (if tlbody
                                          `(seq (tail ,tlbody) ,tlbody1)
                                          tlbody1)))])
@@ -10814,9 +10811,9 @@
                     (let f ([cl* cl*] [dcl* dcl*])
                       (if (null? cl*)
                           (values '() `(seq (pariah) (goto ,Ldoargerr)))
-                          (nanopass-case (L11.5 CaseLambdaClause) (car cl*)
+                          (nanopass-case (L11 CaseLambdaClause) (car cl*)
                             [(clause (,x* ...) (,local* ...) ,mcp ,interface ,tlbody)
-                             (let ([tlbody `(entry-point (,x* ...) ,(car dcl*) ,mcp ,(Tail tlbody))])
+                             (let ([tlbody `(entry-point (,x* ...) ,(car dcl*) ,mcp ,(Tail (maybe-drop-trap-check tlbody)))])
                                (if (fx< interface 0)
                                    (let ([fixed-args (lognot interface)])
                                      (let ([tlbody (if (uvar-referenced? (list-ref x* fixed-args))
@@ -10865,20 +10862,61 @@
                             `(if ,(%inline eq? ,%ac0
                                       (immediate ,interface))
                                  ,ebody
-                                 ,next-ebody))))))))))
+                                 ,next-ebody)))))))))
+        (define (maybe-add-detour-trap-check tl detour-trap-check?)
+          (if detour-trap-check?
+              (with-output-language (L12 Tail)
+                (%seq
+                 (set! ,(ref-reg %trap) ,(%inline -/eq ,(ref-reg %trap) (immediate 1)))
+                 (if (inline ,(make-info-condition-code 'eq? #f #t) ,%condition-code)
+                     (seq (pariah) (goto ,Levent-detour))
+                     (nop))
+                 ,tl))
+              tl)))
       (CaseLambdaExpr : CaseLambdaExpr (ir) -> CaseLambdaExpr ()
         [(case-lambda ,info ,cl* ...)
-         (let-values ([(local* tlbody) (flatten-clauses info cl* (info-lambda-dcl* info))])
-           (safe-assert (nodups local*))
-           (info-lambda-dcl*-set! info (filter direct-call-label-referenced (info-lambda-dcl* info)))
-           `(lambda ,info (,local* ...) ,tlbody))])
+         (let* ([detour-trap-check? (and (not (info-lambda-libspec info))
+                                         (andmap
+                                          (lambda (cl dcl)
+                                            (and
+                                             (not (direct-call-label-referenced dcl))
+                                             (nanopass-case (L11 CaseLambdaClause) cl
+                                               [(clause (,x* ...) (,local1* ...) ,mcp ,interface ,tlbody)
+                                                (let loop ([tlbody tlbody])
+                                                  (nanopass-case (L11 Tail) tlbody
+                                                    [(seq (trap-check ,ioc) ,tlbody) #t]
+                                                    [(seq (overflow-check) ,tlbody) (loop tlbody)]
+                                                    [else #f]))])))
+                                          cl* (info-lambda-dcl* info)))])
+           (let-values ([(local* tlbody) (flatten-clauses info cl* (info-lambda-dcl* info) detour-trap-check?)])
+             (safe-assert (nodups local*))
+             (info-lambda-dcl*-set! info (filter direct-call-label-referenced (info-lambda-dcl* info)))
+             `(lambda ,info (,local* ...) ,(maybe-add-detour-trap-check tlbody detour-trap-check?))))])
       (Tail : Tail (ir) -> Tail ())
       (Effect : Effect (ir) -> Effect ()
         [(mvset ,info (,mdcl ,[t0?] ,[t1] ...) (,[t*] ...) ((,x** ...) ,interface* ,l*) ...)
          `(mvset ,info (,mdcl ,t0? ,t1 ...) (,t* ...) ((,x** ...) ...)
                  ,(flatten-mvclauses x** interface* l*))]))
 
-    (define-pass np-impose-calling-conventions : L12 (ir) -> L13 ()
+    ;; converts any `trap-check` effects not lifted out by `np-flatten-case-lambda`
+    (define-pass np-insert-trap-check : L12 (ir) -> L12.5 ()
+      (Effect : Effect (ir) -> Effect ()
+        [(trap-check ,ioc)
+         `(seq
+            (set! ,(ref-reg %trap) ,(%inline -/eq ,(ref-reg %trap) (immediate 1)))
+            (if (inline ,(make-info-condition-code 'eq? #f #t) ,%condition-code)
+                ,(%seq
+                   (pariah)
+                   (mvcall ,(make-info-call #f #f #f #t #f) #f
+                     (literal ,(make-info-literal #f 'library
+                                 (if ioc
+                                     (lookup-does-not-expect-headroom-libspec event)
+                                     (lookup-libspec event))
+                                 0))
+                     ()))
+                (nop)))]))
+
+    (define-pass np-impose-calling-conventions : L12.5 (ir) -> L13 ()
       (definitions
         (import (only asm-module asm-foreign-call asm-foreign-callable asm-enter))
         (define newframe-info-for-mventry-point)
@@ -11061,7 +11099,7 @@
                                  (not shift-attachment?))
                              (direct-call)
                              (finish-call #f #f (in-context Triv `(label-ref ,mdcl 0)))))
-                       (nanopass-case (L12 Triv) t
+                       (nanopass-case (L12.5 Triv) t
                          ; if the expression in the cp position #f, and we have an mdcl, this is
                          ; a hackish workaround for not having a good way to express maybe-Expr
                          [(literal ,info)
@@ -11112,7 +11150,7 @@
                     (label ,mrvl))))))
           (define store-cp?
             (lambda (t)
-              (nanopass-case (L12 Triv) t
+              (nanopass-case (L12.5 Triv) t
                 [(literal ,info) #f]
                 [else #t])))
           (define build-nontail-call
@@ -13193,6 +13231,12 @@
            [(dooverflood) ((make-do/ret (intrinsic-entry-live* dooverflood) (intrinsic-return-live* dooverflood)) #f "dooverflood" (lookup-c-entry handle-overflood))]
            [(scan-remembered-set) ((make-do/ret (intrinsic-entry-live* scan-remembered-set) (intrinsic-return-live* scan-remembered-set)) (in-context Lvalue (%tc-ref ret)) "scan-remembered-set" (lookup-c-entry scan-remembered-set))]
            [(get-room) ((make-do/ret (intrinsic-entry-live* get-room) (intrinsic-return-live* get-room)) (in-context Lvalue (%tc-ref ret)) "get-room" (lookup-c-entry get-more-room))]
+           [(event-detour)
+            ;; Jumping to `event-detour` while arguments are still in place is an alternative
+            ;; to making a normal function call to `$event` (which requires more instructions).
+            ;; Leads to `$event-and-resume`, which calls `$event` and then retries the call
+            ;; that had just started.
+            (make-do/call (in-context Lvalue (%tc-ref ret)) "event-detour" (lookup-c-entry handle-event-detour))]
            [(nonprocedure-code)
             `(lambda ,(make-info "nonprocedure-code" '()) 0 ()
                ,(%seq
@@ -17159,8 +17203,8 @@
               (pass np-remove-complex-opera* unparse-L10)
               (pass np-push-mrvs unparse-L10.5)
               (pass np-normalize-context unparse-L11)
-              (pass np-insert-trap-check unparse-L11.5)
               (pass np-flatten-case-lambda unparse-L12)
+              (pass np-insert-trap-check unparse-L12.5)
               (pass np-impose-calling-conventions unparse-L13)
               np-after-calling-conventions)))))
 
diff --git a/s/library.ss b/s/library.ss
index fea032614b..28d5de6b77 100644
--- a/s/library.ss
+++ b/s/library.ss
@@ -133,6 +133,7 @@
 (define-hand-coded-library-entry $wrapper-apply)
 (define-hand-coded-library-entry wrapper-apply)
 (define-hand-coded-library-entry arity-wrapper-apply)
+(define-hand-coded-library-entry event-detour)
 (define-hand-coded-library-entry popcount-slow) ; before fxpopcount use
 (define-hand-coded-library-entry cpu-features)  ; before fxpopcount use
 
diff --git a/s/np-languages.ss b/s/np-languages.ss
index db94035509..917449d8b0 100644
--- a/s/np-languages.ss
+++ b/s/np-languages.ss
@@ -49,7 +49,7 @@
     L5 unparse-L5 L6 unparse-L6 L7 unparse-L7
     L9 unparse-L9 L9.5 unparse-L9.5 L9.75 unparse-L9.75
     L10 unparse-L10 L10.5 unparse-L10.5 L11 unparse-L11
-    L11.5 unparse-L11.5 L12 unparse-L12 L13 unparse-L13 L13.5 unparse-L13.5 L14 unparse-L14
+    L12 unparse-L12 L12.5 unparse-L12.5 L13 unparse-L13 L13.5 unparse-L13.5 L14 unparse-L14
     L15a unparse-L15a L15b unparse-L15b L15c unparse-L15c L15d unparse-L15d
     L15e unparse-L15e
     L16 unparse-L16
@@ -791,14 +791,7 @@
          (attachment-set aop t* ...)
          (tail tl))))
 
-  (define-language L11.5 (extends L11)
-    (entry Program)
-    (terminals
-      (- (boolean (ioc))))
-    (Effect (e body)
-      (- (trap-check ioc))))
-
-  (define-language L12 (extends L11.5)
+  (define-language L12 (extends L11)
     (terminals
       (- (fixnum (interface offset))
          (label (l)))
@@ -820,6 +813,13 @@
          ; ideally, grammar would reflect this
          (mventry-point (x* ...) l))))
 
+  (define-language L12.5 (extends L12)
+    (entry Program)
+    (terminals
+      (- (boolean (ioc))))
+    (Effect (e ebody)
+      (- (trap-check ioc))))
+
   (define exact-integer?
     (lambda (x)
       (and (integer? x) (exact? x))))
diff --git a/s/primdata.ss b/s/primdata.ss
index 0fda26e60b..c0f256c220 100644
--- a/s/primdata.ss
+++ b/s/primdata.ss
@@ -1874,6 +1874,7 @@
   ($errno->string [flags single-valued])
   ($error-handling-mode? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable])
   ($event [flags single-valued])
+  ($event-and-resume [flags])
   ($exactnum? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable])
   ($exactnum-imag-part [flags single-valued])
   ($exactnum-real-part [flags single-valued])
diff --git a/s/prims.ss b/s/prims.ss
index 8e528c88f0..6529c1ef74 100644
--- a/s/prims.ss
+++ b/s/prims.ss
@@ -1558,6 +1558,10 @@
 
 (define $event (lambda () ($event)))
 
+(define $event-and-resume (lambda (proc args)
+                            ($event)
+                            (apply proc args)))
+
 (define $tc (lambda () ($tc)))
 (define $thread-list (lambda () ($thread-list)))