places: clean up bad-message reporting, simplify some code

src/racket/src/places.c

@@ -38,7 +38,7 @@ static Scheme_Object *scheme_places_deep_copy_to_master(Scheme_Object *so);
 /* Scheme_Object *scheme_places_deep_copy(Scheme_Object *so); */
 
 #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
-static Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht);
+static Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table **ht);
 #endif
 
 # ifdef MZ_PRECISE_GC
@@ -763,58 +763,58 @@ static Scheme_Object *scheme_place_p(int argc, Scheme_Object *args[])
 
 Scheme_Object *scheme_places_deep_copy(Scheme_Object *so) {
 #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
-  Scheme_Object *new_so = so;
+  Scheme_Hash_Table *ht = NULL;
-  if (SCHEME_INTP(so)) {
+  return scheme_places_deep_copy_worker(so, &ht);
-    return so;
-  }
-
-  switch (so->type) {
-    case scheme_pair_type:
-    case scheme_vector_type:
-    case scheme_struct_type_type:
-    case scheme_structure_type:
-      {
-        Scheme_Hash_Table *ht;
-        ht = scheme_make_hash_table(SCHEME_hash_ptr);
-        new_so = scheme_places_deep_copy_worker(so, ht);
-      }
-      break;
-    default:
-      new_so = scheme_places_deep_copy_worker(so, NULL);
-      break;
-  }
-  return new_so;
 #else
   return so;
 #endif
 }
 
-#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
+static void bad_place_message(Scheme_Object *so) {
-Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht)
+  scheme_arg_mismatch("place-channel-send", 
-{
+                      "cannot transmit a message containing value: ", 
-  Scheme_Object *new_so = 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) {
+static Scheme_Object *trivial_copy(Scheme_Object *so)
+{
+  switch (SCHEME_TYPE(so)) {
+    case scheme_integer_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: /* allocated in the master and can be passed along as is */
-    case scheme_place_bi_channel_type:
+      return so;
-      new_so = so;
-      break;
     case scheme_place_type:
-      new_so = ((Scheme_Place *) so)->channel;
+      return ((Scheme_Place *) so)->channel;
       break;
+    case scheme_byte_string_type:
+    case scheme_flvector_type:
+    case scheme_fxvector_type:
+      if (SHARED_ALLOCATEDP(so))
+        return so;
+  }
+
+  return NULL;
+}
+
+Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table **ht)
+{
+  Scheme_Object *new_so = so;
+
+  /* First, check for simple values that don't need to be hashed: */
+  new_so = trivial_copy(so);
+  if (new_so) return new_so;
+
+  if (*ht) {
+    Scheme_Object *r; 
+    if ((r = scheme_hash_get(*ht, so))) {
+      return r;
+    }
+  }
+
+  switch (SCHEME_TYPE(so)) {
     case scheme_char_type:
       new_so = scheme_make_char(SCHEME_CHAR_VAL(so));
       break;
@@ -850,21 +850,17 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
       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)) {
+      /* not allocated as shared, since that's covered above */
-        new_so = so;
+      new_so = scheme_make_sized_offset_byte_string(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
-      }
-      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:
     case scheme_windows_path_type:
-      new_so = scheme_make_sized_offset_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
+      new_so = scheme_make_sized_offset_kind_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1,
+                                                  SCHEME_TYPE(so));
       break;
     case scheme_symbol_type:
       if (SCHEME_SYM_UNINTERNEDP(so)) {
-        scheme_log_abort("cannot copy uninterned symbol");
+        bad_place_message(so);
-        abort();
       } else {
         new_so = scheme_make_sized_offset_byte_string((char *)so, SCHEME_SYMSTR_OFFSET(so), SCHEME_SYM_LEN(so), 1);
         new_so->type = scheme_serialized_symbol_type;
@@ -900,10 +896,8 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
       }
       break;
     case scheme_fxvector_type:
-      if (SHARED_ALLOCATEDP(so)) {
+      /* not allocated as shared, since that's covered above */
-        new_so = so;
+      {
-      }
-      else {
         Scheme_Vector *vec;
         intptr_t i;
         intptr_t size = SCHEME_FXVEC_SIZE(so);
@@ -916,10 +910,8 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
       }
       break;
     case scheme_flvector_type:
-      if (SHARED_ALLOCATEDP(so)) {
+      /* not allocated as shared, since that's covered above */
-        new_so = so;
+      {
-      }
-      else {
         Scheme_Double_Vector *vec;
         intptr_t i;
         intptr_t size = SCHEME_FLVEC_SIZE(so);
@@ -942,18 +934,14 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
         int local_slots = stype->num_slots - (ptype ? ptype->num_slots : 0);
         int i = 0;
 
-        if (!stype->prefab_key) {
+        if (!stype->prefab_key)
-          scheme_log_abort("cannot copy non prefab structure");
+          bad_place_message(so);
-          abort();
+        for (i = 0; i < local_slots; i++) {
-        }
+          if (!stype->immutables || stype->immutables[i] != 1) {
-        {
+            bad_place_message(so);
-          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++) {
@@ -987,16 +975,19 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
 
     case scheme_resolved_module_path_type:
     default:
-      scheme_arg_mismatch("place-channel-send", "cannot transmit a message containing", so);
+      bad_place_message(so);
       break;
   }
-  if (ht) {
+
-    scheme_hash_set(ht, so, new_so);
+  if (!*ht) {
+    Scheme_Hash_Table *_ht;
+    _ht = scheme_make_hash_table(SCHEME_hash_ptr);
+    *ht = _ht;
   }
+  scheme_hash_set(*ht, so, new_so);
+
   return new_so;
 }
-#endif
-
 
 #if 0
 /* unused code, may be useful when/if we revive shared symbol and prefab key tables */
@@ -1141,28 +1132,22 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
   return (void*) rc;
 }
 
-# ifdef MZ_PRECISE_GC
-Scheme_Hash_Table *force_hash(Scheme_Object *so);
-# endif
-
 Scheme_Object *scheme_places_deep_copy_to_master(Scheme_Object *so) {
+  Scheme_Hash_Table *ht = NULL;
 #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
   Scheme_Object *o;
   void *original_gc;
-  Scheme_Hash_Table *ht;
-
-  ht = force_hash(so);
 
   original_gc = GC_switch_to_master_gc();
   scheme_start_atomic();
 
-  o = scheme_places_deep_copy_worker(so, ht);
+  o = scheme_places_deep_copy_worker(so, &ht);
 
   scheme_end_atomic_no_swap();
   GC_switch_back_from_master(original_gc);
   return o;
 #else
-  return so;
+  return scheme_places_deep_copy_worker(so, &ht);
 #endif
 }
 
@@ -1256,18 +1241,8 @@ Scheme_Object *scheme_places_serialize(Scheme_Object *so, void **msg_memory) {
   Scheme_Object *new_so;
   Scheme_Object *tmp;
 
-  if (SCHEME_INTP(so)) { return so; }
+  new_so = trivial_copy(so);
-  switch (so->type) {
+  if (new_so) return new_so;
-    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:
-      return so;
-    default:
-      break;
-  }
 
   GC_create_message_allocator();
   new_so = scheme_places_deep_copy(so);
@@ -1283,18 +1258,8 @@ Scheme_Object *scheme_places_deserialize(Scheme_Object *so, void *msg_memory) {
 #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
   Scheme_Object *new_so;
 
-  if (SCHEME_INTP(so)) { return so; }
+  new_so = trivial_copy(so);
-  switch (so->type) {
+  if (new_so) return new_so;
-    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:
-      return so;
-    default:
-      break;
-  }
 
   /* small messages are deamed to be < 1k, this could be tuned in either direction */
   if (GC_message_allocator_size(msg_memory) < 1024) {
@@ -1356,100 +1321,6 @@ Scheme_Object *scheme_place_receive(int argc, Scheme_Object *args[]) {
 }
 
 # ifdef MZ_PRECISE_GC
-void force_hash_worker(Scheme_Object *so, Scheme_Hash_Table *ht);
-Scheme_Hash_Table *force_hash(Scheme_Object *so) {
-  if (SCHEME_INTP(so)) {
-    return NULL;
-  }
-
-  switch (so->type) {
-    case scheme_pair_type:
-    case scheme_vector_type:
-    case scheme_struct_type_type:
-    case scheme_structure_type:
-      {
-        Scheme_Hash_Table *ht;
-        ht = scheme_make_hash_table(SCHEME_hash_ptr);
-        force_hash_worker(so, ht);
-        return ht;
-      }
-      break;
-    default:
-      break;
-  }
-  return NULL;
-}
-
-void force_hash_worker(Scheme_Object *so, Scheme_Hash_Table *ht)
-{
-  if (SCHEME_INTP(so)) {
-    return;
-  }
-  if (ht) {
-    Scheme_Object *r; 
-    if ((r = scheme_hash_get(ht, so))) {
-      return;
-    }
-  }
-
-  switch (so->type) {
-    case scheme_true_type:
-    case scheme_false_type:
-    case scheme_null_type:
-    case scheme_char_type:
-    case scheme_rational_type:
-    case scheme_float_type:
-    case scheme_double_type:
-    case scheme_complex_type:
-    case scheme_char_string_type:
-    case scheme_byte_string_type:
-    case scheme_unix_path_type:
-    case scheme_symbol_type:
-    case scheme_place_bi_channel_type:
-    case scheme_flvector_type:
-      break;
-    case scheme_pair_type:
-      {
-        force_hash_worker(SCHEME_CAR(so), ht);
-        force_hash_worker(SCHEME_CDR(so), ht);
-      }
-      break;
-    case scheme_vector_type:
-      {
-        intptr_t i;
-        intptr_t size = SCHEME_VEC_SIZE(so);
-        for (i = 0; i <size ; i++) {
-          force_hash_worker(SCHEME_VEC_ELS(so)[i], ht);
-        }
-      }
-      break;
-    case scheme_structure_type:
-      {
-        Scheme_Structure *st = (Scheme_Structure*)so;
-        Scheme_Struct_Type *stype = st->stype;
-        intptr_t i;
-        intptr_t size = stype->num_slots;
-
-        if (stype->prefab_key)
-          force_hash_worker((Scheme_Object*)stype->prefab_key, ht);
-        
-        for (i = 0; i <size ; i++) {
-          force_hash_worker((Scheme_Object*) st->slots[i], ht);
-        }
-      }
-      break;
-    case scheme_resolved_module_path_type:
-    default:
-      scheme_log_abort("cannot force hash");
-      abort();
-      break;
-  }
-  if (ht) {
-    scheme_hash_set(ht, so, NULL);
-  }
-  return;
-}
-
 void scheme_spawn_master_place() {
   mzrt_proc_first_thread_init();