fix arena

7 files changed, 116 insertions, 37 deletions

diff --git a/src/fmt.cff b/src/fmt.cff
index ad28bbd..8212593 100644
--- a/src/fmt.cff
+++ b/src/fmt.cff
@@ -47,10 +47,15 @@ extern fn vpfmt(proc *fn(u8, *void) void, parg *void, fmt *const u8, ap va_list)
          p('\'');
       case :null;
          ps("#null");
-      case :ident, :macident, :gensym, :label;
+      case :ident, :macident, :label;
          if quote { p('`');  }
          ps(tok.u.ident);
          if quote { p('\'');  }
+      case :gensym;
+         if quote { p('`');  }
+         p('$');
+         ps(tok.u.ident);
+         if quote { p('\'');  }
       case :type;
          pfmt(proc, parg, "%t", tok.ty);
       case else
diff --git a/src/map.hff b/src/map.hff
index 6900878..87d0506 100644
--- a/src/map.hff
+++ b/src/map.hff
@@ -18,8 +18,8 @@ struct Map<K, V, KTraits> {
       if self.N == 0 {
          return #null;
       }
-      let i0 u32 = KTraits:hash(key);
-      let i = i0 & (self.N - 1);
+      let h u32 = KTraits:hash(key);
+      let i = h & (self.N - 1);
       do {
          if self->_iempty(i) {
             return #null;
@@ -27,24 +27,59 @@ struct Map<K, V, KTraits> {
             return &self.vals[i];
          }
          i = (i + 1) & (self.N - 1);
-      } while i != i0;
+      } while i != h;
       assert(#f, "unreachable");
    }
 
+   fn _reallockvb(self *Map) void {
+      let p = xcalloc((self.N * (sizeof K + sizeof V)) + (self.N / 8), 1);
+      self.keys = p;
+      self.vals = as(*V)(self.keys + self.N);
+      self.bitmap = as(*u8)(self.vals + self.N);
+   }
+
+   fn _rehash(self *Map, newN int) void {
+      let oldks = self.keys,
+          oldvs = self.vals,
+          oldbmp = self.bitmap;
+      self.N *= 2;
+      self->_reallockvb();
+      for let i = 0; i < self.N / 2; ++i {
+         let k = oldks[i],
+             v = oldvs[i],
+             b = (oldbmp[i/8] & (1 << (i%8))) != 0;
+         if (b) {
+            let h u32 = KTraits:hash(k);
+            let i = h & (self.N - 1);
+            for ;; {
+               if self->_iempty(i) {
+                  self.keys[i] = k;
+                  self.vals[i] = v;
+                  self.bitmap[i/8] |= 1 << (i%8);
+               } else if KTraits:eq(self.keys[i], k) {
+                  assert(#f, "unreachable");
+               }
+               i = (i + 1) & (self.N - 1);
+            }
+
+         }
+      }
+      free(oldks);
+   }
+
    fn get_slot(self *Map, key K) *V {
       if self.keys == #null {
-         assert(self.vals == #null and self.bitmap == #null and self.N == 0 and self.count == 0,
-               "?");
-         self.keys = xcalloc(self.N = 16, sizeof K);
-         self.vals = xcalloc(self.N, sizeof V);
-         self.bitmap = xcalloc(self.N / 8, 1);
+         assert(self.vals == #null and self.bitmap == #null and self.N == 0 and self.count == 0, "?");
+         self.N = 16;
+         _reallockvb(self);
       }
 
       if self.count == self.N / 2 {
-         // rehash
+         self->_rehash(self.N * 2);
       }
-      let i0 u32 = KTraits:hash(key);
-      let i = i0 & (self.N - 1);
+
+      let h u32 = KTraits:hash(key);
+      let i = h & (self.N - 1);
       do {
          if self->_iempty(i) {
             self.bitmap[i/8] |= (1 << (i%8));
@@ -55,7 +90,7 @@ struct Map<K, V, KTraits> {
             return &self.vals[i];
          }
          i = (i + 1) & (self.N - 1);
-      } while i != i0;
+      } while i != h;
       assert(#f, "unreachable");
    }
 
diff --git a/src/mem.hff b/src/mem.hff
index 84064f3..a86bee3 100644
--- a/src/mem.hff
+++ b/src/mem.hff
@@ -9,30 +9,44 @@ extern fn xrealloc(p *void, n usize) *void;
 
 struct ArenaRegion {
    prev *ArenaRegion,
-   idx int,
-   mem [ARENA_SIZE]u8,
+   idx usize,
+   siz usize,
+   mem [0]u8,
 }
 
 struct Arena {
    r *ArenaRegion,
 
+   fn addregion(a *Arena, siz usize) void {
+      let r *ArenaRegion = xcalloc(sizeof ArenaRegion + siz, 1);
+      r.siz = siz;
+      r.prev = a.r;
+      a.r = r;
+   }
+
    fn allocf(a *void, n usize) *void {
       let a *Arena = a;
       n = ALIGNUP(n, 16);
-      if ARENA_SIZE < n {
-         return xmalloc(n);
+      if n > ARENA_SIZE {
+         a->addregion(n);
+         return a.r.mem;
       } else if a.r == #null {
-         a.r = xcalloc(1, sizeof ArenaRegion);
-         return allocf(a, n);
-      } else if ARENA_SIZE - a.r.idx >= n {
-         let ptr = &a.r.mem[a.r.idx];
-         a.r.idx += n;
-         return ptr;
+         a->addregion(ARENA_SIZE);
+         return allocf(a, n);         
+      } else if n > a.r.siz - a.r.idx {
+         a->addregion(ARENA_SIZE);
+         return allocf(a, n);         
       } else {
-         let rp *ArenaRegion = xmalloc(sizeof ArenaRegion);
-         *rp = *a.r;
-         let r = ArenaRegion { .prev: rp };
-         return allocf(a, n);
+         let p = &a.r.mem[a.r.idx];
+         a.r.idx += n;
+         return p;
+      }
+   }
+
+   fn destroy(a *Arena) void {
+      for let r = a.r, next *ArenaRegion = #null; r; r = next {
+         next = r.prev;
+         free(r);
       }
    }
 }
diff --git a/src/parse.cff b/src/parse.cff
index ba8e35d..0843ccf 100644
--- a/src/parse.cff
+++ b/src/parse.cff
@@ -241,7 +241,7 @@ fn lex(P *Parser) Tok {
          return tok;
       }
    }
-   if isalpha(c) or c == '_' {
+   if isalpha(c) or c == '_' or c == '$' {
       let s [120]u8;
       if readtilsep(P, s[0::], #f) < 0 {
          fatal(P, tok.loc, "identifier too long");
@@ -250,6 +250,9 @@ fn lex(P *Parser) Tok {
       if kw >= 0 {
          tok.t = kw;
          tok.u.ident = keyword2str[kw];
+      } else if (c == '$') {
+         tok.t = :gensym;
+         tok.u.ident = internstr(&s[1]);
       } else {
          tok.t = :ident;
          tok.u.ident = internstr(s);
@@ -262,6 +265,17 @@ fn lex(P *Parser) Tok {
          fatal(P, P.tokloc, "invalid #keyword");
       }
       switch {
+      case streq(s, "#") and chrpeek(P) == '{';
+         chr(P);
+         let bal = 1;
+         while bal != 0 {
+            switch lex(P).t {
+            case '{'; ++bal;
+            case '}'; --bal;
+            case :eof; fatal(P, tok.loc, "unterminated comment");
+            }
+         }
+         return lex(P);
       case streq(s, "#");
          tok.t = '#';
       case streq(s, "#t") or streq(s, "#f");
@@ -316,7 +330,7 @@ fn lex(P *Parser) Tok {
 
       if delim == '"' {
          tok.t = :str;
-         tok.u.str = str->compact();
+         tok.u.str = str->move(P.alloc);
       } else {
          tok.t = :chr;
          if str.len == 0 {
@@ -423,12 +437,15 @@ extern fn parse(P *Parser) [#]Decl {
       free(ptr);
    }
 
-   let alloc = Allocator { #null, &mallocator_allocf, &mallocator_freef };
+   let aralloc = Arena {};
+   let alloc = Allocator { &aralloc, &Arena:allocf, #null };
+   P.alloc = &alloc;
    while not P.eof {
       let tok = lex(P);
       if tok.t == :eof { break; }
       efmt("* tok: %qT\n", tok);
    }
+   aralloc->destroy();
 }
 
 extern fn parser_init(P *Parser, path *const u8) void {
diff --git a/src/set.hff b/src/set.hff
index 4e4b72c..6ab44ea 100644
--- a/src/set.hff
+++ b/src/set.hff
@@ -1,10 +1,11 @@
 import "vec.hff";
 import "all.hff";
 
-#{ KTraits:
-       :hash(K) u32
-       :eq(T, T) bool
-       :dup(T) T }
+#{
+Traits:hash(K) u32 
+      :eq(T, T) bool
+      :dup(T) T // useful to strdup strings before interning them
+}
 struct Set<T, Traits> {
    buf Vec<T>,
    set *int,
diff --git a/src/util.cff b/src/util.cff
index 926b1e4..18305b2 100644
--- a/src/util.cff
+++ b/src/util.cff
@@ -8,7 +8,7 @@ extern fn xmalloc(n usize) *void {
 }
 
 extern fn xcalloc(n usize, m usize) *void {
-   let p = calloc(n, n);
+   let p = calloc(n, m);
    assert(p != #null, "calloc");
    return p;
 }
diff --git a/src/vec.hff b/src/vec.hff
index be29fec..35a9331 100644
--- a/src/vec.hff
+++ b/src/vec.hff
@@ -22,8 +22,7 @@ struct Vec<T> {
 
    fn clear(vec *Vec) void {
       free(vec.dat);
-      vec.len = 0;
-      vec.cap = 0; 
+      *vec = {};
    }
 
    fn compact(vec *Vec) [#]T {
@@ -34,6 +33,14 @@ struct Vec<T> {
       return vec.dat[0::vec.len];
    }
 
+   fn move(vec *Vec, alloc *Allocator) [#]T {
+      let len = vec.len;
+      let dat *T = alloc->alloc(len * sizeof T);
+      memcpy(dat, vec.dat, len * sizeof T);
+      vec->clear();
+      return dat[0::len];
+   }
+
    fn last(vec *const Vec) T { return vec.dat[vec.len - 1]; }
 
    fn lastp(vec *Vec) *T { return &vec.dat[vec.len - 1]; }