conservatory
/
femtolisp
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

misc. fixes
more work on ios
This commit is contained in:
JeffBezanson 2008-08-16 21:15:36 +00:00
parent 6e515a532e
commit fa0e134dd8
9 changed files with 183 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
femtolisp/builtins.c
View File

@ -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)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 @@ 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));

1
femtolisp/flisp.h
View File

@ -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);

10
femtolisp/print.c
View File

@ -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;
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))

4
femtolisp/read.c
View File

@ -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]=='-') {

13
llt/hashing.c
View File

@ -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;
*pim = s * vim;
next = s * vre;
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);

2
llt/hashing.h
View File

@ -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();

129
llt/ios.c
View File

@ -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(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) {
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) {
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,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. */

14
llt/ios.h
View File

@ -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))
/*

18
llt/timefuncs.c
View File

@ -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;