diff options
| author | Mark H Weaver <mhw@netris.org> | 2013-04-06 01:42:45 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2013-04-07 10:14:44 -0400 |
| commit | 7f6c3f8f0012e916469fa6c50b44c621ebdc89ac (patch) | |
| tree | 220b67e9dc1ee7482a66dc3a5a2e6898499d2f45 /libguile/r6rs-ports.c | |
| parent | e1966d0e214b0967c19da71b235196adb057d2b5 (diff) | |
Implement efficient 'scm_unget_bytes' and 'unget-bytevector'.
* libguile/ports.c (scm_i_unget_bytes): New static function.
(scm_unget_bytes): New API function.
(scm_unget_byte): Rewrite to simply call 'scm_i_unget_bytes'.
(scm_ungetc, scm_peek_char, looking_at_bytes): Use 'scm_i_unget_bytes'.
* libguile/ports.h: Add prototype for 'scm_unget_bytes'.
* libguile/fports.c (scm_setvbuf): Use 'scm_unget_bytes'.
* libguile/r6rs-ports.c (scm_unget_bytevector): New procedure.
* module/ice-9/binary-ports.scm (unget-bytevector): New export.
* doc/ref/api-io.texi (R6RS Binary Input): Add documentation.
(R6RS I/O Ports): Update brief description of (ice-9 binary-ports) to
reflect the new reality: it is no longer a subset of (rnrs io ports).
* test-suite/tests/ports.test ("unget-bytevector"): Add test.
Diffstat (limited to 'libguile/r6rs-ports.c')
| -rw-r--r-- | libguile/r6rs-ports.c | 43 |
1 files changed, 43 insertions, 0 deletions
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 48f9f268b..fecc5bd46 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -714,6 +714,49 @@ SCM_DEFINE (scm_put_bytevector, "put-bytevector", 2, 2, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_unget_bytevector, "unget-bytevector", 2, 2, 0, + (SCM port, SCM bv, SCM start, SCM count), + "Unget the contents of @var{bv} to @var{port}, optionally " + "starting at index @var{start} and limiting to @var{count} " + "octets.") +#define FUNC_NAME s_scm_unget_bytevector +{ + unsigned char *c_bv; + size_t c_start, c_count, c_len; + + SCM_VALIDATE_BINARY_INPUT_PORT (1, port); + SCM_VALIDATE_BYTEVECTOR (2, bv); + + c_len = SCM_BYTEVECTOR_LENGTH (bv); + c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv); + + if (!scm_is_eq (start, SCM_UNDEFINED)) + { + c_start = scm_to_size_t (start); + + if (!scm_is_eq (count, SCM_UNDEFINED)) + { + c_count = scm_to_size_t (count); + if (SCM_UNLIKELY (c_start + c_count > c_len)) + scm_out_of_range (FUNC_NAME, count); + } + else + { + if (SCM_UNLIKELY (c_start >= c_len)) + scm_out_of_range (FUNC_NAME, start); + else + c_count = c_len - c_start; + } + } + else + c_start = 0, c_count = c_len; + + scm_unget_bytes (c_bv + c_start, c_count, port); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + /* Bytevector output port ("bop" for short). */ |