From 5f9576cb222c82951c1610c5fc4bf5c9aced2060 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 21 Aug 2016 17:13:24 -0600 Subject: [PATCH] fix space-safety in compiler The `if` case of the compiler's space-safety pass abused its "last non-tail call relative to the closest enclosing binding" state as "last non-tail call relative to the enclosing run time", which could cause it to not clear a stack position as needed to maintain space safety. --- pkgs/racket-test-core/tests/racket/will.rktl | 44 ++++++++++++++++++++ racket/src/racket/src/sfs.c | 38 ++++++++++++----- 2 files changed, 72 insertions(+), 10 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/will.rktl b/pkgs/racket-test-core/tests/racket/will.rktl index d43dd1c4fb..704bcbf7b6 100644 --- a/pkgs/racket-test-core/tests/racket/will.rktl +++ b/pkgs/racket-test-core/tests/racket/will.rktl @@ -312,6 +312,50 @@ (set! f f) (test #t < (f #f #f values 100) 33))) +;; ---------------------------------------- +;; Check space safety related to `if` under a more nested `let` than +;; a relevant binding + +(module allocates-many-vectors racket/base + (provide go) + + (define (f x y) + (let ([z (make-vector 1024 x)]) ; problem if `z` is retained during non-tail `(y)` + (let ([w (cons x x)]) + (if (pair? x) + 'ok ; SFS pass should clear `z` in or after this branch + (error "done" x z z w w))) + (box (y)))) + + (set! f f) + + (define (go) + (let loop ([n 100000]) + (f '(1 2) (lambda () + (if (zero? n) + 'done + (unbox (loop (sub1 n))))))))) + +(let ([init-memory-use (current-memory-use)]) + (define done? #f) + (define t (thread (lambda () + ((dynamic-require ''allocates-many-vectors 'go)) + (set! done? #t)))) + (define watcher-t (thread + (lambda () + (let loop () + (sleep 0.1) + (define mu (current-memory-use)) + (printf "~s\n" mu) + (cond + [(mu . < . (+ init-memory-use (* 100 1024 1024))) + (loop)] + [else + (kill-thread t)]))))) + (sync t) + (kill-thread watcher-t) + (test #t 'many-vectors-in-reasonable-space? done?)) + ;; ---------------------------------------- (report-errs) diff --git a/racket/src/racket/src/sfs.c b/racket/src/racket/src/sfs.c index ab7ff66197..22c85d9a14 100644 --- a/racket/src/racket/src/sfs.c +++ b/racket/src/racket/src/sfs.c @@ -37,9 +37,11 @@ struct SFS_Info { int tail_pos; /* in tail position? */ int depth, stackpos, tlpos; /* stack shape */ int selfpos, selfstart, selflen; /* tracks self calls */ - int ip; /* "instruction pointer" --- counts up during traversal of expressions */ + int ip; /* "instruction pointer" --- counts up during traversal of expressions, but special in `if` */ + int abs_ip; /* like `ip`, but no special `if` adjustment */ int seqn; /* tracks nesting */ - int max_nontail; /* ip of last non-tail call in the body */ + int max_nontail; /* ip of last non-tail call in the body w.r.t. the most recent binding */ + int abs_max_nontail; /* ip of last non-tail call in the body */ int min_touch, max_touch; /* tracks range of `macx_used' values changed */ int *max_used; /* maps stack position (i.e., variable) to ip of the variable's last use */ int *max_calls; /* maps stack position to ip of last non-tail call in variable's scope */ @@ -76,6 +78,7 @@ Scheme_Object *scheme_sfs(Scheme_Object *o, SFS_Info *info, int max_let_depth) info->pass = 0; info->ip = 1; + info->abs_ip = 1; info->saved = scheme_null; info->min_touch = -1; info->max_touch = -1; @@ -88,6 +91,7 @@ Scheme_Object *scheme_sfs(Scheme_Object *o, SFS_Info *info, int max_let_depth) # if MAX_SFS_CLEARING info->max_nontail = info->ip; + info->abs_max_nontail = info->abs_ip; # endif for (i = info->depth; i-- > init; ) { @@ -103,6 +107,7 @@ Scheme_Object *scheme_sfs(Scheme_Object *o, SFS_Info *info, int max_let_depth) info->pass = 1; info->seqn = 0; info->ip = 1; + info->abs_ip = 1; info->tail_pos = 1; info->stackpos = init; o = scheme_sfs_expr(o, info, -1); @@ -165,6 +170,8 @@ void scheme_sfs_push(SFS_Info *info, int cnt, int track) { info->stackpos -= cnt; + SFS_LOG(printf("push %d [%d]: %d\n", cnt, track, info->stackpos)); + if (info->stackpos < 0) scheme_signal_error("internal error: pushed too deep"); @@ -249,6 +256,7 @@ static void sfs_note_app(SFS_Info *info, Scheme_Object *rator, int flags) return; } info->max_nontail = info->ip; + info->abs_max_nontail = info->abs_ip; } else { int tail_ok = (flags & APPN_FLAG_SFS_TAIL); if (!MAX_SFS_CLEARING && (info->selfpos >= 0)) { @@ -264,8 +272,10 @@ static void sfs_note_app(SFS_Info *info, Scheme_Object *rator, int flags) tail_ok = 1; } } - if (!tail_ok) + if (!tail_ok) { info->max_nontail = info->ip; + info->abs_max_nontail = info->abs_ip; + } } } } @@ -403,13 +413,13 @@ static Scheme_Object *sfs_sequence(Scheme_Object *o, SFS_Info *info, int can_fla return o; } -#define SFS_BRANCH_W 4 +#define SFS_BRANCH_W 5 static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip, Scheme_Object *vec, int delta, Scheme_Object *tbranch) { - int t_min_t, t_max_t, t_cnt, n, stackpos, i, save_nt, b_end, nt; + int t_min_t, t_max_t, t_cnt, n, stackpos, i, save_nt, b_end, nt, else_end_abs; Scheme_Object *t_vec, *o; Scheme_Object *clears = scheme_null; @@ -452,9 +462,11 @@ static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip, in this branch). */ o = SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 3]; b_end = SCHEME_INT_VAL(o); - SFS_LOG(printf(" %d %d %d %d\n", nt, ip, b_end, save_nt)); + o = SCHEME_VEC_ELS(vec)[SFS_BRANCH_W + 4]; + else_end_abs = SCHEME_INT_VAL(o); + SFS_LOG(printf(" %d %d %d %d %d\n", nt, ip, b_end, else_end_abs, info->abs_max_nontail)); if (((nt > (ip + 1)) && (nt < b_end)) /* => non-tail call in branch */ - || ((ip + 1) < save_nt)) { /* => non-tail call after branches */ + || (else_end_abs < info->abs_max_nontail)) { /* => non-tail call after branches */ SFS_LOG(printf(" other\n")); o = SCHEME_VEC_ELS(vec)[(1 - delta) * SFS_BRANCH_W]; t_min_t = SCHEME_INT_VAL(o); @@ -474,8 +486,10 @@ static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip, at_ip = info->max_used[pos]; SFS_LOG(printf(" ?%d[%d] %d %d\n", pos, i, n, at_ip)); /* is last use in other branch? */ - if (((!delta && (at_ip == ip)) - || (delta && (at_ip == n)))) { + if ((((!delta && (at_ip == ip)) + || (delta && (at_ip == n)))) + /* and a relevant non-tail call happens after uses */ + && (info->max_calls[pos] > info->max_used[pos])) { /* Yes, so add clear */ SFS_LOG(printf(" !%d %d %d\n", pos, n, at_ip)); pos -= info->stackpos; @@ -495,8 +509,10 @@ static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip, if (info->pass) info->max_nontail = save_nt; # if MAX_SFS_CLEARING - else + else { info->max_nontail = info->ip; + info->abs_max_nontail = info->abs_ip; + } # endif tbranch = scheme_sfs_add_clears(tbranch, clears, 1); @@ -532,6 +548,7 @@ static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip, SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 1] = t_vec; SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 2] = scheme_make_integer(info->max_nontail); SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 3] = scheme_make_integer(info->ip); + SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 4] = scheme_make_integer(info->abs_ip); } memset(info->max_used + info->stackpos, 0, (stackpos - info->stackpos) * sizeof(int)); @@ -1357,6 +1374,7 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_ info->tail_pos = 0; } info->ip++; + info->abs_ip++; switch (type) { case scheme_local_type: