fix compiler to not move allocation across continuation capture
Note that even the movement of operations like `unsafe-fl+` is
constrained, since the operation can allocate. For example, a
continuation captured in
(let ([a (unsafe-fl+ x y)])
(call-with-composable-continuation ....)
a)
should return an `eq?` result. The compiler must not only refrain from
moving the `unsafe-fl+` call, it must not mark `a` as a flonum
binding, because that would cause the JIT to delay allocation of `a`
until the return site.
This commit is contained in:
Matthew Flatt
parent
30959e86aa
commit
389aa9fcd8
|
|
@ -1031,10 +1031,11 @@
|
|||
(error "bad")
|
||||
(equal? (list* w z) (list* z w))))
|
||||
|
||||
;; Ok to move `box' past a side effect:
|
||||
;; Ok to move `box' past a side effect (that can't capture a
|
||||
;; resumable continuation):
|
||||
(test-comp '(let ([h (box 0.0)])
|
||||
(list (printf "hi\n") h))
|
||||
'(list (printf "hi\n") (box 0.0)))
|
||||
(list (random) h))
|
||||
'(list (random) (box 0.0)))
|
||||
|
||||
;; Don't move `box' past a `lambda':
|
||||
(test-comp '(let ([h (box 0.0)])
|
||||
|
|
@ -1394,6 +1395,19 @@
|
|||
[(p) (q)])
|
||||
(list x y z))))
|
||||
|
||||
(test-comp '(lambda (f a)
|
||||
(letrec ([y (if (zero? a)
|
||||
(error "no")
|
||||
8)]
|
||||
[f (lambda (x) (f x))])
|
||||
f))
|
||||
'(lambda (f a)
|
||||
(let ([y (if (zero? a)
|
||||
(error "no")
|
||||
8)])
|
||||
(letrec ([f (lambda (x) (f x))])
|
||||
f))))
|
||||
|
||||
(test-comp '(procedure? add1)
|
||||
#t)
|
||||
(test-comp '(procedure? (lambda (x) x))
|
||||
|
|
@ -1586,31 +1600,60 @@
|
|||
(test-bin 'eq?)
|
||||
(test-bin 'eqv?))
|
||||
|
||||
(let ([test-move
|
||||
(lambda (expr [same? #t])
|
||||
(test-comp `(lambda (z)
|
||||
(let ([x ,expr])
|
||||
(let ([y (read)])
|
||||
(list y x))))
|
||||
`(lambda (z)
|
||||
(list (read) ,expr))
|
||||
same?))])
|
||||
(test-move '(cons 1 2))
|
||||
(test-move '(mcons 1 2))
|
||||
(test-move '(list 1))
|
||||
(test-move '(list 1 2))
|
||||
(test-move '(list 1 2 3))
|
||||
(test-move '(list* 1 2))
|
||||
(test-move '(list* 1 2 3))
|
||||
(test-move '(vector 1))
|
||||
(test-move '(vector 1 2))
|
||||
(test-move '(vector 1 2 3))
|
||||
(test-move '(box 2))
|
||||
(test-move '(box-immutable 2))
|
||||
(test-move '(cons 1 2 3) #f)
|
||||
(test-move '(mcons 1 2 3) #f)
|
||||
(test-move '(box 1 2) #f)
|
||||
(test-move '(box-immutable 1 2) #f))
|
||||
(for ([middle (in-list (list '(random) ; known immediate
|
||||
'(read)))] ; could capture continuation?
|
||||
[default-same? (in-list (list #t
|
||||
#f))])
|
||||
(let ([test-move
|
||||
(lambda (expr [same? default-same?])
|
||||
(test-comp `(lambda (z)
|
||||
(let ([x ,expr])
|
||||
(let ([y ,middle])
|
||||
(list y x))))
|
||||
`(lambda (z)
|
||||
(list ,middle ,expr))
|
||||
same?))])
|
||||
(test-move '(cons 1 2))
|
||||
(test-move '(mcons 1 2))
|
||||
(test-move '(list 1))
|
||||
(test-move '(list 1 2))
|
||||
(test-move '(list 1 2 3))
|
||||
(test-move '(list* 1 2))
|
||||
(test-move '(list* 1 2 3))
|
||||
(test-move '(vector 1))
|
||||
(test-move '(vector 1 2))
|
||||
(test-move '(vector 1 2 3))
|
||||
(test-move '(box 2))
|
||||
(test-move '(box-immutable 2))
|
||||
(test-move '(cons 1 2 3) #f)
|
||||
(test-move '(mcons 1 2 3) #f)
|
||||
(test-move '(box 1 2) #f)
|
||||
(test-move '(box-immutable 1 2) #f)))
|
||||
|
||||
;; Check move in to `else` branch where `then`
|
||||
;; branch might capture a continuation
|
||||
(test-comp `(lambda (z)
|
||||
(let ([x (cons 1 2)])
|
||||
(if z
|
||||
(read)
|
||||
x)))
|
||||
`(lambda (z)
|
||||
(if z
|
||||
(read)
|
||||
(cons 1 2))))
|
||||
;; But not after the merge:
|
||||
(test-comp `(lambda (z)
|
||||
(let ([x (cons 1 2)])
|
||||
(if z
|
||||
(read)
|
||||
(void))
|
||||
x))
|
||||
`(lambda (z)
|
||||
(if z
|
||||
(read)
|
||||
(void))
|
||||
(cons 1 2))
|
||||
#f)
|
||||
|
||||
(let ([test-use-unsafe
|
||||
(lambda (pred op unsafe-op)
|
||||
|
|
@ -1711,13 +1754,22 @@
|
|||
(unsafe-car x))
|
||||
#f)
|
||||
|
||||
;; it's ok to delay `list', because there's no space-safety issue
|
||||
;; It would be ok to delay `list', because there's no space-safety issue
|
||||
;; ... except that an arbitrary function might capture a continuation:
|
||||
(test-comp '(lambda (f x)
|
||||
(let ([y (list x)])
|
||||
(f)
|
||||
y))
|
||||
'(lambda (f x)
|
||||
(f)
|
||||
(list x))
|
||||
#f)
|
||||
(test-comp '(lambda (f x)
|
||||
(let ([y (list x)])
|
||||
(random)
|
||||
y))
|
||||
'(lambda (f x)
|
||||
(random)
|
||||
(list x)))
|
||||
|
||||
;; don't duplicate formerly once-used variable due to inlining
|
||||
|
|
@ -3294,6 +3346,36 @@
|
|||
(test '(0.5e7 yep) (lambda () (even 1e7 0.0))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Double-check that allocation is not moved
|
||||
;; across continuation capture:
|
||||
|
||||
(let ()
|
||||
(define g #f)
|
||||
(define p (make-continuation-prompt-tag))
|
||||
(define (t)
|
||||
(let ([a (cons 1 2)])
|
||||
(call-with-composable-continuation (λ (k) (set! g k)) p)
|
||||
a))
|
||||
(call-with-continuation-prompt t p)
|
||||
(test #t eq?
|
||||
(call-with-continuation-prompt g p)
|
||||
(call-with-continuation-prompt g p)))
|
||||
|
||||
(let ()
|
||||
(define g #f)
|
||||
(define p (make-continuation-prompt-tag))
|
||||
(define (t)
|
||||
(let ([a (fl+ (random) 1.0)])
|
||||
(call-with-composable-continuation (λ (k) (set! g k)) p)
|
||||
(if (fl= a 0.0) ; encourage unboxing of `a` (if not for the continuation capture)
|
||||
#f
|
||||
a))) ; must not delay flnonum allocation to here
|
||||
(call-with-continuation-prompt t p)
|
||||
(test #t eq?
|
||||
(call-with-continuation-prompt g p)
|
||||
(call-with-continuation-prompt g p)))
|
||||
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,52,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,14,0,
|
||||
19,0,32,0,37,0,40,0,47,0,54,0,59,0,63,0,67,0,74,0,83,
|
||||
0,87,0,93,0,107,0,121,0,124,0,130,0,134,0,136,0,147,0,149,0,
|
||||
|
|
@ -100,7 +100,7 @@
|
|||
EVAL_ONE_SIZED_STR((char *)expr, 2051);
|
||||
}
|
||||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,52,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,187,0,0,0,1,0,0,8,0,21,0,
|
||||
26,0,43,0,55,0,77,0,106,0,150,0,156,0,165,0,172,0,187,0,205,
|
||||
0,217,0,233,0,247,0,13,1,32,1,39,1,73,1,90,1,107,1,130,1,
|
||||
|
|
@ -1017,7 +1017,7 @@
|
|||
EVAL_ONE_SIZED_STR((char *)expr, 19187);
|
||||
}
|
||||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,52,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,14,0,0,0,1,0,0,15,0,40,0,
|
||||
57,0,75,0,97,0,120,0,140,0,162,0,171,0,180,0,187,0,196,0,203,
|
||||
0,0,0,231,1,0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,
|
||||
|
|
@ -1047,7 +1047,7 @@
|
|||
EVAL_ONE_SIZED_STR((char *)expr, 557);
|
||||
}
|
||||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,52,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,106,0,0,0,1,0,0,7,0,18,0,
|
||||
45,0,51,0,60,0,67,0,89,0,102,0,128,0,145,0,167,0,175,0,187,
|
||||
0,202,0,218,0,236,0,0,1,12,1,28,1,51,1,75,1,87,1,118,1,
|
||||
|
|
@ -1529,7 +1529,7 @@
|
|||
EVAL_ONE_SIZED_STR((char *)expr, 10046);
|
||||
}
|
||||
{
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0,
|
||||
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,48,46,48,46,52,84,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,
|
||||
29,0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,101,1,0,
|
||||
0,69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,
|
||||
|
|
|
|||
|
|
@ -684,8 +684,15 @@ static intptr_t scheme_sprintf(char *s, intptr_t maxlen, const char *msg, ...)
|
|||
return len;
|
||||
}
|
||||
|
||||
#define ESCAPING_NONCM_PRIM(name, func, a1, a2, env) \
|
||||
p = scheme_make_noncm_prim(func, name, a1, a2); \
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_ALWAYS_ESCAPES); \
|
||||
scheme_add_global_constant(name, p, env);
|
||||
|
||||
void scheme_init_error(Scheme_Env *env)
|
||||
{
|
||||
Scheme_Object *p;
|
||||
|
||||
if (!scheme_console_printf)
|
||||
scheme_console_printf = default_printf;
|
||||
if (!scheme_console_output)
|
||||
|
|
@ -694,15 +701,15 @@ void scheme_init_error(Scheme_Env *env)
|
|||
REGISTER_SO(scheme_raise_arity_error_proc);
|
||||
|
||||
/* errors */
|
||||
GLOBAL_NONCM_PRIM("error", error, 1, -1, env);
|
||||
GLOBAL_NONCM_PRIM("raise-user-error", raise_user_error, 1, -1, env);
|
||||
GLOBAL_NONCM_PRIM("raise-syntax-error", raise_syntax_error, 2, 5, env);
|
||||
GLOBAL_NONCM_PRIM("raise-type-error", raise_type_error, 3, -1, env);
|
||||
GLOBAL_NONCM_PRIM("raise-argument-error", raise_argument_error, 3, -1, env);
|
||||
GLOBAL_NONCM_PRIM("raise-result-error", raise_result_error, 3, -1, env);
|
||||
GLOBAL_NONCM_PRIM("raise-arguments-error", raise_arguments_error, 2, -1, env);
|
||||
GLOBAL_NONCM_PRIM("raise-mismatch-error", raise_mismatch_error, 3, -1, env);
|
||||
GLOBAL_NONCM_PRIM("raise-range-error", raise_range_error, 7, 8, env);
|
||||
ESCAPING_NONCM_PRIM("error", error, 1, -1, env);
|
||||
ESCAPING_NONCM_PRIM("raise-user-error", raise_user_error, 1, -1, env);
|
||||
ESCAPING_NONCM_PRIM("raise-syntax-error", raise_syntax_error, 2, 5, env);
|
||||
ESCAPING_NONCM_PRIM("raise-type-error", raise_type_error, 3, -1, env);
|
||||
ESCAPING_NONCM_PRIM("raise-argument-error", raise_argument_error, 3, -1, env);
|
||||
ESCAPING_NONCM_PRIM("raise-result-error", raise_result_error, 3, -1, env);
|
||||
ESCAPING_NONCM_PRIM("raise-arguments-error", raise_arguments_error, 2, -1, env);
|
||||
ESCAPING_NONCM_PRIM("raise-mismatch-error", raise_mismatch_error, 3, -1, env);
|
||||
ESCAPING_NONCM_PRIM("raise-range-error", raise_range_error, 7, 8, env);
|
||||
|
||||
scheme_raise_arity_error_proc = scheme_make_noncm_prim(raise_arity_error, "raise-arity-error", 2, -1);
|
||||
scheme_add_global_constant("raise-arity-error", scheme_raise_arity_error_proc, env);
|
||||
|
|
|
|||
|
|
@ -771,19 +771,6 @@ scheme_make_prim_w_arity(Scheme_Prim *fun, const char *name,
|
|||
0, 0, NULL);
|
||||
}
|
||||
|
||||
Scheme_Object *
|
||||
scheme_make_folding_prim(Scheme_Prim *fun, const char *name,
|
||||
mzshort mina, mzshort maxa,
|
||||
short folding)
|
||||
{
|
||||
return make_prim_closure(fun, 1, name, mina, maxa,
|
||||
(folding
|
||||
? SCHEME_PRIM_OPT_FOLDING
|
||||
: 0),
|
||||
1, 1,
|
||||
0, 0, NULL);
|
||||
}
|
||||
|
||||
Scheme_Object *
|
||||
scheme_make_noncm_prim(Scheme_Prim *fun, const char *name,
|
||||
mzshort mina, mzshort maxa)
|
||||
|
|
@ -802,14 +789,30 @@ scheme_make_immed_prim(Scheme_Prim *fun, const char *name,
|
|||
mzshort mina, mzshort maxa)
|
||||
{
|
||||
/* An immediate primitive is a non-cm primitive, and it doesn't
|
||||
extend the continuation in a way that interacts with space safety, except
|
||||
maybe to raise an exception. */
|
||||
capture a continuation or extend the continuation in a way that
|
||||
interacts with space safety (which implies no interposition via
|
||||
chaperones), except maybe to raise an exception. */
|
||||
return make_prim_closure(fun, 1, name, mina, maxa,
|
||||
SCHEME_PRIM_OPT_IMMEDIATE,
|
||||
1, 1,
|
||||
0, 0, NULL);
|
||||
}
|
||||
|
||||
Scheme_Object *
|
||||
scheme_make_folding_prim(Scheme_Prim *fun, const char *name,
|
||||
mzshort mina, mzshort maxa,
|
||||
short folding)
|
||||
{
|
||||
/* A folding primitive is an immediate primitive, and for constant
|
||||
arguments the result must be the same on all runs and platforms. */
|
||||
return make_prim_closure(fun, 1, name, mina, maxa,
|
||||
(folding
|
||||
? SCHEME_PRIM_OPT_FOLDING
|
||||
: 0),
|
||||
1, 1,
|
||||
0, 0, NULL);
|
||||
}
|
||||
|
||||
Scheme_Object *
|
||||
scheme_make_noneternal_prim_w_arity(Scheme_Prim *fun, const char *name,
|
||||
mzshort mina, mzshort maxa)
|
||||
|
|
|
|||
|
|
@ -768,25 +768,29 @@ scheme_init_unsafe_list (Scheme_Env *env)
|
|||
REGISTER_SO(scheme_unsafe_car_proc);
|
||||
p = scheme_make_folding_prim(unsafe_car, "unsafe-car", 1, 1, 1);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
|
||||
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
|
||||
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
|
||||
| SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
|
||||
scheme_add_global_constant ("unsafe-car", p, env);
|
||||
scheme_unsafe_car_proc = p;
|
||||
|
||||
REGISTER_SO(scheme_unsafe_cdr_proc);
|
||||
p = scheme_make_folding_prim(unsafe_cdr, "unsafe-cdr", 1, 1, 1);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
|
||||
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
|
||||
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
|
||||
| SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
|
||||
scheme_add_global_constant ("unsafe-cdr", p, env);
|
||||
scheme_unsafe_cdr_proc = p;
|
||||
|
||||
p = scheme_make_folding_prim(unsafe_list_ref, "unsafe-list-ref", 2, 2, 1);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
|
||||
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
|
||||
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
|
||||
| SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
|
||||
scheme_add_global_constant ("unsafe-list-ref", p, env);
|
||||
|
||||
p = scheme_make_folding_prim(unsafe_list_tail, "unsafe-list-tail", 2, 2, 1);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
|
||||
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
|
||||
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
|
||||
| SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
|
||||
scheme_add_global_constant ("unsafe-list-tail", p, env);
|
||||
|
||||
REGISTER_SO(scheme_unsafe_mcar_proc);
|
||||
|
|
|
|||
|
|
@ -53,9 +53,13 @@ struct Optimize_Info
|
|||
int original_frame, new_frame;
|
||||
Scheme_Object *consts;
|
||||
Comp_Prefix *cp;
|
||||
int init_kclock;
|
||||
|
||||
/* Propagated up and down the chain: */
|
||||
int size, vclock, psize;
|
||||
int size;
|
||||
int vclock; /* virtual clock that ticks for a side effect */
|
||||
int kclock; /* virtual clock that ticks for a potential continuation capture */
|
||||
int psize;
|
||||
short inline_fuel;
|
||||
char letrec_not_twice, enforce_const, use_psize, has_nonleaf;
|
||||
Scheme_Hash_Table *top_level_consts;
|
||||
|
|
@ -78,6 +82,7 @@ struct Optimize_Info
|
|||
};
|
||||
|
||||
#define OPT_IS_MUTATED 0x1
|
||||
#define OPT_ESCAPES_AFTER_K_TICK 0x2
|
||||
#define OPT_LOCAL_TYPE_ARG_SHIFT 2
|
||||
#define OPT_LOCAL_TYPE_VAL_SHIFT (OPT_LOCAL_TYPE_ARG_SHIFT + SCHEME_MAX_LOCAL_TYPE_BITS)
|
||||
|
||||
|
|
@ -103,10 +108,12 @@ static void add_type(Optimize_Info *info, int pos, Scheme_Object *pred);
|
|||
|
||||
static void optimize_mutated(Optimize_Info *info, int pos);
|
||||
static void optimize_produces_local_type(Optimize_Info *info, int pos, int ct);
|
||||
static int produces_local_type(Scheme_Object *rator, int argc);
|
||||
static Scheme_Object *optimize_reverse(Optimize_Info *info, int pos, int unless_mutated, int disrupt_single_use);
|
||||
static int optimize_is_used(Optimize_Info *info, int pos);
|
||||
static int optimize_any_uses(Optimize_Info *info, int start_pos, int end_pos);
|
||||
static int optimize_is_mutated(Optimize_Info *info, int pos);
|
||||
static int optimize_escapes_after_k_tick(Optimize_Info *info, int pos);
|
||||
static int optimize_is_local_type_arg(Optimize_Info *info, int pos, int depth);
|
||||
static int optimize_is_local_type_valued(Optimize_Info *info, int pos);
|
||||
static int env_uses_toplevel(Optimize_Info *frame);
|
||||
|
|
@ -132,6 +139,7 @@ typedef struct Scheme_Once_Used {
|
|||
Scheme_Object *expr;
|
||||
int pos;
|
||||
int vclock;
|
||||
int kclock;
|
||||
|
||||
int used;
|
||||
int delta;
|
||||
|
|
@ -141,7 +149,7 @@ typedef struct Scheme_Once_Used {
|
|||
struct Scheme_Once_Used *next;
|
||||
} Scheme_Once_Used;
|
||||
|
||||
static Scheme_Once_Used *make_once_used(Scheme_Object *val, int pos, int vclock, Scheme_Once_Used *prev);
|
||||
static Scheme_Once_Used *make_once_used(Scheme_Object *val, int pos, int vclock, int kclock, Scheme_Once_Used *prev);
|
||||
|
||||
#ifdef MZ_PRECISE_GC
|
||||
static void register_traversers(void);
|
||||
|
|
@ -931,7 +939,7 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
|
|||
return 0;
|
||||
}
|
||||
|
||||
static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda)
|
||||
static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda, int cross_k, Optimize_Info *info)
|
||||
/* A -1 return means that the arguments must be movable without
|
||||
changing space complexity. */
|
||||
{
|
||||
|
|
@ -941,6 +949,11 @@ static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda)
|
|||
doing so risks duplicating a computation if the relevant `lambda'
|
||||
is later inlined. */
|
||||
if (cross_lambda) return 0;
|
||||
if (cross_k
|
||||
&& !(SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_UNSAFE_NONALLOCATE)
|
||||
&& (produces_local_type(rator, n) != SCHEME_LOCAL_TYPE_FIXNUM)) {
|
||||
return 0;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
|
@ -949,6 +962,7 @@ static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda)
|
|||
return -1;
|
||||
|
||||
if (!cross_lambda
|
||||
&& !cross_k /* because all calls below allocate */
|
||||
/* Note that none of these have space-safety issues, since they
|
||||
return values that contain all arguments: */
|
||||
&& (SAME_OBJ(scheme_list_proc, rator)
|
||||
|
|
@ -965,7 +979,8 @@ static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda)
|
|||
return 0;
|
||||
}
|
||||
|
||||
static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delta, int cross_lambda,
|
||||
static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delta,
|
||||
int cross_lambda, int cross_k,
|
||||
int check_space, int fuel)
|
||||
/* An expression that can't necessarily be constant-folded,
|
||||
but can be delayed because it has no side-effects (or is unsafe);
|
||||
|
|
@ -999,11 +1014,12 @@ static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delt
|
|||
}
|
||||
break;
|
||||
case scheme_application_type:
|
||||
can_move = is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args, cross_lambda);
|
||||
can_move = is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args,
|
||||
cross_lambda, cross_k, info);
|
||||
if (can_move) {
|
||||
int i;
|
||||
for (i = ((Scheme_App_Rec *)expr)->num_args; i--; ) {
|
||||
if (!movable_expression(((Scheme_App_Rec *)expr)->args[i+1], info, delta, cross_lambda,
|
||||
if (!movable_expression(((Scheme_App_Rec *)expr)->args[i+1], info, delta, cross_lambda, cross_k,
|
||||
check_space || (can_move < 0), fuel - 1))
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -1011,19 +1027,19 @@ static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delt
|
|||
}
|
||||
break;
|
||||
case scheme_application2_type:
|
||||
can_move = is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1, cross_lambda);
|
||||
can_move = is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1, cross_lambda, cross_k, info);
|
||||
if (can_move) {
|
||||
if (movable_expression(((Scheme_App2_Rec *)expr)->rand, info, delta, cross_lambda,
|
||||
if (movable_expression(((Scheme_App2_Rec *)expr)->rand, info, delta, cross_lambda, cross_k,
|
||||
check_space || (can_move < 0), fuel - 1))
|
||||
return 1;
|
||||
}
|
||||
break;
|
||||
case scheme_application3_type:
|
||||
can_move = is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2, cross_lambda);
|
||||
can_move = is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2, cross_lambda, cross_k, info);
|
||||
if (can_move) {
|
||||
if (movable_expression(((Scheme_App3_Rec *)expr)->rand1, info, delta, cross_lambda,
|
||||
if (movable_expression(((Scheme_App3_Rec *)expr)->rand1, info, delta, cross_lambda, cross_k,
|
||||
check_space || (can_move < 0), fuel - 1)
|
||||
&& movable_expression(((Scheme_App3_Rec *)expr)->rand2, info, delta, cross_lambda,
|
||||
&& movable_expression(((Scheme_App3_Rec *)expr)->rand2, info, delta, cross_lambda, cross_k,
|
||||
check_space || (can_move < 0), fuel - 1))
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -1527,6 +1543,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
|
|||
if (nested_count) {
|
||||
sub_info = optimize_info_add_frame(info, nested_count, nested_count, 0);
|
||||
sub_info->vclock++;
|
||||
sub_info->kclock++;
|
||||
/* We could propagate bound values in sub_info, but relevant inlining
|
||||
and propagatation has probably already happened when the rator was
|
||||
optimized. */
|
||||
|
|
@ -1876,6 +1893,24 @@ static int is_nonmutating_primitive(Scheme_Object *rator, int n)
|
|||
return 0;
|
||||
}
|
||||
|
||||
static int is_noncapturing_primitive(Scheme_Object *rator, int n)
|
||||
{
|
||||
if (SCHEME_PRIMP(rator)) {
|
||||
int opt;
|
||||
opt = ((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_OPT_MASK;
|
||||
if (opt >= SCHEME_PRIM_OPT_IMMEDIATE)
|
||||
return 1;
|
||||
if (opt >= SCHEME_PRIM_OPT_NONCM) {
|
||||
if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_ALWAYS_ESCAPES) {
|
||||
/* even if a continuation is captured, it won't get back */
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
#define IS_NAMED_PRIM(p, nm) (!strcmp(((Scheme_Primitive_Proc *)p)->name, nm))
|
||||
|
||||
static int wants_local_type_arguments(Scheme_Object *rator, int argpos)
|
||||
|
|
@ -2214,6 +2249,8 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_
|
|||
info->size += 1;
|
||||
if (!is_nonmutating_primitive(app->args[0], app->num_args))
|
||||
info->vclock += 1;
|
||||
if (!is_noncapturing_primitive(app->args[0], app->num_args))
|
||||
info->kclock += 1;
|
||||
|
||||
if (all_vals) {
|
||||
le = try_optimize_fold(app->args[0], (Scheme_Object *)app, info);
|
||||
|
|
@ -2396,6 +2433,8 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
|
|||
|
||||
if (!is_nonmutating_primitive(app->rator, 1))
|
||||
info->vclock += 1;
|
||||
if (!is_noncapturing_primitive(app->rator, 1))
|
||||
info->kclock += 1;
|
||||
|
||||
info->preserves_marks = !!(rator_flags & CLOS_PRESERVES_MARKS);
|
||||
info->single_result = !!(rator_flags & CLOS_SINGLE_RESULT);
|
||||
|
|
@ -2606,6 +2645,8 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
|
|||
|
||||
if (!is_nonmutating_primitive(app->rator, 2))
|
||||
info->vclock += 1;
|
||||
if (!is_noncapturing_primitive(app->rator, 2))
|
||||
info->kclock += 1;
|
||||
|
||||
/* Check for (call-with-values (lambda () M) N): */
|
||||
if (SAME_OBJ(app->rator, scheme_call_with_values_proc)) {
|
||||
|
|
@ -3018,7 +3059,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
|
|||
Scheme_Branch_Rec *b;
|
||||
Scheme_Object *t, *tb, *fb;
|
||||
Scheme_Hash_Tree *old_types;
|
||||
int preserves_marks = 1, single_result = 1;
|
||||
int preserves_marks = 1, single_result = 1, init_kclock, then_kclock;
|
||||
|
||||
b = (Scheme_Branch_Rec *)o;
|
||||
|
||||
|
|
@ -3059,6 +3100,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
|
|||
}
|
||||
|
||||
info->vclock += 1; /* model branch as clock increment */
|
||||
init_kclock = info->kclock;
|
||||
|
||||
if (SCHEME_TYPE(t) > _scheme_compiled_values_types_) {
|
||||
info->size -= 1;
|
||||
|
|
@ -3087,6 +3129,8 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
|
|||
single_result = -1;
|
||||
|
||||
info->types = old_types;
|
||||
then_kclock = info->kclock;
|
||||
info->kclock = init_kclock;
|
||||
|
||||
fb = scheme_optimize_expr(fb, info, scheme_optimize_tail_context(context));
|
||||
|
||||
|
|
@ -3099,6 +3143,9 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
|
|||
else if (single_result && (info->single_result < 0))
|
||||
single_result = -1;
|
||||
|
||||
if (then_kclock > info->kclock)
|
||||
info->kclock = then_kclock;
|
||||
|
||||
info->vclock += 1; /* model join as clock increment */
|
||||
info->preserves_marks = preserves_marks;
|
||||
info->single_result = single_result;
|
||||
|
|
@ -3352,6 +3399,7 @@ apply_values_optimize(Scheme_Object *data, Optimize_Info *info, int context)
|
|||
|
||||
info->size += 1;
|
||||
info->vclock += 1;
|
||||
info->kclock += 1;
|
||||
|
||||
return scheme_optimize_apply_values(f, e, info, info->single_result, context);
|
||||
}
|
||||
|
|
@ -3599,21 +3647,27 @@ static Scheme_Object *begin_for_syntax_optimize(Scheme_Object *data, Optimize_In
|
|||
/* let, let-values, letrec, etc. */
|
||||
/*========================================================================*/
|
||||
|
||||
static int is_liftable_prim(Scheme_Object *v)
|
||||
static int is_liftable_prim(Scheme_Object *v, int or_escape)
|
||||
{
|
||||
if (SCHEME_PRIMP(v)) {
|
||||
if ((((Scheme_Primitive_Proc *)v)->pp.flags & SCHEME_PRIM_OPT_MASK)
|
||||
>= SCHEME_PRIM_OPT_IMMEDIATE)
|
||||
int opt = (((Scheme_Primitive_Proc *)v)->pp.flags & SCHEME_PRIM_OPT_MASK);
|
||||
if (opt >= SCHEME_PRIM_OPT_IMMEDIATE)
|
||||
return 1;
|
||||
if (or_escape && (opt >= SCHEME_PRIM_OPT_NONCM)) {
|
||||
if (SCHEME_PRIM_PROC_OPT_FLAGS(v) & SCHEME_PRIM_ALWAYS_ESCAPES)
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
|
||||
int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator, int or_escape)
|
||||
{
|
||||
Scheme_Type t = SCHEME_TYPE(o);
|
||||
|
||||
if (!fuel) return 0;
|
||||
|
||||
switch (t) {
|
||||
case scheme_compiled_unclosed_procedure_type:
|
||||
return !as_rator;
|
||||
|
|
@ -3626,11 +3680,11 @@ int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
|
|||
return 1;
|
||||
break;
|
||||
case scheme_branch_type:
|
||||
if (fuel) {
|
||||
{
|
||||
Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)o;
|
||||
if (scheme_is_liftable(b->test, bind_count, fuel - 1, 0)
|
||||
&& scheme_is_liftable(b->tbranch, bind_count, fuel - 1, as_rator)
|
||||
&& scheme_is_liftable(b->fbranch, bind_count, fuel - 1, as_rator))
|
||||
if (scheme_is_liftable(b->test, bind_count, fuel - 1, 0, or_escape)
|
||||
&& scheme_is_liftable(b->tbranch, bind_count, fuel - 1, as_rator, or_escape)
|
||||
&& scheme_is_liftable(b->fbranch, bind_count, fuel - 1, as_rator, or_escape))
|
||||
return 1;
|
||||
}
|
||||
break;
|
||||
|
|
@ -3638,13 +3692,13 @@ int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
|
|||
{
|
||||
Scheme_App_Rec *app = (Scheme_App_Rec *)o;
|
||||
int i;
|
||||
if (!is_liftable_prim(app->args[0]))
|
||||
if (!is_liftable_prim(app->args[0], or_escape))
|
||||
return 0;
|
||||
if (0) /* not resolved, yet */
|
||||
if (bind_count >= 0)
|
||||
bind_count += app->num_args;
|
||||
for (i = app->num_args + 1; i--; ) {
|
||||
if (!scheme_is_liftable(app->args[i], bind_count, fuel - 1, 1))
|
||||
if (!scheme_is_liftable(app->args[i], bind_count, fuel - 1, 1, or_escape))
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
|
|
@ -3653,27 +3707,27 @@ int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
|
|||
case scheme_application2_type:
|
||||
{
|
||||
Scheme_App2_Rec *app = (Scheme_App2_Rec *)o;
|
||||
if (!is_liftable_prim(app->rator))
|
||||
if (!is_liftable_prim(app->rator, or_escape))
|
||||
return 0;
|
||||
if (0) /* not resolved, yet */
|
||||
if (bind_count >= 0)
|
||||
bind_count += 1;
|
||||
if (scheme_is_liftable(app->rator, bind_count, fuel - 1, 1)
|
||||
&& scheme_is_liftable(app->rand, bind_count, fuel - 1, 1))
|
||||
if (scheme_is_liftable(app->rator, bind_count, fuel - 1, 1, or_escape)
|
||||
&& scheme_is_liftable(app->rand, bind_count, fuel - 1, 1, or_escape))
|
||||
return 1;
|
||||
}
|
||||
break;
|
||||
case scheme_application3_type:
|
||||
{
|
||||
Scheme_App3_Rec *app = (Scheme_App3_Rec *)o;
|
||||
if (!is_liftable_prim(app->rator))
|
||||
if (!is_liftable_prim(app->rator, or_escape))
|
||||
return 0;
|
||||
if (0) /* not resolved, yet */
|
||||
if (bind_count >= 0)
|
||||
bind_count += 2;
|
||||
if (scheme_is_liftable(app->rator, bind_count, fuel - 1, 1)
|
||||
&& scheme_is_liftable(app->rand1, bind_count, fuel - 1, 1)
|
||||
&& scheme_is_liftable(app->rand2, bind_count, fuel - 1, 1))
|
||||
if (scheme_is_liftable(app->rator, bind_count, fuel - 1, 1, or_escape)
|
||||
&& scheme_is_liftable(app->rand1, bind_count, fuel - 1, 1, or_escape)
|
||||
&& scheme_is_liftable(app->rand2, bind_count, fuel - 1, 1, or_escape))
|
||||
return 1;
|
||||
}
|
||||
break;
|
||||
|
|
@ -3686,11 +3740,11 @@ int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
|
|||
if (post_bind) {
|
||||
o = lh->body;
|
||||
for (i = lh->num_clauses; i--; ) {
|
||||
if (!scheme_is_liftable(((Scheme_Compiled_Let_Value *)o)->value, bind_count, fuel - 1, as_rator))
|
||||
if (!scheme_is_liftable(((Scheme_Compiled_Let_Value *)o)->value, bind_count, fuel - 1, as_rator, or_escape))
|
||||
return 0;
|
||||
o = ((Scheme_Compiled_Let_Value *)o)->body;
|
||||
}
|
||||
if (scheme_is_liftable(o, bind_count + lh->count, fuel - 1, as_rator))
|
||||
if (scheme_is_liftable(o, bind_count + lh->count, fuel - 1, as_rator, or_escape))
|
||||
return 1;
|
||||
}
|
||||
break;
|
||||
|
|
@ -4007,7 +4061,7 @@ static int expr_size(Scheme_Object *o, Optimize_Info *info)
|
|||
|
||||
int scheme_might_invoke_call_cc(Scheme_Object *value)
|
||||
{
|
||||
return !scheme_is_liftable(value, -1, 10, 0);
|
||||
return !scheme_is_liftable(value, -1, 10, 0, 1);
|
||||
}
|
||||
|
||||
static int worth_lifting(Scheme_Object *v)
|
||||
|
|
@ -4498,7 +4552,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
|
|||
if (cnt == 1) {
|
||||
/* used only once; we may be able to shift the expression to the use
|
||||
site, instead of binding to a temporary */
|
||||
once_used = make_once_used(value, pos, rhs_info->vclock, NULL);
|
||||
once_used = make_once_used(value, pos, rhs_info->vclock, rhs_info->kclock, NULL);
|
||||
if (!last_once_used)
|
||||
first_once_used = once_used;
|
||||
else
|
||||
|
|
@ -4518,7 +4572,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
|
|||
cnt = ((pre_body->flags[i] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT);
|
||||
if (cnt == 1) {
|
||||
/* Need to register as once-used, in case of copy propagation */
|
||||
once_used = make_once_used(NULL, pos+i, rhs_info->vclock, NULL);
|
||||
once_used = make_once_used(NULL, pos+i, rhs_info->vclock, rhs_info->kclock, NULL);
|
||||
if (!last_once_used)
|
||||
first_once_used = once_used;
|
||||
else
|
||||
|
|
@ -4540,7 +4594,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
|
|||
&& !body_info->letrec_not_twice
|
||||
&& ((i < 1)
|
||||
|| (!scheme_is_compiled_procedure(((Scheme_Compiled_Let_Value *)pre_body->body)->value, 1, 1)
|
||||
&& !scheme_is_liftable(((Scheme_Compiled_Let_Value *)pre_body->body)->value, head->count, 5, 1)))) {
|
||||
&& !scheme_is_liftable(((Scheme_Compiled_Let_Value *)pre_body->body)->value, head->count, 5, 1, 0)))) {
|
||||
Scheme_Object *prop_later = NULL;
|
||||
|
||||
if (did_set_value) {
|
||||
|
|
@ -4711,6 +4765,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
|
|||
info->single_result = body_info->single_result;
|
||||
info->preserves_marks = body_info->preserves_marks;
|
||||
info->vclock = body_info->vclock;
|
||||
info->kclock = body_info->kclock;
|
||||
|
||||
/* Clear used flags where possible */
|
||||
body = head->body;
|
||||
|
|
@ -4754,8 +4809,12 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
|
|||
|
||||
pre_body->flags[j] |= SCHEME_WAS_USED;
|
||||
ct = optimize_is_local_type_arg(body_info, pos+j, 0);
|
||||
if (ct)
|
||||
pre_body->flags[j] |= (ct << SCHEME_WAS_TYPED_ARGUMENT_SHIFT);
|
||||
if (ct) {
|
||||
if (ALWAYS_PREFER_UNBOX_TYPE(ct)
|
||||
|| !optimize_escapes_after_k_tick(body_info, pos+j))
|
||||
pre_body->flags[j] |= (ct << SCHEME_WAS_TYPED_ARGUMENT_SHIFT);
|
||||
}
|
||||
|
||||
|
||||
if (first_once_used && (first_once_used->pos == (pos+j))) {
|
||||
if (first_once_used->vclock < 0) {
|
||||
|
|
@ -4865,6 +4924,7 @@ optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info, int cont
|
|||
SCHEME_LAMBDA_FRAME);
|
||||
|
||||
info->vclock += 1; /* model delayed evaluation as vclock increment */
|
||||
info->kclock += 1;
|
||||
|
||||
/* For reporting warnings: */
|
||||
if (info->context && SCHEME_PAIRP(info->context))
|
||||
|
|
@ -4883,7 +4943,7 @@ optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info, int cont
|
|||
|
||||
cnt = ((cl->local_flags[i] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT);
|
||||
if (cnt == 1) {
|
||||
last_once_used = make_once_used(NULL, i, info->vclock, last_once_used);
|
||||
last_once_used = make_once_used(NULL, i, info->vclock, info->kclock, last_once_used);
|
||||
if (!first_once_used) first_once_used = last_once_used;
|
||||
optimize_propagate(info, i, (Scheme_Object *)last_once_used, 1);
|
||||
}
|
||||
|
|
@ -5856,7 +5916,9 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
|
|||
if (((o->vclock == info->vclock)
|
||||
&& single_valued_noncm_expression(o->expr, 5))
|
||||
|| ((o->vclock != info->vclock)
|
||||
&& movable_expression(o->expr, info, o->delta, o->cross_lambda, 0, 5))) {
|
||||
&& movable_expression(o->expr, info, o->delta, o->cross_lambda,
|
||||
o->kclock != info->kclock,
|
||||
0, 5))) {
|
||||
val = optimize_clone(1, o->expr, info, o->delta, 0);
|
||||
if (val) {
|
||||
info->size -= 1;
|
||||
|
|
@ -6621,7 +6683,7 @@ static void optimize_propagate(Optimize_Info *info, int pos, Scheme_Object *valu
|
|||
info->consts = p;
|
||||
}
|
||||
|
||||
static Scheme_Once_Used *make_once_used(Scheme_Object *val, int pos, int vclock, Scheme_Once_Used *prev)
|
||||
static Scheme_Once_Used *make_once_used(Scheme_Object *val, int pos, int vclock, int kclock, Scheme_Once_Used *prev)
|
||||
{
|
||||
Scheme_Once_Used *o;
|
||||
|
||||
|
|
@ -6631,6 +6693,7 @@ static Scheme_Once_Used *make_once_used(Scheme_Object *val, int pos, int vclock,
|
|||
o->expr = val;
|
||||
o->pos = pos;
|
||||
o->vclock = vclock;
|
||||
o->kclock = kclock;
|
||||
|
||||
if (prev)
|
||||
prev->next = o;
|
||||
|
|
@ -6740,6 +6803,12 @@ static int optimize_is_mutated(Optimize_Info *info, int pos)
|
|||
return check_use(info, pos, OPT_IS_MUTATED, 0);
|
||||
}
|
||||
|
||||
static int optimize_escapes_after_k_tick(Optimize_Info *info, int pos)
|
||||
/* pos is in new-frame counts */
|
||||
{
|
||||
return check_use(info, pos, OPT_ESCAPES_AFTER_K_TICK, 0);
|
||||
}
|
||||
|
||||
static int optimize_is_local_type_arg(Optimize_Info *info, int pos, int depth)
|
||||
/* pos is in new-frame counts */
|
||||
{
|
||||
|
|
@ -6785,7 +6854,7 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int
|
|||
int disrupt_single_use, int *is_mutated, int just_test)
|
||||
{
|
||||
Scheme_Object *p, *n;
|
||||
int delta = 0, orig_j = j;
|
||||
int delta = 0, orig_j = j, kclock = info->kclock;
|
||||
|
||||
while (info) {
|
||||
if (info->flags & SCHEME_LAMBDA_FRAME)
|
||||
|
|
@ -6799,6 +6868,8 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int
|
|||
|
||||
if (OPT_CONTEXT_TYPE(context))
|
||||
register_use(info, pos, OPT_CONTEXT_TYPE(context) << OPT_LOCAL_TYPE_ARG_SHIFT);
|
||||
else if (!just_test && (kclock > info->init_kclock))
|
||||
register_use(info, pos, OPT_ESCAPES_AFTER_K_TICK);
|
||||
|
||||
if (is_mutated)
|
||||
if (info->use && (info->use[pos] & OPT_IS_MUTATED))
|
||||
|
|
@ -6964,6 +7035,8 @@ static Optimize_Info *optimize_info_add_frame(Optimize_Info *info, int orig, int
|
|||
naya->top_level_consts = info->top_level_consts;
|
||||
naya->context = info->context;
|
||||
naya->vclock = info->vclock;
|
||||
naya->kclock = info->kclock;
|
||||
naya->init_kclock = info->kclock;
|
||||
naya->use_psize = info->use_psize;
|
||||
naya->logger = info->logger;
|
||||
|
||||
|
|
@ -6994,6 +7067,7 @@ static void optimize_info_done(Optimize_Info *info, Optimize_Info *parent)
|
|||
|
||||
parent->size += info->size;
|
||||
parent->vclock = info->vclock;
|
||||
parent->kclock = info->kclock;
|
||||
parent->psize += info->psize;
|
||||
if (info->has_nonleaf)
|
||||
parent->has_nonleaf = 1;
|
||||
|
|
|
|||
|
|
@ -999,7 +999,7 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
|
|||
else if (SCHEME_CLV_FLAGS(clv) & SCHEME_CLV_NO_GROUP_USES)
|
||||
is_lift = 1;
|
||||
else
|
||||
is_lift = scheme_is_liftable(clv->value, head->count, 5, 1);
|
||||
is_lift = scheme_is_liftable(clv->value, head->count, 5, 1, 0);
|
||||
|
||||
if (!is_proc && !is_lift) {
|
||||
recbox = 1;
|
||||
|
|
|
|||
|
|
@ -49,7 +49,10 @@
|
|||
|
||||
/* Flonum unboxing is only useful if a value is going to flow to a
|
||||
function that wants it, otherwise we'll have to box the flonum anyway.
|
||||
Fixnum unboxing is always fine, since it's easy to box. */
|
||||
Also, we can only leave flonums unboxed if they don't escape
|
||||
before a potential continuation capture.
|
||||
Fixnum unboxing is always fine, since it's easy to box and doesn't
|
||||
involve allocation. */
|
||||
#define ALWAYS_PREFER_UNBOX_TYPE(ty) ((ty) == SCHEME_LOCAL_TYPE_FIXNUM)
|
||||
|
||||
#define IN_FIXNUM_RANGE_ON_ALL_PLATFORMS(v) (((v) >= -1073741824) && ((v) <= 1073741823))
|
||||
|
|
@ -68,8 +71,10 @@
|
|||
#define SCHEME_PRIM_WANTS_EXTFLONUM_FIRST 512
|
||||
#define SCHEME_PRIM_WANTS_EXTFLONUM_SECOND 1024
|
||||
#define SCHEME_PRIM_WANTS_EXTFLONUM_THIRD 2048
|
||||
#define SCHEME_PRIM_IS_UNSAFE_NONALLOCATE 4096
|
||||
#define SCHEME_PRIM_ALWAYS_ESCAPES 8192
|
||||
|
||||
#define SCHEME_PRIM_OPT_TYPE_SHIFT 12
|
||||
#define SCHEME_PRIM_OPT_TYPE_SHIFT 13
|
||||
#define SCHEME_PRIM_OPT_TYPE_MASK (SCHEME_MAX_LOCAL_TYPE_MASK << SCHEME_PRIM_OPT_TYPE_SHIFT)
|
||||
#define SCHEME_PRIM_OPT_TYPE(x) ((x & SCHEME_PRIM_OPT_TYPE_MASK) >> SCHEME_PRIM_OPT_TYPE_SHIFT)
|
||||
|
||||
|
|
@ -3068,7 +3073,7 @@ int scheme_used_ever(Scheme_Comp_Env *env, int which);
|
|||
int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
|
||||
Optimize_Info *opt_info, Optimize_Info *warn_info, int deeper_than, int no_id);
|
||||
int scheme_might_invoke_call_cc(Scheme_Object *value);
|
||||
int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator);
|
||||
int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator, int or_escape);
|
||||
int scheme_is_functional_primitive(Scheme_Object *rator, int num_args, int expected_vals);
|
||||
|
||||
typedef struct {
|
||||
|
|
|
|||
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "6.0.0.3"
|
||||
#define MZSCHEME_VERSION "6.0.0.4"
|
||||
|
||||
#define MZSCHEME_VERSION_X 6
|
||||
#define MZSCHEME_VERSION_Y 0
|
||||
#define MZSCHEME_VERSION_Z 0
|
||||
#define MZSCHEME_VERSION_W 3
|
||||
#define MZSCHEME_VERSION_W 4
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user