using global variables uniformly for print settings instead of passing
around one of them fixing unwind-protect not to duplicate code
This commit is contained in:
		
							parent
							
								
									264df1f90b
								
							
						
					
					
						commit
						63edc82ba4
					
				| 
						 | 
					@ -94,7 +94,8 @@ value_t IOError, ParseError, TypeError, ArgError, UnboundError, MemoryError;
 | 
				
			||||||
value_t DivideError, BoundsError, Error, KeyError, EnumerationError;
 | 
					value_t DivideError, BoundsError, Error, KeyError, EnumerationError;
 | 
				
			||||||
value_t conssym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
 | 
					value_t conssym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
 | 
				
			||||||
value_t definesym, defmacrosym, forsym, labelsym, printprettysym, setqsym;
 | 
					value_t definesym, defmacrosym, forsym, labelsym, printprettysym, setqsym;
 | 
				
			||||||
value_t printwidthsym, tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym;
 | 
					value_t printwidthsym, printreadablysym;
 | 
				
			||||||
 | 
					value_t tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
static value_t apply_cl(uint32_t nargs);
 | 
					static value_t apply_cl(uint32_t nargs);
 | 
				
			||||||
static value_t *alloc_words(int n);
 | 
					static value_t *alloc_words(int n);
 | 
				
			||||||
| 
						 | 
					@ -1486,6 +1487,7 @@ static void lisp_init(void)
 | 
				
			||||||
    tsym = symbol("t"); Tsym = symbol("T");
 | 
					    tsym = symbol("t"); Tsym = symbol("T");
 | 
				
			||||||
    fsym = symbol("f"); Fsym = symbol("F");
 | 
					    fsym = symbol("f"); Fsym = symbol("F");
 | 
				
			||||||
    set(printprettysym=symbol("*print-pretty*"), FL_T);
 | 
					    set(printprettysym=symbol("*print-pretty*"), FL_T);
 | 
				
			||||||
 | 
					    set(printreadablysym=symbol("*print-readably*"), FL_T);
 | 
				
			||||||
    set(printwidthsym=symbol("*print-width*"), fixnum(SCR_WIDTH));
 | 
					    set(printwidthsym=symbol("*print-width*"), fixnum(SCR_WIDTH));
 | 
				
			||||||
    lasterror = NIL;
 | 
					    lasterror = NIL;
 | 
				
			||||||
    i = 0;
 | 
					    i = 0;
 | 
				
			||||||
| 
						 | 
					@ -1606,7 +1608,7 @@ int main(int argc, char *argv[])
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    FL_CATCH {
 | 
					    FL_CATCH {
 | 
				
			||||||
        ios_puts("fatal error during bootstrap:\n", ios_stderr);
 | 
					        ios_puts("fatal error during bootstrap:\n", ios_stderr);
 | 
				
			||||||
        print(ios_stderr, lasterror, 0);
 | 
					        print(ios_stderr, lasterror);
 | 
				
			||||||
        ios_putc('\n', ios_stderr);
 | 
					        ios_putc('\n', ios_stderr);
 | 
				
			||||||
        return 1;
 | 
					        return 1;
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -125,12 +125,14 @@ extern value_t NIL, FL_T, FL_F;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* read, eval, print main entry points */
 | 
					/* read, eval, print main entry points */
 | 
				
			||||||
value_t read_sexpr(value_t f);
 | 
					value_t read_sexpr(value_t f);
 | 
				
			||||||
void print(ios_t *f, value_t v, int princ);
 | 
					void print(ios_t *f, value_t v);
 | 
				
			||||||
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 applyn(uint32_t n, value_t f, ...);
 | 
					value_t applyn(uint32_t n, value_t f, ...);
 | 
				
			||||||
value_t load_file(char *fname);
 | 
					value_t load_file(char *fname);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					extern value_t printprettysym, printreadablysym, printwidthsym;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
/* object model manipulation */
 | 
					/* object model manipulation */
 | 
				
			||||||
value_t fl_cons(value_t a, value_t b);
 | 
					value_t fl_cons(value_t a, value_t b);
 | 
				
			||||||
value_t list2(value_t a, value_t b);
 | 
					value_t list2(value_t a, value_t b);
 | 
				
			||||||
| 
						 | 
					@ -167,7 +169,7 @@ static inline void argcount(char *fname, uint32_t nargs, uint32_t c)
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
typedef struct {
 | 
					typedef struct {
 | 
				
			||||||
    void (*print)(value_t self, ios_t *f, int princ);
 | 
					    void (*print)(value_t self, ios_t *f);
 | 
				
			||||||
    void (*relocate)(value_t oldv, value_t newv);
 | 
					    void (*relocate)(value_t oldv, value_t newv);
 | 
				
			||||||
    void (*finalize)(value_t self);
 | 
					    void (*finalize)(value_t self);
 | 
				
			||||||
    void (*print_traverse)(value_t self);
 | 
					    void (*print_traverse)(value_t self);
 | 
				
			||||||
| 
						 | 
					@ -178,7 +180,7 @@ value_t relocate_lispvalue(value_t v);
 | 
				
			||||||
void print_traverse(value_t v);
 | 
					void print_traverse(value_t v);
 | 
				
			||||||
void fl_print_chr(char c, ios_t *f);
 | 
					void fl_print_chr(char c, ios_t *f);
 | 
				
			||||||
void fl_print_str(char *s, ios_t *f);
 | 
					void fl_print_str(char *s, ios_t *f);
 | 
				
			||||||
void fl_print_child(ios_t *f, value_t v, int princ);
 | 
					void fl_print_child(ios_t *f, value_t v);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
typedef int (*cvinitfunc_t)(struct _fltype_t*, value_t, void*);
 | 
					typedef int (*cvinitfunc_t)(struct _fltype_t*, value_t, void*);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -11,10 +11,9 @@ static value_t iostreamsym, rdsym, wrsym, apsym, crsym, truncsym;
 | 
				
			||||||
static value_t instrsym, outstrsym;
 | 
					static value_t instrsym, outstrsym;
 | 
				
			||||||
fltype_t *iostreamtype;
 | 
					fltype_t *iostreamtype;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void print_iostream(value_t v, ios_t *f, int princ)
 | 
					void print_iostream(value_t v, ios_t *f)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    (void)v;
 | 
					    (void)v;
 | 
				
			||||||
    (void)princ;
 | 
					 | 
				
			||||||
    fl_print_str("#<io stream>", f);
 | 
					    fl_print_str("#<io stream>", f);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -167,24 +166,27 @@ value_t fl_ioseek(value_t *args, u_int32_t nargs)
 | 
				
			||||||
    return FL_T;
 | 
					    return FL_T;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
static void do_ioprint(value_t *args, u_int32_t nargs, int princ, char *fname)
 | 
					static void do_ioprint(value_t *args, u_int32_t nargs, char *fname)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    if (nargs < 2 || nargs > MAX_ARGS)
 | 
					    if (nargs < 2 || nargs > MAX_ARGS)
 | 
				
			||||||
        argcount(fname, nargs, 2);
 | 
					        argcount(fname, nargs, 2);
 | 
				
			||||||
    ios_t *s = toiostream(args[0], fname);
 | 
					    ios_t *s = toiostream(args[0], fname);
 | 
				
			||||||
    unsigned i;
 | 
					    unsigned i;
 | 
				
			||||||
    for (i=1; i < nargs; i++) {
 | 
					    for (i=1; i < nargs; i++) {
 | 
				
			||||||
        print(s, args[i], princ);
 | 
					        print(s, args[i]);
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
value_t fl_ioprint(value_t *args, u_int32_t nargs)
 | 
					value_t fl_ioprint(value_t *args, u_int32_t nargs)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    do_ioprint(args, nargs, 0, "io.print");
 | 
					    do_ioprint(args, nargs, "io.print");
 | 
				
			||||||
    return args[nargs-1];
 | 
					    return args[nargs-1];
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
value_t fl_ioprinc(value_t *args, u_int32_t nargs)
 | 
					value_t fl_ioprinc(value_t *args, u_int32_t nargs)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    do_ioprint(args, nargs, 1, "io.princ");
 | 
					    value_t oldpr = symbol_value(printreadablysym);
 | 
				
			||||||
 | 
					    set(printreadablysym, FL_F);
 | 
				
			||||||
 | 
					    do_ioprint(args, nargs, "io.princ");
 | 
				
			||||||
 | 
					    set(printreadablysym, oldpr);
 | 
				
			||||||
    return args[nargs-1];
 | 
					    return args[nargs-1];
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,6 +1,7 @@
 | 
				
			||||||
static htable_t printconses;
 | 
					static htable_t printconses;
 | 
				
			||||||
static u_int32_t printlabel;
 | 
					static u_int32_t printlabel;
 | 
				
			||||||
static int print_pretty;
 | 
					static int print_pretty;
 | 
				
			||||||
 | 
					static int print_princ;
 | 
				
			||||||
static int SCR_WIDTH = 80;
 | 
					static int SCR_WIDTH = 80;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
static int HPOS, VPOS;
 | 
					static int HPOS, VPOS;
 | 
				
			||||||
| 
						 | 
					@ -247,7 +248,7 @@ static int blockindent(value_t v)
 | 
				
			||||||
    return (allsmallp(v) > 9);
 | 
					    return (allsmallp(v) > 9);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
static void print_pair(ios_t *f, value_t v, int princ)
 | 
					static void print_pair(ios_t *f, value_t v)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    value_t cd;
 | 
					    value_t cd;
 | 
				
			||||||
    char *op = NULL;
 | 
					    char *op = NULL;
 | 
				
			||||||
| 
						 | 
					@ -262,7 +263,7 @@ static void print_pair(ios_t *f, value_t v, int princ)
 | 
				
			||||||
        unmark_cons(v);
 | 
					        unmark_cons(v);
 | 
				
			||||||
        unmark_cons(cdr_(v));
 | 
					        unmark_cons(cdr_(v));
 | 
				
			||||||
        outs(op, f);
 | 
					        outs(op, f);
 | 
				
			||||||
        fl_print_child(f, car_(cdr_(v)), princ);
 | 
					        fl_print_child(f, car_(cdr_(v)));
 | 
				
			||||||
        return;
 | 
					        return;
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    int startpos = HPOS;
 | 
					    int startpos = HPOS;
 | 
				
			||||||
| 
						 | 
					@ -277,20 +278,20 @@ static void print_pair(ios_t *f, value_t v, int princ)
 | 
				
			||||||
    while (1) {
 | 
					    while (1) {
 | 
				
			||||||
        lastv = VPOS;
 | 
					        lastv = VPOS;
 | 
				
			||||||
        unmark_cons(v);
 | 
					        unmark_cons(v);
 | 
				
			||||||
        fl_print_child(f, car_(v), princ);
 | 
					        fl_print_child(f, car_(v));
 | 
				
			||||||
        cd = cdr_(v);
 | 
					        cd = cdr_(v);
 | 
				
			||||||
        if (!iscons(cd) || ptrhash_has(&printconses, (void*)cd)) {
 | 
					        if (!iscons(cd) || ptrhash_has(&printconses, (void*)cd)) {
 | 
				
			||||||
            if (cd != NIL) {
 | 
					            if (cd != NIL) {
 | 
				
			||||||
                outsn(" . ", f, 3);
 | 
					                outsn(" . ", f, 3);
 | 
				
			||||||
                fl_print_child(f, cd, princ);
 | 
					                fl_print_child(f, cd);
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            outc(')', f);
 | 
					            outc(')', f);
 | 
				
			||||||
            break;
 | 
					            break;
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        if (princ || !print_pretty ||
 | 
					        if (!print_pretty ||
 | 
				
			||||||
            ((head == LAMBDA || head == labelsym) && n == 0)) {
 | 
					            ((head == LAMBDA || head == labelsym) && n == 0)) {
 | 
				
			||||||
            // never break line before lambda-list or in princ
 | 
					            // never break line before lambda-list
 | 
				
			||||||
            ind = 0;
 | 
					            ind = 0;
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        else {
 | 
					        else {
 | 
				
			||||||
| 
						 | 
					@ -337,9 +338,9 @@ static void print_pair(ios_t *f, value_t v, int princ)
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
static void cvalue_print(ios_t *f, value_t v, int princ);
 | 
					static void cvalue_print(ios_t *f, value_t v);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void fl_print_child(ios_t *f, value_t v, int princ)
 | 
					void fl_print_child(ios_t *f, value_t v)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    value_t label;
 | 
					    value_t label;
 | 
				
			||||||
    char *name;
 | 
					    char *name;
 | 
				
			||||||
| 
						 | 
					@ -349,7 +350,7 @@ void fl_print_child(ios_t *f, value_t v, int princ)
 | 
				
			||||||
    case TAG_NUM1: HPOS+=ios_printf(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 (print_princ)
 | 
				
			||||||
            outs(name, f);
 | 
					            outs(name, f);
 | 
				
			||||||
        else if (ismanaged(v)) {
 | 
					        else if (ismanaged(v)) {
 | 
				
			||||||
            outsn("#:", f, 2);
 | 
					            outsn("#:", f, 2);
 | 
				
			||||||
| 
						 | 
					@ -369,7 +370,7 @@ void fl_print_child(ios_t *f, value_t v, int princ)
 | 
				
			||||||
            outsn("()", f, 2);
 | 
					            outsn("()", f, 2);
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        else if (isbuiltin(v)) {
 | 
					        else if (isbuiltin(v)) {
 | 
				
			||||||
            if (!princ)
 | 
					            if (!print_princ)
 | 
				
			||||||
                outsn("#.", f, 2);
 | 
					                outsn("#.", f, 2);
 | 
				
			||||||
            outs(builtin_names[uintval(v)], f);
 | 
					            outs(builtin_names[uintval(v)], f);
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
| 
						 | 
					@ -380,13 +381,13 @@ void fl_print_child(ios_t *f, value_t v, int princ)
 | 
				
			||||||
            char *data = cvalue_data(fn->bcode);
 | 
					            char *data = cvalue_data(fn->bcode);
 | 
				
			||||||
            size_t i, sz = cvalue_len(fn->bcode);
 | 
					            size_t i, sz = cvalue_len(fn->bcode);
 | 
				
			||||||
            for(i=0; i < sz; i++) data[i] += 48;
 | 
					            for(i=0; i < sz; i++) data[i] += 48;
 | 
				
			||||||
            fl_print_child(f, fn->bcode, 0);
 | 
					            fl_print_child(f, fn->bcode);
 | 
				
			||||||
            for(i=0; i < sz; i++) data[i] -= 48;
 | 
					            for(i=0; i < sz; i++) data[i] -= 48;
 | 
				
			||||||
            outc(' ', f);
 | 
					            outc(' ', f);
 | 
				
			||||||
            fl_print_child(f, fn->vals, 0);
 | 
					            fl_print_child(f, fn->vals);
 | 
				
			||||||
            if (fn->env != NIL) {
 | 
					            if (fn->env != NIL) {
 | 
				
			||||||
                outc(' ', f);
 | 
					                outc(' ', f);
 | 
				
			||||||
                fl_print_child(f, fn->env, 0);
 | 
					                fl_print_child(f, fn->env);
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            outc(')', f);
 | 
					            outc(')', f);
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
| 
						 | 
					@ -410,9 +411,9 @@ void fl_print_child(ios_t *f, value_t v, int princ)
 | 
				
			||||||
            unmark_cons(v);
 | 
					            unmark_cons(v);
 | 
				
			||||||
            int i, sz = vector_size(v);
 | 
					            int i, sz = vector_size(v);
 | 
				
			||||||
            for(i=0; i < sz; i++) {
 | 
					            for(i=0; i < sz; i++) {
 | 
				
			||||||
                fl_print_child(f, vector_elt(v,i), princ);
 | 
					                fl_print_child(f, vector_elt(v,i));
 | 
				
			||||||
                if (i < sz-1) {
 | 
					                if (i < sz-1) {
 | 
				
			||||||
                    if (princ || !print_pretty) {
 | 
					                    if (!print_pretty) {
 | 
				
			||||||
                        outc(' ', f);
 | 
					                        outc(' ', f);
 | 
				
			||||||
                    }
 | 
					                    }
 | 
				
			||||||
                    else {
 | 
					                    else {
 | 
				
			||||||
| 
						 | 
					@ -434,10 +435,10 @@ void fl_print_child(ios_t *f, value_t v, int princ)
 | 
				
			||||||
        if (iscvalue(v) || iscprim(v)) {
 | 
					        if (iscvalue(v) || iscprim(v)) {
 | 
				
			||||||
            if (ismanaged(v))
 | 
					            if (ismanaged(v))
 | 
				
			||||||
                unmark_cons(v);
 | 
					                unmark_cons(v);
 | 
				
			||||||
            cvalue_print(f, v, princ);
 | 
					            cvalue_print(f, v);
 | 
				
			||||||
            break;
 | 
					            break;
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        print_pair(f, v, princ);
 | 
					        print_pair(f, v);
 | 
				
			||||||
        break;
 | 
					        break;
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -479,13 +480,13 @@ static numerictype_t sym_to_numtype(value_t type);
 | 
				
			||||||
// 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(ios_t *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 weak)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    int64_t tmp=0;
 | 
					    int64_t tmp=0;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (type == bytesym) {
 | 
					    if (type == bytesym) {
 | 
				
			||||||
        unsigned char ch = *(unsigned char*)data;
 | 
					        unsigned char ch = *(unsigned char*)data;
 | 
				
			||||||
        if (princ)
 | 
					        if (print_princ)
 | 
				
			||||||
            outc(ch, f);
 | 
					            outc(ch, f);
 | 
				
			||||||
        else if (weak)
 | 
					        else if (weak)
 | 
				
			||||||
            HPOS+=ios_printf(f, "0x%hhx", ch);
 | 
					            HPOS+=ios_printf(f, "0x%hhx", ch);
 | 
				
			||||||
| 
						 | 
					@ -495,11 +496,11 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
    else if (type == wcharsym) {
 | 
					    else if (type == wcharsym) {
 | 
				
			||||||
        uint32_t wc = *(uint32_t*)data;
 | 
					        uint32_t wc = *(uint32_t*)data;
 | 
				
			||||||
        char seq[8];
 | 
					        char seq[8];
 | 
				
			||||||
        if (princ || iswprint(wc)) {
 | 
					        if (print_princ || iswprint(wc)) {
 | 
				
			||||||
            size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);
 | 
					            size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);
 | 
				
			||||||
            seq[nb] = '\0';
 | 
					            seq[nb] = '\0';
 | 
				
			||||||
            // TODO: better multibyte handling
 | 
					            // TODO: better multibyte handling
 | 
				
			||||||
            if (!princ) outsn("#\\", f, 2);
 | 
					            if (!print_princ) outsn("#\\", f, 2);
 | 
				
			||||||
            outs(seq, f);
 | 
					            outs(seq, f);
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        else {
 | 
					        else {
 | 
				
			||||||
| 
						 | 
					@ -512,8 +513,8 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
             ) {
 | 
					             ) {
 | 
				
			||||||
        int64_t i64 = *(int64_t*)data;
 | 
					        int64_t i64 = *(int64_t*)data;
 | 
				
			||||||
        if (fits_fixnum(i64) || princ) {
 | 
					        if (fits_fixnum(i64) || print_princ) {
 | 
				
			||||||
            if (weak || princ)
 | 
					            if (weak || print_princ)
 | 
				
			||||||
                HPOS+=ios_printf(f, "%lld", i64);
 | 
					                HPOS+=ios_printf(f, "%lld", i64);
 | 
				
			||||||
            else
 | 
					            else
 | 
				
			||||||
                HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), i64);
 | 
					                HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), i64);
 | 
				
			||||||
| 
						 | 
					@ -529,8 +530,8 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
             ) {
 | 
					             ) {
 | 
				
			||||||
        uint64_t ui64 = *(uint64_t*)data;
 | 
					        uint64_t ui64 = *(uint64_t*)data;
 | 
				
			||||||
        if (fits_fixnum(ui64) || princ) {
 | 
					        if (fits_fixnum(ui64) || print_princ) {
 | 
				
			||||||
            if (weak || princ)
 | 
					            if (weak || print_princ)
 | 
				
			||||||
                HPOS+=ios_printf(f, "%llu", ui64);
 | 
					                HPOS+=ios_printf(f, "%llu", ui64);
 | 
				
			||||||
            else
 | 
					            else
 | 
				
			||||||
                HPOS+=ios_printf(f, "#%s(%llu)", symbol_name(type), ui64);
 | 
					                HPOS+=ios_printf(f, "#%s(%llu)", symbol_name(type), ui64);
 | 
				
			||||||
| 
						 | 
					@ -552,7 +553,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
                rep = sign_bit(d) ? "-NaN" : "+NaN";
 | 
					                rep = sign_bit(d) ? "-NaN" : "+NaN";
 | 
				
			||||||
            else
 | 
					            else
 | 
				
			||||||
                rep = sign_bit(d) ? "-Inf" : "+Inf";
 | 
					                rep = sign_bit(d) ? "-Inf" : "+Inf";
 | 
				
			||||||
            if (type == floatsym && !princ && !weak)
 | 
					            if (type == floatsym && !print_princ && !weak)
 | 
				
			||||||
                HPOS+=ios_printf(f, "#%s(%s)", symbol_name(type), rep);
 | 
					                HPOS+=ios_printf(f, "#%s(%s)", symbol_name(type), rep);
 | 
				
			||||||
            else
 | 
					            else
 | 
				
			||||||
                outs(rep, f);
 | 
					                outs(rep, f);
 | 
				
			||||||
| 
						 | 
					@ -562,7 +563,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
                outsn("-0.0", f, 4);
 | 
					                outsn("-0.0", f, 4);
 | 
				
			||||||
            else
 | 
					            else
 | 
				
			||||||
                outsn("0.0", f, 3);
 | 
					                outsn("0.0", f, 3);
 | 
				
			||||||
            if (type == floatsym && !princ && !weak)
 | 
					            if (type == floatsym && !print_princ && !weak)
 | 
				
			||||||
                outc('f', f);
 | 
					                outc('f', f);
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        else {
 | 
					        else {
 | 
				
			||||||
| 
						 | 
					@ -570,7 +571,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
            int hasdec = (strpbrk(buf, ".eE") != NULL);
 | 
					            int hasdec = (strpbrk(buf, ".eE") != NULL);
 | 
				
			||||||
            outs(buf, f);
 | 
					            outs(buf, f);
 | 
				
			||||||
            if (!hasdec) outsn(".0", f, 2);
 | 
					            if (!hasdec) outsn(".0", f, 2);
 | 
				
			||||||
            if (type == floatsym && !princ && !weak)
 | 
					            if (type == floatsym && !print_princ && !weak)
 | 
				
			||||||
                outc('f', f);
 | 
					                outc('f', f);
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
| 
						 | 
					@ -578,8 +579,8 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
        // handle other integer prims. we know it's smaller than 64 bits
 | 
					        // handle other integer prims. we know it's smaller than 64 bits
 | 
				
			||||||
        // at this point, so int64 is big enough to capture everything.
 | 
					        // at this point, so int64 is big enough to capture everything.
 | 
				
			||||||
        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) || print_princ) {
 | 
				
			||||||
            if (weak || princ)
 | 
					            if (weak || print_princ)
 | 
				
			||||||
                HPOS+=ios_printf(f, "%lld", tmp);
 | 
					                HPOS+=ios_printf(f, "%lld", tmp);
 | 
				
			||||||
            else
 | 
					            else
 | 
				
			||||||
                HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), tmp);
 | 
					                HPOS+=ios_printf(f, "#%s(%lld)", symbol_name(type), tmp);
 | 
				
			||||||
| 
						 | 
					@ -603,7 +604,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
                cnt = elsize ? len/elsize : 0;
 | 
					                cnt = elsize ? len/elsize : 0;
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            if (eltype == bytesym) {
 | 
					            if (eltype == bytesym) {
 | 
				
			||||||
                if (princ) {
 | 
					                if (print_princ) {
 | 
				
			||||||
                    ios_write(f, data, len);
 | 
					                    ios_write(f, data, len);
 | 
				
			||||||
                }
 | 
					                }
 | 
				
			||||||
                else {
 | 
					                else {
 | 
				
			||||||
| 
						 | 
					@ -623,7 +624,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
                }
 | 
					                }
 | 
				
			||||||
                else {
 | 
					                else {
 | 
				
			||||||
                    outsn("#array(", f, 7);
 | 
					                    outsn("#array(", f, 7);
 | 
				
			||||||
                    fl_print_child(f, eltype, princ);
 | 
					                    fl_print_child(f, eltype);
 | 
				
			||||||
                    if (cnt > 0)
 | 
					                    if (cnt > 0)
 | 
				
			||||||
                        outc(' ', f);
 | 
					                        outc(' ', f);
 | 
				
			||||||
                }
 | 
					                }
 | 
				
			||||||
| 
						 | 
					@ -634,7 +635,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
            for(i=0; i < cnt; i++) {
 | 
					            for(i=0; i < cnt; i++) {
 | 
				
			||||||
                if (i > 0)
 | 
					                if (i > 0)
 | 
				
			||||||
                    outc(' ', f);
 | 
					                    outc(' ', f);
 | 
				
			||||||
                cvalue_printdata(f, data, elsize, eltype, princ, 1);
 | 
					                cvalue_printdata(f, data, elsize, eltype, 1);
 | 
				
			||||||
                data += elsize;
 | 
					                data += elsize;
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            if (!weak)
 | 
					            if (!weak)
 | 
				
			||||||
| 
						 | 
					@ -648,14 +649,14 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
            assert(isvector(syms));
 | 
					            assert(isvector(syms));
 | 
				
			||||||
            if (!weak) {
 | 
					            if (!weak) {
 | 
				
			||||||
                outsn("#enum(", f, 6);
 | 
					                outsn("#enum(", f, 6);
 | 
				
			||||||
                fl_print_child(f, syms, princ);
 | 
					                fl_print_child(f, syms);
 | 
				
			||||||
                outc(' ', f);
 | 
					                outc(' ', f);
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            if (n >= (int)vector_size(syms)) {
 | 
					            if (n >= (int)vector_size(syms)) {
 | 
				
			||||||
                cvalue_printdata(f, data, len, int32sym, princ, 1);
 | 
					                cvalue_printdata(f, data, len, int32sym, 1);
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            else {
 | 
					            else {
 | 
				
			||||||
                fl_print_child(f, vector_elt(syms, n), princ);
 | 
					                fl_print_child(f, vector_elt(syms, n));
 | 
				
			||||||
            }
 | 
					            }
 | 
				
			||||||
            if (!weak)
 | 
					            if (!weak)
 | 
				
			||||||
                outc(')', f);
 | 
					                outc(')', f);
 | 
				
			||||||
| 
						 | 
					@ -663,7 +664,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
static void cvalue_print(ios_t *f, value_t v, int princ)
 | 
					static void cvalue_print(ios_t *f, value_t v)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    cvalue_t *cv = (cvalue_t*)ptr(v);
 | 
					    cvalue_t *cv = (cvalue_t*)ptr(v);
 | 
				
			||||||
    void *data = cptr(v);
 | 
					    void *data = cptr(v);
 | 
				
			||||||
| 
						 | 
					@ -677,7 +678,7 @@ static void cvalue_print(ios_t *f, value_t v, int princ)
 | 
				
			||||||
                               (unsigned long)(builtin_t)fptr);
 | 
					                               (unsigned long)(builtin_t)fptr);
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        else {
 | 
					        else {
 | 
				
			||||||
            if (princ)
 | 
					            if (print_princ)
 | 
				
			||||||
                outs(symbol_name(label), f);
 | 
					                outs(symbol_name(label), f);
 | 
				
			||||||
            else
 | 
					            else
 | 
				
			||||||
                HPOS += ios_printf(f, "#builtin(%s)", symbol_name(label));
 | 
					                HPOS += ios_printf(f, "#builtin(%s)", symbol_name(label));
 | 
				
			||||||
| 
						 | 
					@ -685,12 +686,12 @@ static void cvalue_print(ios_t *f, value_t v, int princ)
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    else if (cv_class(cv)->vtable != NULL &&
 | 
					    else if (cv_class(cv)->vtable != NULL &&
 | 
				
			||||||
             cv_class(cv)->vtable->print != NULL) {
 | 
					             cv_class(cv)->vtable->print != NULL) {
 | 
				
			||||||
        cv_class(cv)->vtable->print(v, f, princ);
 | 
					        cv_class(cv)->vtable->print(v, f);
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    else {
 | 
					    else {
 | 
				
			||||||
        value_t type = cv_type(cv);
 | 
					        value_t type = cv_type(cv);
 | 
				
			||||||
        size_t len = iscprim(v) ? cv_class(cv)->size : cv_len(cv);
 | 
					        size_t len = iscprim(v) ? cv_class(cv)->size : cv_len(cv);
 | 
				
			||||||
        cvalue_printdata(f, data, len, type, princ, 0);
 | 
					        cvalue_printdata(f, data, len, type, 0);
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -701,16 +702,17 @@ static void set_print_width()
 | 
				
			||||||
    SCR_WIDTH = numval(pw);
 | 
					    SCR_WIDTH = numval(pw);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void print(ios_t *f, value_t v, int princ)
 | 
					void print(ios_t *f, value_t v)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    print_pretty = (symbol_value(printprettysym) != FL_F);
 | 
					    print_pretty = (symbol_value(printprettysym) != FL_F);
 | 
				
			||||||
    if (print_pretty)
 | 
					    if (print_pretty)
 | 
				
			||||||
        set_print_width();
 | 
					        set_print_width();
 | 
				
			||||||
 | 
					    print_princ = (symbol_value(printreadablysym) == FL_F);
 | 
				
			||||||
    printlabel = 0;
 | 
					    printlabel = 0;
 | 
				
			||||||
    print_traverse(v);
 | 
					    print_traverse(v);
 | 
				
			||||||
    HPOS = VPOS = 0;
 | 
					    HPOS = VPOS = 0;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    fl_print_child(f, v, princ);
 | 
					    fl_print_child(f, v);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    htable_reset(&printconses, 32);
 | 
					    htable_reset(&printconses, 32);
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -110,9 +110,15 @@ value_t fl_string(value_t *args, u_int32_t nargs)
 | 
				
			||||||
    value_t arg, buf = fl_buffer(NULL, 0);
 | 
					    value_t arg, buf = fl_buffer(NULL, 0);
 | 
				
			||||||
    ios_t *s = value2c(ios_t*,buf);
 | 
					    ios_t *s = value2c(ios_t*,buf);
 | 
				
			||||||
    uint32_t i;
 | 
					    uint32_t i;
 | 
				
			||||||
 | 
					    value_t oldpr = symbol_value(printreadablysym);
 | 
				
			||||||
 | 
					    value_t oldpp = symbol_value(printprettysym);
 | 
				
			||||||
 | 
					    set(printreadablysym, FL_F);
 | 
				
			||||||
 | 
					    set(printprettysym, FL_F);
 | 
				
			||||||
    FOR_ARGS(i,0,arg,args) {
 | 
					    FOR_ARGS(i,0,arg,args) {
 | 
				
			||||||
        print(s, args[i], 1);
 | 
					        print(s, args[i]);
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
 | 
					    set(printreadablysym, oldpr);
 | 
				
			||||||
 | 
					    set(printprettysym, oldpp);
 | 
				
			||||||
    PUSH(buf);
 | 
					    PUSH(buf);
 | 
				
			||||||
    value_t outp = stream_to_string(&Stack[SP-1]);
 | 
					    value_t outp = stream_to_string(&Stack[SP-1]);
 | 
				
			||||||
    (void)POP();
 | 
					    (void)POP();
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -440,10 +440,12 @@
 | 
				
			||||||
				(raise ,e))))))
 | 
									(raise ,e))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-macro (unwind-protect expr finally)
 | 
					(define-macro (unwind-protect expr finally)
 | 
				
			||||||
  (let ((e (gensym)))
 | 
					  (let ((e   (gensym))
 | 
				
			||||||
    `(prog1 (trycatch ,expr
 | 
						(thk (gensym)))
 | 
				
			||||||
                      (lambda (,e) (begin ,finally (raise ,e))))
 | 
					    `(let ((,thk (lambda () ,finally)))
 | 
				
			||||||
	    ,finally)))
 | 
					       (prog1 (trycatch ,expr
 | 
				
			||||||
 | 
								(lambda (,e) (begin (,thk) (raise ,e))))
 | 
				
			||||||
 | 
						      (,thk)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
; debugging utilities ---------------------------------------------------------
 | 
					; debugging utilities ---------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -11,7 +11,7 @@
 | 
				
			||||||
static value_t tablesym;
 | 
					static value_t tablesym;
 | 
				
			||||||
static fltype_t *tabletype;
 | 
					static fltype_t *tabletype;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void print_htable(value_t v, ios_t *f, int princ)
 | 
					void print_htable(value_t v, ios_t *f)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(v));
 | 
					    htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(v));
 | 
				
			||||||
    size_t i;
 | 
					    size_t i;
 | 
				
			||||||
| 
						 | 
					@ -20,9 +20,9 @@ void print_htable(value_t v, ios_t *f, int princ)
 | 
				
			||||||
    for(i=0; i < h->size; i+=2) {
 | 
					    for(i=0; i < h->size; i+=2) {
 | 
				
			||||||
        if (h->table[i+1] != HT_NOTFOUND) {
 | 
					        if (h->table[i+1] != HT_NOTFOUND) {
 | 
				
			||||||
            if (!first) fl_print_str("  ", f);
 | 
					            if (!first) fl_print_str("  ", f);
 | 
				
			||||||
            fl_print_child(f, (value_t)h->table[i], princ);
 | 
					            fl_print_child(f, (value_t)h->table[i]);
 | 
				
			||||||
            fl_print_chr(' ', f);
 | 
					            fl_print_chr(' ', f);
 | 
				
			||||||
            fl_print_child(f, (value_t)h->table[i+1], princ);
 | 
					            fl_print_child(f, (value_t)h->table[i+1]);
 | 
				
			||||||
            first = 0;
 | 
					            first = 0;
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1025,10 +1025,12 @@ new evaluator todo:
 | 
				
			||||||
* trycatch should require 2nd arg to be a lambda expression
 | 
					* trycatch should require 2nd arg to be a lambda expression
 | 
				
			||||||
* immediate load int8 instruction
 | 
					* immediate load int8 instruction
 | 
				
			||||||
- fix equal? on functions
 | 
					- fix equal? on functions
 | 
				
			||||||
 | 
					- store function name and signature
 | 
				
			||||||
- maxstack calculation, replace Stack with C stack, alloca
 | 
					- maxstack calculation, replace Stack with C stack, alloca
 | 
				
			||||||
  - stack traces and better debugging support
 | 
					  - stack traces and better debugging support
 | 
				
			||||||
- lambda lifting
 | 
					- lambda lifting
 | 
				
			||||||
* let optimization
 | 
					* let optimization
 | 
				
			||||||
 | 
					- let eversion
 | 
				
			||||||
* have macroexpand use its own global syntax table
 | 
					* have macroexpand use its own global syntax table
 | 
				
			||||||
* be able to create/load an image file
 | 
					* be able to create/load an image file
 | 
				
			||||||
- fix trace and untrace
 | 
					- fix trace and untrace
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue