[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-0-18-gcfb
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-0-18-gcfb4702 |
|
Date: |
Sun, 21 Jun 2009 23:15:06 +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=cfb4702f5886f2df197521cc47b6ca86547b165e
The branch, master has been updated
via cfb4702f5886f2df197521cc47b6ca86547b165e (commit)
via 438974d08dcb96a01fe62ea9b0446b8420e703c4 (commit)
via 404bb5f87b66709206507acdf7b899101185a7a0 (commit)
via 2d34e9244b8b35f62d086a88db749718a2a1a3b4 (commit)
via d64fc8b039fd686a5f8f33458ba1193dc584b2a9 (commit)
from 5c27902e5e01a94b22ebc51288500a3d36253293 (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 cfb4702f5886f2df197521cc47b6ca86547b165e
Author: Ludovic Courtès <address@hidden>
Date: Mon Jun 22 00:56:00 2009 +0200
Always create the bytevector SMOB type.
* libguile/bytevectors.c (scm_tc16_bytevector, print_bytevector,
bytevector_equal_p, free_bytevector): Don't use the snarfing macros.
(scm_bootstrap_bytevectors): New.
(scm_init_bytevectors): No longer initialize SCM_NULL_BYTEVECTOR,
which is done by `scm_bootstrap_bytevectors ()'.
* libguile/bytevectors.h (scm_bootstrap_bytevectors): New declaration.
(scm_init_bytevectors): Made internal. This can be done because we
explicitly register it with `scm_c_register_extension ()' in
`scm_bootstrap_bytevectors ()'.
* libguile/init.c (scm_i_init_guile): Call `scm_bootstrap_bytevectors ()'.
This is so that expressions like "(generalized-vector-length #vu8())"
work even when `(rnrs bytevector)' hasn't been loaded.
commit 438974d08dcb96a01fe62ea9b0446b8420e703c4
Author: Ludovic Courtès <address@hidden>
Date: Mon Jun 22 00:51:08 2009 +0200
Make bytevectors accessible using the generalized-vector API.
As a side effect, this allows compilation of literal bytevectors
("#vu8(...)"), which gets done by the generic array handling
of the GLIL->assembly compiler.
* doc/ref/api-compound.texi (Generalized Vectors): Mention bytevectors.
(Arrays, Array Syntax): Likewise.
* doc/ref/api-data.texi (Bytevectors as Generalized Vectors): New node.
* libguile/bytevectors.c (scm_i_bytevector_generalized_set_x): New.
* libguile/bytevectors.h (scm_i_bytevector_generalized_set_x): New
declaration.
* libguile/srfi-4.c (scm_i_generalized_vector_type,
scm_array_handle_uniform_element_size,
scm_array_handle_uniform_writable_elements): Add support for
bytevectors.
* libguile/unif.c (type_creator_table): Add `vu8'.
(bytevector_ref, bytevector_set): New functions.
(memoize_ref, memoize_set): Add support for bytevectors.
* libguile/vectors.c (scm_is_generalized_vector,
scm_c_generalized_vector_length, scm_c_generalized_vector_ref,
scm_c_generalized_vector_set_x): Add support for bytevectors.
* test-suite/tests/bytevectors.test ("Generalized Vectors"): New test
set.
commit 404bb5f87b66709206507acdf7b899101185a7a0
Author: Ludovic Courtès <address@hidden>
Date: Sun Jun 21 23:16:57 2009 +0200
bytevectors: Add a C-friendly API.
* doc/ref/api-data.texi (Bytevector Manipulation): Add
`scm_is_bytevector ()', `scm_c_bytevector_length ()',
`scm_c_bytevector_length ()', and `scm_c_bytevector_set_x ()'.
* libguile/bytevectors.c (scm_is_bytevector, scm_c_bytevector_length,
scm_c_bytevector_ref, scm_c_bytevector_set_x): New functions.
(scm_bytevector_p): Use `scm_is_bytevector ()'.
(scm_bytevector_length): Use `scm_c_bytevector_length ()'.
* libguile/bytevectors.h (scm_is_bytevector, scm_c_bytevector_length,
scm_c_bytevector_ref, scm_c_bytevector_set_x): New declarations.
commit 2d34e9244b8b35f62d086a88db749718a2a1a3b4
Author: Ludovic Courtès <address@hidden>
Date: Sun Jun 21 16:55:58 2009 +0200
bytevectors: Use `size_t' rather than `unsigned' for sizes.
* doc/ref/api-data.texi (Bytevector Manipulation): Update.
* libguile/bytevectors.c (INTEGER_ACCESSOR_PROLOGUE,
make_bytevector_from_buffer, scm_c_make_bytevector,
scm_c_take_bytevector, scm_i_shrink_bytevector): Use `size_t' for
bytevector lengths.
commit d64fc8b039fd686a5f8f33458ba1193dc584b2a9
Author: Ludovic Courtès <address@hidden>
Date: Sun Jun 21 23:32:19 2009 +0200
Fix documentation of `make-bytevector'.
* doc/ref/api-data.texi (Bytevector Manipulation): Fix documentation of
the FILL argument of `make-bytevector'.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-compound.texi | 22 +++++--
doc/ref/api-data.texi | 51 +++++++++++++++-
libguile/bytevectors.c | 119 ++++++++++++++++++++++++++++++------
libguile/bytevectors.h | 17 ++++--
libguile/init.c | 2 +
libguile/srfi-4.c | 9 +++-
libguile/unif.c | 31 +++++++++-
libguile/vectors.c | 14 ++++-
test-suite/tests/bytevectors.test | 71 ++++++++++++++++++++++
9 files changed, 296 insertions(+), 40 deletions(-)
diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 2811ee4..8d0e02f 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1649,9 +1649,9 @@ and writing.
@subsection Generalized Vectors
Guile has a number of data types that are generally vector-like:
-strings, uniform numeric vectors, bitvectors, and of course ordinary
-vectors of arbitrary Scheme values. These types are disjoint: a
-Scheme value belongs to at most one of the four types listed above.
+strings, uniform numeric vectors, bytevectors, bitvectors, and of course
+ordinary vectors of arbitrary Scheme values. These types are disjoint:
+a Scheme value belongs to at most one of the four types listed above.
If you want to gloss over this distinction and want to treat all four
types with common code, you can use the procedures in this section.
@@ -1749,9 +1749,9 @@ matrix with zero columns and 3 rows is different from a
matrix with 3
columns and zero rows, which again is different from a vector of
length zero.
-Generalized vectors, such as strings, uniform numeric vectors, bit
-vectors and ordinary vectors, are the special case of one dimensional
-arrays.
+Generalized vectors, such as strings, uniform numeric vectors,
+bytevectors, bit vectors and ordinary vectors, are the special case of
+one dimensional arrays.
@menu
* Array Syntax::
@@ -1834,6 +1834,16 @@ is a rank-zero array with contents 12.
@end table
+In addition, bytevectors are also arrays, but use a different syntax
+(@pxref{Bytevectors}):
+
address@hidden @code
+
address@hidden #vu8(1 2 3)
+is a 3-byte long bytevector, with contents 1, 2, 3.
+
address@hidden table
+
@node Array Procedures
@subsubsection Array Procedures
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 8dbad38..4401ef1 100755
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -3789,6 +3789,7 @@ R6RS (@pxref{R6RS I/O Ports}).
* Bytevectors and Integer Lists:: Converting to/from an integer list.
* Bytevectors as Floats:: Interpreting bytes as real numbers.
* Bytevectors as Strings:: Interpreting bytes as Unicode strings.
+* Bytevectors as Generalized Vectors:: Guile extension to the bytevector API.
@end menu
@node Bytevector Endianness
@@ -3833,14 +3834,14 @@ The objects denoting big (resp. little) endianness.
@subsubsection Manipulating Bytevectors
Bytevectors can be created, copied, and analyzed with the following
-procedures.
+procedures and C functions.
@deffn {Scheme Procedure} make-bytevector len [fill]
@deffnx {C Function} scm_make_bytevector (len, fill)
address@hidden {C Function} scm_c_make_bytevector (unsigned len)
address@hidden {C Function} scm_c_make_bytevector (size_t len)
Return a new bytevector of @var{len} bytes. Optionally, if @var{fill}
-is given, fill it with @var{fill}; @var{fill} must be an 8-bit signed
-integer, i.e., in the range [-128,127].
+is given, fill it with @var{fill}; @var{fill} must be in the range
+[-128,255].
@end deffn
@deffn {Scheme Procedure} bytevector? obj
@@ -3848,11 +3849,19 @@ integer, i.e., in the range [-128,127].
Return true if @var{obj} is a bytevector.
@end deffn
address@hidden {C Function} int scm_is_bytevector (SCM obj)
+Equivalent to @code{scm_is_true (scm_bytevector_p (obj))}.
address@hidden deftypefn
+
@deffn {Scheme Procedure} bytevector-length bv
@deffnx {C Function} scm_bytevector_length (bv)
Return the length in bytes of bytevector @var{bv}.
@end deffn
address@hidden {C Function} size_t scm_c_bytevector_length (SCM bv)
+Likewise, return the length in bytes of bytevector @var{bv}.
address@hidden deftypefn
+
@deffn {Scheme Procedure} bytevector=? bv1 bv2
@deffnx {C Function} scm_bytevector_eq_p (bv1, bv2)
Return is @var{bv1} equals to @var{bv2}---i.e., if they have the same
@@ -3876,6 +3885,14 @@ and start writing at @var{target-start}.
Return a newly allocated copy of @var{bv}.
@end deffn
address@hidden {C Function} scm_t_uint8 scm_c_bytevector_ref (SCM bv, size_t
index)
+Return the byte at @var{index} in bytevector @var{bv}.
address@hidden deftypefn
+
address@hidden {C Function} void scm_c_bytevector_set_x (SCM bv, size_t index,
scm_t_uint8 value)
+Set the byte at @var{index} in @var{bv} to @var{value}.
address@hidden deftypefn
+
Low-level C macros are available. They do not perform any
type-checking; as such they should be used with care.
@@ -4140,6 +4157,32 @@ Return a newly allocated string that contains from the
UTF-8-, UTF-16-,
or UTF-32-decoded contents of bytevector @var{utf}.
@end deffn
address@hidden Bytevectors as Generalized Vectors
address@hidden Accessing Bytevectors with the Generalized Vector API
+
+As an extension to the R6RS, Guile allows bytevectors to be manipulated
+with the @dfn{generalized vector} procedures (@pxref{Generalized
+Vectors}). This also allows bytevectors to be accessed using the
+generic @dfn{array} procedures (@pxref{Array Procedures}). When using
+these APIs, bytes are accessed one at a time as 8-bit unsigned integers:
+
address@hidden
+(define bv #vu8(0 1 2 3))
+
+(generalized-vector? bv)
address@hidden #t
+
+(generalized-vector-ref bv 2)
address@hidden 2
+
+(generalized-vector-set! bv 2 77)
+(array-ref bv 2)
address@hidden 77
+
+(array-type bv)
address@hidden vu8
address@hidden example
+
@node Regular Expressions
@subsection Regular Expressions
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 2484a64..fd9043a 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -26,6 +26,7 @@
#include <gmp.h>
#include "libguile/_scm.h"
+#include "libguile/extensions.h"
#include "libguile/bytevectors.h"
#include "libguile/strings.h"
#include "libguile/validate.h"
@@ -74,7 +75,7 @@
#define INTEGER_ACCESSOR_PROLOGUE(_len, _sign) \
- unsigned c_len, c_index; \
+ size_t c_len, c_index; \
_sign char *c_bv; \
\
SCM_VALIDATE_BYTEVECTOR (1, bv); \
@@ -172,7 +173,7 @@
/* Bytevector type. */
-SCM_GLOBAL_SMOB (scm_tc16_bytevector, "r6rs-bytevector", 0);
+scm_t_bits scm_tc16_bytevector;
#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \
SCM_SET_SMOB_DATA ((_bv), (scm_t_bits) (_len))
@@ -184,14 +185,14 @@ SCM scm_null_bytevector = SCM_UNSPECIFIED;
static inline SCM
-make_bytevector_from_buffer (unsigned len, signed char *contents)
+make_bytevector_from_buffer (size_t len, signed char *contents)
{
/* Assuming LEN > SCM_BYTEVECTOR_INLINE_THRESHOLD. */
SCM_RETURN_NEWSMOB2 (scm_tc16_bytevector, len, contents);
}
static inline SCM
-make_bytevector (unsigned len)
+make_bytevector (size_t len)
{
SCM bv;
@@ -212,7 +213,7 @@ make_bytevector (unsigned len)
/* Return a new bytevector of size LEN octets. */
SCM
-scm_c_make_bytevector (unsigned len)
+scm_c_make_bytevector (size_t len)
{
return (make_bytevector (len));
}
@@ -220,7 +221,7 @@ scm_c_make_bytevector (unsigned len)
/* 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, unsigned len)
+scm_c_take_bytevector (signed char *contents, size_t len)
{
SCM bv;
@@ -243,11 +244,11 @@ scm_c_take_bytevector (signed char *contents, unsigned
len)
/* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
size) and return BV. */
SCM
-scm_i_shrink_bytevector (SCM bv, unsigned c_new_len)
+scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
{
if (!SCM_BYTEVECTOR_INLINE_P (bv))
{
- unsigned c_len;
+ size_t c_len;
signed char *c_bv, *c_new_bv;
c_len = SCM_BYTEVECTOR_LENGTH (bv);
@@ -274,8 +275,71 @@ scm_i_shrink_bytevector (SCM bv, unsigned c_new_len)
return bv;
}
-SCM_SMOB_PRINT (scm_tc16_bytevector, print_bytevector,
- bv, port, pstate)
+int
+scm_is_bytevector (SCM obj)
+{
+ return SCM_SMOB_PREDICATE (scm_tc16_bytevector, obj);
+}
+
+size_t
+scm_c_bytevector_length (SCM bv)
+#define FUNC_NAME "scm_c_bytevector_length"
+{
+ SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+ return SCM_BYTEVECTOR_LENGTH (bv);
+}
+#undef FUNC_NAME
+
+scm_t_uint8
+scm_c_bytevector_ref (SCM bv, size_t index)
+#define FUNC_NAME "scm_c_bytevector_ref"
+{
+ size_t c_len;
+ const scm_t_uint8 *c_bv;
+
+ SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+ c_len = SCM_BYTEVECTOR_LENGTH (bv);
+ c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+ if (SCM_UNLIKELY (index >= c_len))
+ scm_out_of_range (FUNC_NAME, scm_from_size_t (index));
+
+ return c_bv[index];
+}
+#undef FUNC_NAME
+
+void
+scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
+#define FUNC_NAME "scm_c_bytevector_set_x"
+{
+ size_t c_len;
+ scm_t_uint8 *c_bv;
+
+ SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+ c_len = SCM_BYTEVECTOR_LENGTH (bv);
+ c_bv = (scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+ if (SCM_UNLIKELY (index >= c_len))
+ scm_out_of_range (FUNC_NAME, scm_from_size_t (index));
+
+ c_bv[index] = value;
+}
+#undef FUNC_NAME
+
+/* This procedure is used by `scm_c_generalized_vector_set_x ()'. */
+void
+scm_i_bytevector_generalized_set_x (SCM bv, size_t index, SCM value)
+#define FUNC_NAME "scm_i_bytevector_generalized_set_x"
+{
+ scm_c_bytevector_set_x (bv, index, scm_to_uint8 (value));
+}
+#undef FUNC_NAME
+
+static int
+print_bytevector (SCM bv, SCM port, scm_print_state *pstate)
{
unsigned c_len, i;
unsigned char *c_bv;
@@ -300,12 +364,14 @@ SCM_SMOB_PRINT (scm_tc16_bytevector, print_bytevector,
return 1;
}
-SCM_SMOB_EQUALP (scm_tc16_bytevector, bytevector_equal_p, bv1, bv2)
+static SCM
+bytevector_equal_p (SCM bv1, SCM bv2)
{
return scm_bytevector_eq_p (bv1, bv2);
}
-SCM_SMOB_FREE (scm_tc16_bytevector, free_bytevector, bv)
+static size_t
+free_bytevector (SCM bv)
{
if (!SCM_BYTEVECTOR_INLINE_P (bv))
@@ -357,8 +423,7 @@ SCM_DEFINE (scm_bytevector_p, "bytevector?", 1, 0, 0,
"Return true if @var{obj} is a bytevector.")
#define FUNC_NAME s_scm_bytevector_p
{
- return (scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_bytevector,
- obj)));
+ return scm_from_bool (scm_is_bytevector (obj));
}
#undef FUNC_NAME
@@ -403,9 +468,7 @@ SCM_DEFINE (scm_bytevector_length, "bytevector-length", 1,
0, 0,
"Return the length (in bytes) of @var{bv}.")
#define FUNC_NAME s_scm_bytevector_length
{
- SCM_VALIDATE_BYTEVECTOR (1, bv);
-
- return (scm_from_uint (SCM_BYTEVECTOR_LENGTH (bv)));
+ return scm_from_uint (scm_c_bytevector_length (bv));
}
#undef FUNC_NAME
@@ -1999,6 +2062,25 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string",
/* Initialization. */
void
+scm_bootstrap_bytevectors (void)
+{
+ /* The SMOB type must be instantiated here because the
+ generalized-vector API may want to access bytevectors even though
+ `(rnrs bytevector)' hasn't been loaded. */
+ scm_tc16_bytevector = scm_make_smob_type ("bytevector", 0);
+ scm_set_smob_free (scm_tc16_bytevector, free_bytevector);
+ scm_set_smob_print (scm_tc16_bytevector, print_bytevector);
+ scm_set_smob_equalp (scm_tc16_bytevector, bytevector_equal_p);
+
+ scm_null_bytevector =
+ scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
+
+ scm_c_register_extension ("libguile", "scm_init_bytevectors",
+ (scm_t_extension_init_func) scm_init_bytevectors,
+ NULL);
+}
+
+void
scm_init_bytevectors (void)
{
#include "libguile/bytevectors.x"
@@ -2011,7 +2093,4 @@ scm_init_bytevectors (void)
scm_endianness_big = scm_sym_big;
scm_endianness_little = scm_sym_little;
-
- scm_null_bytevector =
- scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
}
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index 4b1b606..903ce7a 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -27,7 +27,7 @@
/* R6RS bytevectors. */
#define SCM_BYTEVECTOR_LENGTH(_bv) \
- ((unsigned) SCM_SMOB_DATA (_bv))
+ ((size_t) SCM_SMOB_DATA (_bv))
#define SCM_BYTEVECTOR_CONTENTS(_bv) \
(SCM_BYTEVECTOR_INLINE_P (_bv) \
? (signed char *) SCM_SMOB_OBJECT_2_LOC (_bv) \
@@ -37,8 +37,13 @@
SCM_API SCM scm_endianness_big;
SCM_API SCM scm_endianness_little;
+SCM_API SCM scm_c_make_bytevector (size_t);
+SCM_API int scm_is_bytevector (SCM);
+SCM_API size_t scm_c_bytevector_length (SCM);
+SCM_API scm_t_uint8 scm_c_bytevector_ref (SCM, size_t);
+SCM_API void scm_c_bytevector_set_x (SCM, size_t, scm_t_uint8);
+
SCM_API SCM scm_make_bytevector (SCM, SCM);
-SCM_API SCM scm_c_make_bytevector (unsigned);
SCM_API SCM scm_native_endianness (void);
SCM_API SCM scm_bytevector_p (SCM);
SCM_API SCM scm_bytevector_length (SCM);
@@ -120,17 +125,19 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
/* Hint that is passed to `scm_gc_malloc ()' and friends. */
#define SCM_GC_BYTEVECTOR "bytevector"
-SCM_API void scm_init_bytevectors (void);
+SCM_INTERNAL void scm_bootstrap_bytevectors (void);
+SCM_INTERNAL void scm_init_bytevectors (void);
SCM_INTERNAL scm_t_bits scm_tc16_bytevector;
-SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, unsigned);
+SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t);
#define scm_c_shrink_bytevector(_bv, _len) \
(SCM_BYTEVECTOR_INLINE_P (_bv) \
? (_bv) \
: scm_i_shrink_bytevector ((_bv), (_len)))
-SCM_INTERNAL SCM scm_i_shrink_bytevector (SCM, unsigned);
+SCM_INTERNAL SCM scm_i_shrink_bytevector (SCM, size_t);
+SCM_INTERNAL void scm_i_bytevector_generalized_set_x (SCM, size_t, SCM);
SCM_INTERNAL SCM scm_null_bytevector;
#endif /* SCM_BYTEVECTORS_H */
diff --git a/libguile/init.c b/libguile/init.c
index 2b500ac..5ece01f 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -38,6 +38,7 @@
#include "libguile/async.h"
#include "libguile/backtrace.h"
#include "libguile/boolean.h"
+#include "libguile/bytevectors.h"
#include "libguile/chars.h"
#include "libguile/continuations.h"
#include "libguile/debug.h"
@@ -573,6 +574,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_rw ();
scm_init_extensions ();
+ scm_bootstrap_bytevectors ();
scm_bootstrap_vm ();
atexit (cleanup_for_exit);
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index ac31fdc..da571b0 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 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2004, 2006, 2009 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
@@ -29,6 +29,7 @@
#include "libguile/_scm.h"
#include "libguile/__scm.h"
#include "libguile/srfi-4.h"
+#include "libguile/bytevectors.h"
#include "libguile/error.h"
#include "libguile/read.h"
#include "libguile/ports.h"
@@ -609,6 +610,8 @@ scm_i_generalized_vector_type (SCM v)
return scm_sym_b;
else if (scm_is_uniform_vector (v))
return scm_from_locale_symbol (uvec_tags[SCM_UVEC_TYPE(v)]);
+ else if (scm_is_bytevector (v))
+ return scm_from_locale_symbol ("vu8");
else
return SCM_BOOL_F;
}
@@ -750,6 +753,8 @@ scm_array_handle_uniform_element_size (scm_t_array_handle
*h)
vec = SCM_I_ARRAY_V (vec);
if (scm_is_uniform_vector (vec))
return uvec_sizes[SCM_UVEC_TYPE(vec)];
+ if (scm_is_bytevector (vec))
+ return 1U;
scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
}
@@ -790,6 +795,8 @@ scm_array_handle_uniform_writable_elements
(scm_t_array_handle *h)
char *elts = SCM_UVEC_BASE (vec);
return (void *) (elts + size*h->base);
}
+ if (scm_is_bytevector (vec))
+ return SCM_BYTEVECTOR_CONTENTS (vec);
scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
}
diff --git a/libguile/unif.c b/libguile/unif.c
index d393e8a..84b5323 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006,
2009 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
@@ -47,6 +47,7 @@
#include "libguile/srfi-13.h"
#include "libguile/srfi-4.h"
#include "libguile/vectors.h"
+#include "libguile/bytevectors.h"
#include "libguile/list.h"
#include "libguile/deprecation.h"
#include "libguile/dynwind.h"
@@ -109,6 +110,7 @@ struct {
{ "f64", SCM_UNSPECIFIED, scm_make_f64vector },
{ "c32", SCM_UNSPECIFIED, scm_make_c32vector },
{ "c64", SCM_UNSPECIFIED, scm_make_c64vector },
+ { "vu8", SCM_UNSPECIFIED, scm_make_bytevector },
{ NULL }
};
@@ -314,6 +316,12 @@ bitvector_ref (scm_t_array_handle *h, ssize_t pos)
}
static SCM
+bytevector_ref (scm_t_array_handle *h, ssize_t pos)
+{
+ return scm_from_uint8 (((scm_t_uint8 *) h->elements)[pos]);
+}
+
+static SCM
memoize_ref (scm_t_array_handle *h, ssize_t pos)
{
SCM v = h->array;
@@ -346,6 +354,11 @@ memoize_ref (scm_t_array_handle *h, ssize_t pos)
h->elements = scm_array_handle_bit_elements (h);
h->ref = bitvector_ref;
}
+ else if (scm_is_bytevector (v))
+ {
+ h->elements = scm_array_handle_uniform_elements (h);
+ h->ref = bytevector_ref;
+ }
else
scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
@@ -387,6 +400,17 @@ bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
}
static void
+bytevector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
+{
+ scm_t_uint8 c_value;
+ scm_t_uint8 *elements;
+
+ c_value = scm_to_uint8 (val);
+ elements = (scm_t_uint8 *) h->elements;
+ elements[pos] = (scm_t_uint8) c_value;
+}
+
+static void
memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
{
SCM v = h->array;
@@ -420,6 +444,11 @@ memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
h->writable_elements = scm_array_handle_bit_writable_elements (h);
h->set = bitvector_set;
}
+ else if (scm_is_bytevector (v))
+ {
+ h->elements = scm_array_handle_uniform_writable_elements (h);
+ h->set = bytevector_set;
+ }
else
scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
diff --git a/libguile/vectors.c b/libguile/vectors.c
index ae0fc31..6dc994f 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 Free Software
Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2009 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
@@ -31,6 +31,7 @@
#include "libguile/validate.h"
#include "libguile/vectors.h"
#include "libguile/unif.h"
+#include "libguile/bytevectors.h"
#include "libguile/ramap.h"
#include "libguile/srfi-4.h"
#include "libguile/strings.h"
@@ -523,7 +524,7 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!",
5, 0, 0,
}
#undef FUNC_NAME
-
+
/* Generalized vectors. */
int
@@ -532,7 +533,8 @@ scm_is_generalized_vector (SCM obj)
return (scm_is_vector (obj)
|| scm_is_string (obj)
|| scm_is_bitvector (obj)
- || scm_is_uniform_vector (obj));
+ || scm_is_uniform_vector (obj)
+ || scm_is_bytevector (obj));
}
SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
@@ -564,6 +566,8 @@ scm_c_generalized_vector_length (SCM v)
return scm_c_bitvector_length (v);
else if (scm_is_uniform_vector (v))
return scm_c_uniform_vector_length (v);
+ else if (scm_is_bytevector (v))
+ return scm_c_bytevector_length (v);
else
scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
}
@@ -588,6 +592,8 @@ scm_c_generalized_vector_ref (SCM v, size_t idx)
return scm_c_bitvector_ref (v, idx);
else if (scm_is_uniform_vector (v))
return scm_c_uniform_vector_ref (v, idx);
+ else if (scm_is_bytevector (v))
+ return scm_from_uint8 (scm_c_bytevector_ref (v, idx));
else
scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
}
@@ -613,6 +619,8 @@ scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
scm_c_bitvector_set_x (v, idx, val);
else if (scm_is_uniform_vector (v))
scm_c_uniform_vector_set_x (v, idx, val);
+ else if (scm_is_bytevector (v))
+ scm_i_bytevector_generalized_set_x (v, idx, val);
else
scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
}
diff --git a/test-suite/tests/bytevectors.test
b/test-suite/tests/bytevectors.test
index 342f08a..45f11ec 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -583,6 +583,77 @@
exception:wrong-type-arg
(with-input-from-string "#vu8(0 256)" read)))
+
+(with-test-prefix "Generalized Vectors"
+
+ (pass-if "generalized-vector?"
+ (generalized-vector? #vu8(1 2 3)))
+
+ (pass-if "generalized-vector-length"
+ (equal? (iota 16)
+ (map generalized-vector-length
+ (map make-bytevector (iota 16)))))
+
+ (pass-if "generalized-vector-ref"
+ (let ((bv #vu8(255 127)))
+ (and (= 255 (generalized-vector-ref bv 0))
+ (= 127 (generalized-vector-ref bv 1)))))
+
+ (pass-if-exception "generalized-vector-ref [index out-of-range]"
+ exception:out-of-range
+ (let ((bv #vu8(1 2)))
+ (generalized-vector-ref bv 2)))
+
+ (pass-if "generalized-vector-set!"
+ (let ((bv (make-bytevector 2)))
+ (generalized-vector-set! bv 0 255)
+ (generalized-vector-set! bv 1 77)
+ (equal? '(255 77)
+ (bytevector->u8-list bv))))
+
+ (pass-if-exception "generalized-vector-set! [index out-of-range]"
+ exception:out-of-range
+ (let ((bv (make-bytevector 2)))
+ (generalized-vector-set! bv 2 0)))
+
+ (pass-if-exception "generalized-vector-set! [value out-of-range]"
+ exception:out-of-range
+ (let ((bv (make-bytevector 2)))
+ (generalized-vector-set! bv 0 256)))
+
+ (pass-if "array-type"
+ (eq? 'vu8 (array-type #vu8())))
+
+ (pass-if "array-contents"
+ (let ((bv (u8-list->bytevector (iota 10))))
+ (eq? bv (array-contents bv))))
+
+ (pass-if "array-ref"
+ (let ((bv (u8-list->bytevector (iota 10))))
+ (equal? (iota 10)
+ (map (lambda (i) (array-ref bv i))
+ (iota 10)))))
+
+ (pass-if "array-set!"
+ (let ((bv (make-bytevector 10)))
+ (for-each (lambda (i)
+ (array-set! bv i i))
+ (iota 10))
+ (equal? (iota 10)
+ (bytevector->u8-list bv))))
+
+ (pass-if "make-typed-array"
+ (let ((bv (make-typed-array 'vu8 77 33)))
+ (equal? bv (u8-list->bytevector (make-list 33 77)))))
+
+ (pass-if-exception "make-typed-array [out-of-range]"
+ exception:out-of-range
+ (make-typed-array 'vu8 256 77))
+
+ (pass-if "uniform-array->bytevector"
+ (let ((bv #vu8(0 1 128 255)))
+ (equal? bv (uniform-array->bytevector bv)))))
+
;;; Local Variables:
;;; coding: latin-1
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-0-18-gcfb4702,
Ludovic Courtès <=