guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, srfi-4-bytevectors, updated. release_1


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, srfi-4-bytevectors, updated. release_1-9-0-39-gc3d3817
Date: Thu, 02 Jul 2009 16:00:02 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c3d381785dd26fbacea731cc12dc91ebf45dcf2c

The branch, srfi-4-bytevectors has been updated
       via  c3d381785dd26fbacea731cc12dc91ebf45dcf2c (commit)
       via  ff4c5b5432e3615010e7d7c3b955575e18aab203 (commit)
       via  66d1ef1b2c56d493b9ee433d46177ee3e518a3ad (commit)
      from  1b1922e51c050acc087e7bb0ba5bccde0ad6c9af (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit c3d381785dd26fbacea731cc12dc91ebf45dcf2c
Author: Andy Wingo <address@hidden>
Date:   Thu Jul 2 17:59:59 2009 +0200

    srfi-4 vects are representable using bytevectors, not switched yet
    
    * libguile/bytevectors.h (SCM_BYTEVECTOR_INLINE_THRESHOLD)
      (SCM_BYTEVECTOR_INLINEABLE_SIZE_P): Move these to the .c file.
      (SCM_BYTEVECTOR_TYPE_HINT_NONE)
      (SCM_BYTEVECTOR_TYPE_HINT_U8)
      (SCM_BYTEVECTOR_TYPE_HINT_S8)
      (SCM_BYTEVECTOR_TYPE_HINT_U16)
      (SCM_BYTEVECTOR_TYPE_HINT_S16)
      (SCM_BYTEVECTOR_TYPE_HINT_U32)
      (SCM_BYTEVECTOR_TYPE_HINT_S32)
      (SCM_BYTEVECTOR_TYPE_HINT_U64)
      (SCM_BYTEVECTOR_TYPE_HINT_S64)
      (SCM_BYTEVECTOR_TYPE_HINT_F32)
      (SCM_BYTEVECTOR_TYPE_HINT_F64)
      (SCM_BYTEVECTOR_TYPE_HINT_C32)
      (SCM_BYTEVECTOR_TYPE_HINT_C64)
      (SCM_BYTEVECTOR_TYPE_HINT_LAST): New exciting type hints. Since
      bytevectors need to be able to print themselves, and srfi-4 will need
      to be able to create a typed bytevector, this knowledge must be shared
      between the two. It's internal API, though.
      (scm_c_take_bytevector): This internal func takes an additional arg,
      the type hint.
    
    * libguile/bytevectors.c (type_sizes, type_tags): Arrays for the unit
      sizes and #foo() tags for the various hinted types of byte vectors.
      (make_bytevector, make_bytevector_from_buffer, scm_c_take_bytevector):
      Take an extra type hint param. Callers adapted.
      (scm_i_shrink_bytevector): Fix shrinking for inlined bytevectors.
      (print_bytevector): Print hinted bytevectors appropriately. Neat :)
    
    * libguile/r6rs-ports.c: Adapt to scm_c_take_bytevector changes.

commit ff4c5b5432e3615010e7d7c3b955575e18aab203
Author: Andy Wingo <address@hidden>
Date:   Thu Jul 2 17:46:23 2009 +0200

    fix race in which some instruction name symbols could go unmarked
    
    * libguile/instructions.c: In loops, replace scm_op_last with
      SCM_VM_NUM_INSTRUCTIONS.
      (fetch_instruction_table): Protect the instruction symbols from
      collection. Before they were only marked by the name->opcode hash
      table, leading to races in which they could be collected.
      (scm_lookup_instruction_by_name): Protect the hash table earlier, as
      it's not actually a stack variable, since it's static.

commit 66d1ef1b2c56d493b9ee433d46177ee3e518a3ad
Author: Andy Wingo <address@hidden>
Date:   Thu Jul 2 17:43:07 2009 +0200

    fix bounds checks for the last element of bv-*-{ref,set}
    
    * libguile/vm-i-scheme.c (BV_FIXABLE_INT_REF, BV_INT_REF):
      (BV_FLOAT_REF, BV_FIXABLE_INT_SET, BV_INT_SET, BV_FLOAT_SET): Fix the
      bounds check for the last element.

-----------------------------------------------------------------------

Summary of changes:
 libguile/bytevectors.c  |  152 +++++++++++++++++++++++++++++++++++++++--------
 libguile/bytevectors.h  |   19 +++++-
 libguile/instructions.c |   17 +++---
 libguile/instructions.h |    1 -
 libguile/r6rs-ports.c   |   11 ++-
 libguile/vm-i-scheme.c  |   14 ++--
 6 files changed, 166 insertions(+), 48 deletions(-)

diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index b83c514..4fb5d25 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -174,22 +174,58 @@
 
 scm_t_bits scm_tc16_bytevector;
 
+#define SCM_BYTEVECTOR_INLINE_THRESHOLD  (2 * sizeof (SCM))
+#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size)        \
+  ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
 #define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)   \
   SCM_SET_SMOB_DATA ((_bv), (scm_t_bits) (_len))
 #define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf) \
   SCM_SET_SMOB_DATA_2 ((_bv), (scm_t_bits) (_buf))
 #define SCM_BYTEVECTOR_SET_INLINE(bv)                                   \
   SCM_SET_SMOB_FLAGS (bv, SCM_SMOB_FLAGS (bv) | SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_SET_TYPE_HINT(bv, hint)                          \
+  SCM_SET_SMOB_FLAGS (bv, (SCM_SMOB_FLAGS (bv) & 0xFF) | (hint << 8))
 
 /* The empty bytevector.  */
 SCM scm_null_bytevector = SCM_UNSPECIFIED;
 
 
+/* This array maps type tags to the size of the elements.  */
+static const int type_sizes[13] = {
+  1,
+  1, 1,
+  2, 2,
+  4, 4,
+#if SCM_HAVE_T_INT64
+  8, 8,
+#else
+  sizeof (SCM), sizeof (SCM),
+#endif
+  sizeof(float), sizeof(double),
+  2*sizeof(float), 2*sizeof(double)
+};
+
+static const char *type_tags[13] = {
+  "vu8",
+  "u8", "s8",
+  "u16", "s16",
+  "u32", "s32",
+  "u64", "s64",
+  "f32", "f64",
+  "c32", "c64",
+};
+
+
 static inline SCM
-make_bytevector_from_buffer (size_t len, signed char *contents)
+make_bytevector_from_buffer (size_t len, signed char *contents,
+                             scm_t_uint8 type_hint)
 {
   SCM ret;
-  /* Assuming LEN > SCM_BYTEVECTOR_INLINE_THRESHOLD.  */
+  if (SCM_UNLIKELY (type_hint > SCM_BYTEVECTOR_TYPE_HINT_LAST
+                    || len % type_sizes[type_hint]))
+    /* This would be an internal Guile programming error */
+    abort ();
+  
   if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
     SCM_NEWSMOB2 (ret, scm_tc16_bytevector, len, contents);
   else
@@ -202,32 +238,46 @@ make_bytevector_from_buffer (size_t len, signed char 
*contents)
           scm_gc_free (contents, len, SCM_GC_BYTEVECTOR);
         }
     }
+  SCM_BYTEVECTOR_SET_TYPE_HINT (ret, type_hint);
   return ret;
 }
 
 static inline SCM
-make_bytevector (size_t len)
+make_bytevector (size_t len, scm_t_uint8 type_hint)
 {
-  if (SCM_UNLIKELY (len == 0))
+  if (SCM_UNLIKELY (len == 0 && type_hint == 0))
     return scm_null_bytevector;
+  else if (SCM_UNLIKELY (type_hint > SCM_BYTEVECTOR_TYPE_HINT_LAST
+                         || len % type_sizes[type_hint]))
+    /* This would be an internal Guile programming error */
+    abort ();
+  else if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
+    {
+      SCM ret;
+      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, len, NULL);
+      SCM_BYTEVECTOR_SET_INLINE (ret);
+      SCM_BYTEVECTOR_SET_TYPE_HINT (ret, type_hint);
+      return ret;
+    }
   else
     return make_bytevector_from_buffer (len,
-                                        scm_gc_malloc (len, 
SCM_GC_BYTEVECTOR));
+                                        scm_gc_malloc (len, SCM_GC_BYTEVECTOR),
+                                        type_hint);
 }
 
 /* Return a new bytevector of size LEN octets.  */
 SCM
 scm_c_make_bytevector (size_t len)
 {
-  return (make_bytevector (len));
+  return make_bytevector (len, SCM_BYTEVECTOR_TYPE_HINT_NONE);
 }
 
 /* Return a bytevector of size LEN made up of CONTENTS.  The area pointed to
    by CONTENTS must have been allocated using `scm_gc_malloc ()'.  */
 SCM
-scm_c_take_bytevector (signed char *contents, size_t len)
+scm_c_take_bytevector (signed char *contents, size_t len, scm_t_uint8 
type_hint)
 {
-  return make_bytevector_from_buffer (len, contents);
+  return make_bytevector_from_buffer (len, contents, type_hint);
 }
 
 /* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
@@ -235,6 +285,10 @@ scm_c_take_bytevector (signed char *contents, size_t len)
 SCM
 scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
 {
+  if (SCM_UNLIKELY (c_new_len % type_sizes[SCM_BYTEVECTOR_TYPE_HINT (bv)]))
+    /* This would be an internal Guile programming error */
+    abort ();
+
   if (!SCM_BYTEVECTOR_INLINE_P (bv))
     {
       size_t c_len;
@@ -261,6 +315,8 @@ scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
          SCM_BYTEVECTOR_SET_CONTENTS (bv, c_new_bv);
        }
     }
+  else
+    SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
 
   return bv;
 }
@@ -324,26 +380,71 @@ void
 scm_i_bytevector_generalized_set_x (SCM bv, size_t index, SCM value)
 #define FUNC_NAME "scm_i_bytevector_generalized_set_x"
 {
+  /* FIXME Think more about what this should do if we have a hinted type */
   scm_c_bytevector_set_x (bv, index, scm_to_uint8 (value));
 }
 #undef FUNC_NAME
 
+static SCM
+bytevector_ref_c32 (SCM bv, SCM idx)
+{ /* checks are unnecessary here */
+  const float *contents = (const float*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/4], contents[i/4 + 1]);
+}
+
+static SCM
+bytevector_ref_c64 (SCM bv, SCM idx)
+{ /* checks are unnecessary here */
+  const double *contents = (const double*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/8], contents[i/8 + 1]);
+}
+
+typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
+
+const scm_t_bytevector_ref_fn bytevector_ref_fns[] = 
+{ scm_bytevector_u8_ref,
+  scm_bytevector_u8_ref,
+  scm_bytevector_s8_ref,
+  scm_bytevector_u16_native_ref,
+  scm_bytevector_s16_native_ref,
+  scm_bytevector_u32_native_ref,
+  scm_bytevector_s32_native_ref,
+  scm_bytevector_u64_native_ref,
+  scm_bytevector_s64_native_ref,
+  scm_bytevector_ieee_single_native_ref,
+  scm_bytevector_ieee_double_native_ref,
+  bytevector_ref_c32,
+  bytevector_ref_c64
+};
+
+
 static int
 print_bytevector (SCM bv, SCM port, scm_print_state *pstate)
 {
-  unsigned c_len, i;
-  unsigned char *c_bv;
-
+  size_t c_len, i;
+  scm_t_uint8 type_hint;
+  const char *tag;
+  int unit_size;
+  scm_t_bytevector_ref_fn ref;
+  
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
-
-  scm_puts ("#vu8(", port);
-  for (i = 0; i < c_len; i++)
+  type_hint = SCM_BYTEVECTOR_TYPE_HINT (bv);
+  
+  tag = type_tags[type_hint];
+  unit_size = type_sizes[type_hint];
+  ref = bytevector_ref_fns[type_hint];
+  
+  scm_putc ('#', port);
+  scm_puts (tag, port);
+  scm_putc ('(', port);
+  for (i = 0; i < c_len; i+=unit_size)
     {
       if (i > 0)
        scm_putc (' ', port);
 
-      scm_uintprint (c_bv[i], 10, port);
+      scm_write (ref (bv, scm_from_size_t (i)), port);
     }
 
   scm_putc (')', port);
@@ -437,7 +538,7 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
       c_fill = (signed char) value;
     }
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_BYTEVECTOR_TYPE_HINT_NONE);
   if (fill != SCM_UNDEFINED)
     {
       unsigned i;
@@ -563,7 +664,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
   c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
 
-  copy = make_bytevector (c_len);
+  copy = make_bytevector (c_len, SCM_BYTEVECTOR_TYPE_HINT (bv));
   c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
   memcpy (c_copy, c_bv, c_len);
 
@@ -593,7 +694,7 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, 
"uniform-array->bytevector",
   len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
   sz = scm_array_handle_uniform_element_size (&h);
 
-  ret = make_bytevector (len * sz);
+  ret = make_bytevector (len * sz, SCM_BYTEVECTOR_TYPE_HINT_NONE);
   memcpy (SCM_BYTEVECTOR_CONTENTS (ret), base, len * sz);
 
   scm_array_handle_release (&h);
@@ -682,7 +783,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, 
"u8-list->bytevector", 1, 0, 0,
 
   SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_BYTEVECTOR_TYPE_HINT_NONE);
   c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
@@ -1119,7 +1220,7 @@ SCM_DEFINE (scm_bytevector_to_uint_list, 
"bytevector->uint-list",
   if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))   \
     scm_out_of_range (FUNC_NAME, size);                                        
\
                                                                        \
-  bv = make_bytevector (c_len * c_size);                               \
+  bv = make_bytevector (c_len * c_size, SCM_BYTEVECTOR_TYPE_HINT_NONE); \
   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);                                
\
                                                                        \
   for (c_bv_ptr = c_bv;                                                        
\
@@ -1886,7 +1987,8 @@ utf_encoding_name (char *name, size_t utf_width, SCM 
endianness)
   else                                                                 \
     /* C_UTF is null-terminated.  */                                   \
     utf = scm_c_take_bytevector ((signed char *) c_utf,                        
\
-                                     c_utf_len);                       \
+                                 c_utf_len,                             \
+                                 SCM_BYTEVECTOR_TYPE_HINT_NONE);        \
                                                                        \
   return (utf);
 
@@ -1922,7 +2024,8 @@ SCM_DEFINE (scm_string_to_utf8, "string->utf8",
   else
     /* C_UTF is null-terminated.  */
     utf = scm_c_take_bytevector ((signed char *) c_utf,
-                                     UTF_STRLEN (8, c_utf));
+                                 UTF_STRLEN (8, c_utf),
+                                 SCM_BYTEVECTOR_TYPE_HINT_NONE);
 
   return (utf);
 }
@@ -2062,7 +2165,8 @@ scm_bootstrap_bytevectors (void)
   scm_set_smob_equalp (scm_tc16_bytevector, bytevector_equal_p);
 
   scm_null_bytevector =
-    scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
+    scm_gc_protect_object
+    (make_bytevector_from_buffer (0, NULL, SCM_BYTEVECTOR_TYPE_HINT_NONE));
 
 #ifdef WORDS_BIGENDIAN
   scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol 
("big"));
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index 71626ed..327abba 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -127,9 +127,20 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
 #define SCM_BYTEVECTOR_TYPE_HINT(_bv)          \
   (SCM_SMOB_FLAGS (_bv) >> 8)
 
-#define SCM_BYTEVECTOR_INLINE_THRESHOLD  (2 * sizeof (SCM))
-#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size)        \
-  ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
+#define SCM_BYTEVECTOR_TYPE_HINT_NONE          0
+#define SCM_BYTEVECTOR_TYPE_HINT_U8    1
+#define SCM_BYTEVECTOR_TYPE_HINT_S8    2
+#define SCM_BYTEVECTOR_TYPE_HINT_U16   3
+#define SCM_BYTEVECTOR_TYPE_HINT_S16   4
+#define SCM_BYTEVECTOR_TYPE_HINT_U32   5
+#define SCM_BYTEVECTOR_TYPE_HINT_S32   6
+#define SCM_BYTEVECTOR_TYPE_HINT_U64   7
+#define SCM_BYTEVECTOR_TYPE_HINT_S64   8
+#define SCM_BYTEVECTOR_TYPE_HINT_F32   9
+#define SCM_BYTEVECTOR_TYPE_HINT_F64   10
+#define SCM_BYTEVECTOR_TYPE_HINT_C32   11
+#define SCM_BYTEVECTOR_TYPE_HINT_C64   12
+#define SCM_BYTEVECTOR_TYPE_HINT_LAST  12
 
 /* Hint that is passed to `scm_gc_malloc ()' and friends.  */
 #define SCM_GC_BYTEVECTOR "bytevector"
@@ -139,7 +150,7 @@ SCM_INTERNAL void scm_init_bytevectors (void);
 
 SCM_INTERNAL scm_t_bits scm_tc16_bytevector;
 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_t_uint8);
 
 #define scm_c_shrink_bytevector(_bv, _len)             \
   (SCM_BYTEVECTOR_INLINE_P (_bv)                       \
diff --git a/libguile/instructions.c b/libguile/instructions.c
index 8e6d169..04180e5 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -53,7 +53,7 @@ fetch_instruction_table ()
 
   if (SCM_UNLIKELY (!table))
     {
-      size_t bytes = scm_op_last * sizeof(struct scm_instruction);
+      size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_instruction);
       int i;
       table = malloc (bytes);
       memset (table, 0, bytes);
@@ -63,11 +63,12 @@ fetch_instruction_table ()
 #include <libguile/vm-i-scheme.i>
 #include <libguile/vm-i-loader.i>
 #undef VM_INSTRUCTION_TO_TABLE
-      for (i = 0; i < scm_op_last; i++)
+      for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
         {
           table[i].opcode = i;
           if (table[i].name)
-            table[i].symname = scm_from_locale_symbol (table[i].name);
+            table[i].symname =
+              scm_permanent_object (scm_from_locale_symbol (table[i].name));
           else
             table[i].symname = SCM_BOOL_F;
         }
@@ -85,12 +86,12 @@ scm_lookup_instruction_by_name (SCM name)
   if (SCM_UNLIKELY (SCM_FALSEP (instructions_by_name)))
     { 
       int i;
-      instructions_by_name = scm_make_hash_table (SCM_I_MAKINUM (scm_op_last));
-      for (i = 0; i < scm_op_last; i++)
+      instructions_by_name = scm_permanent_object
+        (scm_make_hash_table (SCM_I_MAKINUM (SCM_VM_NUM_INSTRUCTIONS)));
+      for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
         if (scm_is_true (table[i].symname))
           scm_hashq_set_x (instructions_by_name, table[i].symname,
                            SCM_I_MAKINUM (i));
-      instructions_by_name = scm_permanent_object (instructions_by_name);
     }
   
   op = scm_hashq_ref (instructions_by_name, name, SCM_UNDEFINED);
@@ -111,7 +112,7 @@ SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 
0,
   SCM list = SCM_EOL;
   int i;
   struct scm_instruction *ip = fetch_instruction_table ();
-  for (i = 0; i < scm_op_last; i++)
+  for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
     if (ip[i].name)
       list = scm_cons (ip[i].symname, list);
   return scm_reverse_x (list, SCM_EOL);
@@ -182,7 +183,7 @@ SCM_DEFINE (scm_opcode_to_instruction, 
"opcode->instruction", 1, 0, 0,
   SCM_MAKE_VALIDATE (1, op, I_INUMP);
   opcode = SCM_I_INUM (op);
 
-  if (opcode < scm_op_last)
+  if (opcode >= 0 && opcode < SCM_VM_NUM_INSTRUCTIONS)
     ret = fetch_instruction_table ()[opcode].symname;
 
   if (scm_is_false (ret))
diff --git a/libguile/instructions.h b/libguile/instructions.h
index d081b3e..a226322 100644
--- a/libguile/instructions.h
+++ b/libguile/instructions.h
@@ -31,7 +31,6 @@ enum scm_opcode {
 #include <libguile/vm-i-scheme.i>
 #include <libguile/vm-i-loader.i>
 #undef VM_INSTRUCTION_TO_OPCODE
-  scm_op_last = SCM_VM_NUM_INSTRUCTIONS
 };
 
 SCM_API SCM scm_instruction_list (void);
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index e3aa99e..7e0c774 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -622,7 +622,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_BYTEVECTOR_TYPE_HINT_NONE);
     }
 
   return result;
@@ -681,7 +682,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_BYTEVECTOR_TYPE_HINT_NONE);
     }
 
   return result;
@@ -935,7 +937,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_null_bytevector;
   else
     {
       if (result_buf.total_len > result_buf.len)
@@ -946,7 +948,8 @@ 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_BYTEVECTOR_TYPE_HINT_NONE);
     }
 
   return bv;
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 5de39a2..894ebe2 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -351,7 +351,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
                   && ((i = SCM_I_INUM (idx)) >= 0)                        \
-                  && (i < SCM_BYTEVECTOR_LENGTH (bv))                   \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
                   && (i % size == 0)))                                  \
     RETURN (SCM_I_MAKINUM (*(scm_t_##type*)                             \
                            (SCM_BYTEVECTOR_CONTENTS (bv) + i)));        \
@@ -365,8 +365,8 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
   ARGS2 (bv, idx);                                                      \
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
-                  && ((i = SCM_I_INUM (idx)) >= 0)                        \
-                  && (i < SCM_BYTEVECTOR_LENGTH (bv))                   \
+                  && ((i = SCM_I_INUM (idx)) >= 0)                      \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
                   && (i % size == 0)))                                  \
     { scm_t_##type x = (*(scm_t_##type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)); \
       if (SCM_FIXABLE (x))                                              \
@@ -385,7 +385,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
                   && ((i = SCM_I_INUM (idx)) >= 0)                        \
-                  && (i < SCM_BYTEVECTOR_LENGTH (bv))                   \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
                   && (i % size == 0)))                                  \
     RETURN (scm_from_double ((*(type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)))); \
   else                                                                  \
@@ -459,7 +459,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
                   && ((i = SCM_I_INUM (idx)) >= 0)                      \
-                  && (i < SCM_BYTEVECTOR_LENGTH (bv))                   \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
                   && (i % size == 0)                                    \
                   && (SCM_I_INUMP (val))                                \
                   && ((j = SCM_I_INUM (val)) >= min)                    \
@@ -477,7 +477,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
                   && ((i = SCM_I_INUM (idx)) >= 0)                      \
-                  && (i < SCM_BYTEVECTOR_LENGTH (bv))                   \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
                   && (i % size == 0)))                                  \
     *(scm_t_##type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = scm_to_##type (val); 
\
   else                                                                  \
@@ -492,7 +492,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
   VM_VALIDATE_BYTEVECTOR (bv);                                          \
   if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
                   && ((i = SCM_I_INUM (idx)) >= 0)                      \
-                  && (i < SCM_BYTEVECTOR_LENGTH (bv))                   \
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
                   && (i % size == 0)))                                  \
     *(type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = scm_to_double (val);  \
   else                                                                  \


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]