ref: a70379d7e4b822f532fb0a8ccdd1624a90b64a68
dir: /src/io.c/
#include "sl.h"
#include "cvalues.h"
#include "types.h"
#include "print.h"
#include "read.h"
#include "io.h"
static sl_v sl_linesym, sl_blocksym, sl_memorysym, sl_nonesym;
static sl_v sl_ioinsym, sl_whitespace;
sl_v sl_iooutsym;
sl_type *sl_iotype;
static void
print_io(sl_v v, sl_ios *f)
{
sl_ios *s = value2c(sl_ios*, v);
sl_print_str(f, "#<io");
if(*s->loc.filename){
sl_print_chr(f, ' ');
sl_print_str(f, s->loc.filename);
}
sl_print_chr(f, '>');
}
static void
free_io(sl_v self)
{
sl_ios *s = value2c(sl_ios*, self);
ios_close(s);
ios_free(s);
}
static void
relocate_io(sl_v oldv, sl_v newv)
{
sl_ios *olds = value2c(sl_ios*, oldv);
sl_ios *news = value2c(sl_ios*, newv);
if(news->buf == &olds->local[0])
news->buf = &news->local[0];
}
static sl_cvtable io_vtable = {
print_io,
relocate_io,
free_io,
nil
};
bool
isio(sl_v v)
{
return iscvalue(v) && cv_class(ptr(v)) == sl_iotype;
}
sl_purefn
BUILTIN("io?", iop)
{
argcount(nargs, 1);
return isio(args[0]) ? sl_t : sl_nil;
}
sl_purefn
BUILTIN("eof-object?", eof_objectp)
{
argcount(nargs, 1);
return args[0] == sl_eof ? sl_t : sl_nil;
}
sl_purefn
sl_ios *
toio(sl_v v)
{
if(sl_unlikely(!isio(v)))
type_error("io", v);
return value2c(sl_ios*, v);
}
BUILTIN("file", file)
{
if(nargs < 1)
argcount(nargs, 1);
bool r = false, w = false, c = false, t = false, a = false;
for(int i = 1; i < nargs; i++){
if(args[i] == sl_rdsym)
r = 1;
else if(args[i] == sl_wrsym)
w = 1;
else if(args[i] == sl_apsym)
a = w = 1;
else if(args[i] == sl_crsym)
c = w = 1;
else if(args[i] == sl_truncsym)
t = w = 1;
}
if(!r && !w && !c && !t && !a)
r = true; // default to reading
sl_v f = cvalue(sl_iotype, sizeof(sl_ios));
char *fname = tostr(args[0]);
sl_ios *s = value2c(sl_ios*, f);
if(ios_file(s, fname, r, w, c, t) == nil)
lerrorf(sl_errio, "could not open \"%s\"", fname);
if(a)
ios_seek_end(s);
return f;
}
BUILTIN("io-buffer-mode", io_buffer_mode)
{
if(nargs < 1 || nargs > 2)
argcount(nargs, 1);
sl_ios *s = toio(args[0]);
if(nargs == 1){
switch(s->bm){
case bm_none: return sl_nonesym;
case bm_line: return sl_linesym;
case bm_block: return sl_blocksym;
case bm_mem: return sl_memorysym;
}
assert("impossible" == nil);
}
sl_v a = args[1];
int bm = -1;
if(a == sl_nonesym)
bm = bm_none;
else if(a == sl_linesym)
bm = bm_line;
else if(a == sl_blocksym)
bm = bm_block;
else if(a == sl_memorysym)
bm = bm_mem;
if(bm < 0 || ios_bufmode(s, bm) != 0)
lerrorf(sl_errarg, "invalid buffer mode");
return sl_void;
}
BUILTIN("buffer", buffer)
{
argcount(nargs, 0);
USED(args);
sl_v f = cvalue(sl_iotype, sizeof(sl_ios));
sl_ios *s = value2c(sl_ios*, f);
if(ios_mem(s, 0) == nil)
lerrorf(sl_errmem, "could not allocate in-memory io");
return f;
}
BUILTIN("read", read)
{
bool ws = false;
if(nargs >= 2 && nargs <= 3){
int i;
if(args[i = 0] == sl_whitespace || (nargs > 2 && args[i = 1] == sl_whitespace)){
ws = args[++i] != sl_nil;
if(i < 2) // (read :whitespace T io)
args[0] = args[2];
nargs -= 2;
}
}
argcount(nargs, 1);
sl_v a = nargs == 0 ? sym_value(sl_ioinsym) : args[0];
sl_gc_handle(&a);
sl_v v = sl_read_sexpr(a, ws);
sl_free_gc_handles(1);
return ios_eof(toio(a)) ? sl_eof : v;
}
BUILTIN("io-peekrune", io_peekrune)
{
argcount(nargs, 1);
sl_ios *s = toio(args[0]);
Rune r;
int res;
if((res = ios_peekrune(s, &r)) == IOS_EOF)
//lerrorf(sl_errio, "end of file reached");
return sl_eof;
if(res == 0)
lerrorf(sl_errio, "invalid UTF-8 sequence");
return mk_rune(r);
}
BUILTIN("io-getrune", io_getrune)
{
argcount(nargs, 1);
sl_ios *s = toio(args[0]);
Rune r;
int res;
if((res = ios_getrune(s, &r)) == IOS_EOF)
//lerrorf(sl_errio, "end of file reached");
return sl_eof;
if(res == 0)
lerrorf(sl_errio, "invalid UTF-8 sequence");
return mk_rune(r);
}
BUILTIN("io-putrune", io_putrune)
{
argcount(nargs, 2);
sl_ios *s = toio(args[0]);
sl_cprim *cp = ptr(args[1]);
if(!iscprim(args[1]) || cp_class(cp) != sl_runetype)
type_error("rune", args[1]);
Rune r = *(Rune*)cp_data(cp);
return fixnum(ios_putrune(s, r));
}
BUILTIN("io-skip", io_skip)
{
argcount(nargs, 2);
sl_ios *s = toio(args[0]);
soffset off = tooffset(args[1]);
soffset res = ios_skip(s, off);
if(res < 0)
return sl_nil;
return sizeof(res) == sizeof(s64int) ? mk_s64(res) : mk_s32(res);
}
BUILTIN("io-flush", io_flush)
{
argcount(nargs, 1);
return ios_flush(toio(args[0])) == 0 ? sl_t : sl_nil;
}
BUILTIN("io-close", io_close)
{
argcount(nargs, 1);
ios_close(toio(args[0]));
return sl_void;
}
BUILTIN("io-truncate", io_truncate)
{
argcount(nargs, 2);
sl_ios *s = toio(args[0]);
if(ios_trunc(s, tooffset(args[1])) < 0)
lerrorf(sl_errio, "truncation failed");
return sl_void;
}
BUILTIN("io-discardbuffer", io_discardbuffer)
{
argcount(nargs, 1);
ios_purge(toio(args[0]));
return sl_void;
}
sl_purefn
BUILTIN("io-eof?", io_eofp)
{
argcount(nargs, 1);
return ios_eof(toio(args[0])) ? sl_t : sl_nil;
}
BUILTIN("io-seek", io_seek)
{
argcount(nargs, 2);
sl_ios *s = toio(args[0]);
usize pos = tosize(args[1]);
soffset res = ios_seek(s, (soffset)pos);
if(res < 0)
return sl_nil;
return sl_t;
}
BUILTIN("io-pos", io_pos)
{
argcount(nargs, 1);
sl_ios *s = toio(args[0]);
soffset res = ios_pos(s);
if(res < 0)
return sl_nil;
return size_wrap((usize)res);
}
BUILTIN("write", write)
{
if(nargs < 1 || nargs > 2)
argcount(nargs, 1);
sl_ios *s;
s = nargs == 2 ? toio(args[1]) : toio(sym_value(sl_iooutsym));
sl_print(s, args[0]);
return args[0];
}
BUILTIN("io-read", io_read)
{
if(nargs != 3)
argcount(nargs, 2);
sl_ios *s = toio(args[0]);
usize n;
sl_type *ft;
if(nargs == 3){
// form (io.read s type count)
ft = get_arr_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(sl_errarg, "incomplete type");
n = ft->size;
}
sl_v cv = cvalue(ft, n);
u8int *data = cptr(cv);
usize got = ios_read(s, data, n);
if(got < n)
//lerrorf(sl_errio, "end of input reached");
return sl_eof;
return cv;
}
// args must contain data[, offset[, count]]
static void
get_start_count_args(sl_v *args, u32int nargs, usize sz, usize *offs, usize *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);
sl_ios *s = toio(args[0]);
sl_v v = args[1];
sl_cprim *cp = ptr(v);
if(iscprim(args[1]) && cp_class(cp) == sl_runetype){
if(nargs > 2)
lerrorf(sl_errarg, "offset argument not supported for characters");
Rune r = *(Rune*)cp_data(ptr(args[1]));
return fixnum(ios_putrune(s, r));
}
u8int *data;
usize sz, offs = 0;
to_sized_ptr(v, &data, &sz);
usize 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 u8int
get_delim_arg(sl_v arg)
{
usize uldelim = tosize(arg);
if(uldelim > 0x7f){
// runes > 0x7f, or anything else > 0xff, are out of range
if((iscprim(arg) && cp_class(ptr(arg)) == sl_runetype) || uldelim > 0xff)
lerrorf(sl_errarg, "delimiter out of range");
}
return (u8int)uldelim;
}
BUILTIN("io-readuntil", io_readuntil)
{
argcount(nargs, 2);
sl_v str = cvalue_str(80);
sl_cv *cv = ptr(str);
u8int *data = cv_data(cv);
sl_ios dest;
ios_mem(&dest, 0);
ios_setbuf(&dest, data, 80, 0);
u8int delim = get_delim_arg(args[1]);
sl_ios *src = toio(args[0]);
usize n = ios_copyuntil(&dest, src, delim);
cv->len = n;
if(dest.buf != data){
// outgrew initial space
usize sz;
cv->data = ios_takebuf(&dest, &sz);
cv_autorelease(cv);
}else{
((u8int*)cv->data)[n] = 0;
}
ios_free(&dest);
if(n == 0 && ios_eof(src))
return sl_eof;
return str;
}
BUILTIN("io-copyuntil", io_copyuntil)
{
argcount(nargs, 3);
sl_ios *dest = toio(args[0]);
sl_ios *src = toio(args[1]);
u8int 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);
sl_ios *dest = toio(args[0]);
sl_ios *src = toio(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 str_from_cstr(toio(args[0])->loc.filename);
}
BUILTIN("io-set-filename!", io_set_filename)
{
argcount(nargs, 2);
sl_ios *s = toio(args[0]);
char *f = tostr(args[1]);
MEM_FREE(s->loc.filename);
s->loc.filename = MEM_STRDUP(f);
return args[1];
}
BUILTIN("io-line", io_line)
{
argcount(nargs, 1);
return size_wrap(toio(args[0])->loc.lineno);
}
BUILTIN("io-set-line!", io_set_line)
{
argcount(nargs, 2);
toio(args[0])->loc.lineno = tosize(args[1]);
return args[1];
}
BUILTIN("io-column", io_column)
{
argcount(nargs, 1);
return size_wrap(toio(args[0])->loc.colno);
}
BUILTIN("io-set-column!", io_set_column)
{
argcount(nargs, 2);
toio(args[0])->loc.colno = tosize(args[1]);
return args[1];
}
sl_v
io_to_str(sl_v *ps)
{
sl_v str;
usize n;
sl_ios *st = value2c(sl_ios*, *ps);
if(st->buf == &st->local[0]){
n = st->size;
str = cvalue_str(n);
memcpy(cvalue_data(str), st->buf, n);
ios_trunc(st, 0);
}else{
u8int *b = ios_takebuf(st, &n); n--;
if(n == 0)
return sl_emptystr;
b[n] = '\0';
str = cvalue_from_ref(sl_strtype, b, n);
cv_autorelease(ptr(str));
}
return str;
}
BUILTIN("io->str", io_tostr)
{
argcount(nargs, 1);
sl_ios *src = toio(args[0]);
if(src->bm != bm_mem)
lerrorf(sl_errarg, "requires in-memory io");
bool eof = ios_eof(src);
sl_v v = io_to_str(&args[0]);
if(eof && v == sl_emptystr)
v = sl_eof;
return v;
}
void
io_init(void)
{
sl_iosym = mk_csym("io");
sl_rdsym = mk_csym(":read");
sl_wrsym = mk_csym(":write");
sl_apsym = mk_csym(":append");
sl_crsym = mk_csym(":create");
sl_truncsym = mk_csym(":truncate");
sl_nonesym = mk_csym(":none");
sl_linesym = mk_csym(":line");
sl_blocksym = mk_csym(":block");
sl_memorysym = mk_csym(":memory");
sl_whitespace = mk_csym(":whitespace");
sl_ioinsym = mk_csym("*io-in*");
sl_iooutsym = mk_csym("*io-out*");
sl_iotype = define_opaque_type(sl_iosym, sizeof(sl_ios), &io_vtable, nil);
set(mk_csym("*stdout*"), cvalue_from_ref(sl_iotype, ios_stdout, sizeof(sl_ios)));
set(mk_csym("*stderr*"), cvalue_from_ref(sl_iotype, ios_stderr, sizeof(sl_ios)));
set(mk_csym("*stdin*"), cvalue_from_ref(sl_iotype, ios_stdin, sizeof(sl_ios)));
}