bytevectors have internal parent field

* libguile/bytevectors.h (SCM_BYTEVECTOR_HEADER_SIZE): Bump, giving
  bytevectors another word: a parent pointer.  Will allow for
  sub-bytevectors and efficient mmap bindings.

* libguile/bytevectors.c (make_bytevector):
  (make_bytevector_from_buffer): Init parent to #f.
  (scm_c_take_bytevector, scm_c_take_typed_bytevector): Another
  argument, the parent, which gets set in the bytevector.

* libguile/foreign.c (scm_pointer_to_bytevector): Use the parent field
  instead of registering a weak reference from bytevector to foreign
  pointer.

* libguile/objcodes.c (scm_objcode_to_bytecode): Use the parent field to
  avoid copying the objcode.

* libguile/srfi-4.c (DEFINE_SRFI_4_C_FUNCS):
* libguile/strings.c (scm_from_stringn):
* libguile/vm.c (really_make_boot_program):
* libguile/r6rs-ports.c (scm_get_bytevector_some)
  (scm_get_bytevector_all, bytevector_output_port_procedure): Set the
  parent to #f.

libguile/bytevectors.c

@@ -193,6 +193,9 @@
   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_BYTEVECTOR_TYPE_SIZE(var)                           \
   (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
 #define SCM_BYTEVECTOR_TYPED_LENGTH(var)                        \
@@ -233,6 +236,7 @@ make_bytevector (size_t len, scm_t_array_element_type element_type)
       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);
     }
 
   return ret;
@@ -262,6 +266,7 @@ make_bytevector_from_buffer (size_t len, void *contents,
       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);
     }
 
   return ret;
@@ -282,19 +287,31 @@ scm_i_make_typed_bytevector (size_t len, scm_t_array_element_type element_type)
   return make_bytevector (len, element_type);
 }
 
-/* Return a bytevector of size LEN made up of CONTENTS.  The area pointed to
+/* Return a bytevector of size LEN made up of CONTENTS.  The area
-   by CONTENTS must have been allocated using `scm_gc_malloc ()'.  */
+   pointed to by CONTENTS must be protected from GC somehow: either
+   because it was allocated using `scm_gc_malloc ()', or because it is
+   part of PARENT.  */
 SCM
-scm_c_take_bytevector (signed char *contents, size_t len)
+scm_c_take_bytevector (signed char *contents, size_t len, SCM parent)
 {
-  return make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
+  SCM ret;
+
+  ret = make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
+  SCM_BYTEVECTOR_SET_PARENT (ret, parent);
+
+  return ret;
 }
 
 SCM
 scm_c_take_typed_bytevector (signed char *contents, size_t len,
-                             scm_t_array_element_type element_type)
+                             scm_t_array_element_type element_type, SCM parent)
 {
-  return make_bytevector_from_buffer (len, contents, element_type);
+  SCM ret;
+
+  ret = make_bytevector_from_buffer (len, contents, element_type);
+  SCM_BYTEVECTOR_SET_PARENT (ret, parent);
+
+  return ret;
 }
 
 /* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current

libguile/bytevectors.h

@@ -1,7 +1,7 @@
 #ifndef SCM_BYTEVECTORS_H
 #define SCM_BYTEVECTORS_H
 
-/* Copyright (C) 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -28,12 +28,14 @@
 
 /* The size in words of the bytevector header (type tag and flags, length,
    and pointer to the underlying buffer).  */
-#define SCM_BYTEVECTOR_HEADER_SIZE   3U
+#define SCM_BYTEVECTOR_HEADER_SIZE   4U
 
 #define SCM_BYTEVECTOR_LENGTH(_bv)		\
   ((size_t) SCM_CELL_WORD_1 (_bv))
 #define SCM_BYTEVECTOR_CONTENTS(_bv)		\
   ((signed char *) SCM_CELL_WORD_2 (_bv))
+#define SCM_BYTEVECTOR_PARENT(_bv)		\
+  (SCM_CELL_OBJECT_3 (_bv))
 
 
 SCM_API SCM scm_endianness_big;
@@ -132,13 +134,13 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
 
 SCM_INTERNAL SCM scm_i_make_typed_bytevector (size_t, scm_t_array_element_type);
 SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
-                                              scm_t_array_element_type);
+                                              scm_t_array_element_type, SCM);
 
 SCM_INTERNAL void scm_bootstrap_bytevectors (void);
 SCM_INTERNAL void scm_init_bytevectors (void);
 
 SCM_INTERNAL SCM scm_i_native_endianness;
-SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t);
+SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t, SCM);
 
 SCM_INTERNAL int scm_i_print_bytevector (SCM, SCM, scm_print_state *);
 

libguile/foreign.c

@@ -269,8 +269,8 @@ SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0,
 
   blen = scm_to_size_t (len);
 
-  ret = scm_c_take_typed_bytevector (ptr + boffset, blen, btype);
+  ret = scm_c_take_typed_bytevector (ptr + boffset, blen, btype, pointer);
-  register_weak_reference (ret, pointer);
+
   return ret;
 }
 #undef FUNC_NAME

libguile/objcodes.c

@@ -308,17 +308,14 @@ SCM_DEFINE (scm_objcode_to_bytecode, "objcode->bytecode", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_objcode_to_bytecode
 {
-  scm_t_int8 *s8vector;
   scm_t_uint32 len;
 
   SCM_VALIDATE_OBJCODE (1, objcode);
 
   len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode);
 
-  s8vector = scm_malloc (len);
+  return scm_c_take_bytevector ((scm_t_int8*)SCM_OBJCODE_DATA (objcode),
-  memcpy (s8vector, SCM_OBJCODE_DATA (objcode), len);
+                                len, objcode);
-
-  return scm_c_take_bytevector (s8vector, len);
 }
 #undef FUNC_NAME
 

libguile/r6rs-ports.c

@@ -621,7 +621,8 @@ SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
 	  c_len = (unsigned) c_total;
 	}
 
-      result = scm_c_take_bytevector ((signed char *) c_bv, c_len);
+      result = scm_c_take_bytevector ((signed char *) c_bv, c_len,
+                                      SCM_BOOL_F);
     }
 
   return result;
@@ -680,7 +681,8 @@ SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
 	  c_len = (unsigned) c_total;
 	}
 
-      result = scm_c_take_bytevector ((signed char *) c_bv, c_len);
+      result = scm_c_take_bytevector ((signed char *) c_bv, c_len,
+                                      SCM_BOOL_F);
     }
 
   return result;
@@ -922,7 +924,7 @@ SCM_SMOB_APPLY (bytevector_output_port_procedure,
   bop_buffer_init (buf);
 
   if (result_buf.len == 0)
-    bv = scm_c_take_bytevector (NULL, 0);
+    bv = scm_c_take_bytevector (NULL, 0, SCM_BOOL_F);
   else
     {
       if (result_buf.total_len > result_buf.len)
@@ -933,7 +935,7 @@ SCM_SMOB_APPLY (bytevector_output_port_procedure,
 					    SCM_GC_BOP);
 
       bv = scm_c_take_bytevector ((signed char *) result_buf.buffer,
-				       result_buf.len);
+                                  result_buf.len, SCM_BOOL_F);
     }
 
   return bv;

libguile/srfi-4.c

@@ -1,6 +1,6 @@
 /* srfi-4.c --- Uniform numeric vector datatypes.
  *
- * 	Copyright (C) 2001, 2004, 2006, 2009, 2010 Free Software Foundation, Inc.
+ * 	Copyright (C) 2001, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -113,7 +113,8 @@
 #define DEFINE_SRFI_4_C_FUNCS(TAG, tag, ctype, width)                   \
   SCM scm_take_##tag##vector (ctype *data, size_t n)                    \
   {                                                                     \
-    return scm_c_take_typed_bytevector ((scm_t_int8*)data, n, ETYPE (TAG));   \
+    return scm_c_take_typed_bytevector ((scm_t_int8*)data, n, ETYPE (TAG), \
+                                        SCM_BOOL_F);                    \
   }                                                                     \
   const ctype* scm_array_handle_##tag##_elements (scm_t_array_handle *h) \
   {                                                                     \

libguile/strings.c

@@ -1489,7 +1489,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding,
 
       buf = scm_gc_malloc_pointerless (len, "bytevector");
       memcpy (buf, str, len);
-      bv = scm_c_take_bytevector (buf, len);
+      bv = scm_c_take_bytevector (buf, len, SCM_BOOL_F);
 
       scm_decoding_error (__func__, errno,
 			  "input locale conversion error", bv);

libguile/vm.c

@@ -390,7 +390,8 @@ really_make_boot_program (long nargs)
   bp->metalen = 0;
 
   u8vec = scm_c_take_bytevector ((scm_t_int8*)bp,
-                                 sizeof (struct scm_objcode) + sizeof (text));
+                                 sizeof (struct scm_objcode) + sizeof (text),
+                                 SCM_BOOL_F);
   ret = scm_make_program (scm_bytecode_to_objcode (u8vec),
                           SCM_BOOL_F, SCM_BOOL_F);
   SCM_SET_CELL_WORD_0 (ret, SCM_CELL_WORD_0 (ret) | SCM_F_PROGRAM_IS_BOOT);