static Scheme_Object *vector_to_immutable (int argc, Scheme_Object *argv[])
{
Scheme_Object *vec, *ovec, *v;
intptr_t len, i;
vec = argv[0];
if (SCHEME_NP_CHAPERONEP(vec))
vec = SCHEME_CHAPERONE_VAL(vec);
if (!SCHEME_VECTORP(vec))
scheme_wrong_contract("vector->immutable-vector", "vector?", 0, argc, argv);
if (SCHEME_IMMUTABLEP(vec))
return argv[0];
ovec = vec;
len = SCHEME_VEC_SIZE(ovec);
vec = scheme_make_vector(len, NULL);
if (!SAME_OBJ(ovec, argv[0])) {
for (i = 0; i < len; i++) {
v = scheme_chaperone_vector_ref(argv[0], i);
SCHEME_VEC_ELS(vec)[i] = v;
}
} else {
for (i = 0; i < len; i++) {
SCHEME_VEC_ELS(vec)[i] = SCHEME_VEC_ELS(ovec)[i];
}
}
SCHEME_SET_IMMUTABLE(vec);
return vec;
}
static Scheme_Object *define_values_jit(Scheme_Object *data)
{
Scheme_Object *orig = SCHEME_DEFN_RHS(data), *naya;
if (SAME_TYPE(SCHEME_TYPE(orig), scheme_lambda_type)
&& (SCHEME_DEFN_VAR_COUNT(data) == 1))
naya = scheme_jit_closure(orig, SCHEME_DEFN_VAR_(data, 0));
else if (SAME_TYPE(SCHEME_TYPE(orig), scheme_inline_variant_type)
&& SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(orig)[0]), scheme_lambda_type)
&& (SCHEME_DEFN_VAR_COUNT(data) == 1)) {
naya = scheme_jit_closure(SCHEME_VEC_ELS(orig)[0], SCHEME_DEFN_VAR_(data, 0));
if (!SAME_OBJ(naya, SCHEME_DEFN_RHS(orig)))
naya = clone_inline_variant(orig, naya);
} else
naya = jit_expr(orig);
if (SAME_OBJ(naya, orig))
return data;
else {
orig = naya;
naya = scheme_clone_vector(data, 0, 1);
SCHEME_DEFN_RHS(naya) = orig;
return naya;
}
}
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 *apply_impersonator_of(int for_chaperone, Scheme_Object *procs, Scheme_Object *obj)
{
Scheme_Object *a[1], *v, *oprocs;
a[0] = obj;
v = _scheme_apply(SCHEME_CDR(procs), 1, a);
if (SCHEME_FALSEP(v))
return NULL;
oprocs = scheme_struct_type_property_ref(scheme_impersonator_of_property, v);
if (!oprocs || !SAME_OBJ(SCHEME_CAR(oprocs), SCHEME_CAR(procs)))
scheme_contract_error((for_chaperone ? "impersonator-of?" : "equal?"),
"impersonator-of property procedure returned a value with a different prop:impersonator-of source",
"original value", 1, obj,
"returned value", 1, v,
NULL);
procs = scheme_struct_type_property_ref(scheme_equal_property, obj);
oprocs = scheme_struct_type_property_ref(scheme_equal_property, v);
if (procs || oprocs)
if (!procs || !oprocs || !SAME_OBJ(SCHEME_VEC_ELS(oprocs)[0],
SCHEME_VEC_ELS(procs)[0]))
scheme_contract_error((for_chaperone ? "impersonator-of?" : "equal?"),
"impersonator-of property procedure returned a value with a different prop:equal+hash source",
"original value", 1, obj,
"returned value", 1, v,
NULL);
return v;
}
static Scheme_Object *
define_values_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *e;
scheme_sfs_start_sequence(info, 1, 0);
e = scheme_sfs_expr(SCHEME_VEC_ELS(data)[0], info, -1);
SCHEME_VEC_ELS(data)[0] = e;
return data;
}
static Scheme_Object *clone_inline_variant(Scheme_Object *obj, Scheme_Object *naya)
{
Scheme_Object *naya2;
naya2 = scheme_make_vector(3, scheme_false);
naya2->type = scheme_inline_variant_type;
SCHEME_VEC_ELS(naya2)[0] = naya;
SCHEME_VEC_ELS(naya2)[1] = SCHEME_VEC_ELS(obj)[1];
return naya2;
}
static Scheme_Object *
inline_variant_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *e;
scheme_sfs_start_sequence(info, 1, 0);
e = scheme_sfs_expr(SCHEME_VEC_ELS(data)[0], info, -1);
SCHEME_VEC_ELS(data)[0] = e;
/* we don't bother with inlinable variant, since it isn't called directly */
return data;
}
static Scheme_Object *write_define_values(Scheme_Object *obj)
{
Scheme_Object *e;
obj = scheme_clone_vector(obj, 0, 0);
e = scheme_protect_quote(SCHEME_VEC_ELS(obj)[0]);
SCHEME_VEC_ELS(obj)[0] = e;
return obj;
}
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_to_values (int argc, Scheme_Object *argv[])
{
Scheme_Thread *p;
Scheme_Object *vec, **a;
long len, start, finish, i;
vec = argv[0];
if (!SCHEME_VECTORP(vec))
scheme_wrong_type("vector->values", "vector", 0, argc, argv);
len = SCHEME_VEC_SIZE(vec);
if (argc > 1)
start = scheme_extract_index("vector->values", 1, argc, argv, len + 1, 0);
else
start = 0;
if (argc > 2)
finish = scheme_extract_index("vector->values", 2, argc, argv, len + 1, 0);
else
finish = len;
if (!(start <= len)) {
bad_index("vector->values", argv[1], vec, 0);
}
if (!(finish >= start && finish <= len)) {
bad_index("vector->values", argv[2], vec, start);
}
len = finish - start;
if (len == 1)
return SCHEME_VEC_ELS(vec)[start];
p = scheme_current_thread;
if (p->values_buffer && (p->values_buffer_size >= len))
a = p->values_buffer;
else {
a = MALLOC_N(Scheme_Object *, len);
p->values_buffer = a;
p->values_buffer_size = len;
}
p->ku.multiple.array = a;
p->ku.multiple.count = len;
for (i = 0; i < len; i++) {
a[i] = SCHEME_VEC_ELS(vec)[start + i];
}
return SCHEME_MULTIPLE_VALUES;
}
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;
}
static Scheme_Object *do_define_syntaxes_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *e;
if (!info->pass) {
int depth;
depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(data)[2]);
info = scheme_new_sfs_info(depth);
e = scheme_sfs(SCHEME_VEC_ELS(data)[0], info, depth);
SCHEME_VEC_ELS(data)[0] = e;
}
return data;
}
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_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;
}
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;
}
static Scheme_Object *unsafe_vector_ref (int argc, Scheme_Object *argv[])
{
if (SCHEME_NP_CHAPERONEP(argv[0]))
return scheme_chaperone_vector_ref(argv[0], SCHEME_INT_VAL(argv[1]));
else
return SCHEME_VEC_ELS(argv[0])[SCHEME_INT_VAL(argv[1])];
}
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;
}
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_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;
}
Scheme_Object *scheme_chaperone_vector_ref(Scheme_Object *o, int i)
{
if (!SCHEME_NP_CHAPERONEP(o)) {
return SCHEME_VEC_ELS(o)[i];
} else {
Scheme_Chaperone *px = (Scheme_Chaperone *)o;
Scheme_Object *a[3], *red, *orig;
#ifdef DO_STACK_CHECK
{
# include "mzstkchk.h"
return chaperone_vector_ref_overflow(o, i);
}
#endif
orig = scheme_chaperone_vector_ref(px->prev, i);
if (SCHEME_VECTORP(px->redirects)) {
/* chaperone was on property accessors */
return orig;
}
a[0] = px->prev;
a[1] = scheme_make_integer(i);
a[2] = orig;
red = SCHEME_CAR(px->redirects);
o = _scheme_apply(red, 3, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(o, orig))
scheme_wrong_chaperoned("vector-ref", "result", orig, o);
return o;
}
}
Scheme_Object *scheme_jit_make_two_element_vector(Scheme_Object *a, Scheme_Object *b)
{
Scheme_Object *vec;
vec = scheme_make_vector(2, a);
SCHEME_VEC_ELS(vec)[1] = b;
return vec;
}
void scheme_chaperone_vector_set(Scheme_Object *o, int i, Scheme_Object *v)
{
while (1) {
if (!SCHEME_NP_CHAPERONEP(o)) {
SCHEME_VEC_ELS(o)[i] = v;
return;
} else {
Scheme_Chaperone *px = (Scheme_Chaperone *)o;
Scheme_Object *a[3], *red;
o = px->prev;
a[0] = o;
a[1] = scheme_make_integer(i);
a[2] = v;
red = SCHEME_CDR(px->redirects);
v = _scheme_apply(red, 3, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
if (!scheme_chaperone_of(v, a[2]))
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"vector-set!: chaperone produced a result: %V that is not a chaperone of the original result: %V",
v,
a[2]);
}
}
}
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;
}
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 *unsafe_vector_set (int argc, Scheme_Object *argv[])
{
if (SCHEME_NP_CHAPERONEP(argv[0]))
scheme_chaperone_vector_set(argv[0], SCHEME_INT_VAL(argv[1]), argv[2]);
else
SCHEME_VEC_ELS(argv[0])[SCHEME_INT_VAL(argv[1])] = argv[2];
return scheme_void;
}
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 void sfs_restore_one_branch(SFS_Info *info, int ip,
Scheme_Object *vec, int delta)
{
int t_min_t, t_cnt, i;
Scheme_Object *t_vec;
t_vec = SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 1];
if (SCHEME_FALSEP(t_vec)) return;
t_min_t = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[delta * SFS_BRANCH_W]);
t_cnt = SCHEME_VEC_SIZE(t_vec);
for (i = 0; i < t_cnt; i++) {
if (SCHEME_TRUEP(SCHEME_VEC_ELS(t_vec)[i]))
info->max_used[i + t_min_t] = ip;
}
}
static Scheme_Object *begin_for_syntax_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *l, *a;
if (!info->pass) {
int depth;
depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(data)[2]);
for (l = SCHEME_VEC_ELS(data)[0]; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
a = SCHEME_CAR(l);
info = scheme_new_sfs_info(depth);
a = scheme_sfs(a, info, depth);
SCHEME_CAR(l) = a;
}
}
return data;
}
Scheme_Linklet *scheme_jit_linklet(Scheme_Linklet *linklet, int step)
/* step 1: clone the immediate record, to be mutated for actual prepataion
step 2: actual preparation */
{
Scheme_Linklet *new_linklet;
Scheme_Object *bodies, *v;
int i;
if (force_jit)
step = 2;
if (!linklet->jit_ready) {
new_linklet = MALLOC_ONE_TAGGED(Scheme_Linklet);
memcpy(new_linklet, linklet, sizeof(Scheme_Linklet));
} else
new_linklet = linklet;
if (new_linklet->jit_ready >= step)
return new_linklet;
if (step == 1) {
new_linklet->jit_ready = 1;
return new_linklet;
}
if (force_jit)
current_linklet_native_lambdas = scheme_null;
i = SCHEME_VEC_SIZE(linklet->bodies);
bodies = scheme_make_vector(i, NULL);
while (i--) {
v = jit_expr(SCHEME_VEC_ELS(linklet->bodies)[i]);
SCHEME_VEC_ELS(bodies)[i] = v;
}
new_linklet->bodies = bodies;
new_linklet->jit_ready = 2;
new_linklet->native_lambdas = current_linklet_native_lambdas;
current_linklet_native_lambdas = NULL;
return new_linklet;
}
static Scheme_Object *do_define_syntaxes_clone(Scheme_Object *expr, int jit)
{
Resolve_Prefix *rp, *orig_rp;
Scheme_Object *naya, *rhs;
rhs = SCHEME_VEC_ELS(expr)[0];
#ifdef MZ_USE_JIT
if (jit) {
if (SAME_TYPE(SCHEME_TYPE(expr), scheme_define_syntaxes_type))
naya = scheme_jit_expr(rhs);
else {
int changed = 0;
Scheme_Object *a, *l = rhs;
naya = scheme_null;
while (!SCHEME_NULLP(l)) {
a = scheme_jit_expr(SCHEME_CAR(l));
if (!SAME_OBJ(a, SCHEME_CAR(l)))
changed = 1;
naya = scheme_make_pair(a, naya);
l = SCHEME_CDR(l);
}
if (changed)
naya = scheme_reverse(naya);
else
naya = rhs;
}
} else
#endif
naya = rhs;
orig_rp = (Resolve_Prefix *)SCHEME_VEC_ELS(expr)[1];
rp = scheme_prefix_eval_clone(orig_rp);
if (SAME_OBJ(naya, rhs)
&& SAME_OBJ(orig_rp, rp))
return expr;
else {
expr = scheme_clone_vector(expr, 0, 1);
SCHEME_VEC_ELS(expr)[0] = naya;
SCHEME_VEC_ELS(expr)[1] = (Scheme_Object *)rp;
return expr;
}
}
