eliminate a little more 3m overhead

svn: r5457

src/mzscheme/src/eval.c

@@ -5528,34 +5528,27 @@ Scheme_Object *_scheme_apply_prim_closure(Scheme_Object *rator,
 
 
 #ifdef MZ_USE_JIT
-Scheme_Object *_scheme_apply_from_native(Scheme_Object *rator,
-					 int argc,
-					 Scheme_Object **argv)
-{
-#define PRIM_CHECK_VALUE 1
-#define PRIM_CHECK_MULTI 1
-#include "schnapp.inc"
-}
 
-Scheme_Object *_scheme_apply_multi_from_native(Scheme_Object *rator,
+# define PRIM_APPLY_NAME _scheme_apply_from_native
-					       int argc,
+# define PRIM_APPLY_NAME_FAST _scheme_apply_from_native_fast
-					       Scheme_Object **argv)
+# define PRIM_CHECK_VALUE 1
-{
+# define PRIM_CHECK_MULTI 1
-#define PRIM_CHECK_VALUE 1
+# include "schnapp.inc"
-#define PRIM_CHECK_MULTI 0
+
-#include "schnapp.inc"
+# define PRIM_APPLY_NAME _scheme_apply_multi_from_native
-}
+# define PRIM_APPLY_NAME_FAST _scheme_apply_multi_from_native_fast
+# define PRIM_CHECK_VALUE 1
+# define PRIM_CHECK_MULTI 0
+# include "schnapp.inc"
+
+# define PRIM_APPLY_NAME _scheme_tail_apply_from_native
+# define PRIM_APPLY_NAME_FAST _scheme_tail_apply_from_native_fast
+/* It's ok to call primitive and closed primitives directly,
+   since they implement further tail by trampolining. */
+# define PRIM_CHECK_VALUE 0
+# define PRIM_CHECK_MULTI 0
+# include "schnapp.inc"
 
-Scheme_Object *_scheme_tail_apply_from_native(Scheme_Object *rator,
-					      int argc,
-					      Scheme_Object **argv)
-{
-  /* It's ok to call primitive and closed primitives directly,
-     since they implement further tail by trampolining. */
-#define PRIM_CHECK_VALUE 0
-#define PRIM_CHECK_MULTI 0
-#include "schnapp.inc"
-}
 #endif
 
 Scheme_Object *scheme_check_one_value(Scheme_Object *v)

src/mzscheme/src/numarith.c

@@ -175,6 +175,13 @@ scheme_sub1 (int argc, Scheme_Object *argv[])
 #define FS_MULTIPLY(x,y) scheme_make_float(x * y)
 #define FS_DIVIDE(x,y) scheme_make_float((float)x / (float)y)
 
+static Scheme_Object *ADD_slow(long a, long b)
+{
+  Small_Bignum sa, sb;
+  return scheme_bignum_add(scheme_make_small_bignum(a, &sa),
+                           scheme_make_small_bignum(b, &sb));
+}
+
 static Scheme_Object *ADD(long a, long b)
 {
   long r;
@@ -187,11 +194,15 @@ static Scheme_Object *ADD(long a, long b)
 
   if (b == r - a)
     return o;
-  else {
+  else
-    Small_Bignum sa, sb;
+    return ADD_slow(a, b);
-    return scheme_bignum_add(scheme_make_small_bignum(a, &sa),
+}
-			     scheme_make_small_bignum(b, &sb));
+
-  }
+static Scheme_Object *SUBTRACT_slow(long a, long b)
+{
+  Small_Bignum sa, sb;
+  return scheme_bignum_subtract(scheme_make_small_bignum(a, &sa),
+                                scheme_make_small_bignum(b, &sb));  
 }
 
 static Scheme_Object *SUBTRACT(long a, long b)
@@ -206,11 +217,8 @@ static Scheme_Object *SUBTRACT(long a, long b)
 
   if (a == r + b)
     return o;
-  else {
+  else
-    Small_Bignum sa, sb;
+    return SUBTRACT_slow(a, b);
-    return scheme_bignum_subtract(scheme_make_small_bignum(a, &sa),
-				  scheme_make_small_bignum(b, &sb));
-  }
 }
 
 static Scheme_Object *MULTIPLY(long a, long b)
@@ -235,6 +243,13 @@ static Scheme_Object *MULTIPLY(long a, long b)
   }
 }
 
+static Scheme_Object *unary_minus(const Scheme_Object *n)
+{
+  Scheme_Object *a[1];
+  a[0] = (Scheme_Object *)n;
+  return minus(1, a);
+}
+
 GEN_BIN_OP(scheme_bin_plus, "+", ADD, F_ADD, FS_ADD, scheme_bignum_add, scheme_rational_add, scheme_complex_add, GEN_RETURN_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK)
 GEN_BIN_OP(scheme_bin_minus, "-", SUBTRACT, F_SUBTRACT, FS_SUBTRACT, scheme_bignum_subtract, scheme_rational_subtract, scheme_complex_subtract, GEN_SINGLE_SUBTRACT_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK)
 GEN_BIN_OP(scheme_bin_mult, "*", MULTIPLY, F_MULTIPLY, FS_MULTIPLY, scheme_bignum_multiply, scheme_rational_multiply, scheme_complex_multiply, GEN_RETURN_0, GEN_RETURN_0, NO_NAN_CHECK, NO_NAN_CHECK)
@@ -243,11 +258,25 @@ GEN_BIN_DIV_OP(scheme_bin_div, "/", DIVIDE, F_DIVIDE, FS_DIVIDE, scheme_make_rat
 GEN_NARY_OP(static, plus, "+", scheme_bin_plus, 0, SCHEME_NUMBERP, "number")
 GEN_NARY_OP(static, mult, "*", scheme_bin_mult, 1, SCHEME_NUMBERP, "number")
 
+static MZ_INLINE Scheme_Object *
+minus_slow (Scheme_Object *ret, int argc, Scheme_Object *argv[])
+{
+  int i;
+  for (i = 1; i < argc; i++) {
+    Scheme_Object *o = argv[i];
+    if (!SCHEME_NUMBERP(o)) {
+      scheme_wrong_type("-", "number", i, argc, argv);
+      ESCAPED_BEFORE_HERE;
+    }
+    ret = scheme_bin_minus(ret, o);
+  }
+  return ret;
+}
+
 static Scheme_Object *
 minus (int argc, Scheme_Object *argv[])
 {
-  Scheme_Object *ret;
+  Scheme_Object *ret, *v;
-  int i;
 
   ret = argv[0];
   if (!SCHEME_NUMBERP(ret)) {
@@ -264,15 +293,15 @@ minus (int argc, Scheme_Object *argv[])
     }
     return scheme_bin_minus(zeroi, ret);
   }
-  for (i = 1; i < argc; i++) {
+  if (argc == 2) {
-    Scheme_Object *o = argv[i];
+    v = argv[1];
-    if (!SCHEME_NUMBERP(o)) {
+    if (!SCHEME_NUMBERP(v)) {
-      scheme_wrong_type("-", "number", i, argc, argv);
+      scheme_wrong_type("-", "number", 1, argc, argv);
       ESCAPED_BEFORE_HERE;
     } 
-    ret = scheme_bin_minus(ret, o);
+    return scheme_bin_minus(ret, v);
   }
-  return ret;
+  return minus_slow(ret, argc, argv);
 }
 
 static Scheme_Object *

src/mzscheme/src/nummacs.h

@@ -51,16 +51,14 @@
 static int name (Scheme_Object *n1, Scheme_Object *n2)
 
 #define GEN_NARY_COMP(name, scheme_name, bin_name, TYPEP, type) \
-static Scheme_Object * \
+static Scheme_Object *name (int argc, Scheme_Object *argv[]); \
-name (int argc, Scheme_Object *argv[]) \
+static MZ_INLINE Scheme_Object * \
+name ## __slow (Scheme_Object *p, int argc, Scheme_Object *argv[]) \
 { \
+  Scheme_Object *o; \
   int i; \
-  Scheme_Object *p; \
-  p = argv[0]; \
-  if (argc == 1) if (!TYPEP(p)) \
-   scheme_wrong_type(scheme_name, type, 0, argc, argv); \
   for (i = 1; i < argc; i++) {\
-    Scheme_Object *o = argv[i]; \
+    o = argv[i]; \
     if (!TYPEP(o)) { \
       scheme_wrong_type(scheme_name, type, i, argc, argv); \
       return NULL; \
@@ -75,6 +73,24 @@ name (int argc, Scheme_Object *argv[]) \
     p = o; \
   } \
   return scheme_true; \
+} \
+static MZ_INLINE Scheme_Object *name ## __bin(Scheme_Object *a, Scheme_Object *b) { \
+  return (bin_name(a, b) ? scheme_true : scheme_false); \
+} \
+Scheme_Object * \
+name (int argc, Scheme_Object *argv[]) \
+{ \
+  Scheme_Object *p, *p2; \
+  p = argv[0]; \
+  if (!TYPEP(p)) \
+   scheme_wrong_type(scheme_name, type, 0, argc, argv); \
+  if (argc == 2) { \
+    p2 = argv[1]; \
+    if (!TYPEP(p2)) \
+      scheme_wrong_type(scheme_name, type, 1, argc, argv); \
+    return name ## __bin(p, p2); \
+  } else \
+    return name ## __slow(p, argc, argv); \
 }
 
 #define GEN_BIN_PROT(name) \
@@ -166,6 +182,10 @@ static MZ_INLINE rettype name ## __dbl_comp(double d1, const Scheme_Object *n1,
   return cxop((scheme_make_small_complex(n1, &sc)), \
 	      (n2)); \
 }) \
+static MZ_INLINE rettype name ## __big_int(const Scheme_Object *n1, const Scheme_Object *n2) { \
+  Small_Bignum sb; \
+  return bn_op((n1), (scheme_make_small_bignum(SCHEME_INT_VAL(n2), &sb))); \
+} \
 FLOATWRAP( \
 static MZ_INLINE rettype name ## __big_flt(double d1, const Scheme_Object *n1, const Scheme_Object *n2) { \
   Small_Rational sr6; \
@@ -369,9 +389,7 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \
   else if (t1 == scheme_bignum_type) \
     { \
       if (SCHEME_INTP(n2)) { \
-         Small_Bignum sb; \
+        return name ## __big_int(n1, n2); \
-	 return bn_op((n1), \
-		      (scheme_make_small_bignum(SCHEME_INT_VAL(n2), &sb))); \
       } \
       t2 = _SCHEME_TYPE(n2); \
       FLOATWRAP( \
@@ -466,7 +484,7 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \
 #define GEN_RETURN_1(x) x return scheme_make_integer(1);
 #define GEN_RETURN_N1(x) x return (Scheme_Object *)n1;
 #define GEN_RETURN_N2(x) x return (Scheme_Object *)n2;
-#define GEN_SINGLE_SUBTRACT_N2(x) x if SCHEME_FLOATP(n2) return minus(1, (Scheme_Object **)&n2);
+#define GEN_SINGLE_SUBTRACT_N2(x) x if SCHEME_FLOATP(n2) return unary_minus(n2);
 
 #define GEN_SAME_INF(x) (scheme_is_positive(x) ? scheme_inf_object : scheme_minus_inf_object)
 #define GEN_OPP_INF(x) (!scheme_is_positive(x) ? scheme_inf_object : scheme_minus_inf_object)
@@ -563,11 +581,23 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \
 }
 
 #define GEN_NARY_OP(stat, name, scheme_name, bin_name, ident, TYPEP, type) \
-stat Scheme_Object * \
+stat Scheme_Object *name (int argc, Scheme_Object *argv[]); \
+static MZ_INLINE Scheme_Object * \
+name ## __slow (Scheme_Object *ret, int argc, Scheme_Object *argv[])  \
+{ \
+  int i; \
+  for (i = 1 ; i<argc ; ++i ) { \
+    Scheme_Object *o; \
+    o = argv[i]; \
+    if (!TYPEP(o)) { scheme_wrong_type(scheme_name, type, i, argc, argv); return NULL; } \
+    ret = bin_name (ret, o); \
+  } \
+  return (ret); \
+}\
+Scheme_Object * \
 name (int argc, Scheme_Object *argv[]) \
 { \
-  Scheme_Object *ret; \
+  Scheme_Object *ret;                          \
-  int i; \
   if (!argc) return scheme_make_integer(ident); \
   ret = argv[0]; \
   if (!TYPEP(ret)) { scheme_wrong_type(scheme_name, type, 0, argc, argv); return NULL; } \
@@ -577,36 +607,35 @@ name (int argc, Scheme_Object *argv[]) \
     if (!TYPEP(b)) { scheme_wrong_type(scheme_name, type, 1, argc, argv); return NULL; } \
     return bin_name(ret, b); \
   } \
-  for (i = 1 ; i<argc ; ++i ) { \
+  return name ## __slow(ret, argc, argv); \
-    Scheme_Object *o; \
-    o = argv[i]; \
-    if (!TYPEP(o)) { scheme_wrong_type(scheme_name, type, i, argc, argv); return NULL; } \
-    ret = bin_name (ret, o); \
-  } \
-  return (ret); \
 }
 
 #define GEN_TWOARY_OP(stat, name, scheme_name, bin_name, TYPEP, type) \
-stat Scheme_Object * \
+stat Scheme_Object * name (int argc, Scheme_Object *argv[]); \
-name (int argc, Scheme_Object *argv[]) \
+static MZ_INLINE Scheme_Object * \
-{ \
+name ## __slow (Scheme_Object *ret, int argc, Scheme_Object *argv[]) \
-  Scheme_Object *ret; \
+{\
   int i; \
-  if (!TYPEP(argv[0])) \
-    scheme_wrong_type(scheme_name, type, 0, argc, argv); \
-  if (argc == 1) return argv[0]; \
-  if (argc == 2) { \
-    if (!TYPEP(argv[1])) \
-      scheme_wrong_type(scheme_name, type, 1, argc, argv); \
-    return bin_name(argv[0], argv[1]); \
-  } \
-  ret = argv[0]; \
   for ( i=1 ; i<argc ; ++i ) { \
     if (!TYPEP(argv[i])) \
       scheme_wrong_type(scheme_name, type, i, argc, argv); \
     ret = bin_name (ret, argv[i]); \
   } \
   return ret; \
+}\
+Scheme_Object * \
+name (int argc, Scheme_Object *argv[]) \
+{ \
+  Scheme_Object *ret = argv[0]; \
+  if (!TYPEP(ret)) \
+    scheme_wrong_type(scheme_name, type, 0, argc, argv); \
+  if (argc == 1) return ret; \
+  if (argc == 2) { \
+    if (!TYPEP(argv[1])) \
+      scheme_wrong_type(scheme_name, type, 1, argc, argv); \
+    return bin_name(ret, argv[1]); \
+  } \
+  return name ## __slow(ret, argc, argv); \
 }
 
 #define BIGNUMS_AS_DOUBLES(o) d = scheme_bignum_to_double(o);

src/mzscheme/src/schnapp.inc

@@ -3,39 +3,53 @@
    scheme_do_eval()'s increment, because this
    might be the continuation of a tail call. */
 
+/* This code is written in such a way that xform can
+   see that no GC cooperation is needed. */
+
+static MZ_INLINE Scheme_Object *PRIM_APPLY_NAME_FAST(Scheme_Object *rator,
+                                                     int argc,
+                                                     Scheme_Object **argv)
+{
+  GC_CAN_IGNORE Scheme_Object *v;
+  GC_CAN_IGNORE Scheme_Primitive_Proc *prim;
+  GC_CAN_IGNORE Scheme_Primitive_Closure_Proc *f;
+  
+  prim = (Scheme_Primitive_Proc *)rator;
+  
+  if (argc < prim->mina || (argc > prim->mu.maxa && prim->mina >= 0)) {
+    scheme_wrong_count(prim->name, prim->mina, prim->mu.maxa, argc, argv);
+    return NULL; /* Shouldn't get here */
+  }
+  
+  f = (Scheme_Primitive_Closure_Proc *)prim->prim_val;
+  v = f(argc, argv, (Scheme_Object *)prim);
+  
+#if PRIM_CHECK_VALUE
+  if (v == SCHEME_TAIL_CALL_WAITING)
+    v = scheme_force_value_same_mark(v);
+#endif
+  
+#if PRIM_CHECK_MULTI
+  if (v == SCHEME_MULTIPLE_VALUES) {
+    scheme_wrong_return_arity(NULL, 1, scheme_multiple_count, scheme_multiple_array, NULL);
+    return NULL; /* Shouldn't get here */
+  }
+#endif
+  
+  return v;
+}
+
+Scheme_Object *PRIM_APPLY_NAME(Scheme_Object *rator,
+                               int argc,
+                               Scheme_Object **argv)
+{
   if (!SCHEME_INTP(rator)) {
     Scheme_Type t;
 
     t = _SCHEME_TYPE(rator);
 
     if (t == scheme_prim_type) {
-      GC_CAN_IGNORE Scheme_Object *v;
+      return PRIM_APPLY_NAME_FAST(rator, argc, argv);
-      GC_CAN_IGNORE Scheme_Primitive_Proc *prim;
-      GC_CAN_IGNORE Scheme_Primitive_Closure_Proc *f;
-
-      prim = (Scheme_Primitive_Proc *)rator;
-
-      if (argc < prim->mina || (argc > prim->mu.maxa && prim->mina >= 0)) {
-	scheme_wrong_count(prim->name, prim->mina, prim->mu.maxa, argc, argv);
-	return NULL; /* Shouldn't get here */
-      }
-
-      f = (Scheme_Primitive_Closure_Proc *)prim->prim_val;
-      v = f(argc, argv, (Scheme_Object *)prim);
-
-#if PRIM_CHECK_VALUE
-      if (v == SCHEME_TAIL_CALL_WAITING)
-	v = scheme_force_value_same_mark(v);
-#endif
-
-#if PRIM_CHECK_MULTI
-      if (v == SCHEME_MULTIPLE_VALUES) {
-	scheme_wrong_return_arity(NULL, 1, scheme_multiple_count, scheme_multiple_array, NULL);
-	return NULL; /* Shouldn't get here */
-      }
-#endif
-
-      return v;
     }
   }
 
@@ -60,6 +74,9 @@
   return _scheme_tail_apply(rator, argc, argv);
 # endif
 #endif
+}
 
 #undef PRIM_CHECK_VALUE
 #undef PRIM_CHECK_MULTI
+#undef PRIM_APPLY_NAME
+#undef PRIM_APPLY_NAME_FAST