commit dc4601d7152e9944baca0fe1d2b21d47abbba4c1
parent e3d7e46e591e5c2378ccd13127526f68f3771220
Author: Andres Navarro <canavarro82@gmail.com>
Date: Wed, 16 Nov 2011 16:11:46 -0300
Added binary ports (as opposed to the current character ports).
Diffstat:
14 files changed, 299 insertions(+), 48 deletions(-)
diff --git a/src/kgblobs.c b/src/kgblobs.c
@@ -106,7 +106,7 @@ void blob_u8_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
UNUSED(xparams);
UNUSED(denv);
bind_3tp(K, ptree, "blob", ttisblob, blob,
- "exact integer", keintegerp, tv_i, "exact integer", keintegerp, tv_byte);
+ "exact integer", keintegerp, tv_i, "u8", ttisu8, tv_byte);
if (!ttisfixint(tv_i)) {
/* TODO show index */
@@ -115,10 +115,7 @@ void blob_u8_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
} else if (kblob_immutablep(blob)) {
klispE_throw_simple(K, "immutable blob");
return;
- } else if (ivalue(tv_byte) < 0 || ivalue(tv_byte) > 255) {
- klispE_throw_simple(K, "bad byte");
- return;
- }
+ }
int32_t i = ivalue(tv_i);
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -50,6 +50,8 @@ bool kfinitep(TValue obj) { return !ttisinf(obj); }
bool kintegerp(TValue obj) { return ttisinteger(obj); }
/* only exact integers (like for indices), bigints & fixints */
bool keintegerp(TValue obj) { return ttiseinteger(obj); }
+/* exact integers between 0 and 255 inclusive */
+bool ku8p(TValue obj) { return ttisu8(obj); }
bool krationalp(TValue obj) { return ttisrational(obj); }
bool krealp(TValue obj) { return ttisreal(obj); }
/* TEMP used (as a type predicate) in all predicates that need a real with
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -36,6 +36,7 @@ bool kexactp(TValue obj);
bool kinexactp(TValue obj);
bool kundefinedp(TValue obj);
bool krobustp(TValue obj);
+bool ku8p(TValue obj);
/* 12.5.2 =? */
diff --git a/src/kgports.c b/src/kgports.c
@@ -66,7 +66,7 @@ void with_file(klisp_State *K, TValue *xparams, TValue ptree,
bind_2tp(K, ptree, "string", ttisstring, filename,
"combiner", ttiscombiner, comb);
- TValue new_port = kmake_port(K, filename, writep);
+ TValue new_port = kmake_port(K, filename, writep, false);
krooted_tvs_push(K, new_port);
/* make the continuation to close the file before returning */
TValue new_cont = kmake_continuation(K, kget_cc(K),
@@ -109,11 +109,12 @@ void get_current_port(klisp_State *K, TValue *xparams, TValue ptree,
void open_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
bool writep = bvalue(xparams[1]);
+ bool binaryp = bvalue(xparams[2]);
UNUSED(denv);
bind_1tp(K, ptree, "string", ttisstring, filename);
- TValue new_port = kmake_port(K, filename, writep);
+ TValue new_port = kmake_port(K, filename, writep, binaryp);
kapply_cc(K, new_port);
}
@@ -136,6 +137,27 @@ void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
}
+/* 15.1.? close-input-port, close-output-port, close-port */
+void close_port(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ bool readp = bvalue(xparams[1]);
+ bool writep = bvalue(xparams[2]);
+ UNUSED(denv);
+
+ bind_1tp(K, ptree, "port", ttisport, port);
+
+ bool dir_ok = !((writep && !kport_is_output(port)) ||
+ (readp && !kport_is_input(port)));
+
+ if (dir_ok) {
+ kclose_port(K, port);
+ kapply_cc(K, KINERT);
+ } else {
+ klispE_throw_simple(K, "wrong input/output direction");
+ return;
+ }
+}
+
/* 15.1.7 read */
void read(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
@@ -145,11 +167,15 @@ void read(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue port = ptree;
if (!get_opt_tpar(K, "read", K_TPORT, &port)) {
port = kcdr(K->kd_in_port_key); /* access directly */
- } else if (!kport_is_input(port)) {
+ }
+
+ if (!kport_is_input(port)) {
klispE_throw_simple(K, "the port should be an input port");
return;
- }
- if (kport_is_closed(port)) {
+ } else if (!kport_is_character(port)) {
+ klispE_throw_simple(K, "the port should be a character port");
+ return;
+ } else if (kport_is_closed(port)) {
klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -170,11 +196,15 @@ void write(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!get_opt_tpar(K, "write", K_TPORT, &port)) {
port = kcdr(K->kd_out_port_key); /* access directly */
- } else if (!kport_is_output(port)) {
+ }
+
+ if (!kport_is_output(port)) {
klispE_throw_simple(K, "the port should be an output port");
return;
- }
- if (kport_is_closed(port)) {
+ } else if (!kport_is_character(port)) {
+ klispE_throw_simple(K, "the port should be a character port");
+ return;
+ } else if (kport_is_closed(port)) {
klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -196,11 +226,15 @@ void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue port = ptree;
if (!get_opt_tpar(K, "newline", K_TPORT, &port)) {
port = kcdr(K->kd_out_port_key); /* access directly */
- } else if (!kport_is_output(port)) {
+ }
+
+ if (!kport_is_output(port)) {
klispE_throw_simple(K, "the port should be an output port");
return;
- }
- if (kport_is_closed(port)) {
+ } else if (!kport_is_character(port)) {
+ klispE_throw_simple(K, "the port should be a character port");
+ return;
+ } else if (kport_is_closed(port)) {
klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -220,11 +254,15 @@ void write_char(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!get_opt_tpar(K, "write-char", K_TPORT, &port)) {
port = kcdr(K->kd_out_port_key); /* access directly */
- } else if (!kport_is_output(port)) {
+ }
+
+ if (!kport_is_output(port)) {
klispE_throw_simple(K, "the port should be an output port");
return;
- }
- if (kport_is_closed(port)) {
+ } else if (!kport_is_character(port)) {
+ klispE_throw_simple(K, "the port should be a character port");
+ return;
+ } else if (kport_is_closed(port)) {
klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -249,11 +287,15 @@ void read_peek_char(klisp_State *K, TValue *xparams, TValue ptree,
TValue port = ptree;
if (!get_opt_tpar(K, name, K_TPORT, &port)) {
port = kcdr(K->kd_in_port_key); /* access directly */
- } else if (!kport_is_input(port)) {
+ }
+
+ if (!kport_is_input(port)) {
klispE_throw_simple(K, "the port should be an input port");
return;
- }
- if (kport_is_closed(port)) {
+ } else if (!kport_is_character(port)) {
+ klispE_throw_simple(K, "the port should be a character port");
+ return;
+ } else if (kport_is_closed(port)) {
klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -282,11 +324,15 @@ void char_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue port = ptree;
if (!get_opt_tpar(K, "char-ready?", K_TPORT, &port)) {
port = kcdr(K->kd_in_port_key); /* access directly */
- } else if (!kport_is_input(port)) {
+ }
+
+ if (!kport_is_input(port)) {
klispE_throw_simple(K, "the port should be an input port");
return;
- }
- if (kport_is_closed(port)) {
+ } else if (!kport_is_character(port)) {
+ klispE_throw_simple(K, "the port should be a character port");
+ return;
+ } else if (kport_is_closed(port)) {
klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -295,6 +341,102 @@ void char_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
kapply_cc(K, KTRUE);
}
+/* 15.1.? write-u8 */
+void write_u8(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ bind_al1tp(K, ptree, "u8", ttisu8, u8, port);
+
+ if (!get_opt_tpar(K, "write-u8", K_TPORT, &port)) {
+ port = kcdr(K->kd_out_port_key); /* access directly */
+ }
+
+ if (!kport_is_output(port)) {
+ klispE_throw_simple(K, "the port should be an output port");
+ return;
+ } else if (!kport_is_binary(port)) {
+ klispE_throw_simple(K, "the port should be a binary port");
+ return;
+ } else if (kport_is_closed(port)) {
+ klispE_throw_simple(K, "the port is already closed");
+ return;
+ }
+
+ kwrite_char_to_port(K, port, u8);
+ kapply_cc(K, KINERT);
+}
+
+/* Helper for read-u8 and peek-u8 */
+void read_peek_u8(klisp_State *K, TValue *xparams, TValue ptree,
+ TValue denv)
+{
+ /*
+ ** xparams[0]: symbol name
+ ** xparams[1]: ret-u8-after-readp
+ */
+ UNUSED(denv);
+
+ char *name = ksymbol_buf(xparams[0]);
+ bool ret_u8p = bvalue(xparams[1]);
+
+ TValue port = ptree;
+ if (!get_opt_tpar(K, name, K_TPORT, &port)) {
+ port = kcdr(K->kd_in_port_key); /* access directly */
+ }
+
+ if (!kport_is_input(port)) {
+ klispE_throw_simple(K, "the port should be an input port");
+ return;
+ } else if (!kport_is_binary(port)) {
+ klispE_throw_simple(K, "the port should be a binary port");
+ return;
+ } else if (kport_is_closed(port)) {
+ klispE_throw_simple(K, "the port is already closed");
+ return;
+ }
+
+ TValue obj = kread_peek_u8_from_port(K, port, ret_u8p);
+ kapply_cc(K, obj);
+}
+
+
+/* 15.1.? read-u8 */
+/* uses read_peek_u8 */
+
+/* 15.1.? peek-u8 */
+/* uses read_peek_u8 */
+
+/* 15.1.? u8-ready? */
+/* XXX: this always return #t, proper behaviour requires platform
+ specific code (probably select for posix & a thread for windows
+ (at least for files & consoles, I think pipes and sockets may
+ have something) */
+void u8_readyp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ TValue port = ptree;
+ if (!get_opt_tpar(K, "u8-ready?", K_TPORT, &port)) {
+ port = kcdr(K->kd_in_port_key); /* access directly */
+ }
+
+ if (!kport_is_input(port)) {
+ klispE_throw_simple(K, "the port should be an input port");
+ return;
+ } else if (!kport_is_binary(port)) {
+ klispE_throw_simple(K, "the port should be a binary port");
+ return;
+ } else if (kport_is_closed(port)) {
+ klispE_throw_simple(K, "the port is already closed");
+ return;
+ }
+
+ /* TODO: check if there are pending chars */
+ kapply_cc(K, KTRUE);
+}
/* 15.2.1 call-with-input-file, call-with-output-file */
/* XXX: The report is incomplete here... for now use an empty environment,
@@ -310,7 +452,7 @@ void call_with_file(klisp_State *K, TValue *xparams, TValue ptree,
bind_2tp(K, ptree, "string", ttisstring, filename,
"combiner", ttiscombiner, comb);
- TValue new_port = kmake_port(K, filename, writep);
+ TValue new_port = kmake_port(K, filename, writep, false);
krooted_tvs_push(K, new_port);
/* make the continuation to close the file before returning */
TValue new_cont = kmake_continuation(K, kget_cc(K),
@@ -428,7 +570,7 @@ void load(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* the reads must be guarded to close the file if there is some error
this continuation also will return inert after the evaluation of the
last expression is done */
- TValue port = kmake_port(K, filename, false);
+ TValue port = kmake_port(K, filename, false, false);
krooted_tvs_push(K, port);
TValue inert_cont = make_return_value_cont(K, kget_cc(K), KINERT);
@@ -477,7 +619,7 @@ void get_module(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
bind_al1tp(K, ptree, "string", ttisstring, filename,
maybe_env);
- TValue port = kmake_port(K, filename, false);
+ TValue port = kmake_port(K, filename, false, false);
krooted_tvs_push(K, port);
TValue env = kmake_environment(K, K->ground_env);
@@ -537,11 +679,15 @@ void display(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!get_opt_tpar(K, "display", K_TPORT, &port)) {
port = kcdr(K->kd_out_port_key); /* access directly */
- } else if (!kport_is_output(port)) {
+ }
+
+ if (!kport_is_output(port)) {
klispE_throw_simple(K, "the port should be an output port");
return;
- }
- if (kport_is_closed(port)) {
+ } else if (!kport_is_character(port)) {
+ klispE_throw_simple(K, "the port should be a character port");
+ return;
+ } else if (kport_is_closed(port)) {
klispE_throw_simple(K, "the port is already closed");
return;
}
@@ -653,6 +799,12 @@ void kinit_ports_ground_env(klisp_State *K)
p2tv(kis_input_port));
add_applicative(K, ground_env, "output-port?", ftypep, 2, symbol,
p2tv(kis_output_port));
+ /* 15.1.? binary-port?, character-port? */
+ add_applicative(K, ground_env, "binary-port?", ftypep, 2, symbol,
+ p2tv(kis_binary_port));
+ add_applicative(K, ground_env, "character-port?", ftypep, 2, symbol,
+ p2tv(kis_character_port));
+
/* 15.1.3 with-input-from-file, with-ouput-to-file */
/* 15.1.? with-error-to-file */
add_applicative(K, ground_env, "with-input-from-file", with_file,
@@ -670,10 +822,16 @@ void kinit_ports_ground_env(klisp_State *K)
add_applicative(K, ground_env, "get-current-error-port", get_current_port,
2, symbol, K->kd_error_port_key);
/* 15.1.5 open-input-file, open-output-file */
- add_applicative(K, ground_env, "open-input-file", open_file, 2, symbol,
- b2tv(false));
- add_applicative(K, ground_env, "open-output-file", open_file, 2, symbol,
- b2tv(true));
+ add_applicative(K, ground_env, "open-input-file", open_file, 3, symbol,
+ b2tv(false), b2tv(false));
+ add_applicative(K, ground_env, "open-output-file", open_file, 3, symbol,
+ b2tv(true), b2tv(false));
+ /* 15.1.? open-binary-input-file, open-binary-output-file */
+ add_applicative(K, ground_env, "open-binary-input-file", open_file, 3, symbol,
+ b2tv(false), b2tv(true));
+ add_applicative(K, ground_env, "open-binary-output-file", open_file, 3, symbol,
+ b2tv(true), b2tv(true));
+
/* 15.1.6 close-input-file, close-output-file */
/* ASK John: should this be called close-input-port & close-ouput-port
like in r5rs? that doesn't seem consistent with open thou */
@@ -681,6 +839,14 @@ void kinit_ports_ground_env(klisp_State *K)
b2tv(false));
add_applicative(K, ground_env, "close-output-file", close_file, 2, symbol,
b2tv(true));
+ /* 15.1.? Use the r7rs names, in preparation for other kind of ports */
+ add_applicative(K, ground_env, "close-input-port", close_port, 3, symbol,
+ b2tv(true), b2tv(false));
+ add_applicative(K, ground_env, "close-output-port", close_port, 3, symbol,
+ b2tv(false), b2tv(true));
+ add_applicative(K, ground_env, "close-port", close_port, 3, symbol,
+ b2tv(false), b2tv(false));
+
/* 15.1.7 read */
add_applicative(K, ground_env, "read", read, 0);
/* 15.1.8 write */
@@ -709,6 +875,20 @@ void kinit_ports_ground_env(klisp_State *K)
(at least for files & consoles), I think pipes and sockets may
have something */
add_applicative(K, ground_env, "char-ready?", char_readyp, 0);
+ /* 15.1.? write-u8 */
+ add_applicative(K, ground_env, "write-u8", write_u8, 0);
+ /* 15.1.? read-u8 */
+ add_applicative(K, ground_env, "read-u8", read_peek_u8, 2, symbol,
+ b2tv(false));
+ /* 15.1.? peek-u8 */
+ add_applicative(K, ground_env, "peek-u8", read_peek_u8, 2, symbol,
+ b2tv(true));
+ /* 15.1.? u8-ready? */
+ /* XXX: this always return #t, proper behaviour requires platform
+ specific code (probably select for posix, a thread for windows
+ (at least for files & consoles), I think pipes and sockets may
+ have something */
+ add_applicative(K, ground_env, "u8-ready?", u8_readyp, 0);
/* 15.2.1 call-with-input-file, call-with-output-file */
add_applicative(K, ground_env, "call-with-input-file", call_with_file,
2, symbol, b2tv(false));
diff --git a/src/kobject.c b/src/kobject.c
@@ -78,6 +78,16 @@ bool kis_output_port(TValue o)
return ttisport(o) && kport_is_output(o);
}
+bool kis_binary_port(TValue o)
+{
+ return ttisport(o) && kport_is_binary(o);
+}
+
+bool kis_character_port(TValue o)
+{
+ return ttisport(o) && kport_is_character(o);
+}
+
int32_t klispO_log2 (uint32_t x) {
static const uint8_t log_2[256] = {
0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
diff --git a/src/kobject.h b/src/kobject.h
@@ -237,6 +237,9 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define ttisbigint(o) (tbasetype_(o) == K_TAG_BIGINT)
#define ttiseinteger(o_) ({ int32_t t_ = tbasetype_(o_); \
t_ == K_TAG_FIXINT || t_ == K_TAG_BIGINT;})
+#define ttisu8(o) ({ \
+ TValue o__ = (o); \
+ (ttisfixint(o__) && ivalue(o__) > 0 && ivalue(o__) < 256); })
#define ttisinteger(o) ({ TValue o__ = (o); \
(ttiseinteger(o__) || \
(ttisdouble(o__) && (floor(dvalue(o__)) == dvalue(o__))));})
@@ -789,14 +792,19 @@ int32_t kmark_count;
#define K_FLAG_OUTPUT_PORT 0x01
#define K_FLAG_INPUT_PORT 0x02
#define K_FLAG_CLOSED_PORT 0x04
+/* At least for now ports are either binary or character */
+#define K_FLAG_BINARY_PORT 0x08
#define kport_set_input(o_) (tv_get_kflags(o_) |= K_FLAG_INPUT_PORT)
#define kport_set_output(o_) (tv_get_kflags(o_) |= K_FLAG_INPUT_PORT)
#define kport_set_closed(o_) (tv_get_kflags(o_) |= K_FLAG_CLOSED_PORT)
+#define kport_set_binary(o_) (tv_get_kflags(o_) |= K_FLAG_BINARY_PORT)
#define kport_is_input(o_) ((tv_get_kflags(o_) & K_FLAG_INPUT_PORT) != 0)
#define kport_is_output(o_) ((tv_get_kflags(o_) & K_FLAG_OUTPUT_PORT) != 0)
#define kport_is_closed(o_) ((tv_get_kflags(o_) & K_FLAG_CLOSED_PORT) != 0)
+#define kport_is_binary(o_) ((tv_get_kflags(o_) & K_FLAG_BINARY_PORT) != 0)
+#define kport_is_character(o_) ((tv_get_kflags(o_) & K_FLAG_BINARY_PORT) == 0)
#define K_FLAG_WEAK_KEYS 0x01
#define K_FLAG_WEAK_VALUES 0x02
@@ -811,6 +819,8 @@ int32_t kmark_count;
(at least gcc doesn't bother to create them and the linker fails) */
bool kis_input_port(TValue o);
bool kis_output_port(TValue o);
+bool kis_binary_port(TValue o);
+bool kis_character_port(TValue o);
/* Macro to test the most basic equality on TValues */
#define tv_equal(tv1_, tv2_) ((tv1_).raw == (tv2_).raw)
diff --git a/src/kport.c b/src/kport.c
@@ -23,16 +23,22 @@
Should use open, but it is non standard (fcntl.h, POSIX only) */
/* GC: Assumes filename is rooted */
-TValue kmake_port(klisp_State *K, TValue filename, bool writep)
+TValue kmake_port(klisp_State *K, TValue filename, bool writep, bool binaryp)
{
/* for now always use text mode */
- FILE *f = fopen(kstring_buf(filename), writep? "w": "r");
+ char *mode;
+ if (binaryp)
+ mode = writep? "wb": "rb";
+ else
+ mode = writep? "w": "r";
+
+ FILE *f = fopen(kstring_buf(filename), mode);
if (f == NULL) {
klispE_throw_errno_with_irritants(K, "fopen", 2, filename,
- kstring_new_b_imm(K, writep? "w": "r"));
+ kstring_new_b_imm(K, mode));
return KINERT;
} else {
- return kmake_std_port(K, filename, writep, f);
+ return kmake_std_port(K, filename, writep, binaryp, f);
}
}
@@ -41,14 +47,15 @@ TValue kmake_port(klisp_State *K, TValue filename, bool writep)
/* GC: Assumes filename, name & si are rooted */
TValue kmake_std_port(klisp_State *K, TValue filename, bool writep,
- FILE *file)
+ bool binaryp, FILE *file)
{
Port *new_port = klispM_new(K, Port);
/* header + gc_fields */
klispC_link(K, (GCObject *) new_port, K_TPORT,
K_FLAG_CAN_HAVE_NAME |
- (writep? K_FLAG_OUTPUT_PORT : K_FLAG_INPUT_PORT));
+ (writep? K_FLAG_OUTPUT_PORT : K_FLAG_INPUT_PORT) |
+ (binaryp? K_FLAG_BINARY_PORT : 0));
/* port specific fields */
new_port->filename = filename;
diff --git a/src/kport.h b/src/kport.h
@@ -13,13 +13,13 @@
#include "kstate.h"
/* GC: Assumes filename is rooted */
-TValue kmake_port(klisp_State *K, TValue filename, bool writep);
+TValue kmake_port(klisp_State *K, TValue filename, bool writep, bool binaryp);
/* this is for creating ports for stdin/stdout/stderr &
helper for the one above */
/* GC: Assumes filename, name & si are rooted */
TValue kmake_std_port(klisp_State *K, TValue filename, bool writep,
- FILE *file);
+ bool binaryp, FILE *file);
/* This closes the underlying FILE * (unless it is a std port) and also
set the closed flag to true, this shouldn't throw errors because it
diff --git a/src/kread.c b/src/kread.c
@@ -597,8 +597,31 @@ TValue kread_peek_char_from_port(klisp_State *K, TValue port, bool peek)
return ch == EOF? KEOF : ch2tv((char)ch);
}
+TValue kread_peek_u8_from_port(klisp_State *K, TValue port, bool peek)
+{
+ /* Reset the EOF flag in the tokenizer. The flag is shared,
+ by operations on all ports. */
+ K->ktok_seen_eof = false;
+
+ K->curr_port = port;
+ K->curr_in = kport_file(port);
+ int32_t u8;
+ if (peek) {
+ u8 = ktok_peekc(K);
+ } else {
+ ktok_set_source_info(K, kport_filename(port),
+ kport_line(port), kport_col(port));
+ u8 = ktok_getc(K);
+ kport_update_source_info(port, K->ktok_source_info.line,
+ K->ktok_source_info.col);
+ }
+ return u8 == EOF? KEOF : i2tv(u8 & 0xff);
+}
+
/* This is needed by the repl to ignore trailing spaces (especially newlines)
that could affect the source info */
+/* XXX This should be replaced somehow, as it doesn't work for sexp and
+ multi line comments */
void kread_ignore_whitespace_and_comments_from_port(klisp_State *K,
TValue port)
{
diff --git a/src/kread.h b/src/kread.h
@@ -15,6 +15,7 @@
*/
TValue kread_from_port(klisp_State *K, TValue port, bool mut);
TValue kread_peek_char_from_port(klisp_State *K, TValue port, bool peek);
+TValue kread_peek_u8_from_port(klisp_State *K, TValue port, bool peek);
void kread_ignore_whitespace_and_comments_from_port(klisp_State *K,
TValue port);
diff --git a/src/kstate.c b/src/kstate.c
@@ -202,11 +202,11 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/* the dynamic ports and the keys for the dynamic ports */
TValue in_port = kmake_std_port(K, kstring_new_b_imm(K, "*STDIN*"),
- false, stdin);
+ false, false, stdin);
TValue out_port = kmake_std_port(K, kstring_new_b_imm(K, "*STDOUT*"),
- true, stdout);
+ true, false, stdout);
TValue error_port = kmake_std_port(K, kstring_new_b_imm(K, "*STDERR*"),
- true, stderr);
+ true, false, stderr);
K->kd_in_port_key = kcons(K, KTRUE, in_port);
K->kd_out_port_key = kcons(K, KTRUE, out_port);
K->kd_error_port_key = kcons(K, KTRUE, error_port);
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -422,8 +422,10 @@ void kwrite_simple(klisp_State *K, TValue obj)
kw_printf(K, "#[promise]");
break;
case K_TPORT:
- /* TODO try to get the name/ I/O direction / filename */
- kw_printf(K, "#[%s port", kport_is_input(obj)? "input" : "output");
+ /* TODO try to get the filename */
+ kw_printf(K, "#[%s %s port",
+ kport_is_binary? "binary" : "character",
+ kport_is_input(obj)? "input" : "output");
#if KTRACK_NAMES
if (khas_name(obj)) {
kw_print_name(K, obj);
@@ -602,3 +604,18 @@ void kwrite_char_to_port(klisp_State *K, TValue port, TValue ch)
kwrite_error(K, "error writing char");
}
}
+
+void kwrite_u8_to_port(klisp_State *K, TValue port, TValue u8)
+{
+ K->curr_port = port;
+ K->curr_out = kport_file(port);
+ int res = fputc(ivalue(u8), K->curr_out);
+ /* implicit flush, MAYBE add flush call */
+ if (res != EOF)
+ res = fflush(K->curr_out);
+
+ if (res == EOF) {
+ clearerr(K->curr_out); /* clear error for next time */
+ kwrite_error(K, "error writing u8");
+ }
+}
diff --git a/src/kwrite.h b/src/kwrite.h
@@ -17,6 +17,7 @@ void kwrite_display_to_port(klisp_State *K, TValue port, TValue obj,
bool displayp);
void kwrite_newline_to_port(klisp_State *K, TValue port);
void kwrite_char_to_port(klisp_State *K, TValue port, TValue ch);
+void kwrite_u8_to_port(klisp_State *K, TValue port, TValue u8);
#endif
diff --git a/src/tests/ports.k b/src/tests/ports.k
@@ -2,6 +2,8 @@
;;
;; Tests of i/o features.
;;
+;; TODO binary ports
+;;
;; Utilities for testing input and output features:
;;
;; temp-file .......... temporary file for input and output
