shithub: femtolisp

Info  •  Files  •  Log  •  Branches

fix bug in (case)
reducing use of strlen

--- a/femtolisp/print.c

+++ b/femtolisp/print.c

@@ -14,6 +14,11 @@

     ios_puts(s, f);

     HPOS += u8_strwidth(s);

 }

+static void outsn(char *s, ios_t *f, size_t n)

+{

+    ios_write(f, s, n);

+    HPOS += u8_strwidth(s);

+}

 static int outindent(int n, ios_t *f)

 {

     // move back to left margin if we get too indented

@@ -269,7 +274,7 @@

         cd = cdr_(v);

         if (!iscons(cd) || ptrhash_has(&printconses, (void*)cd)) {

             if (cd != NIL) {

-                outs(" . ", f);

+                outsn(" . ", f, 3);

                 fl_print_child(f, cd, princ);

             }

             outc(')', f);

@@ -340,7 +345,7 @@

         if (princ)

             outs(name, f);

         else if (ismanaged(v)) {

-            outs("#:", f);

+            outsn("#:", f, 2);

             outs(name, f);

         }

         else

@@ -348,20 +353,20 @@

         break;

     case TAG_BUILTIN:

         if (v == FL_T) {

-            outs("#t", f);

+            outsn("#t", f, 2);

             break;

         }

         if (v == FL_F) {

-            outs("#f", f);

+            outsn("#f", f, 2);

             break;

         }

         if (v == NIL) {

-            outs("()", f);

+            outsn("()", f, 2);

             break;

         }

         if (isbuiltin(v)) {

             if (!princ)

-                outs("#.", f);

+                outsn("#.", f, 2);

             outs(builtin_names[uintval(v)], f);

             break;

         }

@@ -434,8 +439,8 @@

     outc('"', f);

     while (i < sz) {

-        u8_escape(buf, sizeof(buf), str, &i, sz, 1, 0);

-        outs(buf, f);

+        size_t n = u8_escape(buf, sizeof(buf), str, &i, sz, 1, 0);

+        outsn(buf, f, n-1);

     }

     outc('"', f);

 }

@@ -467,7 +472,7 @@

             size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);

             seq[nb] = '\0';

             // TODO: better multibyte handling

-            if (!princ) outs("#\\", f);

+            if (!princ) outsn("#\\", f, 2);

             outs(seq, f);

         }

         else if (weak) {

@@ -530,9 +535,9 @@

         }

         else if (d == 0) {

             if (1/d < 0)

-                outs("-0.0", f);

+                outsn("-0.0", f, 4);

             else

-                outs("0.0", f);

+                outsn("0.0", f, 3);

             if (type == floatsym && !princ && !weak)

                 outc('f', f);

         }

@@ -540,7 +545,7 @@

             snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);

             int hasdec = (strpbrk(buf, ".eE") != NULL);

             outs(buf, f);

-            if (!hasdec) outs(".0", f);

+            if (!hasdec) outsn(".0", f, 2);

             if (type == floatsym && !princ && !weak)

                 outc('f', f);

         }

@@ -589,7 +594,7 @@

             }

             size_t i;

             if (!weak) {

-                outs("#array(", f);

+                outsn("#array(", f, 7);

                 fl_print_child(f, eltype, princ);

                 if (cnt > 0)

                     outc(' ', f);

@@ -613,7 +618,7 @@

             value_t syms = car(cdr_(type));

             assert(isvector(syms));

             if (!weak) {

-                outs("#enum(", f);

+                outsn("#enum(", f, 6);

                 fl_print_child(f, syms, princ);

                 outc(' ', f);

             }

--- a/femtolisp/system.lsp

+++ b/femtolisp/system.lsp

@@ -189,9 +189,7 @@

 (define (expand x) (macroexpand x))

 (define =   eqv?)

-(define eql eqv?)

 (define (/= a b) (not (eqv? a b)))

-(define != /=)

 (define (>  a b) (< b a))

 (define (<= a b) (not (< b a)))

 (define (>= a b) (not (< a b)))

@@ -422,7 +420,7 @@

   (define (vals->cond key v)

     (cond ((eq? v 'else)   'else)

 	  ((null? v)       #f)

-          ((atom? v)       `(eqv? ,key ,v))

+          ((atom? v)       `(eqv? ,key ,(quote-value v)))

 	  ((null? (cdr v)) `(eqv? ,key ,(quote-value (car v))))

 	  (else            `(memv ,key ',v))))

   (let ((g (gensym)))

--- a/llt/dump.c

+++ b/llt/dump.c

@@ -12,30 +12,27 @@

 void hexdump(ios_t *dest, char *buffer, size_t len, size_t startoffs)

 {

     size_t offs=0;

-    size_t i, pos, nc;

+    size_t i, pos;

     char ch, linebuffer[16];

     char hexc[4];

+    static char *spc50 = "                                                  ";

     hexc[2] = hexc[3] = ' ';

     do {

         ios_printf(dest, "%.8x  ", offs+startoffs);

         pos = 10;

-        for(i=0; i < 16 && (offs+i) < len; i++) {

-            ch = buffer[offs + i];

+        for(i=0; i < 16 && offs < len; i++, offs++) {

+            ch = buffer[offs];

             linebuffer[i] = (ch<32 || ch>=0x7f) ? '.' : ch;

             hexc[0] = hexdig[((unsigned char)ch)>>4];

             hexc[1] = hexdig[ch&0x0f];

-            nc = (i==7 || i==15) ? 4 : 3;

-            ios_write(dest, hexc, nc);

-            pos += nc;

+            pos += ios_write(dest, hexc, (i==7 || i==15) ? 4 : 3);

         }

         for(; i < 16; i++)

             linebuffer[i] = ' ';

-        for(i=0; i < 60-pos; i++)

-            ios_putc(' ', dest);

+        ios_write(dest, spc50, 60-pos);

         ios_putc('|', dest);

         ios_write(dest, linebuffer, 16);

         ios_write(dest, "|\n", 2);

-        offs += 16;

     } while (offs < len);

 }