improve procedure-{reduce-arity,rename} performance

The main performance improvement is in calling a function returned by
`procedure-{reduce-arity,rename}` when the arity is not a single
integer. Calls to functions with > 29 arguments can be worse, but
that seems like a much rarer case.

racket/src/racket/src/fun.c

@@ -2803,7 +2803,7 @@ void scheme_init_reduced_proc_struct(Scheme_Startup_Env *env)
     scheme_reduced_procedure_struct = scheme_make_struct_type2(NULL,
                                                                NULL,
                                                                (Scheme_Object *)insp,
-                                                               4, 0,
+                                                               5, 0,
                                                                scheme_false,
                                                                scheme_null,
                                                                scheme_make_integer(0),
@@ -2811,9 +2811,50 @@ void scheme_init_reduced_proc_struct(Scheme_Startup_Env *env)
   }
 }
 
+static Scheme_Object *arity_to_fast_check_mask(Scheme_Object *aty)
+{
+  if (SCHEME_INTP(aty)) {
+    intptr_t n = SCHEME_INT_VAL(aty);
+    if (n <= SCHEME_MAX_FAST_ARITY_CHECK)
+      return scheme_make_integer(1 << n);
+    else
+      return scheme_make_integer(0);
+  } else if (SCHEME_STRUCTP(aty)) {
+    Scheme_Object *mask;
+    intptr_t n;
+
+    mask = arity_to_fast_check_mask(scheme_struct_ref(aty, 0));
+    n = SCHEME_INTP(mask);
+    if (!n)
+      return mask;
+    else {
+      /* Set all bits above highest-set bit */
+      int i;
+      for (i = SCHEME_MAX_FAST_ARITY_CHECK; ; i--) {
+        if (n & (1 << i))
+          break;
+        n |= (1 << i);
+      }
+      return scheme_make_integer(n);
+    }
+  } else if (SCHEME_PAIRP(aty)) {
+    Scheme_Object *mask;
+    intptr_t n = 0;
+    while (SCHEME_PAIRP(aty)) {
+      mask = arity_to_fast_check_mask(SCHEME_CAR(aty));
+      n |= SCHEME_INT_VAL(mask);
+      aty = SCHEME_CDR(aty);
+    }
+    return scheme_make_integer(n);
+  } else
+    return scheme_make_integer(0);
+}
+
+
 static Scheme_Object *make_reduced_proc(Scheme_Object *proc, Scheme_Object *aty, Scheme_Object *name, Scheme_Object *is_meth)
 {
-  Scheme_Object *a[4];
+  Scheme_Object *mask;
+  Scheme_Structure *inst;
   
   if (SCHEME_STRUCTP(proc)
       && scheme_is_struct_instance(scheme_reduced_procedure_struct, proc)) {
@@ -2825,12 +2866,22 @@ static Scheme_Object *make_reduced_proc(Scheme_Object *proc, Scheme_Object *aty,
     proc = ((Scheme_Structure *)proc)->slots[0];
   }
 
-  a[0] = proc;
-  a[1] = aty;
-  a[2] = (name ? name : scheme_false);
-  a[3] = (is_meth ? is_meth : scheme_false);
+  /* A fast-check bitmap, where a bitmap is set in a fixnum if that
+     many arguments are allowed: */
+  mask = arity_to_fast_check_mask(aty);
 
-  return scheme_make_struct_instance(scheme_reduced_procedure_struct, 4, a);
+  inst = (Scheme_Structure *)scheme_malloc_tagged(sizeof(Scheme_Structure)
+                                                  + ((5 - mzFLEX_DELTA) * sizeof(Scheme_Object *)));
+  inst->so.type = scheme_proc_struct_type;
+  inst->stype = (Scheme_Struct_Type *)scheme_reduced_procedure_struct;
+
+  inst->slots[0] = proc;
+  inst->slots[1] = aty;
+  inst->slots[2] = (name ? name : scheme_false);
+  inst->slots[3] = (is_meth ? is_meth : scheme_false);
+  inst->slots[4] = mask;
+
+  return (Scheme_Object *)inst;
 }
 
 static int is_subarity(Scheme_Object *req, Scheme_Object *orig, int req_delta)

racket/src/racket/src/jitcall.c

@@ -79,13 +79,20 @@ static jit_insn *generate_proc_struct_retry(mz_jit_state *jitter, int num_rands,
      then we can't just apply the struct's procedure. */
   jit_ldxi_p(JIT_R1, JIT_V1, &((Scheme_Structure *)0x0)->stype);
   jit_ldi_p(JIT_R2, &scheme_reduced_procedure_struct);
-  ref3 = jit_bner_p(jit_forward(), JIT_R1, JIT_R2);
+  if (num_rands <= SCHEME_MAX_FAST_ARITY_CHECK) {
+    ref3 = jit_bner_p(jit_forward(), JIT_R1, JIT_R2);
 
-  /* Matches reduced arity in a simple way? */
-  jit_ldxi_p(JIT_R2, JIT_V1, &((Scheme_Structure *)0x0)->slots[1]);
-  refz3 = jit_bnei_p(jit_forward(), JIT_R2, scheme_make_integer(num_rands));
+    /* Matches reduced arity in a simple way? */
+    jit_ldxi_p(JIT_R2, JIT_V1, &((Scheme_Structure *)0x0)->slots[4]);
+    refz3 = jit_bmci_l(jit_forward(), JIT_R2, (1 << (num_rands + 1)));
+
+    /* Yes, matches */
+    mz_patch_branch(ref3);
+  } else {
+    /* Too many arguments for fast check, so assume it desn't match */
+    refz3 = jit_beqr_p(jit_forward(), JIT_R1, JIT_R2);
+  }
 
-  mz_patch_branch(ref3);
   /* It's an applicable struct that is not an arity reduce or the
      arity matches. We can extract the procedure if it's in a field: */
   jit_ldxi_p(JIT_R1, JIT_R1, &((Scheme_Struct_Type *)0x0)->proc_attr);

racket/src/racket/src/schpriv.h

@@ -3434,6 +3434,8 @@ Scheme_Object *scheme_get_or_check_arity(Scheme_Object *p, intptr_t a);
 int scheme_native_arity_check(Scheme_Object *closure, int argc);
 Scheme_Object *scheme_get_native_arity(Scheme_Object *closure, int mode);
 
+#define SCHEME_MAX_FAST_ARITY_CHECK 29
+
 struct Scheme_Logger {
   Scheme_Object so;
   Scheme_Object *name;