Commit 2d2c5fec authored by Erick's avatar Erick

Added input and output bytecode vectors

parent 2c6f01a2
......@@ -20,7 +20,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 17-Feb-1993 12:27
* Last file update: 1-Aug-2018 18:28 (eg)
* Last file update: 3-Aug-2018 16:09 (eg)
*
*/
......@@ -37,6 +37,11 @@ static void error_bad_string(SCM s)
STk_error("bad string ~S", s);
}
static void error_bad_bytevector(SCM bv)
{
STk_error("bad bytevector ~S", bv);
}
/*===========================================================================*\
*
* Low level plugins
......@@ -181,11 +186,13 @@ static off_t Sseek(void *stream, off_t offset, int whence)
static void sport_print(SCM obj, SCM port) /* Generic printing of string ports */
{
char buffer[MAX_PATH_LENGTH + 20];
int flags = PORT_FLAGS(obj);
sprintf(buffer, "#[%s-string-port %lx%s]",
ISPORTP(obj) ? "input" : "output",
sprintf(buffer, "#[%s-%s-port %lx%s]",
(flags & PORT_READ) ? "input" : "output",
(flags & PORT_BINARY) ? "bytevector" : "string",
(unsigned long) obj,
PORT_IS_CLOSEDP(obj) ? " (closed)" : "");
(flags & PORT_CLOSED) ? " (closed)" : "");
STk_puts(buffer, port);
}
......@@ -195,12 +202,14 @@ static void sport_release(SCM port)
}
/*===========================================================================*\
*
* Input ports
* String ports
*
\*===========================================================================*/
enum kind_port {SREAD_C, SREAD, SWRITE};
enum kind_port {PREAD_C, PREAD, PWRITE};
static struct port_obj *
make_sport(enum kind_port kind, SCM str, int init_len, int flags)
......@@ -210,7 +219,7 @@ make_sport(enum kind_port kind, SCM str, int init_len, int flags)
/* Initialize the stream part */
switch (kind) {
case SREAD: /* this is a input string */
case PREAD: /* this is a input string */
{
char *s = STRING_CHARS(str);
......@@ -219,12 +228,12 @@ make_sport(enum kind_port kind, SCM str, int init_len, int flags)
PORT_STR(ss) = str;
break;
}
case SREAD_C: /* this is a input string (from a C string) */
case PREAD_C: /* this is a input string (from a C string) */
PORT_BASE(ss) = (char *) str;
PORT_END(ss) = (char *) str + init_len;
PORT_STR(ss) = str;
break;
case SWRITE: /* This is an output string */
case PWRITE: /* This is an output string */
PORT_BASE(ss) = PORT_END(ss) = STk_must_malloc_atomic(init_len);
PORT_STR(ss) = STk_false;
break;
......@@ -236,10 +245,10 @@ make_sport(enum kind_port kind, SCM str, int init_len, int flags)
/* Set the case sensitive bit */
if (STk_read_case_sensitive) flags |= PORT_CASE_SENSITIVE;
/* Initialize now the port itsef */
/* Initialize now the port itself */
NEWCELL(res, port);
PORT_STREAM(res) = ss;
PORT_FLAGS(res) = flags | PORT_IS_STRING | PORT_TEXTUAL;
PORT_FLAGS(res) = flags;
PORT_UNGETC(res) = EOF;
PORT_LINE(res) = 1;
PORT_POS(res) = 0;
......@@ -264,12 +273,78 @@ make_sport(enum kind_port kind, SCM str, int init_len, int flags)
return (struct port_obj *) res;
}
/*===========================================================================*\
*
* Bytevector ports
*
\*===========================================================================*/
static struct port_obj *
make_bport(enum kind_port kind, SCM str, int init_len, int flags)
{
struct sstream *ss = STk_must_malloc(sizeof(struct sstream));
SCM res;
/* Initialize the stream part */
switch (kind) {
case PREAD: /* this is a input bytevector */
{
char *s = UVECTOR_DATA(str);
PORT_BASE(ss) = s;
PORT_END(ss) = s + init_len;
PORT_STR(ss) = str;
break;
}
// case PREAD_C: /* this is a input string (from a C string) */
// PORT_BASE(ss) = (char *) str;
// PORT_END(ss) = (char *) str + init_len;
// PORT_STR(ss) = str;
// break;
case PWRITE: /* This is an output bytevector */
PORT_BASE(ss) = PORT_END(ss) = STk_must_malloc_atomic(init_len);
PORT_STR(ss) = STk_false;
break;
}
PORT_PTR(ss) = PORT_BASE(ss);
PORT_BUFSIZE(ss) = init_len;
/* Initialize now the port itself */
NEWCELL(res, port);
PORT_STREAM(res) = ss;
PORT_FLAGS(res) = flags;
PORT_UNGETC(res) = EOF;
PORT_LINE(res) = 1;
PORT_POS(res) = 0;
PORT_FNAME(res) = "bytevector port";
PORT_CLOSEHOOK(res) = STk_false;
PORT_PRINT(res) = NULL;
PORT_RELEASE(res) = sport_release;
PORT_GETC(res) = Sgetc;
PORT_READY(res) = Sreadyp;
PORT_EOFP(res) = Seof;
PORT_CLOSE(res) = Sclose;
PORT_PUTC(res) = Sputc;
PORT_PUTS(res) = NULL;
PORT_PUTSTRING(res) = NULL;
PORT_NPUTS(res) = Snputs;
PORT_FLUSH(res) = Sflush;
PORT_BREAD(res) = Sread;
PORT_BWRITE(res) = Swrite;
PORT_SEEK(res) = Sseek;
return (struct port_obj *) res;
}
/*
* open-input-string with a C string ...
*/
SCM STk_open_C_string(char *str)
{
return (SCM) make_sport(SREAD_C, (SCM) str, strlen(str), PORT_READ);
return (SCM) make_sport(PREAD_C, (SCM) str, strlen(str),
PORT_IS_STRING | PORT_READ | PORT_TEXTUAL);
}
......@@ -284,7 +359,24 @@ doc>
DEFINE_PRIMITIVE("open-input-string", open_input_string, subr1, (SCM s))
{
if (!STRINGP(s)) error_bad_string(s);
return (SCM) make_sport(SREAD, s, STRING_SIZE(s), PORT_READ);
return (SCM) make_sport(PREAD, s, STRING_SIZE(s),
PORT_IS_STRING | PORT_READ| PORT_TEXTUAL);
}
/*
<doc R7RS open-input-bytevector
* (open-input-string bytevector)
*
* Takes a bytevector and returns a binary input port that
* delivers bytes from the |bytevector|.
doc>
*/
DEFINE_PRIMITIVE("open-input-bytevector", open_input_bytevector, subr1, (SCM bv))
{
if (!BYTEVECTORP(bv)) error_bad_bytevector(bv);
return (SCM) make_bport(PREAD, bv, UVECTOR_SIZE(bv),
PORT_IS_BYTEVECTOR | PORT_READ | PORT_BINARY);
}
......@@ -295,11 +387,28 @@ DEFINE_PRIMITIVE("open-input-string", open_input_string, subr1, (SCM s))
* Returns an output string port capable of receiving and collecting characters.
doc>
*/
DEFINE_PRIMITIVE("open-output-string", open_output_string, subr0,(void))
DEFINE_PRIMITIVE("open-output-string", open_output_string, subr0, (void))
{
return (SCM) make_sport(SWRITE, (SCM) NULL, START_ALLOC_SIZE, PORT_WRITE);
return (SCM) make_sport(PWRITE, (SCM) NULL, START_ALLOC_SIZE,
PORT_IS_STRING | PORT_WRITE | PORT_TEXTUAL);
}
/*
<doc R7RS open-output-bytevector
* (open-output-bytevector)
*
* Returns a binary output port that will accumulate bytes
* for retrieval by |get-output-bytevector|.
doc>
*/
DEFINE_PRIMITIVE("open-output-bytevector", open_output_bytevector, subr0, (void))
{
return (SCM) make_bport(PWRITE, (SCM) NULL, START_ALLOC_SIZE,
PORT_IS_BYTEVECTOR | PORT_WRITE | PORT_BINARY);
}
/*
<doc EXT get-output-string
......@@ -326,6 +435,33 @@ DEFINE_PRIMITIVE("get-output-string", get_output_string, subr1, (SCM port))
return STk_makestring(PORT_END(p) - base, base);
}
/*
<doc EXT get-output-bytevector
* (get-output-bytevector port)
*
* Returns a bytevector consisting of the bytes that have been
* output to the |port| so far in the order they were output.
*
* @lisp
* (let ((p (open-output-bytevector)))
* (u8-write 65)
* (u8-write 66)
* (get-output-bytevector p)) => #u8(65 66)
* @end lisp
doc>
*/
DEFINE_PRIMITIVE("get-output-bytevector", get_output_bytevector, subr1, (SCM port))
{
struct port_obj* p;
char *base;
if (! OBPORTP(port)) STk_error_bad_port(port);
p = PORT_STREAM(port);
base = PORT_BASE(p);
return STk_make_bytevector_from_C_string(base, PORT_END(p) - base);
}
/*
<doc EXT input-string-port? output-string-port?
......@@ -346,13 +482,41 @@ DEFINE_PRIMITIVE("output-string-port?", output_string_portp, subr1, (SCM port))
return MAKE_BOOLEAN(OSPORTP(port));
}
/*
<doc EXT input-bytevector-port? output-bytevector-port?
* (input-bytevector-port? obj)
* (output-bytevector-port? obj)
*
* Returns |#t| if |obj| is an input bytevector port or output bytevector port
* respectively, otherwise returns #f.
doc>
*/
DEFINE_PRIMITIVE("input-bytevector-port?", input_bytevector_portp, subr1, (SCM port))
{
return MAKE_BOOLEAN(IBPORTP(port));
}
DEFINE_PRIMITIVE("output-bytevector-port?",output_bytevector_portp,subr1, (SCM port))
{
return MAKE_BOOLEAN(OBPORTP(port));
}
int STk_init_sport(void)
{
ADD_PRIMITIVE(open_input_string);
ADD_PRIMITIVE(open_input_bytevector);
ADD_PRIMITIVE(open_output_string);
ADD_PRIMITIVE(open_output_bytevector);
ADD_PRIMITIVE(get_output_string);
ADD_PRIMITIVE(get_output_bytevector);
ADD_PRIMITIVE(input_string_portp);
ADD_PRIMITIVE(input_bytevector_portp);
ADD_PRIMITIVE(output_string_portp);
ADD_PRIMITIVE(output_bytevector_portp);
return TRUE;
}
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 22:58 (eg)
* Last file update: 18-Jul-2018 16:17 (eg)
* Last file update: 2-Aug-2018 23:03 (eg)
*/
......@@ -934,6 +934,10 @@ struct port_obj {
#define ISPORTP(x) (SPORTP(x) && (PORT_FLAGS(x) & (PORT_READ|PORT_RW)))
#define OSPORTP(x) (SPORTP(x) && (PORT_FLAGS(x) & (PORT_WRITE|PORT_RW)))
#define BPORTP(x) (PORTP(x) && (PORT_FLAGS(x) & PORT_IS_BYTEVECTOR))
#define IBPORTP(x) (BPORTP(x) && (PORT_FLAGS(x) & (PORT_READ|PORT_RW)))
#define OBPORTP(x) (BPORTP(x) && (PORT_FLAGS(x) & (PORT_WRITE|PORT_RW)))
#define VPORTP(x) (PORTP(x) && (PORT_FLAGS(x) & PORT_IS_VIRTUAL))
#define IVPORTP(x) (VPORTP(x) && (PORT_FLAGS(x) & (PORT_READ|PORT_RW)))
#define OVPORTP(x) (VPORTP(x) && (PORT_FLAGS(x) & (PORT_WRITE|PORT_RW)))
......@@ -1275,7 +1279,6 @@ int STk_utf8_char_from_byte(char *s, int i, int max); /* byte index => char ind
int STk_init_utf8(void);
/*
------------------------------------------------------------------------------
----
......@@ -1284,6 +1287,40 @@ int STk_init_utf8(void);
------------------------------------------------------------------------------
*/
struct uvector_obj {
stk_header header;
int vect_type;
int size;
char data[1];
};
#define UVECT_S8 0
#define UVECT_U8 1
#define UVECT_S16 2
#define UVECT_U16 3
#define UVECT_S32 4
#define UVECT_U32 5
#define UVECT_S64 6
#define UVECT_U64 7
#define UVECT_F32 8
#define UVECT_F64 9
/*
* 64 bits values are always represented with bignums even on 64 bits machines
* Here are the intersting maxima for 64 bits.
*/
#define S64_MIN "-9223372036854775808"
#define S64_MAX "9223372036854775807"
#define U64_MAX "18446744073709551615"
#define UVECTOR_TYPE(p) (((struct uvector_obj *) (p))->vect_type)
#define UVECTOR_SIZE(p) (((struct uvector_obj *) (p))->size)
#define UVECTOR_DATA(p) (((struct uvector_obj *) (p))->data)
#define UVECTORP(p) (BOXED_TYPE_EQ((p), tc_uvector))
#define BYTEVECTORP(p) (UVECTORP(p) && UVECTOR_TYPE(p) == UVECT_U8)
extern int STk_uvectors_allowed;
int STk_uniform_vector_tag(char *s);
......@@ -1291,6 +1328,9 @@ int STk_uvector_equal(SCM u1, SCM u2);
SCM STk_list2uvector(int type, SCM l);
int STk_init_uniform_vector(void);
SCM STk_make_bytevector_from_C_string(char *str, long len);
/*
------------------------------------------------------------------------------
----
......
......@@ -22,7 +22,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: ??????
* Last file update: 10-Jul-2018 20:33 (eg)
* Last file update: 2-Aug-2018 23:04 (eg)
*/
#include <ctype.h>
......@@ -1317,7 +1317,7 @@ DEFINE_PRIMITIVE("string->utf8", string2utf8, vsubr, (int argc, SCM *argv))
start_addr = STk_utf8_index(STRING_CHARS(str), (int) start, STRING_SIZE(str));
end_addr = STk_utf8_index(STRING_CHARS(str), (int) end, STRING_SIZE(str));
return STk_make_bytevector_from_string(start_addr, end_addr - start_addr);
return STk_make_bytevector_from_C_string(start_addr, end_addr - start_addr);
}
......
......@@ -21,46 +21,12 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 15-Apr-2001 10:13 (eg)
* Last file update: 11-Jul-2018 16:25 (eg)
* Last file update: 2-Aug-2018 23:00 (eg)
*/
#include "stklos.h"
#define UVECT_S8 0
#define UVECT_U8 1
#define UVECT_S16 2
#define UVECT_U16 3
#define UVECT_S32 4
#define UVECT_U32 5
#define UVECT_S64 6
#define UVECT_U64 7
#define UVECT_F32 8
#define UVECT_F64 9
/*
* 64 bits values are always represeneted with bignums even on 64 bits machines
* Here are the intersting maxima for 64 bits.
*/
#define S64_MIN "-9223372036854775808"
#define S64_MAX "9223372036854775807"
#define U64_MAX "18446744073709551615"
struct uvector_obj {
stk_header header;
int vect_type;
int size;
char data[1];
};
int STk_uvectors_allowed = 0;
#define UVECTOR_TYPE(p) (((struct uvector_obj *) (p))->vect_type)
#define UVECTOR_SIZE(p) (((struct uvector_obj *) (p))->size)
#define UVECTOR_DATA(p) (((struct uvector_obj *) (p))->data)
#define UVECTORP(p) (BOXED_TYPE_EQ((p), tc_uvector))
static SCM u64_max, s64_min, s64_max;
......@@ -531,6 +497,13 @@ static struct extended_type_descr xtype_uvector = {
/* B Y T E V E C T O R S */
/* */
/*==========================================================================*/
SCM STk_make_C_bytevector(int len, char *init)
{
return makeuvect(UVECT_U8, len, init);
}
/*
<doc R7RS bytevector-copy
* (bytevector-copy bytevector)
......@@ -621,7 +594,7 @@ DEFINE_PRIMITIVE("bytevector-append", bytevector_append, vsubr,(int argc, SCM *a
* @end lisp
doc>
*/
SCM STk_make_bytevector_from_string(char *str, long len)
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);
......@@ -640,7 +613,7 @@ DEFINE_PRIMITIVE("utf8->string", utf82string, vsubr, (int argc, SCM *argv))
len = end_addr - start_addr;
/* Verify that the sub-vector denotes a correct string */
if (STk_utf8_verify_sequence(start_addr, len)) {
if (STk_utf8_verify_sequence((char *) start_addr, len)) {
SCM z = STk_makestring(len, NULL);
memcpy(STRING_CHARS(z), start_addr, end_addr - start_addr);
return z;
......
......@@ -22,7 +22,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-Apr-2011 20:58 (eg)
;;;; Last file update: 1-Aug-2018 18:29 (eg)
;;;; Last file update: 3-Aug-2018 17:12 (eg)
;;;;
(require "test")
......@@ -394,7 +394,7 @@
(make-list 4 42))
;;------------------------------------------------------------------
;;======================================================================
(test-subsection "Input and Output")
(test "call-with-port"
......@@ -408,5 +408,64 @@
(test "read-string.2" "E" (read-string 4 p))
(test "read-string.3" #eof (read-string 4 p)))
;; --------------------------------------------------
(let ((p (open-input-bytevector #u8(0 1 2 3))))
(test "input bytevector.1"
'(#eof 3 2 1 0)
(let* ((c0 (read-byte p))
(c1 (read-byte p))
(c2 (read-byte p))
(c3 (read-byte p))
(c4 (read-byte p)))
(list c4 c3 c2 c1 c0))))
(let ((p (open-input-bytevector #u8(0 1 2 3))))
(test "input bytevector.2"
'(#\x0 #\x1 #\x2 #\x3 . #eof)
(let* ((c0 (read-chars 2 p))
(c1 (read-chars 3 p))
(c2 (read-chars 1 p)))
(append (string->list c0)
(string->list c1)
c2))))
(let ((p (open-input-bytevector #u8())))
(test "input bytevector.3"
(make-list 5 #eof)
(let* ((c0 (read-byte p))
(c1 (read-byte p))
(c2 (read-byte p))
(c3 (read-byte p))
(c4 (read-byte p)))
(list c4 c3 c2 c1 c0))))
; --------------------------------------------------
(let ((p (open-output-bytevector)))
(test "output bytevector.1"
#u8()
(get-output-bytevector p)))
(let ((p (open-output-bytevector)))
(test "output bytevector.2"
#u8(1 2)
(begin
(write-byte 1 p)
(write-byte 2 p)
(get-output-bytevector p)))
(test "output bytevector.3"
#u8(1 2 3 4)
(begin
(write-byte 3 p)
(write-byte 4 p)
(get-output-bytevector p)))
(test "close bytevector port"
'(#f #u8(1 2 3 4) #t)
(let* ((closed? (port-closed? p))
(val (get-output-bytevector p)))
(close-port p)
(list closed? val (port-closed? p)))))
(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