ref: 9acdf313b977ce11cf05254f9f05f6f8725ffbaa
parent: 755bb33714d76e352817e16615b80be02354130f
author: JeffBezanson <[email protected]>
date: Sun Aug 17 14:16:31 EDT 2008
adding more ios functions porting femtolisp to use ios for all I/O
--- a/femtolisp/builtins.c
+++ b/femtolisp/builtins.c
@@ -39,8 +39,8 @@
{
unsigned i;
for (i=0; i < nargs; i++)
- print(stdout, args[i], 0);
- fputc('\n', stdout);
+ print(ios_stdout, args[i], 0);
+ ios_putc('\n', ios_stdout);
return nargs ? args[nargs-1] : NIL;
}
@@ -48,7 +48,7 @@
{
unsigned i;
for (i=0; i < nargs; i++)
- print(stdout, args[i], 1);
+ print(ios_stdout, args[i], 1);
return nargs ? args[nargs-1] : NIL;
}
@@ -56,7 +56,7 @@
{
(void)args;
argcount("read", nargs, 0);
- return read_sexpr(stdin);
+ return read_sexpr(ios_stdin);
}
value_t fl_load(value_t *args, u_int32_t nargs)
--- a/femtolisp/cvalues.c
+++ b/femtolisp/cvalues.c
@@ -32,7 +32,7 @@
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
value_t cvalue_new(value_t *args, u_int32_t nargs);
value_t cvalue_sizeof(value_t *args, u_int32_t nargs);
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -84,7 +84,7 @@
static value_t eval_sexpr(value_t e, uint32_t penv, int tail);
static value_t *alloc_words(int n);
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 {
ptrhash_t backrefs;
@@ -1389,23 +1389,23 @@
{
if (iscons(lasterror) && car_(lasterror) == TypeError &&
llength(lasterror) == 4) {
- fprintf(stderr, "type-error: ");
- print(stderr, car_(cdr_(lasterror)), 1);
- fprintf(stderr, ": expected ");
- print(stderr, car_(cdr_(cdr_(lasterror))), 1);
- fprintf(stderr, ", got ");
- print(stderr, car_(cdr_(cdr_(cdr_(lasterror)))), 0);
+ ios_printf(ios_stderr, "type-error: ");
+ print(ios_stderr, car_(cdr_(lasterror)), 1);
+ ios_printf(ios_stderr, ": expected ");
+ print(ios_stderr, car_(cdr_(cdr_(lasterror))), 1);
+ ios_printf(ios_stderr, ", got ");
+ print(ios_stderr, car_(cdr_(cdr_(cdr_(lasterror)))), 0);
}
else if (iscons(lasterror) && car_(lasterror) == UnboundError &&
iscons(cdr_(lasterror))) {
- fprintf(stderr, "unbound-error: eval: variable %s has no value",
- (symbol_name(car_(cdr_(lasterror)))));
+ ios_printf(ios_stderr, "unbound-error: eval: variable %s has no value",
+ (symbol_name(car_(cdr_(lasterror)))));
}
else if (iscons(lasterror) && car_(lasterror) == Error) {
value_t v = cdr_(lasterror);
- fprintf(stderr, "error: ");
+ ios_printf(ios_stderr, "error: ");
while (iscons(v)) {
- print(stderr, car_(v), 1);
+ print(ios_stderr, car_(v), 1);
v = cdr_(v);
}
}
@@ -1412,32 +1412,34 @@
else {
if (lasterror != NIL) {
if (!lerrorbuf[0])
- fprintf(stderr, "*** Unhandled exception: ");
- print(stderr, lasterror, 0);
+ ios_printf(ios_stderr, "*** Unhandled exception: ");
+ print(ios_stderr, lasterror, 0);
if (lerrorbuf[0])
- fprintf(stderr, ": ");
+ ios_printf(ios_stderr, ": ");
}
}
if (lerrorbuf[0])
- fprintf(stderr, "%s", lerrorbuf);
+ ios_printf(ios_stderr, "%s", lerrorbuf);
}
value_t load_file(char *fname)
{
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);
FL_TRY {
while (1) {
e = read_sexpr(f);
- //print(stdout,e,0); printf("\n");
- if (feof(f)) break;
+ //print(ios_stdout,e,0); ios_puts("\n", ios_stdout);
+ if (ios_eof(f)) break;
v = toplevel_eval(e);
}
}
FL_CATCH {
- fclose(f);
+ ios_close(f);
size_t msglen = strlen(lerrorbuf);
snprintf(&lerrorbuf[msglen], sizeof(lerrorbuf)-msglen,
"\nin file \"%s\"", fname);
@@ -1444,7 +1446,7 @@
lerrorbuf[sizeof(lerrorbuf)-1] = '\0';
raise(lasterror);
}
- fclose(f);
+ ios_close(f);
return v;
}
@@ -1477,7 +1479,7 @@
lerrorbuf[0] = '\0';
lasterror = NIL;
- fprintf(stderr, "\n\n");
+ ios_puts("\n\n", ios_stderr);
goto repl;
}
load_file("system.lsp");
@@ -1488,13 +1490,13 @@
printf(";-------------------|----------------------------------------------------------\n\n");
repl:
while (1) {
- printf("> ");
- v = read_sexpr(stdin);
- if (feof(stdin)) break;
- print(stdout, v=toplevel_eval(v), 0);
+ ios_puts("> ", ios_stdout); ios_flush(ios_stdout);
+ v = read_sexpr(ios_stdin);
+ if (ios_eof(ios_stdin)) break;
+ print(ios_stdout, v=toplevel_eval(v), 0);
set(symbol("that"), v);
- printf("\n\n");
+ ios_puts("\n\n", ios_stdout);
}
- printf("\n");
+ ios_puts("\n", ios_stdout);
return 0;
}
--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -105,8 +105,8 @@
extern value_t NIL, T;
/* read, eval, print main entry points */
-value_t read_sexpr(FILE *f);
-void print(FILE *f, value_t v, int princ);
+value_t read_sexpr(ios_t *f);
+void print(ios_t *f, value_t v, int princ);
value_t toplevel_eval(value_t expr);
value_t apply(value_t f, value_t l);
value_t load_file(char *fname);
--- a/femtolisp/print.c
+++ b/femtolisp/print.c
@@ -3,27 +3,27 @@
static int print_pretty;
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++;
}
-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);
}
-static void outindent(int n, FILE *f)
+static void outindent(int n, ios_t *f)
{
- fputc('\n', f);
+ ios_putc('\n', f);
VPOS++;
HPOS = n;
while (n >= 8) {
- fputc('\t', f);
+ ios_putc('\t', f);
n -= 8;
}
while (n) {
- fputc(' ', f);
+ ios_putc(' ', f);
n--;
}
}
@@ -65,7 +65,7 @@
}
}
-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;
@@ -202,7 +202,7 @@
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;
char *op = NULL;
@@ -286,9 +286,9 @@
}
}
-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;
char *name;
@@ -295,7 +295,7 @@
switch (tag(v)) {
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:
name = symbol_name(v);
if (princ)
@@ -323,10 +323,10 @@
if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) !=
(value_t)PH_NOTFOUND) {
if (!ismarked(v)) {
- HPOS+=fprintf(f, "#%ld#", numval(label));
+ HPOS+=ios_printf(f, "#%ld#", numval(label));
return;
}
- HPOS+=fprintf(f, "#%ld=", numval(label));
+ HPOS+=ios_printf(f, "#%ld=", numval(label));
}
if (isvector(v)) {
outc('[', f);
@@ -362,7 +362,7 @@
}
}
-void print_string(FILE *f, char *str, size_t sz)
+void print_string(ios_t *f, char *str, size_t sz)
{
char buf[512];
size_t i = 0;
@@ -381,7 +381,7 @@
// 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
// 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)
{
int64_t tmp=0;
@@ -392,11 +392,11 @@
if (princ)
outc(ch, f);
else if (weak)
- HPOS+=fprintf(f, "%hhu", ch);
+ HPOS+=ios_printf(f, "%hhu", ch);
else if (isprint(ch))
- HPOS+=fprintf(f, "#\\%c", ch);
+ HPOS+=ios_printf(f, "#\\%c", ch);
else
- HPOS+=fprintf(f, "#char(%hhu)", ch);
+ HPOS+=ios_printf(f, "#char(%hhu)", ch);
}
/*
else if (type == ucharsym) {
@@ -405,8 +405,8 @@
outc(ch, f);
else {
if (!weak)
- fprintf(f, "#uchar(");
- fprintf(f, "%hhu", ch);
+ ios_printf(f, "#uchar(");
+ ios_printf(f, "%hhu", ch);
if (!weak)
outs(")", f);
}
@@ -416,7 +416,7 @@
uint32_t wc = *(uint32_t*)data;
char seq[8];
if (weak)
- HPOS+=fprintf(f, "%d", (int)wc);
+ HPOS+=ios_printf(f, "%d", (int)wc);
else if (princ || (iswprint(wc) && wc>0x7f)) {
// reader only reads #\c syntax as wchar if the code is >0x7f
size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);
@@ -426,7 +426,7 @@
outs(seq, f);
}
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
@@ -437,14 +437,14 @@
int64_t i64 = *(int64_t*)data;
if (fits_fixnum(i64) || princ) {
if (weak || princ)
- HPOS+=fprintf(f, "%lld", i64);
+ HPOS+=ios_printf(f, "%lld", i64);
else
- HPOS+=fprintf(f, "#%s(%lld)", symbol_name(type), i64);
+ HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), i64);
}
else
- HPOS+=fprintf(f, "#%s(0x%08x%08x)", symbol_name(type),
- (uint32_t)(i64>>32),
- (uint32_t)(i64));
+ HPOS+=ios_printf(f, "#%s(0x%08x%08x)", symbol_name(type),
+ (uint32_t)(i64>>32),
+ (uint32_t)(i64));
}
else if (type == uint64sym
#ifdef BITS64
@@ -454,14 +454,14 @@
uint64_t ui64 = *(uint64_t*)data;
if (fits_fixnum(ui64) || princ) {
if (weak || princ)
- HPOS+=fprintf(f, "%llu", ui64);
+ HPOS+=ios_printf(f, "%llu", ui64);
else
- HPOS+=fprintf(f, "#%s(%llu)", symbol_name(type), ui64);
+ HPOS+=ios_printf(f, "#%s(%llu)", symbol_name(type), ui64);
}
else
- HPOS+=fprintf(f, "#%s(0x%08x%08x)", symbol_name(type),
- (uint32_t)(ui64>>32),
- (uint32_t)(ui64));
+ HPOS+=ios_printf(f, "#%s(0x%08x%08x)", symbol_name(type),
+ (uint32_t)(ui64>>32),
+ (uint32_t)(ui64));
}
else if (type == lispvaluesym) {
// TODO
@@ -479,9 +479,9 @@
}
else {
if (!DFINITE(d))
- HPOS+=fprintf(f, "#%s(\"%s\")", symbol_name(type), buf);
+ HPOS+=ios_printf(f, "#%s(\"%s\")", symbol_name(type), buf);
else
- HPOS+=fprintf(f, "#%s(%s)", symbol_name(type), buf);
+ HPOS+=ios_printf(f, "#%s(%s)", symbol_name(type), buf);
}
}
else if (issymbol(type)) {
@@ -490,13 +490,13 @@
tmp = conv_to_int64(data, sym_to_numtype(type));
if (fits_fixnum(tmp) || princ) {
if (weak || princ)
- HPOS+=fprintf(f, "%lld", tmp);
+ HPOS+=ios_printf(f, "%lld", tmp);
else
- HPOS+=fprintf(f, "#%s(%lld)", symbol_name(type), tmp);
+ HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), tmp);
}
else
- HPOS+=fprintf(f, "#%s(0x%08x)", symbol_name(type),
- (uint32_t)(tmp&0xffffffff));
+ HPOS+=ios_printf(f, "#%s(0x%08x)", symbol_name(type),
+ (uint32_t)(tmp&0xffffffff));
}
else if (iscons(type)) {
if (car_(type) == arraysym) {
@@ -514,7 +514,7 @@
}
if (eltype == charsym) {
if (princ) {
- fwrite(data, 1, len, f);
+ ios_write(f, data, len);
}
else {
print_string(f, (char*)data, len);
@@ -562,14 +562,14 @@
}
}
-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);
void *data = cv_data(cv);
if (cv->flags.islispfunction) {
- HPOS+=fprintf(f, "#<guestfunction @0x%08lx>",
- (unsigned long)*(guestfunc_t*)data);
+ HPOS+=ios_printf(f, "#<guestfunction @0x%08lx>",
+ (unsigned long)*(guestfunc_t*)data);
return;
}
@@ -576,7 +576,7 @@
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);
ptrhash_reset(&printconses, 32);
--- a/femtolisp/read.c
+++ b/femtolisp/read.c
@@ -55,21 +55,21 @@
static value_t tokval;
static char buf[256];
-static char nextchar(FILE *f)
+static char nextchar(ios_t *f)
{
int ch;
char c;
do {
- ch = fgetc(f);
- if (ch == EOF)
+ ch = ios_getc(f);
+ if (ch == IOS_EOF)
return 0;
c = (char)ch;
if (c == ';') {
// single-line comment
do {
- ch = fgetc(f);
- if (ch == EOF)
+ ch = ios_getc(f);
+ if (ch == IOS_EOF)
return 0;
} while ((char)ch != '\n');
c = (char)ch;
@@ -91,14 +91,14 @@
}
// 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;
while (1) {
if (!first) {
- ch = fgetc(f);
- if (ch == EOF)
+ ch = ios_getc(f);
+ if (ch == IOS_EOF)
goto terminate;
c = (char)ch;
}
@@ -109,8 +109,8 @@
}
else if (c == '\\') {
issym = 1;
- ch = fgetc(f);
- if (ch == EOF)
+ ch = ios_getc(f);
+ if (ch == IOS_EOF)
goto terminate;
accumchar((char)ch, &i);
}
@@ -121,13 +121,13 @@
accumchar(c, &i);
}
}
- ungetc(c, f);
+ ios_ungetc(c, f);
terminate:
buf[i++] = '\0';
return issym;
}
-static u_int32_t peek(FILE *f)
+static u_int32_t peek(ios_t *f)
{
char c, *end;
fixnum_t x;
@@ -136,7 +136,7 @@
if (toktype != TOK_NONE)
return toktype;
c = nextchar(f);
- if (feof(f)) return TOK_NONE;
+ if (ios_eof(f)) return TOK_NONE;
if (c == '(') {
toktype = TOK_OPEN;
}
@@ -159,8 +159,8 @@
toktype = TOK_DOUBLEQUOTE;
}
else if (c == '#') {
- ch = fgetc(f);
- if (ch == EOF)
+ ch = ios_getc(f);
+ if (ch == IOS_EOF)
lerror(ParseError, "read: invalid read macro");
if ((char)ch == '.') {
toktype = TOK_SHARPDOT;
@@ -169,8 +169,8 @@
toktype = TOK_SHARPQUOTE;
}
else if ((char)ch == '\\') {
- u_int32_t cval = u8_fgetc(f);
- if (cval == UEOF)
+ uint32_t cval;
+ if (ios_getutf8(f, &cval) == IOS_EOF)
lerror(ParseError, "read: end of input in character constant");
toktype = TOK_NUM;
tokval = fixnum(cval);
@@ -189,7 +189,7 @@
}
else if (isdigit((char)ch)) {
read_token(f, (char)ch, 1);
- c = (char)fgetc(f);
+ c = (char)ios_getc(f);
if (c == '#')
toktype = TOK_BACKREF;
else if (c == '=')
@@ -205,19 +205,19 @@
else if ((char)ch == '!') {
// #! single line comment for shbang script support
do {
- ch = fgetc(f);
- } while (ch != EOF && (char)ch != '\n');
+ ch = ios_getc(f);
+ } while (ch != IOS_EOF && (char)ch != '\n');
return peek(f);
}
else if ((char)ch == '|') {
// multiline comment
while (1) {
- ch = fgetc(f);
+ ch = ios_getc(f);
hashpipe_got:
- if (ch == EOF)
+ if (ch == IOS_EOF)
lerror(ParseError, "read: eof within comment");
if ((char)ch == '|') {
- ch = fgetc(f);
+ ch = ios_getc(f);
if ((char)ch == '#')
break;
goto hashpipe_got;
@@ -228,9 +228,9 @@
}
else if ((char)ch == ':') {
// gensym
- ch = fgetc(f);
+ ch = ios_getc(f);
if ((char)ch == 'g')
- ch = fgetc(f);
+ ch = ios_getc(f);
read_token(f, (char)ch, 0);
errno = 0;
x = strtol(buf, &end, 10);
@@ -256,8 +256,8 @@
}
else if (c == ',') {
toktype = TOK_COMMA;
- ch = fgetc(f);
- if (ch == EOF)
+ ch = ios_getc(f);
+ if (ch == IOS_EOF)
return toktype;
if ((char)ch == '@')
toktype = TOK_COMMAAT;
@@ -264,7 +264,7 @@
else if ((char)ch == '.')
toktype = TOK_COMMADOT;
else
- ungetc((char)ch, f);
+ ios_ungetc((char)ch, f);
}
else {
if (!read_token(f, c, 0)) {
@@ -286,9 +286,9 @@
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;
u_int32_t i=0;
@@ -296,7 +296,7 @@
if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
while (peek(f) != closer) {
- if (feof(f))
+ if (ios_eof(f))
lerror(ParseError, "read: unexpected end of input");
if (i >= vector_size(v))
Stack[SP-1] = vector_grow(v);
@@ -310,7 +310,7 @@
return POP();
}
-static value_t read_string(FILE *f)
+static value_t read_string(ios_t *f)
{
char *buf, *temp;
char eseq[10];
@@ -330,8 +330,8 @@
}
buf = temp;
}
- c = fgetc(f);
- if (c == EOF) {
+ c = ios_getc(f);
+ if (c == IOS_EOF) {
free(buf);
lerror(ParseError, "read: unexpected end of input in string");
}
@@ -338,8 +338,8 @@
if (c == '"')
break;
else if (c == '\\') {
- c = fgetc(f);
- if (c == EOF) {
+ c = ios_getc(f);
+ if (c == IOS_EOF) {
free(buf);
lerror(ParseError, "read: end of input in escape sequence");
}
@@ -347,9 +347,9 @@
if (octal_digit(c)) {
do {
eseq[j++] = c;
- c = fgetc(f);
- } while (octal_digit(c) && j<3 && (c!=EOF));
- if (c!=EOF) ungetc(c, f);
+ c = ios_getc(f);
+ } while (octal_digit(c) && j<3 && (c!=IOS_EOF));
+ if (c!=IOS_EOF) ios_ungetc(c, f);
eseq[j] = '\0';
wc = strtol(eseq, NULL, 8);
i += u8_wc_toutf8(&buf[i], wc);
@@ -358,12 +358,12 @@
(c=='u' && (ndig=4)) ||
(c=='U' && (ndig=8))) {
wc = c;
- c = fgetc(f);
- while (hex_digit(c) && j<ndig && (c!=EOF)) {
+ c = ios_getc(f);
+ while (hex_digit(c) && j<ndig && (c!=IOS_EOF)) {
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';
if (j) wc = strtol(eseq, NULL, 16);
i += u8_wc_toutf8(&buf[i], wc);
@@ -398,7 +398,7 @@
// 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
// 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;
u_int32_t t;
@@ -407,7 +407,7 @@
pc = &Stack[SP-1]; // to keep track of current cons cell
t = peek(f);
while (t != TOK_CLOSE) {
- if (feof(f))
+ if (ios_eof(f))
lerror(ParseError, "read: unexpected end of input");
c = mk_cons(); car_(c) = cdr_(c) = NIL;
if (iscons(*pc)) {
@@ -428,7 +428,7 @@
c = do_read_sexpr(f,UNBOUND);
cdr_(*pc) = c;
t = peek(f);
- if (feof(f))
+ if (ios_eof(f))
lerror(ParseError, "read: unexpected end of input");
if (t != TOK_CLOSE)
lerror(ParseError, "read: expected ')'");
@@ -439,7 +439,7 @@
}
// 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 *pv;
@@ -529,7 +529,7 @@
return NIL;
}
-value_t read_sexpr(FILE *f)
+value_t read_sexpr(ios_t *f)
{
value_t v;
readstate_t state;
--- a/femtolisp/torus.lsp
+++ b/femtolisp/torus.lsp
@@ -37,6 +37,7 @@
l))
(time (progn (print (torus 100 100)) nil))
+;(time (dotimes (i 1) (load "100x100.lsp")))
; with ltable
; printing time: 0.415sec
; reading time: 0.165sec
--- a/llt/hashing.c
+++ b/llt/hashing.c
@@ -129,4 +129,6 @@
flt_tolerance(5e-6);
randomize();
+
+ ios_init_stdstreams();
}
--- a/llt/ios.c
+++ b/llt/ios.c
@@ -302,6 +302,25 @@
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)
{
if (n == 0) return 0;
@@ -421,10 +440,13 @@
return 1;
if (s->_eof)
return 1;
+ return 0;
+ /*
if (_fd_available(s->fd))
return 0;
s->_eof = 1;
return 1;
+ */
}
static void _discard_partial_buffer(ios_t *s)
@@ -646,36 +668,22 @@
return s;
}
-ios_t *ios_stdin()
-{
- static ios_t *_ios_stdin = NULL;
- if (_ios_stdin == NULL) {
- _ios_stdin = malloc(sizeof(ios_t));
- ios_fd(_ios_stdin, STDIN_FILENO, 0);
- }
- return _ios_stdin;
-}
+ios_t *ios_stdin = NULL;
+ios_t *ios_stdout = NULL;
+ios_t *ios_stderr = NULL;
-ios_t *ios_stdout()
+void ios_init_stdstreams()
{
- static ios_t *_ios_stdout = NULL;
- if (_ios_stdout == NULL) {
- _ios_stdout = malloc(sizeof(ios_t));
- ios_fd(_ios_stdout, STDOUT_FILENO, 0);
- _ios_stdout->bm = bm_line;
- }
- return _ios_stdout;
-}
+ ios_stdin = malloc(sizeof(ios_t));
+ ios_fd(ios_stdin, STDIN_FILENO, 0);
-ios_t *ios_stderr()
-{
- static ios_t *_ios_stderr = NULL;
- if (_ios_stderr == NULL) {
- _ios_stderr = malloc(sizeof(ios_t));
- ios_fd(_ios_stderr, STDERR_FILENO, 0);
- _ios_stderr->bm = bm_none;
- }
- return _ios_stderr;
+ ios_stdout = malloc(sizeof(ios_t));
+ ios_fd(ios_stdout, STDOUT_FILENO, 0);
+ ios_stdout->bm = bm_line;
+
+ ios_stderr = malloc(sizeof(ios_t));
+ ios_fd(ios_stderr, STDERR_FILENO, 0);
+ ios_stderr->bm = bm_none;
}
/* higher level interface */
@@ -689,10 +697,11 @@
int ios_getc(ios_t *s)
{
+ if (s->bpos < s->size)
+ return s->buf[s->bpos++];
if (s->_eof) return IOS_EOF;
char ch;
- size_t n = ios_read(s, &ch, 1);
- if (n < 1)
+ if (ios_read(s, &ch, 1) < 1)
return IOS_EOF;
return (int)ch;
}
@@ -716,20 +725,53 @@
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, ...)
{
- char *str;
+ char buf[512];
+ char *str=&buf[0];
va_list args;
+ int c;
va_start(args, format);
+
// 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);
- if (c == -1) return c;
+ if (c < 0) return c;
ios_write(s, str, c);
- free(str);
+ if (str != &buf[0]) free(str);
return c;
}
--- a/llt/ios.h
+++ b/llt/ios.h
@@ -9,7 +9,7 @@
typedef enum { bst_none, bst_rd, bst_wr } bufstate_t;
#define IOS_INLSIZE 54
-#define IOS_BUFSIZE 4095
+#define IOS_BUFSIZE 8191
typedef struct {
bufmode_t bm;
@@ -79,8 +79,8 @@
void ios_bswap(ios_t *s, int bswap);
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);
+// ensure at least n bytes are buffered if possible. returns # available.
+size_t ios_readprep(ios_t *from, size_t n);
//void ios_lock(ios_t *s);
//int ios_trylock(ios_t *s);
//int ios_unlock(ios_t *s);
@@ -91,9 +91,10 @@
ios_t *ios_str(ios_t *s, char *str);
ios_t *ios_fd(ios_t *s, long fd, int isfile);
// todo: ios_socket
-ios_t *ios_stdin();
-ios_t *ios_stdout();
-ios_t *ios_stderr();
+extern ios_t *ios_stdin;
+extern ios_t *ios_stdout;
+extern ios_t *ios_stderr;
+void ios_init_stdstreams();
/* high-level functions - output */
int ios_putnum(ios_t *s, char *data, uint32_t type);
--- a/llt/utf8.c
+++ b/llt/utf8.c
@@ -80,7 +80,7 @@
sz = dest size in # of wide characters
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)
{
@@ -565,23 +565,25 @@
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;
u_int32_t *wcs;
sz = 512;
buf = (char*)alloca(sz);
- try_print:
cnt = vsnprintf(buf, sz, fmt, ap);
+ if ((ssize_t)cnt < 0)
+ return 0;
if (cnt >= sz) {
- buf = (char*)alloca(cnt - sz + 1);
- sz = cnt + 1;
- goto try_print;
+ buf = (char*)malloc(cnt + 1);
+ needfree = 1;
+ vsnprintf(buf, cnt+1, fmt, ap);
}
wcs = (u_int32_t*)alloca((cnt+1) * sizeof(u_int32_t));
nc = u8_toucs(wcs, cnt+1, buf, cnt);
wcs[nc] = 0;
printf("%ls", (wchar_t*)wcs);
+ if (needfree) free(buf);
return nc;
}
@@ -701,28 +703,4 @@
}
}
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;
}
--- a/llt/utf8.h
+++ b/llt/utf8.h
@@ -121,8 +121,4 @@
be allocated to at least len+1 bytes. returns 1 for error, 0 otherwise */
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