1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00

Extend bytevector-fill! to handle a partial fill

* libguile/bytevectors.c (bytevector-fill!): As stated.
  (scm_bytevector_fill_x): Stub to avoid changing the C API.
* doc/ref/api-data.texi: Documentation.
* libguile/vectors.c (vector-fill!): Less confusing variable names.
* test-suite/tests/bytevectors.test: Test partial fill cases for
  bytevector-fill!.
This commit is contained in:
Daniel Llorens 2021-08-17 16:47:04 +02:00
parent 926f70f9b5
commit 9a62f7caca
4 changed files with 63 additions and 28 deletions

View file

@ -3424,6 +3424,7 @@ Like @code{scm_string_set_x}, but the index is given as a @code{size_t}.
@end deftypefn
@rnindex string-fill!
@anchor{x-string-fill!}
@deffn {Scheme Procedure} string-fill! str chr [start [end]]
@deffnx {C Function} scm_substring_fill_x (str, chr, start, end)
@deffnx {C Function} scm_string_fill_x (str, chr)
@ -6383,6 +6384,7 @@ Store @var{obj} in position @var{k} (a @code{size_t}) of @var{vec}.
@end deftypefn
@rnindex vector-fill!
@anchor{x-vector-fill!}
@deffn {Scheme Procedure} vector-fill! vec fill [start [end]]
@deffnx {C Function} scm_vector_fill_x (vec, fill)
Store @var{fill} in every position of @var{vec} in the range
@ -6821,17 +6823,25 @@ Return is @var{bv1} equals to @var{bv2}---i.e., if they have the same
length and contents.
@end deffn
@deffn {Scheme Procedure} bytevector-fill! bv fill
@deffn {Scheme Procedure} bytevector-fill! bv fill [start [end]]
@deffnx {C Function} scm_bytevector_fill_x (bv, fill)
Fill bytevector @var{bv} with @var{fill}, a byte.
Fill positions [@var{start} ... @var{end}) of bytevector @var{bv} with
byte @var{fill}. @var{start} defaults to 0 and @var{end} defaults to the
length of @var{bv}.@footnote{R6RS defines @code{(bytevector-fill! bv
fill)}. Arguments @var{start} and @var{end} are a Guile extension
(cf. @ref{x-vector-fill!,@code{vector-fill!}},
@ref{x-string-fill!,@code{string-fill!}}).}
@end deffn
@deffn {Scheme Procedure} bytevector-copy! source source-start target target-start len
@deffnx {C Function} scm_bytevector_copy_x (source, source_start, target, target_start, len)
Copy @var{len} bytes from @var{source} into @var{target}, starting
reading from @var{source-start} (a positive index within @var{source})
and start writing at @var{target-start}. It is permitted for the
@var{source} and @var{target} regions to overlap.
and writing at @var{target-start}.
It is permitted for the @var{source} and @var{target} regions to
overlap. In that case, copying takes place as if the source is first
copied into a temporary bytevector and then into the destination.
@end deffn
@deffn {Scheme Procedure} bytevector-copy bv

View file

@ -565,32 +565,46 @@ SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_bytevector_fill_x, "bytevector-fill!", 2, 0, 0,
(SCM bv, SCM fill),
"Fill bytevector @var{bv} with @var{fill}, a byte.")
#define FUNC_NAME s_scm_bytevector_fill_x
{
size_t c_len, i;
uint8_t *c_bv, c_fill;
int value;
static SCM scm_bytevector_fill_partial_x (SCM bv, SCM fill, SCM start, SCM end);
SCM_DEFINE (scm_bytevector_fill_partial_x, "bytevector-fill!", 2, 2, 0,
(SCM bv, SCM fill, SCM start, SCM end),
"Fill positions [@var{start} ... @var{end}) of bytevector "
"@var{bv} with @var{fill}, a byte. @var{start} defaults to 0 "
"and @var{end} defaults to the length of @var{bv}. "
"The return value is unspecified.")
#define FUNC_NAME s_scm_bytevector_fill_partial_x
{
SCM_VALIDATE_MUTABLE_BYTEVECTOR (1, bv);
value = scm_to_int (fill);
int value = scm_to_int (fill);
if (SCM_UNLIKELY ((value < -128) || (value > 255)))
scm_out_of_range (FUNC_NAME, fill);
c_fill = (uint8_t) value;
size_t i = 0;
size_t c_end = SCM_BYTEVECTOR_LENGTH (bv);
uint8_t *c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
c_len = SCM_BYTEVECTOR_LENGTH (bv);
c_bv = (uint8_t *) SCM_BYTEVECTOR_CONTENTS (bv);
if (!SCM_UNBNDP (start))
i = scm_to_unsigned_integer (start, 0, c_end);
if (!SCM_UNBNDP (end))
c_end = scm_to_unsigned_integer (end, i, c_end);
for (i = 0; i < c_len; i++)
c_bv[i] = c_fill;
memset (c_bv + i, value, c_end-i);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM
scm_bytevector_fill_x (SCM bv, SCM fill)
#define FUNC_NAME s_scm_bytevector_fill_x
{
return scm_bytevector_fill_partial_x (bv, fill, SCM_UNDEFINED, SCM_UNDEFINED);
}
#undef FUNC_NAME
SCM_DEFINE (scm_bytevector_copy_x, "bytevector-copy!", 5, 0, 0,
(SCM source, SCM source_start, SCM target, SCM target_start,
SCM len),

View file

@ -412,27 +412,24 @@ static SCM scm_vector_fill_partial_x (SCM vec, SCM fill, SCM start, SCM end);
SCM_DEFINE_STATIC (scm_vector_fill_partial_x, "vector-fill!", 2, 2, 0,
(SCM vec, SCM fill, SCM start, SCM end),
"Assign the value of every location in vector @var{vec} between\n"
"@var{start} and @var{end} to @var{fill}. @var{start} defaults\n"
"Assign the value of every location in vector @var{vec} in the range\n"
"[@var{start} ... @var{end}) to @var{fill}. @var{start} defaults\n"
"to 0 and @var{end} defaults to the length of @var{vec}. The value\n"
"returned by @code{vector-fill!} is unspecified.")
#define FUNC_NAME s_scm_vector_fill_partial_x
{
SCM_VALIDATE_MUTABLE_VECTOR(1, vec);
SCM *data;
size_t i = 0;
size_t len = SCM_I_VECTOR_LENGTH (vec);
data = SCM_I_VECTOR_WELTS (vec);
size_t c_end = SCM_I_VECTOR_LENGTH (vec);
SCM *data = SCM_I_VECTOR_WELTS (vec);
if (!SCM_UNBNDP (start))
i = scm_to_unsigned_integer (start, 0, len);
i = scm_to_unsigned_integer (start, 0, c_end);
if (!SCM_UNBNDP (end))
len = scm_to_unsigned_integer (end, i, len);
c_end = scm_to_unsigned_integer (end, i, c_end);
for (; i < len; ++i)
for (; i < c_end; ++i)
data[i] = fill;
return SCM_UNSPECIFIED;

View file

@ -65,6 +65,20 @@
(bytevector-fill! bv -128)
bv))
;; This is a Guile-specific extension.
(pass-if-equal "bytevector-fill! range arguments I"
#vu8(0 0 1 1 1)
(let ((bv (make-bytevector 5 0)))
(bytevector-fill! bv 1 2)
bv))
;; This is a Guile-specific extension.
(pass-if-equal "bytevector-fill! range arguments II"
#vu8(0 0 1 1 0)
(let ((bv (make-bytevector 5 0)))
(bytevector-fill! bv 1 2 4)
bv))
(pass-if "bytevector-copy! overlapping"
;; See <http://debbugs.gnu.org/10070>.
(let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8))))