diff --git a/bootstrap.txt b/bootstrap.txt index 5edf95c..0d151ce 100644 --- a/bootstrap.txt +++ b/bootstrap.txt @@ -13,4 +13,8 @@ fun println() { apply(print, __arguments__); print("\n"); __arguments__; -} \ No newline at end of file +} + +fun millis() { + microseconds() / 1000; +} diff --git a/object.c b/object.c index f2c0319..66a97d8 100644 --- a/object.c +++ b/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); } diff --git a/parse.leg b/parse.leg index abb4624..018850b 100644 --- a/parse.leg +++ b/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 @@ -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;