#include "sl.h"#include "cvalues.h"#include "types.h"#include "print.h"#include "read.h"#include "io.h" static sl_v iosym, rdsym, wrsym, apsym, crsym, truncsym;static sl_v linesym, blocksym, memorysym;static sl_v ioinsym, wssym, endsym, bendian, lendian;sl_v sl_iooutsym;sl_type *sl_iotype; static voidprint_io(sl_v v, ios *f){	ios *s = value2c(ios*, v);	sl_print_str(f, "#<io", true);	if(*s->filename){		sl_print_str(f, " \"", true);		sl_print_str(f, s->filename, false);		sl_print_str(f, "\" ", true);		sl_print(f, fixnum(s->loc.lineno));		sl_print_chr(f, ' ');		sl_print(f, fixnum(s->loc.colno));	}	sl_print_chr(f, '>');} static voidfree_io(sl_v self){	ios *s = value2c(ios*, self);	ios_close(s);	ios_free(s);} static voidrelocate_io(sl_v oldv, sl_v newv){	ios *olds = value2c(ios*, oldv);	ios *news = value2c(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,	nil}; boolisio(sl_v v){	return iscvalue(v) && cv_class(ptr(v)) == sl_iotype;} sl_purefnstatic boolisflipped(sl_v v){	bool little;	if(v == lendian)		little = true;	else if(v == bendian)		little = false;	else		cthrow(lerrorf(sl_errarg, "invalid endian specifier"), v);#if BYTE_ORDER == LITTLE_ENDIAN	return !little;#else	return little;#endif} sl_purefnBUILTIN("io?", iop){	argcount(nargs, 1);	return isio(args[0]) ? sl_t : sl_nil;} sl_purefnBUILTIN("eof-object?", eof_objectp){	argcount(nargs, 1);	return args[0] == sl_eof ? sl_t : sl_nil;} sl_purefnios *toio(sl_v v, bool open, bool rd, bool wr){	if(sl_unlikely(!isio(v)))		cthrow(type_error(nil, "io", v), v);	ios *s = value2c(ios*, v);	if(open){		if(sl_unlikely(s->state == bst_closed))			cthrow(lerrorf(sl_errio, "closed file"), v);		if(wr && sl_unlikely(s->readonly))			cthrow(lerrorf(sl_errio, "read-only file"), v);		if(rd && sl_unlikely(s->writeonly))			cthrow(lerrorf(sl_errio, "write-only file"), v);	}	return s;} BUILTIN("file", file){	if(nargs < 1)		argcount(nargs, 1);	bool r = false, w = false, c = false, t = false, a = false;	usize mode = 0644;	for(int i = 1; i < nargs; i++){		if(isfixnum(args[i]))			mode = tosize(args[i]);		if(args[i] == rdsym)			r = true;		else if(args[i] == wrsym)			w = true;		else if(args[i] == apsym)			a = w = true;		else if(args[i] == crsym)			c = w = true;		else if(args[i] == truncsym)			t = w = true;	}	if(!r && !w && !c && !t && !a)		r = true; // default to reading	sl_v f = cvalue(sl_iotype, sizeof(ios));	char *fname = tostr(args[0]);	ios *s = value2c(ios*, f);	if(ios_file(s, fname, r, w, c, t, mode) == nil)		bthrow(lerrorf(sl_errio, "could not open \"%s\"", fname));	if(a)		ios_seek_end(s);	return f;} sl_purefnBUILTIN("io-buffer-mode", io_buffer_mode){	argcount(nargs, 1);	switch(toio(args[0], true, false, false)->bm){	case bm_none: return sl_nil;	case bm_line: return linesym;	case bm_block: return blocksym;	case bm_memory: return memorysym;	default: abort();	}} BUILTIN("io-buffer-mode!", io_buffer_mode_q){	argcount(nargs, 2);	sl_v m = args[1];	int bm;	if(m == sl_nil)		bm = bm_none;	else if(m == linesym)		bm = bm_line;	else if(m == blocksym)		bm = bm_block;	else if(m == memorysym)		bm = bm_memory;	else		bthrow(lerrorf(sl_errarg, "invalid buffer mode"));	if(ios_bufmode(toio(args[0], true, false, false), bm) != 0)		bthrow(lerrorf(sl_errarg, "invalid buffer mode for this io"));	return args[1];} BUILTIN("buffer", buffer){	argcount(nargs, 0);	sl_v f = cvalue(sl_iotype, sizeof(ios));	ios *s = value2c(ios*, f);	if(ios_mem(s, 0) == nil)		bthrow(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] == wssym || (nargs > 2 && args[i = 1] == wssym)){			ws = args[++i] != sl_nil;			if(i < 2) // (read :whitespace T io)				args[0] = args[2];			nargs -= 2;		}	}	sl_v a = nargs == 0 ? sym_value(ioinsym) : args[0];	if(nargs > 1)		argcount(nargs, 1);	ios *s = toio(a, true, true, false);	sl_gc_handle(&a);	sl_v v = sl_read_sexpr(a, ws);	sl_free_gc_handles(1);	return ios_eof(s) ? sl_eof : v;} BUILTIN("io-peek-rune", io_peek_rune){	argcount(nargs, 1);	ios *s = toio(args[0], true, true, false);	Rune r;	int res;	if((res = ios_peekrune(s, &r)) == IOS_EOF)		//bthrow(lerrorf(sl_errio, "end of file reached"));		return sl_eof;	if(res == 0)		bthrow(lerrorf(sl_errio, "invalid UTF-8 sequence"));	return mk_rune(r);} BUILTIN("io-skip", io_skip){	if(nargs != 2 && nargs != 4)		argcount(nargs, 2);	bool end = false;	if(nargs == 4){		if(args[2] == endsym)			end = args[3] != sl_nil;		else			bthrow(lerrorf(sl_errarg, "invalid arguments"));	}	ios *s = toio(args[0], true, false, false);	soffset off = tooffset(args[1]);	soffset res = ios_skip(s, off, end);	if(res < 0)		return sl_nil;	return size_wrap((usize)res);} BUILTIN("io-flush", io_flush){	argcount(nargs, 1);	return ios_flush(toio(args[0], true, false, false)) == 0 ? sl_t : sl_nil;} BUILTIN("io-close", io_close){	argcount(nargs, 1);	ios_close(toio(args[0], false, false, false));	return sl_void;} BUILTIN("io-truncate", io_truncate){	argcount(nargs, 2);	ios *s = toio(args[0], true, false, true);	if(ios_trunc(s, tooffset(args[1])) < 0)		bthrow(lerrorf(sl_errio, "truncation failed"));	return sl_void;} BUILTIN("io-discard-buffer", io_discard_buffer){	argcount(nargs, 1);	ios_purge(toio(args[0], true, false, false));	return sl_void;} sl_purefnBUILTIN("io-eof?", io_eofp){	argcount(nargs, 1);	return ios_eof(toio(args[0], true, false, false)) ? sl_t : sl_nil;} BUILTIN("io-pos", io_pos){	argcount(nargs, 1);	ios *s = toio(args[0], true, false, false);	soffset res = ios_skip(s, 0, false);	return res < 0 ? sl_nil : size_wrap((usize)res);} BUILTIN("io-pos!", io_pos_q){	argcount(nargs, 2);	ios *s = toio(args[0], true, false, false);	soffset res = ios_seek(s, tosize(args[1]));	return res < 0 ? sl_nil : size_wrap((usize)res);} BUILTIN("write", write){	if(nargs < 1 || nargs > 2)		argcount(nargs, 1);	ios *s;	s = toio(		nargs == 2 && args[1] != sl_nil ? args[1] : sym_value(sl_iooutsym),		true, false, true	);	sl_print(s, args[0]);	return args[0];} BUILTIN("io-read", io_read){	if(nargs != 3 && nargs != 4)		argcount(nargs, 2);	ios *s = toio(args[0], true, true, false);	sl_type *ft;	usize n, nem, emsz;	bool isrune, isutf8, flip = false;	if(nargs >= 3 && issym(args[nargs-1]) && iskeyword((sl_sym*)ptr(args[nargs-1])))		flip = isflipped(args[--nargs]);	if(nargs == 3){		// form (io-read s type count)		ft = get_arr_type(args[1]);		nem = tosize(args[2]);		emsz = ft->elsz;		n = nem * emsz;		isrune = ft->eltype == sl_runetype;		isutf8 = ft->eltype == sl_utf8type;	}else{		ft = get_type(args[1]);		if(ft->eltype != nil && !iscons(cdr_(cdr_(args[1]))))			bthrow(lerrorf(sl_errarg, "incomplete type"));		nem = 1;		emsz = n = ft->size;		isrune = ft == sl_runetype;		isutf8 = ft == sl_utf8type;	}	if(isutf8){		ft = sl_strtype;		n *= 4;	}	sl_v cv = sl_nil;	u8int *data = nil;	if(ft != sl_runetype){		// unboxed rune otherwise		cv = cvalue(ft, n);		data = cvalue_data(cv);	}	usize got;	if(!isrune && !isutf8){		got = ios_read(s, data, n);		if(flip && got == n && emsz > 1){			for(usize i = 0; i < nem; i++, data += emsz){				for(usize j = 0; j < (emsz>>1); j++){					u8int x = data[j];					data[j] = data[emsz-1-j];					data[emsz-1-j] = x;				}			}		}	}else{		n /= sizeof(Rune);		usize nb = 0;		for(got = 0; got < n;){			Rune r;			int nr = ios_getrune(s, &r);			if(nr == 0)				bthrow(lerrorf(sl_errio, "invalid rune"));			if(nr != 1)				break;			got++;			if(isutf8)				nb += runetochar((char*)data+nb, &r);			else{				if(ft == sl_runetype){					cv = mk_rune(r);					break;				}				((Rune*)data)[got-1] = r;			}		}		if(isutf8)			cvalue_cutdown(cv, nb);	}	if(got < n)		//bthrow(lerrorf(sl_errio, "end of input reached"));		return sl_eof;	return cv;} BUILTIN("io-write", io_write){	if(nargs != 3)		argcount(nargs, 2);	ios *s = toio(args[0], true, false, true);	sl_v v = args[1];	bool flip = nargs > 2 && isflipped(args[2]);	if(isrune(v))		return fixnum(ios_putrune(s, torune(v)));	uintptr u;	u8int *data;	usize sz, nb = 0;	to_sized_ptr(v, &data, &sz, &u);	if(!iscvalue(v) || cv_class(ptr(v)) != sl_runetype->artype){		if(!flip)			nb = ios_write(s, data, sz);		else{			for(usize i = sz; i > 0; i--, nb++){				if(ios_write(s, data+i-1, 1) != 1)					break;			}		}	}else{		sz /= sizeof(Rune);		for(usize i = 0; i < sz; i++){			int r = ios_putrune(s, ((Rune*)data)[i]);			if(r <= 0)				break;			nb += r;		}	}	return size_wrap(nb);} static Runeget_delim_arg(sl_v arg){	return isrune(arg) ? torune(arg) : tosize(arg);} BUILTIN("io-read-until", io_read_until){	argcount(nargs, 2);	ios *src = toio(args[0], true, true, false);	sl_v str = cvalue_str(80);	sl_cv *cv = ptr(str);	u8int *data = cv_data(cv);	ios dest;	ios_mem(&dest, 0);	ios_setbuf(&dest, data, 80, 0);	Rune delim = get_delim_arg(args[1]);	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-copy-until", io_copy_until){	argcount(nargs, 3);	ios *dest = toio(args[0], true, false, true);	ios *src = toio(args[1], true, true, false);	Rune 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 *dest = toio(args[0], true, false, true);	ios *src = toio(args[1], true, true, false);	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], false, false, false)->filename);} BUILTIN("io-filename!", io_filename_q){	argcount(nargs, 2);	ios *s = toio(args[0], false, false, false);	char *f = tostr(args[1]);	MEM_FREE(s->filename);	s->filename = MEM_STRDUP(f);	return args[1];} BUILTIN("io-line", io_line){	argcount(nargs, 1);	return size_wrap(toio(args[0], false, false, false)->loc.lineno);} BUILTIN("io-line!", io_line_q){	argcount(nargs, 2);	toio(args[0], false, false, false)->loc.lineno = tosize(args[1]);	return args[1];}

Lines 1–500 of 604. Load more