adding dump, memstream, io.read, and io.write
more renaming allowing iostreams to be read-only fixing bug allowing arrays with 0-size elements
This commit is contained in:
JeffBezanson
parent
923c7d5495
commit
2cf5187ca9
|
|
@ -17,7 +17,7 @@
|
|||
,(begin->cps (cdr forms) k)))))))
|
||||
|
||||
(define-macro (lambda/cc args body)
|
||||
`(rplaca (lambda ,args ,body) 'lambda/cc))
|
||||
`(set-car! (lambda ,args ,body) 'lambda/cc))
|
||||
|
||||
; a utility used at run time to dispatch a call with or without
|
||||
; the continuation argument, depending on the function
|
||||
|
|
@ -26,7 +26,7 @@
|
|||
(apply f (cons k args))
|
||||
(k (apply f args))))
|
||||
(define *funcall/cc-names*
|
||||
(list-to-vector
|
||||
(list->vector
|
||||
(map (lambda (i) (intern (string 'funcall/cc- i)))
|
||||
(iota 6))))
|
||||
(define-macro (def-funcall/cc-n args)
|
||||
|
|
|
|||
|
|
@ -153,7 +153,7 @@ void lerror(value_t e, char *format, ...) __attribute__ ((__noreturn__));
|
|||
void raise(value_t e) __attribute__ ((__noreturn__));
|
||||
void type_error(char *fname, char *expected, value_t got) __attribute__ ((__noreturn__));
|
||||
void bounds_error(char *fname, value_t arr, value_t ind) __attribute__ ((__noreturn__));
|
||||
extern value_t ArgError, IOError, KeyError;
|
||||
extern value_t ArgError, IOError, KeyError, MemoryError;
|
||||
static inline void argcount(char *fname, uint32_t nargs, uint32_t c)
|
||||
{
|
||||
if (__unlikely(nargs != c))
|
||||
|
|
@ -220,7 +220,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 value2c(type, v) ((type)cv_data((cvalue_t*)ptr(v)))
|
||||
|
||||
#define valid_numtype(v) ((v) < N_NUMTYPES)
|
||||
#define cp_class(cp) ((cp)->type)
|
||||
|
|
|
|||
|
|
@ -7,7 +7,8 @@
|
|||
#include "llt.h"
|
||||
#include "flisp.h"
|
||||
|
||||
static value_t iostreamsym, rdsym, wrsym, apsym, crsym, truncsym, instrsym;
|
||||
static value_t iostreamsym, rdsym, wrsym, apsym, crsym, truncsym;
|
||||
static value_t instrsym, outstrsym;
|
||||
static fltype_t *iostreamtype;
|
||||
|
||||
void print_iostream(value_t v, ios_t *f, int princ)
|
||||
|
|
@ -60,13 +61,15 @@ 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;
|
||||
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;
|
||||
else if (args[i] == crsym) c = 1;
|
||||
else if (args[i] == truncsym) t = 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], "file");
|
||||
ios_t *s = value2c(ios_t*, f);
|
||||
|
|
@ -76,6 +79,17 @@ value_t fl_file(value_t *args, uint32_t nargs)
|
|||
return f;
|
||||
}
|
||||
|
||||
value_t fl_memstream(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("memstream", nargs, 0);
|
||||
(void)args;
|
||||
value_t f = cvalue(iostreamtype, sizeof(ios_t));
|
||||
ios_t *s = value2c(ios_t*, f);
|
||||
if (ios_mem(s, 0) == NULL)
|
||||
lerror(MemoryError, "memstream: could not allocate stream");
|
||||
return f;
|
||||
}
|
||||
|
||||
value_t fl_read(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
if (nargs > 1) {
|
||||
|
|
@ -152,9 +166,84 @@ value_t fl_ioprinc(value_t *args, u_int32_t nargs)
|
|||
return args[nargs-1];
|
||||
}
|
||||
|
||||
value_t fl_ioread(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
if (nargs != 3)
|
||||
argcount("io.read", nargs, 2);
|
||||
(void)toiostream(args[0], "io.read");
|
||||
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], "io.read") * ft->elsz;
|
||||
}
|
||||
else {
|
||||
ft = get_type(args[1]);
|
||||
if (ft->eltype != NULL && !iscons(cdr_(cdr_(args[1]))))
|
||||
lerror(ArgError, "io.read: 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)
|
||||
lerror(IOError, "io.read: end of input reached");
|
||||
return cv;
|
||||
}
|
||||
|
||||
// get pointer and size for any plain-old-data value
|
||||
static void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz)
|
||||
{
|
||||
if (isiostream(v) && (value2c(ios_t*,v)->bm == bm_mem)) {
|
||||
ios_t *x = value2c(ios_t*,v);
|
||||
*pdata = x->buf;
|
||||
*psz = x->size;
|
||||
}
|
||||
else if (iscvalue(v)) {
|
||||
cvalue_t *pcv = (cvalue_t*)ptr(v);
|
||||
*pdata = cv_data(pcv);
|
||||
*psz = cv_len(pcv);
|
||||
}
|
||||
else if (iscprim(v)) {
|
||||
cprim_t *pcp = (cprim_t*)ptr(v);
|
||||
*pdata = cp_data(pcp);
|
||||
*psz = cp_class(pcp)->size;
|
||||
}
|
||||
else {
|
||||
type_error(fname, "byte stream", v);
|
||||
}
|
||||
}
|
||||
|
||||
value_t fl_iowrite(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("io.write", nargs, 2);
|
||||
ios_t *s = toiostream(args[0], "io.write");
|
||||
char *data;
|
||||
size_t sz;
|
||||
to_sized_ptr(args[1], "io.write", &data, &sz);
|
||||
size_t n = ios_write(s, data, sz);
|
||||
return size_wrap(n);
|
||||
}
|
||||
|
||||
value_t fl_dump(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("dump", nargs, 1);
|
||||
ios_t *s = toiostream(symbol_value(outstrsym), "dump");
|
||||
char *data;
|
||||
size_t sz;
|
||||
to_sized_ptr(args[0], "dump", &data, &sz);
|
||||
hexdump(s, data, sz, 0);
|
||||
return FL_T;
|
||||
}
|
||||
|
||||
static builtinspec_t iostreamfunc_info[] = {
|
||||
{ "iostream?", fl_iostreamp },
|
||||
{ "dump", fl_dump },
|
||||
{ "file", fl_file },
|
||||
{ "memstream", fl_memstream },
|
||||
{ "read", fl_read },
|
||||
{ "io.print", fl_ioprint },
|
||||
{ "io.princ", fl_ioprinc },
|
||||
|
|
@ -163,6 +252,8 @@ static builtinspec_t iostreamfunc_info[] = {
|
|||
{ "io.eof?" , fl_ioeof },
|
||||
{ "io.getc" , fl_iogetc },
|
||||
{ "io.discardbuffer", fl_iopurge },
|
||||
{ "io.read", fl_ioread },
|
||||
{ "io.write", fl_iowrite },
|
||||
{ NULL, NULL }
|
||||
};
|
||||
|
||||
|
|
@ -175,6 +266,7 @@ void iostream_init()
|
|||
crsym = symbol(":create");
|
||||
truncsym = symbol(":truncate");
|
||||
instrsym = symbol("*input-stream*");
|
||||
outstrsym = symbol("*output-stream*");
|
||||
iostreamtype = define_opaque_type(iostreamsym, sizeof(ios_t),
|
||||
&iostream_vtable, NULL);
|
||||
assign_global_builtins(iostreamfunc_info);
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ bq-process
|
|||
|
||||
(map-int (lambda (x) `(a b c d e)) 90)
|
||||
|
||||
(list-to-vector (map-int (lambda (x) `(a b c d e)) 90))
|
||||
(list->vector (map-int (lambda (x) `(a b c d e)) 90))
|
||||
|
||||
'((lambda (x y) (if (< x y) x y)) (a b c) (d e f) 2 3 (r t y))
|
||||
|
||||
|
|
|
|||
|
|
@ -6,11 +6,7 @@
|
|||
(if (not (bound? 'eq))
|
||||
(begin
|
||||
(set-constant! 'eq eq?)
|
||||
(set-constant! 'eqv eqv?)
|
||||
(set-constant! 'equal equal?)
|
||||
(set-constant! 'rplaca set-car!)
|
||||
(set-constant! 'rplacd set-cdr!)
|
||||
(set-constant! 'char? (lambda (x) (eq? (typeof x) 'wchar)))))
|
||||
(set-constant! 'equal equal?)))
|
||||
|
||||
; convert a sequence of body statements to a single expression.
|
||||
; this allows define, defun, defmacro, let, etc. to contain multiple
|
||||
|
|
@ -69,8 +65,8 @@
|
|||
((null? (cdr lsts)) (car lsts))
|
||||
((null? (car lsts)) (apply nconc (cdr lsts)))
|
||||
(#t (prog1 (car lsts)
|
||||
(rplacd (last (car lsts))
|
||||
(apply nconc (cdr lsts)))))))
|
||||
(set-cdr! (last (car lsts))
|
||||
(apply nconc (cdr lsts)))))))
|
||||
|
||||
(define (append . lsts)
|
||||
(cond ((null? lsts) ())
|
||||
|
|
@ -83,24 +79,24 @@
|
|||
|
||||
(define (member item lst)
|
||||
(cond ((atom? lst) #f)
|
||||
((equal (car lst) item) lst)
|
||||
((equal? (car lst) item) lst)
|
||||
(#t (member item (cdr lst)))))
|
||||
(define (memq item lst)
|
||||
(cond ((atom? lst) #f)
|
||||
((eq (car lst) item) lst)
|
||||
((eq? (car lst) item) lst)
|
||||
(#t (memq item (cdr lst)))))
|
||||
(define (memv item lst)
|
||||
(cond ((atom? lst) #f)
|
||||
((eqv (car lst) item) lst)
|
||||
((eqv? (car lst) item) lst)
|
||||
(#t (memv item (cdr lst)))))
|
||||
|
||||
(define (assoc item lst)
|
||||
(cond ((atom? lst) #f)
|
||||
((equal (caar lst) item) (car lst))
|
||||
((equal? (caar lst) item) (car lst))
|
||||
(#t (assoc item (cdr lst)))))
|
||||
(define (assv item lst)
|
||||
(cond ((atom? lst) #f)
|
||||
((eqv (caar lst) item) (car lst))
|
||||
((eqv? (caar lst) item) (car lst))
|
||||
(#t (assv item (cdr lst)))))
|
||||
|
||||
(define (macrocall? e) (and (symbol? (car e))
|
||||
|
|
@ -192,9 +188,9 @@
|
|||
|
||||
(define (expand x) (macroexpand x))
|
||||
|
||||
(define = eqv)
|
||||
(define eql eqv)
|
||||
(define (/= a b) (not (eqv a b)))
|
||||
(define = eqv?)
|
||||
(define eql eqv?)
|
||||
(define (/= a b) (not (eqv? a b)))
|
||||
(define != /=)
|
||||
(define (> a b) (< b a))
|
||||
(define (<= a b) (not (< b a)))
|
||||
|
|
@ -205,6 +201,7 @@
|
|||
(define remainder mod)
|
||||
(define (abs x) (if (< x 0) (- x) x))
|
||||
(define (identity x) x)
|
||||
(define (char? x) (eq? (typeof x) 'wchar))
|
||||
(define K prog1) ; K combinator ;)
|
||||
(define begin0 prog1)
|
||||
|
||||
|
|
@ -250,7 +247,7 @@
|
|||
(define (nlist* . l)
|
||||
(if (atom? (cdr l))
|
||||
(car l)
|
||||
(rplacd l (apply nlist* (cdr l)))))
|
||||
(set-cdr! l (apply nlist* (cdr l)))))
|
||||
|
||||
(define (lastcdr l)
|
||||
(if (atom? l) l
|
||||
|
|
@ -265,7 +262,7 @@
|
|||
(define (map! f lst)
|
||||
(prog1 lst
|
||||
(while (pair? lst)
|
||||
(rplaca lst (f (car lst)))
|
||||
(set-car! lst (f (car lst)))
|
||||
(set! lst (cdr lst)))))
|
||||
|
||||
(define (mapcar f . lsts)
|
||||
|
|
@ -318,8 +315,8 @@
|
|||
(let ((prev ()))
|
||||
(while (pair? l)
|
||||
(set! l (prog1 (cdr l)
|
||||
(rplacd l (prog1 prev
|
||||
(set! prev l))))))
|
||||
(set-cdr! l (prog1 prev
|
||||
(set! prev l))))))
|
||||
prev))
|
||||
|
||||
(define-macro (let* binds . body)
|
||||
|
|
@ -336,8 +333,8 @@
|
|||
(define (revappend l1 l2) (nconc (reverse l1) l2))
|
||||
(define (nreconc l1 l2) (nconc (nreverse l1) l2))
|
||||
|
||||
(define (list-to-vector l) (apply vector l))
|
||||
(define (vector-to-list v)
|
||||
(define (list->vector l) (apply vector l))
|
||||
(define (vector->list v)
|
||||
(let ((n (length v))
|
||||
(l ()))
|
||||
(for 1 n
|
||||
|
|
@ -362,7 +359,7 @@
|
|||
(define (bq-process x)
|
||||
(cond ((self-evaluating? x)
|
||||
(if (vector? x)
|
||||
(let ((body (bq-process (vector-to-list x))))
|
||||
(let ((body (bq-process (vector->list x))))
|
||||
(if (eq (car body) 'list)
|
||||
(cons vector (cdr body))
|
||||
(list apply vector body)))
|
||||
|
|
@ -408,7 +405,7 @@
|
|||
(list 'quote v)))
|
||||
|
||||
(define-macro (case key . clauses)
|
||||
(define (vals-to-cond key v)
|
||||
(define (vals->cond key v)
|
||||
(cond ((eq? v 'else) 'else)
|
||||
((null? v) #f)
|
||||
((null? (cdr v)) `(eqv? ,key ,(quote-value (car v))))
|
||||
|
|
@ -416,7 +413,7 @@
|
|||
(let ((g (gensym)))
|
||||
`(let ((,g ,key))
|
||||
(cond ,@(map (lambda (clause)
|
||||
(cons (vals-to-cond g (car clause))
|
||||
(cons (vals->cond g (car clause))
|
||||
(cdr clause)))
|
||||
clauses)))))
|
||||
|
||||
|
|
@ -453,7 +450,7 @@
|
|||
(set! acc first)
|
||||
(for 1 (- n 1)
|
||||
(lambda (i)
|
||||
(begin (rplacd acc (cons (f i) ()))
|
||||
(begin (set-cdr! acc (cons (f i) ()))
|
||||
(set! acc (cdr acc)))))
|
||||
first)))
|
||||
|
||||
|
|
|
|||
|
|
@ -68,7 +68,7 @@
|
|||
(lambda (acc i n)
|
||||
(if (= i n)
|
||||
first
|
||||
(begin (rplacd acc (cons (f i) ()))
|
||||
(begin (set-cdr! acc (cons (f i) ()))
|
||||
(map-int- (cdr acc) (+ i 1) n)))))
|
||||
first 1 n))))
|
||||
|
||||
|
|
@ -116,8 +116,8 @@
|
|||
; swap the cars and cdrs of every cons in a structure
|
||||
(define (swapad c)
|
||||
(if (atom? c) c
|
||||
(rplacd c (K (swapad (car c))
|
||||
(rplaca c (swapad (cdr c)))))))
|
||||
(set-cdr! c (K (swapad (car c))
|
||||
(set-car! c (swapad (cdr c)))))))
|
||||
|
||||
(define (without x l)
|
||||
(filter (lambda (e) (not (eq e x))) l))
|
||||
|
|
@ -202,7 +202,7 @@
|
|||
(set! ,first ,acc)
|
||||
(while ,cnd
|
||||
(begin (set! ,acc
|
||||
(cdr (rplacd ,acc (cons ,what ()))))
|
||||
(cdr (set-cdr! ,acc (cons ,what ()))))
|
||||
,@body))
|
||||
(cdr ,first))))
|
||||
|
||||
|
|
@ -215,7 +215,7 @@
|
|||
(for ,lo ,hi
|
||||
(lambda (,var)
|
||||
(begin (set! ,acc
|
||||
(cdr (rplacd ,acc (cons ,what ()))))
|
||||
(cdr (set-cdr! ,acc (cons ,what ()))))
|
||||
,@body)))
|
||||
(cdr ,first))))
|
||||
|
||||
|
|
|
|||
|
|
@ -848,15 +848,15 @@ IOStream API
|
|||
*princ
|
||||
*file
|
||||
iostream - (stream[ cvalue-as-bytestream])
|
||||
memstream
|
||||
*memstream
|
||||
fifo
|
||||
socket
|
||||
*io.eof
|
||||
*io.flush
|
||||
*io.close
|
||||
*io.discardbuffer
|
||||
io.write - (io.write s cvalue)
|
||||
io.read - (io.read s ctype [len])
|
||||
*io.write - (io.write s cvalue)
|
||||
*io.read - (io.read s ctype [len])
|
||||
io.getc - get utf8 character(s)
|
||||
io.readline
|
||||
io.copy - (io.copy to from [nbytes])
|
||||
|
|
@ -865,7 +865,7 @@ IOStream API
|
|||
io.seek - (io.seek s offset)
|
||||
io.seekend - move to end of stream
|
||||
io.trunc
|
||||
io.tostring! - destructively convert stringstream to string
|
||||
io.read! - destructively take data
|
||||
io.readlines
|
||||
io.readall
|
||||
print-to-string
|
||||
|
|
|
|||
|
|
@ -41,6 +41,10 @@ fltype_t *get_type(value_t t)
|
|||
if (iscons(t)) {
|
||||
if (isarray) {
|
||||
fltype_t *eltype = get_type(car_(cdr_(t)));
|
||||
if (eltype->size == 0) {
|
||||
free(ft);
|
||||
lerror(ArgError, "invalid array element type");
|
||||
}
|
||||
ft->elsz = eltype->size;
|
||||
ft->eltype = eltype;
|
||||
ft->init = &cvalue_array_init;
|
||||
|
|
|
|||
14
llt/ios.c
14
llt/ios.c
|
|
@ -328,6 +328,7 @@ static void _write_update_pos(ios_t *s)
|
|||
|
||||
size_t ios_write(ios_t *s, char *data, size_t n)
|
||||
{
|
||||
if (s->readonly) return 0;
|
||||
if (n == 0) return 0;
|
||||
size_t space;
|
||||
size_t wrote = 0;
|
||||
|
|
@ -566,7 +567,8 @@ int ios_setbuf(ios_t *s, char *buf, size_t size, int own)
|
|||
size_t nvalid=0;
|
||||
|
||||
nvalid = (size < s->size) ? size : s->size;
|
||||
memcpy(buf, s->buf, nvalid);
|
||||
if (nvalid > 0)
|
||||
memcpy(buf, s->buf, nvalid);
|
||||
if (s->bpos > nvalid) {
|
||||
// truncated
|
||||
s->bpos = nvalid;
|
||||
|
|
@ -590,6 +592,14 @@ int ios_bufmode(ios_t *s, bufmode_t mode)
|
|||
return 0;
|
||||
}
|
||||
|
||||
void ios_set_readonly(ios_t *s)
|
||||
{
|
||||
if (s->readonly) return;
|
||||
ios_flush(s);
|
||||
s->state = bst_none;
|
||||
s->readonly = 1;
|
||||
}
|
||||
|
||||
void ios_bswap(ios_t *s, int bswap)
|
||||
{
|
||||
s->byteswap = !!bswap;
|
||||
|
|
@ -645,6 +655,8 @@ ios_t *ios_file(ios_t *s, char *fname, int rd, int wr, int create, int trunc)
|
|||
goto open_file_err;
|
||||
s = ios_fd(s, fd, 1);
|
||||
s->ownfd = 1;
|
||||
if (!wr)
|
||||
s->readonly = 1;
|
||||
return s;
|
||||
open_file_err:
|
||||
s->fd = -1;
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ typedef struct {
|
|||
long fd;
|
||||
|
||||
unsigned char byteswap:1;
|
||||
//unsigned char readonly:1;
|
||||
unsigned char readonly:1;
|
||||
unsigned char ownbuf:1;
|
||||
unsigned char ownfd:1;
|
||||
unsigned char _eof:1;
|
||||
|
|
@ -76,6 +76,7 @@ char *ios_takebuf(ios_t *s, size_t *psize); // release buffer to caller
|
|||
// set buffer space to use
|
||||
int ios_setbuf(ios_t *s, char *buf, size_t size, int own);
|
||||
int ios_bufmode(ios_t *s, bufmode_t mode);
|
||||
void ios_set_readonly(ios_t *s);
|
||||
void ios_bswap(ios_t *s, int bswap);
|
||||
int ios_copy(ios_t *to, ios_t *from, size_t nbytes);
|
||||
int ios_copyall(ios_t *to, ios_t *from);
|
||||
|
|
|
|||
Loading…
Reference in New Issue