mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

Make bytevectors accessible using the generalized-vector API.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2009-06-22 00:51:08 +02:00
parent 404bb5f87b
commit 438974d08d
8 changed files with 173 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

31
libguile/unif.c
View file

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