1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00

Fix uniform-vector-read!' and uniform-vector-write'.

* libguile/deprecated.c (scm_uniform_vector_read_x,
  scm_uniform_vector-write): Account for optional arguments.  Make sure
  the former always returns an integer.

* libguile/deprecated.h (scm_uniform_vector_read_x,
  scm_uniform_vector_write, scm_uniform_array_read_x,
  scm_uniform_array_write): Mark as `SCM_DEPRECATED'.
This commit is contained in:
Ludovic Courtès 2010-01-20 23:58:39 +01:00
parent a70c0ff578
commit 73d1aaafb2
2 changed files with 48 additions and 25 deletions

View file

@ -1354,20 +1354,34 @@ SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0,
"to the value returned by @code{(current-input-port)}.")
#define FUNC_NAME s_scm_uniform_vector_read_x
{
size_t width;
SCM result;
size_t c_width, c_start, c_end;
SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, uvec);
scm_c_issue_deprecation_warning
scm_c_issue_deprecation_warning
("`uniform-vector-read!' is deprecated. Use `get-bytevector-n!' from\n"
"`(rnrs io ports)' instead.");
width = scm_to_size_t (scm_uniform_vector_element_size (uvec));
if (SCM_UNBNDP (port_or_fd))
port_or_fd = scm_current_input_port ();
return scm_get_bytevector_n_x (port_or_fd, uvec,
scm_from_size_t (scm_to_size_t (start)*width),
scm_from_size_t ((scm_to_size_t (end)
- scm_to_size_t (start))
* width));
c_width = scm_to_size_t (scm_uniform_vector_element_size (uvec));
c_start = SCM_UNBNDP (start) ? 0 : scm_to_size_t (start);
c_start *= c_width;
c_end = SCM_UNBNDP (end) ? SCM_BYTEVECTOR_LENGTH (uvec) : scm_to_size_t (end);
c_end *= c_width;
result = scm_get_bytevector_n_x (port_or_fd, uvec,
scm_from_size_t (c_start),
scm_from_size_t (c_end - c_start));
if (SCM_EOF_OBJECT_P (result))
result = SCM_INUM0;
return result;
}
#undef FUNC_NAME
@ -1391,21 +1405,30 @@ SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0,
"@code{(current-output-port)}.")
#define FUNC_NAME s_scm_uniform_vector_write
{
size_t width;
SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, uvec);
port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
size_t c_width, c_start, c_end;
scm_c_issue_deprecation_warning
SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, uvec);
scm_c_issue_deprecation_warning
("`uniform-vector-write' is deprecated. Use `put-bytevector' from\n"
"`(rnrs io ports)' instead.");
width = scm_to_size_t (scm_uniform_vector_element_size (uvec));
if (SCM_UNBNDP (port_or_fd))
port_or_fd = scm_current_output_port ();
port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
c_width = scm_to_size_t (scm_uniform_vector_element_size (uvec));
c_start = SCM_UNBNDP (start) ? 0 : scm_to_size_t (start);
c_start *= c_width;
c_end = SCM_UNBNDP (end) ? SCM_BYTEVECTOR_LENGTH (uvec) : scm_to_size_t (end);
c_end *= c_width;
return scm_put_bytevector (port_or_fd, uvec,
scm_from_size_t (scm_to_size_t (start)*width),
scm_from_size_t ((scm_to_size_t (end)
- scm_to_size_t (start))
* width));
scm_from_size_t (c_start),
scm_from_size_t (c_end - c_start));
}
#undef FUNC_NAME

View file

@ -483,14 +483,14 @@ SCM_DEPRECATED scm_t_array_dim *scm_i_array_dims (SCM a);
#define SCM_ARRAY_BASE(a) scm_i_array_base(a)
#define SCM_ARRAY_DIMS(a) scm_i_array_dims(a)
SCM_API SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
SCM start, SCM end);
SCM_API SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
SCM start, SCM end);
SCM_API SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
SCM start, SCM end);
SCM_API SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
SCM start, SCM end);
SCM_DEPRECATED SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
SCM start, SCM end);
SCM_DEPRECATED SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
SCM start, SCM end);
SCM_DEPRECATED SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
SCM start, SCM end);
SCM_DEPRECATED SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
SCM start, SCM end);
/* Deprecated because they should not be lvalues and we want people to
use the official interfaces.