summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-05-07 14:57:15 +0200
committerAndy Wingo <wingo@pobox.com>2011-05-07 14:57:15 +0200
commit059a588fedf377ffd32cc1f1fee7ed829b263890 (patch)
treefe9e620b9503457f780434d3a1778de6b514837b
parent5eb75b5de08ea8eb86a4760e1454460b61b4bccc (diff)
downloadguile-059a588fedf377ffd32cc1f1fee7ed829b263890.tar.gz
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.
-rw-r--r--libguile/bytevectors.c29
-rw-r--r--libguile/bytevectors.h10
-rw-r--r--libguile/foreign.c4
-rw-r--r--libguile/objcodes.c7
-rw-r--r--libguile/r6rs-ports.c10
-rw-r--r--libguile/srfi-4.c5
-rw-r--r--libguile/strings.c2
-rw-r--r--libguile/vm.c3
8 files changed, 45 insertions, 25 deletions
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index a969e3bb4..4ca3c4e25 100644
--- a/libguile/bytevectors.c
+++ b/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
- by CONTENTS must have been allocated using `scm_gc_malloc ()'. */
+/* Return a bytevector of size LEN made up of CONTENTS. The area
+ 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
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index 431b7dddd..4b775f244 100644
--- a/libguile/bytevectors.h
+++ b/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 *);
diff --git a/libguile/foreign.c b/libguile/foreign.c
index ae9e27a8d..8081c5e3d 100644
--- a/libguile/foreign.c
+++ b/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);
- register_weak_reference (ret, pointer);
+ ret = scm_c_take_typed_bytevector (ptr + boffset, blen, btype, pointer);
+
return ret;
}
#undef FUNC_NAME
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 448badafb..bfa13bca9 100644
--- a/libguile/objcodes.c
+++ b/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);
- memcpy (s8vector, SCM_OBJCODE_DATA (objcode), len);
-
- return scm_c_take_bytevector (s8vector, len);
+ return scm_c_take_bytevector ((scm_t_int8*)SCM_OBJCODE_DATA (objcode),
+ len, objcode);
}
#undef FUNC_NAME
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index b9d52829f..16890505f 100644
--- a/libguile/r6rs-ports.c
+++ b/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;
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index af8126d03..ff0c414d7 100644
--- a/libguile/srfi-4.c
+++ b/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) \
{ \
diff --git a/libguile/strings.c b/libguile/strings.c
index bf637041c..628dffd01 100644
--- a/libguile/strings.c
+++ b/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);
diff --git a/libguile/vm.c b/libguile/vm.c
index e8f8ddf01..e9d96194c 100644
--- a/libguile/vm.c
+++ b/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);