ref: fa0e134dd85d2acaf09edeb0675047aeb954428b
parent: 6e515a532e6cf52317d6cc3d26a30c4d73085395
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Sat Aug 16 17:15:36 EDT 2008
adding "d.df" syntax for reading single-precision numbers misc. fixes more work on ios
--- a/femtolisp/builtins.c
+++ b/femtolisp/builtins.c
@@ -316,28 +316,50 @@
value_t fl_rand(value_t *args, u_int32_t nargs)
{- (void)args;
- (void)nargs;
- return fixnum(random()&0x1fffffff);
+ (void)args; (void)nargs;
+ fixnum_t r;
+#ifdef BITS64
+ r = ((((uint64_t)random())<<32) | random()) & 0x1fffffffffffffffLL;
+#else
+ r = random() & 0x1fffffff;
+#endif
+ return fixnum(r);
}
value_t fl_rand32(value_t *args, u_int32_t nargs)
{- (void)args;
- (void)nargs;
- return mk_uint32(random());
+ (void)args; (void)nargs;
+ ulong r = random();
+#ifdef BITS64
+ return fixnum(r);
+#else
+ if (fits_fixnum(r)) return fixnum(r);
+ return mk_uint32(r);
+#endif
}
value_t fl_rand64(value_t *args, u_int32_t nargs)
{- (void)args;
- (void)nargs;
- return mk_uint64(((uint64_t)random())<<32 | ((uint64_t)random()));
+ (void)args; (void)nargs;
+ ulong r = (((uint64_t)random())<<32) | random();
+#ifdef BITS64
+ if (fits_fixnum(r)) return fixnum(r);
+#endif
+ return mk_uint64(r);
}
value_t fl_randd(value_t *args, u_int32_t nargs)
{- (void)args;
- (void)nargs;
+ (void)args; (void)nargs;
return mk_double(rand_double());
}
+value_t fl_randf(value_t *args, u_int32_t nargs)
+{+ (void)args; (void)nargs;
+ return mk_float(rand_float());
+}
+value_t fl_randn(value_t *args, u_int32_t nargs)
+{+ (void)args; (void)nargs;
+ return mk_double(randn());
+}
extern void stringfuncs_init();
@@ -366,6 +388,8 @@
set(symbol("rand.uint32"), guestfunc(fl_rand32)); set(symbol("rand.uint64"), guestfunc(fl_rand64)); set(symbol("rand.double"), guestfunc(fl_randd));+ set(symbol("rand.float"), guestfunc(fl_randf));+ set(symbol("randn"), guestfunc(fl_randn)); set(symbol("path.cwd"), guestfunc(fl_path_cwd));--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -241,6 +241,7 @@
value_t cvalue_wchar(value_t *args, uint32_t nargs);
value_t mk_double(double_t n);
+value_t mk_float(float_t n);
value_t mk_uint32(uint32_t n);
value_t mk_uint64(uint64_t n);
value_t return_from_uint64(uint64_t Uaccum);
--- a/femtolisp/print.c
+++ b/femtolisp/print.c
@@ -469,11 +469,13 @@
else if (type == floatsym || type == doublesym) {char buf[64];
double d;
- if (type == floatsym) d = (double)*(float*)data;
- else d = *(double*)data;
- snprint_real(buf, sizeof(buf), d, 0, 16, 3, 10);
- if (weak || princ || (type==doublesym && strpbrk(buf, ".eE"))) {+ int ndec;
+ if (type == floatsym) { d = (double)*(float*)data; ndec = 8; }+ else { d = *(double*)data; ndec = 16; }+ snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);
+ if (weak || princ || strpbrk(buf, ".eE")) {outs(buf, f);
+ if (type == floatsym) outc('f', f);}
else {if (!DFINITE(d))
--- a/femtolisp/read.c
+++ b/femtolisp/read.c
@@ -31,6 +31,10 @@
if (pval) *pval = mk_double(d);
return 1;
}
+ if (end > tok && *end == 'f' && end[1] == '\0') {+ if (pval) *pval = mk_float((float)d);
+ return 1;
+ }
}
if (isdigit(tok[0]) || tok[0]=='-' || tok[0]=='+') { if (tok[0]=='-') {--- a/llt/hashing.c
+++ b/llt/hashing.c
@@ -90,10 +90,16 @@
return f.f - 1.0;
}
-void randn(double *pre, double *pim)
+double randn()
{double s, vre, vim, ure, uim;
+ static double next = -42;
+ if (next != -42) {+ s = next;
+ next = -42;
+ return s;
+ }
do {ure = rand_double();
uim = rand_double();
@@ -102,8 +108,8 @@
s = vre*vre + vim*vim;
} while (s >= 1);
s = sqrt(-2*log(s)/s);
- *pre = s * vre;
- *pim = s * vim;
+ next = s * vre;
+ return s * vim;
}
void randomize()
@@ -117,6 +123,7 @@
/*
I used this function to guess good values based on epsilon:
tol(eps) = exp(ln(eps)*-.2334012088721472)*eps
+ I derived the constant by hallucinating freely.
*/
dbl_tolerance(1e-12);
flt_tolerance(5e-6);
--- a/llt/hashing.h
+++ b/llt/hashing.h
@@ -15,7 +15,7 @@
#define srandom(n) init_genrand(n)
double rand_double();
float rand_float();
-void randn(double *pre, double *pim);
+double randn();
u_int64_t i64time();
void randomize();
unsigned long genrand_int32();
--- a/llt/ios.c
+++ b/llt/ios.c
@@ -24,6 +24,8 @@
#include "socket.h"
#include "timefuncs.h"
+#define MOST_OF(x) ((x) - ((x)>>4))
+
/* OS-level primitive wrappers */
static int _fd_available(long fd)
@@ -36,7 +38,7 @@
FD_SET(fd, &set);
return (select(fd+1, &set, NULL, NULL, &tv)!=0);
#else
- return 0;
+ return 1;
#endif
}
@@ -118,7 +120,7 @@
*nwritten = 0;
return errno;
}
- sleep_ms(5);
+ sleep_ms(SLEEP_TIME);
}
return 0;
}
@@ -212,7 +214,7 @@
}
s->size = s->bpos + n;
}
- memcpy(&s->buf[s->bpos], data, n);
+ memcpy(s->buf + s->bpos, data, n);
s->bpos += n;
return n;
@@ -254,24 +256,31 @@
s->state = bst_rd;
}
- if (n > (s->maxsize - (s->maxsize>>4))) {+ if (n > MOST_OF(s->maxsize)) {// doesn't fit comfortably in buffer; go direct
if (all)
result = _os_read_all(s->fd, dest, n, &got);
else
result = _os_read(s->fd, dest, n, &got);
- return tot+got;
+ tot += got;
+ if (got < n)
+ s->_eof = 1;
+ return tot;
}
else {// refill buffer
if (_os_read(s->fd, s->buf, s->maxsize, &got)) {+ s->_eof = 1;
return tot;
}
if (got == 0) {- if (all)
+ if (all) {_fd_poll(s->fd, 0);
- else
+ }
+ else {+ s->_eof = 1;
return tot;
+ }
}
s->size = got;
}
@@ -282,18 +291,57 @@
size_t ios_write(ios_t *s, char *data, size_t n)
{+ if (n == 0) return 0;
+ size_t space;
+ size_t wrote = 0;
+
+ if (s->state == bst_wr)
+ space = s->maxsize - s->bpos;
+ else
+ space = s->size - s->bpos;
+
+ if (s->bm == bm_mem) {+ wrote = _writebuf_force(s, data, n);
+ }
+ else if (s->bm == bm_none) {+ int result = _os_write_all(s->fd, data, n, &wrote);
+ return wrote;
+ }
+ else if (n <= space) {+ memcpy(s->buf + s->bpos, data, n);
+ s->bpos += n;
+ wrote = n;
+ }
+ else {+ s->state = bst_wr;
+ ios_flush(s);
+ if (n > MOST_OF(s->maxsize)) {+ int result = _os_write_all(s->fd, data, n, &wrote);
+ return wrote;
+ }
+ return ios_write(s, data, n);
+ }
+ if (s->bpos > s->ndirty)
+ s->ndirty = s->bpos;
+ if (s->bpos > s->size)
+ s->size = s->bpos;
+ return wrote;
}
off_t ios_seek(ios_t *s, off_t pos)
{+ s->_eof = 0;
}
off_t ios_seek_end(ios_t *s)
{+ s->_eof = 1;
}
off_t ios_skip(ios_t *s, off_t offs)
{+ if (offs < 0)
+ s->_eof = 0;
}
off_t ios_pos(ios_t *s)
@@ -314,6 +362,22 @@
size_t ios_trunc(ios_t *s, size_t size)
{+ if (s->bm == bm_mem) {+ if (size == s->size)
+ return s->size;
+ if (size < s->size) {+ if (s->bpos > size)
+ s->bpos = size;
+ }
+ else {+ if (_buf_realloc(s, size)==NULL)
+ return s->size;
+ }
+ s->size = size;
+ return size;
+ }
+ //todo
+ return 0;
}
int ios_eof(ios_t *s)
@@ -322,7 +386,12 @@
return (s->bpos >= s->size);
if (s->fd == -1)
return 1;
- // todo
+ if (s->_eof)
+ return 1;
+ if (_fd_available(s->fd))
+ return 0;
+ s->_eof = 1;
+ return 1;
}
static void _discard_partial_buffer(ios_t *s)
@@ -356,8 +425,7 @@
}
size_t nw, ntowrite=s->ndirty;
- // todo: this should use sendall
- int err = _os_write(s->fd, s->buf, ntowrite, &nw);
+ int err = _os_write_all(s->fd, s->buf, ntowrite, &nw);
// todo: try recovering from some kinds of errors (e.g. retry)
if (s->state == bst_rd) {@@ -364,6 +432,11 @@
if (lseek(s->fd, s->size - nw, SEEK_CUR) == (off_t)-1) {}
}
+ else if (s->state == bst_wr) {+ if (s->bpos != nw &&
+ lseek(s->fd, (off_t)s->bpos - (off_t)nw, SEEK_CUR) == (off_t)-1) {+ }
+ }
if (s->ndirty <= s->bpos) {// in this case assume we're done with the first part of the buffer
@@ -386,6 +459,20 @@
s->fd = -1;
}
+static void _buf_init(ios_t *s, bufmode_t bm)
+{+ s->bm = bm;
+ if (s->bm == bm_mem || s->bm == bm_none) {+ s->buf = &s->local[0];
+ s->maxsize = IOS_INLSIZE;
+ }
+ else {+ s->buf = NULL;
+ _buf_realloc(s, IOS_BUFSIZE);
+ }
+ s->size = s->bpos = 0;
+}
+
char *ios_takebuf(ios_t *s, size_t *psize)
{char *buf;
@@ -407,15 +494,7 @@
*psize = s->size+1; // buffer is actually 1 bigger for terminating NUL
/* empty stream and reinitialize */
- if (s->bm == bm_mem || s->bm == bm_none) {- s->buf = &s->local[0];
- s->maxsize = IOS_INLSIZE;
- }
- else {- s->buf = NULL;
- _buf_realloc(s, IOS_BUFSIZE);
- }
- s->size = s->bpos = 0;
+ _buf_init(s, s->bm);
return buf;
}
@@ -455,8 +534,18 @@
s->byteswap = !!bswap;
}
-int ios_copy(ios_t *to, ios_t *from, size_t nbytes, bool_t all)
+static int ios_copy_(ios_t *to, ios_t *from, size_t nbytes, bool_t all)
{+}
+
+int ios_copy(ios_t *to, ios_t *from, size_t nbytes)
+{+ return ios_copy_(to, from, nbytes, 0);
+}
+
+int ios_copyall(ios_t *to, ios_t *from)
+{+ return ios_copy_(to, from, 0, 1);
}
--- a/llt/ios.h
+++ b/llt/ios.h
@@ -41,6 +41,7 @@
//unsigned char readonly:1;
unsigned char ownbuf:1;
unsigned char ownfd:1;
+ unsigned char _eof:1;
// this means you can read, seek back, then read the same data
// again any number of times. usually only true for files and strings.
@@ -50,7 +51,7 @@
// seek without flushing in between. this performs read-before-write
// to populate the buffer, so "rereadable" capability is required.
// this is off by default.
- unsigned char stenciled:1;
+ //unsigned char stenciled:1;
// request durable writes (fsync)
// unsigned char durable:1;
@@ -75,7 +76,10 @@
int ios_setbuf(ios_t *s, char *buf, size_t size, int own);
int ios_bufmode(ios_t *s, bufmode_t mode);
void ios_bswap(ios_t *s, int bswap);
-int ios_copy(ios_t *to, ios_t *from, size_t nbytes, bool_t all);
+int ios_copy(ios_t *to, ios_t *from, size_t nbytes);
+int ios_copyall(ios_t *to, ios_t *from);
+// ensure at least n bytes are buffered if possible. returns actual #.
+//size_t ios_ensure(ios_t *from, size_t n);
//void ios_lock(ios_t *s);
//int ios_trylock(ios_t *s);
//int ios_unlock(ios_t *s);
@@ -109,11 +113,11 @@
/* stdio-style functions */
#define IOS_EOF (-1)
int ios_putc(ios_t *s, int c);
-wint_t ios_putwc(ios_t *s, wchar_t wc);
+//wint_t ios_putwc(ios_t *s, wchar_t wc);
int ios_getc(ios_t *s);
-wint_t ios_getwc(ios_t *s);
+//wint_t ios_getwc(ios_t *s);
int ios_ungetc(ios_t *s, int c);
-wint_t ios_ungetwc(ios_t *s, wint_t wc);
+//wint_t ios_ungetwc(ios_t *s, wint_t wc);
#define ios_puts(s, str) ios_write(s, str, strlen(str))
/*
--- a/llt/timefuncs.c
+++ b/llt/timefuncs.c
@@ -22,17 +22,18 @@
#include "timefuncs.h"
#ifdef WIN32
+/*
double tvals2float(struct tm *t, struct timeb *tstruct)
{- return (double)t->tm_hour * 3600 + (double)t->tm_min * 60 +
+ return (double)t->tm_hour * 3600 + (double)t->tm_min * 60 +
(double)t->tm_sec + (double)tstruct->millitm/1.0e3;
}
-
+*/
double floattime()
{struct timeb tstruct;
- ftime(&tstruct);
+ ftime(&tstruct);
return (double)tstruct.time + (double)tstruct.millitm/1.0e3;
}
#else
@@ -53,7 +54,7 @@
u_int64_t a;
#ifdef WIN32
struct timeb tstruct;
- ftime(&tstruct);
+ ftime(&tstruct);
a = (((u_int64_t)tstruct.time)<<32) + (u_int64_t)tstruct.millitm;
#else
struct timeval now;
@@ -76,12 +77,6 @@
#endif
}
-#ifndef LINUX
-static char *wdaystr[] = {"Sun","Mon","Tue","Wed","Thu","Fri","Sat"};-static char *monthstr[] = {"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug",- "Sep","Oct","Nov","Dec"};
-#endif
-
void timestring(double seconds, char *buffer, size_t len)
{time_t tme = (time_t)seconds;
@@ -93,6 +88,9 @@
localtime_r(&tme, &tm);
strftime(buffer, len, fmt, &tm);
#else
+ static char *wdaystr[] = {"Sun","Mon","Tue","Wed","Thu","Fri","Sat"};+ static char *monthstr[] = {"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug",+ "Sep","Oct","Nov","Dec"};
struct tm *tm;
int hr;