suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

eliminate a little more 3m overhead

Browse Source 
svn: r5457
This commit is contained in:
Matthew Flatt 2007-01-25 09:35:01 +00:00
parent 0bd80179b6
commit 4516fb561f
4 changed files with 174 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
src/mzscheme/src/eval.c
View File

@ -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,
int argc,
Scheme_Object **argv)
{
#define PRIM_CHECK_VALUE 1
#define PRIM_CHECK_MULTI 0
#include "schnapp.inc"
}
# define PRIM_APPLY_NAME _scheme_apply_from_native
# define PRIM_APPLY_NAME_FAST _scheme_apply_from_native_fast
# define PRIM_CHECK_VALUE 1
# define PRIM_CHECK_MULTI 1
# 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)

67
src/mzscheme/src/numarith.c
View File

@ -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 {
Small_Bignum sa, sb;
return scheme_bignum_add(scheme_make_small_bignum(a, &sa),
scheme_make_small_bignum(b, &sb));
}
else
return ADD_slow(a, b);
}
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 {
Small_Bignum sa, sb;
return scheme_bignum_subtract(scheme_make_small_bignum(a, &sa),
scheme_make_small_bignum(b, &sb));
}
else
return SUBTRACT_slow(a, b);
}
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;
int i;
Scheme_Object *ret, *v;
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++) {
Scheme_Object *o = argv[i];
if (!SCHEME_NUMBERP(o)) {
scheme_wrong_type("-", "number", i, argc, argv);
if (argc == 2) {
v = argv[1];
if (!SCHEME_NUMBERP(v)) {
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 *

97
src/mzscheme/src/nummacs.h
View File

@ -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 * \
name (int argc, Scheme_Object *argv[]) \
static Scheme_Object *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 bn_op((n1), \
(scheme_make_small_bignum(SCHEME_INT_VAL(n2), &sb))); \
return name ## __big_int(n1, n2); \
} \
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; \
int i; \
Scheme_Object *ret; \
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 ) { \
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); \
return name ## __slow(ret, argc, argv); \
}
#define GEN_TWOARY_OP(stat, name, scheme_name, bin_name, TYPEP, type) \
stat Scheme_Object * \
name (int argc, Scheme_Object *argv[]) \
{ \
Scheme_Object *ret; \
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; \
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);

71
src/mzscheme/src/schnapp.inc
View File

@ -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;
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;
return PRIM_APPLY_NAME_FAST(rator, argc, argv);
}
}
@ -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