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);