diff --git a/femtolisp/builtins.c b/femtolisp/builtins.c index fdd14e9..4931ac4 100644 --- a/femtolisp/builtins.c +++ b/femtolisp/builtins.c @@ -332,7 +332,6 @@ value_t fl_rand32(value_t *args, u_int32_t nargs) #ifdef BITS64 return fixnum(r); #else - if (fits_fixnum(r)) return fixnum(r); return mk_uint32(r); #endif } @@ -340,9 +339,6 @@ value_t fl_rand64(value_t *args, u_int32_t nargs) { (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) diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index f2b2b12..4b18502 100644 --- a/femtolisp/cvalues.c +++ b/femtolisp/cvalues.c @@ -16,7 +16,7 @@ static int struct_aligns[8] = { sizeof(struct { char a; int64_t i; }) }; static int ALIGN2, ALIGN4, ALIGN8, ALIGNPTR; -typedef void (*cvinitfunc_t)(value_t*, u_int32_t, void*, void*); +typedef void (*cvinitfunc_t)(value_t, value_t, void*, void*); value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym; value_t int64sym, uint64sym; @@ -30,7 +30,7 @@ value_t unionsym; value_t autoreleasesym, typeofsym, sizeofsym; -static void cvalue_init(value_t type, value_t *vs, u_int32_t nv, void *dest); +static void cvalue_init(value_t type, value_t v, void *dest); void cvalue_print(ios_t *f, value_t v, int princ); // exported guest functions @@ -239,39 +239,45 @@ static double strtodouble(char *str, char *fname) } #define num_ctor(typenam, cnvt, tag, fromstr) \ -static void cvalue_##typenam##_init(value_t *args, u_int32_t nargs, \ +static void cvalue_##typenam##_init(value_t type, value_t arg, \ void *dest, void *data) \ { \ typenam##_t n=0; \ - (void)data; \ - if (nargs) { \ - if (iscvalue(args[0])) { \ - cvalue_t *cv = (cvalue_t*)ptr(args[0]); \ - void *p = cv_data(cv); \ - if (valid_numtype(cv_numtype(cv))) { \ - n = (typenam##_t)conv_to_##cnvt(p, cv_numtype(cv)); \ - } \ - else if (cv->flags.cstring) { \ - n = fromstr(p, #typenam); \ - } \ - else if (cv_len(cv) == sizeof(typenam##_t)) { \ - n = *(typenam##_t*)p; \ - } \ - else { \ - type_error(#typenam, "number", args[0]); \ - } \ + (void)data; (void)type; \ + if (isfixnum(arg)) { \ + n = numval(arg); \ + } \ + else if (iscvalue(arg)) { \ + cvalue_t *cv = (cvalue_t*)ptr(arg); \ + void *p = cv_data(cv); \ + if (valid_numtype(cv_numtype(cv))) { \ + n = (typenam##_t)conv_to_##cnvt(p, cv_numtype(cv)); \ + } \ + else if (cv->flags.cstring) { \ + n = fromstr(p, #typenam); \ + } \ + else if (cv_len(cv) == sizeof(typenam##_t)) { \ + n = *(typenam##_t*)p; \ } \ else { \ - n = tofixnum(args[0], #typenam); \ + goto cnvt_error; \ } \ } \ + else { \ + goto cnvt_error; \ + } \ *((typenam##_t*)dest) = n; \ + return; \ + cnvt_error: \ + type_error(#typenam, "number", arg); \ } \ value_t cvalue_##typenam(value_t *args, u_int32_t nargs) \ { \ + if (nargs==0) { PUSH(fixnum(0)); args = &Stack[SP-1]; } \ value_t cv = cvalue(typenam##sym, sizeof(typenam##_t)); \ ((cprim_t*)ptr(cv))->flags.numtype = tag; \ - cvalue_##typenam##_init(args, nargs, &((cprim_t*)ptr(cv))->data, 0); \ + cvalue_##typenam##_init(typenam##sym, \ + args[0], &((cprim_t*)ptr(cv))->data, 0); \ return cv; \ } \ value_t mk_##typenam(typenam##_t n) \ @@ -332,20 +338,18 @@ value_t char_from_code(uint32_t code) return cvalue_char(&ccode, 1); } -static void cvalue_enum_init(value_t *args, u_int32_t nargs, void *dest, - void *data) +static void cvalue_enum_init(value_t type, value_t arg, void *dest, void *data) { int n=0; value_t syms; (void)data; - argcount("enum", nargs, 2); - syms = args[0]; + syms = car(cdr(type)); if (!iscons(syms)) type_error("enum", "cons", syms); - if (issymbol(args[1])) { + if (issymbol(arg)) { while (iscons(syms)) { - if (car_(syms) == args[1]) { + if (car_(syms) == arg) { *(int*)dest = n; return; } @@ -354,13 +358,13 @@ static void cvalue_enum_init(value_t *args, u_int32_t nargs, void *dest, } lerror(ArgError, "enum: invalid enum value"); } - if (isfixnum(args[1])) { - n = (int)numval(args[1]); + if (isfixnum(arg)) { + n = (int)numval(arg); } - else if (iscvalue(args[1])) { - cvalue_t *cv = (cvalue_t*)ptr(args[1]); + else if (iscvalue(arg)) { + cvalue_t *cv = (cvalue_t*)ptr(arg); if (!valid_numtype(cv_numtype(cv))) - type_error("enum", "number", args[1]); + type_error("enum", "number", arg); n = conv_to_int32(cv_data(cv), cv_numtype(cv)); } if ((unsigned)n >= llength(syms)) @@ -373,105 +377,112 @@ value_t cvalue_enum(value_t *args, u_int32_t nargs) argcount("enum", nargs, 2); value_t cv = cvalue(list2(enumsym, args[0]), 4); ((cvalue_t*)ptr(cv))->flags.numtype = T_INT32; - cvalue_enum_init(args, nargs, cv_data((cvalue_t*)ptr(cv)), NULL); + cvalue_enum_init(cv_type((cvalue_t*)ptr(cv)), + args[1], cv_data((cvalue_t*)ptr(cv)), NULL); return cv; } -static void cvalue_array_init(value_t *args, u_int32_t nargs, void *dest, - void *data) +static void array_init_fromargs(char *dest, value_t *vals, size_t cnt, + value_t eltype, size_t elsize) { - size_t cnt=0, elsize, i; - value_t *init = NULL; + size_t i; + for(i=0; i < cnt; i++) { + cvalue_init(eltype, vals[i], dest); + dest += elsize; + } +} + +static int isarray(value_t v) +{ + if (!iscvalue(v)) return 0; + value_t type = cv_type((cvalue_t*)ptr(v)); + return (iscons(type) && car_(type)==arraysym); +} + +static size_t predict_arraylen(value_t arg) +{ + if (isvector(arg)) + return vector_size(arg); + else if (iscons(arg)) + return llength(arg); + else if (arg == NIL) + return 0; + if (isarray(arg)) + return cvalue_arraylen(arg); + return 1; +} + +static void cvalue_array_init(value_t type, value_t arg, void *dest, void *data) +{ + size_t elsize, i, cnt, sz; int junk; + value_t eltype = car(cdr(type)); if (data != 0) elsize = (size_t)data; // already computed by constructor else - elsize = ctype_sizeof(args[0], &junk); - char *out = (char*)dest; + elsize = ctype_sizeof(eltype, &junk); - if (nargs == 2) { - if (isvector(args[1]) || iscons(args[1]) || args[1]==NIL) - init = &args[1]; - else - cnt = toulong(args[1], "array"); + cnt = predict_arraylen(arg); + + if (iscons(cdr_(cdr_(type)))) { + size_t tc = toulong(car_(cdr_(cdr_(type))), "array"); + if (tc != cnt) + lerror(ArgError, "array: size mismatch"); } - else if (nargs == 3) { - cnt = toulong(args[1], "array"); - init = &args[2]; + + sz = elsize * cnt; + + if (isvector(arg)) { + array_init_fromargs((char*)dest, &vector_elt(arg,0), cnt, + eltype, elsize); + return; } - else { - argcount("array", nargs, 2); - } - if (init) { - if (isvector(*init)) { - if (cnt && vector_size(*init) != cnt) - lerror(ArgError, "array: size mismatch"); - cnt = vector_size(*init); - for(i=0; i < cnt; i++) { - cvalue_init(args[0], &vector_elt(*init, i), 1, out); - out += elsize; - } - return; + else if (iscons(arg) || arg==NIL) { + i = 0; + while (iscons(arg)) { + if (SP >= N_STACK) + break; + PUSH(car_(arg)); + i++; + arg = cdr_(arg); } - else if (iscons(*init) || *init==NIL) { - for(i=0; i < cnt || cnt==0; i++) { - if (!iscons(*init)) { - if (cnt != 0) - lerror(ArgError, "array: size mismatch"); - else - break; - } - cvalue_init(args[0], &car_(*init), 1, out); - out += elsize; - *init = cdr_(*init); - } - return; - } - else if (iscvalue(*init)) { - cvalue_t *cv = (cvalue_t*)ptr(*init); - size_t tot = cnt*elsize; - if (tot == cv_len(cv)) { - if (tot) memcpy(out, cv_data(cv), tot); + if (i != cnt) + lerror(ArgError, "array: size mismatch"); + array_init_fromargs((char*)dest, &Stack[SP-i], i, eltype, elsize); + POPN(i); + return; + } + else if (iscvalue(arg)) { + cvalue_t *cv = (cvalue_t*)ptr(arg); + if (isarray(arg)) { + value_t aet = car(cdr(cv_type(cv))); + if (aet == eltype) { + if (cv_len(cv) == sz) + memcpy(dest, cv_data(cv), sz); + else + lerror(ArgError, "array: size mismatch"); return; } + else { + // TODO: initialize array from different type elements + lerror(ArgError, "array: element type mismatch"); + } } - else { - type_error("array", "cons", *init); - } - lerror(ArgError, "array: invalid size"); } -} - -static size_t predict_arraylen(value_t *args, u_int32_t nargs, size_t *elsz) -{ - int junk; - size_t cnt; - - if (nargs < 2) - argcount("array", nargs, 2); - *elsz = ctype_sizeof(args[0], &junk); - if (isvector(args[1])) { - cnt = vector_size(args[1]); - } - else if (iscons(args[1])) { - cnt = llength(args[1]); - } - else if (args[1] == NIL) { - cnt = 0; - } - else { - cnt = toulong(args[1], "array"); - } - return cnt; + if (cnt == 1) + cvalue_init(eltype, arg, dest); + else + type_error("array", "sequence", arg); } static value_t alloc_array(value_t type, size_t sz) { value_t cv; if (car_(cdr_(type)) == charsym) { + PUSH(type); cv = cvalue_string(sz); - ((cvalue_t*)ptr(cv))->type = type; + ((cvalue_t*)ptr(cv))->type = POP(); } else { cv = cvalue(type, sz); @@ -482,12 +493,18 @@ static value_t alloc_array(value_t type, size_t sz) value_t cvalue_array(value_t *args, u_int32_t nargs) { size_t elsize, cnt, sz; + int junk; - cnt = predict_arraylen(args, nargs, &elsize); + if (nargs < 1) + argcount("array", nargs, 1); + + cnt = nargs - 1; + elsize = ctype_sizeof(args[0], &junk); sz = elsize * cnt; value_t cv = alloc_array(listn(3, arraysym, args[0], size_wrap(cnt)), sz); - cvalue_array_init(args, nargs, cv_data((cvalue_t*)ptr(cv)), (void*)elsize); + array_init_fromargs(cv_data((cvalue_t*)ptr(cv)), &args[1], cnt, + args[0], elsize); return cv; } @@ -683,33 +700,24 @@ value_t cvalue_copy(value_t v) return tagptr(pnv, TAG_CVALUE); } -static void cvalue_init(value_t type, value_t *vs, u_int32_t nv, void *dest) +static void cvalue_init(value_t type, value_t v, void *dest) { cvinitfunc_t f; - unsigned int i, na=0; if (issymbol(type)) { f = ((symbol_t*)ptr(type))->dlcache; } - else if (!iscons(type)) { - f = NULL; - lerror(ArgError, "c-value: invalid c type"); - } - else { + else if (iscons(type)) { value_t head = car_(type); f = ((symbol_t*)ptr(head))->dlcache; - type = cdr_(type); - while (iscons(type)) { - PUSH(car_(type)); - na++; - type = cdr_(type); - } } - for(i=0; i < nv; i++) - PUSH(vs[i]); - na += nv; - f(&Stack[SP-na], na, dest, NULL); - POPN(na); + else { + f = NULL; + } + if (f == NULL) + lerror(ArgError, "c-value: invalid c type"); + + f(type, v, dest, NULL); } static numerictype_t sym_to_numtype(value_t type) @@ -756,29 +764,26 @@ static numerictype_t sym_to_numtype(value_t type) // type, including user-defined. value_t cvalue_new(value_t *args, u_int32_t nargs) { - if (nargs < 1) - argcount("c-value", nargs, 1); + if (nargs < 1 || nargs > 2) + argcount("c-value", nargs, 2); value_t type = args[0]; value_t cv; if (iscons(type) && car_(type) == arraysym) { // special case to handle incomplete array types bla[] - size_t elsz; - value_t c = cdr_(type); - int na=0; - while (iscons(c)) { - PUSH(car_(c)); - c = cdr_(c); - na++; - } - if (nargs > 1) { - PUSH(args[1]); - na++; - } - size_t cnt = predict_arraylen(&Stack[SP-na], na, &elsz); + value_t eltype = car(cdr_(type)); + int junk; + size_t elsz = ctype_sizeof(eltype, &junk); + size_t cnt; + if (iscons(cdr_(cdr_(type)))) + cnt = toulong(car_(cdr_(cdr_(type))), "array"); + else if (nargs == 2) + cnt = predict_arraylen(args[1]); + else + cnt = 0; cv = alloc_array(type, elsz * cnt); - cvalue_array_init(&Stack[SP-na], na, cv_data((cvalue_t*)ptr(cv)), - (void*)elsz); - POPN(na); + if (nargs == 2) + cvalue_array_init(type, args[1], cv_data((cvalue_t*)ptr(cv)), + (void*)elsz); } else { int junk; @@ -786,7 +791,8 @@ value_t cvalue_new(value_t *args, u_int32_t nargs) if (issymbol(type)) { ((cvalue_t*)ptr(cv))->flags.numtype = sym_to_numtype(type); } - cvalue_init(type, &args[1], nargs-1, cv_data((cvalue_t*)ptr(cv))); + if (nargs == 2) + cvalue_init(type, args[1], cv_data((cvalue_t*)ptr(cv))); } return cv; } diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index 8f3309e..b37e466 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -1433,7 +1433,7 @@ value_t load_file(char *fname) FL_TRY { while (1) { e = read_sexpr(f); - //print(ios_stdout,e,0); ios_puts("\n", ios_stdout); + //print(ios_stdout,e,0); ios_putc('\n', ios_stdout); if (ios_eof(f)) break; v = toplevel_eval(e); } @@ -1497,6 +1497,6 @@ int main(int argc, char *argv[]) set(symbol("that"), v); ios_puts("\n\n", ios_stdout); } - ios_puts("\n", ios_stdout); + ios_putc('\n', ios_stdout); return 0; } diff --git a/femtolisp/print.c b/femtolisp/print.c index 9ea009a..54292d7 100644 --- a/femtolisp/print.c +++ b/femtolisp/print.c @@ -530,18 +530,22 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type, if (!weak) { outs("#array(", f); do_print(f, eltype, princ); - outc(' ', f); - } - outc('[', f); - for(i=0; i < cnt; i++) { - cvalue_printdata(f, data, elsize, eltype, princ, 1); - if (i < cnt-1) + if (cnt > 0) outc(' ', f); + } + else { + outc('[', f); + } + for(i=0; i < cnt; i++) { + if (i > 0) + outc(' ', f); + cvalue_printdata(f, data, elsize, eltype, princ, 1); data += elsize; } - outc(']', f); if (!weak) outc(')', f); + else + outc(']', f); } else if (car_(type) == enumsym) { value_t sym = list_nth(car(cdr_(type)), *(size_t*)data); diff --git a/femtolisp/todo b/femtolisp/todo index 95f9058..f2b1db1 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -149,15 +149,14 @@ typedef struct _cvtable_t { void (*print)(struct _cvalue_t *, FILE *); } cvtable_t; -; remember: variable-length data preferred over variable-length arglists - c type representations: symbols void, [u]int[8,16,32,64], float, double, [u]char, [u]short, [u]int, [u]long, lispvalue (c-function ret-type (argtype ...)) -(array type N) +(array type[ N]) (struct ((name type) (name type) ...)) (union ((name type) (name type) ...)) +(mlayout ((name type offset) (name type offset) ...)) (enum (name1 name2 ...)) (pointer type) @@ -167,8 +166,8 @@ constructors: ([u]int64 b3 b2 b1 b0) (float hi lo) or (float "3.14") (double b3 b2 b1 b0) or (double "3.14") -(array ctype (val ...)) -(struct ((name type) ...) (val ...)) +(array ctype val ...) +(struct ((name type) ...) val ...) (pointer ctype) ; null pointer (pointer cvalue) ; constructs pointer to the given value ; same as (pointer (typeof x) x) @@ -243,11 +242,27 @@ should be related formally: (if (symbolp type) (apply (eval type) ()) (apply (eval (car type)) (cdr type)))) +NOTE: this relationship is no longer true. we don't want to have to +construct 1 cvalue from 1 lisp value every time, since that could +require allocating a totally redundant list or vector. it should be +possible to make a cvalue from a series of lisp arguments. for +example there are now 2 different ways to make an array: + +1) from series of arguments: (array type val0 val1 ...) +2) from 1 (optional) value: (c-value '(array int8[ size])[ V]) + +constructors will internally use the second form to initialize elements +of aggregates. e.g. 'array' in the first case will conceptually call + (c-value type val0) + (c-value type val1) + ... + + for aggregate types, you can keep a variable referring to the relevant piece: (setq point '((x int) (y int))) -(struct point [2 3]) ; looks like c declaration 'struct point x;' +(struct point 2 3) ; looks like c declaration 'struct point x;' a type is a function, so something similar to typedef is achieved by: @@ -373,10 +388,10 @@ then we can write the vector clause in backquote as e.g. setup plan: -- create source directory and svn repository, move llt sources into it +* create source directory and svn repository, move llt sources into it * write femtolisp.h, definitions for extensions to #include - add fl_ prefix to all exported functions -- port read and print to jclib's iostreams +* port read and print to llt iostreams * get rid of flutils; use ptrhash instead * builtinp needs to be a builtin ;) to distinguish lisp builtins from cvalues * allocation and gc for cvalues @@ -585,6 +600,10 @@ cvalues todo: - anonymous unions * fix princ for cvalues - make header size for primitives 8 bytes, even on 64-bit arch +- more efficient read for #array(), so it doesn't need to build a pairlist +- make sure shared pieces of types, like lists of enum values, can be + printed as shared structure to avoid duplication. +- share more types, allocate less - string constructor/concatenator: (string 'sym #char(65) #wchar(945) "blah" 23) @@ -797,23 +816,30 @@ String API IOStream API - read + read - (read[ stream]) ; get next sexpr from stream print, sprint princ, sprinc - stream - (stream cvalue-as-bytestream) + iostream - (stream[ cvalue-as-bytestream]) file fifo socket stream.eof - stream.write - (stream.write cvalue) - stream.read - (stream.read ctype) + stream.write - (stream.write s cvalue) + stream.read - (stream.read s ctype) stream.copy - (stream.copy to from [nbytes]) stream.copyuntil - (stream.copy to from byte) stream.flush stream.pos - (stream.pos s [set-pos]) stream.seek - (stream.seek s offset) + stream.seekend - move to end of stream stream.trunc stream.getc - get utf8 character(s) + stream.tostring! - destructively convert stringstream to string + stream.readline + stream.readlines + stream.readall + print-to-string + princ-to-string path.combine @@ -840,9 +866,11 @@ IOStream API *rand +*randn *rand.uint32 *rand.uint64 *rand.double +*rand.float ----------------------------------------------------------------------------- @@ -880,3 +908,5 @@ switch to miser mode, otherwise default is ok, for example: * *print-pretty* to control it - if indent gets too large, dedent back to left edge + +----------------------------------------------------------------------------- diff --git a/llt/ios.c b/llt/ios.c index 1127a87..7acd75f 100644 --- a/llt/ios.c +++ b/llt/ios.c @@ -189,7 +189,7 @@ static char *_buf_realloc(ios_t *s, size_t sz) // write a block of data into the buffer at the current position, resizing // if necessary. returns # written. -static size_t _writebuf_force(ios_t *s, char *data, size_t n) +static size_t _write_grow(ios_t *s, char *data, size_t n) { size_t amt; size_t newsize; @@ -249,15 +249,14 @@ static size_t _ios_read(ios_t *s, char *dest, size_t n, int all) s->bpos += avail; return avail; } - else { - dest += avail; - n -= avail; - tot += avail; - - ios_flush(s); - s->bpos = s->size = 0; - s->state = bst_rd; - } + + dest += avail; + n -= avail; + tot += avail; + + ios_flush(s); + s->bpos = s->size = 0; + s->state = bst_rd; if (n > MOST_OF(s->maxsize)) { // doesn't fit comfortably in buffer; go direct @@ -321,6 +320,12 @@ size_t ios_readprep(ios_t *s, size_t n) return s->size - s->bpos; } +static void _write_update_pos(ios_t *s) +{ + if (s->bpos > s->ndirty) s->ndirty = s->bpos; + if (s->bpos > s->size) s->size = s->bpos; +} + size_t ios_write(ios_t *s, char *data, size_t n) { if (n == 0) return 0; @@ -334,7 +339,7 @@ size_t ios_write(ios_t *s, char *data, size_t n) space = s->size - s->bpos; if (s->bm == bm_mem) { - wrote = _writebuf_force(s, data, n); + wrote = _write_grow(s, data, n); } else if (s->bm == bm_none) { int result = _os_write_all(s->fd, data, n, &wrote); @@ -366,10 +371,7 @@ size_t ios_write(ios_t *s, char *data, size_t n) } return ios_write(s, data, n); } - if (s->bpos > s->ndirty) - s->ndirty = s->bpos; - if (s->bpos > s->size) - s->size = s->bpos; + _write_update_pos(s); return wrote; } @@ -617,7 +619,7 @@ static void _ios_init(ios_t *s) s->tally = 0; s->fd = -1; s->byteswap = 0; - s->ownbuf = 0; + s->ownbuf = 1; s->ownfd = 0; s->_eof = 0; s->rereadable = 0; @@ -692,6 +694,13 @@ int ios_putc(int c, ios_t *s) { char ch = (char)c; + if (s->state == bst_wr && s->bpos < s->maxsize && s->bm != bm_none) { + s->buf[s->bpos++] = ch; + _write_update_pos(s); + if (s->bm == bm_line && ch == '\n') + ios_flush(s); + return 1; + } return (int)ios_write(s, &ch, 1); } @@ -754,17 +763,31 @@ int ios_getutf8(ios_t *s, uint32_t *pwc) int ios_printf(ios_t *s, char *format, ...) { - char buf[512]; - char *str=&buf[0]; + char *str=NULL; va_list args; int c; va_start(args, format); - // TODO: avoid copy - c = vsnprintf(buf, sizeof(buf), format, args); - if ((size_t)c >= sizeof(buf)) - c = vasprintf(&str, format, args); + if (s->state == bst_wr && s->bpos < s->maxsize && s->bm != bm_none) { + size_t avail = s->maxsize - s->bpos; + char *start = s->buf + s->bpos; + c = vsnprintf(start, avail, format, args); + if (c < 0) { + va_end(args); + return c; + } + if (c < avail) { + va_end(args); + s->bpos += (size_t)c; + _write_update_pos(s); + // TODO: only works right if newline is at end + if (s->bm == bm_line && memrchr(start, '\n', (size_t)c)) + ios_flush(s); + return c; + } + } + c = vasprintf(&str, format, args); va_end(args); @@ -772,6 +795,6 @@ int ios_printf(ios_t *s, char *format, ...) ios_write(s, str, c); - if (str != &buf[0]) free(str); + free(str); return c; }