diff --git a/ruamoko/scheme/CompiledCode.r b/ruamoko/scheme/CompiledCode.r index 84d66a6d1..f05e02a9c 100644 --- a/ruamoko/scheme/CompiledCode.r +++ b/ruamoko/scheme/CompiledCode.r @@ -9,7 +9,14 @@ instructions = [Array new]; return self; } - + +- (void) markReachable +{ + [literals mark]; + [constants makeObjectsPerformSelector: @selector(mark)]; + [instructions makeObjectsPerformSelector: @selector(mark)]; +} + - (void) addInstruction: (Instruction) inst { [inst offset: [instructions count]]; @@ -38,10 +45,9 @@ inst = [instructions getItemAt: index]; [inst emitStruct: code]; } - [instructions makeObjectsPerformSelector: @selector(retain)]; [instructions release]; - [constants makeObjectsPerformSelector: @selector(retain)]; [constants release]; + instructions = constants = NIL; } - (instruction_t []) code @@ -54,4 +60,12 @@ return literals; } +- (void) dealloc +{ + [instructions release]; + [constants release]; + if (code) + obj_free (code); +} + @end diff --git a/ruamoko/scheme/Compiler.r b/ruamoko/scheme/Compiler.r index e3d0c5e4b..0a3d5154c 100644 --- a/ruamoko/scheme/Compiler.r +++ b/ruamoko/scheme/Compiler.r @@ -15,8 +15,8 @@ self = [super init]; sexpr = xp; scope = sc; - lambdaSym = [Symbol newFromString: "lambda"]; - quoteSym = [Symbol newFromString: "quote"]; + lambdaSym = [Symbol forString: "lambda"]; + quoteSym = [Symbol forString: "quote"]; code = [CompiledCode new]; return self; } @@ -140,5 +140,14 @@ { return code; } - + +- (void) markReachable +{ + [code mark]; + [sexpr mark]; + [lambdaSym mark]; + [quoteSym mark]; + [Scope mark]; +} + @end diff --git a/ruamoko/scheme/Cons.r b/ruamoko/scheme/Cons.r index ed14cec7b..ed9d7b354 100644 --- a/ruamoko/scheme/Cons.r +++ b/ruamoko/scheme/Cons.r @@ -49,9 +49,8 @@ Cons cons (SchemeObject car, SchemeObject cdr) cdr = d; } -- (void) mark +- (void) markReachable { - [super mark]; [car mark]; [cdr mark]; } diff --git a/ruamoko/scheme/Continuation.r b/ruamoko/scheme/Continuation.r index c919f92d5..cdcee6648 100644 --- a/ruamoko/scheme/Continuation.r +++ b/ruamoko/scheme/Continuation.r @@ -26,6 +26,14 @@ return; } +- (void) markReachable +{ + [state.literals mark]; + [state.stack mark]; + [cont mark]; + [env mark]; +} + - (string) printForm { return ""; diff --git a/ruamoko/scheme/Frame.r b/ruamoko/scheme/Frame.r index ab02524cd..ead1030fa 100644 --- a/ruamoko/scheme/Frame.r +++ b/ruamoko/scheme/Frame.r @@ -30,4 +30,19 @@ return link; } +- (void) markReachable +{ + local integer index; + for (index = 0; index < size; index++) { + [array[index] mark]; + } + [link mark]; +} + +- (void) dealloc +{ + obj_free(array); + [super dealloc]; +} + @end diff --git a/ruamoko/scheme/Instruction.r b/ruamoko/scheme/Instruction.r index a87745af6..fda1c2707 100644 --- a/ruamoko/scheme/Instruction.r +++ b/ruamoko/scheme/Instruction.r @@ -51,4 +51,9 @@ } } +- (void) markReachable +{ + [label mark]; +} + @end diff --git a/ruamoko/scheme/Lambda.r b/ruamoko/scheme/Lambda.r index 9c69644e0..c151cda9d 100644 --- a/ruamoko/scheme/Lambda.r +++ b/ruamoko/scheme/Lambda.r @@ -4,71 +4,6 @@ #include "string.h" #include "defs.h" -/* -SchemeObject evaluate (SchemeObject expr, SchemeObject env); - -SchemeObject extend_environment (SchemeObject baseenv, SchemeObject argnames, SchemeObject argvalues) -{ - local SchemeObject name, value; - - if (argnames == [Nil nil]) { - return baseenv; - } - - name = [argnames car]; - value = [argvalues car]; - return [Cons newWithCar: [Cons newWithCar: name cdr: value] cdr: - extend_environment([baseenv cdr], [argnames cdr], [argvalues cdr])]; -} - -SchemeObject assoc (Symbol name, SchemeObject list) -{ - if (list == [Nil nil]) { - return NIL; - } - - printf("assoc: Comparing %s to %s\n", - [name printForm], [[[list car] car] printForm]); - - if ([[list car] car] == name) { - print("assoc: Comparison successful, returning" + - [[[list car] cdr] printForm] + "\n"); - return [[list car] cdr]; - } else { - return assoc (name, [list cdr]); - } -} - -SchemeObject evaluate_list (SchemeObject list, SchemeObject env) -{ - if (list == [Nil nil]) { - return list; - } else { - return [Cons newWithCar: evaluate([list car], env) cdr: - evaluate_list ([list cdr], env)]; - } -} - -SchemeObject evaluate (SchemeObject expr, SchemeObject env) -{ - local SchemeObject res; - - print ("Entering evaluated...\n"); - - if ([expr isKindOfClass: [Cons class]]) { - res = evaluate_list (expr, env); - print("Got evaluated list: " + [res printForm] + "\n"); - return [[res car] invokeWithArgs: [res cdr]]; - } else if ([expr isKindOfClass: [Symbol class]]) { - print("Looking up symbol: " + [expr printForm] + "\n"); - return assoc((Symbol) expr, env); - } else { - return expr; - } -} - -*/ - @implementation Lambda + (id) newWithCode: (CompiledCode) c environment: (Frame) e { @@ -88,5 +23,11 @@ SchemeObject evaluate (SchemeObject expr, SchemeObject env) [m loadCode: code]; [m environment: env]; } - + +- (void) markReachable +{ + [env mark]; + [code mark]; +} + @end diff --git a/ruamoko/scheme/Lexer.h b/ruamoko/scheme/Lexer.h index 205b0f025..6214d2cf5 100644 --- a/ruamoko/scheme/Lexer.h +++ b/ruamoko/scheme/Lexer.h @@ -6,8 +6,6 @@ @interface Lexer: Object { string source; - Symbol lparen; - Symbol rparen; } + (id) newFromSource: (string) s; - (id) initWithSource: (string) s; diff --git a/ruamoko/scheme/Lexer.r b/ruamoko/scheme/Lexer.r index c8d68445c..fdbcc9f6b 100644 --- a/ruamoko/scheme/Lexer.r +++ b/ruamoko/scheme/Lexer.r @@ -29,8 +29,9 @@ BOOL issymbol (string x) - (id) initWithSource: (string) s { + self = [super init]; source = s; - return [super init]; + return self; } - (SchemeObject) nextToken @@ -70,7 +71,7 @@ BOOL issymbol (string x) return NIL; default: for (len = 1; issymbol(str_mid(source, len, len+1)); len++); - sym = [Symbol newFromString: str_mid (source, 0, len)]; + sym = [Symbol forString: str_mid (source, 0, len)]; source = str_mid(source, len); return sym; } diff --git a/ruamoko/scheme/Machine.r b/ruamoko/scheme/Machine.r index 23e9781e5..c1e2b3d2d 100644 --- a/ruamoko/scheme/Machine.r +++ b/ruamoko/scheme/Machine.r @@ -4,14 +4,6 @@ #include "Nil.h" #include "defs.h" - -//#define DEBUG -#ifdef DEBUG -#define dprintf printf -#else -#define dprintf(x, ...) -#endif - string GlobalGetKey (void []ele, void []data) { return [[((Cons) ele) car] printForm]; @@ -40,7 +32,9 @@ void GlobalFree (void []ele, void []data) - (void) addGlobal: (Symbol) sym value: (SchemeObject) val { - Hash_Add(globals, cons(sym, val)); + local Cons c = cons(sym, val); + [c makeRootCell]; + Hash_Add(globals, c); } - (void) loadCode: (CompiledCode) code @@ -123,7 +117,8 @@ void GlobalFree (void []ele, void []data) break; case MAKECLOSURE: dprintf("Makeclosure\n"); - value = [Lambda newWithCode: (CompiledCode) value environment: env]; + value = [Lambda newWithCode: (CompiledCode) value + environment: env]; break; case MAKECONT: dprintf("Makecont\n"); @@ -176,4 +171,14 @@ void GlobalFree (void []ele, void []data) } } } + +- (void) markReachable +{ + [state.literals mark]; + [state.stack mark]; + [cont mark]; + [env mark]; + [value mark]; + // FIXME: need to mark globals +} @end diff --git a/ruamoko/scheme/Nil.r b/ruamoko/scheme/Nil.r index e83190dce..ac5de2992 100644 --- a/ruamoko/scheme/Nil.r +++ b/ruamoko/scheme/Nil.r @@ -8,6 +8,7 @@ Nil one_nil_to_rule_them_all; + (void) initialize { one_nil_to_rule_them_all = [Nil new]; + [one_nil_to_rule_them_all makeRootCell]; } + (id) nil diff --git a/ruamoko/scheme/Parser.r b/ruamoko/scheme/Parser.r index 101e9fec1..0bb300712 100644 --- a/ruamoko/scheme/Parser.r +++ b/ruamoko/scheme/Parser.r @@ -12,8 +12,9 @@ - (id) initWithSource: (string) s { + self = [super init]; lexer = [Lexer newFromSource: s]; - return [super init]; + return self; } - (SchemeObject) readList diff --git a/ruamoko/scheme/SchemeObject.h b/ruamoko/scheme/SchemeObject.h index 1f8a5f349..2d53efc19 100644 --- a/ruamoko/scheme/SchemeObject.h +++ b/ruamoko/scheme/SchemeObject.h @@ -4,13 +4,22 @@ #define true YES #define false NO +//#define DEBUG +#ifdef DEBUG +#define dprintf printf +#else +#define dprintf(x, ...) +#endif + + @interface SchemeObject: Object { - BOOL marked; + @public SchemeObject prev, next; + BOOL marked, root; } - (void) mark; -- (BOOL) sweep; -//+ (id) alloc; +- (void) markReachable; +- (void) makeRootCell; - (string) printForm; @end diff --git a/ruamoko/scheme/SchemeObject.r b/ruamoko/scheme/SchemeObject.r index ea576ab3b..fe4456303 100644 --- a/ruamoko/scheme/SchemeObject.r +++ b/ruamoko/scheme/SchemeObject.r @@ -1,27 +1,128 @@ #include "SchemeObject.h" +#include "defs.h" + +SchemeObject maybe_garbage, not_garbage, roots; +BOOL markstate; + +BOOL contains (SchemeObject list, SchemeObject what) +{ + local SchemeObject cur; + + for (cur = list; cur; cur = cur.next) { + if (cur == what) + return true; + } + + return false; +} + + @implementation SchemeObject -/* -+ (id) alloc ++ (void) initialize { - return [super alloc]; -} -*/ -- (void) mark -{ - marked = true; + maybe_garbage = not_garbage = roots = NIL; + markstate = true; } -- (BOOL) sweep ++ (id) dummyObject { - if (marked) { - marked = false; - return false; - } else { - [self release]; - return true; + return [[SchemeObject alloc] initDummy]; +} + +- (id) initDummy +{ + self = [super init]; + prev = next = NIL; + marked = markstate; + root = false; + return self; +} + ++ (void) collect +{ + local SchemeObject cur, next = NIL, dummy; + + not_garbage = dummy = [SchemeObject dummyObject]; + for (cur = roots; cur; cur = next) { + next = cur.next; + [cur markReachable]; } + for (cur = dummy; cur; cur = cur.prev) { + dprintf("GC: marking queue: %s[%s]@%i\n", [cur description], [cur printForm], + (integer) cur); + [cur markReachable]; + } + for (cur = maybe_garbage; cur; cur = next) { + next = cur.next; + dprintf("GC: freeing %s[%s]@%i...\n", [cur description], [cur printForm], (integer) cur); + [cur release]; + } + maybe_garbage = not_garbage; + not_garbage = NIL; + markstate = !markstate; +} + +- (id) init +{ + self = [super init]; + if (maybe_garbage) { + maybe_garbage.prev = self; + } + next = maybe_garbage; + maybe_garbage = self; + prev = NIL; + marked = !markstate; + root = false; + return self; +} + +- (void) mark +{ + if (!root && marked != markstate) { + dprintf("GC: Marking %s[%s]@%i\n", [self description], [self printForm], (integer) self); + marked = markstate; + if (prev) { + prev.next = next; + } else { + maybe_garbage = next; + } + if (next) { + next.prev = prev; + } + if (not_garbage) { + not_garbage.prev = self; + } + next = not_garbage; + prev = NIL; + not_garbage = self; + //[self markReachable]; + } +} + +- (void) makeRootCell +{ + if (prev) { + prev.next = next; + } else { + maybe_garbage = next; + } + if (next) { + next.prev = prev; + } + if (roots) { + roots.prev = self; + } + next = roots; + prev = NIL; + roots = self; + root = true; +} + +- (void) markReachable +{ + return; } - (string) printForm @@ -29,4 +130,10 @@ return ""; } +- (void) dealloc +{ + dprintf("Deallocing %s @ %i!\n", [self description], (integer) self); + [super dealloc]; +} + @end diff --git a/ruamoko/scheme/Scope.r b/ruamoko/scheme/Scope.r index d8e4ed2f2..1175751a9 100644 --- a/ruamoko/scheme/Scope.r +++ b/ruamoko/scheme/Scope.r @@ -74,4 +74,10 @@ [names release]; } +- (void) markReachable +{ + [names makeObjectsPerformSelector: @selector(mark)]; + [outerScope mark]; +} + @end diff --git a/ruamoko/scheme/Symbol.h b/ruamoko/scheme/Symbol.h index 559f2a53a..1aebb4b30 100644 --- a/ruamoko/scheme/Symbol.h +++ b/ruamoko/scheme/Symbol.h @@ -4,7 +4,6 @@ @interface Symbol: String { - string value; } + (void) initialize; + (Symbol) leftParen; diff --git a/ruamoko/scheme/Symbol.r b/ruamoko/scheme/Symbol.r index 1ab2932a5..c7182a957 100644 --- a/ruamoko/scheme/Symbol.r +++ b/ruamoko/scheme/Symbol.r @@ -28,12 +28,22 @@ Symbol quote; lparen = [Symbol forString: "("]; rparen = [Symbol forString: ")"]; quote = [Symbol forString: "'"]; - + [lparen makeRootCell]; + [rparen makeRootCell]; + [quote makeRootCell]; } + (Symbol) forString: (string) s { - return (Symbol) [self newFromString: s]; + local Symbol res; + + if ((res = Hash_Find (symbols, s))) { + return res; + } else { + res = (Symbol) [self newFromString: s]; + Hash_Add (symbols, res); + return res; + } } + (Symbol) leftParen @@ -51,24 +61,17 @@ Symbol quote; return quote; } -- (id) initWithString: (string) s -{ - local Symbol res; - [super initWithString: s]; - - if ((res = Hash_Find (symbols, s))) { - [self release]; - return res; - } else { - Hash_Add (symbols, self); - return self; - } -} - - (string) printForm { - return [self stringValue]; + return value; } +- (void) dealloc +{ + if (Hash_Find (symbols, value) == self) { + Hash_Del (symbols, value); + } + [super dealloc]; +} @end diff --git a/ruamoko/scheme/Void.r b/ruamoko/scheme/Void.r index d56da95ce..8adde740a 100644 --- a/ruamoko/scheme/Void.r +++ b/ruamoko/scheme/Void.r @@ -7,6 +7,7 @@ Void voidConstant; + (void) initialize { voidConstant = [Void new]; + [voidConstant makeRootCell]; } + (id) voidConstant diff --git a/ruamoko/scheme/main.qc b/ruamoko/scheme/main.qc index ad152f995..6aa786ff4 100644 --- a/ruamoko/scheme/main.qc +++ b/ruamoko/scheme/main.qc @@ -40,6 +40,7 @@ integer main (integer argc, string []argv) builtin_init(); parser = [Parser newFromSource: readfile(argv[1])]; vm = [Machine new]; + [vm makeRootCell]; [vm addGlobal: [Symbol forString: "display"] value: print_p]; [vm addGlobal: [Symbol forString: "newline"] value: newline_p]; [vm addGlobal: [Symbol forString: "+"] value: add_p]; @@ -55,6 +56,7 @@ integer main (integer argc, string []argv) lm = [Lambda newWithCode: code environment: NIL]; [lm invokeOnMachine: vm]; [vm run]; + [SchemeObject collect]; } return 0; }