ref: 10975974378b044cb302353961d0ed94e027b260
parent: 2a083db293f21e587ee5c0e606dfc828f4542878
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Sun Feb 8 22:22:31 EST 2009
file stream creation and io.read
--- 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)
--- a/femtolisp/builtins.c
+++ b/femtolisp/builtins.c
@@ -389,6 +389,7 @@
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 @@
assign_global_builtins(builtin_info);
stringfuncs_init();
table_init();
+ iostream_init();
}
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -1565,7 +1565,7 @@
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) {--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -219,6 +219,7 @@
#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)
--- /dev/null
+++ b/femtolisp/iostream.c
@@ -1,0 +1,114 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
+#include <assert.h>
+#include <sys/types.h>
+#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("#<iostream>", 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));
+}
--- a/femtolisp/stream.c
+++ /dev/null
@@ -1,56 +1,0 @@
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <string.h>
-#include <assert.h>
-#include <sys/types.h>
-#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);
-}
--- 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)))))
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -834,25 +834,25 @@
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
--- a/llt/ios.c
+++ b/llt/ios.c
@@ -629,20 +629,24 @@
/* 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)
--- a/llt/ios.h
+++ b/llt/ios.h
@@ -86,7 +86,7 @@
//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);