예제 #1
0
파일: sfs.c 프로젝트: juanfra684/racket
static Scheme_Object *with_immed_mark_sfs(Scheme_Object *o, SFS_Info *info)
{
  Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)o;
  Scheme_Object *k, *v, *b, *vec;
  int pos, save_mnt;
  
  scheme_sfs_start_sequence(info, 3, 1);

  k = scheme_sfs_expr(wcm->key, info, -1);
  v = scheme_sfs_expr(wcm->val, info, -1);

  scheme_sfs_push(info, 1, 1);

  pos = info->stackpos;
  save_mnt = info->max_nontail;

  if (!info->pass) {
    vec = scheme_make_vector(3, NULL);
    scheme_sfs_save(info, vec);
  } else {
    vec = scheme_sfs_next_saved(info);
    if (SCHEME_VEC_SIZE(vec) != 3)
      scheme_signal_error("internal error: bad vector length");
    info->max_used[pos] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[0]);
    info->max_calls[pos] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[1]);
    info->max_nontail = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[2]);
  }
  
  b = scheme_sfs_expr(wcm->body, info, -1);
  
  wcm->key = k;
  wcm->val = v;
  wcm->body = b;

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

  if (!info->pass) {
    int n;
    info->max_calls[pos] = info->max_nontail;
    n = info->max_used[pos];
    SCHEME_VEC_ELS(vec)[0] = scheme_make_integer(n);
    n = info->max_calls[pos];
    SCHEME_VEC_ELS(vec)[1] = scheme_make_integer(n);
    SCHEME_VEC_ELS(vec)[2] = scheme_make_integer(info->max_nontail);
  } else {
    info->max_nontail = save_mnt;
  }

  return o;
}
예제 #2
0
파일: sfs.c 프로젝트: awest/racket
static Scheme_Object *sfs_let_void(Scheme_Object *o, SFS_Info *info)
{
  Scheme_Let_Void *lv = (Scheme_Let_Void *)o;
  Scheme_Object *body;
  int i, pos, save_mnt;
  Scheme_Object *vec;
    
  scheme_sfs_push(info, lv->count, 1);
  pos = info->stackpos;
  save_mnt = info->max_nontail;

  if (!info->pass) {
    vec = scheme_make_vector(lv->count + 1, NULL);
    scheme_sfs_save(info, vec);
  } else {
    vec = scheme_sfs_next_saved(info);
    if (!SCHEME_VECTORP(vec))
      scheme_signal_error("internal error: not a vector");
    for (i = 0; i < lv->count; i++) {
      info->max_used[pos + i] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[i]);
      info->max_calls[pos + i] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[lv->count]);
    }
    info->max_nontail = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[lv->count]);
  }

  body = scheme_sfs_expr(lv->body, info, -1);

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

  if (!info->pass) {
    int n;
    SCHEME_VEC_ELS(vec)[lv->count] = scheme_make_integer(info->max_nontail);
    for (i = 0; i < lv->count; i++) {
      n = info->max_used[pos + i];
      SCHEME_VEC_ELS(vec)[i] = scheme_make_integer(n);
    }
  } else {
    info->max_nontail = save_mnt;
  }

  lv->body = body;

  return o;
}
예제 #3
0
파일: sfs.c 프로젝트: awest/racket
static Scheme_Object *sfs_application2(Scheme_Object *o, SFS_Info *info)
{
  Scheme_App2_Rec *app;
  Scheme_Object *nrator, *nrand;

  app = (Scheme_App2_Rec *)o;

  scheme_sfs_start_sequence(info, 2, 0);
  scheme_sfs_push(info, 1, 0);

  nrator = scheme_sfs_expr(app->rator, info, -1);
  nrand = scheme_sfs_expr(app->rand, info, -1);
  app->rator = nrator;
  app->rand = nrand;

  sfs_note_app(info, app->rator);

  scheme_reset_app2_eval_type(app);
  
  return o;
}
예제 #4
0
파일: sfs.c 프로젝트: awest/racket
static Scheme_Object *sfs_application3(Scheme_Object *o, SFS_Info *info)
{
  Scheme_App3_Rec *app;
  Scheme_Object *nrator, *nrand1, *nrand2;

  app = (Scheme_App3_Rec *)o;

  scheme_sfs_start_sequence(info, 3, 0);
  scheme_sfs_push(info, 2, 0);

  nrator = scheme_sfs_expr(app->rator, info, -1);
  nrand1 = scheme_sfs_expr(app->rand1, info, -1);
  nrand2 = scheme_sfs_expr(app->rand2, info, -1);
  
  app->rator = nrator;
  app->rand1 = nrand1;
  app->rand2 = nrand2;

  sfs_note_app(info, app->rator);

  scheme_reset_app3_eval_type(app);

  return o;
}
예제 #5
0
파일: sfs.c 프로젝트: awest/racket
static Scheme_Object *sfs_application(Scheme_Object *o, SFS_Info *info)
{
  Scheme_Object *orig, *naya = NULL;
  Scheme_App_Rec *app;
  int i, n;

  app = (Scheme_App_Rec *)o;
  n = app->num_args + 1;

  scheme_sfs_start_sequence(info, n, 0);
  scheme_sfs_push(info, n-1, 0);

  for (i = 0; i < n; i++) {
    orig = app->args[i];
    naya = scheme_sfs_expr(orig, info, -1);
    app->args[i] = naya;
  }

  sfs_note_app(info, app->args[0]);

  scheme_finish_application(app);

  return o;
}
예제 #6
0
파일: sfs.c 프로젝트: awest/racket
static Scheme_Object *sfs_let_one(Scheme_Object *o, SFS_Info *info)
{
  Scheme_Let_One *lo = (Scheme_Let_One *)o;
  Scheme_Object *body, *rhs, *vec;
  int pos, save_mnt, ip, et;
  int unused = 0;

  scheme_sfs_start_sequence(info, 2, 1);

  scheme_sfs_push(info, 1, 1);
  ip = info->ip;
  pos = info->stackpos;
  save_mnt = info->max_nontail;

  if (!info->pass) {
    vec = scheme_make_vector(3, NULL);
    scheme_sfs_save(info, vec);
  } else {
    vec = scheme_sfs_next_saved(info);
    if (SCHEME_VEC_SIZE(vec) != 3)
      scheme_signal_error("internal error: bad vector length");
    info->max_used[pos] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[0]);
    info->max_calls[pos] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[1]);
    info->max_nontail = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[2]);
  }

  rhs = scheme_sfs_expr(lo->value, info, -1);
  body = scheme_sfs_expr(lo->body, info, -1);

# if MAX_SFS_CLEARING
  if (!info->pass)
    info->max_nontail = info->ip;
# endif
  
  if (!info->pass) {
    int n;
    info->max_calls[pos] = info->max_nontail;
    n = info->max_used[pos];
    SCHEME_VEC_ELS(vec)[0] = scheme_make_integer(n);
    n = info->max_calls[pos];
    SCHEME_VEC_ELS(vec)[1] = scheme_make_integer(n);
    SCHEME_VEC_ELS(vec)[2] = scheme_make_integer(info->max_nontail);
  } else {
    info->max_nontail = save_mnt;

    if (info->max_used[pos] <= ip) {
      /* No one is using it, so don't actually push the value at run time
         (but keep the check that the result is single-valued).
         The optimizer normally would have converted away the binding, but
         it might not because (1) it was introduced late by inlining,
         or (2) the rhs expression doesn't always produce a single
         value. */
      if (scheme_omittable_expr(rhs, 1, -1, 1, NULL, -1)) {
        rhs = scheme_false;
      } else if ((ip < info->max_calls[pos])
                 && SAME_TYPE(SCHEME_TYPE(rhs), scheme_toplevel_type)) {
        /* Unusual case: we can't just drop the global-variable access,
           because it might be undefined, but we don't need the value,
           and we want to avoid an SFS clear in the interpreter loop.
           So, bind #f and then access in the global in a `begin'. */
        Scheme_Sequence *s;
        s = scheme_malloc_sequence(2);
        s->so.type = scheme_sequence_type;
        s->count = 2;
        s->array[0] = rhs;
        s->array[1] = body;
        body = (Scheme_Object *)s;
        rhs = scheme_false;
      }
      unused = 1;
    }
  }

  lo->value = rhs;
  lo->body = body;

  et = scheme_get_eval_type(lo->value);
  SCHEME_LET_EVAL_TYPE(lo) = (et 
                              | (unused ? 0 : (SCHEME_LET_EVAL_TYPE(lo) & LET_ONE_FLONUM))
                              | (unused ? LET_ONE_UNUSED : 0));

  return o;
}
예제 #7
0
파일: sfs.c 프로젝트: awest/racket
static Scheme_Object *sfs_closure(Scheme_Object *expr, SFS_Info *info, int self_pos)
{
  Scheme_Closure_Data *data = (Scheme_Closure_Data *)expr;
  Scheme_Object *code;
  int i, size, has_tl = 0;

  size = data->closure_size;
  if (size) {
    if (info->stackpos + data->closure_map[size - 1] == info->tlpos) {
      has_tl = 1;
      --size;
    }
  }

  if (!info->pass) {
    for (i = size; i--; ) {
      scheme_sfs_used(info, data->closure_map[i]);
    }
  } else {
    /* Check whether we need to zero out any stack positions
       after capturing them in a closure: */
    Scheme_Object *clears = scheme_null;

    if (info->ip < info->max_nontail) {
      int pos, ip;
      for (i = size; i--; ) {
        pos = data->closure_map[i] + info->stackpos;
        if (pos < info->depth) {
          ip = info->max_used[pos];
          if ((ip == info->ip)
              && (ip < info->max_calls[pos])) {
            pos -= info->stackpos;
            clears = scheme_make_pair(scheme_make_integer(pos),
                                      clears);
          }
        }
      }
    }

    return scheme_sfs_add_clears(expr, clears, 0);
  }

  if (!(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_SFS)) {
    SCHEME_CLOSURE_DATA_FLAGS(data) |= CLOS_SFS;
    info = scheme_new_sfs_info(data->max_let_depth);
    scheme_sfs_push(info, data->closure_size + data->num_params, 1);

    if (has_tl)
      info->tlpos = info->stackpos + data->closure_size - 1;

    if (self_pos >= 0) {
      for (i = size; i--; ) {
        if (data->closure_map[i] == self_pos) {
          info->selfpos = info->stackpos + i;
          info->selfstart = info->stackpos;
          info->selflen = data->closure_size;
          break;
        }
      }
    }

    code = scheme_sfs(data->code, info, data->max_let_depth);

    /* If any arguments go unused, and if there's a non-tail,
       non-immediate call in the body, then we flush the
       unused arguments at the start of the body. We assume that
       the closure values are used (otherwise they wouldn't
       be in the closure). */
    if (info->max_nontail) {
      int i, pos, cnt;
      Scheme_Object *clears = scheme_null;

      cnt = data->num_params;
      for (i = 0; i < cnt; i++) {
        pos = data->max_let_depth - (cnt - i);
        if (!info->max_used[pos]) {
          pos = i + data->closure_size;
          clears = scheme_make_pair(scheme_make_integer(pos),
                                    clears);
        }
      }
      
      if (SCHEME_PAIRP(clears))
        code = scheme_sfs_add_clears(code, clears, 1);

      if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)
        SCHEME_CLOSURE_DATA_FLAGS(data) |= CLOS_NEED_REST_CLEAR;
    }

    data->code = code;
  }

  return expr;
}
예제 #8
0
파일: sfs.c 프로젝트: juanfra684/racket
static Scheme_Object *sfs_lambda(Scheme_Object *expr, SFS_Info *info, int self_pos)
{
  Scheme_Lambda *data = (Scheme_Lambda *)expr;
  Scheme_Object *code;
  int i, size, has_tl = 0;

  size = data->closure_size;
  if (size) {
    if (info->stackpos + data->closure_map[size - 1] == info->tlpos) {
      has_tl = 1;
      --size;
    }
  }

  if (!info->pass) {
    for (i = size; i--; ) {
      scheme_sfs_used(info, data->closure_map[i]);
    }
  } else {
    /* Check whether we need to zero out any stack positions
       after capturing them in a closure: */
    Scheme_Object *clears = scheme_null;

    if (info->ip < info->max_nontail) {
      int pos, ip;
      for (i = size; i--; ) {
        pos = data->closure_map[i] + info->stackpos;
        if (pos < info->depth) {
          ip = info->max_used[pos];
          if ((ip == info->ip)
              && (ip < info->max_calls[pos])) {
            pos -= info->stackpos;
            clears = scheme_make_pair(scheme_make_integer(pos),
                                      clears);
          }
        }
      }
    }

    return scheme_sfs_add_clears(expr, clears, 0);
  }

  if (!(SCHEME_LAMBDA_FLAGS(data) & LAMBDA_SFS)) {
    SCHEME_LAMBDA_FLAGS(data) |= LAMBDA_SFS;
    info = scheme_new_sfs_info(data->max_let_depth);
    scheme_sfs_push(info, data->closure_size + data->num_params, 1);

    if (has_tl)
      info->tlpos = info->stackpos + data->closure_size - 1;

    if (self_pos >= 0) {
      for (i = size; i--; ) {
        if (data->closure_map[i] == self_pos) {
          info->selfpos = info->stackpos + i;
          info->selfstart = info->stackpos;
          info->selflen = data->closure_size;
          break;
        }
      }
    }

    /* Never clear typed arguments or typed closure elements: */
    if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
      int delta, size, ct, j, pos;
      mzshort *map;
      delta = data->closure_size;
      size = data->closure_size + data->num_params;
      map = data->closure_map;
      for (j = 0; j < size; j++) {
        ct = scheme_boxmap_get(map, j, delta);
        if (ct > LAMBDA_TYPE_TYPE_OFFSET) {
          if (j < data->num_params)
            pos = info->stackpos + delta + j;
          else
            pos = info->stackpos + (j - data->num_params);
          info->max_used[pos] = FAR_VALUE_FOR_MAX_USED;
        }
      }
    }

    code = scheme_sfs(data->body, info, data->max_let_depth);

    /* If any arguments go unused, and if there's a non-tail,
       non-immediate call in the body, then we flush the
       unused arguments at the start of the body. We assume that
       the closure values are used (otherwise they wouldn't
       be in the closure). */
    if (info->max_nontail) {
      int i, pos, cnt;
      Scheme_Object *clears = scheme_null;

      cnt = data->num_params;
      for (i = 0; i < cnt; i++) {
        pos = data->max_let_depth - (cnt - i);
        if (!info->max_used[pos]) {
          pos = i + data->closure_size;
          clears = scheme_make_pair(scheme_make_integer(pos),
                                    clears);
        }
      }
      
      if (SCHEME_PAIRP(clears))
        code = scheme_sfs_add_clears(code, clears, 1);

      if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST)
        SCHEME_LAMBDA_FLAGS(data) |= LAMBDA_NEED_REST_CLEAR;
    }

    data->body = code;
  }

  return expr;
}