diff --git a/femtolisp/Makefile b/femtolisp/Makefile index 37cdd95..2c54246 100644 --- a/femtolisp/Makefile +++ b/femtolisp/Makefile @@ -1,7 +1,7 @@ CC = gcc NAME = flisp -SRCS = $(NAME).c equal.c builtins.c string.c equalhash.c table.c +SRCS = $(NAME).c equal.c builtins.c string.c equalhash.c table.c iostream.c OBJS = $(SRCS:%.c=%.o) DOBJS = $(SRCS:%.c=%.do) EXENAME = $(NAME) diff --git a/femtolisp/builtins.c b/femtolisp/builtins.c index 44dc8dc..6a9648a 100644 --- a/femtolisp/builtins.c +++ b/femtolisp/builtins.c @@ -389,6 +389,7 @@ value_t fl_randf(value_t *args, u_int32_t nargs) extern void stringfuncs_init(); extern void table_init(); +extern void iostream_init(); static builtinspec_t builtin_info[] = { { "set-constant!", fl_setconstant }, @@ -431,4 +432,5 @@ void builtins_init() assign_global_builtins(builtin_info); stringfuncs_init(); table_init(); + iostream_init(); } diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index d12436f..6afb2de 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -1565,7 +1565,7 @@ value_t load_file(char *fname) ios_t fi; ios_t * volatile f; fname = strdup(fname); - f = &fi; f = ios_file(f, fname, 0, 0); + f = &fi; f = ios_file(f, fname, 1, 0, 0, 0); if (f == NULL) lerror(IOError, "file \"%s\" not found", fname); FL_TRY { while (1) { diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h index f64301b..e11c5fb 100644 --- a/femtolisp/flisp.h +++ b/femtolisp/flisp.h @@ -219,6 +219,7 @@ typedef struct { #define cv_isstr(cv) (cv_class(cv)->eltype == bytetype) #define cvalue_data(v) cv_data((cvalue_t*)ptr(v)) +#define value2c(type, v) (type)cv_data((cvalue_t*)ptr(v)) #define valid_numtype(v) ((v) < N_NUMTYPES) #define cp_class(cp) ((cp)->type) diff --git a/femtolisp/iostream.c b/femtolisp/iostream.c new file mode 100644 index 0000000..a9dac00 --- /dev/null +++ b/femtolisp/iostream.c @@ -0,0 +1,114 @@ +#include +#include +#include +#include +#include +#include +#include "llt.h" +#include "flisp.h" + +static value_t iostreamsym, rdsym, wrsym, apsym, crsym, truncsym; +static fltype_t *iostreamtype; + +void print_iostream(value_t v, ios_t *f, int princ) +{ + (void)v; + (void)princ; + fl_print_str("#", 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); + cvalue_t *cv = (cvalue_t*)ptr(oldv); + if (isinlined(cv)) { + if (olds->buf == &olds->local[0]) { + news->buf = &news->local[0]; + } + } +} + +cvtable_t iostream_vtable = { print_iostream, relocate_iostream, + free_iostream, NULL }; + +int isiostream(value_t v) +{ + return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == iostreamtype; +} + +value_t fl_iostreamp(value_t *args, uint32_t nargs) +{ + argcount("iostream?", nargs, 1); + return isiostream(args[0]) ? FL_T : FL_F; +} + +static ios_t *toiostream(value_t v, char *fname) +{ + if (!isiostream(v)) + type_error(fname, "iostream", v); + return value2c(ios_t*, v); +} + +value_t fl_file(value_t *args, uint32_t nargs) +{ + if (nargs < 1) + argcount("file", nargs, 1); + int i, r=1, w=0, c=0, t=0, a=0; + char *fname = tostring(args[0], "file"); + for(i=1; i < (int)nargs; i++) { + if (args[i] == wrsym) w = 1; + else if (args[i] == apsym) a = 1; + else if (args[i] == crsym) c = 1; + else if (args[i] == truncsym) t = 1; + } + value_t f = cvalue(iostreamtype, sizeof(ios_t)); + ios_t *s = value2c(ios_t*, f); + if (ios_file(s, fname, r, w, c, t) == NULL) + lerror(IOError, "could not open file \"%s\"", fname); + if (a) ios_seek_end(s); + return f; +} + +value_t fl_ioread(value_t *args, u_int32_t nargs) +{ + argcount("io.read", nargs, 1); + ios_t *s = toiostream(args[0], "io.read"); + value_t v = read_sexpr(s); + if (ios_eof(s)) + lerror(IOError, "end of file reached"); + return v; +} + +static builtinspec_t iostreamfunc_info[] = { + { "iostream?", fl_iostreamp }, + { "file", fl_file }, + { "io.read", fl_ioread }, + { NULL, NULL } +}; + +void iostream_init() +{ + iostreamsym = symbol("iostream"); + rdsym = symbol(":read"); + wrsym = symbol(":write"); + apsym = symbol(":append"); + crsym = symbol(":create"); + truncsym = symbol(":truncate"); + iostreamtype = define_opaque_type(iostreamsym, sizeof(ios_t), + &iostream_vtable, NULL); + assign_global_builtins(iostreamfunc_info); + + setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, &ios_stdout, + sizeof(ios_t), NIL)); + setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, &ios_stderr, + sizeof(ios_t), NIL)); + setc(symbol("*stdin*" ), cvalue_from_ref(iostreamtype, &ios_stdin, + sizeof(ios_t), NIL)); +} diff --git a/femtolisp/stream.c b/femtolisp/stream.c deleted file mode 100644 index a2ceda5..0000000 --- a/femtolisp/stream.c +++ /dev/null @@ -1,56 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include "llt.h" -#include "flisp.h" - -static value_t streamsym; -static fltype_t *streamtype; - -void print_stream(value_t v, ios_t *f, int princ) -{ -} - -void free_stream(value_t self) -{ -} - -void relocate_stream(value_t oldv, value_t newv) -{ -} - -cvtable_t stream_vtable = { print_stream, relocate_stream, free_stream, NULL }; - -int isstream(value_t v) -{ - return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == streamtype; -} - -value_t fl_streamp(value_t *args, uint32_t nargs) -{ - argcount("stream?", nargs, 1); - return isstream(args[0]) ? FL_T : FL_F; -} - -static ios_t *tostream(value_t v, char *fname) -{ - if (!isstream(v)) - type_error(fname, "stream", v); - return (ios_t*)cv_data((cvalue_t*)ptr(v)); -} - -static builtinspec_t streamfunc_info[] = { - { "stream?", fl_streamp }, - { NULL, NULL } -}; - -void stream_init() -{ - streamsym = symbol("stream"); - streamtype = define_opaque_type(streamsym, sizeof(ios_t), - &stream_vtable, NULL); - assign_global_builtins(streamfunc_info); -} diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index a772728..39b79b5 100644 --- a/femtolisp/system.lsp +++ b/femtolisp/system.lsp @@ -14,7 +14,7 @@ ; this allows define, defun, defmacro, let, etc. to contain multiple ; body expressions as in Common Lisp. (set! f-body (lambda (e) - (cond ((atom? e) e) + (cond ((atom? e) #f) ((eq (cdr e) ()) (car e)) (#t (cons 'begin e))))) diff --git a/femtolisp/todo b/femtolisp/todo index 92df3d7..e7f5093 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -834,25 +834,25 @@ IOStream API print princ iostream - (stream[ cvalue-as-bytestream]) - file - stream.eof - stream.write - (stream.write s cvalue) - stream.read - (stream.read s ctype) - stream.flush - stream.close - stream.pos - (stream.pos s [set-pos]) - stream.seek - (stream.seek s offset) - stream.getc - get utf8 character(s) - stream.readline - stream.copy - (stream.copy to from [nbytes]) - stream.copyuntil - (stream.copy to from byte) +*file + io.eof + io.write - (io.write s cvalue) +*io.read - (io.read s ctype) + io.flush + io.close + io.pos - (io.pos s [set-pos]) + io.seek - (io.seek s offset) + io.getc - get utf8 character(s) + io.readline + io.copy - (io.copy to from [nbytes]) + io.copyuntil - (io.copy to from byte) fifo socket - stream.seekend - move to end of stream - stream.trunc - stream.tostring! - destructively convert stringstream to string - stream.readlines - stream.readall + io.seekend - move to end of stream + io.trunc + io.tostring! - destructively convert stringstream to string + io.readlines + io.readall print-to-string princ-to-string diff --git a/llt/ios.c b/llt/ios.c index af7d01d..497cbbe 100644 --- a/llt/ios.c +++ b/llt/ios.c @@ -629,20 +629,24 @@ static void _ios_init(ios_t *s) /* stream object initializers. we do no allocation. */ -ios_t *ios_file(ios_t *s, char *fname, int create, int rewrite) +ios_t *ios_file(ios_t *s, char *fname, int rd, int wr, int create, int trunc) { int fd; - int flags = O_RDWR; + if (!(rd || wr)) + // must specify read and/or write + goto open_file_err; + int flags = wr ? (rd ? O_RDWR : O_WRONLY) : O_RDONLY; if (create) flags |= O_CREAT; - if (rewrite) flags |= O_TRUNC; + if (trunc) flags |= O_TRUNC; fd = open(fname, flags, S_IRUSR|S_IWUSR|S_IRGRP|S_IROTH/*644*/); - if (fd == -1) { - s->fd = -1; - return NULL; - } + if (fd == -1) + goto open_file_err; s = ios_fd(s, fd, 1); s->ownfd = 1; return s; + open_file_err: + s->fd = -1; + return NULL; } ios_t *ios_mem(ios_t *s, size_t initsize) diff --git a/llt/ios.h b/llt/ios.h index c3b6de6..edf4b31 100644 --- a/llt/ios.h +++ b/llt/ios.h @@ -86,7 +86,7 @@ size_t ios_readprep(ios_t *from, size_t n); //int ios_unlock(ios_t *s); /* stream creation */ -ios_t *ios_file(ios_t *s, char *fname, int create, int rewrite); +ios_t *ios_file(ios_t *s, char *fname, int rd, int wr, int create, int trunc); ios_t *ios_mem(ios_t *s, size_t initsize); ios_t *ios_str(ios_t *s, char *str); ios_t *ios_fd(ios_t *s, long fd, int isfile);