shithub: femtolisp

ref: b307865d7a8cc2e9ae02104907656c7f159ac5d3
dir: /iostream.c/

View raw version
#include "llt.h"
#include "flisp.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];
    }
}

cvtable_t iostream_vtable = { print_iostream, relocate_iostream,
                              free_iostream, nil };

int fl_isiostream(value_t v)
{
    return iscvalue(v) && cv_class((cvalue_t*)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 (FL_EOF == args[0]) ? FL_T : FL_F;
}

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

ios_t *fl_toiostream(value_t v)
{
    return toiostream(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 < (int)nargs; i++) {
        if      (args[i] == wrsym)    w = 1;
        else if (args[i] == apsym)    { a = 1; w = 1; }
        else if (args[i] == crsym)    { c = 1; w = 1; }
        else if (args[i] == truncsym) { t = 1; w = 1; }
        else if (args[i] == rdsym)    r = 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];
    }
    (void)toiostream(arg);
    fl_gc_handle(&arg);
    value_t v = fl_read_sexpr(arg);
    fl_free_gc_handles(1);
    if (ios_eof(value2c(ios_t*,arg)))
        return FL_EOF;
    return v;
}

BUILTIN("io.getc", io_getc)
{
    argcount(nargs, 1);
    ios_t *s = 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 = 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 = 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 = 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);
    ios_t *s = toiostream(args[0]);
    if (ios_flush(s) != 0)
        return FL_F;
    return FL_T;
}

BUILTIN("io.close", io_close)
{
    argcount(nargs, 1);
    ios_t *s = toiostream(args[0]);
    ios_close(s);
    return FL_T;
}

BUILTIN("io.discardbuffer", io_discardbuffer)
{
    argcount(nargs, 1);
    ios_t *s = toiostream(args[0]);
    ios_purge(s);
    return FL_T;
}

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

BUILTIN("io.seek", io_seek)
{
    argcount(nargs, 2);
    ios_t *s = 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 = 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;
    if (nargs == 2)
        s = toiostream(args[1]);
    else
        s = toiostream(symbol_value(outstrsym));
    fl_print(s, args[0]);
    return args[0];
}

BUILTIN("io.read", io_read)
{
    if (nargs != 3)
        argcount(nargs, 2);
    (void)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((cvalue_t*)ptr(cv));
    else data = cp_data((cprim_t*)ptr(cv));
    size_t got = ios_read(value2c(ios_t*,args[0]), 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]);
        if (nargs > 2)
            *nb = toulong(args[2]);
        else
            *nb = 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 = toiostream(args[0]);
    if (iscprim(args[1]) && ((cprim_t*)ptr(args[1]))->type == wchartype) {
        if (nargs > 2)
            lerrorf(ArgError,
                   "io.write: offset argument not supported for characters");
        uint32_t wc = *(uint32_t*)cp_data((cprim_t*)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 = 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((cprim_t*)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 = (cvalue_t*)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 = 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 = toiostream(args[0]);
    ios_t *src = 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 = toiostream(args[0]);
    ios_t *src = toiostream(args[1]);
    if (nargs == 3) {
        size_t n = toulong(args[2]);
        return size_wrap(ios_copy(dest, src, n));
    }
    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), value2c(ios_t*,*ps)->buf, n);
        ios_trunc(value2c(ios_t*,*ps), 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((cvalue_t*)ptr(str));
#endif
    }
    return str;
}

BUILTIN("io.tostring!", io_tostring)
{
    argcount(nargs, 1);
    ios_t *src = 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));
}