Separate tagged and untagged pointerless allocations

Tagged allocations can move; untagged allocations cannot.

* libguile/gc-inline.h:
* libguile/gc-malloc.c:
* libguile/gc.h: Split scm_allocate_pointerless into tagged and untagged
variants.
* libguile/bitvectors.c:
* libguile/bytevectors.c:
* libguile/foreign.c:
* libguile/fports.c:
* libguile/integers.c:
* libguile/intrinsics.c:
* libguile/load.c:
* libguile/loader.c:
* libguile/numbers.c:
* libguile/programs.h:
* libguile/random.c:
* libguile/read.c:
* libguile/regex-posix.c:
* libguile/smob.c:
* libguile/strings.c:
* libguile/vm.c: Use the new functions.

libguile/bitvectors.c

@@ -109,9 +109,9 @@ make_bitvector (size_t len, int fill)
   size_t word_len = bit_count_to_word_count (len);
   struct scm_bitvector *bv;
 
-  bv = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+  bv = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
-                                 sizeof (struct scm_bitvector)
+                                        sizeof (struct scm_bitvector)
-                                  + sizeof (scm_t_bits) * word_len);
+                                        + sizeof (scm_t_bits) * word_len);
 
   bv->tag_and_flags = scm_tc7_bitvector;
   bv->length = len;

libguile/bytevectors.c

@@ -233,8 +233,8 @@ make_bytevector (size_t len, scm_t_array_element_type element_type)
 
   size_t c_len = len * bytes_per_elt;
   struct scm_bytevector *bv =
-    scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+    scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
-                              sizeof (struct scm_bytevector) + c_len);
+                                     sizeof (struct scm_bytevector) + c_len);
 
   scm_t_bits flags = SCM_F_BYTEVECTOR_CONTIGUOUS;
   bv->tag_flags_and_element_type = make_bytevector_tag (flags, element_type);

libguile/foreign.c

@@ -817,7 +817,7 @@ make_cif (SCM return_type, SCM arg_types, const char *caller)
   cif_len = (ROUND_UP (cif_len, alignof_type (ffi_type))
 	     + (nargs + n_struct_elts + 1)*sizeof(ffi_type));
 
-  mem = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, cif_len);
+  mem = scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD, cif_len);
   /* ensure all the memory is initialized, even the holes */
   memset (mem, 0, cif_len);
   cif = (ffi_cif *) mem;
@@ -1133,7 +1133,8 @@ pack (const ffi_type * type, const void *loc, int return_value_p)
 
     case FFI_TYPE_STRUCT:
       {
-	void *mem = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, type->size);
+	void *mem =
+          scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD, type->size);
 	memcpy (mem, loc, type->size);
 	return scm_from_pointer (mem, NULL);
       }

libguile/fports.c

@@ -455,8 +455,8 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name, unsigned options)
         }
     }
 
-  fp = (scm_t_fport *) scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+  fp = (scm_t_fport *) scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
-                                                 sizeof (scm_t_fport));
+                                                          sizeof (scm_t_fport));
   fp->fdes = fdes;
   fp->options = options;
   fp->revealed = 0;

libguile/gc-inline.h

@@ -45,13 +45,6 @@
 
 
 
-static inline void *
-scm_inline_allocate_pointerless (scm_thread *thread, size_t bytes)
-{
-  return gc_allocate (thread->mutator, bytes,
-                      GC_ALLOCATION_UNTAGGED_POINTERLESS);
-}
-
 static inline void *
 scm_inline_allocate_tagged (scm_thread *thread, size_t bytes)
 {
@@ -59,6 +52,20 @@ scm_inline_allocate_tagged (scm_thread *thread, size_t bytes)
                       GC_ALLOCATION_TAGGED);
 }
 
+static inline void *
+scm_inline_allocate_tagged_pointerless (scm_thread *thread, size_t bytes)
+{
+  return gc_allocate (thread->mutator, bytes,
+                      GC_ALLOCATION_TAGGED_POINTERLESS);
+}
+
+static inline void *
+scm_inline_allocate_untagged_pointerless (scm_thread *thread, size_t bytes)
+{
+  return gc_allocate (thread->mutator, bytes,
+                      GC_ALLOCATION_UNTAGGED_POINTERLESS);
+}
+
 static inline void *
 scm_inline_allocate_sloppy (scm_thread *thread, size_t bytes)
 {

libguile/gc-malloc.c

@@ -149,13 +149,6 @@ scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
 {
 }
 
-void *
-scm_allocate_pointerless (struct scm_thread *thr, size_t size)
-{
-  if (!size) abort();
-  return scm_inline_allocate_pointerless (thr, size);
-}
-
 void *
 scm_allocate_tagged (struct scm_thread *thr, size_t size)
 {
@@ -163,6 +156,20 @@ scm_allocate_tagged (struct scm_thread *thr, size_t size)
   return scm_inline_allocate_tagged (thr, size);
 }
 
+void *
+scm_allocate_tagged_pointerless (struct scm_thread *thr, size_t size)
+{
+  if (!size) abort();
+  return scm_inline_allocate_tagged_pointerless (thr, size);
+}
+
+void *
+scm_allocate_untagged_pointerless (struct scm_thread *thr, size_t size)
+{
+  if (!size) abort();
+  return scm_inline_allocate_untagged_pointerless (thr, size);
+}
+
 void *
 scm_allocate_sloppy (struct scm_thread *thr, size_t size)
 {
@@ -171,13 +178,12 @@ scm_allocate_sloppy (struct scm_thread *thr, size_t size)
 }
 
 /* Allocate SIZE bytes of memory whose contents should not be scanned
-   for pointers (useful, e.g., for strings).  Note though that this
+   for pointers (useful, e.g., for strings).  The memory is cleared.  */
-   memory is *not* cleared; be sure to initialize it to prevent
-   information leaks.  */
 void *
 scm_gc_malloc_pointerless (size_t size, const char *what)
 {
-  return scm_allocate_pointerless (SCM_I_CURRENT_THREAD, size ? size : 1);
+  return scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
+                                            size ? size : 1);
 }
 
 void *

libguile/gc.h

@@ -112,8 +112,9 @@ SCM_API void scm_gc_register_collectable_memory (void *mem, size_t size,
 SCM_API void scm_gc_unregister_collectable_memory (void *mem, size_t size,
 						   const char *what);
 
-SCM_API void *scm_allocate_pointerless (struct scm_thread *thr, size_t size);
 SCM_API void *scm_allocate_tagged (struct scm_thread *thr, size_t size);
+SCM_API void *scm_allocate_tagged_pointerless (struct scm_thread *thr, size_t size);
+SCM_API void *scm_allocate_untagged_pointerless (struct scm_thread *thr, size_t size);
 SCM_API void *scm_allocate_sloppy (struct scm_thread *thr, size_t size);
 
 SCM_API void scm_gc_pin_object (struct scm_thread *thr, SCM x);

libguile/integers.c

@@ -139,7 +139,8 @@ allocate_bignum (size_t nlimbs)
   ASSERT (nlimbs <= NLIMBS_MAX);
 
   size_t size = sizeof (struct scm_bignum) + nlimbs * sizeof(mp_limb_t);
-  struct scm_bignum *z = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, size);
+  struct scm_bignum *z =
+    scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, size);
 
   z->tag = scm_tc16_big;
   z->size = nlimbs;

libguile/intrinsics.c

@@ -469,8 +469,8 @@ allocate_words (scm_thread *thread, size_t n)
 static SCM
 allocate_pointerless_words (scm_thread *thread, size_t n)
 {
-  return SCM_PACK_POINTER (scm_inline_allocate_pointerless (thread,
+  return SCM_PACK_POINTER
-                                                            n * sizeof (SCM)));
+    (scm_inline_allocate_untagged_pointerless (thread, n * sizeof (SCM)));
 }
 
 static SCM

libguile/load.c

@@ -430,8 +430,8 @@ stringbuf_grow (struct stringbuf *buf)
   ptroff = buf->ptr - buf->buf;
 
   buf->buf_len *= 2;
-  buf->buf = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+  buf->buf = scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
-                                       buf->buf_len);
+                                                buf->buf_len);
   memcpy (buf->buf, prev_buf, prev_len);
   buf->ptr = buf->buf + ptroff;
 }

libguile/loader.c

@@ -698,9 +698,9 @@ register_elf (char *data, size_t len, char *frame_maps)
 
         prev = mapped_elf_images;
         mapped_elf_images =
-          scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+          scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
-                                    sizeof (*mapped_elf_images)
+                                             sizeof (*mapped_elf_images)
-                                     * mapped_elf_images_allocated);
+                                             * mapped_elf_images_allocated);
 
         for (n = 0; n < mapped_elf_images_count; n++)
           {

libguile/numbers.c

@@ -422,15 +422,13 @@ scm_i_fraction2double (SCM z)
 static SCM
 scm_i_from_double (double val)
 {
-  SCM z;
+  struct scm_t_double *z =
+    scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, sizeof (*z));
 
-  z = SCM_PACK_POINTER
+  z->type = scm_tc16_real;
-    (scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (scm_t_double)));
+  z->real = val;
 
-  SCM_SET_CELL_TYPE (z, scm_tc16_real);
+  return SCM_PACK_POINTER (z);
-  SCM_REAL_VALUE (z) = val;
-
-  return z;
 }
 
 SCM_PRIMITIVE_GENERIC (scm_exact_p, "exact?", 1, 0, 0, 
@@ -6074,14 +6072,12 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0,
 SCM
 scm_c_make_rectangular (double re, double im)
 {
-  SCM z;
+  struct scm_t_complex *z =
-
+    scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, sizeof (*z));
-  z = SCM_PACK_POINTER
+  z->type = scm_tc16_complex;
-    (scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (scm_t_complex)));
+  z->real = re;
-  SCM_SET_CELL_TYPE (z, scm_tc16_complex);
+  z->imag = im;
-  SCM_COMPLEX_REAL (z) = re;
+  return SCM_PACK_POINTER (z);
-  SCM_COMPLEX_IMAG (z) = im;
-  return z;
 }
 
 SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0,

libguile/programs.h

@@ -127,8 +127,7 @@ static inline SCM
 scm_i_make_program (const uint32_t *code)
 {
   struct scm_program *ret =
-    scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+    scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, sizeof (*ret));
-                              sizeof (struct scm_program));
   ret->tag_flags_and_free_variable_count = scm_tc7_program;
   ret->code = code;
   return scm_from_program (ret);

libguile/random.c

@@ -137,8 +137,8 @@ scm_i_copy_rstate (scm_t_rstate *state)
 {
   scm_t_rstate *new_state;
 
-  new_state = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+  new_state = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
-                                        state->rng->rstate_size);
+                                               state->rng->rstate_size);
   return memcpy (new_state, state, state->rng->rstate_size);
 }
 
@@ -183,8 +183,8 @@ scm_c_make_rstate (const char *seed, int n)
 {
   scm_t_rstate *state;
 
-  state = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+  state = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
-                                    scm_the_rng.rstate_size);
+                                           scm_the_rng.rstate_size);
   state->tag = scm_tc16_random_state;
   state->rng = &scm_the_rng;
   state->normal_next = 0.0;
@@ -197,8 +197,8 @@ scm_c_rstate_from_datum (SCM datum)
 {
   scm_t_rstate *state;
 
-  state = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+  state = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
-                                    scm_the_rng.rstate_size);
+                                           scm_the_rng.rstate_size);
   state->tag = scm_tc16_random_state;
   state->rng = &scm_the_rng;
   state->normal_next = 0.0;

libguile/read.c

@@ -234,16 +234,17 @@ read_complete_token (SCM port, char *buffer, size_t buffer_size, size_t *read)
         {
           if (overflow_size == 0)
             {
-              overflow_buffer = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+              overflow_buffer =
-                                                          bytes_read);
+                scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
+                                                   bytes_read);
               memcpy (overflow_buffer, buffer, bytes_read);
               overflow_size = bytes_read;
             }
           else
             {
 	      char *new_buf =
-		scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+		scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
-                                          overflow_size + bytes_read);
+                                                   overflow_size + bytes_read);
 
 	      memcpy (new_buf, overflow_buffer, overflow_size);
               memcpy (new_buf + overflow_size, buffer, bytes_read);

libguile/regex-posix.c

@@ -153,8 +153,7 @@ SCM_DEFINE_STATIC (make_regexp, "make-regexp", 1, 0, 1,
       flag = SCM_CDR (flag);
     }
 
-  rx = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+  rx = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, sizeof (*rx));
-                                 sizeof (*rx));
   rx->tag = scm_tc16_regexp;
   c_pat = scm_to_locale_string (pat);
   status = regcomp (&rx->regex, c_pat,

libguile/smob.c

@@ -308,7 +308,7 @@ scm_new_smob (scm_t_bits tc, scm_t_bits data)
       uint32_t all_fields_unmanaged = -1;
       all_fields_unmanaged >>= 32 - desc->field_count;
       if (desc->unmanaged_fields == all_fields_unmanaged)
-        ret = scm_allocate_pointerless (thr, sz);
+        ret = scm_allocate_tagged_pointerless (thr, sz);
       else
         ret = scm_allocate_tagged (thr, sz);
     }
@@ -345,7 +345,7 @@ scm_new_double_smob (scm_t_bits tc, scm_t_bits data1,
       uint32_t all_fields_unmanaged = -1;
       all_fields_unmanaged >>= 32 - desc->field_count;
       if (desc->unmanaged_fields == all_fields_unmanaged)
-        ret = scm_allocate_pointerless (thr, sz);
+        ret = scm_allocate_tagged_pointerless (thr, sz);
       else
         ret = scm_allocate_tagged (thr, sz);
     }

libguile/strings.c

@@ -199,7 +199,8 @@ make_narrow_stringbuf (size_t len)
     return (struct scm_narrow_stringbuf *) &null_stringbuf;
 
   struct scm_narrow_stringbuf *buf =
-    scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (*buf) + len + 1);
+    scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
+                                     sizeof (*buf) + len + 1);
   buf->header.tag_and_flags = scm_tc7_stringbuf;
   buf->header.length = len;
 
@@ -222,8 +223,9 @@ make_wide_stringbuf (size_t len)
     scm_out_of_range ("make_stringbuf", scm_from_size_t (len));
 
   struct scm_wide_stringbuf *buf =
-    scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+    scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
-                              sizeof (*buf) + (len + 1) * sizeof (scm_t_wchar));
+                                     sizeof (*buf)
+                                     + (len + 1) * sizeof (scm_t_wchar));
   buf->header.tag_and_flags = scm_tc7_stringbuf | SCM_I_STRINGBUF_F_WIDE;
   buf->header.length = len;
 
@@ -1513,7 +1515,7 @@ decoding_error (const char *func_name, int errno_save,
   SCM bv;
   signed char *buf;
 
-  buf = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, len);
+  buf = scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD, len);
   memcpy (buf, str, len);
   bv = scm_c_take_gc_bytevector (buf, len, SCM_BOOL_F);
 

libguile/vm.c

@@ -480,7 +480,7 @@ define_vm_builtins (void)
     size_t sz = sizeof (builtin##_code);                                \
     vm_builtin_##builtin##_code = instrumented_code (builtin##_code, sz); \
     struct scm_program *p =                                             \
-      scm_allocate_pointerless (thr, sizeof (struct scm_program));      \
+      scm_allocate_tagged_pointerless (thr, sizeof (*p));               \
     scm_t_bits tag = scm_tc7_program | SCM_F_PROGRAM_IS_PRIMITIVE;      \
     p->tag_flags_and_free_variable_count = tag;                         \
     p->code = vm_builtin_##builtin##_code;                              \