コード例 #1
0
ファイル: sfs.c プロジェクト: juanfra684/racket
void scheme_sfs_used(SFS_Info *info, int pos)
{
  if (info->pass)
    return;

  pos += info->stackpos;

  if ((pos < 0) || (pos >= info->depth)) {
    scheme_signal_error("internal error: stack use out of bounds");
  }
  if (pos == info->tlpos)
    scheme_signal_error("internal error: misuse of toplevel pointer");

  SFS_LOG(printf("touch %d %d\n", pos, info->ip));

  if (info->max_used[pos] >= FAR_VALUE_FOR_MAX_USED) {
    info->max_used[pos] = (FAR_VALUE_FOR_MAX_USED + 1);
    return;
  }
  
  if ((info->min_touch == -1)
      || (pos < info->min_touch))
    info->min_touch = pos;
  if (pos > info->max_touch)
    info->max_touch = pos;

  info->max_used[pos] = info->ip;
}
コード例 #2
0
ファイル: sfs.c プロジェクト: juanfra684/racket
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");

  if (track) {
    while (cnt--) {
      scheme_sfs_used(info, cnt);
    }
  }
}
コード例 #3
0
ファイル: sfs.c プロジェクト: juanfra684/racket
Scheme_Object *scheme_sfs(Scheme_Object *o, SFS_Info *info, int max_let_depth)
{
  int init, i;

  SFS_LOG(printf("sfs %d\n", SCHEME_TYPE(o)));

  if (!info) {
    info = scheme_new_sfs_info(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;
  info->tail_pos = 1;
  init = info->stackpos;
  o = scheme_sfs_expr(o, info, -1);

  if (info->seqn)
    scheme_signal_error("ended in the middle of an expression?");

# if MAX_SFS_CLEARING
  info->max_nontail = info->ip;
  info->abs_max_nontail = info->abs_ip;
# endif

  for (i = info->depth; i-- > init; ) {
    info->max_calls[i] = info->max_nontail;
  }

  {
    Scheme_Object *v;
    v = scheme_reverse(info->saved);
    info->saved = v;
  }

  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);

  return o;
}
コード例 #4
0
ファイル: sfs.c プロジェクト: awest/racket
static Scheme_Object *sfs_branch(Scheme_Object *o, SFS_Info *info)
{
  Scheme_Branch_Rec *b;
  Scheme_Object *t, *tb, *fb, *vec;
  int ip, min_t, max_t;

  b = (Scheme_Branch_Rec *)o;

  scheme_sfs_start_sequence(info, 1, 0);

  t = scheme_sfs_expr(b->test, info, -1);

  ip = info->ip;
  info->ip++;
  /* Use ip to represent all uses in the two branches.
     Use ip+1 to represent all non-tail calls in the two branches. */

  min_t = info->min_touch;
  max_t = info->max_touch;

  SFS_LOG(printf(" after test: %d %d\n", min_t, max_t));

  if (!info->pass) {
    vec = scheme_make_vector(SFS_BRANCH_W * 2, NULL);
    scheme_sfs_save(info, vec);
  } else {
    vec = scheme_sfs_next_saved(info);
  }

  tb = sfs_one_branch(info, ip, vec, 0, b->tbranch);

  if (!info->pass) {
    if ((min_t == -1)
        || ((info->min_touch > -1) && (info->min_touch < min_t)))
      min_t = info->min_touch;
    if (info->max_touch > max_t)
      max_t = info->max_touch;
    if (info->max_nontail > ip + 1)
      info->max_nontail = ip + 1;
  }

  fb = sfs_one_branch(info, ip, vec, 1, b->fbranch);

  if (!info->pass) {
    if ((min_t == -1)
        || ((info->min_touch > -1) && (info->min_touch < min_t)))
      min_t = info->min_touch;
    if (info->max_touch > max_t)
      max_t = info->max_touch;
    if (info->max_nontail > ip + 1)
      info->max_nontail = ip + 1;
  }

  SFS_LOG(printf(" done if: %d %d\n", min_t, max_t));
  
  info->min_touch = min_t;
  info->max_touch = max_t;
  
  b->test = t;
  b->tbranch = tb;
  b->fbranch = fb;

  return o;
}
コード例 #5
0
ファイル: sfs.c プロジェクト: awest/racket
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;
  Scheme_Object *t_vec, *o;
  Scheme_Object *clears = scheme_null;

  info->min_touch = -1;
  info->max_touch = -1;
  save_nt = info->max_nontail;

  SFS_LOG(printf("%d %d %s %d\n", info->pass, ip, (delta ? "else" : "then"), ip));

  if (info->pass) {
    /* Re-install max_used entries that refer to the branch */
    o = SCHEME_VEC_ELS(vec)[delta * SFS_BRANCH_W];
    t_min_t = SCHEME_INT_VAL(o);
    o = SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 2];
    nt = SCHEME_INT_VAL(o);
    if (nt > info->max_nontail)
      info->max_nontail = nt;
    if (t_min_t > -1) {
      t_vec = SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 1];
      t_cnt = SCHEME_VEC_SIZE(t_vec);
      for (i = 0; i < t_cnt; i++) {
        o = SCHEME_VEC_ELS(t_vec)[i];
        if (SCHEME_INTP(o)) {
          n = SCHEME_INT_VAL(o);
          SFS_LOG(printf(" @%d %d\n", i + t_min_t, n));
          if (info->max_used[i + t_min_t] < n) {
            SFS_LOG(printf(" |%d %d %d\n", i + t_min_t, n, info->max_nontail));
            info->max_used[i + t_min_t] = n;
            info->max_calls[i + t_min_t] = info->max_nontail;
          }
        }
      }
    }
    /* If the other branch has last use for something not used in this
       branch, and if there's a non-tail call in this branch
       of later, then we'll have to start with explicit clears. 
       Note that it doesn't matter whether the other branch actually
       clears them (i.e., the relevant non-tail call might be only
       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));
    if (((nt > (ip + 1)) && (nt < b_end)) /* => non-tail call in branch */
        || ((ip + 1) < save_nt)) { /* => 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);
      if (t_min_t > -1) {
        int at_ip, pos;
        t_vec = SCHEME_VEC_ELS(vec)[((1 - delta) * SFS_BRANCH_W) + 1];
        t_cnt = SCHEME_VEC_SIZE(t_vec);
        o = SCHEME_VEC_ELS(vec)[((1 - delta) * SFS_BRANCH_W) + 2];
        nt = SCHEME_INT_VAL(o);
        o = SCHEME_VEC_ELS(vec)[((1 - delta) * SFS_BRANCH_W) + 3];
        b_end = SCHEME_INT_VAL(o);
        for (i = 0; i < t_cnt; i++) {
          o = SCHEME_VEC_ELS(t_vec)[i];
          if (SCHEME_INTP(o)) {
            n = SCHEME_INT_VAL(o);
            pos = i + t_min_t;
            at_ip = info->max_used[pos];
            SFS_LOG(printf(" ?%d %d %d\n", pos, n, at_ip));
            /* is last use in other branch? */
            if (((!delta && (at_ip == ip))
                 || (delta && (at_ip == n)))) {
              /* Yes, so add clear */
              SFS_LOG(printf(" !%d %d %d\n", pos, n, at_ip));
              pos -= info->stackpos;
              clears = scheme_make_pair(scheme_make_integer(pos), 
                                        clears);
            }
          }
        }
      }
    }
  }

  stackpos = info->stackpos;

  tbranch = scheme_sfs_expr(tbranch, info, -1);

  if (info->pass)
    info->max_nontail = save_nt;
# if MAX_SFS_CLEARING
  else
    info->max_nontail = info->ip;
# endif

  tbranch = scheme_sfs_add_clears(tbranch, clears, 1);

  if (!info->pass) {
    t_min_t = info->min_touch;
    t_max_t = info->max_touch;
    if (t_min_t < stackpos)
      t_min_t = stackpos;
    if (t_max_t < stackpos)
      t_max_t = -1;
    SFS_LOG(printf("%d %s %d [%d,%d] /%d\n", info->pass, (delta ? "else" : "then"), ip, 
                   t_min_t, t_max_t, stackpos));
    if (t_max_t < 0) {
      t_min_t = -1;
      t_vec = scheme_false;
    } else {
      t_cnt = t_max_t - t_min_t + 1;
      t_vec = scheme_make_vector(t_cnt, NULL);
      for (i = 0; i < t_cnt; i++) {
        n = info->max_used[i + t_min_t];
        SFS_LOG(printf("%d %s %d %d -> %d/%d\n", info->pass, (delta ? "else" : "then"), ip, 
                       i + t_min_t, n, info->max_calls[i+ t_min_t]));
        if (n > ip) {
          SCHEME_VEC_ELS(t_vec)[i] = scheme_make_integer(n);
          info->max_used[i + t_min_t] = ip;
        } else {
          SCHEME_VEC_ELS(t_vec)[i] = scheme_false;
        }
      }
    }
    SCHEME_VEC_ELS(vec)[delta * SFS_BRANCH_W] = scheme_make_integer(t_min_t);
    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);
  }

  memset(info->max_used + info->stackpos, 0, (stackpos - info->stackpos) * sizeof(int));
  memset(info->max_calls + info->stackpos, 0, (stackpos - info->stackpos) * sizeof(int));

  info->stackpos = stackpos;

  return tbranch;
}