adjust event-detour path again to apply more often

Instead of constaining the use of event-detour so much, make it merely
unlikely that the detour will have to allocate when used in a loop
that otherwise doesn't allocate. We'll only have to allocate if the
available stack space turns out to be too small --- and if we do
allocate, it's not the end of the world.

original commit: f1dbed82df415c18c8304bedcee2ecf4912badc7

c/schsig.c

@@ -463,30 +463,31 @@ void S_handle_event_detour() {
     ptr tc = get_thread_context();
     ptr resume_proc = CP(tc);
     ptr resume_args = Snil;
-    iptr argcnt, i;
+    iptr argcnt, stack_avail, i;
 
     argcnt = (iptr)AC0(tc);
+    stack_avail = (((uptr)ESP(tc) - (uptr)SFP(tc)) >> log2_ptr_bytes) - 1;
 
-    if (argcnt < asm_arg_reg_cnt) {
+    if (argcnt < (stack_avail + asm_arg_reg_cnt)) {
-      /* Avoid allocation by passing arguments directly; this case
+      /* Avoid allocation by passing arguments directly. The compiler
-         should always happen if the right number of arguments are
+         will only use `detour-event` when the expected number is
-         passed to a function, because the compiler will only use
+         small enough to avoid allocation (unless the function expected
-         `detour-event` when the expected number is small enough. */
+         to allocate a list of arguments, anyway). */
       for (i = argcnt; i > 0; i--)
         S_put_scheme_arg(tc, i+1, S_get_scheme_arg(tc, i));
       S_put_scheme_arg(tc, 1, resume_proc);
       CP(tc) = S_symbol_value(S_G.event_and_resume_id);
       AC0(tc) = (ptr)(argcnt+1);
     } else {
-      /* At least one argument can go in a register, otherwise the
+      /* We're assuming that either at least one argument can go in a
-         compiler would not use `detour-event` for any functions. */
+         register or stack slop will save us. */
       for (i = argcnt; i > 0; i--)
         resume_args = Scons(S_get_scheme_arg(tc, i), resume_args);
       resume_args = Scons(resume_proc, resume_args);
  
       CP(tc) = S_symbol_value(S_G.event_and_resume_star_id);
       S_put_scheme_arg(tc, 1, resume_args);
-      AC0(tc) = (ptr)2;
+      AC0(tc) = (ptr)1;
     }
 }
 

s/cmacros.ss

@@ -1988,6 +1988,10 @@
 ;;; stack underflow/continuation invocation
 (define-constant underflow-limit (* (constant ptr-bytes) 16))
 
+;; Number of arguments (including procedure) that can be handled
+;; by `$event-and-resume` without allocating:
+(define-constant event-resume-max-preferred-arg-cnt 5)
+
 ;;; check assumptions
 (let ([x (fxsrl (constant type-char)
            (fx- (constant char-data-offset)

s/cpnanopass.ss

@@ -10884,7 +10884,7 @@
                                              (not (direct-call-label-referenced dcl))
                                              (nanopass-case (L11 CaseLambdaClause) cl
                                                [(clause (,x* ...) (,local1* ...) ,mcp ,interface ,tlbody)
-                                                (and (fx< -1 interface (constant asm-arg-reg-cnt))
+                                                (and (fx< interface (constant event-resume-max-preferred-arg-cnt))
                                                      (let loop ([tlbody tlbody])
                                                        (nanopass-case (L11 Tail) tlbody
                                                          [(seq (trap-check ,ioc) ,tlbody) #t]

s/prims.ss

@@ -1583,6 +1583,16 @@
           ($event)
           (inc)
           (proc arg1 arg2)]
+         [(proc arg1 arg2 arg3)
+          ($event)
+          (inc)
+          (proc arg1 arg2 arg3)]
+         [(proc arg1 arg2 arg3 arg4)
+          ($event)
+          (inc)
+          (proc arg1 arg2 arg3 arg4)]
+         ;; Cases above should cover `event-resume-max-preferred-arg-cnt`,
+         ;; including `proc` in th count
          [(proc . args)
           ($event)
           (inc)