file stream creation and io.read

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)

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

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) {

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)

femtolisp/iostream.c

@@ -0,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));
+}

femtolisp/stream.c

@@ -1,56 +0,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);
-}

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)))))
 

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
 

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)

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