All literal constants are read-only

* libguile/array-handle.c (initialize_vector_handle): Add mutable_p
  argument.  Unless the vector handle is mutable, null out its
  writable_elements member.
  (scm_array_get_handle): Adapt to determine mutability of the various
  arrays.
  (scm_array_handle_elements, scm_array_handle_writable_elements):
  Reverse the sense: instead of implementing read-only in terms of
  read-write, go the other way around, adding an assertion in the
  read-write case that the array handle is mutable.
* libguile/array-map.c (racp): Assert that the destination is mutable.
* libguile/bitvectors.c (SCM_F_BITVECTOR_IMMUTABLE, IS_BITVECTOR):
  (IS_MUTABLE_BITVECTOR): Add a flag to indicate immutability.
  (scm_i_bitvector_bits): Fix indentation.
  (scm_i_is_mutable_bitvector): New helper.
  (scm_array_handle_bit_elements)
  ((scm_array_handle_bit_writable_elements): Build writable_elements in
  terms of elements.
  (scm_bitvector_elements, scm_bitvector_writable_elements): Likewise.
  (scm_c_bitvector_set_x): Require a mutable bitvector for the
  fast-path.
  (scm_bitvector_to_list, scm_bit_count): Use read-only elements()
  function.
* libguile/bitvectors.h (scm_i_is_mutable_bitvector): New decl.
* libguile/bytevectors.c (INTEGER_ACCESSOR_PROLOGUE):
  (INTEGER_GETTER_PROLOGUE, INTEGER_SETTER_PROLOGUE):
  (INTEGER_REF, INTEGER_NATIVE_REF, INTEGER_SET, INTEGER_NATIVE_SET):
  (GENERIC_INTEGER_ACCESSOR_PROLOGUE):
  (GENERIC_INTEGER_GETTER_PROLOGUE, GENERIC_INTEGER_SETTER_PROLOGUE):
  (LARGE_INTEGER_NATIVE_REF, LARGE_INTEGER_NATIVE_SET):
  (IEEE754_GETTER_PROLOGUE, IEEE754_SETTER_PROLOGUE):
  (IEEE754_REF, IEEE754_NATIVE_REF, IEEE754_SET, IEEE754_NATIVE_SET):
  Setters require a mutable bytevector.
  (SCM_BYTEVECTOR_SET_FLAG): New helper.
  (SCM_BYTEVECTOR_SET_CONTIGUOUS_P, SCM_BYTEVECTOR_SET_ELEMENT_TYPE):
  Remove helpers.
  (SCM_VALIDATE_MUTABLE_BYTEVECTOR): New helper.
  (make_bytevector, make_bytevector_from_buffer): Use
  SCM_SET_BYTEVECTOR_FLAGS.
  (scm_c_bytevector_set_x, scm_bytevector_fill_x)
  (scm_bytevector_copy_x): Require a mutable bytevector.
* libguile/bytevectors.h (SCM_F_BYTEVECTOR_CONTIGUOUS)
  (SCM_F_BYTEVECTOR_IMMUTABLE, SCM_MUTABLE_BYTEVECTOR_P): New
  definitions.
* libguile/bytevectors.h (SCM_BYTEVECTOR_CONTIGUOUS_P): Just access one
  bit.
* libguile/srfi-4.c (DEFINE_SRFI_4_C_FUNCS): Implement
  writable_elements() in terms of elements().
* libguile/strings.c (scm_i_string_is_mutable): New helper.
* libguile/uniform.c (scm_array_handle_uniform_elements):
  (scm_array_handle_uniform_writable_elements): Implement
  writable_elements in terms of elements.
* libguile/vectors.c (SCM_VALIDATE_MUTABLE_VECTOR): New helper.
  (scm_vector_elements, scm_vector_writable_elements): Implement
  writable_elements in terms of elements.
  (scm_c_vector_set_x): Require a mutable vector.
* libguile/vectors.h (SCM_F_VECTOR_IMMUTABLE, SCM_I_IS_MUTABLE_VECTOR):
  New definitions.
* libguile/vm-engine.c (VM_VALIDATE_MUTABLE_BYTEVECTOR):
  (VM_VALIDATE_MUTABLE_VECTOR, vector-set!, vector-set!/immediate)
  (BV_BOUNDED_SET, BV_SET): Require mutable bytevector/vector.
* libguile/vm.c (vm_error_not_a_mutable_bytevector):
  (vm_error_not_a_mutable_vector): New definitions.
* module/system/vm/assembler.scm (link-data): Mark residualized vectors,
  bytevectors, and bitvectors as being read-only.

15 files changed, 237 insertions, 131 deletions

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 89277d9d6..3d81efc04 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -140,7 +140,7 @@ static void
 initialize_vector_handle (scm_t_array_handle *h, size_t len,
                           scm_t_array_element_type element_type,
                           scm_t_vector_ref vref, scm_t_vector_set vset,
-                          void *writable_elements)
+                          const void *elements, int mutable_p)
 {
   h->base = 0;
   h->ndims = 1;
@@ -149,7 +149,8 @@ initialize_vector_handle (scm_t_array_handle *h, size_t len,
   h->dim0.ubnd = (ssize_t) (len - 1U);
   h->dim0.inc = 1;
   h->element_type = element_type;
-  h->elements = h->writable_elements = writable_elements;
+  h->elements = elements;
+  h->writable_elements = mutable_p ? ((void *) elements) : NULL;
   h->vector = h->array;
   h->vref = vref;
   h->vset = vset;
@@ -169,19 +170,22 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
       initialize_vector_handle (h, scm_c_string_length (array),
                                 SCM_ARRAY_ELEMENT_TYPE_CHAR,
                                 scm_c_string_ref, scm_c_string_set_x,
-                                NULL);
+                                NULL,
+                                scm_i_string_is_mutable (array));
       break;
     case scm_tc7_vector:
       initialize_vector_handle (h, scm_c_vector_length (array),
                                 SCM_ARRAY_ELEMENT_TYPE_SCM,
                                 scm_c_vector_ref, scm_c_vector_set_x,
-                                SCM_I_VECTOR_WELTS (array));
+                                SCM_I_VECTOR_WELTS (array),
+                                SCM_I_IS_MUTABLE_VECTOR (array));
       break;
     case scm_tc7_bitvector:
       initialize_vector_handle (h, scm_c_bitvector_length (array),
                                 SCM_ARRAY_ELEMENT_TYPE_BIT,
                                 scm_c_bitvector_ref, scm_c_bitvector_set_x,
-                                scm_i_bitvector_bits (array));
+                                scm_i_bitvector_bits (array),
+                                scm_i_is_mutable_bitvector (array));
       break;
     case scm_tc7_bytevector:
       {
@@ -225,7 +229,8 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
           }
 
         initialize_vector_handle (h, length, element_type, vref, vset,
-                                  SCM_BYTEVECTOR_CONTENTS (array));
+                                  SCM_BYTEVECTOR_CONTENTS (array),
+                                  SCM_MUTABLE_BYTEVECTOR_P (array));
       }
       break;
     case scm_tc7_array:
@@ -320,15 +325,19 @@ scm_array_handle_release (scm_t_array_handle *h)
 const SCM *
 scm_array_handle_elements (scm_t_array_handle *h)
 {
-  return scm_array_handle_writable_elements (h);
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
+
+  return ((const SCM *) h->elements) + h->base;
 }
 
 SCM *
 scm_array_handle_writable_elements (scm_t_array_handle *h)
 {
-  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
-    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-  return ((SCM*)h->elements) + h->base;
+  if (h->writable_elements != h->elements)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable array");
+
+  return (SCM *) scm_array_handle_elements (h);
 }
 
 void
diff --git a/libguile/array-map.c b/libguile/array-map.c
index c2825bc42..79383969d 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -263,6 +263,8 @@ racp (SCM src, SCM dst)
     {
       SCM const * el_s = h_s.elements;
       SCM * el_d = h_d.writable_elements;
+      if (!el_d)
+        scm_wrong_type_arg_msg ("array-copy!", SCM_ARG2, dst, "mutable array");
       for (; n-- > 0; i_s += inc_s, i_d += inc_d)
         el_d[i_d] = el_s[i_s];
     }
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 7a4ed9bf9..cfca4ab6c 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -38,11 +38,18 @@
  * but alack, all we have is this crufty C.
  */
 
-#define IS_BITVECTOR(obj)       SCM_TYP16_PREDICATE(scm_tc7_bitvector,(obj))
+#define SCM_F_BITVECTOR_IMMUTABLE (0x80)
+
+#define IS_BITVECTOR(obj)         SCM_HAS_TYP7  ((obj), scm_tc7_bitvector)
+#define IS_MUTABLE_BITVECTOR(x)                                 \
+  (SCM_NIMP (x) &&                                              \
+   ((SCM_CELL_TYPE (x) & (0x7f | SCM_F_BITVECTOR_IMMUTABLE))    \
+    == scm_tc7_bitvector))
 #define BITVECTOR_LENGTH(obj)   ((size_t)SCM_CELL_WORD_1(obj))
 #define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_CELL_WORD_2(obj))
 
-scm_t_uint32 *scm_i_bitvector_bits (SCM vec)
+scm_t_uint32 *
+scm_i_bitvector_bits (SCM vec)
 {
   if (!IS_BITVECTOR (vec))
     abort ();
@@ -50,6 +57,12 @@ scm_t_uint32 *scm_i_bitvector_bits (SCM vec)
 }
 
 int
+scm_i_is_mutable_bitvector (SCM vec)
+{
+  return IS_MUTABLE_BITVECTOR (vec);
+}
+
+int
 scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
 {
   size_t bit_len = BITVECTOR_LENGTH (vec);
@@ -166,18 +179,17 @@ SCM_DEFINE (scm_bitvector_length, "bitvector-length", 1, 0, 0,
 const scm_t_uint32 *
 scm_array_handle_bit_elements (scm_t_array_handle *h)
 {
-  return scm_array_handle_bit_writable_elements (h);
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_BIT)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
+  return ((const scm_t_uint32 *) h->elements) + h->base/32;
 }
 
 scm_t_uint32 *
 scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
 {
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (IS_BITVECTOR (vec))
-    return BITVECTOR_BITS (vec) + h->base/32;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
+  if (h->writable_elements != h->elements)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable bit array");
+  return (scm_t_uint32 *) scm_array_handle_bit_elements (h);
 }
 
 size_t
@@ -193,7 +205,15 @@ scm_bitvector_elements (SCM vec,
 			size_t *lenp,
 			ssize_t *incp)
 {
-  return scm_bitvector_writable_elements (vec, h, offp, lenp, incp);
+  scm_generalized_vector_get_handle (vec, h);
+  if (offp)
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (h);
+      *offp = scm_array_handle_bit_elements_offset (h);
+      *lenp = dim->ubnd - dim->lbnd + 1;
+      *incp = dim->inc;
+    }
+  return scm_array_handle_bit_elements (h);
 }
 
 
@@ -204,15 +224,12 @@ scm_bitvector_writable_elements (SCM vec,
 				 size_t *lenp,
 				 ssize_t *incp)
 {
-  scm_generalized_vector_get_handle (vec, h);
-  if (offp)
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (h);
-      *offp = scm_array_handle_bit_elements_offset (h);
-      *lenp = dim->ubnd - dim->lbnd + 1;
-      *incp = dim->inc;
-    }
-  return scm_array_handle_bit_writable_elements (h);
+  const scm_t_uint32 *ret = scm_bitvector_elements (vec, h, offp, lenp, incp);
+
+  if (h->writable_elements != h->elements)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable bit array");
+
+  return (scm_t_uint32 *) ret;
 }
 
 SCM
@@ -260,7 +277,7 @@ scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
   scm_t_array_handle handle;
   scm_t_uint32 *bits, mask;
 
-  if (IS_BITVECTOR (vec))
+  if (IS_MUTABLE_BITVECTOR (vec))
     {
       if (idx >= BITVECTOR_LENGTH (vec))
 	scm_out_of_range (NULL, scm_from_size_t (idx));
@@ -283,7 +300,7 @@ scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
   else
     bits[idx/32] &= ~mask;
 
-  if (!IS_BITVECTOR (vec))
+  if (!IS_MUTABLE_BITVECTOR (vec))
       scm_array_handle_release (&handle);
 }
 
@@ -382,11 +399,10 @@ SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
   scm_t_array_handle handle;
   size_t off, len;
   ssize_t inc;
-  scm_t_uint32 *bits;
+  const scm_t_uint32 *bits;
   SCM res = SCM_EOL;
 
-  bits = scm_bitvector_writable_elements (vec, &handle,
-					  &off, &len, &inc);
+  bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
 
   if (off == 0 && inc == 1)
     {
@@ -446,12 +462,11 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
   scm_t_array_handle handle;
   size_t off, len;
   ssize_t inc;
-  scm_t_uint32 *bits;
+  const scm_t_uint32 *bits;
   int bit = scm_to_bool (b);
   size_t count = 0;
 
-  bits = scm_bitvector_writable_elements (bitvector, &handle,
-					  &off, &len, &inc);
+  bits = scm_bitvector_elements (bitvector, &handle, &off, &len, &inc);
 
   if (off == 0 && inc == 1 && len > 0)
     {
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
index 6b2cb1e5c..57ae52fc8 100644
--- a/libguile/bitvectors.h
+++ b/libguile/bitvectors.h
@@ -71,6 +71,7 @@ SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec,
 						       ssize_t *incp);
 
 SCM_INTERNAL scm_t_uint32 *scm_i_bitvector_bits (SCM vec);
+SCM_INTERNAL int scm_i_is_mutable_bitvector (SCM vec);
 SCM_INTERNAL int scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate);
 SCM_INTERNAL SCM scm_i_bitvector_equal_p (SCM vec1, SCM vec2);
 SCM_INTERNAL void scm_init_bitvectors (void);
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 7b4585d1f..7cd753009 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -74,11 +74,11 @@
 #define SIGNEDNESS(_sign)       SIGNEDNESS_ ## _sign
 
 
-#define INTEGER_ACCESSOR_PROLOGUE(_len, _sign)			\
+#define INTEGER_ACCESSOR_PROLOGUE(validate, _len, _sign)        \
   size_t c_len, c_index;					\
   _sign char *c_bv;						\
 								\
-  SCM_VALIDATE_BYTEVECTOR (1, bv);				\
+  SCM_VALIDATE_##validate (1, bv);                              \
   c_index = scm_to_uint (index);				\
 								\
   c_len = SCM_BYTEVECTOR_LENGTH (bv);				\
@@ -87,11 +87,17 @@
   if (SCM_UNLIKELY (c_index + ((_len) >> 3UL) - 1 >= c_len))	\
     scm_out_of_range (FUNC_NAME, index);
 
+#define INTEGER_GETTER_PROLOGUE(_len, _sign)            \
+  INTEGER_ACCESSOR_PROLOGUE (BYTEVECTOR, _len, _sign)
+
+#define INTEGER_SETTER_PROLOGUE(_len, _sign)                    \
+  INTEGER_ACCESSOR_PROLOGUE (MUTABLE_BYTEVECTOR, _len, _sign)
+
 /* Template for fixed-size integer access (only 8, 16 or 32-bit).  */
 #define INTEGER_REF(_len, _sign)                                \
   SCM result;                                                   \
                                                                 \
-  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);                      \
+  INTEGER_GETTER_PROLOGUE (_len, _sign);                        \
   SCM_VALIDATE_SYMBOL (3, endianness);                          \
                                                                 \
   {                                                             \
@@ -110,7 +116,7 @@
 #define INTEGER_NATIVE_REF(_len, _sign)			\
   SCM result;						\
 							\
-  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);		\
+  INTEGER_GETTER_PROLOGUE (_len, _sign);                \
 							\
   {							\
     INT_TYPE (_len, _sign)  c_result;			\
@@ -123,7 +129,7 @@
 
 /* Template for fixed-size integer modification (only 8, 16 or 32-bit).  */
 #define INTEGER_SET(_len, _sign)				\
-  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);			\
+  INTEGER_SETTER_PROLOGUE (_len, _sign);                        \
   SCM_VALIDATE_SYMBOL (3, endianness);				\
 								\
   {								\
@@ -149,7 +155,7 @@
 /* Template for fixed-size integer modification using the native
    endianness.  */
 #define INTEGER_NATIVE_SET(_len, _sign)				\
-  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);			\
+  INTEGER_SETTER_PROLOGUE (_len, _sign);                        \
 								\
   {								\
     scm_t_signed_bits c_value;					\
@@ -176,22 +182,19 @@
 #define SCM_BYTEVECTOR_HEADER_BYTES		\
   (SCM_BYTEVECTOR_HEADER_SIZE * sizeof (scm_t_bits))
 
+#define SCM_BYTEVECTOR_SET_FLAG(bv, flag) \
+  SCM_SET_BYTEVECTOR_FLAGS ((bv), SCM_BYTEVECTOR_FLAGS (bv) | flag)
 #define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)            \
   SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
 #define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents)	\
   SCM_SET_CELL_WORD_2 ((_bv), (scm_t_bits) (_contents))
-#define SCM_BYTEVECTOR_SET_CONTIGUOUS_P(bv, contiguous_p)	\
-  SCM_SET_BYTEVECTOR_FLAGS ((bv),				\
-			    SCM_BYTEVECTOR_ELEMENT_TYPE (bv)	\
-			    | ((contiguous_p) << 8UL))
-
-#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint)			\
-  SCM_SET_BYTEVECTOR_FLAGS ((bv),					\
-                            (hint)					\
-                            | (SCM_BYTEVECTOR_CONTIGUOUS_P (bv) << 8UL))
 #define SCM_BYTEVECTOR_SET_PARENT(_bv, _parent)	\
   SCM_SET_CELL_OBJECT_3 ((_bv), (_parent))
 
+#define SCM_VALIDATE_MUTABLE_BYTEVECTOR(pos, v) \
+  SCM_MAKE_VALIDATE_MSG (pos, v, MUTABLE_BYTEVECTOR_P, "mutable bytevector")
+
+
 /* The empty bytevector.  */
 SCM scm_null_bytevector = SCM_UNSPECIFIED;
 
@@ -223,10 +226,10 @@ make_bytevector (size_t len, scm_t_array_element_type element_type)
       ret = SCM_PACK_POINTER (contents);
       contents += SCM_BYTEVECTOR_HEADER_BYTES;
 
+      SCM_SET_BYTEVECTOR_FLAGS (ret,
+                                element_type | SCM_F_BYTEVECTOR_CONTIGUOUS);
       SCM_BYTEVECTOR_SET_LENGTH (ret, c_len);
       SCM_BYTEVECTOR_SET_CONTENTS (ret, contents);
-      SCM_BYTEVECTOR_SET_CONTIGUOUS_P (ret, 1);
-      SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
       SCM_BYTEVECTOR_SET_PARENT (ret, SCM_BOOL_F);
     }
 
@@ -253,10 +256,9 @@ make_bytevector_from_buffer (size_t len, void *contents,
 
       c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
 
+      SCM_SET_BYTEVECTOR_FLAGS (ret, element_type);
       SCM_BYTEVECTOR_SET_LENGTH (ret, c_len);
       SCM_BYTEVECTOR_SET_CONTENTS (ret, contents);
-      SCM_BYTEVECTOR_SET_CONTIGUOUS_P (ret, 0);
-      SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
       SCM_BYTEVECTOR_SET_PARENT (ret, SCM_BOOL_F);
     }
 
@@ -390,7 +392,7 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
   size_t c_len;
   scm_t_uint8 *c_bv;
 
-  SCM_VALIDATE_BYTEVECTOR (1, bv);
+  SCM_VALIDATE_MUTABLE_BYTEVECTOR (1, bv);
 
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
   c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
@@ -551,7 +553,7 @@ SCM_DEFINE (scm_bytevector_fill_x, "bytevector-fill!", 2, 0, 0,
   scm_t_uint8 *c_bv, c_fill;
   int value;
 
-  SCM_VALIDATE_BYTEVECTOR (1, bv);
+  SCM_VALIDATE_MUTABLE_BYTEVECTOR (1, bv);
 
   value = scm_to_int (fill);
   if (SCM_UNLIKELY ((value < -128) || (value > 255)))
@@ -582,7 +584,7 @@ SCM_DEFINE (scm_bytevector_copy_x, "bytevector-copy!", 5, 0, 0,
   signed char *c_source, *c_target;
 
   SCM_VALIDATE_BYTEVECTOR (1, source);
-  SCM_VALIDATE_BYTEVECTOR (3, target);
+  SCM_VALIDATE_MUTABLE_BYTEVECTOR (3, target);
 
   c_len = scm_to_size_t (len);
   c_source_start = scm_to_size_t (source_start);
@@ -707,8 +709,6 @@ SCM_DEFINE (scm_bytevector_s8_set_x, "bytevector-s8-set!", 3, 0, 0,
 }
 #undef FUNC_NAME
 
-#undef OCTET_ACCESSOR_PROLOGUE
-
 
 SCM_DEFINE (scm_bytevector_to_u8_list, "bytevector->u8-list", 1, 0, 0,
 	    (SCM bv),
@@ -895,11 +895,11 @@ bytevector_large_set (char *c_bv, size_t c_size, int signed_p,
   return err;
 }
 
-#define GENERIC_INTEGER_ACCESSOR_PROLOGUE(_sign)			\
+#define GENERIC_INTEGER_ACCESSOR_PROLOGUE(validate, _sign)              \
   size_t c_len, c_index, c_size;					\
   char *c_bv;								\
 									\
-  SCM_VALIDATE_BYTEVECTOR (1, bv);					\
+  SCM_VALIDATE_##validate (1, bv);					\
   c_index = scm_to_size_t (index);					\
   c_size = scm_to_size_t (size);					\
 									\
@@ -914,6 +914,10 @@ bytevector_large_set (char *c_bv, size_t c_size, int signed_p,
   if (SCM_UNLIKELY (c_index + c_size > c_len))				\
     scm_out_of_range (FUNC_NAME, index);
 
+#define GENERIC_INTEGER_GETTER_PROLOGUE(_sign)          \
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (BYTEVECTOR, _sign)
+#define GENERIC_INTEGER_SETTER_PROLOGUE(_sign)                  \
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (MUTABLE_BYTEVECTOR, _sign)
 
 /* Template of an integer reference function.  */
 #define GENERIC_INTEGER_REF(_sign)					\
@@ -1063,7 +1067,7 @@ SCM_DEFINE (scm_bytevector_uint_ref, "bytevector-uint-ref", 4, 0, 0,
 	    "@var{index} in @var{bv}.")
 #define FUNC_NAME s_scm_bytevector_uint_ref
 {
-  GENERIC_INTEGER_ACCESSOR_PROLOGUE (unsigned);
+  GENERIC_INTEGER_GETTER_PROLOGUE (unsigned);
 
   return (bytevector_unsigned_ref (&c_bv[c_index], c_size, endianness));
 }
@@ -1075,7 +1079,7 @@ SCM_DEFINE (scm_bytevector_sint_ref, "bytevector-sint-ref", 4, 0, 0,
 	    "@var{index} in @var{bv}.")
 #define FUNC_NAME s_scm_bytevector_sint_ref
 {
-  GENERIC_INTEGER_ACCESSOR_PROLOGUE (signed);
+  GENERIC_INTEGER_GETTER_PROLOGUE (signed);
 
   return (bytevector_signed_ref (&c_bv[c_index], c_size, endianness));
 }
@@ -1087,7 +1091,7 @@ SCM_DEFINE (scm_bytevector_uint_set_x, "bytevector-uint-set!", 5, 0, 0,
 	    "to @var{value}.")
 #define FUNC_NAME s_scm_bytevector_uint_set_x
 {
-  GENERIC_INTEGER_ACCESSOR_PROLOGUE (unsigned);
+  GENERIC_INTEGER_SETTER_PROLOGUE (unsigned);
 
   bytevector_unsigned_set (&c_bv[c_index], c_size, value, endianness,
 			   FUNC_NAME);
@@ -1102,7 +1106,7 @@ SCM_DEFINE (scm_bytevector_sint_set_x, "bytevector-sint-set!", 5, 0, 0,
 	    "to @var{value}.")
 #define FUNC_NAME s_scm_bytevector_sint_set_x
 {
-  GENERIC_INTEGER_ACCESSOR_PROLOGUE (signed);
+  GENERIC_INTEGER_SETTER_PROLOGUE (signed);
 
   bytevector_signed_set (&c_bv[c_index], c_size, value, endianness,
 			 FUNC_NAME);
@@ -1330,7 +1334,7 @@ SCM_DEFINE (scm_bytevector_s16_native_set_x, "bytevector-s16-native-set!",
    `large_{ref,set}' variants on 32-bit machines.  */
 
 #define LARGE_INTEGER_REF(_len, _sign)					\
-  INTEGER_ACCESSOR_PROLOGUE(_len, _sign);				\
+  INTEGER_GETTER_PROLOGUE(_len, _sign);                                 \
   SCM_VALIDATE_SYMBOL (3, endianness);					\
 									\
   return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8,	\
@@ -1338,7 +1342,7 @@ SCM_DEFINE (scm_bytevector_s16_native_set_x, "bytevector-s16-native-set!",
 
 #define LARGE_INTEGER_SET(_len, _sign)					\
   int err;								\
-  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);				\
+  INTEGER_SETTER_PROLOGUE (_len, _sign);                                \
   SCM_VALIDATE_SYMBOL (4, endianness);					\
 									\
   err = bytevector_large_set ((char *) c_bv + c_index, _len / 8,	\
@@ -1348,14 +1352,14 @@ SCM_DEFINE (scm_bytevector_s16_native_set_x, "bytevector-s16-native-set!",
 									\
   return SCM_UNSPECIFIED;
 
-#define LARGE_INTEGER_NATIVE_REF(_len, _sign)				 \
-  INTEGER_ACCESSOR_PROLOGUE(_len, _sign);				 \
-  return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8,	 \
+#define LARGE_INTEGER_NATIVE_REF(_len, _sign)                           \
+  INTEGER_GETTER_PROLOGUE(_len, _sign);                                 \
+  return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8,      \
 				SIGNEDNESS (_sign), scm_i_native_endianness));
 
 #define LARGE_INTEGER_NATIVE_SET(_len, _sign)				\
   int err;								\
-  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);				\
+  INTEGER_SETTER_PROLOGUE (_len, _sign);                                \
 									\
   err = bytevector_large_set ((char *) c_bv + c_index, _len / 8,	\
 			      SIGNEDNESS (_sign), value,		\
@@ -1665,13 +1669,16 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
 
 /* Templace getters and setters.  */
 
-#define IEEE754_ACCESSOR_PROLOGUE(_type)			\
-  INTEGER_ACCESSOR_PROLOGUE (sizeof (_type) << 3UL, signed);
+#define IEEE754_GETTER_PROLOGUE(_type)                          \
+  INTEGER_GETTER_PROLOGUE (sizeof (_type) << 3UL, signed);
+
+#define IEEE754_SETTER_PROLOGUE(_type)                          \
+  INTEGER_SETTER_PROLOGUE (sizeof (_type) << 3UL, signed);
 
 #define IEEE754_REF(_type)					\
   _type c_result;						\
 								\
-  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+  IEEE754_GETTER_PROLOGUE (_type);                              \
   SCM_VALIDATE_SYMBOL (3, endianness);				\
 								\
   if (scm_is_eq (endianness, scm_i_native_endianness))		\
@@ -1690,7 +1697,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
 #define IEEE754_NATIVE_REF(_type)				\
   _type c_result;						\
 								\
-  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+  IEEE754_GETTER_PROLOGUE (_type);				\
 								\
   memcpy (&c_result, &c_bv[c_index], sizeof (c_result));	\
   return (IEEE754_TO_SCM (_type) (c_result));
@@ -1698,7 +1705,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
 #define IEEE754_SET(_type)					\
   _type c_value;						\
 								\
-  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+  IEEE754_SETTER_PROLOGUE (_type);				\
   VALIDATE_REAL (3, value);					\
   SCM_VALIDATE_SYMBOL (4, endianness);				\
   c_value = IEEE754_FROM_SCM (_type) (value);			\
@@ -1718,7 +1725,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
 #define IEEE754_NATIVE_SET(_type)			\
   _type c_value;					\
 							\
-  IEEE754_ACCESSOR_PROLOGUE (_type);			\
+  IEEE754_SETTER_PROLOGUE (_type);			\
   VALIDATE_REAL (3, value);				\
   c_value = IEEE754_FROM_SCM (_type) (value);		\
 							\
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index af4ac1c34..77f0006a4 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -124,10 +124,18 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
   SCM_SET_CELL_TYPE ((_bv),						\
 		     scm_tc7_bytevector | ((scm_t_bits)(_f) << 7UL))
 
+#define SCM_F_BYTEVECTOR_CONTIGUOUS 0x100UL
+#define SCM_F_BYTEVECTOR_IMMUTABLE 0x200UL
+
+#define SCM_MUTABLE_BYTEVECTOR_P(x)                                     \
+  (SCM_NIMP (x) &&                                                      \
+   ((SCM_CELL_TYPE (x) & (0x7fUL | (SCM_F_BYTEVECTOR_IMMUTABLE << 7UL)))  \
+    == scm_tc7_bytevector))
+
 #define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv)	\
   (SCM_BYTEVECTOR_FLAGS (_bv) & 0xffUL)
 #define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv)	\
-  (SCM_BYTEVECTOR_FLAGS (_bv) >> 8UL)
+  (SCM_BYTEVECTOR_FLAGS (_bv) & SCM_F_BYTEVECTOR_CONTIGUOUS)
 
 #define SCM_BYTEVECTOR_TYPE_SIZE(var)                           \
   (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 057664c58..b0ed0ce17 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -119,24 +119,18 @@
   {                                                                     \
     if (h->element_type != ETYPE (TAG))                                 \
       scm_wrong_type_arg_msg (NULL, 0, h->array, #tag "vector");        \
-    return ((const ctype*) h->elements) + h->base*width;                \
+    return ((const ctype *) h->elements) + h->base*width;               \
   }                                                                     \
   ctype* scm_array_handle_##tag##_writable_elements (scm_t_array_handle *h) \
   {                                                                     \
-    if (h->element_type != ETYPE (TAG))                                 \
-      scm_wrong_type_arg_msg (NULL, 0, h->array, #tag "vector");        \
-    return ((ctype*) h->writable_elements) + h->base*width;             \
+    if (h->writable_elements != h->elements)                            \
+      scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable " #tag "vector"); \
+    return (ctype *) scm_array_handle_##tag##_elements (h);             \
   }                                                                     \
   const ctype *scm_##tag##vector_elements (SCM uvec,                    \
                                            scm_t_array_handle *h,       \
                                            size_t *lenp, ssize_t *incp) \
   {                                                                     \
-    return scm_##tag##vector_writable_elements (uvec, h, lenp, incp);   \
-  }                                                                     \
-  ctype *scm_##tag##vector_writable_elements (SCM uvec,                 \
-                                              scm_t_array_handle *h,    \
-                                              size_t *lenp, ssize_t *incp) \
-  {                                                                     \
     size_t byte_width = width * sizeof (ctype);                         \
     if (!scm_is_bytevector (uvec)                                       \
         || (scm_c_bytevector_length (uvec) % byte_width))               \
@@ -146,7 +140,16 @@
       *lenp = scm_c_bytevector_length (uvec) / byte_width;              \
     if (incp)                                                           \
       *incp = 1;                                                        \
-    return ((ctype *)h->writable_elements);                             \
+    return ((const ctype *) h->elements);                               \
+  }                                                                     \
+  ctype *scm_##tag##vector_writable_elements (SCM uvec,                 \
+                                              scm_t_array_handle *h,    \
+                                              size_t *lenp, ssize_t *incp) \
+  {                                                                     \
+    const ctype *ret = scm_##tag##vector_elements (uvec, h, lenp, incp);\
+    if (h->writable_elements != h->elements)                            \
+      scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable " #tag "vector"); \
+    return (ctype *) ret;                                               \
   }
 
 
diff --git a/libguile/strings.c b/libguile/strings.c
index 8d0aa453f..5c49e33d8 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -507,6 +507,12 @@ scm_i_string_length (SCM str)
   return STRING_LENGTH (str);
 }
 
+int
+scm_i_string_is_mutable (SCM str)
+{
+  return !IS_RO_STRING (str);
+}
+
 /* True if the string is 'narrow', meaning it has a 8-bit Latin-1
    encoding.  False if it is 'wide', having a 32-bit UCS-4
    encoding.  */
diff --git a/libguile/strings.h b/libguile/strings.h
index 77690ce67..5b3e7805f 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -194,12 +194,12 @@ SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap,
 				    int read_only_p);
 SCM_INTERNAL SCM scm_i_make_wide_string (size_t len, scm_t_wchar **datap,
 					 int read_only_p);
-SCM_INTERNAL SCM scm_i_set_string_read_only_x (SCM str);
 SCM_INTERNAL SCM scm_i_substring (SCM str, size_t start, size_t end);
 SCM_INTERNAL SCM scm_i_substring_read_only (SCM str, size_t start, size_t end);
 SCM_INTERNAL SCM scm_i_substring_shared (SCM str, size_t start, size_t end);
 SCM_INTERNAL SCM scm_i_substring_copy (SCM str, size_t start, size_t end);
 SCM_INTERNAL size_t scm_i_string_length (SCM str);
+SCM_INTERNAL int scm_i_string_is_mutable (SCM str);
 SCM_API /* FIXME: not internal */ const char *scm_i_string_chars (SCM str);
 SCM_API /* FIXME: not internal */ char *scm_i_string_writable_chars (SCM str);
 SCM_INTERNAL const scm_t_wchar *scm_i_string_wide_chars (SCM str);
diff --git a/libguile/uniform.c b/libguile/uniform.c
index f7ca7bce9..13ee18a0c 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -67,18 +67,21 @@ scm_array_handle_uniform_element_bit_size (scm_t_array_handle *h)
 const void *
 scm_array_handle_uniform_elements (scm_t_array_handle *h)
 {
-  return scm_array_handle_uniform_writable_elements (h);
+  size_t esize;
+  const scm_t_uint8 *ret;
+
+  esize = scm_array_handle_uniform_element_size (h);
+  ret = ((const scm_t_uint8 *) h->elements) + h->base * esize;
+  return ret;
 }
 
 void *
 scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
 {
-  size_t esize;
-  scm_t_uint8 *ret;
+  if (h->writable_elements != h->elements)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "mutable array");
 
-  esize = scm_array_handle_uniform_element_size (h);
-  ret = ((scm_t_uint8*) h->writable_elements) + h->base * esize;
-  return ret;
+  return (void *) scm_array_handle_uniform_elements (h);
 }
 
 void
diff --git a/libguile/vectors.c b/libguile/vectors.c
index b9613c50f..328cf6f5f 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -42,6 +42,12 @@
 
 #define VECTOR_MAX_LENGTH (SCM_T_BITS_MAX >> 8)
 
+#define SCM_VALIDATE_MUTABLE_VECTOR(pos, v)                             \
+  do {                                                                  \
+    SCM_ASSERT (SCM_I_IS_MUTABLE_VECTOR (v), v, pos, FUNC_NAME);        \
+  } while (0)
+
+
 int
 scm_is_vector (SCM obj)
 {
@@ -58,14 +64,6 @@ const SCM *
 scm_vector_elements (SCM vec, scm_t_array_handle *h,
 		     size_t *lenp, ssize_t *incp)
 {
-  /* guard against weak vectors in the next call */
-  return scm_vector_writable_elements (vec, h, lenp, incp);
-}
-
-SCM *
-scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
-			      size_t *lenp, ssize_t *incp)
-{
   /* it's unsafe to access the memory of a weak vector */
   if (SCM_I_WVECTP (vec))
     scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
@@ -77,7 +75,19 @@ scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
       *lenp = dim->ubnd - dim->lbnd + 1;
       *incp = dim->inc;
     }
-  return scm_array_handle_writable_elements (h);
+  return scm_array_handle_elements (h);
+}
+
+SCM *
+scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
+			      size_t *lenp, ssize_t *incp)
+{
+  const SCM *ret = scm_vector_elements (vec, h, lenp, incp);
+
+  if (h->writable_elements != h->elements)
+    scm_wrong_type_arg_msg (NULL, 0, vec, "mutable vector");
+
+  return (SCM *) ret;
 }
 
 SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, 
@@ -203,7 +213,7 @@ void
 scm_c_vector_set_x (SCM v, size_t k, SCM obj)
 #define FUNC_NAME s_scm_vector_set_x
 {
-  SCM_VALIDATE_VECTOR (1, v);
+  SCM_VALIDATE_MUTABLE_VECTOR (1, v);
 
   if (k >= SCM_I_VECTOR_LENGTH (v))
     scm_out_of_range (NULL, scm_from_size_t (k)); 
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 995f64f4e..d279787c8 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -63,6 +63,14 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 
 /* Internals */
 
+/* Vectors residualized into compiled objects have scm_tc7_vector in the
+   low 7 bits, but also an additional bit set to indicate
+   immutability.  */
+#define SCM_F_VECTOR_IMMUTABLE 0x80UL
+#define SCM_I_IS_MUTABLE_VECTOR(x)                              \
+  (SCM_NIMP (x) &&                                              \
+   ((SCM_CELL_TYPE (x) & (0x7f | SCM_F_VECTOR_IMMUTABLE))       \
+    == scm_tc7_vector))
 #define SCM_I_IS_VECTOR(x)     (SCM_HAS_TYP7 (x, scm_tc7_vector))
 #define SCM_I_VECTOR_ELTS(x)   ((const SCM *) SCM_I_VECTOR_WELTS (x))
 #define SCM_I_VECTOR_WELTS(x)  (SCM_CELL_OBJECT_LOC (x, 1))
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index cb7d4aa12..6c88ebf11 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -420,6 +420,8 @@
   VM_VALIDATE (x, scm_is_atomic_box, proc, atomic_box)
 #define VM_VALIDATE_BYTEVECTOR(x, proc)                                 \
   VM_VALIDATE (x, SCM_BYTEVECTOR_P, proc, bytevector)
+#define VM_VALIDATE_MUTABLE_BYTEVECTOR(obj, proc)                       \
+  VM_VALIDATE (obj, SCM_MUTABLE_BYTEVECTOR_P, proc, mutable_bytevector)
 #define VM_VALIDATE_CHAR(x, proc)                                       \
   VM_VALIDATE (x, SCM_CHARP, proc, char)
 #define VM_VALIDATE_PAIR(x, proc)                                       \
@@ -434,6 +436,8 @@
   VM_VALIDATE (obj, SCM_VARIABLEP, proc, variable)
 #define VM_VALIDATE_VECTOR(obj, proc)                                   \
   VM_VALIDATE (obj, SCM_I_IS_VECTOR, proc, vector)
+#define VM_VALIDATE_MUTABLE_VECTOR(obj, proc)                           \
+  VM_VALIDATE (obj, SCM_I_IS_MUTABLE_VECTOR, proc, mutable_vector)
 
 #define VM_VALIDATE_INDEX(u64, size, proc)                              \
   VM_ASSERT (u64 < size, vm_error_out_of_range_uint64 (proc, u64))
@@ -2690,7 +2694,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       c_idx = SP_REF_U64 (idx);
       val = SP_REF (src);
 
-      VM_VALIDATE_VECTOR (vect, "vector-set!");
+      VM_VALIDATE_MUTABLE_VECTOR (vect, "vector-set!");
       VM_VALIDATE_INDEX (c_idx, SCM_I_VECTOR_LENGTH (vect), "vector-set!");
       SCM_I_VECTOR_WELTS (vect)[c_idx] = val;
       NEXT (1);
@@ -2710,7 +2714,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       vect = SP_REF (dst);
       val = SP_REF (src);
 
-      VM_VALIDATE_VECTOR (vect, "vector-set!");
+      VM_VALIDATE_MUTABLE_VECTOR (vect, "vector-set!");
       VM_VALIDATE_INDEX (idx, SCM_I_VECTOR_LENGTH (vect), "vector-set!");
       SCM_I_VECTOR_WELTS (vect)[idx] = val;
       NEXT (1);
@@ -3044,7 +3048,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
     c_idx = SP_REF_U64 (idx);                                           \
     slot_val = SP_REF_ ## slot (src);                                   \
 									\
-    VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!");                   \
+    VM_VALIDATE_MUTABLE_BYTEVECTOR (bv, "bv-" #stem "-set!");           \
 									\
     VM_ASSERT (SCM_BYTEVECTOR_LENGTH (bv) >= size                       \
                && SCM_BYTEVECTOR_LENGTH (bv) - size >= c_idx,           \
@@ -3070,7 +3074,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
     c_idx = SP_REF_U64 (idx);                                           \
     val = SP_REF_ ## slot (src);                                        \
 									\
-    VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!");                   \
+    VM_VALIDATE_MUTABLE_BYTEVECTOR (bv, "bv-" #stem "-set!");           \
 									\
     VM_ASSERT (SCM_BYTEVECTOR_LENGTH (bv) >= size                       \
                && SCM_BYTEVECTOR_LENGTH (bv) - size >= c_idx,           \
diff --git a/libguile/vm.c b/libguile/vm.c
index ea2bfbd0c..18f219249 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -433,8 +433,10 @@ static void vm_error_not_a_mutable_pair (const char *subr, SCM x) SCM_NORETURN S
 static void vm_error_not_a_string (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_not_a_atomic_box (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_not_a_bytevector (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_not_a_mutable_bytevector (const char *subr, SCM v) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_not_a_vector (const char *subr, SCM v) SCM_NORETURN SCM_NOINLINE;
+static void vm_error_not_a_mutable_vector (const char *subr, SCM v) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_out_of_range_uint64 (const char *subr, scm_t_uint64 idx) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_out_of_range_int64 (const char *subr, scm_t_int64 idx) SCM_NORETURN SCM_NOINLINE;
 static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
@@ -553,6 +555,12 @@ vm_error_not_a_bytevector (const char *subr, SCM x)
 }
 
 static void
+vm_error_not_a_mutable_bytevector (const char *subr, SCM x)
+{
+  scm_wrong_type_arg_msg (subr, 1, x, "mutable bytevector");
+}
+
+static void
 vm_error_not_a_struct (const char *subr, SCM x)
 {
   scm_wrong_type_arg_msg (subr, 1, x, "struct");
@@ -565,6 +573,12 @@ vm_error_not_a_vector (const char *subr, SCM x)
 }
 
 static void
+vm_error_not_a_mutable_vector (const char *subr, SCM x)
+{
+  scm_wrong_type_arg_msg (subr, 1, x, "mutable vector");
+}
+
+static void
 vm_error_out_of_range_uint64 (const char *subr, scm_t_uint64 idx)
 {
   scm_out_of_range (subr, scm_from_uint64 (idx));
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 56c33be81..cfccd5b66 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1392,17 +1392,27 @@ should be .data or .rodata), and return the resulting linker object.
     (+ address
        (modulo (- alignment (modulo address alignment)) alignment)))
 
-  (define tc7-vector 13)
+  (define tc7-vector #x0d)
+  (define vector-immutable-flag #x80)
+
+  (define tc7-string #x15)
+  (define string-read-only-flag #x200)
+
+  (define tc7-stringbuf #x27)
   (define stringbuf-wide-flag #x400)
-  (define tc7-stringbuf 39)
-  (define tc7-narrow-stringbuf tc7-stringbuf)
-  (define tc7-wide-stringbuf (+ tc7-stringbuf stringbuf-wide-flag))
-  (define tc7-ro-string (+ 21 #x200))
+
   (define tc7-syntax #x3d)
-  (define tc7-program 69)
-  (define tc7-bytevector 77)
-  (define tc7-bitvector 95)
-  (define tc7-array 93)
+
+  (define tc7-program #x45)
+
+  (define tc7-bytevector #x4d)
+  ;; This flag is intended to be left-shifted by 7 bits.
+  (define bytevector-immutable-flag #x200)
+
+  (define tc7-array #x5d)
+
+  (define tc7-bitvector #x5f)
+  (define bitvector-immutable-flag #x80)
 
   (let ((word-size (asm-word-size asm))
         (endianness (asm-endianness asm)))
@@ -1447,9 +1457,10 @@ should be .data or .rodata), and return the resulting linker object.
        ((stringbuf? obj)
         (let* ((x (stringbuf-string obj))
                (len (string-length x))
-               (tag (if (= (string-bytes-per-char x) 1)
-                        tc7-narrow-stringbuf
-                        tc7-wide-stringbuf)))
+               (tag (logior tc7-stringbuf
+                            (if (= (string-bytes-per-char x) 1)
+                                0
+                                stringbuf-wide-flag))))
           (case word-size
             ((4)
              (bytevector-u32-set! buf pos tag endianness)
@@ -1491,15 +1502,15 @@ should be .data or .rodata), and return the resulting linker object.
         (write-placeholder asm buf pos))
 
        ((string? obj)
-        (let ((tag (logior tc7-ro-string (ash (string-length obj) 8)))) ; FIXME: unused?
+        (let ((tag (logior tc7-string string-read-only-flag)))
           (case word-size
             ((4)
-             (bytevector-u32-set! buf pos tc7-ro-string endianness)
+             (bytevector-u32-set! buf pos tag endianness)
              (write-placeholder asm buf (+ pos 4)) ; stringbuf
              (bytevector-u32-set! buf (+ pos 8) 0 endianness)
              (bytevector-u32-set! buf (+ pos 12) (string-length obj) endianness))
             ((8)
-             (bytevector-u64-set! buf pos tc7-ro-string endianness)
+             (bytevector-u64-set! buf pos tag endianness)
              (write-placeholder asm buf (+ pos 8)) ; stringbuf
              (bytevector-u64-set! buf (+ pos 16) 0 endianness)
              (bytevector-u64-set! buf (+ pos 24) (string-length obj) endianness))
@@ -1511,7 +1522,7 @@ should be .data or .rodata), and return the resulting linker object.
 
        ((simple-vector? obj)
         (let* ((len (vector-length obj))
-               (tag (logior tc7-vector (ash len 8))))
+               (tag (logior tc7-vector vector-immutable-flag (ash len 8))))
           (case word-size
             ((4) (bytevector-u32-set! buf pos tag endianness))
             ((8) (bytevector-u64-set! buf pos tag endianness))
@@ -1546,9 +1557,14 @@ should be .data or .rodata), and return the resulting linker object.
 
        ((simple-uniform-vector? obj)
         (let ((tag (if (bitvector? obj)
-                       tc7-bitvector
-                       (let ((type-code (array-type-code obj)))
-                         (logior tc7-bytevector (ash type-code 7))))))
+                       (logior tc7-bitvector
+                               bitvector-immutable-flag)
+                       (logior tc7-bytevector
+                               ;; Bytevector immutable flag also shifted
+                               ;; left.
+                               (ash (logior bytevector-immutable-flag
+                                            (array-type-code obj))
+                                    7)))))
           (case word-size
             ((4)
              (bytevector-u32-set! buf pos tag endianness)