int scheme_is_zero(const Scheme_Object *o) { Scheme_Type t; if (SCHEME_INTP(o)) return o == zeroi; t = _SCHEME_TYPE(o); #ifdef MZ_USE_SINGLE_FLOATS if (t == scheme_float_type) { # ifdef NAN_EQUALS_ANYTHING if (MZ_IS_NAN(SCHEME_FLT_VAL(o))) return 0; # endif return SCHEME_FLT_VAL(o) == 0.0f; } #endif if (t == scheme_double_type) { #ifdef NAN_EQUALS_ANYTHING if (MZ_IS_NAN(SCHEME_DBL_VAL(o))) return 0; #endif return SCHEME_DBL_VAL(o) == 0.0; } if (t == scheme_complex_type) { if (scheme_is_zero(scheme_complex_imaginary_part(o))) return scheme_is_zero(scheme_complex_real_part(o)); return 0; } if ((t >= scheme_bignum_type) && (t <= scheme_complex_type)) return 0; return -1; }
XFORM_NONGCING static int is_eqv(Scheme_Object *obj1, Scheme_Object *obj2) { Scheme_Type t1, t2; if (SAME_OBJ(obj1, obj2)) return 1; t1 = SCHEME_TYPE(obj1); t2 = SCHEME_TYPE(obj2); if (NOT_SAME_TYPE(t1, t2)) { #ifdef EQUATE_FLOATS_OF_DIFFERENT_PRECISIONS /* If one is a float and the other is a double, coerce to double */ if ((t1 == scheme_float_type) && (t2 == scheme_double_type)) return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_DBL_VAL(obj2)); else if ((t2 == scheme_float_type) && (t1 == scheme_double_type)) return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_FLT_VAL(obj2)); #endif return -1; } else { switch (t1) { #ifdef MZ_LONG_DOUBLE case scheme_long_double_type: return mz_long_double_eqv(SCHEME_LONG_DBL_VAL(obj1), SCHEME_LONG_DBL_VAL(obj2)); #endif #ifdef MZ_USE_SINGLE_FLOATS case scheme_float_type: return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_FLT_VAL(obj2)); #endif case scheme_double_type: return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_DBL_VAL(obj2)); case scheme_bignum_type: return scheme_bignum_eq(obj1, obj2); case scheme_rational_type: return scheme_rational_eq(obj1, obj2); case scheme_complex_type: { Scheme_Complex *c1 = (Scheme_Complex *)obj1; Scheme_Complex *c2 = (Scheme_Complex *)obj2; return scheme_eqv(c1->r, c2->r) && scheme_eqv(c1->i, c2->i); } case scheme_char_type: return SCHEME_CHAR_VAL(obj1) == SCHEME_CHAR_VAL(obj2); case scheme_symbol_type: case scheme_keyword_type: case scheme_scope_type: /* `eqv?` requires `eq?` */ return 0; default: return -1; } } }
/** * Convert a Scheme object to a GVariant that will serve as one of * the parameters of a call go g_dbus_proxy_call_.... Returns NULL * if it is unable to do the conversion. */ static GVariant * scheme_object_to_parameter (Scheme_Object *obj, gchar *type) { gchar *str; // A temporary string switch (type[0]) { // Arrays case 'a': return scheme_object_to_array (obj, type); // Doubles case 'd': if (SCHEME_DBLP (obj)) return g_variant_new ("d", SCHEME_DBL_VAL (obj)); else if (SCHEME_FLTP (obj)) return g_variant_new ("d", (double) SCHEME_FLT_VAL (obj)); else if (SCHEME_INTP (obj)) return g_variant_new ("d", (double) SCHEME_INT_VAL (obj)); else return NULL; // 32 bit integers case 'i': if (SCHEME_INTP (obj)) return g_variant_new ("i", (int) SCHEME_INT_VAL (obj)); else if (SCHEME_DBLP (obj)) return g_variant_new ("i", (int) SCHEME_DBL_VAL (obj)); else return NULL; // Strings case 's': str = scheme_object_to_string (obj); if (str == NULL) return NULL; return g_variant_new ("s", str); // 32 bit unsigned integers case 'u': if (SCHEME_INTP (obj)) return g_variant_new ("u", (unsigned int) SCHEME_INT_VAL (obj)); else return NULL; // Everything else is currently unsupported default: return NULL; } // switch } // scheme_object_to_parameter
Scheme_Object * scheme_abs(int argc, Scheme_Object *argv[]) { Scheme_Type t; Scheme_Object *o; o = argv[0]; if (SCHEME_INTP(o)) { intptr_t n = SCHEME_INT_VAL(o); return scheme_make_integer_value(ABS(n)); } t = _SCHEME_TYPE(o); #ifdef MZ_USE_SINGLE_FLOATS if (t == scheme_float_type) return scheme_make_float(fabs(SCHEME_FLT_VAL(o))); #endif if (t == scheme_double_type) return scheme_make_double(fabs(SCHEME_DBL_VAL(o))); if (t == scheme_bignum_type) { if (SCHEME_BIGPOS(o)) return o; return scheme_bignum_negate(o); } if (t == scheme_rational_type) { if (scheme_is_rational_positive(o)) return o; else return scheme_rational_negate(o); } NEED_REAL(abs); ESCAPED_BEFORE_HERE; }
static Scheme_Object * minus (int argc, Scheme_Object *argv[]) { Scheme_Object *ret, *v; ret = argv[0]; if (!SCHEME_NUMBERP(ret)) { scheme_wrong_contract("-", "number?", 0, argc, argv); ESCAPED_BEFORE_HERE; } if (argc == 1) { if (SCHEME_FLOATP(ret)) { #ifdef MZ_USE_SINGLE_FLOATS if (SCHEME_FLTP(ret)) return scheme_make_float(-SCHEME_FLT_VAL(ret)); #endif return scheme_make_double(-SCHEME_DBL_VAL(ret)); } return scheme_bin_minus(zeroi, ret); } if (argc == 2) { v = argv[1]; if (!SCHEME_NUMBERP(v)) { scheme_wrong_contract("-", "number?", 1, argc, argv); ESCAPED_BEFORE_HERE; } return scheme_bin_minus(ret, v); } return minus_slow(ret, argc, argv); }
Scheme_Object * scheme_sub1 (int argc, Scheme_Object *argv[]) { Scheme_Type t; Scheme_Object *o = argv[0]; if (SCHEME_INTP(o)) { intptr_t v; v = SCHEME_INT_VAL(o); if (v > -(0x3FFFFFFF)) return scheme_make_integer(SCHEME_INT_VAL(o) - 1); else { Small_Bignum b; return scheme_bignum_sub1(scheme_make_small_bignum(v, &b)); } } t = _SCHEME_TYPE(o); #ifdef MZ_USE_SINGLE_FLOATS if (t == scheme_float_type) return scheme_make_float(SCHEME_FLT_VAL(o) - 1.0f); #endif if (t == scheme_double_type) return scheme_make_double(SCHEME_DBL_VAL(o) - 1.0); if (t == scheme_bignum_type) return scheme_bignum_sub1(o); if (t == scheme_rational_type) return scheme_rational_sub1(o); if (t == scheme_complex_type) return scheme_complex_sub1(o); NEED_NUMBER(sub1); ESCAPED_BEFORE_HERE; }
XFORM_NONGCING static int is_eqv(Scheme_Object *obj1, Scheme_Object *obj2) { Scheme_Type t1, t2; if (SAME_OBJ(obj1, obj2)) return 1; t1 = SCHEME_TYPE(obj1); t2 = SCHEME_TYPE(obj2); if (NOT_SAME_TYPE(t1, t2)) { #ifdef EQUATE_FLOATS_OF_DIFFERENT_PRECISIONS /* If one is a float and the other is a double, coerce to double */ if ((t1 == scheme_float_type) && (t2 == scheme_double_type)) return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_DBL_VAL(obj2)); else if ((t2 == scheme_float_type) && (t1 == scheme_double_type)) return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_FLT_VAL(obj2)); #endif return -1; #ifdef MZ_LONG_DOUBLE } else if (t1 == scheme_long_double_type) { return long_double_eqv(SCHEME_LONG_DBL_VAL(obj1), SCHEME_LONG_DBL_VAL(obj2)); #endif #ifdef MZ_USE_SINGLE_FLOATS } else if (t1 == scheme_float_type) { return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_FLT_VAL(obj2)); #endif } else if (t1 == scheme_double_type) { return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_DBL_VAL(obj2)); } else if (t1 == scheme_bignum_type) return scheme_bignum_eq(obj1, obj2); else if (t1 == scheme_rational_type) return scheme_rational_eq(obj1, obj2); else if (t1 == scheme_complex_type) { Scheme_Complex *c1 = (Scheme_Complex *)obj1; Scheme_Complex *c2 = (Scheme_Complex *)obj2; return scheme_eqv(c1->r, c2->r) && scheme_eqv(c1->i, c2->i); } else if (t1 == scheme_char_type) return SCHEME_CHAR_VAL(obj1) == SCHEME_CHAR_VAL(obj2); else return -1; }
static Scheme_Object * rem_mod (int argc, Scheme_Object *argv[], char *name, int first_sign) { Scheme_Object *n1, *n2, *r; int negate; n1 = argv[0]; n2 = argv[1]; if (!scheme_is_integer(n1)) scheme_wrong_contract(name, "integer?", 0, argc, argv); if (!scheme_is_integer(n2)) scheme_wrong_contract(name, "integer?", 1, argc, argv); if (SCHEME_INTP(n2) && !SCHEME_INT_VAL(n2)) scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO, "%s: undefined for 0", name); if ( #ifdef MZ_USE_SINGLE_FLOATS (SCHEME_FLTP(n2) && (SCHEME_FLT_VAL(n2) == 0.0f)) || #endif (SCHEME_DBLP(n2) && (SCHEME_DBL_VAL(n2) == 0.0))) { int neg; neg = scheme_minus_zero_p(SCHEME_FLOAT_VAL(n2)); scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO, "%s: undefined for %s0.0", name, neg ? "-" : ""); } if (SCHEME_INTP(n1) && !SCHEME_INT_VAL(n1)) return zeroi; if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) { intptr_t a, b, na, nb, v; int neg1, neg2; a = SCHEME_INT_VAL(n1); b = SCHEME_INT_VAL(n2); na = (a < 0) ? -a : a; nb = (b < 0) ? -b : b; v = na % nb; if (v) { if (first_sign) { if (a < 0) v = -v; } else { neg1 = (a < 0); neg2 = (b < 0); if (neg1 != neg2) v = nb - v; if (neg2) v = -v; } } return scheme_make_integer(v); } if (SCHEME_FLOATP(n1) || SCHEME_FLOATP(n2)) { double a, b, na, nb, v; #ifdef MZ_USE_SINGLE_FLOATS int was_single = !(SCHEME_DBLP(n1) || SCHEME_DBLP(n2)); #endif if (SCHEME_INTP(n1)) a = SCHEME_INT_VAL(n1); #ifdef MZ_USE_SINGLE_FLOATS else if (SCHEME_FLTP(n1)) a = SCHEME_FLT_VAL(n1); #endif else if (SCHEME_DBLP(n1)) a = SCHEME_DBL_VAL(n1); else a = scheme_bignum_to_double(n1); if (SCHEME_INTP(n2)) b = SCHEME_INT_VAL(n2); #ifdef MZ_USE_SINGLE_FLOATS else if (SCHEME_FLTP(n2)) b = SCHEME_FLT_VAL(n2); #endif else if (SCHEME_DBLP(n2)) b = SCHEME_DBL_VAL(n2); else b = scheme_bignum_to_double(n2); if (a == 0.0) { /* Avoid sign problems. */ #ifdef MZ_USE_SINGLE_FLOATS if (was_single) return scheme_zerof; #endif return scheme_zerod; } na = (a < 0) ? -a : a; nb = (b < 0) ? -b : b; if (MZ_IS_POS_INFINITY(nb)) v = na; else if (MZ_IS_POS_INFINITY(na)) { #ifdef MZ_USE_SINGLE_FLOATS if (was_single) return scheme_zerof; #endif return scheme_zerod; } else { v = fmod(na, nb); #ifdef FMOD_CAN_RETURN_NEG_ZERO if (v == 0.0) v = 0.0; #endif } if (v) { if (first_sign) { /* remainder */ if (a < 0) v = -v; } else { /* modulo */ int neg1, neg2; neg1 = (a < 0); neg2 = (b < 0); if (neg1 != neg2) v = nb - v; if (neg2) v = -v; } } #ifdef MZ_USE_SINGLE_FLOATS if (was_single) return scheme_make_float((float)v); #endif return scheme_make_double(v); } n1 = scheme_to_bignum(n1); n2 = scheme_to_bignum(n2); scheme_bignum_divide(n1, n2, NULL, &r, 1); negate = 0; if (!SCHEME_INTP(r) || SCHEME_INT_VAL(r)) { /* Easier if we can assume 'r' is positive: */ if (SCHEME_INTP(r)) { if (SCHEME_INT_VAL(r) < 0) r = scheme_make_integer(-SCHEME_INT_VAL(r)); } else if (!SCHEME_BIGPOS(r)) r = scheme_bignum_negate(r); if (first_sign) { if (!SCHEME_BIGPOS(n1)) negate = 1; } else { int neg1, neg2; neg1 = !SCHEME_BIGPOS(n1); neg2 = !SCHEME_BIGPOS(n2); if (neg1 != neg2) { if (neg2) r = scheme_bin_plus(n2, r); else r = scheme_bin_minus(n2, r); } else if (neg2) negate = 1; } if (negate) { if (SCHEME_INTP(r)) r = scheme_make_integer(-SCHEME_INT_VAL(r)); else r = scheme_bignum_negate(r); } } return r; }
Scheme_Object * do_bin_quotient(const char *name, const Scheme_Object *n1, const Scheme_Object *n2, Scheme_Object **bn_rem) { Scheme_Object *q; if (!scheme_is_integer(n1)) { Scheme_Object *a[2]; a[0] = (Scheme_Object *)n1; a[1] = (Scheme_Object *)n2; scheme_wrong_contract(name, "integer?", 0, 2, a); } if (!scheme_is_integer(n2)) { Scheme_Object *a[2]; a[0] = (Scheme_Object *)n1; a[1] = (Scheme_Object *)n2; scheme_wrong_contract(name, "integer?", 1, 2, a); } if (SCHEME_INTP(n2) && !SCHEME_INT_VAL(n2)) scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO, "%s: undefined for 0", name); if ( #ifdef MZ_USE_SINGLE_FLOATS (SCHEME_FLTP(n2) && (SCHEME_FLT_VAL(n2) == 0.0f)) || #endif (SCHEME_DBLP(n2) && (SCHEME_DBL_VAL(n2) == 0.0))) scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO, "%s: undefined for 0.0", name); if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) { /* Beware that most negative fixnum divided by -1 isn't a fixnum: */ return (scheme_make_integer_value(SCHEME_INT_VAL(n1) / SCHEME_INT_VAL(n2))); } if (SCHEME_DBLP(n1) || SCHEME_DBLP(n2)) { Scheme_Object *r; double d, d2; r = scheme_bin_div(n1, n2); /* could be exact 0 ... */ if (SCHEME_DBLP(r)) { d = SCHEME_DBL_VAL(r); if (d > 0) d2 = floor(d); else d2 = ceil(d); if (d2 == d) return r; else return scheme_make_double(d2); } else return r; } #ifdef MZ_USE_SINGLE_FLOATS if (SCHEME_FLTP(n1) || SCHEME_FLTP(n2)) { Scheme_Object *r; float d, d2; r = scheme_bin_div(n1, n2); /* could be exact 0 ... */ if (SCHEME_FLTP(r)) { d = SCHEME_FLT_VAL(r); if (d > 0) d2 = floor(d); else d2 = ceil(d); if (d2 == d) return r; else return scheme_make_float(d2); } else return r; } #endif #if 0 /* I'm pretty sure this isn't needed, but I'm keeping the code just in case... 03/19/2000 */ if (SCHEME_RATIONALP(n1)) wrong_contract(name, "integer?", n1); if (SCHEME_RATIONALP(n2)) wrong_contract(name, "integer?", n2); #endif n1 = scheme_to_bignum(n1); n2 = scheme_to_bignum(n2); scheme_bignum_divide(n1, n2, &q, bn_rem, 1); return q; }
static Scheme_Object *pos_sqrt(int argc, Scheme_Object **argv) { if (SCHEME_DBLP(argv[0]) && (SCHEME_DBL_VAL(argv[0]) < 0.0)) return scheme_nan_object; return scheme_sqrt(argc, argv); }
/** * Convert a Scheme object to a GVariant that will serve as one of * the parameters of a call go g_dbus_proxy_call_.... Returns NULL * if it is unable to do the conversion. */ static GVariant * scheme_object_to_parameter (Scheme_Object *obj, gchar *type) { gchar *str; // A temporary string // Special case: Array of bytes if (g_strcmp0 (type, "ay") == 0) { if (SCHEME_BYTE_STRINGP (obj)) { return g_variant_new_fixed_array (G_VARIANT_TYPE_BYTE, SCHEME_BYTE_STR_VAL (obj), SCHEME_BYTE_STRLEN_VAL (obj), sizeof (guchar)); } // if it's a byte string } // array of bytes // Handle normal cases switch (type[0]) { // Arrays case 'a': return scheme_object_to_array (obj, type); // Doubles case 'd': if (SCHEME_DBLP (obj)) return g_variant_new ("d", SCHEME_DBL_VAL (obj)); else if (SCHEME_FLTP (obj)) return g_variant_new ("d", (double) SCHEME_FLT_VAL (obj)); else if (SCHEME_INTP (obj)) return g_variant_new ("d", (double) SCHEME_INT_VAL (obj)); else if (SCHEME_RATIONALP (obj)) return g_variant_new ("d", (double) scheme_rational_to_double (obj)); else return NULL; // 32 bit integers case 'i': if (SCHEME_INTP (obj)) return g_variant_new ("i", (int) SCHEME_INT_VAL (obj)); else if (SCHEME_DBLP (obj)) return g_variant_new ("i", (int) SCHEME_DBL_VAL (obj)); else if (SCHEME_FLTP (obj)) return g_variant_new ("i", (int) SCHEME_FLT_VAL (obj)); else if (SCHEME_RATIONALP (obj)) return g_variant_new ("i", (int) scheme_rational_to_double (obj)); else return NULL; // Strings case 's': str = scheme_object_to_string (obj); if (str == NULL) return NULL; return g_variant_new ("s", str); // 32 bit unsigned integers case 'u': if (SCHEME_INTP (obj)) return g_variant_new ("u", (unsigned int) SCHEME_INT_VAL (obj)); else return NULL; // Everything else is currently unsupported default: return NULL; } // switch } // scheme_object_to_parameter
Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht) { Scheme_Object *new_so = so; if (SCHEME_INTP(so)) { return so; } if (ht) { Scheme_Object *r; if ((r = scheme_hash_get(ht, so))) { return r; } } switch (so->type) { case scheme_true_type: case scheme_false_type: case scheme_null_type: case scheme_void_type: /* place_bi_channels are allocated in the master and can be passed along as is */ case scheme_place_bi_channel_type: new_so = so; break; case scheme_place_type: new_so = ((Scheme_Place *) so)->channel; break; case scheme_char_type: new_so = scheme_make_char(SCHEME_CHAR_VAL(so)); break; case scheme_rational_type: { Scheme_Object *n; Scheme_Object *d; n = scheme_rational_numerator(so); d = scheme_rational_denominator(so); n = scheme_places_deep_copy_worker(n, ht); d = scheme_places_deep_copy_worker(d, ht); new_so = scheme_make_rational(n, d); } break; case scheme_float_type: new_so = scheme_make_float(SCHEME_FLT_VAL(so)); break; case scheme_double_type: new_so = scheme_make_double(SCHEME_DBL_VAL(so)); break; case scheme_complex_type: { Scheme_Object *r; Scheme_Object *i; r = scheme_complex_real_part(so); i = scheme_complex_imaginary_part(so); r = scheme_places_deep_copy_worker(r, ht); i = scheme_places_deep_copy_worker(i, ht); new_so = scheme_make_complex(r, i); } break; case scheme_char_string_type: new_so = scheme_make_sized_offset_char_string(SCHEME_CHAR_STR_VAL(so), 0, SCHEME_CHAR_STRLEN_VAL(so), 1); break; case scheme_byte_string_type: if (SHARED_ALLOCATEDP(so)) { new_so = so; } else { new_so = scheme_make_sized_offset_byte_string(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1); } break; case scheme_unix_path_type: new_so = scheme_make_sized_offset_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1); break; case scheme_symbol_type: if (SCHEME_SYM_UNINTERNEDP(so)) { scheme_log_abort("cannot copy uninterned symbol"); abort(); } else { new_so = scheme_make_sized_offset_byte_string(SCHEME_SYM_VAL(so), 0, SCHEME_SYM_LEN(so), 1); new_so->type = scheme_serialized_symbol_type; } break; case scheme_serialized_symbol_type: new_so = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so)); break; case scheme_pair_type: { Scheme_Object *car; Scheme_Object *cdr; Scheme_Object *pair; car = scheme_places_deep_copy_worker(SCHEME_CAR(so), ht); cdr = scheme_places_deep_copy_worker(SCHEME_CDR(so), ht); pair = scheme_make_pair(car, cdr); new_so = pair; } break; case scheme_vector_type: { Scheme_Object *vec; intptr_t i; intptr_t size = SCHEME_VEC_SIZE(so); vec = scheme_make_vector(size, 0); for (i = 0; i <size ; i++) { Scheme_Object *tmp; tmp = scheme_places_deep_copy_worker(SCHEME_VEC_ELS(so)[i], ht); SCHEME_VEC_ELS(vec)[i] = tmp; } SCHEME_SET_IMMUTABLE(vec); new_so = vec; } break; case scheme_fxvector_type: if (SHARED_ALLOCATEDP(so)) { new_so = so; } else { Scheme_Vector *vec; intptr_t i; intptr_t size = SCHEME_FXVEC_SIZE(so); vec = scheme_alloc_fxvector(size); for (i = 0; i < size; i++) { SCHEME_FXVEC_ELS(vec)[i] = SCHEME_FXVEC_ELS(so)[i]; } new_so = (Scheme_Object *) vec; } break; case scheme_flvector_type: if (SHARED_ALLOCATEDP(so)) { new_so = so; } else { Scheme_Double_Vector *vec; intptr_t i; intptr_t size = SCHEME_FLVEC_SIZE(so); vec = scheme_alloc_flvector(size); for (i = 0; i < size; i++) { SCHEME_FLVEC_ELS(vec)[i] = SCHEME_FLVEC_ELS(so)[i]; } new_so = (Scheme_Object *) vec; } break; case scheme_structure_type: { Scheme_Structure *st = (Scheme_Structure*)so; Scheme_Serialized_Structure *nst; Scheme_Struct_Type *stype = st->stype; Scheme_Struct_Type *ptype = stype->parent_types[stype->name_pos - 1]; Scheme_Object *nprefab_key; intptr_t size = stype->num_slots; int local_slots = stype->num_slots - (ptype ? ptype->num_slots : 0); int i = 0; if (!stype->prefab_key) { scheme_log_abort("cannot copy non prefab structure"); abort(); } { for (i = 0; i < local_slots; i++) { if (!stype->immutables || stype->immutables[i] != 1) { scheme_log_abort("cannot copy mutable prefab structure"); abort(); } } } nprefab_key = scheme_places_deep_copy_worker(stype->prefab_key, ht); nst = (Scheme_Serialized_Structure*) scheme_make_serialized_struct_instance(nprefab_key, size); for (i = 0; i <size ; i++) { Scheme_Object *tmp; tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht); nst->slots[i] = tmp; } new_so = (Scheme_Object*) nst; } break; case scheme_serialized_structure_type: { Scheme_Serialized_Structure *st = (Scheme_Serialized_Structure*)so; Scheme_Struct_Type *stype; Scheme_Structure *nst; intptr_t size; int i = 0; size = st->num_slots; stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size); nst = (Scheme_Structure*) scheme_make_blank_prefab_struct_instance(stype); for (i = 0; i <size ; i++) { Scheme_Object *tmp; tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht); nst->slots[i] = tmp; } new_so = (Scheme_Object*)nst; } break; case scheme_resolved_module_path_type: default: printf("places deep copy cannot copy object of type %hi at %p\n", so->type, so); scheme_log_abort("places deep copy cannot copy object"); abort(); break; } if (ht) { scheme_hash_set(ht, so, new_so); } return new_so; }