adding "d.df" syntax for reading single-precision numbers

misc. fixes
more work on ios

femtolisp/builtins.c

@@ -316,28 +316,50 @@ value_t fl_os_setenv(value_t *args, uint32_t nargs)
 
 value_t fl_rand(value_t *args, u_int32_t nargs)
 {
-    (void)args;
+    (void)args; (void)nargs;
-    (void)nargs;
+    fixnum_t r;
-    return fixnum(random()&0x1fffffff);
+#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)args; (void)nargs;
-    (void)nargs;
+    ulong r = random();
-    return mk_uint32(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)args; (void)nargs;
-    (void)nargs;
+    ulong r = (((uint64_t)random())<<32) | random();
-    return mk_uint64(((uint64_t)random())<<32 | ((uint64_t)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)args; (void)nargs;
-    (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 @@ void builtins_init()
     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));
 

femtolisp/flisp.h

@@ -241,6 +241,7 @@ value_t cvalue_char(value_t *args, uint32_t nargs);
 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);

femtolisp/print.c

@@ -469,11 +469,13 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
     else if (type == floatsym || type == doublesym) {
         char buf[64];
         double d;
-        if (type == floatsym) d = (double)*(float*)data;
+        int ndec;
-        else d = *(double*)data;
+        if (type == floatsym) { d = (double)*(float*)data; ndec = 8; }
-        snprint_real(buf, sizeof(buf), d, 0, 16, 3, 10);
+        else { d = *(double*)data; ndec = 16; }
-        if (weak || princ || (type==doublesym && strpbrk(buf, ".eE"))) {
+        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))

femtolisp/read.c

@@ -31,6 +31,10 @@ static int isnumtok(char *tok, value_t *pval)
             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]=='-') {

llt/hashing.c

@@ -90,10 +90,16 @@ float rand_float()
     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 @@ void randn(double *pre, double *pim)
         s = vre*vre + vim*vim;
     } while (s >= 1);
     s = sqrt(-2*log(s)/s);
-    *pre = s * vre;
+    next = s * vre;
-    *pim = s * vim;
+    return s * vim;
 }
 
 void randomize()
@@ -117,6 +123,7 @@ void llt_init()
     /*
       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);

llt/hashing.h

@@ -15,7 +15,7 @@ u_int64_t memhash(char* buf, size_t n);
 #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();

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 @@ static int _fd_available(long fd)
     FD_SET(fd, &set);
     return (select(fd+1, &set, NULL, NULL, &tv)!=0);
 #else
-    return 0;
+    return 1;
 #endif
 }
 
@@ -118,7 +120,7 @@ static int _os_write(long fd, void *buf, size_t n, size_t *nwritten)
             *nwritten = 0;
             return errno;
         }
-        sleep_ms(5);
+        sleep_ms(SLEEP_TIME);
     }
     return 0;
 }
@@ -212,7 +214,7 @@ static size_t _writebuf_force(ios_t *s, char *data, size_t n)
         }
         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 @@ size_t ios_read(ios_t *s, char *dest, size_t n, int all)
             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_read(ios_t *s, char *dest, size_t n, int all)
 
 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 @@ off_t ios_pos(ios_t *s)
 
 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 @@ int ios_eof(ios_t *s)
         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,14 +425,18 @@ int ios_flush(ios_t *s)
     }
 
     size_t nw, ntowrite=s->ndirty;
-    // todo: this should use sendall
+    int err = _os_write_all(s->fd, s->buf, ntowrite, &nw);
-    int err = _os_write(s->fd, s->buf, ntowrite, &nw);
     // todo: try recovering from some kinds of errors (e.g. retry)
 
     if (s->state == bst_rd) {
         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 @@ void ios_close(ios_t *s)
     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 @@ char *ios_takebuf(ios_t *s, size_t *psize)
     *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) {
+    _buf_init(s, s->bm);
-        s->buf = &s->local[0];
-        s->maxsize = IOS_INLSIZE;
-    }
-    else {
-        s->buf = NULL;
-        _buf_realloc(s, IOS_BUFSIZE);
-    }
-    s->size = s->bpos = 0;
 
     return buf;
 }
@@ -455,10 +534,20 @@ void ios_bswap(ios_t *s, int bswap)
     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);
+}
+
 
 /* stream object initializers. we do no allocation. */
 

llt/ios.h

@@ -41,6 +41,7 @@ typedef struct {
     //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 @@ typedef struct {
     // 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 @@ char *ios_takebuf(ios_t *s, size_t *psize);  // release buffer to caller
 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 @@ int ios_prevutf8(ios_t *s);
 /* 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))
 
 /*

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 i64time()
     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 @@ double clock_now()
 #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 @@ void timestring(double seconds, char *buffer, size_t len)
     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;