C++ SCHEME_VEC_SIZE函数代码示例

static int vector_equal(Scheme_Object *vec1, Scheme_Object *orig_vec1,
                        Scheme_Object *vec2, Scheme_Object *orig_vec2,
                        Equal_Info *eql)
{
  intptr_t i, len;
  Scheme_Object *v1, *v2;

  len = SCHEME_VEC_SIZE(vec1);
  if (len != SCHEME_VEC_SIZE(vec2))
    return 0;

  SCHEME_USE_FUEL(len);

  for (i = 0; i < len; i++) {
    if (SAME_OBJ(vec1, orig_vec1))
      v1 = SCHEME_VEC_ELS(vec1)[i];
    else
      v1 = scheme_chaperone_vector_ref(orig_vec1, i);
    if (SAME_OBJ(vec2, orig_vec2))
      v2 = SCHEME_VEC_ELS(vec2)[i];
    else
      v2 = scheme_chaperone_vector_ref(orig_vec2, i);

    if (!is_equal(v1, v2, eql))
      return 0;
  }

  return 1;
}

static Scheme_Object *define_values_jit(Scheme_Object *data)
{
  Scheme_Object *orig = SCHEME_VEC_ELS(data)[0], *naya;

  if (SAME_TYPE(SCHEME_TYPE(orig), scheme_unclosed_procedure_type)
      && (SCHEME_VEC_SIZE(data) == 2))
    naya = scheme_jit_closure(orig, SCHEME_VEC_ELS(data)[1]);
  else if (SAME_TYPE(SCHEME_TYPE(orig), scheme_inline_variant_type)
           && SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(orig)[0]), scheme_unclosed_procedure_type)
           && (SCHEME_VEC_SIZE(data) == 2)) {
    naya = scheme_jit_closure(SCHEME_VEC_ELS(orig)[0], SCHEME_VEC_ELS(data)[1]);
    if (!SAME_OBJ(naya, SCHEME_VEC_ELS(orig)[0]))
      naya = clone_inline_variant(orig, naya);
  } else
    naya = scheme_jit_expr(orig);

  if (SAME_OBJ(naya, orig))
    return data;
  else {
    orig = naya;
    naya = scheme_clone_vector(data, 0, 1);
    SCHEME_VEC_ELS(naya)[0] = orig;
    return naya;
  }
}

static Scheme_Object *
bad_index(char *name, const char *which, Scheme_Object *i, Scheme_Object *vec, int bottom)
{
    scheme_bad_vec_index(name, i, which, vec, bottom,
                         (SCHEME_NP_CHAPERONEP(vec)
                          ? SCHEME_VEC_SIZE(SCHEME_CHAPERONE_VAL(vec))
                          : SCHEME_VEC_SIZE(vec)));
    return NULL;
}

static Scheme_Object *vector_copy_bang(int argc, Scheme_Object *argv[])
{
    Scheme_Object *s1, *s2;
    intptr_t istart, ifinish;
    intptr_t ostart, ofinish;
    int slow = 0;

    s1 = argv[0];
    if (SCHEME_NP_CHAPERONEP(s1)) {
        slow = 1;
        s1 = SCHEME_CHAPERONE_VAL(s1);
    }
    if (!SCHEME_MUTABLE_VECTORP(s1))
        scheme_wrong_contract("vector-copy!", "(and/c vector? (not/c immutable?))", 0, argc, argv);

    scheme_do_get_substring_indices("vector-copy!", s1,
                                    argc, argv, 1, 5,
                                    &ostart, &ofinish, SCHEME_VEC_SIZE(s1));

    s2 = argv[2];
    if (SCHEME_NP_CHAPERONEP(s2)) {
        slow = 1;
        s2 = SCHEME_CHAPERONE_VAL(s2);
    }
    if (!SCHEME_VECTORP(s2))
        scheme_wrong_contract("vector-copy!", "vector?", 2, argc, argv);

    scheme_do_get_substring_indices("vector-copy!", s2,
                                    argc, argv, 3, 4,
                                    &istart, &ifinish, SCHEME_VEC_SIZE(s2));

    if ((ofinish - ostart) < (ifinish - istart)) {
        scheme_contract_error("vector-copy!",
                              "not enough room in target vector",
                              "target vector", 1, argv[2],
                              "starting index", 1, scheme_make_integer(ostart),
                              "element count", 1, scheme_make_integer(ofinish - ostart),
                              NULL);
        return NULL;
    }

    if (slow) {
        int i, o;
        for (i = istart, o = ostart; i < ifinish; i++, o++) {
            scheme_chaperone_vector_set(argv[0], o, scheme_chaperone_vector_ref(argv[2], i));
        }
    } else {
        memmove(SCHEME_VEC_ELS(s1) + ostart,
                SCHEME_VEC_ELS(s2) + istart,
                (ifinish - istart) * sizeof(Scheme_Object*));
    }

    return scheme_void;
}

static Scheme_Object *vector_copy_bang(int argc, Scheme_Object *argv[])
{
  Scheme_Object *s1, *s2;
  intptr_t istart, ifinish;
  intptr_t ostart, ofinish;
  int slow = 0;

  s1 = argv[0];
  if (SCHEME_NP_CHAPERONEP(s1)) {
    slow = 1;
    s1 = SCHEME_CHAPERONE_VAL(s1);
  }
  if (!SCHEME_MUTABLE_VECTORP(s1))
    scheme_wrong_type("vector-copy!", "mutable vector", 0, argc, argv);

  scheme_do_get_substring_indices("vector-copy!", s1, 
                                  argc, argv, 1, 5, 
                                  &ostart, &ofinish, SCHEME_VEC_SIZE(s1));

  s2 = argv[2];
  if (SCHEME_NP_CHAPERONEP(s2)) {
    slow = 1;
    s2 = SCHEME_CHAPERONE_VAL(s2);
  }
  if (!SCHEME_VECTORP(s2))
    scheme_wrong_type("vector-copy!", "vector", 2, argc, argv);

  scheme_do_get_substring_indices("vector-copy!", s2, 
                                  argc, argv, 3, 4, 
                                  &istart, &ifinish, SCHEME_VEC_SIZE(s2));

  if ((ofinish - ostart) < (ifinish - istart)) {
    scheme_arg_mismatch("vector-copy!",
			"not enough room in target vector: ",
			argv[2]);
    return NULL;
  }

  if (slow) {
    int i, o;
    for (i = istart, o = ostart; i < ifinish; i++, o++) {
      scheme_chaperone_vector_set(argv[0], o, scheme_chaperone_vector_ref(argv[2], i));
    }
  } else {
    memmove(SCHEME_VEC_ELS(s1) + ostart,
            SCHEME_VEC_ELS(s2) + istart,
            (ifinish - istart) * sizeof(Scheme_Object*));
  }
  
  return scheme_void;
}

Scheme_Object *
scheme_make_vector (intptr_t size, Scheme_Object *fill)
{
  Scheme_Object *vec;
  intptr_t i;

  if (size < 0) {
    vec = scheme_make_integer(size);
    scheme_wrong_type("make-vector", "non-negative exact integer", -1, 0, &vec);
  }

  if (size < 1024) {
    vec = (Scheme_Object *)scheme_malloc_tagged(VECTOR_BYTES(size));
  } else {
    vec = (Scheme_Object *)scheme_malloc_fail_ok(scheme_malloc_tagged, VECTOR_BYTES(size));
  }

  vec->type = scheme_vector_type;
  SCHEME_VEC_SIZE(vec) = size;

  if (fill) {
    for (i = 0; i < size; i++) {
      SCHEME_VEC_ELS(vec)[i] = fill;
    }
  }

  return vec;
}

Scheme_Object *
scheme_checked_vector_ref (int argc, Scheme_Object *argv[])
{
    intptr_t i, len;
    Scheme_Object *vec;

    vec = argv[0];
    if (SCHEME_CHAPERONEP(vec))
        vec = SCHEME_CHAPERONE_VAL(vec);

    if (!SCHEME_VECTORP(vec))
        scheme_wrong_contract("vector-ref", "vector?", 0, argc, argv);

    len = SCHEME_VEC_SIZE(vec);

    i = scheme_extract_index("vector-ref", 1, argc, argv, len, 0);

    if (i >= len)
        return bad_index("vector-ref", "", argv[1], argv[0], 0);

    if (!SAME_OBJ(vec, argv[0]))
        /* chaperone */
        return scheme_chaperone_vector_ref(argv[0], i);
    else
        return (SCHEME_VEC_ELS(vec))[i];
}

Scheme_Object *
scheme_checked_vector_set(int argc, Scheme_Object *argv[])
{
    Scheme_Object *vec = argv[0];
    intptr_t i, len;

    if (SCHEME_CHAPERONEP(vec))
        vec = SCHEME_CHAPERONE_VAL(vec);

    if (!SCHEME_MUTABLE_VECTORP(vec))
        scheme_wrong_contract("vector-set!", "(and/c vector? (not/c immutable?))", 0, argc, argv);

    len = SCHEME_VEC_SIZE(vec);

    i = scheme_extract_index("vector-set!", 1, argc, argv, len, 0);

    if (i >= len)
        return bad_index("vector-set!", "", argv[1], argv[0], 0);

    if (!SAME_OBJ(vec, argv[0]))
        scheme_chaperone_vector_set(argv[0], i, argv[2]);
    else
        SCHEME_VEC_ELS(vec)[i] = argv[2];

    return scheme_void;
}

static Scheme_Object *
vector_fill (int argc, Scheme_Object *argv[])
{
    int i, sz;
    Scheme_Object *v, *vec = argv[0];

    if (SCHEME_NP_CHAPERONEP(vec))
        vec = SCHEME_CHAPERONE_VAL(vec);

    if (!SCHEME_MUTABLE_VECTORP(vec))
        scheme_wrong_contract("vector-fill!", "(and/c vector? (not/c immutable?))", 0, argc, argv);

    v = argv[1];
    sz = SCHEME_VEC_SIZE(vec);
    if (SAME_OBJ(vec, argv[0])) {
        for (i = 0; i < sz; i++) {
            SCHEME_VEC_ELS(argv[0])[i] = v;
        }
    } else {
        for (i = 0; i < sz; i++) {
            scheme_chaperone_vector_set(argv[0], i, v);
        }
    }

    return scheme_void;
}

static Scheme_Object *unsafe_vector_star_len (int argc, Scheme_Object *argv[])
{
    Scheme_Object *vec = argv[0];
    intptr_t n;
    n = SCHEME_VEC_SIZE(vec);
    return scheme_make_integer(n);
}

Scheme_Object *
scheme_make_vector (intptr_t size, Scheme_Object *fill)
{
    Scheme_Object *vec;
    intptr_t i;

    if (size < 0) {
        vec = scheme_make_integer(size);
        scheme_wrong_contract("make-vector", "exact-nonnegative-integer?", -1, 0, &vec);
    }

    if (size < 1024) {
        vec = (Scheme_Object *)scheme_malloc_tagged(VECTOR_BYTES(size));
    } else {
        size_t sz;
        sz = VECTOR_BYTES(size);
        if (REV_VECTOR_BYTES(sz) != size)
            /* overflow */
            scheme_raise_out_of_memory(NULL, NULL);
        else
            vec = (Scheme_Object *)scheme_malloc_fail_ok(scheme_malloc_tagged, sz);
    }

    vec->type = scheme_vector_type;
    SCHEME_VEC_SIZE(vec) = size;

    if (fill) {
        for (i = 0; i < size; i++) {
            SCHEME_VEC_ELS(vec)[i] = fill;
        }
    }

    return vec;
}

Scheme_Object *
scheme_make_vector (int size, Scheme_Object *fill)
{
  Scheme_Object *vec;
  int i;

  if (size <= 0) {
    if (size) {
      vec = scheme_make_integer(size);
      scheme_wrong_type("make-vector", "non-negative exact integer", -1, 0, &vec);
    } else
      return zero_length_vector;
  }

  if (size < 1024) {
    vec = (Scheme_Object *)scheme_malloc_tagged(sizeof(Scheme_Vector) 
						+ (size - 1) * sizeof(Scheme_Object *));
  } else {
    vec = (Scheme_Object *)scheme_malloc_fail_ok(scheme_malloc_tagged,
						 sizeof(Scheme_Vector) 
						 + (size - 1) * sizeof(Scheme_Object *));
  }

  vec->type = scheme_vector_type;
  SCHEME_VEC_SIZE(vec) = size;

  if (fill) {
    for (i = 0; i < size; i++) {
      SCHEME_VEC_ELS(vec)[i] = fill;
    }
  }

  return vec;
}

static int vector_equal(Scheme_Object *vec1, Scheme_Object *vec2, Equal_Info *eql)
{
  intptr_t i, len;

  len = SCHEME_VEC_SIZE(vec1);
  if (len != SCHEME_VEC_SIZE(vec2))
    return 0;

  SCHEME_USE_FUEL(len);

  for (i = 0; i < len; i++) {
    if (!is_equal(SCHEME_VEC_ELS(vec1)[i], SCHEME_VEC_ELS(vec2)[i], eql))
      return 0;
  }

  return 1;
}

static Scheme_Object *
module_sfs(Scheme_Object *data, SFS_Info *old_info)
{
  Scheme_Module *m = (Scheme_Module *)data;
  Scheme_Object *e, *ex;
  SFS_Info *info;
  int i, j, cnt, let_depth;

  if (!old_info->for_mod) {
    if (old_info->pass)
      return data;

    info = scheme_new_sfs_info(m->max_let_depth);
    info->for_mod = 1;
    scheme_sfs(data, info, m->max_let_depth);
    return data;
  }

  info = old_info;

  cnt = SCHEME_VEC_SIZE(m->bodies[0]);
  scheme_sfs_start_sequence(info, cnt, 0);

  for (i = 0; i < cnt; i++) {
    e = scheme_sfs_expr(SCHEME_VEC_ELS(m->bodies[0])[i], info, -1);
    SCHEME_VEC_ELS(m->bodies[0])[i] = e;
  }

  if (!info->pass) {
    for (j = m->num_phases; j-- > 1; ) {
      cnt = SCHEME_VEC_SIZE(m->bodies[j]);
      for (i = 0; i < cnt; i++) {
        e = SCHEME_VEC_ELS(m->bodies[j])[i];
        
        let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
        ex = SCHEME_VEC_ELS(e)[1];
        
        info = scheme_new_sfs_info(let_depth);
        ex = scheme_sfs(ex, info, let_depth);
        SCHEME_VEC_ELS(e)[1] = ex;
      }
    }
  }

  return data;
}

static Scheme_Object *
vector_length (int argc, Scheme_Object *argv[])
{
  if (!SCHEME_VECTORP(argv[0]))
    scheme_wrong_type("vector-length", "vector", 0, argc, argv);

  return scheme_make_integer(SCHEME_VEC_SIZE(argv[0]));
}