diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index 17ec079219..4c25b0acf9 100644 --- a/racket/src/racket/src/fun.c +++ b/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) diff --git a/racket/src/racket/src/jitcall.c b/racket/src/racket/src/jitcall.c index 11eda68411..9ad1b402dd 100644 --- a/racket/src/racket/src/jitcall.c +++ b/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); diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 1e4f819b2c..e66f51aaa7 100644 --- a/racket/src/racket/src/schpriv.h +++ b/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;