adding more ios functions
porting femtolisp to use ios for all I/O
This commit is contained in:
JeffBezanson
parent
755bb33714
commit
9acdf313b9
|
|
@ -39,8 +39,8 @@ value_t fl_print(value_t *args, u_int32_t nargs)
|
|||
{
|
||||
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 @@ value_t fl_princ(value_t *args, u_int32_t nargs)
|
|||
{
|
||||
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 @@ value_t fl_read(value_t *args, u_int32_t nargs)
|
|||
{
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -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 *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,62 +1389,64 @@ static void print_toplevel_exception()
|
|||
{
|
||||
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);
|
||||
}
|
||||
}
|
||||
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);
|
||||
lerrorbuf[sizeof(lerrorbuf)-1] = '\0';
|
||||
raise(lasterror);
|
||||
}
|
||||
fclose(f);
|
||||
ios_close(f);
|
||||
return v;
|
||||
}
|
||||
|
||||
|
|
@ -1477,7 +1479,7 @@ int main(int argc, char *argv[])
|
|||
|
||||
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 @@ int main(int argc, char *argv[])
|
|||
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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -105,8 +105,8 @@ enum {
|
|||
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);
|
||||
|
|
|
|||
|
|
@ -3,27 +3,27 @@ static u_int32_t printlabel;
|
|||
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_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;
|
||||
|
||||
|
|
@ -202,7 +202,7 @@ static int blockindent(value_t v)
|
|||
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,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;
|
||||
char *name;
|
||||
|
||||
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 @@ static void do_print(FILE *f, value_t v, int princ)
|
|||
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 @@ 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];
|
||||
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
|
||||
// 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 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
|
|||
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 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
|
|||
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 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
|
|||
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 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
|
|||
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 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
|
|||
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 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
|
|||
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 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
|
|||
}
|
||||
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 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
|
|||
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 @@ static void cvalue_printdata(FILE *f, void *data, size_t len, value_t type,
|
|||
}
|
||||
if (eltype == charsym) {
|
||||
if (princ) {
|
||||
fwrite(data, 1, len, f);
|
||||
ios_write(f, data, len);
|
||||
}
|
||||
else {
|
||||
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);
|
||||
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;
|
||||
}
|
||||
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -55,21 +55,21 @@ static u_int32_t toktype = TOK_NONE;
|
|||
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 @@ static void accumchar(char c, int *pi)
|
|||
}
|
||||
|
||||
// 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 @@ static int read_token(FILE *f, char c, int digits)
|
|||
}
|
||||
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 @@ static int read_token(FILE *f, char c, int digits)
|
|||
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 @@ static u_int32_t peek(FILE *f)
|
|||
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 @@ static u_int32_t peek(FILE *f)
|
|||
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 @@ static u_int32_t peek(FILE *f)
|
|||
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 @@ static u_int32_t peek(FILE *f)
|
|||
}
|
||||
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 @@ static u_int32_t peek(FILE *f)
|
|||
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 @@ static u_int32_t peek(FILE *f)
|
|||
}
|
||||
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,15 +256,15 @@ static u_int32_t peek(FILE *f)
|
|||
}
|
||||
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;
|
||||
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 @@ static u_int32_t peek(FILE *f)
|
|||
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 @@ static value_t read_vector(FILE *f, value_t label, u_int32_t closer)
|
|||
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 @@ static value_t read_vector(FILE *f, value_t label, u_int32_t closer)
|
|||
return POP();
|
||||
}
|
||||
|
||||
static value_t read_string(FILE *f)
|
||||
static value_t read_string(ios_t *f)
|
||||
{
|
||||
char *buf, *temp;
|
||||
char eseq[10];
|
||||
|
|
@ -330,16 +330,16 @@ static value_t read_string(FILE *f)
|
|||
}
|
||||
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");
|
||||
}
|
||||
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 @@ static value_t read_string(FILE *f)
|
|||
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 @@ static value_t read_string(FILE *f)
|
|||
(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 @@ static value_t read_string(FILE *f)
|
|||
// 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 @@ static void read_list(FILE *f, value_t *pval, value_t label)
|
|||
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 @@ static void read_list(FILE *f, value_t *pval, value_t label)
|
|||
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 @@ 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
|
||||
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 @@ static value_t do_read_sexpr(FILE *f, value_t label)
|
|||
return NIL;
|
||||
}
|
||||
|
||||
value_t read_sexpr(FILE *f)
|
||||
value_t read_sexpr(ios_t *f)
|
||||
{
|
||||
value_t v;
|
||||
readstate_t state;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -129,4 +129,6 @@ void llt_init()
|
|||
flt_tolerance(5e-6);
|
||||
|
||||
randomize();
|
||||
|
||||
ios_init_stdstreams();
|
||||
}
|
||||
|
|
|
|||
108
llt/ios.c
108
llt/ios.c
|
|
@ -302,6 +302,25 @@ size_t ios_readall(ios_t *s, char *dest, size_t n)
|
|||
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 @@ int ios_eof(ios_t *s)
|
|||
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 @@ ios_t *ios_fd(ios_t *s, long fd, int isfile)
|
|||
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_putc(int c, 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;
|
||||
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 @@ int ios_ungetc(int c, ios_t *s)
|
|||
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;
|
||||
}
|
||||
|
|
|
|||
13
llt/ios.h
13
llt/ios.h
|
|
@ -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;
|
||||
|
||||
#define IOS_INLSIZE 54
|
||||
#define IOS_BUFSIZE 4095
|
||||
#define IOS_BUFSIZE 8191
|
||||
|
||||
typedef struct {
|
||||
bufmode_t bm;
|
||||
|
|
@ -79,8 +79,8 @@ 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);
|
||||
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_mem(ios_t *s, size_t initsize);
|
|||
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);
|
||||
|
|
|
|||
38
llt/utf8.c
38
llt/utf8.c
|
|
@ -80,7 +80,7 @@ size_t u8_codingsize(u_int32_t *wcstr, size_t n)
|
|||
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 @@ int u8_is_locale_utf8(const char *locale)
|
|||
|
||||
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;
|
||||
}
|
||||
|
||||
|
|
@ -702,27 +704,3 @@ int u8_reverse(char *dest, char * src, size_t len)
|
|||
}
|
||||
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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue