adding functions io.copy, io.readall, time.fromstring

adding srfi-6 (string ports) functions
removing unnecessary behavior of sometimes printing int32s and int64s in
  hexadecimal
This commit is contained in:
JeffBezanson 2009-08-08 23:43:12 +00:00
parent 302ddec770
commit 3fbd5e7da6
9 changed files with 109 additions and 66 deletions

View File

@ -2,6 +2,7 @@
; femtolisp procedures ; femtolisp procedures
(define top-level-bound? bound?) (define top-level-bound? bound?)
(define (eval-core x) (eval x))
(define vector-ref aref) (define vector-ref aref)
(define vector-set! aset!) (define vector-set! aset!)
@ -65,5 +66,18 @@
(define (input-port? x) (iostream? x)) (define (input-port? x) (iostream? x))
(define (output-port? x) (iostream? x)) (define (output-port? x) (iostream? x))
(define close-input-port io.close)
(define (eval-core x) (eval x)) (define close-output-port io.close)
(define (read-char (s *input-stream*)) (io.getc s))
(define (write-char c (s *output-stream*)) (io.putc s c))
(define (open-input-string str)
(let ((b (buffer)))
(io.write b str)
(io.seek b 0)
b))
(define (open-output-string) (buffer))
(define (get-output-string b)
(let ((p (io.pos b)))
(io.seek b 0)
(prog1 (io.readall b)
(io.seek b p))))

View File

@ -324,6 +324,17 @@ static value_t fl_time_string(value_t *args, uint32_t nargs)
return string_from_cstr(buf); return string_from_cstr(buf);
} }
static value_t fl_time_fromstring(value_t *args, uint32_t nargs)
{
argcount("time.fromstring", nargs, 1);
char *ptr = tostring(args[0], "time.fromstring");
double t = parsetime(ptr);
int64_t it = (int64_t)t;
if ((double)it == t && fits_fixnum(it))
return fixnum(it);
return mk_double(t);
}
static value_t fl_path_cwd(value_t *args, uint32_t nargs) static value_t fl_path_cwd(value_t *args, uint32_t nargs)
{ {
if (nargs > 1) if (nargs > 1)
@ -433,6 +444,7 @@ static builtinspec_t builtin_info[] = {
{ "time.now", fl_time_now }, { "time.now", fl_time_now },
{ "time.string", fl_time_string }, { "time.string", fl_time_string },
{ "time.fromstring", fl_time_fromstring },
{ "rand", fl_rand }, { "rand", fl_rand },
{ "rand.uint32", fl_rand32 }, { "rand.uint32", fl_rand32 },

File diff suppressed because one or more lines are too long

View File

@ -299,6 +299,19 @@ value_t fl_iocopyuntil(value_t *args, u_int32_t nargs)
return size_wrap(ios_copyuntil(dest, src, delim)); return size_wrap(ios_copyuntil(dest, src, delim));
} }
value_t fl_iocopy(value_t *args, u_int32_t nargs)
{
if (nargs < 2 || nargs > 3)
argcount("io.copy", nargs, 2);
ios_t *dest = toiostream(args[0], "io.copy");
ios_t *src = toiostream(args[1], "io.copy");
if (nargs == 3) {
size_t n = toulong(args[2], "io.copy");
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 stream_to_string(value_t *ps)
{ {
value_t str; value_t str;
@ -344,6 +357,7 @@ static builtinspec_t iostreamfunc_info[] = {
{ "io.discardbuffer", fl_iopurge }, { "io.discardbuffer", fl_iopurge },
{ "io.read", fl_ioread }, { "io.read", fl_ioread },
{ "io.write", fl_iowrite }, { "io.write", fl_iowrite },
{ "io.copy", fl_iocopy },
{ "io.readuntil", fl_ioreaduntil }, { "io.readuntil", fl_ioreaduntil },
{ "io.copyuntil", fl_iocopyuntil }, { "io.copyuntil", fl_iocopyuntil },
{ "io.tostring!", fl_iotostring }, { "io.tostring!", fl_iotostring },

View File

@ -501,8 +501,6 @@ static numerictype_t sym_to_numtype(value_t type);
static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type, static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
int weak) int weak)
{ {
int64_t tmp=0;
if (type == bytesym) { if (type == bytesym) {
unsigned char ch = *(unsigned char*)data; unsigned char ch = *(unsigned char*)data;
if (print_princ) if (print_princ)
@ -539,40 +537,6 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
else HPOS+=ios_printf(f, "x%04x", (int)wc); else HPOS+=ios_printf(f, "x%04x", (int)wc);
} }
} }
else if (type == int64sym
#ifdef BITS64
|| type == longsym
#endif
) {
int64_t i64 = *(int64_t*)data;
if (fits_fixnum(i64) || print_princ) {
if (weak || print_princ)
HPOS+=ios_printf(f, "%lld", i64);
else
HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), i64);
}
else
HPOS+=ios_printf(f, "#%s(0x%08x%08x)", symbol_name(type),
(uint32_t)(i64>>32),
(uint32_t)(i64));
}
else if (type == uint64sym
#ifdef BITS64
|| type == ulongsym
#endif
) {
uint64_t ui64 = *(uint64_t*)data;
if (fits_fixnum(ui64) || print_princ) {
if (weak || print_princ)
HPOS+=ios_printf(f, "%llu", ui64);
else
HPOS+=ios_printf(f, "#%s(%llu)", symbol_name(type), ui64);
}
else
HPOS+=ios_printf(f, "#%s(0x%08x%08x)", symbol_name(type),
(uint32_t)(ui64>>32),
(uint32_t)(ui64));
}
else if (type == floatsym || type == doublesym) { else if (type == floatsym || type == doublesym) {
char buf[64]; char buf[64];
double d; double d;
@ -607,19 +571,25 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
outc('f', f); outc('f', f);
} }
} }
else if (issymbol(type)) { else if (type == uint64sym
// handle other integer prims. we know it's smaller than 64 bits #ifdef BITS64
// at this point, so int64 is big enough to capture everything. || type == ulongsym
tmp = conv_to_int64(data, sym_to_numtype(type)); #endif
if (fits_fixnum(tmp) || print_princ) { ) {
if (weak || print_princ) uint64_t ui64 = *(uint64_t*)data;
HPOS+=ios_printf(f, "%lld", tmp); if (weak || print_princ)
else HPOS += ios_printf(f, "%llu", ui64);
HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), tmp);
}
else else
HPOS+=ios_printf(f, "#%s(0x%08x)", symbol_name(type), HPOS += ios_printf(f, "#%s(%llu)", symbol_name(type), ui64);
(uint32_t)(tmp&0xffffffff)); }
else if (issymbol(type)) {
// handle other integer prims. we know it's smaller than uint64
// at this point, so int64 is big enough to capture everything.
int64_t i64 = conv_to_int64(data, sym_to_numtype(type));
if (weak || print_princ)
HPOS += ios_printf(f, "%lld", i64);
else
HPOS += ios_printf(f, "#%s(%lld)", symbol_name(type), i64);
} }
else if (iscons(type)) { else if (iscons(type)) {
if (car_(type) == arraysym) { if (car_(type) == arraysym) {

View File

@ -544,6 +544,11 @@
(define (io.readlines s) (read-all-of io.readline s)) (define (io.readlines s) (read-all-of io.readline s))
(define (read-all s) (read-all-of read s)) (define (read-all s) (read-all-of read s))
(define (io.readall s)
(let ((b (buffer)))
(io.copy b s)
(io.tostring! b)))
(define-macro (with-output-to stream . body) (define-macro (with-output-to stream . body)
`(with-bindings ((*output-stream* ,stream)) `(with-bindings ((*output-stream* ,stream))
,@body)) ,@body))

View File

@ -139,6 +139,7 @@ for internal use:
x preallocate all byte,int8,uint8 values, and some wchars (up to 0x31B7?) x preallocate all byte,int8,uint8 values, and some wchars (up to 0x31B7?)
. this made no difference in a string.map microbenchmark . this made no difference in a string.map microbenchmark
- use faster hash/compare in tables where the keys are eq-comparable - use faster hash/compare in tables where the keys are eq-comparable
- a way to do open-input-string without copying
bugs: bugs:
* with the fully recursive (simpler) relocate(), the size of cons chains * with the fully recursive (simpler) relocate(), the size of cons chains
@ -869,10 +870,11 @@ IOStream API
*io.read - (io.read s ctype [len]) *io.read - (io.read s ctype [len])
*io.getc - get utf8 character *io.getc - get utf8 character
*io.putc *io.putc
io.peekc
*io.readline *io.readline
*io.readuntil *io.readuntil
io.copy - (io.copy to from [nbytes]) *io.copy - (io.copy to from [nbytes])
io.copyuntil - (io.copy to from byte) *io.copyuntil - (io.copy to from byte)
io.pos - (io.pos s [set-pos]) io.pos - (io.pos s [set-pos])
io.seek - (io.seek s offset) io.seek - (io.seek s offset)
io.seekend - move to end of stream io.seekend - move to end of stream
@ -880,7 +882,7 @@ IOStream API
io.read! - destructively take data io.read! - destructively take data
*io.tostring! *io.tostring!
*io.readlines *io.readlines
io.readall *io.readall
*print-to-string *print-to-string
*princ-to-string *princ-to-string
@ -899,7 +901,7 @@ IOStream API
time.parts time.parts
time.fromparts time.fromparts
*time.string *time.string
time.fromstring *time.fromstring
*os.name *os.name
@ -964,10 +966,10 @@ consolidated todo list as of 7/8:
* new toplevel * new toplevel
* make raising a memory error non-consing * make raising a memory error non-consing
- eliminate string copy in lerror() when possible * eliminate string copy in lerror() when possible
* fix printing lists of short strings * fix printing lists of short strings
- evaluator improvements, perf & debugging (below) * evaluator improvements, perf & debugging (below)
* fix make-system-image to save aliases of builtins * fix make-system-image to save aliases of builtins
* reading named characters, e.g. #\newline etc. * reading named characters, e.g. #\newline etc.
- #+, #- reader macros - #+, #- reader macros
@ -1043,7 +1045,7 @@ new evaluator todo:
* stack traces and better debugging support * stack traces and better debugging support
* improve internal define * improve internal define
* try removing MAX_ARGS trickery * try removing MAX_ARGS trickery
- apply optimization, avoid redundant list copying calling vararg fns ? apply optimization, avoid redundant list copying calling vararg fns
- let eversion - let eversion
- variable analysis - avoid holding references to values in frames - variable analysis - avoid holding references to values in frames
captured by closures but not used inside them captured by closures but not used inside them

View File

@ -303,15 +303,17 @@ size_t ios_readall(ios_t *s, char *dest, size_t n)
size_t ios_readprep(ios_t *s, size_t n) size_t ios_readprep(ios_t *s, size_t n)
{ {
if (s->state == bst_wr && s->bm != bm_mem) {
ios_flush(s);
s->bpos = s->size = 0;
}
size_t space = s->size - s->bpos; size_t space = s->size - s->bpos;
if (s->state == bst_wr)
return space;
s->state = bst_rd; s->state = bst_rd;
if (space >= n || s->bm == bm_mem || s->fd == -1) if (space >= n || s->bm == bm_mem || s->fd == -1)
return space; return space;
if (s->maxsize < s->bpos+n) { if (s->maxsize < s->bpos+n) {
// it won't fit. grow buffer or move data back. // it won't fit. grow buffer or move data back.
if (n <= s->maxsize && space <= ((s->maxsize)>>5)) { if (n <= s->maxsize && space <= ((s->maxsize)>>2)) {
if (space) if (space)
memmove(s->buf, s->buf+s->bpos, space); memmove(s->buf, s->buf+s->bpos, space);
s->size -= s->bpos; s->size -= s->bpos;
@ -615,16 +617,40 @@ void ios_bswap(ios_t *s, int bswap)
s->byteswap = !!bswap; s->byteswap = !!bswap;
} }
static int ios_copy_(ios_t *to, ios_t *from, size_t nbytes, bool_t all) static size_t ios_copy_(ios_t *to, ios_t *from, size_t nbytes, bool_t all)
{ {
size_t total = 0, avail;
if (!ios_eof(from)) {
do {
avail = ios_readprep(from, IOS_BUFSIZE/2);
if (avail == 0) {
from->_eof = 1;
break;
}
size_t written, ntowrite;
ntowrite = (avail <= nbytes || all) ? avail : nbytes;
written = ios_write(to, from->buf+from->bpos, ntowrite);
// TODO: should this be +=written instead?
from->bpos += ntowrite;
total += written;
if (!all) {
nbytes -= written;
if (nbytes == 0)
break;
}
if (written < ntowrite)
break;
} while (!ios_eof(from));
}
return total;
} }
int ios_copy(ios_t *to, ios_t *from, size_t nbytes) size_t ios_copy(ios_t *to, ios_t *from, size_t nbytes)
{ {
return ios_copy_(to, from, nbytes, 0); return ios_copy_(to, from, nbytes, 0);
} }
int ios_copyall(ios_t *to, ios_t *from) size_t ios_copyall(ios_t *to, ios_t *from)
{ {
return ios_copy_(to, from, 0, 1); return ios_copy_(to, from, 0, 1);
} }

View File

@ -78,8 +78,8 @@ int ios_setbuf(ios_t *s, char *buf, size_t size, int own);
int ios_bufmode(ios_t *s, bufmode_t mode); int ios_bufmode(ios_t *s, bufmode_t mode);
void ios_set_readonly(ios_t *s); void ios_set_readonly(ios_t *s);
void ios_bswap(ios_t *s, int bswap); void ios_bswap(ios_t *s, int bswap);
int ios_copy(ios_t *to, ios_t *from, size_t nbytes); size_t ios_copy(ios_t *to, ios_t *from, size_t nbytes);
int ios_copyall(ios_t *to, ios_t *from); size_t ios_copyall(ios_t *to, ios_t *from);
size_t ios_copyuntil(ios_t *to, ios_t *from, char delim); size_t ios_copyuntil(ios_t *to, ios_t *from, char delim);
// ensure at least n bytes are buffered if possible. returns # available. // ensure at least n bytes are buffered if possible. returns # available.
size_t ios_readprep(ios_t *from, size_t n); size_t ios_readprep(ios_t *from, size_t n);