Exemplo n.º 1
0
Scheme_Object *scheme_make_char_or_nul(mzchar v)
{
  if ((v <= 0x10FFFF)
      && ((v < 0xD800) || (v > 0xDFFF)))
    return scheme_make_char(v);

  return scheme_char_constants[0];
}
Exemplo n.º 2
0
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;
}