Commit dd1175dc authored by Erick's avatar Erick

Added R7RS primitive read-bytevector

parent bf91f509
......@@ -18,7 +18,7 @@
;; USA.
;; Author: Erick Gallesio [eg@unice.fr]
;; Creation date: 26-Nov-2000 18:19 (eg)
;; Last file update: 2-Aug-2018 23:21 (eg)
;; Last file update: 5-Aug-2018 17:34 (eg)
;;
;; ======================================================================
......@@ -593,6 +593,7 @@ be accessed as a normal port with the standard Scheme primitives.])
(insertdoc 'define-reader-ctor)
(insertdoc 'read-char)
(insertdoc 'read-chars)
(insertdoc 'read-bytevector)
(insertdoc 'read-chars!)
(insertdoc 'read-byte)
(insertdoc 'peek-char)
......
This diff is collapsed.
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-Apr-2011 19:36 (eg)
;;;; Last file update: 1-Aug-2018 19:08 (eg)
;;;; Last file update: 3-Aug-2018 19:27 (eg)
;;;;
;;;; ----------------------------------------------------------------------
......@@ -784,3 +784,29 @@ doc>
(error "bad binary port ~S" port))
(char-ready? port)))
#|
<doc R7RS read-bytevector!
* (read-bytevector! k)
* (read-bytevector! k port)
* (read-bytevector! k port start)
* (read-bytevector! k port start end)
*
* Reads the next |end - start| bytes, or as many as are available
* before the end of file, from the binary input port
* into |bytevector| in left-to-right order beginning at the start
* position. If |end| is not supplied, reads until the end of
* |bytevector| has been reached. If |start| is not supplied, reads
* beginning at position 0. Returns the number of bytes read.
* If no bytes are available, an end-of-file object is returned.
doc>
|#
(define (read-bytevector! bv :optional (port (current-input-port))
(start 0)
(end -1 end?))
(%claim-error
'read-bytevector!
(unless (bytevector? bv)
(error "bad bytevector ~S" bv))
(unless end?
(set! end (bytevector-length bv)))
(%read-bytevector! bv port start end)))
......@@ -20,7 +20,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 17-Feb-1993 12:27
* Last file update: 3-Aug-2018 17:35 (eg)
* Last file update: 5-Aug-2018 17:20 (eg)
*
*/
......@@ -326,7 +326,7 @@ DEFINE_PRIMITIVE("read-char", read_char, subr01, (SCM port))
* of the old name is deprecated.
doc>
*/
DEFINE_PRIMITIVE("read-bytes", read_chars, subr12, (SCM size, SCM port))
DEFINE_PRIMITIVE("read-bytes", read_bytes, subr12, (SCM size, SCM port))
{
int count, n = STk_integer_value(size);
SCM z;
......@@ -348,18 +348,57 @@ DEFINE_PRIMITIVE("read-bytes", read_chars, subr12, (SCM size, SCM port))
return z;
}
/*
<doc EXT read-chars!
* (read-chars! str)
* (read-chars! str port)
<doc R7RS read-bytevector
* (read-bytevector k)
* (read-bytevector k port)
*
* Reads the next |k| bytes, or as many as are available
* before the end of file, from the textual input |port| into a
* newly allocated string in left-to-right order and returns the
* string. If no characters are available before the end of file,
* an end-of-file object is returned.
doc>
*/
DEFINE_PRIMITIVE("read-bytevector", read_bytevector, subr12, (SCM size, SCM port))
{
int count, n = STk_integer_value(size);
SCM z;
port = verify_port(port, PORT_READ);
if (!PORT_BINARYP(port))
STk_error("bad binary input port ~S", port);
if (n < 0) STk_error("bad length");
/* Allocate a new bytevector for result */
z = STk_make_C_bytevector(n);
count = STk_read_buffer(port, UVECTOR_DATA(z), n);
if (count == 0)
return STk_eof;
if (count < n) {
/* result is shorter than the allocated bytevector */
return STk_make_bytevector_from_C_string(UVECTOR_DATA(z), count);
}
return z;
}
/*
<doc EXT read-bytes read-chars!
* (read-bytes! str)
* (read-bytes! str port)
*
* This function reads the characters available from |port| in the string |str|
* by chuncks whose size is equal to the length of |str|.
* The value returned by |read-chars!|is an integer indicating the number
* The value returned by |read-bytes!|is an integer indicating the number
* of characters read. |Port| may be omitted, in which case it defaults to the
* value returned by |current-input-port|.
* @l
* This function is similar to |read-chars| except that it avoids to allocate
* This function is similar to |read-bytes| except that it avoids to allocate
* a new string for each read.
* @lisp
* (define (copy-file from to)
......@@ -368,7 +407,7 @@ DEFINE_PRIMITIVE("read-bytes", read_chars, subr12, (SCM size, SCM port))
* (out (open-output-file to))
* (s (make-string size)))
* (let Loop ()
* (let ((n (read-chars! s in)))
* (let ((n (read-bytes! s in)))
* (cond
* ((= n size)
* (write-chars s out)
......@@ -379,14 +418,34 @@ DEFINE_PRIMITIVE("read-bytes", read_chars, subr12, (SCM size, SCM port))
* @end lisp
doc>
*/
DEFINE_PRIMITIVE("read-chars!", d_read_chars, subr12, (SCM str, SCM port))
DEFINE_PRIMITIVE("read-bytes!", d_read_bytes, subr12, (SCM str, SCM port))
{
port = verify_port(port, PORT_READ);
if (!STRINGP(str)) STk_error("bad string ~S", str);
return MAKE_INT(STk_read_buffer(port, STRING_CHARS(str), STRING_LENGTH(str)));
}
DEFINE_PRIMITIVE("%read-bytevector!", d_read_bytevector, subr4,
(SCM str, SCM port, SCM start, SCM end))
{
long vstart = STk_integer_value(start);
long vend = STk_integer_value(end);
port = verify_port(port, PORT_READ);
if (!STRINGP(str)) STk_error("bad string ~S", str);
return MAKE_INT(STk_read_buffer(port, STRING_CHARS(str), STRING_SIZE(str)));
if (vstart < 0) STk_error("bad start value ~S", start);
if (vend == LONG_MIN || vend > STRING_LENGTH(str))
STk_error("bad end value ~S", start);
if (vend > vstart) STk_error("start index is bigger than end index");
STk_read_buffer(port, STRING_CHARS(str)+ vstart, vend - vstart);
return STk_void;
}
/*
<doc EXT read-byte
* (read-byte)
......@@ -1558,8 +1617,9 @@ int STk_init_port(void)
ADD_PRIMITIVE(scheme_read);
ADD_PRIMITIVE(scheme_read_cst);
ADD_PRIMITIVE(read_char);
ADD_PRIMITIVE(read_chars);
ADD_PRIMITIVE(d_read_chars);
ADD_PRIMITIVE(read_bytes);
ADD_PRIMITIVE(read_bytevector);
ADD_PRIMITIVE(d_read_bytes);
ADD_PRIMITIVE(peek_char);
ADD_PRIMITIVE(peek_byte);
ADD_PRIMITIVE(read_byte);
......
......@@ -20,7 +20,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 17-Feb-1993 12:27
* Last file update: 3-Aug-2018 17:59 (eg)
* Last file update: 3-Aug-2018 18:16 (eg)
*
*/
......@@ -318,7 +318,7 @@ make_bport(enum kind_port kind, SCM str, int init_len, int flags)
PORT_FNAME(res) = "bytevector port";
PORT_CLOSEHOOK(res) = STk_false;
PORT_PRINT(res) = NULL;
PORT_PRINT(res) = sport_print;
PORT_RELEASE(res) = sport_release;
PORT_GETC(res) = Sgetc;
PORT_READY(res) = Sreadyp;
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 22:58 (eg)
* Last file update: 2-Aug-2018 23:03 (eg)
* Last file update: 5-Aug-2018 17:23 (eg)
*/
......@@ -944,6 +944,8 @@ struct port_obj {
#define PORT_IS_CLOSEDP(x) (PORT_FLAGS(x) & PORT_CLOSED)
#define PORT_CASE_SENSITIVEP(x) (PORT_FLAGS(x) & PORT_CASE_SENSITIVE)
#define PORT_BINARYP(x) (PORT_FLAGS(x) & PORT_BINARY)
#define PORT_TEXTUALP(x) (PORT_FLAGS(x) & PORT_TEXTUAL)
/****
......@@ -1328,6 +1330,7 @@ int STk_uvector_equal(SCM u1, SCM u2);
SCM STk_list2uvector(int type, SCM l);
int STk_init_uniform_vector(void);
SCM STk_make_C_bytevector(int len);
SCM STk_make_bytevector_from_C_string(char *str, long len);
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 15-Apr-2001 10:13 (eg)
* Last file update: 2-Aug-2018 23:00 (eg)
* Last file update: 3-Aug-2018 19:25 (eg)
*/
#include "stklos.h"
......@@ -498,9 +498,16 @@ static struct extended_type_descr xtype_uvector = {
/* */
/*==========================================================================*/
SCM STk_make_C_bytevector(int len, char *init)
SCM STk_make_C_bytevector(int len)
{
return makeuvect(UVECT_U8, len, init);
return makeuvect(UVECT_U8, len, NULL);
}
SCM STk_make_bytevector_from_C_string(char *str, long len)
{
SCM z = makeuvect(UVECT_U8, len, (SCM) NULL);
memcpy(UVECTOR_DATA(z),str, len);
return z;
}
......@@ -594,13 +601,6 @@ DEFINE_PRIMITIVE("bytevector-append", bytevector_append, vsubr,(int argc, SCM *a
* @end lisp
doc>
*/
SCM STk_make_bytevector_from_C_string(char *str, long len)
{
SCM z = makeuvect(UVECT_U8, len, (SCM) NULL);
memcpy(UVECTOR_DATA(z),str, len);
return z;
}
DEFINE_PRIMITIVE("utf8->string", utf82string, vsubr, (int argc, SCM *argv))
{
long start, end, len;
......
......@@ -22,7 +22,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-Apr-2011 20:58 (eg)
;;;; Last file update: 3-Aug-2018 17:12 (eg)
;;;; Last file update: 5-Aug-2018 17:45 (eg)
;;;;
(require "test")
......@@ -467,5 +467,36 @@
(close-port p)
(list closed? val (port-closed? p)))))
; --------------------------------------------------
(let ((p (open-input-bytevector #u8(0 1 2 3))))
(test "read-bytevector.1"
'(#u8(0 1 2 3) . #eof)
(let* ((c0 (read-bytevector 2 p))
(c1 (read-bytevector 3 p))
(c2 (read-bytevector 1 p)))
(cons (bytevector-append c0 c1) c2))))
(test "read-bytevector.2"
#t
(eof-object? (read-bytevector 3 (open-input-bytevector #u8()))))
(test "read-bytevector.3"
#t (u8-ready? (open-input-bytevector #u8(1))))
(test "read-bytevector.4"
#u8(0)
(read-bytevector 3 (open-input-bytevector #u8(0))))
(test "read-bytevector.4"
#u8(0 1)
(read-bytevector 3 (open-input-bytevector #u8(0 1))))
(test "read-bytevector.4"
#u8(0 1 2)
(read-bytevector 3 (open-input-bytevector #u8(0 1 2))))
(test "read-bytevector.5"
#u8(0 1 2)
(read-bytevector 3 (open-input-bytevector #u8(0 1 2 3))))
(test "read-bytevector.6"
#u8(0 1 2)
(read-bytevector 10 (open-input-bytevector #u8(0 1 2 ))))
(test-section-end)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment