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

adding more ios functions 

porting femtolisp to use ios for all I/O
This commit is contained in:
JeffBezanson 2008-08-17 18:16:31 +00:00
parent 755bb33714
commit 9acdf313b9
12 changed files with 222 additions and 200 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
femtolisp/builtins.c
View File

@ -39,8 +39,8 @@ value_t fl_print(value_t *args, u_int32_t nargs)
{ {
unsigned i; unsigned i;
for (i=0; i < nargs; i++) for (i=0; i < nargs; i++)
print(stdout, args[i], 0); print(ios_stdout, args[i], 0);
fputc('\n', stdout); ios_putc('\n', ios_stdout);
return nargs ? args[nargs-1] : NIL; return nargs ? args[nargs-1] : NIL;
} }
@ -48,7 +48,7 @@ value_t fl_princ(value_t *args, u_int32_t nargs)
{ {
unsigned i; unsigned i;
for (i=0; i < nargs; i++) for (i=0; i < nargs; i++)
print(stdout, args[i], 1); print(ios_stdout, args[i], 1);
return nargs ? args[nargs-1] : NIL; return nargs ? args[nargs-1] : NIL;
} }
@ -56,7 +56,7 @@ value_t fl_read(value_t *args, u_int32_t nargs)
{ {
(void)args; (void)args;
argcount("read", nargs, 0); argcount("read", nargs, 0);
return read_sexpr(stdin); return read_sexpr(ios_stdin);
} }
value_t fl_load(value_t *args, u_int32_t nargs) value_t fl_load(value_t *args, u_int32_t nargs)

2
femtolisp/cvalues.c
View File

@ -32,7 +32,7 @@ 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 *vs, u_int32_t nv, void *dest);
void cvalue_print(FILE *f, value_t v, int princ); void cvalue_print(ios_t *f, value_t v, int princ);
// exported guest functions // exported guest functions
value_t cvalue_new(value_t *args, u_int32_t nargs); value_t cvalue_new(value_t *args, u_int32_t nargs);
value_t cvalue_sizeof(value_t *args, u_int32_t nargs); value_t cvalue_sizeof(value_t *args, u_int32_t nargs);

56
femtolisp/flisp.c
View File

@ -84,7 +84,7 @@ value_t defunsym, defmacrosym, forsym, labelsym, printprettysym;
static value_t eval_sexpr(value_t e, uint32_t penv, int tail); static value_t eval_sexpr(value_t e, uint32_t penv, int tail);
static value_t *alloc_words(int n); static value_t *alloc_words(int n);
static value_t relocate(value_t v); static value_t relocate(value_t v);
static void do_print(FILE *f, value_t v, int princ); static void do_print(ios_t *f, value_t v, int princ);
typedef struct _readstate_t { typedef struct _readstate_t {
ptrhash_t backrefs; ptrhash_t backrefs;
@ -1389,62 +1389,64 @@ static void print_toplevel_exception()
{ {
if (iscons(lasterror) && car_(lasterror) == TypeError && if (iscons(lasterror) && car_(lasterror) == TypeError &&
llength(lasterror) == 4) { llength(lasterror) == 4) {
fprintf(stderr, "type-error: "); ios_printf(ios_stderr, "type-error: ");
print(stderr, car_(cdr_(lasterror)), 1); print(ios_stderr, car_(cdr_(lasterror)), 1);
fprintf(stderr, ": expected "); ios_printf(ios_stderr, ": expected ");
print(stderr, car_(cdr_(cdr_(lasterror))), 1); print(ios_stderr, car_(cdr_(cdr_(lasterror))), 1);
fprintf(stderr, ", got "); ios_printf(ios_stderr, ", got ");
print(stderr, car_(cdr_(cdr_(cdr_(lasterror)))), 0); print(ios_stderr, car_(cdr_(cdr_(cdr_(lasterror)))), 0);
} }
else if (iscons(lasterror) && car_(lasterror) == UnboundError && else if (iscons(lasterror) && car_(lasterror) == UnboundError &&
iscons(cdr_(lasterror))) { iscons(cdr_(lasterror))) {
fprintf(stderr, "unbound-error: eval: variable %s has no value", ios_printf(ios_stderr, "unbound-error: eval: variable %s has no value",
(symbol_name(car_(cdr_(lasterror))))); (symbol_name(car_(cdr_(lasterror)))));
} }
else if (iscons(lasterror) && car_(lasterror) == Error) { else if (iscons(lasterror) && car_(lasterror) == Error) {
value_t v = cdr_(lasterror); value_t v = cdr_(lasterror);
fprintf(stderr, "error: "); ios_printf(ios_stderr, "error: ");
while (iscons(v)) { while (iscons(v)) {
print(stderr, car_(v), 1); print(ios_stderr, car_(v), 1);
v = cdr_(v); v = cdr_(v);
} }
} }
else { else {
if (lasterror != NIL) { if (lasterror != NIL) {
if (!lerrorbuf[0]) if (!lerrorbuf[0])
fprintf(stderr, "*** Unhandled exception: "); ios_printf(ios_stderr, "*** Unhandled exception: ");
print(stderr, lasterror, 0); print(ios_stderr, lasterror, 0);
if (lerrorbuf[0]) if (lerrorbuf[0])
fprintf(stderr, ": "); ios_printf(ios_stderr, ": ");
} }
} }
if (lerrorbuf[0]) if (lerrorbuf[0])
fprintf(stderr, "%s", lerrorbuf); ios_printf(ios_stderr, "%s", lerrorbuf);
} }
value_t load_file(char *fname) value_t load_file(char *fname)
{ {
value_t volatile e, v=NIL; value_t volatile e, v=NIL;
FILE * volatile f = fopen(fname, "r"); ios_t fi;
ios_t * volatile f;
f = &fi; f = ios_file(f, fname, 0, 0);
if (f == NULL) lerror(IOError, "file \"%s\" not found", fname); if (f == NULL) lerror(IOError, "file \"%s\" not found", fname);
FL_TRY { FL_TRY {
while (1) { while (1) {
e = read_sexpr(f); e = read_sexpr(f);
//print(stdout,e,0); printf("\n"); //print(ios_stdout,e,0); ios_puts("\n", ios_stdout);
if (feof(f)) break; if (ios_eof(f)) break;
v = toplevel_eval(e); v = toplevel_eval(e);
} }
} }
FL_CATCH { FL_CATCH {
fclose(f); ios_close(f);
size_t msglen = strlen(lerrorbuf); size_t msglen = strlen(lerrorbuf);
snprintf(&lerrorbuf[msglen], sizeof(lerrorbuf)-msglen, snprintf(&lerrorbuf[msglen], sizeof(lerrorbuf)-msglen,
"\nin file \"%s\"", fname); "\nin file \"%s\"", fname);
lerrorbuf[sizeof(lerrorbuf)-1] = '\0'; lerrorbuf[sizeof(lerrorbuf)-1] = '\0';
raise(lasterror); raise(lasterror);
} }
fclose(f); ios_close(f);
return v; return v;
} }
@ -1477,7 +1479,7 @@ int main(int argc, char *argv[])
lerrorbuf[0] = '\0'; lerrorbuf[0] = '\0';
lasterror = NIL; lasterror = NIL;
fprintf(stderr, "\n\n"); ios_puts("\n\n", ios_stderr);
goto repl; goto repl;
} }
load_file("system.lsp"); load_file("system.lsp");
@ -1488,13 +1490,13 @@ int main(int argc, char *argv[])
printf(";-------------------|----------------------------------------------------------\n\n"); printf(";-------------------|----------------------------------------------------------\n\n");
repl: repl:
while (1) { while (1) {
printf("> "); ios_puts("> ", ios_stdout); ios_flush(ios_stdout);
v = read_sexpr(stdin); v = read_sexpr(ios_stdin);
if (feof(stdin)) break; if (ios_eof(ios_stdin)) break;
print(stdout, v=toplevel_eval(v), 0); print(ios_stdout, v=toplevel_eval(v), 0);
set(symbol("that"), v); set(symbol("that"), v);
printf("\n\n"); ios_puts("\n\n", ios_stdout);
} }
printf("\n"); ios_puts("\n", ios_stdout);
return 0; return 0;
} }

4
femtolisp/flisp.h
View File

@ -105,8 +105,8 @@ enum {
extern value_t NIL, T; extern value_t NIL, T;
/* read, eval, print main entry points */ /* read, eval, print main entry points */
value_t read_sexpr(FILE *f); value_t read_sexpr(ios_t *f);
void print(FILE *f, value_t v, int princ); void print(ios_t *f, value_t v, int princ);
value_t toplevel_eval(value_t expr); value_t toplevel_eval(value_t expr);
value_t apply(value_t f, value_t l); value_t apply(value_t f, value_t l);
value_t load_file(char *fname); value_t load_file(char *fname);

90
femtolisp/print.c
View File

@ -3,27 +3,27 @@ static u_int32_t printlabel;
static int print_pretty; static int print_pretty;
static int HPOS, VPOS; static int HPOS, VPOS;
static void outc(char c, FILE *f) static void outc(char c, ios_t *f)
{ {
fputc(c, f); ios_putc(c, f);
HPOS++; HPOS++;
} }
static void outs(char *s, FILE *f) static void outs(char *s, ios_t *f)
{ {
fputs(s, f); ios_puts(s, f);
HPOS += u8_strwidth(s); HPOS += u8_strwidth(s);
} }
static void outindent(int n, FILE *f) static void outindent(int n, ios_t *f)
{ {
fputc('\n', f); ios_putc('\n', f);
VPOS++; VPOS++;
HPOS = n; HPOS = n;
while (n >= 8) { while (n >= 8) {
fputc('\t', f); ios_putc('\t', f);
n -= 8; n -= 8;
} }
while (n) { while (n) {
fputc(' ', f); ios_putc(' ', f);
n--; n--;
} }
} }
@ -65,7 +65,7 @@ static void print_traverse(value_t v)
} }
} }
static void print_symbol_name(FILE *f, char *name) static void print_symbol_name(ios_t *f, char *name)
{ {
int i, escape=0, charescape=0; int i, escape=0, charescape=0;
@ -202,7 +202,7 @@ static int blockindent(value_t v)
return (allsmallp(v) > 9); return (allsmallp(v) > 9);
} }
static void print_pair(FILE *f, value_t v, int princ) static void print_pair(ios_t *f, value_t v, int princ)
{ {
value_t cd; value_t cd;
char *op = NULL; char *op = NULL;
@ -286,16 +286,16 @@ static void print_pair(FILE *f, value_t v, int princ)
} }
} }
void cvalue_print(FILE *f, value_t v, int princ); void cvalue_print(ios_t *f, value_t v, int princ);
static void do_print(FILE *f, value_t v, int princ) static void do_print(ios_t *f, value_t v, int princ)
{ {
value_t label; value_t label;
char *name; char *name;
switch (tag(v)) { switch (tag(v)) {
case TAG_NUM : case TAG_NUM :
case TAG_NUM1: HPOS+=fprintf(f, "%ld", numval(v)); break; case TAG_NUM1: HPOS+=ios_printf(f, "%ld", numval(v)); break;
case TAG_SYM: case TAG_SYM:
name = symbol_name(v); name = symbol_name(v);
if (princ) if (princ)
@ -323,10 +323,10 @@ static void do_print(FILE *f, value_t v, int princ)
if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) != if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) !=
(value_t)PH_NOTFOUND) { (value_t)PH_NOTFOUND) {
if (!ismarked(v)) { if (!ismarked(v)) {
HPOS+=fprintf(f, "#%ld#", numval(label)); HPOS+=ios_printf(f, "#%ld#", numval(label));
return; return;
} }
HPOS+=fprintf(f, "#%ld=", numval(label)); HPOS+=ios_printf(f, "#%ld=", numval(label));
} }
if (isvector(v)) { if (isvector(v)) {
outc('[', f); outc('[', f);
@ -362,7 +362,7 @@ static void do_print(FILE *f, value_t v, int princ)
} }
} }
void print_string(FILE *f, char *str, size_t sz) void print_string(ios_t *f, char *str, size_t sz)
{ {
char buf[512]; char buf[512];
size_t i = 0; size_t i = 0;
@ -381,7 +381,7 @@ static numerictype_t sym_to_numtype(value_t type);
// for example #int32(0) can be printed as just 0. this is used // for example #int32(0) can be printed as just 0. this is used
// printing in a context where a type is already implied, e.g. inside // printing in a context where a type is already implied, e.g. inside
// an array. // an array.
static void cvalue_printdata(FILE *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 princ, int weak) int princ, int weak)
{ {
int64_t tmp=0; int64_t tmp=0;
@ -392,11 +392,11 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
if (princ) if (princ)
outc(ch, f); outc(ch, f);
else if (weak) else if (weak)
HPOS+=fprintf(f, "%hhu", ch); HPOS+=ios_printf(f, "%hhu", ch);
else if (isprint(ch)) else if (isprint(ch))
HPOS+=fprintf(f, "#\\%c", ch); HPOS+=ios_printf(f, "#\\%c", ch);
else else
HPOS+=fprintf(f, "#char(%hhu)", ch); HPOS+=ios_printf(f, "#char(%hhu)", ch);
} }
/* /*
else if (type == ucharsym) { else if (type == ucharsym) {
@ -405,8 +405,8 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
outc(ch, f); outc(ch, f);
else { else {
if (!weak) if (!weak)
fprintf(f, "#uchar("); ios_printf(f, "#uchar(");
fprintf(f, "%hhu", ch); ios_printf(f, "%hhu", ch);
if (!weak) if (!weak)
outs(")", f); outs(")", f);
} }
@ -416,7 +416,7 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
uint32_t wc = *(uint32_t*)data; uint32_t wc = *(uint32_t*)data;
char seq[8]; char seq[8];
if (weak) if (weak)
HPOS+=fprintf(f, "%d", (int)wc); HPOS+=ios_printf(f, "%d", (int)wc);
else if (princ || (iswprint(wc) && wc>0x7f)) { else if (princ || (iswprint(wc) && wc>0x7f)) {
// reader only reads #\c syntax as wchar if the code is >0x7f // reader only reads #\c syntax as wchar if the code is >0x7f
size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1); size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);
@ -426,7 +426,7 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
outs(seq, f); outs(seq, f);
} }
else { else {
HPOS+=fprintf(f, "#%s(%d)", symbol_name(type), (int)wc); HPOS+=ios_printf(f, "#%s(%d)", symbol_name(type), (int)wc);
} }
} }
else if (type == int64sym else if (type == int64sym
@ -437,14 +437,14 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
int64_t i64 = *(int64_t*)data; int64_t i64 = *(int64_t*)data;
if (fits_fixnum(i64) || princ) { if (fits_fixnum(i64) || princ) {
if (weak || princ) if (weak || princ)
HPOS+=fprintf(f, "%lld", i64); HPOS+=ios_printf(f, "%lld", i64);
else else
HPOS+=fprintf(f, "#%s(%lld)", symbol_name(type), i64); HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), i64);
} }
else else
HPOS+=fprintf(f, "#%s(0x%08x%08x)", symbol_name(type), HPOS+=ios_printf(f, "#%s(0x%08x%08x)", symbol_name(type),
(uint32_t)(i64>>32), (uint32_t)(i64>>32),
(uint32_t)(i64)); (uint32_t)(i64));
} }
else if (type == uint64sym else if (type == uint64sym
#ifdef BITS64 #ifdef BITS64
@ -454,14 +454,14 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
uint64_t ui64 = *(uint64_t*)data; uint64_t ui64 = *(uint64_t*)data;
if (fits_fixnum(ui64) || princ) { if (fits_fixnum(ui64) || princ) {
if (weak || princ) if (weak || princ)
HPOS+=fprintf(f, "%llu", ui64); HPOS+=ios_printf(f, "%llu", ui64);
else else
HPOS+=fprintf(f, "#%s(%llu)", symbol_name(type), ui64); HPOS+=ios_printf(f, "#%s(%llu)", symbol_name(type), ui64);
} }
else else
HPOS+=fprintf(f, "#%s(0x%08x%08x)", symbol_name(type), HPOS+=ios_printf(f, "#%s(0x%08x%08x)", symbol_name(type),
(uint32_t)(ui64>>32), (uint32_t)(ui64>>32),
(uint32_t)(ui64)); (uint32_t)(ui64));
} }
else if (type == lispvaluesym) { else if (type == lispvaluesym) {
// TODO // TODO
@ -479,9 +479,9 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
} }
else { else {
if (!DFINITE(d)) if (!DFINITE(d))
HPOS+=fprintf(f, "#%s(\"%s\")", symbol_name(type), buf); HPOS+=ios_printf(f, "#%s(\"%s\")", symbol_name(type), buf);
else else
HPOS+=fprintf(f, "#%s(%s)", symbol_name(type), buf); HPOS+=ios_printf(f, "#%s(%s)", symbol_name(type), buf);
} }
} }
else if (issymbol(type)) { else if (issymbol(type)) {
@ -490,13 +490,13 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
tmp = conv_to_int64(data, sym_to_numtype(type)); tmp = conv_to_int64(data, sym_to_numtype(type));
if (fits_fixnum(tmp) || princ) { if (fits_fixnum(tmp) || princ) {
if (weak || princ) if (weak || princ)
HPOS+=fprintf(f, "%lld", tmp); HPOS+=ios_printf(f, "%lld", tmp);
else else
HPOS+=fprintf(f, "#%s(%lld)", symbol_name(type), tmp); HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), tmp);
} }
else else
HPOS+=fprintf(f, "#%s(0x%08x)", symbol_name(type), HPOS+=ios_printf(f, "#%s(0x%08x)", symbol_name(type),
(uint32_t)(tmp&0xffffffff)); (uint32_t)(tmp&0xffffffff));
} }
else if (iscons(type)) { else if (iscons(type)) {
if (car_(type) == arraysym) { if (car_(type) == arraysym) {
@ -514,7 +514,7 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
} }
if (eltype == charsym) { if (eltype == charsym) {
if (princ) { if (princ) {
fwrite(data, 1, len, f); ios_write(f, data, len);
} }
else { else {
print_string(f, (char*)data, len); print_string(f, (char*)data, len);
@ -562,21 +562,21 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
} }
} }
void cvalue_print(FILE *f, value_t v, int princ) void cvalue_print(ios_t *f, value_t v, int princ)
{ {
cvalue_t *cv = (cvalue_t*)ptr(v); cvalue_t *cv = (cvalue_t*)ptr(v);
void *data = cv_data(cv); void *data = cv_data(cv);
if (cv->flags.islispfunction) { if (cv->flags.islispfunction) {
HPOS+=fprintf(f, "#<guestfunction @0x%08lx>", HPOS+=ios_printf(f, "#<guestfunction @0x%08lx>",
(unsigned long)*(guestfunc_t*)data); (unsigned long)*(guestfunc_t*)data);
return; return;
} }
cvalue_printdata(f, data, cv_len(cv), cv_type(cv), princ, 0); cvalue_printdata(f, data, cv_len(cv), cv_type(cv), princ, 0);
} }
void print(FILE *f, value_t v, int princ) void print(ios_t *f, value_t v, int princ)
{ {
print_pretty = (symbol_value(printprettysym) != NIL); print_pretty = (symbol_value(printprettysym) != NIL);
ptrhash_reset(&printconses, 32); ptrhash_reset(&printconses, 32);

96
femtolisp/read.c
View File

@ -55,21 +55,21 @@ static u_int32_t toktype = TOK_NONE;
static value_t tokval; static value_t tokval;
static char buf[256]; static char buf[256];
static char nextchar(FILE *f) static char nextchar(ios_t *f)
{ {
int ch; int ch;
char c; char c;
do { do {
ch = fgetc(f); ch = ios_getc(f);
if (ch == EOF) if (ch == IOS_EOF)
return 0; return 0;
c = (char)ch; c = (char)ch;
if (c == ';') { if (c == ';') {
// single-line comment // single-line comment
do { do {
ch = fgetc(f); ch = ios_getc(f);
if (ch == EOF) if (ch == IOS_EOF)
return 0; return 0;
} while ((char)ch != '\n'); } while ((char)ch != '\n');
c = (char)ch; c = (char)ch;
@ -91,14 +91,14 @@ static void accumchar(char c, int *pi)
} }
// return: 1 if escaped (forced to be symbol) // return: 1 if escaped (forced to be symbol)
static int read_token(FILE *f, char c, int digits) static int read_token(ios_t *f, char c, int digits)
{ {
int i=0, ch, escaped=0, issym=0, first=1; int i=0, ch, escaped=0, issym=0, first=1;
while (1) { while (1) {
if (!first) { if (!first) {
ch = fgetc(f); ch = ios_getc(f);
if (ch == EOF) if (ch == IOS_EOF)
goto terminate; goto terminate;
c = (char)ch; c = (char)ch;
} }
@ -109,8 +109,8 @@ static int read_token(FILE *f, char c, int digits)
} }
else if (c == '\\') { else if (c == '\\') {
issym = 1; issym = 1;
ch = fgetc(f); ch = ios_getc(f);
if (ch == EOF) if (ch == IOS_EOF)
goto terminate; goto terminate;
accumchar((char)ch, &i); accumchar((char)ch, &i);
} }
@ -121,13 +121,13 @@ static int read_token(FILE *f, char c, int digits)
accumchar(c, &i); accumchar(c, &i);
} }
} }
ungetc(c, f); ios_ungetc(c, f);
terminate: terminate:
buf[i++] = '\0'; buf[i++] = '\0';
return issym; return issym;
} }
static u_int32_t peek(FILE *f) static u_int32_t peek(ios_t *f)
{ {
char c, *end; char c, *end;
fixnum_t x; fixnum_t x;
@ -136,7 +136,7 @@ static u_int32_t peek(FILE *f)
if (toktype != TOK_NONE) if (toktype != TOK_NONE)
return toktype; return toktype;
c = nextchar(f); c = nextchar(f);
if (feof(f)) return TOK_NONE; if (ios_eof(f)) return TOK_NONE;
if (c == '(') { if (c == '(') {
toktype = TOK_OPEN; toktype = TOK_OPEN;
} }
@ -159,8 +159,8 @@ static u_int32_t peek(FILE *f)
toktype = TOK_DOUBLEQUOTE; toktype = TOK_DOUBLEQUOTE;
} }
else if (c == '#') { else if (c == '#') {
ch = fgetc(f); ch = ios_getc(f);
if (ch == EOF) if (ch == IOS_EOF)
lerror(ParseError, "read: invalid read macro"); lerror(ParseError, "read: invalid read macro");
if ((char)ch == '.') { if ((char)ch == '.') {
toktype = TOK_SHARPDOT; toktype = TOK_SHARPDOT;
@ -169,8 +169,8 @@ static u_int32_t peek(FILE *f)
toktype = TOK_SHARPQUOTE; toktype = TOK_SHARPQUOTE;
} }
else if ((char)ch == '\\') { else if ((char)ch == '\\') {
u_int32_t cval = u8_fgetc(f); uint32_t cval;
if (cval == UEOF) if (ios_getutf8(f, &cval) == IOS_EOF)
lerror(ParseError, "read: end of input in character constant"); lerror(ParseError, "read: end of input in character constant");
toktype = TOK_NUM; toktype = TOK_NUM;
tokval = fixnum(cval); tokval = fixnum(cval);
@ -189,7 +189,7 @@ static u_int32_t peek(FILE *f)
} }
else if (isdigit((char)ch)) { else if (isdigit((char)ch)) {
read_token(f, (char)ch, 1); read_token(f, (char)ch, 1);
c = (char)fgetc(f); c = (char)ios_getc(f);
if (c == '#') if (c == '#')
toktype = TOK_BACKREF; toktype = TOK_BACKREF;
else if (c == '=') else if (c == '=')
@ -205,19 +205,19 @@ static u_int32_t peek(FILE *f)
else if ((char)ch == '!') { else if ((char)ch == '!') {
// #! single line comment for shbang script support // #! single line comment for shbang script support
do { do {
ch = fgetc(f); ch = ios_getc(f);
} while (ch != EOF && (char)ch != '\n'); } while (ch != IOS_EOF && (char)ch != '\n');
return peek(f); return peek(f);
} }
else if ((char)ch == '|') { else if ((char)ch == '|') {
// multiline comment // multiline comment
while (1) { while (1) {
ch = fgetc(f); ch = ios_getc(f);
hashpipe_got: hashpipe_got:
if (ch == EOF) if (ch == IOS_EOF)
lerror(ParseError, "read: eof within comment"); lerror(ParseError, "read: eof within comment");
if ((char)ch == '|') { if ((char)ch == '|') {
ch = fgetc(f); ch = ios_getc(f);
if ((char)ch == '#') if ((char)ch == '#')
break; break;
goto hashpipe_got; goto hashpipe_got;
@ -228,9 +228,9 @@ static u_int32_t peek(FILE *f)
} }
else if ((char)ch == ':') { else if ((char)ch == ':') {
// gensym // gensym
ch = fgetc(f); ch = ios_getc(f);
if ((char)ch == 'g') if ((char)ch == 'g')
ch = fgetc(f); ch = ios_getc(f);
read_token(f, (char)ch, 0); read_token(f, (char)ch, 0);
errno = 0; errno = 0;
x = strtol(buf, &end, 10); x = strtol(buf, &end, 10);
@ -256,15 +256,15 @@ static u_int32_t peek(FILE *f)
} }
else if (c == ',') { else if (c == ',') {
toktype = TOK_COMMA; toktype = TOK_COMMA;
ch = fgetc(f); ch = ios_getc(f);
if (ch == EOF) if (ch == IOS_EOF)
return toktype; return toktype;
if ((char)ch == '@') if ((char)ch == '@')
toktype = TOK_COMMAAT; toktype = TOK_COMMAAT;
else if ((char)ch == '.') else if ((char)ch == '.')
toktype = TOK_COMMADOT; toktype = TOK_COMMADOT;
else else
ungetc((char)ch, f); ios_ungetc((char)ch, f);
} }
else { else {
if (!read_token(f, c, 0)) { if (!read_token(f, c, 0)) {
@ -286,9 +286,9 @@ static u_int32_t peek(FILE *f)
return toktype; return toktype;
} }
static value_t do_read_sexpr(FILE *f, value_t label); static value_t do_read_sexpr(ios_t *f, value_t label);
static value_t read_vector(FILE *f, value_t label, u_int32_t closer) static value_t read_vector(ios_t *f, value_t label, u_int32_t closer)
{ {
value_t v=alloc_vector(4, 1), elt; value_t v=alloc_vector(4, 1), elt;
u_int32_t i=0; u_int32_t i=0;
@ -296,7 +296,7 @@ static value_t read_vector(FILE *f, value_t label, u_int32_t closer)
if (label != UNBOUND) if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v); ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
while (peek(f) != closer) { while (peek(f) != closer) {
if (feof(f)) if (ios_eof(f))
lerror(ParseError, "read: unexpected end of input"); lerror(ParseError, "read: unexpected end of input");
if (i >= vector_size(v)) if (i >= vector_size(v))
Stack[SP-1] = vector_grow(v); Stack[SP-1] = vector_grow(v);
@ -310,7 +310,7 @@ static value_t read_vector(FILE *f, value_t label, u_int32_t closer)
return POP(); return POP();
} }
static value_t read_string(FILE *f) static value_t read_string(ios_t *f)
{ {
char *buf, *temp; char *buf, *temp;
char eseq[10]; char eseq[10];
@ -330,16 +330,16 @@ static value_t read_string(FILE *f)
} }
buf = temp; buf = temp;
} }
c = fgetc(f); c = ios_getc(f);
if (c == EOF) { if (c == IOS_EOF) {
free(buf); free(buf);
lerror(ParseError, "read: unexpected end of input in string"); lerror(ParseError, "read: unexpected end of input in string");
} }
if (c == '"') if (c == '"')
break; break;
else if (c == '\\') { else if (c == '\\') {
c = fgetc(f); c = ios_getc(f);
if (c == EOF) { if (c == IOS_EOF) {
free(buf); free(buf);
lerror(ParseError, "read: end of input in escape sequence"); lerror(ParseError, "read: end of input in escape sequence");
} }
@ -347,9 +347,9 @@ static value_t read_string(FILE *f)
if (octal_digit(c)) { if (octal_digit(c)) {
do { do {
eseq[j++] = c; eseq[j++] = c;
c = fgetc(f); c = ios_getc(f);
} while (octal_digit(c) && j<3 && (c!=EOF)); } while (octal_digit(c) && j<3 && (c!=IOS_EOF));
if (c!=EOF) ungetc(c, f); if (c!=IOS_EOF) ios_ungetc(c, f);
eseq[j] = '\0'; eseq[j] = '\0';
wc = strtol(eseq, NULL, 8); wc = strtol(eseq, NULL, 8);
i += u8_wc_toutf8(&buf[i], wc); i += u8_wc_toutf8(&buf[i], wc);
@ -358,12 +358,12 @@ static value_t read_string(FILE *f)
(c=='u' && (ndig=4)) || (c=='u' && (ndig=4)) ||
(c=='U' && (ndig=8))) { (c=='U' && (ndig=8))) {
wc = c; wc = c;
c = fgetc(f); c = ios_getc(f);
while (hex_digit(c) && j<ndig && (c!=EOF)) { while (hex_digit(c) && j<ndig && (c!=IOS_EOF)) {
eseq[j++] = c; eseq[j++] = c;
c = fgetc(f); c = ios_getc(f);
} }
if (c!=EOF) ungetc(c, f); if (c!=IOS_EOF) ios_ungetc(c, f);
eseq[j] = '\0'; eseq[j] = '\0';
if (j) wc = strtol(eseq, NULL, 16); if (j) wc = strtol(eseq, NULL, 16);
i += u8_wc_toutf8(&buf[i], wc); i += u8_wc_toutf8(&buf[i], wc);
@ -398,7 +398,7 @@ static value_t read_string(FILE *f)
// build a list of conses. this is complicated by the fact that all conses // build a list of conses. this is complicated by the fact that all conses
// can move whenever a new cons is allocated. we have to refer to every cons // can move whenever a new cons is allocated. we have to refer to every cons
// through a handle to a relocatable pointer (i.e. a pointer on the stack). // through a handle to a relocatable pointer (i.e. a pointer on the stack).
static void read_list(FILE *f, value_t *pval, value_t label) static void read_list(ios_t *f, value_t *pval, value_t label)
{ {
value_t c, *pc; value_t c, *pc;
u_int32_t t; u_int32_t t;
@ -407,7 +407,7 @@ static void read_list(FILE *f, value_t *pval, value_t label)
pc = &Stack[SP-1]; // to keep track of current cons cell pc = &Stack[SP-1]; // to keep track of current cons cell
t = peek(f); t = peek(f);
while (t != TOK_CLOSE) { while (t != TOK_CLOSE) {
if (feof(f)) if (ios_eof(f))
lerror(ParseError, "read: unexpected end of input"); lerror(ParseError, "read: unexpected end of input");
c = mk_cons(); car_(c) = cdr_(c) = NIL; c = mk_cons(); car_(c) = cdr_(c) = NIL;
if (iscons(*pc)) { if (iscons(*pc)) {
@ -428,7 +428,7 @@ static void read_list(FILE *f, value_t *pval, value_t label)
c = do_read_sexpr(f,UNBOUND); c = do_read_sexpr(f,UNBOUND);
cdr_(*pc) = c; cdr_(*pc) = c;
t = peek(f); t = peek(f);
if (feof(f)) if (ios_eof(f))
lerror(ParseError, "read: unexpected end of input"); lerror(ParseError, "read: unexpected end of input");
if (t != TOK_CLOSE) if (t != TOK_CLOSE)
lerror(ParseError, "read: expected ')'"); lerror(ParseError, "read: expected ')'");
@ -439,7 +439,7 @@ static void read_list(FILE *f, value_t *pval, value_t label)
} }
// label is the backreference we'd like to fix up with this read // label is the backreference we'd like to fix up with this read
static value_t do_read_sexpr(FILE *f, value_t label) static value_t do_read_sexpr(ios_t *f, value_t label)
{ {
value_t v, sym, oldtokval, *head; value_t v, sym, oldtokval, *head;
value_t *pv; value_t *pv;
@ -529,7 +529,7 @@ static value_t do_read_sexpr(FILE *f, value_t label)
return NIL; return NIL;
} }
value_t read_sexpr(FILE *f) value_t read_sexpr(ios_t *f)
{ {
value_t v; value_t v;
readstate_t state; readstate_t state;

1
femtolisp/torus.lsp
View File

@ -37,6 +37,7 @@
l)) l))
(time (progn (print (torus 100 100)) nil)) (time (progn (print (torus 100 100)) nil))
;(time (dotimes (i 1) (load "100x100.lsp")))
; with ltable ; with ltable
; printing time: 0.415sec ; printing time: 0.415sec
; reading time: 0.165sec ; reading time: 0.165sec

2
llt/hashing.c
View File

@ -129,4 +129,6 @@ void llt_init()
flt_tolerance(5e-6); flt_tolerance(5e-6);
randomize(); randomize();
ios_init_stdstreams();
} }

108
llt/ios.c
View File

@ -302,6 +302,25 @@ size_t ios_readall(ios_t *s, char *dest, size_t n)
return _ios_read(s, dest, n, 1); return _ios_read(s, dest, n, 1);
} }
size_t ios_readprep(ios_t *s, size_t n)
{
size_t space = s->size - s->bpos;
if (s->state == bst_wr)
return space;
if (space >= n || s->bm == bm_mem || s->fd == -1)
return space;
if (s->maxsize < s->bpos+n) {
if (_buf_realloc(s, s->maxsize + n)==NULL)
return space;
}
size_t got;
int result = _os_read(s->fd, s->buf+s->size, s->maxsize - s->size, &got);
if (result)
return space;
s->size += got;
return s->size - s->bpos;
}
size_t ios_write(ios_t *s, char *data, size_t n) size_t ios_write(ios_t *s, char *data, size_t n)
{ {
if (n == 0) return 0; if (n == 0) return 0;
@ -421,10 +440,13 @@ int ios_eof(ios_t *s)
return 1; return 1;
if (s->_eof) if (s->_eof)
return 1; return 1;
return 0;
/*
if (_fd_available(s->fd)) if (_fd_available(s->fd))
return 0; return 0;
s->_eof = 1; s->_eof = 1;
return 1; return 1;
*/
} }
static void _discard_partial_buffer(ios_t *s) static void _discard_partial_buffer(ios_t *s)
@ -646,36 +668,22 @@ ios_t *ios_fd(ios_t *s, long fd, int isfile)
return s; return s;
} }
ios_t *ios_stdin() ios_t *ios_stdin = NULL;
{ ios_t *ios_stdout = NULL;
static ios_t *_ios_stdin = NULL; ios_t *ios_stderr = NULL;
if (_ios_stdin == NULL) {
_ios_stdin = malloc(sizeof(ios_t));
ios_fd(_ios_stdin, STDIN_FILENO, 0);
}
return _ios_stdin;
}
ios_t *ios_stdout() void ios_init_stdstreams()
{ {
static ios_t *_ios_stdout = NULL; ios_stdin = malloc(sizeof(ios_t));
if (_ios_stdout == NULL) { ios_fd(ios_stdin, STDIN_FILENO, 0);
_ios_stdout = malloc(sizeof(ios_t));
ios_fd(_ios_stdout, STDOUT_FILENO, 0);
_ios_stdout->bm = bm_line;
}
return _ios_stdout;
}
ios_t *ios_stderr() ios_stdout = malloc(sizeof(ios_t));
{ ios_fd(ios_stdout, STDOUT_FILENO, 0);
static ios_t *_ios_stderr = NULL; ios_stdout->bm = bm_line;
if (_ios_stderr == NULL) {
_ios_stderr = malloc(sizeof(ios_t)); ios_stderr = malloc(sizeof(ios_t));
ios_fd(_ios_stderr, STDERR_FILENO, 0); ios_fd(ios_stderr, STDERR_FILENO, 0);
_ios_stderr->bm = bm_none; ios_stderr->bm = bm_none;
}
return _ios_stderr;
} }
/* higher level interface */ /* higher level interface */
@ -689,10 +697,11 @@ int ios_putc(int c, ios_t *s)
int ios_getc(ios_t *s) int ios_getc(ios_t *s)
{ {
if (s->bpos < s->size)
return s->buf[s->bpos++];
if (s->_eof) return IOS_EOF; if (s->_eof) return IOS_EOF;
char ch; char ch;
size_t n = ios_read(s, &ch, 1); if (ios_read(s, &ch, 1) < 1)
if (n < 1)
return IOS_EOF; return IOS_EOF;
return (int)ch; return (int)ch;
} }
@ -716,20 +725,53 @@ int ios_ungetc(int c, ios_t *s)
return c; return c;
} }
int ios_getutf8(ios_t *s, uint32_t *pwc)
{
int c;
size_t sz;
char c0;
char buf[8];
c = ios_getc(s);
if (c == IOS_EOF)
return IOS_EOF;
c0 = (char)c;
sz = u8_seqlen(&c0)-1;
if (sz == 0) {
*pwc = (uint32_t)c0;
return 1;
}
if (ios_ungetc(c, s) == IOS_EOF)
return IOS_EOF;
if (ios_readprep(s, sz) < sz)
// NOTE: this can return EOF even if some bytes are available
return IOS_EOF;
size_t i = s->bpos;
*pwc = u8_nextchar(s->buf, &i);
ios_read(s, buf, sz+1);
return 1;
}
int ios_printf(ios_t *s, char *format, ...) int ios_printf(ios_t *s, char *format, ...)
{ {
char *str; char buf[512];
char *str=&buf[0];
va_list args; va_list args;
int c;
va_start(args, format); va_start(args, format);
// TODO: avoid copy // TODO: avoid copy
int c = vasprintf(&str, format, args); c = vsnprintf(buf, sizeof(buf), format, args);
if ((size_t)c >= sizeof(buf))
c = vasprintf(&str, format, args);
va_end(args); va_end(args);
if (c == -1) return c; if (c < 0) return c;
ios_write(s, str, c); ios_write(s, str, c);
free(str); if (str != &buf[0]) free(str);
return c; return c;
} }

13
llt/ios.h
View File

@ -9,7 +9,7 @@ typedef enum { bm_none, bm_line, bm_block, bm_mem } bufmode_t;
typedef enum { bst_none, bst_rd, bst_wr } bufstate_t; typedef enum { bst_none, bst_rd, bst_wr } bufstate_t;
#define IOS_INLSIZE 54 #define IOS_INLSIZE 54
#define IOS_BUFSIZE 4095 #define IOS_BUFSIZE 8191
typedef struct { typedef struct {
bufmode_t bm; bufmode_t bm;
@ -79,8 +79,8 @@ int ios_bufmode(ios_t *s, bufmode_t mode);
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); int ios_copy(ios_t *to, ios_t *from, size_t nbytes);
int ios_copyall(ios_t *to, ios_t *from); int ios_copyall(ios_t *to, ios_t *from);
// ensure at least n bytes are buffered if possible. returns actual #. // ensure at least n bytes are buffered if possible. returns # available.
//size_t ios_ensure(ios_t *from, size_t n); size_t ios_readprep(ios_t *from, size_t n);
//void ios_lock(ios_t *s); //void ios_lock(ios_t *s);
//int ios_trylock(ios_t *s); //int ios_trylock(ios_t *s);
//int ios_unlock(ios_t *s); //int ios_unlock(ios_t *s);
@ -91,9 +91,10 @@ ios_t *ios_mem(ios_t *s, size_t initsize);
ios_t *ios_str(ios_t *s, char *str); ios_t *ios_str(ios_t *s, char *str);
ios_t *ios_fd(ios_t *s, long fd, int isfile); ios_t *ios_fd(ios_t *s, long fd, int isfile);
// todo: ios_socket // todo: ios_socket
ios_t *ios_stdin(); extern ios_t *ios_stdin;
ios_t *ios_stdout(); extern ios_t *ios_stdout;
ios_t *ios_stderr(); extern ios_t *ios_stderr;
void ios_init_stdstreams();
/* high-level functions - output */ /* high-level functions - output */
int ios_putnum(ios_t *s, char *data, uint32_t type); int ios_putnum(ios_t *s, char *data, uint32_t type);

38
llt/utf8.c
View File

@ -80,7 +80,7 @@ size_t u8_codingsize(u_int32_t *wcstr, size_t n)
sz = dest size in # of wide characters sz = dest size in # of wide characters
returns # characters converted returns # characters converted
if sz = srcsz+1 (i.e. 4*srcsz+4 bytes), there will always be enough space. if sz == srcsz+1 (i.e. 4*srcsz+4 bytes), there will always be enough space.
*/ */
size_t u8_toucs(u_int32_t *dest, size_t sz, const char *src, size_t srcsz) size_t u8_toucs(u_int32_t *dest, size_t sz, const char *src, size_t srcsz)
{ {
@ -565,23 +565,25 @@ int u8_is_locale_utf8(const char *locale)
size_t u8_vprintf(const char *fmt, va_list ap) size_t u8_vprintf(const char *fmt, va_list ap)
{ {
size_t cnt, sz=0, nc; size_t cnt, sz=0, nc, needfree=0;
char *buf; char *buf;
u_int32_t *wcs; u_int32_t *wcs;
sz = 512; sz = 512;
buf = (char*)alloca(sz); buf = (char*)alloca(sz);
try_print:
cnt = vsnprintf(buf, sz, fmt, ap); cnt = vsnprintf(buf, sz, fmt, ap);
if ((ssize_t)cnt < 0)
return 0;
if (cnt >= sz) { if (cnt >= sz) {
buf = (char*)alloca(cnt - sz + 1); buf = (char*)malloc(cnt + 1);
sz = cnt + 1; needfree = 1;
goto try_print; vsnprintf(buf, cnt+1, fmt, ap);
} }
wcs = (u_int32_t*)alloca((cnt+1) * sizeof(u_int32_t)); wcs = (u_int32_t*)alloca((cnt+1) * sizeof(u_int32_t));
nc = u8_toucs(wcs, cnt+1, buf, cnt); nc = u8_toucs(wcs, cnt+1, buf, cnt);
wcs[nc] = 0; wcs[nc] = 0;
printf("%ls", (wchar_t*)wcs); printf("%ls", (wchar_t*)wcs);
if (needfree) free(buf);
return nc; return nc;
} }
@ -702,27 +704,3 @@ int u8_reverse(char *dest, char * src, size_t len)
} }
return 0; return 0;
} }
u_int32_t u8_fgetc(FILE *f)
{
int amt=0, sz, c;
u_int32_t ch=0;
char c0;
c = fgetc(f);
if (c == EOF)
return UEOF;
ch = (u_int32_t)c;
c0 = (char)ch;
amt = sz = u8_seqlen(&c0);
while (--amt) {
ch <<= 6;
c = fgetc(f);
if (c == EOF)
return UEOF;
ch += (u_int32_t)c;
}
ch -= offsetsFromUTF8[sz-1];
return ch;
}

4
llt/utf8.h
View File

@ -121,8 +121,4 @@ int u8_isvalid(const char *str, int length);
be allocated to at least len+1 bytes. returns 1 for error, 0 otherwise */ be allocated to at least len+1 bytes. returns 1 for error, 0 otherwise */
int u8_reverse(char *dest, char *src, size_t len); int u8_reverse(char *dest, char *src, size_t len);
#include <stdio.h> // temporary, until u8_fgetc is gone
/* read a UTF-8 sequence from a stream and return a wide character or UEOF */
u_int32_t u8_fgetc(FILE *f);
#endif #endif