ref: 7bcf6ac7b612306d197d063aaf6d971ca5dd2e3f
dir: /iostream.c/
#include "flisp.h"
#include "cvalues.h"
#include "types.h"
#include "print.h"
#include "read.h"
#include "iostream.h"
static void
print_iostream(value_t v, ios_t *f)
{
USED(v);
fl_print_str("#<io stream", f);
if(*f->loc.filename){
fl_print_chr(' ', f);
fl_print_str(f->loc.filename, f);
}
fl_print_chr('>', f);
}
static void
free_iostream(value_t self)
{
ios_t *s = value2c(ios_t*, self);
ios_close(s);
}
static void
relocate_iostream(value_t oldv, value_t newv)
{
ios_t *olds = value2c(ios_t*, oldv);
ios_t *news = value2c(ios_t*, newv);
if(news->buf == &olds->local[0])
news->buf = &news->local[0];
}
static cvtable_t iostream_vtable = {
print_iostream,
relocate_iostream,
free_iostream,
nil
};
static int
isiostream(value_t v)
{
return iscvalue(v) && cv_class(ptr(v)) == FL(iostreamtype);
}
BUILTIN("iostream?", iostreamp)
{
argcount(nargs, 1);
return isiostream(args[0]) ? FL_t : FL_f;
}
BUILTIN("eof-object?", eof_objectp)
{
argcount(nargs, 1);
return args[0] == FL_eof ? FL_t : FL_f;
}
ios_t *
toiostream(value_t v)
{
if(__unlikely(!isiostream(v)))
type_error("iostream", v);
return value2c(ios_t*, v);
}
BUILTIN("file", file)
{
if(nargs < 1)
argcount(nargs, 1);
size_t i;
int r = 0, w = 0, c = 0, t = 0, a = 0;
for(i = 1; i < nargs; i++){
if(args[i] == FL(rdsym))
r = 1;
else if(args[i] == FL(wrsym))
w = 1;
else if(args[i] == FL(apsym))
a = w = 1;
else if(args[i] == FL(crsym))
c = w = 1;
else if(args[i] == FL(truncsym))
t = w = 1;
}
if((r|w|c|t|a) == 0)
r = 1; // default to reading
value_t f = cvalue(FL(iostreamtype), sizeof(ios_t));
char *fname = tostring(args[0]);
ios_t *s = value2c(ios_t*, f);
if(ios_file(s, fname, r, w, c, t) == nil)
lerrorf(FL(IOError), "could not open \"%s\"", fname);
if(a)
ios_seek_end(s);
return f;
}
BUILTIN("buffer", buffer)
{
argcount(nargs, 0);
USED(args);
value_t f = cvalue(FL(iostreamtype), sizeof(ios_t));
ios_t *s = value2c(ios_t*, f);
if(ios_mem(s, 0) == nil)
lerrorf(FL(MemoryError), "could not allocate stream");
return f;
}
BUILTIN("read", read)
{
if(nargs > 1)
argcount(nargs, 1);
value_t a = nargs == 0 ? symbol_value(FL(instrsym)) : args[0];
USED(toiostream(a));
value_t v = fl_read_sexpr(a);
a = nargs == 0 ? symbol_value(FL(instrsym)) : args[0];
return ios_eof(toiostream(a)) ? FL_eof : v;
}
BUILTIN("io-getc", io_getc)
{
argcount(nargs, 1);
ios_t *s = toiostream(args[0]);
Rune r;
int res;
if((res = ios_getutf8(s, &r)) == IOS_EOF)
//lerrorf(FL(IOError), "end of file reached");
return FL_eof;
if(res == 0)
lerrorf(FL(IOError), "invalid UTF-8 sequence");
return mk_rune(r);
}
BUILTIN("io-wait", io_wait)
{
if(nargs > 2)
argcount(nargs, 2);
ios_t *s = toiostream(args[0]);
int r = ios_wait(s, nargs > 1 ? todouble(args[1]) : -1);
if(r >= 0)
return r ? FL_t : FL_f;
if(r == IOS_EOF)
return FL_eof;
lerrorf(FL(IOError), "i/o error");
}
BUILTIN("io-putc", io_putc)
{
argcount(nargs, 2);
ios_t *s = toiostream(args[0]);
if(!iscprim(args[1]) || ((cprim_t*)ptr(args[1]))->type != FL(runetype))
type_error("rune", args[1]);
Rune r = *(Rune*)cp_data((cprim_t*)ptr(args[1]));
return fixnum(ios_pututf8(s, r));
}
BUILTIN("io-skip", io_skip)
{
argcount(nargs, 2);
ios_t *s = toiostream(args[0]);
off_t off = tooffset(args[1]);
off_t res = ios_skip(s, off);
if(res < 0)
return FL_f;
return sizeof(res) == sizeof(int64_t) ? mk_int64(res) : mk_int32(res);
}
BUILTIN("io-flush", io_flush)
{
argcount(nargs, 1);
return ios_flush(toiostream(args[0])) == 0 ? FL_t : FL_f;
}
BUILTIN("io-close", io_close)
{
argcount(nargs, 1);
ios_close(toiostream(args[0]));
return FL_void;
}
BUILTIN("io-discardbuffer", io_discardbuffer)
{
argcount(nargs, 1);
ios_purge(toiostream(args[0]));
return FL_void;
}
BUILTIN("io-eof?", io_eofp)
{
argcount(nargs, 1);
return ios_eof(toiostream(args[0])) ? FL_t : FL_f;
}
BUILTIN("io-seek", io_seek)
{
argcount(nargs, 2);
ios_t *s = toiostream(args[0]);
size_t pos = tosize(args[1]);
off_t res = ios_seek(s, (off_t)pos);
if(res < 0)
return FL_f;
return FL_t;
}
BUILTIN("io-pos", io_pos)
{
argcount(nargs, 1);
ios_t *s = toiostream(args[0]);
off_t res = ios_pos(s);
if(res < 0)
return FL_f;
return size_wrap((size_t)res);
}
BUILTIN("write", write)
{
if(nargs < 1 || nargs > 2)
argcount(nargs, 1);
ios_t *s;
s = nargs == 2 ? toiostream(args[1]) : toiostream(symbol_value(FL(outstrsym)));
fl_print(s, args[0]);
return args[0];
}
BUILTIN("io-read", io_read)
{
if(nargs != 3)
argcount(nargs, 2);
ios_t *s = toiostream(args[0]);
size_t n;
fltype_t *ft;
if(nargs == 3){
// form (io.read s type count)
ft = get_array_type(args[1]);
n = tosize(args[2]) * ft->elsz;
}else{
ft = get_type(args[1]);
if(ft->eltype != nil && !iscons(cdr_(cdr_(args[1]))))
lerrorf(FL(ArgError), "incomplete type");
n = ft->size;
}
value_t cv = cvalue(ft, n);
uint8_t *data = cptr(cv);
size_t got = ios_read(s, data, n);
if(got < n)
//lerrorf(FL(IOError), "end of input reached");
return FL_eof;
return cv;
}
// args must contain data[, offset[, count]]
static void
get_start_count_args(value_t *args, uint32_t nargs, size_t sz, size_t *offs, size_t *nb)
{
if(nargs > 1){
*offs = tosize(args[1]);
*nb = nargs > 2 ? tosize(args[2]) : sz - *offs;
if(*offs >= sz || *offs + *nb > sz)
bounds_error(args[0], args[1]);
}
}
BUILTIN("io-write", io_write)
{
if(nargs < 2 || nargs > 4)
argcount(nargs, 2);
ios_t *s = toiostream(args[0]);
if(iscprim(args[1]) && ((cprim_t*)ptr(args[1]))->type == FL(runetype)){
if(nargs > 2)
lerrorf(FL(ArgError), "offset argument not supported for characters");
Rune r = *(Rune*)cp_data(ptr(args[1]));
return fixnum(ios_pututf8(s, r));
}
uint8_t *data;
size_t sz, offs = 0;
to_sized_ptr(args[1], &data, &sz);
size_t nb = sz;
if(nargs > 2){
get_start_count_args(&args[1], nargs-1, sz, &offs, &nb);
data += offs;
}
return size_wrap(ios_write(s, data, nb));
}
static uint8_t
get_delim_arg(value_t arg)
{
size_t uldelim = tosize(arg);
if(uldelim > 0x7f){
// runes > 0x7f, or anything else > 0xff, are out of range
if((iscprim(arg) && cp_class(ptr(arg)) == FL(runetype)) || uldelim > 0xff)
lerrorf(FL(ArgError), "delimiter out of range");
}
return (uint8_t)uldelim;
}
BUILTIN("io-readuntil", io_readuntil)
{
argcount(nargs, 2);
value_t str = cvalue_string(80);
cvalue_t *cv = ptr(str);
uint8_t *data = cv_data(cv);
ios_t dest;
ios_mem(&dest, 0);
ios_setbuf(&dest, data, 80, 0);
uint8_t delim = get_delim_arg(args[1]);
ios_t *src = toiostream(args[0]);
size_t n = ios_copyuntil(&dest, src, delim);
cv->len = n;
if(dest.buf != data){
// outgrew initial space
size_t sz;
cv->data = ios_takebuf(&dest, &sz);
cv_autorelease(cv);
}else{
((uint8_t*)cv->data)[n] = 0;
}
if(n == 0 && ios_eof(src))
return FL_eof;
return str;
}
BUILTIN("io-copyuntil", io_copyuntil)
{
argcount(nargs, 3);
ios_t *dest = toiostream(args[0]);
ios_t *src = toiostream(args[1]);
uint8_t delim = get_delim_arg(args[2]);
return size_wrap(ios_copyuntil(dest, src, delim));
}
BUILTIN("io-copy", io_copy)
{
if(nargs < 2 || nargs > 3)
argcount(nargs, 2);
ios_t *dest = toiostream(args[0]);
ios_t *src = toiostream(args[1]);
if(nargs == 3)
return size_wrap(ios_copy(dest, src, tosize(args[2])));
return size_wrap(ios_copyall(dest, src));
}
BUILTIN("io-filename", io_filename)
{
argcount(nargs, 1);
return cvalue_static_cstring(toiostream(args[0])->loc.filename);
}
BUILTIN("io-line", io_line)
{
argcount(nargs, 1);
return size_wrap(toiostream(args[0])->loc.lineno);
}
BUILTIN("io-set-line!", io_set_line)
{
argcount(nargs, 2);
toiostream(args[0])->loc.lineno = tosize(args[1]);
return args[1];
}
BUILTIN("io-column", io_column)
{
argcount(nargs, 1);
return size_wrap(toiostream(args[0])->loc.colno);
}
BUILTIN("io-set-column!", io_set_column)
{
argcount(nargs, 2);
toiostream(args[0])->loc.colno = tosize(args[1]);
return args[1];
}
value_t
stream_to_string(value_t *ps)
{
value_t str;
size_t n;
ios_t *st = value2c(ios_t*, *ps);
if(st->buf == &st->local[0]){
n = st->size;
str = cvalue_string(n);
memcpy(cvalue_data(str), st->buf, n);
ios_trunc(st, 0);
}else{
uint8_t *b = ios_takebuf(st, &n); n--;
if(n == 0)
return FL(the_empty_string);
b[n] = '\0';
str = cvalue_from_ref(FL(stringtype), b, n, FL_nil);
cv_autorelease(ptr(str));
}
return str;
}
BUILTIN("iostream->string", io_tostring)
{
argcount(nargs, 1);
ios_t *src = toiostream(args[0]);
if(src->bm != bm_mem)
lerrorf(FL(ArgError), "requires memory stream");
bool eof = ios_eof(src);
value_t v = stream_to_string(&args[0]);
if(eof && v == FL(the_empty_string))
v = FL_eof;
return v;
}
void
iostream_init(void)
{
FL(iostreamsym) = symbol("iostream", false);
FL(rdsym) = symbol(":read", false);
FL(wrsym) = symbol(":write", false);
FL(apsym) = symbol(":append", false);
FL(crsym) = symbol(":create", false);
FL(truncsym) = symbol(":truncate", false);
FL(instrsym) = symbol("*input-stream*", false);
FL(outstrsym) = symbol("*output-stream*", false);
FL(iostreamtype) = define_opaque_type(FL(iostreamsym), sizeof(ios_t), &iostream_vtable, nil);
set(symbol("*stdout*", false), cvalue_from_ref(FL(iostreamtype), ios_stdout, sizeof(ios_t), FL_nil));
set(symbol("*stderr*", false), cvalue_from_ref(FL(iostreamtype), ios_stderr, sizeof(ios_t), FL_nil));
set(symbol("*stdin*", false), cvalue_from_ref(FL(iostreamtype), ios_stdin, sizeof(ios_t), FL_nil));
}