a couple bug fixes

some small performance tweaks
moving some test files around

femtolisp/flisp.c

@@ -422,7 +422,8 @@ static value_t relocate(value_t v)
                 *pcdr = cdr_(v);
                 return first;
             }
-            *pcdr = nc = mk_cons();
+            *pcdr = nc = tagptr((cons_t*)curheap, TAG_CONS);
+            curheap += sizeof(cons_t);
             d = cdr_(v);
             car_(v) = TAG_FWD; cdr_(v) = nc;
             car_(nc) = relocate(a);

femtolisp/iostream.c

@@ -114,9 +114,11 @@ value_t fl_read(value_t *args, u_int32_t nargs)
     else {
         arg = args[0];
     }
-    ios_t *s = toiostream(arg, "read");
+    (void)toiostream(arg, "read");
+    fl_gc_handle(&arg);
     value_t v = read_sexpr(arg);
-    if (ios_eof(s))
+    fl_free_gc_handles(1);
+    if (ios_eof(value2c(ios_t*,arg)))
         return FL_EOF;
     return v;
 }

femtolisp/read.c

@@ -13,8 +13,8 @@ enum {
 // an ordinary symbol character unless it's the first character.
 static int symchar(char c)
 {
-    static char *special = "()[]'\";`,\\|";
+    static char *special = "()[]'\";`,\\| \f\n\r\t\v";
-    return (!isspace(c) && !strchr(special, c));
+    return !strchr(special, c);
 }
 
 int isnumtok_base(char *tok, value_t *pval, int base)
@@ -91,22 +91,28 @@ static char nextchar()
 {
     int ch;
     char c;
+    ios_t *f = F;
 
     do {
-        ch = ios_getc(F);
+        if (f->bpos < f->size) {
-        if (ch == IOS_EOF)
+            ch = f->buf[f->bpos++];
-            return 0;
+        }
+        else {
+            ch = ios_getc(f);
+            if (ch == IOS_EOF)
+                return 0;
+        }
         c = (char)ch;
         if (c == ';') {
             // single-line comment
             do {
-                ch = ios_getc(F);
+                ch = ios_getc(f);
                 if (ch == IOS_EOF)
                     return 0;
             } while ((char)ch != '\n');
             c = (char)ch;
         }
-    } while (isspace(c));
+    } while (c==' ' || isspace(c));
     return c;
 }
 
@@ -658,6 +664,7 @@ value_t read_sexpr(value_t f)
     htable_new(&state.gensyms, 8);
     state.source = f;
     readstate = &state;
+    assert(toktype == TOK_NONE);
 
     v = do_read_sexpr(UNBOUND);
 

femtolisp/system.lsp

@@ -489,8 +489,9 @@
 						     (newline)
 						     (apply #.apply args)))))
     (lambda (f)
-      (equal? (function:code f)
+      (and (closure? f)
-	      (function:code sample-traced-lambda)))))
+	   (equal? (function:code f)
+		   (function:code sample-traced-lambda))))))
 
 (define (trace sym)
   (let* ((func (top-level-value sym))

femtolisp/tests/argv.lsp

@@ -0,0 +1 @@
+(print *argv*) (princ "\n")

femtolisp/tests/err.lsp

@@ -0,0 +1,4 @@
+(define (f x) (begin (list-tail '(1) 3) 3))
+(f 2)
+a
+(trycatch a (lambda (e) (print (stacktrace))))

femtolisp/tests/hashtest.lsp

@@ -0,0 +1,40 @@
+; -*- scheme -*-
+
+(define (hins1)
+  (let ((h (table)))
+    (dotimes (n 200000)
+      (put! h (mod (rand) 1000) 'apple))
+    h))
+
+(define (hread h)
+  (dotimes (n 200000)
+    (get h (mod (rand) 10000) nil)))
+
+(time (dotimes (i 100000)
+        (table :a 1 :b 2 :c 3 :d 4 :e 5 :f 6 :g 7 :foo 8 :bar 9)))
+(time (dotimes (i 100000) (table :a 1 :b 2 :c 3 :d 4 :e 5 :f 6 :g 7 :foo 8)))
+(time (dotimes (i 100000) (table :a 1 :b 2 :c 3 :d 4)))
+(time (dotimes (i 100000) (table :a 1 :b 2)))
+(time (dotimes (i 100000) (table)))
+
+#t
+
+#|
+
+with HT_N_INLINE==16
+Elapsed time: 0.0796329975128174 seconds
+Elapsed time: 0.0455679893493652 seconds
+Elapsed time: 0.0272290706634521 seconds
+Elapsed time: 0.0177979469299316 seconds
+Elapsed time: 0.0102229118347168 seconds
+
+
+with HT_N_INLINE==8
+
+Elapsed time: 0.1010119915008545 seconds
+Elapsed time: 0.174872875213623 seconds
+Elapsed time: 0.0322129726409912 seconds
+Elapsed time: 0.0195930004119873 seconds
+Elapsed time: 0.008836030960083 seconds
+
+|#

femtolisp/tests/tme.lsp

@@ -0,0 +1,4 @@
+(let ((t (table)))
+  (time (dotimes (i 2000000)
+          (put! t (rand) (rand)))))
+#t