Merge pull request #17 from mtardy/memory-optimisation

Memory optimisation

bootstrap.txt

@@ -13,4 +13,8 @@ fun println() {
     apply(print, __arguments__);
     print("\n");
     __arguments__;
-}
+}
+
+fun millis() {
+    microseconds() / 1000;
+}

object.c

@@ -24,8 +24,11 @@ void *memcheck(void *ptr)
     return ptr;
 }
 
+unsigned long long nalloc= 0;
+
 void *xmalloc(size_t n)
 {
+    nalloc += n;
 #if (USE_GC)
     void *mem= GC_malloc(n);
     assert(mem);
@@ -37,6 +40,7 @@ void *xmalloc(size_t n)
 
 void *xrealloc(void *p, size_t n)
 {
+    nalloc += n;
 #if (USE_GC)
     void *mem= GC_realloc(p, n);
     assert(mem);
@@ -53,6 +57,7 @@ char *xstrdup(char *s)
     char  *mem= GC_malloc_atomic(len + 1);
     assert(mem);
     memcpy(mem, s, len + 1);
+    nalloc += len;
 #else
     char *mem= memcheck(strdup(s));
 #endif
@@ -116,11 +121,19 @@ struct Pair {
     oop value;
 };
 
+enum {
+    MAP_ENCLOSED = 1 << 0,    // set when map is used as a scope and closed over by a function
+};
+
 struct Map {
     type_t type;
+    int    flags;
     struct Pair *elements; // even are keys, odd are values   [ key val key val key val ]
-    size_t size;
     size_t capacity;
+    union {
+	size_t size;       // free Maps will be reset to 0 size on allocation
+	oop    pool;       // free list of Map objects
+    };
 };
 
 union object {
@@ -289,7 +302,7 @@ oop makeFunction(primitive_t primitive, oop name, oop param, oop body, oop paren
 
 oop makeMap()
 {
-    oop newMap = malloc(sizeof(union object));
+    oop newMap = malloc(sizeof(union object));			assert(0 == newMap->Map.flags);
     newMap->type = Map;
     return newMap;
 }
@@ -368,7 +381,8 @@ oop map_get(oop map, oop key)
     return get(map, Map, elements)[pos].value;
 }
 
-#define MAP_CHUNK_SIZE 8
+#define MAP_MIN_SIZE  4
+#define MAP_GROW_SIZE 2
 
 oop map_insert(oop map, oop key, oop value, size_t pos)
 {
@@ -382,7 +396,8 @@ oop map_insert(oop map, oop key, oop value, size_t pos)
 
     // check capacity and expand if needed
     if (map_size(map) >= get(map, Map, capacity)) {
-        size_t newCapacity = get(map, Map, capacity) + MAP_CHUNK_SIZE;
+        size_t newCapacity = get(map, Map, capacity) * MAP_GROW_SIZE;
+	if (newCapacity < MAP_MIN_SIZE) newCapacity= MAP_MIN_SIZE;
         set(map, Map, elements, realloc(get(map, Map, elements), sizeof(struct Pair) * newCapacity));
         set(map, Map, capacity, newCapacity);
     }

parse.leg

@@ -50,21 +50,14 @@ typedef struct jb_record
 
 jb_record *jbs= NULL;
 
-jb_record *jbRecPush() {
-    jb_record *newJbRec = malloc(sizeof(jb_record));
-    newJbRec->result = null;
-    newJbRec->next = jbs;
-    jbs = newJbRec;
-    return newJbRec;
-}
-
-jb_record *jbRecPop() {
-    assert(jbs);
-    jb_record *head = jbs;
-    jbs = head->next;
-    return head;
-}
+#define jbRecPush()				\
+    struct jb_record jbrec;			\
+    jbrec.next= jbs;				\
+    jbs= &jbrec
 
+#define jbRecPop()				\
+    assert(jbs == &jbrec);			\
+    jbs= jbrec.next
 
 // this is the global scope
 oop globals= 0;
@@ -85,6 +78,7 @@ DO_SYMBOLS()
 DO_PROTOS()
 #undef _DO
 
+int opt_g= 0;
 int opt_v= 0;
 oop mrAST= &_null;
 
@@ -761,7 +755,6 @@ value   =   n:NUMBER                { $$ = newInteger(n) }
         |   NULL                    { $$ = null }
         |   i:IDENT                 { $$ = newGetVariable(i) }
         |   LPAREN i:stmt  RPAREN   { $$ = i }
-        |   b:block                 { $$ = b }
 
 string  =   s:STRING -              { $$ = s }
 
@@ -887,11 +880,11 @@ SQUOTE  =    "'"
 ;
 
 
-oop map_zip(oop keys, oop values)
+oop map_zip(oop map, oop keys, oop values)
 {
+    assert(is(Map, map));
     assert(is(Map, keys));
     assert(is(Map, values));
-    oop map= makeMap();
     size_t sk= map_size(keys), sv= map_size(values);
     if (sk < sv) sk= sv;
     for (size_t i= 0;  i < sk;  ++i) {
@@ -1139,6 +1132,38 @@ oop applyOperator(oop ast, oop op, oop lhs, oop rhs)
     return rhs;
 }
 
+oop freeScopes= 0; // pool of free scopes
+
+oop fixScope(oop scope)        // prevent this scope and its parents from being recycled
+{                                                       assert(is(Map, scope));
+    oop tmp= scope;
+    while (is(Map, tmp) && (0 == (tmp->Map.flags & MAP_ENCLOSED))) {
+        tmp->Map.flags |= MAP_ENCLOSED;
+        tmp= map_get(tmp, __proto___symbol);
+    }
+    return scope;
+}
+
+oop newScope(oop parent)
+{
+    if (0 == freeScopes) freeScopes= makeMap();
+    oop scope= freeScopes;                              assert(is(Map, scope));
+    freeScopes= freeScopes->Map.pool;
+    scope->Map.size= 0;
+    map_set(scope, __proto___symbol, parent);
+    return scope;
+}
+
+void delScope(oop scope)
+{                                                       assert(is(Map, scope));
+    if (scope->Map.flags & MAP_ENCLOSED) {
+        printf("IGNORE %p\n", scope);
+        return;
+    }
+    scope->Map.pool= freeScopes;
+    freeScopes= scope;
+}
+
 oop evalArgs(oop scope, oop args);
 
 oop apply(oop scope, oop this, oop func, oop args, oop ast)
@@ -1150,28 +1175,32 @@ oop apply(oop scope, oop this, oop func, oop args, oop ast)
     }
 
     oop param = get(func, Function, param);
-    oop localScope = map_zip(param, args);
+    oop localScope = newScope(get(func, Function, parentScope));
+    map_zip(localScope, param, args);
     map_set(localScope, this_symbol, this);
     map_set(localScope, __arguments___symbol, args);
-    map_set(localScope, __proto___symbol, get(func, Function, parentScope));
     jbRecPush();
     trace(ast, func);
     int jbt = sigsetjmp(jbs->jb, 0);
     switch (jbt) {
         case j_return: {
             untrace(ast);
+	    delScope(localScope);
             oop result = jbs->result;
             jbRecPop();
             return result;
         }
         case j_break: {
+	    delScope(localScope);
             runtimeError("break outside of a loop or switch");
         }
         case j_continue: {
+	    delScope(localScope);
             runtimeError("continue outside of a loop");
         }
         case j_throw: {
             untrace(ast);
+	    delScope(localScope);
             oop res= jbs->result;
             jbRecPop();
             jbs->result= res;
@@ -1180,6 +1209,7 @@ oop apply(oop scope, oop this, oop func, oop args, oop ast)
     }
     oop result= eval(localScope, get(func, Function, body));
     untrace(ast);
+    delScope(localScope);
     jbRecPop();
     return result;
 }
@@ -1313,13 +1343,14 @@ oop eval(oop scope, oop ast)
         oop update     = map_get(ast, update_symbol );
         oop body       = map_get(ast, body_symbol);
         oop result     = null;
-        oop localScope = newObject(scope);
+        oop localScope = newScope(scope);
 
         jbRecPush();
         int jbt = sigsetjmp(jbs->jb, 0);
         switch (jbt) {
             case j_return:
             case j_throw: {
+                delScope(localScope);
                 oop result = jbs->result;
                 jbRecPop();
                 assert(jbs);
@@ -1328,6 +1359,7 @@ oop eval(oop scope, oop ast)
                 assert(0);
             }
             case j_break: {
+                delScope(localScope);
                 jbRecPop();
                 return result;
             }
@@ -1340,6 +1372,7 @@ oop eval(oop scope, oop ast)
             result= eval(localScope, body);
         restart_for:;
         }
+        delScope(localScope);
         jbRecPop();
         return result;
     }
@@ -1348,12 +1381,13 @@ oop eval(oop scope, oop ast)
         oop name   =             map_get(ast, name_symbol      ) ;
         oop body   =             map_get(ast, body_symbol      ) ;
         oop result = null;
-        oop localScope = newObject(scope);
+        oop localScope = newScope(scope);
         jbRecPush();
         int jbt = sigsetjmp(jbs->jb, 0);
         switch (jbt) {
             case j_return:
             case j_throw: {
+                delScope(localScope);
                 oop result = jbs->result;
                 jbRecPop();
                 assert(jbs);
@@ -1362,6 +1396,7 @@ oop eval(oop scope, oop ast)
                 assert(0);
             }
             case j_break: {
+                delScope(localScope);
                 jbRecPop();
                 return result;
             }
@@ -1374,6 +1409,7 @@ oop eval(oop scope, oop ast)
             result= eval(localScope, body);
         restart_forin:;
         }
+        delScope(localScope);
         jbRecPop();
         return result;
     }
@@ -1435,7 +1471,7 @@ oop eval(oop scope, oop ast)
         oop param = map_get(ast, param_symbol);
         oop body  = map_get(ast, body_symbol);
         oop fixed = map_get(ast, fixed_symbol);
-        oop func  = makeFunction(NULL, name, param, body, scope, fixed);
+        oop func  = makeFunction(NULL, name, param, body, fixScope(scope), fixed);
         if (opt_v > 4) {
             printf("funcscope: ");
             println(scope);
@@ -1516,16 +1552,18 @@ oop eval(oop scope, oop ast)
             if (null == catch) {
                 return eval(scope, finally);
             }
-            oop localScope= newObject(scope);
+            oop localScope= newScope(scope);
             setVariable(localScope, exception, res);
 
             jbRecPush();
             jbt= sigsetjmp(jbs->jb, 0);
             if (0 == jbt) {
                 eval(localScope, catch);
+                delScope(localScope);
                 jbRecPop();
                 return eval(scope, finally);
             }
+            delScope(localScope);
             // something happend in the catch block
             res= jbs->result;
             jbRecPop();
@@ -1540,12 +1578,13 @@ oop eval(oop scope, oop ast)
         int i = 0;
         oop index;
         oop statement, res;
-        oop localScope = newObject(scope);
+        oop localScope = newScope(scope);
         while ((index = makeInteger(i)), map_hasKey(statements, index)) {
             statement = map_get(statements, index);
             res = eval(localScope, statement);
             i++;
         }
+        delScope(localScope);
         return res;
     }
     case t_GetVariable: {
@@ -1910,9 +1949,15 @@ oop prim_import(oop scope, oop params)
     return null;
 }
 
+oop prim_String(oop scope, oop params)
+{
+    if (!map_hasIntegerKey(params, 0)) return null;
+    return makeString(printString(get(params, Map, elements)[0].value));
+}
+
 oop prim_scope(oop scope, oop params)
 {
-    return scope;
+    return fixScope(scope);
 }
 
 #include <sys/resource.h>
@@ -1943,6 +1988,7 @@ int main(int argc, char **argv)
     map_set(globals, intern("clone"       ), makeFunction(prim_clone,        intern("clone"       ), null, null, globals, null));
     map_set(globals, intern("import"      ), makeFunction(prim_import,       intern("import"      ), null, null, globals, null));
     map_set(globals, intern("microseconds"), makeFunction(prim_microseconds, intern("microseconds"), null, null, globals, null));
+    map_set(globals, intern("String"      ), makeFunction(prim_String      , intern("String"      ), null, null, globals, null));
 
     map_set(globals, intern("scope"), makeFunction(prim_scope, intern("scope"), null, null, globals, null));
 
@@ -1964,10 +2010,13 @@ int main(int argc, char **argv)
     DO_PROTOS()
     #undef _DO
 
+    fixScope(globals);
+
     int repled = 0;
     while (argc-- > 1) {
         ++argv;
-        if (!strcmp(*argv, "-v"))  ++opt_v;
+        if      (!strcmp(*argv, "-g"))  ++opt_g;
+        else if (!strcmp(*argv, "-v"))  ++opt_v;
         else if (!strcmp(*argv, "-")) {
             readEvalPrint(globals, NULL);
             repled= 1;
@@ -1981,6 +2030,13 @@ int main(int argc, char **argv)
         readEvalPrint(globals, NULL);
     }
 
+    if (opt_g) {
+	if      (nalloc <           1024) printf("[GC: %lli bytes allocated]\n",         nalloc                   );
+	else if (nalloc <      1024*1024) printf("[GC: %lli kB allocated]\n",            nalloc /            1024 );
+	else if (nalloc < 1024*1024*1024) printf("[GC: %.2f MB allocated]\n",    (double)nalloc / (     1024*1024));
+	else                              printf("[GC: %.2f GB allocated]\n",    (double)nalloc / (1024*1024*1024));
+    }
+
     return 0;
 
     (void)yyAccept;