From 53befeb700c31dec58cec2c8f6f34535541a2f39 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 17 Jun 2009 00:22:09 +0100 Subject: Change Guile license to LGPLv3+ (Not quite finished, the following will be done tomorrow. module/srfi/*.scm module/rnrs/*.scm module/scripts/*.scm testsuite/*.scm guile-readline/* ) --- libguile/vectors.c | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'libguile/vectors.c') diff --git a/libguile/vectors.c b/libguile/vectors.c index eeb856995..ae0fc319f 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -1,18 +1,19 @@ /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 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 as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ -- cgit v1.2.3 From 438974d08dcb96a01fe62ea9b0446b8420e703c4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 22 Jun 2009 00:51:08 +0200 Subject: 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. --- doc/ref/api-compound.texi | 22 ++++++++---- doc/ref/api-data.texi | 27 +++++++++++++++ libguile/bytevectors.c | 9 +++++ libguile/bytevectors.h | 1 + libguile/srfi-4.c | 9 ++++- libguile/unif.c | 31 ++++++++++++++++- libguile/vectors.c | 14 ++++++-- test-suite/tests/bytevectors.test | 71 +++++++++++++++++++++++++++++++++++++++ 8 files changed, 173 insertions(+), 11 deletions(-) (limited to 'libguile/vectors.c') diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi index 2811ee4f2..8d0e02f20 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}): + +@table @code + +@item #vu8(1 2 3) +is a 3-byte long bytevector, with contents 1, 2, 3. + +@end table + @node Array Procedures @subsubsection Array Procedures diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 4ff738c6b..4401ef1cf 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 @@ -4156,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 +@node Bytevectors as Generalized Vectors +@subsubsection 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: + +@example +(define bv #vu8(0 1 2 3)) + +(generalized-vector? bv) +@result{} #t + +(generalized-vector-ref bv 2) +@result{} 2 + +(generalized-vector-set! bv 2 77) +(array-ref bv 2) +@result{} 77 + +(array-type bv) +@result{} vu8 +@end example + @node Regular Expressions @subsection Regular Expressions diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index 4dd66970d..2060192c6 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -328,6 +328,15 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 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 + SCM_SMOB_PRINT (scm_tc16_bytevector, print_bytevector, bv, port, pstate) { diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h index df1ad2dfe..ccab27522 100644 --- a/libguile/bytevectors.h +++ b/libguile/bytevectors.h @@ -136,6 +136,7 @@ SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t); : scm_i_shrink_bytevector ((_bv), (_len))) 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/srfi-4.c b/libguile/srfi-4.c index ac31fdc10..da571b0b8 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 d393e8a1a..84b532347 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 } }; @@ -313,6 +315,12 @@ bitvector_ref (scm_t_array_handle *h, ssize_t pos) scm_from_bool (((scm_t_uint32 *)h->elements)[pos/32] & (1l << (pos % 32))); } +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) { @@ -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)); @@ -386,6 +399,17 @@ bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val) ((scm_t_uint32 *)h->writable_elements)[pos/32] &= ~mask; } +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) { @@ -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 ae0fc319f..6dc994f55 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 342f08a24..45f11ec77 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 -- cgit v1.2.3