shithub: femtolisp

ref: ed84debe7fb8a8932b4df46ded4ba0ac30bf2a6a
dir: /iostream.c/

View raw version
#include "llt.h"
#include "flisp.h"
#include "cvalues.h"
#include "types.h"
#include "print.h"
#include "read.h"

static value_t iostreamsym, rdsym, wrsym, apsym, crsym, truncsym;
static value_t instrsym, outstrsym;
fltype_t *iostreamtype;

void
print_iostream(value_t v, ios_t *f)
{
	USED(v);
	fl_print_str("#<io stream>", f);
}

void
free_iostream(value_t self)
{
	ios_t *s = value2c(ios_t*, self);
	ios_close(s);
}

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
};

int
fl_isiostream(value_t v)
{
	return iscvalue(v) && cv_class(ptr(v)) == iostreamtype;
}

BUILTIN("iostream?", iostreamp)
{
	argcount(nargs, 1);
	return fl_isiostream(args[0]) ? FL_T : FL_F;
}

BUILTIN("eof-object", eof_object)
{
	USED(args);
	argcount(nargs, 0);
	return FL_EOF;
}

BUILTIN("eof-object?", eof_objectp)
{
	argcount(nargs, 1);
	return args[0] == FL_EOF ? FL_T : FL_F;
}

ios_t *
fl_toiostream(value_t v)
{
	if(!fl_isiostream(v))
		type_error("iostream", v);
	return value2c(ios_t*, v);
}

BUILTIN("file", file)
{
	if(nargs < 1)
		argcount(nargs, 1);
	int i, r = 0, w = 0, c = 0, t = 0, a = 0;
	for(i = 1; i < nargs; i++){
		if(args[i] == rdsym)
			r = 1;
		else if(args[i] == wrsym)
			w = 1;
		else if(args[i] == apsym)
			a = w = 1;
		else if(args[i] == crsym)
			c = w = 1;
		else if(args[i] == truncsym)
			t = w = 1;
	}
	if((r|w|c|t|a) == 0)
		r = 1;  // default to reading
	value_t f = cvalue(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(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(iostreamtype, sizeof(ios_t));
	ios_t *s = value2c(ios_t*, f);
	if(ios_mem(s, 0) == nil)
		lerrorf(MemoryError, "could not allocate stream");
	return f;
}

BUILTIN("read", read)
{
	value_t arg = 0;
	if(nargs > 1)
		argcount(nargs, 1);
	else if(nargs == 0)
		arg = symbol_value(instrsym);
	else
		arg = args[0];
	ios_t *s = fl_toiostream(arg);
	fl_gc_handle(&arg);
	value_t v = fl_read_sexpr(arg);
	fl_free_gc_handles(1);
	if(ios_eof(s))
		return FL_EOF;
	return v;
}

BUILTIN("io.getc", io_getc)
{
	argcount(nargs, 1);
	ios_t *s = fl_toiostream(args[0]);
	uint32_t wc;
	int res;
	if((res = ios_getutf8(s, &wc)) == IOS_EOF)
		//lerrorf(IOError, "end of file reached");
		return FL_EOF;
	if(res == 0)
		lerrorf(IOError, "invalid UTF-8 sequence");
	return mk_wchar(wc);
}

BUILTIN("io.peekc", io_peekc)
{
	argcount(nargs, 1);
	ios_t *s = fl_toiostream(args[0]);
	uint32_t wc;
	int res;
	if((res = ios_peekutf8(s, &wc)) == IOS_EOF)
		return FL_EOF;
	if(res == 0)
		lerrorf(IOError, "invalid UTF-8 sequence");
	return mk_wchar(wc);
}

BUILTIN("io.putc", io_putc)
{
	argcount(nargs, 2);
	ios_t *s = fl_toiostream(args[0]);
	if(!iscprim(args[1]) || ((cprim_t*)ptr(args[1]))->type != wchartype)
		type_error("wchar", args[1]);
	uint32_t wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1]));
	return fixnum(ios_pututf8(s, wc));
}

BUILTIN("io.skip", io_skip)
{
	argcount(nargs, 2);
	ios_t *s = fl_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(fl_toiostream(args[0])) == 0 ? FL_T : FL_F;
}

BUILTIN("io.close", io_close)
{
	argcount(nargs, 1);
	ios_close(fl_toiostream(args[0]));
	return FL_T;
}

BUILTIN("io.discardbuffer", io_discardbuffer)
{
	argcount(nargs, 1);
	ios_purge(fl_toiostream(args[0]));
	return FL_T;
}

BUILTIN("io.eof?", io_eofp)
{
	argcount(nargs, 1);
	return ios_eof(fl_toiostream(args[0])) ? FL_T : FL_F;
}

BUILTIN("io.seek", io_seek)
{
	argcount(nargs, 2);
	ios_t *s = fl_toiostream(args[0]);
	size_t pos = toulong(args[1]);
	off_t res = ios_seek(s, (off_t)pos);
	if(res == -1)
		return FL_F;
	return FL_T;
}

BUILTIN("io.pos", io_pos)
{
	argcount(nargs, 1);
	ios_t *s = fl_toiostream(args[0]);
	off_t res = ios_pos(s);
	if(res == -1)
		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 ? fl_toiostream(args[1]) : fl_toiostream(symbol_value(outstrsym));
	fl_print(s, args[0]);
	return args[0];
}

BUILTIN("io.read", io_read)
{
	if(nargs != 3)
		argcount(nargs, 2);
	ios_t *s = fl_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 = toulong(args[2]) * ft->elsz;
	}else{
		ft = get_type(args[1]);
		if(ft->eltype != nil && !iscons(cdr_(cdr_(args[1]))))
			lerrorf(ArgError, "incomplete type");
		n = ft->size;
	}
	value_t cv = cvalue(ft, n);
	char *data;
	if(iscvalue(cv))
		data = cv_data(ptr(cv));
	else data = cp_data(ptr(cv));
	size_t got = ios_read(s, data, n);
	if(got < n)
		//lerrorf(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 = toulong(args[1]);
		*nb = nargs > 2 ? toulong(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 = fl_toiostream(args[0]);
	if(iscprim(args[1]) && ((cprim_t*)ptr(args[1]))->type == wchartype){
		if(nargs > 2)
			lerrorf(ArgError, "offset argument not supported for characters");
		uint32_t wc = *(uint32_t*)cp_data(ptr(args[1]));
		return fixnum(ios_pututf8(s, wc));
	}
	char *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));
}

BUILTIN("dump", dump)
{
	if(nargs < 1 || nargs > 3)
		argcount(nargs, 1);
	ios_t *s = fl_toiostream(symbol_value(outstrsym));
	char *data;
	size_t sz, offs = 0;
	to_sized_ptr(args[0], &data, &sz);
	size_t nb = sz;
	if(nargs > 1){
		get_start_count_args(args, nargs, sz, &offs, &nb);
		data += offs;
	}
	hexdump(s, data, nb, offs);
	return FL_T;
}

static char
get_delim_arg(value_t arg)
{
	size_t uldelim = toulong(arg);
	if(uldelim > 0x7f){
		// wchars > 0x7f, or anything else > 0xff, are out of range
		if((iscprim(arg) && cp_class(ptr(arg)) == wchartype) || uldelim > 0xff)
			lerrorf(ArgError, "delimiter out of range");
	}
	return (char)uldelim;
}

BUILTIN("io.readuntil", io_readuntil)
{
	argcount(nargs, 2);
	value_t str = cvalue_string(80);
	cvalue_t *cv = ptr(str);
	char *data = cv_data(cv);
	ios_t dest;
	ios_mem(&dest, 0);
	ios_setbuf(&dest, data, 80, 0);
	char delim = get_delim_arg(args[1]);
	ios_t *src = fl_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);
#ifndef BOEHM_GC
		cv_autorelease(cv);
#endif
	}else{
		((char*)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 = fl_toiostream(args[0]);
	ios_t *src = fl_toiostream(args[1]);
	char 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 = fl_toiostream(args[0]);
	ios_t *src = fl_toiostream(args[1]);
	if(nargs == 3)
		return size_wrap(ios_copy(dest, src, toulong(args[2])));
	return size_wrap(ios_copyall(dest, src));
}

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);
		memmove(cvalue_data(str), st->buf, n);
		ios_trunc(st, 0);
	}else{
		char *b = ios_takebuf(st, &n); n--;
		b[n] = '\0';
		str = cvalue_from_ref(stringtype, b, n, FL_NIL);
#ifndef BOEHM_GC
		cv_autorelease(ptr(str));
#endif
	}
	return str;
}

BUILTIN("io.tostring!", io_tostring)
{
	argcount(nargs, 1);
	ios_t *src = fl_toiostream(args[0]);
	if(src->bm != bm_mem)
		lerrorf(ArgError, "requires memory stream");
	return stream_to_string(&args[0]);
}

void
iostream_init(void)
{
	iostreamsym = symbol("iostream");
	rdsym = symbol(":read");
	wrsym = symbol(":write");
	apsym = symbol(":append");
	crsym = symbol(":create");
	truncsym = symbol(":truncate");
	instrsym = symbol("*input-stream*");
	outstrsym = symbol("*output-stream*");
	iostreamtype = define_opaque_type(iostreamsym, sizeof(ios_t), &iostream_vtable, nil);
	setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, ios_stdout, sizeof(ios_t), FL_NIL));
	setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, ios_stderr, sizeof(ios_t), FL_NIL));
	setc(symbol("*stdin*" ), cvalue_from_ref(iostreamtype, ios_stdin, sizeof(ios_t), FL_NIL));
}