Initial commit of a future partial implementation of the R5RS Scheme

standard, implemented in Ruamoko.  Currently works for a few simple
"Hello, world!" programs.

configure.ac

@@ -1654,7 +1654,7 @@ QF_WITH_TARGETS(
 QF_WITH_TARGETS(
 	tools,
 	[  --with-tools=<list>     compile qf tools:],
-	[bsp2img,carne,pak,qfbsp,qfcc,qflight,qfmodelgen,qfvis,qwaq,wad,wav],dummy
+	[bsp2img,carne,gsc,pak,qfbsp,qfcc,qflight,qfmodelgen,qfvis,qwaq,wad,wav],dummy
 )
 
 unset CL_TARGETS
@@ -1831,6 +1831,9 @@ fi
 if test "x$ENABLE_tools_carne" = xyes; then
 	TOOLS_TARGETS="$TOOLS_TARGETS carne"
 fi
+if test "x$ENABLE_tools_gsc" = xyes; then
+	TOOLS_TARGETS="$TOOLS_TARGETS gsc"
+fi
 if test "x$ENABLE_tools_pak" = xyes; then
 	TOOLS_TARGETS="$TOOLS_TARGETS pak"
 fi
@@ -1861,6 +1864,7 @@ fi
 
 AM_CONDITIONAL(BUILD_BSP2IMG, test "$ENABLE_tools_bsp2img" = "yes")
 AM_CONDITIONAL(BUILD_CARNE, test "$ENABLE_tools_carne" = "yes")
+AM_CONDITIONAL(BUILD_GSC, test "$ENABLE_tools_gsc" = "yes")
 AM_CONDITIONAL(BUILD_PAK, test "$ENABLE_tools_pak" = "yes")
 AM_CONDITIONAL(BUILD_QFBSP, test "$ENABLE_tools_qfbsp" = "yes")
 AM_CONDITIONAL(BUILD_QFCC, test "$ENABLE_tools_qfcc" = "yes")
@@ -2123,7 +2127,7 @@ QF_DEPS(QFVIS,
 )
 QF_DEPS(QWAQ,
 	[],
-	[$(top_builddir)/libs/ruamoko/libQFruamoko.la $(top_builddir)/libs/gamecode/engine/libQFgamecode.la $(top_builddir)/libs/util/libQFutil.la],
+	[$(top_builddir)/libs/ruamoko/libQFruamoko.la $(top_builddir)/libs/gamecode/engine/libQFgamecode.la $(top_builddir)/libs/util/libQFutil.la $(top_builddir)/libs/gamecode/builtins/libQFgamecode_builtins.la],
 	[$(WIN32_LIBS)],
 )
 QF_DEPS(CARNE,
@@ -2131,6 +2135,11 @@ QF_DEPS(CARNE,
 	[$(top_builddir)/libs/gib/libQFgib.la $(top_builddir)/libs/util/libQFutil.la],
 	[$(WIN32_LIBS)],
 )
+QF_DEPS(GSC,
+	[],
+	[$(top_builddir)/libs/gibscript/libQFgibscript.la $(top_builddir)/libs/util/libQFutil.la],
+	[$(WIN32_LIBS)],
+)
 QF_DEPS(PAK,
 	[],
 	[$(top_builddir)/libs/util/libQFutil.la],
@@ -2185,6 +2194,7 @@ AC_OUTPUT(
 	libs/gamecode/engine/Makefile
 	libs/gamecode/builtins/Makefile
 	libs/gib/Makefile
+	libs/gibscript/Makefile
 	libs/image/Makefile
 	libs/models/Makefile
 	libs/models/alias/Makefile
@@ -2222,6 +2232,7 @@ AC_OUTPUT(
 	tools/Makefile
 	tools/bsp2img/Makefile
 	tools/carne/Makefile
+	tools/gsc/Makefile
 	tools/pak/Makefile
 	tools/qfbsp/Makefile
 	tools/qfbsp/include/Makefile
@@ -2251,6 +2262,7 @@ AC_OUTPUT(
 	ruamoko/game/Makefile
 	ruamoko/gui/Makefile
 	ruamoko/cl_menu/Makefile
+	ruamoko/scheme/Makefile
 
 	doc/Makefile
 	doc/quakeforge.dox

ruamoko/Makefile.am

@@ -1 +1 @@
-SUBDIRS= include lib game gui cl_menu
+SUBDIRS= include lib game gui cl_menu scheme

ruamoko/scheme/CompiledCode.h

@@ -0,0 +1,22 @@
+#ifndef __CompiledCode_h
+#define __CompiledCode_h
+#include "SchemeObject.h"
+#include "Array.h"
+#include "Instruction.h"
+#include "Frame.h"
+
+@interface CompiledCode: SchemeObject
+{
+    Frame literals;
+    Array instructions;
+    Array constants;
+    instruction_t [] code;
+}
+- (void) addInstruction: (Instruction) inst;
+- (integer) addConstant: (SchemeObject) c;
+- (void) compile;
+- (instruction_t []) code;
+- (Frame) literals;
+@end
+
+#endif //__CompiledCode_h

ruamoko/scheme/CompiledCode.r

@@ -0,0 +1,57 @@
+#include "CompiledCode.h"
+#include "defs.h"
+
+@implementation CompiledCode
+- (id) init
+{
+    self = [super init];
+    constants = [Array new];
+    instructions = [Array new];
+    return self;
+}
+    
+- (void) addInstruction: (Instruction) inst
+{
+    [inst offset: [instructions count]];
+    if ([inst opcode] != LABEL) {
+            [instructions addItem: inst];
+    }
+}
+
+- (integer) addConstant: (SchemeObject) c
+{
+    local integer number = [constants count];
+    [constants addItem: c];
+    return number;
+}            
+    
+- (void) compile
+{
+    local integer index;
+    local Instruction inst;
+    literals = [Frame newWithSize: [constants count] link: NIL];
+    code = obj_malloc (@sizeof(instruction_t) * [instructions count]);
+    for (index = 0; index < [constants count]; index++) {
+            [literals set: index to: (SchemeObject) [constants getItemAt: index]];
+    }
+    for (index = 0; index < [instructions count]; index++) {
+            inst = [instructions getItemAt: index];
+            [inst emitStruct: code];
+    }
+    [instructions makeObjectsPerformSelector: @selector(retain)];
+    [instructions release];
+    [constants makeObjectsPerformSelector: @selector(retain)];
+    [constants release];
+}
+
+- (instruction_t []) code
+{
+    return code;
+}
+
+- (Frame) literals
+{
+    return literals;
+}
+
+@end

ruamoko/scheme/Compiler.h

@@ -0,0 +1,23 @@
+#ifndef __Compiler_h
+#define __Compiler_h
+#include "SchemeObject.h"
+#include "CompiledCode.h"
+#include "Symbol.h"
+#include "Scope.h"
+
+@interface Compiler: SchemeObject
+{
+    CompiledCode code;
+    SchemeObject sexpr;
+    Symbol lambdaSym, quoteSym;
+    Scope scope;
+}
+
++ (id) newWithLambda: (SchemeObject) xp scope: (Scope) sc;
+- (id) initWithLambda: (SchemeObject) xp scope: (Scope) sc;
+- (void) compile;
+- (CompiledCode) code;
+
+@end
+
+#endif //__Compiler_h

ruamoko/scheme/Compiler.r

@@ -0,0 +1,144 @@
+#include "Compiler.h"
+#include "Instruction.h"
+#include "Nil.h"
+#include "Cons.h"
+#include "defs.h"
+
+@implementation Compiler
++ (id) newWithLambda: (SchemeObject) xp scope: (Scope) sc
+{
+    return [[self alloc] initWithLambda: xp scope: sc];
+}
+
+- (id) initWithLambda: (SchemeObject) xp scope: (Scope) sc
+{
+    self = [super init];
+    sexpr = xp;
+    scope = sc;
+    lambdaSym = [Symbol newFromString: "lambda"];
+    quoteSym = [Symbol newFromString: "quote"];
+    code = [CompiledCode new];
+    return self;
+}
+
+- (void) emitBuildEnvironment: (SchemeObject) arguments
+{
+    local integer count, index;
+    local SchemeObject cur;
+
+    scope = [Scope newWithOuter: scope];
+    count = 0;
+    for (cur = arguments; cur != [Nil nil]; cur = [cur cdr]) {
+            count++;
+    }
+    [code addInstruction: [Instruction opcode: MAKEENV operand: count]];
+    [code addInstruction: [Instruction opcode: LOADENV]];
+    cur = arguments;
+    for (index = 0; index < count; cur = [cur cdr]) {
+            [scope addName: (Symbol) [cur car]];
+            [code addInstruction: [Instruction opcode: SET operand: index]];
+            index++;
+    }       
+}
+
+- (void) emitSequence: (SchemeObject) expressions
+{
+    local SchemeObject cur;
+
+    for (cur = expressions; cur != [Nil nil]; cur = [cur cdr]) {
+            [self emitExpression: [cur car]];
+    }
+}
+
+- (void) emitVariable: (Symbol) sym
+{
+    local integer depth = [scope depthOf: sym];
+    local integer index = [scope indexOf: sym];
+
+    [code addInstruction: [Instruction opcode: LOADENV]];
+    if (depth != -1) {
+            for (; depth; depth--) {
+                    [code addInstruction: [Instruction opcode: GETLINK]];
+            }
+            [code addInstruction: [Instruction opcode: GET operand: index]];
+    } else {
+            index = [code addConstant: sym];
+            [code addInstruction: [Instruction opcode: LOADLITS]];
+            [code addInstruction: [Instruction opcode: GET operand: index]];
+            [code addInstruction: [Instruction opcode: GETGLOBAL]];
+    }                          
+}
+
+- (void) emitExpression: (SchemeObject) expression
+{
+    if ([expression isKindOfClass: [Cons class]]) {
+            if ([expression car] == lambdaSym) {
+                    [self emitLambda: expression];
+            } else if ([expression car] == quoteSym) {
+                    [self emitConstant: [[expression cdr] car]];
+            } else {
+                    [self emitApply: expression];
+            }
+    } else if ([expression isKindOfClass: [Symbol class]]) {
+            [self emitVariable: (Symbol) expression];
+    } else {
+            [self emitConstant: expression];
+    }
+}
+
+- (void) emitArguments: (SchemeObject) expression
+{
+    if (expression == [Nil nil]) {
+            return;
+    } else {
+            [self emitArguments: [expression cdr]];
+            [self emitExpression: [expression car]];
+            [code addInstruction: [Instruction opcode: PUSH]];
+    }
+}
+
+- (void) emitApply: (SchemeObject) expression
+{
+    local Instruction label = [Instruction opcode: LABEL];
+    [code addInstruction: [Instruction opcode: MAKECONT label: label]];
+    [self emitArguments: [expression cdr]];
+    [self emitExpression: [expression car]];
+    [code addInstruction: [Instruction opcode: CALL]];
+    [code addInstruction: label];
+}
+
+- (void) emitLambda: (SchemeObject) expression
+{
+    local Compiler compiler = [Compiler newWithLambda: expression
+                                        scope: scope];
+    local integer index;
+    
+    [compiler compile];
+    index = [code addConstant: [compiler code]];
+    [code addInstruction: [Instruction opcode: LOADLITS]];
+    [code addInstruction: [Instruction opcode: GET operand: index]];
+    [code addInstruction: [Instruction opcode: MAKECLOSURE]];
+}
+
+- (void) emitConstant: (SchemeObject) expression
+{
+    local integer index;
+    index = [code addConstant: expression];
+    [code addInstruction: [Instruction opcode: LOADLITS]];
+    [code addInstruction: [Instruction opcode: GET operand: index]];
+}
+
+- (void) compile
+{
+    [self emitBuildEnvironment: [[sexpr cdr] car]];
+    [self emitSequence: [[sexpr cdr] cdr]];
+    [code addInstruction: [Instruction opcode: RETURN]];
+    [code compile];
+}
+
+- (CompiledCode) code
+{
+    return code;
+}
+            
+@end

ruamoko/scheme/Cons.h

@@ -0,0 +1,19 @@
+#ifndef __Cons_h
+#define __Cons_h
+#include "SchemeObject.h"
+
+@interface Cons: SchemeObject
+{
+    SchemeObject car, cdr;
+}
++ (id) newWithCar: (SchemeObject) a cdr: (SchemeObject) d;
+- (id) initWithCar: (SchemeObject) a cdr: (SchemeObject) d;
+- (SchemeObject) car;
+- (void) car: (SchemeObject) a;
+- (SchemeObject) cdr;
+- (void) cdr: (SchemeObject) d;
+@end
+
+@extern Cons cons (SchemeObject car, SchemeObject cdr);
+
+#endif //__Cons_h

ruamoko/scheme/Cons.r

@@ -0,0 +1,82 @@
+#include "string.h"
+#include "Cons.h"
+#include "Nil.h"
+#include "defs.h"
+
+Cons cons (SchemeObject car, SchemeObject cdr)
+{
+    return [Cons newWithCar: car cdr: cdr];
+}
+
+@implementation Cons
+
++ (id) newWithCar: (SchemeObject) a cdr: (SchemeObject) d
+{
+    return [[self alloc] initWithCar: a cdr: d];
+}
+
+- (id) initWithCar: (SchemeObject) a cdr: (SchemeObject) d
+{
+    car = a;
+    cdr = d;
+
+    if (!car) {
+            print("Cons: WARNING: NIL car\n");
+    } else if (!cdr) {
+            print("cons: WARNING: NIL cdr\n");
+    }
+
+     return [super init];
+}
+
+- (SchemeObject) car
+{
+    return car;
+}
+
+- (void) car: (SchemeObject) a
+{
+    car = a;
+}
+
+- (SchemeObject) cdr
+{
+    return cdr;
+}
+
+- (void) cdr: (SchemeObject) d
+{
+    cdr = d;
+}   
+
+- (void) mark
+{
+    [super mark];
+    [car mark];
+    [cdr mark];
+}
+
+- (string) printForm
+{
+    local string acc = "", res;
+    local id cur, next = NIL;
+
+    for (cur = self; cur; cur = next) {
+            next = [cur cdr];
+            acc = acc + [[cur car] printForm];
+            if (next == [Nil nil]) {
+                    next = NIL;
+            } else  if (next && ![next isKindOfClass: [Cons class]]) {
+                    acc = acc + " . " + [next printForm];
+                    next = NIL;
+            } else if (next) {
+                    acc = acc + " ";
+            }
+    }
+
+    res = str_new();
+    str_copy(res, sprintf("(%s)", acc));
+    return res;
+}
+
+@end

ruamoko/scheme/Continuation.h

@@ -0,0 +1,18 @@
+#ifndef __Continuation_h
+#define __Continuation_h
+#include "SchemeObject.h"
+#include "Procedure.h"
+#include "state.h"
+
+@interface Continuation: Procedure
+{
+    state_t state;
+    SchemeObject cont;
+    Frame env;
+}
++ (id) newWithState: (state_t []) st environment: (Frame) e continuation: (Continuation) c pc: (integer) p;
+- (id) initWithState: (state_t []) st environment: (Frame) e continuation: (Continuation) c pc: (integer) p;
+
+@end
+
+#endif //__Procedure_h

ruamoko/scheme/Continuation.r

@@ -0,0 +1,34 @@
+#include "Continuation.h"
+#include "defs.h"
+
+@implementation Continuation
++ (id) newWithState: (state_t []) st environment: (Frame) e continuation: (Continuation) c pc: (integer) p
+{
+    return [[self alloc] initWithState: st environment: e continuation: c pc: p];
+}
+- (id) initWithState: (state_t []) st environment: (Frame) e continuation: (Continuation) c pc: (integer) p
+{
+    self = [self init];
+    state.program = st.program;
+    state.pc = p;
+    state.literals = st.literals;
+    state.stack = st.stack;
+    cont = c;
+    env = e;
+    return self;
+}
+
+- (void) invokeOnMachine: (Machine) m
+{
+    [m state: &state];
+    [m environment: env];
+    [m continuation: cont];
+    return;
+}
+
+- (string) printForm
+{
+    return "<continuation>";
+}
+
+@end

ruamoko/scheme/Frame.h

@@ -0,0 +1,18 @@
+#ifndef __Frame_h
+#define __Frame_h
+#include "SchemeObject.h"
+
+@interface Frame: SchemeObject
+{
+    SchemeObject[] array;
+    integer size;
+    Frame link;
+}
++ (id) newWithSize: (integer) sz link: (Frame) l;
+- (id) initWithSize: (integer) sz link: (Frame) l;
+- (void) set: (integer) index to: (SchemeObject) o;
+- (SchemeObject) get: (integer) index;
+- (Frame) getLink;
+@end
+
+#endif //__FOO_h

ruamoko/scheme/Frame.r

@@ -0,0 +1,33 @@
+#include "Frame.h"
+
+@implementation Frame
++ (id) newWithSize: (integer) sz link: (Frame) l
+{
+    return [[self alloc] initWithSize: sz link: l];
+}
+
+- (id) initWithSize: (integer) sz link: (Frame) l
+{
+    self = [super init];
+    size = sz;
+    link = l;
+    array = obj_malloc(@sizeof (id) * size);
+    return self;
+}
+
+- (void) set: (integer) index to: (SchemeObject) o
+{
+    array[index] = o;
+}
+
+- (SchemeObject) get: (integer) index
+{
+    return array[index];
+}
+
+- (Frame) getLink
+{
+    return link;
+}
+
+@end

ruamoko/scheme/Instruction.h

@@ -0,0 +1,46 @@
+#ifndef __Instruction_h
+#define __Instruction_h
+#include "SchemeObject.h"
+
+typedef enum {
+    LABEL,
+    PUSH,
+    POP,
+    MAKECLOSURE,
+    MAKECONT,
+    LOADENV,
+    LOADLITS,
+    MAKEENV,
+    GET,
+    SET,
+    GETLINK,
+    GETGLOBAL,
+    CALL,
+    RETURN
+} opcode_e;
+
+struct instruction_s {
+    opcode_e opcode;
+    integer operand;
+};
+
+typedef struct instruction_s instruction_t;
+
+@interface Instruction: SchemeObject
+{
+    opcode_e opcode;
+    integer operand, offset;
+    Instruction label;
+}
++ (id) opcode: (opcode_e) oc;
++ (id) opcode: (opcode_e) oc operand: (integer) op;
++ (id) opcode: (opcode_e) oc label: (Instruction) l;
+- (id) initWithOpcode: (opcode_e) oc operand: (integer) op label: (Instruction) l;
+- (void) offset: (integer) ofs;
+- (integer) offset;
+- (opcode_e) opcode;
+- (void) emitStruct: (instruction_t []) program;
+
+@end
+
+#endif //__Instruction_h

ruamoko/scheme/Instruction.r

@@ -0,0 +1,54 @@
+#include "Instruction.h"
+#include "defs.h"
+
+@implementation Instruction
++ (id) opcode: (opcode_e) oc
+{
+    return [[self alloc] initWithOpcode: oc operand: 0 label: NIL];
+}
+
++ (id) opcode: (opcode_e) oc operand: (integer) op
+{
+    return [[self alloc] initWithOpcode: oc operand: op label: NIL];
+}
+
++ (id) opcode: (opcode_e) oc label: (Instruction) l
+{
+    return [[self alloc] initWithOpcode: oc operand: 0 label: l];
+}
+
+- (id) initWithOpcode: (opcode_e) oc operand: (integer) op label: (Instruction) l
+{
+    self = [super init];
+    opcode = oc;
+    operand = op;
+    label = l;
+    return self;
+}
+
+- (void) offset: (integer) ofs
+{
+    offset = ofs;
+}
+
+- (integer) offset
+{
+    return offset;
+}
+
+- (opcode_e) opcode
+{
+    return opcode;
+}
+
+- (void) emitStruct: (instruction_t []) program
+{
+    program[offset].opcode = opcode;
+    if (label) {
+            program[offset].operand = [label offset];
+    } else {
+            program[offset].operand = operand;
+    }
+}
+
+@end

ruamoko/scheme/Lambda.h

@@ -0,0 +1,17 @@
+#ifndef __Lambda_h
+#define __Lambda_h
+#include "Procedure.h"
+#include "Cons.h"
+#include "Frame.h"
+#include "CompiledCode.h"
+
+@interface Lambda: Procedure
+{
+    Frame env;
+    CompiledCode code;
+}
++ (id) newWithCode: (CompiledCode) c environment: (Frame) e;
+- (id) initWithCode: (CompiledCode) c environment: (Frame) e;
+@end
+
+#endif //__Lambda_h

ruamoko/scheme/Lambda.r

@@ -0,0 +1,92 @@
+#include "Lambda.h"
+#include "Nil.h"
+#include "Symbol.h"
+#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
+{
+    return [[self alloc] initWithCode: c environment: e];
+}
+            
+- (id) initWithCode: (CompiledCode) c environment: (Frame) e
+{
+    self = [super init];
+    code = c;
+    env = e;
+    return self;
+}
+
+- (void) invokeOnMachine: (Machine) m
+{
+    [m loadCode: code];
+    [m environment: env];
+}
+    
+@end

ruamoko/scheme/Lexer.h

@@ -0,0 +1,17 @@
+#ifndef __Lexer_h
+#define __Lexer_h
+#include "SchemeObject.h"
+#include "Symbol.h"
+
+@interface Lexer: Object
+{
+    string source;
+    Symbol lparen;
+    Symbol rparen;
+}
++ (id) newFromSource: (string) s;
+- (id) initWithSource: (string) s;
+- (SchemeObject) nextToken;
+@end
+
+#endif //__Lexer_h

ruamoko/scheme/Lexer.r

@@ -0,0 +1,79 @@
+#include "Lexer.h"
+#include "Number.h"
+#include "string.h"
+
+
+BOOL isdigit (string x)
+{
+    return (x == "0" || x == "1" || x == "2" || x == "3" ||
+            x == "4" || x == "5" || x == "6" || x == "7" ||
+            x == "8" || x == "9");
+}
+
+BOOL isspace (string x)
+{
+    return (x == " " || x == "\t" || x == "\n" || x == "\r");
+}
+
+BOOL issymbol (string x)
+{
+    return (x != "" && x != "(" && x !=")" && !isspace (x));
+}
+
+@implementation Lexer
+
++ (id) newFromSource: (string) s
+{
+    return [[Lexer alloc] initWithSource: s];
+}
+
+- (id) initWithSource: (string) s
+{
+    source = s;
+    return [super init];
+}
+
+- (SchemeObject) nextToken
+{
+    local integer len;
+    local Number num;
+    local Symbol sym;
+    local String str;
+    
+    for (len = 0; isspace(str_mid(source, len, len+1)); len++);
+    source = str_mid(source, len);
+
+    switch (str_mid (source, 0, 1)) {
+        case "(":
+            source = str_mid (source, 1);
+            return [Symbol leftParen];
+        case ")":
+            source = str_mid (source, 1);
+            return [Symbol rightParen];
+        case "0": case "1": case "2":
+        case "3": case "4": case "5":
+        case "6": case "7": case "8":
+        case "9":
+            for (len = 1; isdigit(str_mid(source, len, len+1)); len++);
+            num = [Number newFromInt: stoi (str_mid(source, 0, len))];
+            source = str_mid(source, len);
+            return num;
+        case "\"":
+            for (len = 1; str_mid(source, len, len+1) != "\""; len++);
+            str = [String newFromString: str_mid(source, 1, len)];
+            source = str_mid(source, len+1);
+            return str;
+        case "'":
+            source = str_mid (source, 1);
+            return [Symbol quote];
+        case "":
+            return NIL;
+        default:
+            for (len = 1; issymbol(str_mid(source, len, len+1)); len++);
+            sym = [Symbol newFromString: str_mid (source, 0, len)];
+            source = str_mid(source, len);
+            return sym;
+    }
+}
+
+@end

ruamoko/scheme/Machine.h

@@ -0,0 +1,31 @@
+#ifndef __Machine_h
+#define __Machine_h
+#include "Symbol.h"
+#include "CompiledCode.h"
+#include "Frame.h"
+#include "Continuation.h"
+#include "hash.h"
+#include "state.h"
+
+@interface Machine: SchemeObject
+{
+    state_t state;
+    SchemeObject value;
+    Continuation cont;
+    Frame env;
+    hashtab_t globals;
+}
+- (void) loadCode: (CompiledCode) code;
+- (SchemeObject) run;
+- (void) addGlobal: (Symbol) sym value: (SchemeObject) val;
+- (void) environment: (Frame) e;
+- (void) continuation: (Continuation) c;
+- (Continuation) continuation;
+- (void) value: (SchemeObject) o;
+- (SchemeObject) stack;
+- (void) stack: (SchemeObject) o;
+- (state_t []) state;
+- (void) state: (state_t []) st;
+@end
+
+#endif //__Machine_h

ruamoko/scheme/Machine.r

@@ -0,0 +1,179 @@
+#include "Machine.h"
+#include "Cons.h"
+#include "Lambda.h"
+#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];
+}
+
+void GlobalFree (void []ele, void []data)
+{
+    return;
+}
+
+@implementation Machine
+
+- (id) init
+{
+    self = [super init];
+    state.program = NIL;
+    state.pc = 0;
+    value = NIL;
+    cont = NIL;
+    env = NIL;
+    state.literals = NIL;
+    state.stack = [Nil nil];
+    globals = Hash_NewTable(1024, GlobalGetKey, GlobalFree, NIL);
+    return self;
+}
+
+- (void) addGlobal: (Symbol) sym value: (SchemeObject) val
+{
+    Hash_Add(globals, cons(sym, val));
+}
+
+- (void) loadCode: (CompiledCode) code
+{
+    state.program = [code code];
+    state.literals = [code literals];
+    state.pc = 0;
+}
+
+- (void) environment: (Frame) e
+{
+    env = e;
+}
+
+- (void) continuation: (Continuation) c
+{
+    cont = c;
+}
+
+- (void) value: (SchemeObject) v
+{
+    value = v;
+}
+
+- (Continuation) continuation
+{
+    return cont;
+}
+
+- (SchemeObject) stack
+{
+    return state.stack;
+}
+
+- (void) stack: (SchemeObject) o
+{
+    state.stack = o;
+}
+
+- (state_t []) state
+{
+    return &state;
+}
+
+- (void) state: (state_t []) st
+{
+    state.program = st[0].program;
+    state.pc = st[0].pc;
+    state.literals = st[0].literals;
+    state.stack = st[0].stack;
+}
+
+- (SchemeObject) run
+{
+    local integer opcode;
+    local integer operand;
+    while (1) {
+            opcode = state.program[state.pc].opcode;
+            operand = state.program[state.pc].operand;
+            state.pc = state.pc + 1;
+
+            
+            switch (opcode) {
+                case PUSH:
+                    if (value) {
+                            dprintf("Push: %s\n", [value printForm]);
+                    } else {
+                            dprintf("Push: NULL!!!!\n");
+                    }
+                    state.stack = cons(value, state.stack);
+                    break;
+                case POP:
+                    value = [state.stack car];
+                    if (value) {
+                            dprintf("Pop: %s\n", [value printForm]);
+                    } else {
+                            dprintf("Pop: NULL!!!!\n");
+                    }
+                    state.stack = [state.stack cdr];
+                    break;
+                case MAKECLOSURE:
+                    dprintf("Makeclosure\n");
+                    value = [Lambda newWithCode: (CompiledCode) value environment: env];
+                    break;
+                case MAKECONT:
+                    dprintf("Makecont\n");
+                    cont = [Continuation newWithState: &state
+                                         environment: env
+                                         continuation: cont
+                                         pc: operand];
+                    break;
+                case LOADENV:
+                    dprintf("Loadenv\n");
+                    value = env;
+                    break;
+                case LOADLITS:
+                    dprintf("Loadlits\n");
+                    value = state.literals;
+                    break;
+                case MAKEENV:
+                    dprintf("Makeenv\n");
+                    env = [Frame newWithSize: operand link: env];
+                    break;
+                case GET:
+                    value = [value get: operand];
+                    dprintf("Get: %i --> %s\n", operand, [value printForm]);
+                    break;
+                case SET:
+                    [value set: operand to: [state.stack car]];
+                    dprintf("Set: %i --> %s\n", operand, [value printForm]);
+                    state.stack = [state.stack cdr];
+                    break;
+                case GETLINK:
+                    dprintf("Getlink");
+                    value = [value getLink];
+                    break;
+                case GETGLOBAL:
+                    dprintf("Getglobal: %s\n", [value printForm]);
+                    value = [((Cons) Hash_Find(globals, [value printForm])) cdr];
+                    break;
+                case CALL:
+                    dprintf("Call\n");
+                    [value invokeOnMachine: self];
+                    break;
+                case RETURN:
+                    dprintf("Return: %s\n", [value printForm]);
+                    if (!cont) {
+                            return value;
+                    } else {
+                            [cont invokeOnMachine: self];
+                    }
+                    break;
+            }
+    }
+}
+@end

ruamoko/scheme/Makefile.am

@@ -0,0 +1,62 @@
+AUTOMAKE_OPTIONS=	foreign
+
+pkglibdir=$(libdir)/ruamoko
+
+QFCC_DEP=$(top_builddir)/tools/qfcc/source/qfcc$(EXEEXT)
+QFCC=$(QFCC_DEP)
+QCFLAGS=-qq -g -Werror
+QCPPFLAGS=$(INCLUDES)
+PAK=$(top_builddir)/tools/pak/pak$(EXEEXT)
+GZIP=if echo $@ | grep -q .gz; then gzip -f `basename $@ .gz`; if test -f `basename $@ .dat.gz`.sym; then gzip -f `basename $@ .dat.gz`.sym; fi; fi
+if HAVE_ZLIB
+GZ=.gz
+else
+GZ=
+endif
+STRIP=$(shell echo `echo -n $(srcdir)/ | sed -e 's/[^/]//g' | wc -c`)
+
+RANLIB=touch
+
+INCLUDES=	-I$(top_srcdir)/ruamoko/include -I$(top_srcdir)/include
+
+scheme_libs=libscheme.a
+if BUILD_RUAMOKO
+libs=$(scheme_libs)
+data=$(scheme_data)
+else
+libs=
+endif
+
+pkglib_LIBRARIES= $(libs)
+EXTRA_LIBRARIES= $(scheme_libs)
+pkgdata_DATA= $(data)
+EXTRA_DATA = $(scheme_data)
+
+
+%.qfo: %.r
+	$(QFCC) $(QCFLAGS) $(QCPPFLAGS) -c -o $@ $<
+
+%.o: %.r
+	$(QFCC) $(QCFLAGS) $(QCPPFLAGS) -c -o $@ $<
+%.o: %.qc
+	$(QFCC) $(QCFLAGS) $(QCPPFLAGS) -c -o $@ $<
+
+libscheme_a_SOURCES=\
+	SchemeObject.r Cons.r Number.r String.r Symbol.r Lexer.r Parser.r Nil.r \
+	Procedure.r Primitive.r Lambda.r Scope.r Instruction.r builtins.r \
+	Frame.r CompiledCode.r Compiler.r Continuation.r Machine.r Void.r
+libscheme_a_AR=$(PAK) -cf
+
+scheme_data=\
+	main.dat$(GZ)
+
+scheme_src=\
+	main.qc defs.qc
+
+scheme_obj=$(addsuffix .o,$(basename $(scheme_src)))
+
+main.dat$(GZ): $(scheme_obj) $(QFCC_DEP) ../lib/libcsqc.a ../lib/libr.a libscheme.a
+	$(QFCC) $(QCFLAGS) -p $(STRIP) -o main.dat $(scheme_obj) libscheme.a ../lib/libcsqc.a ../lib/libr.a
+	$(GZIP)
+
+CLEANFILES=	*.qfo *.o

ruamoko/scheme/Nil.h

@@ -0,0 +1,11 @@
+#ifndef __Nil_h
+#define __Nil_h
+#include "SchemeObject.h"
+
+@interface Nil: SchemeObject
+{
+}
++ (id) nil;
+@end
+
+#endif //__Nil_h

ruamoko/scheme/Nil.r

@@ -0,0 +1,23 @@
+#include "Nil.h"
+#include "defs.h"
+
+Nil one_nil_to_rule_them_all;
+
+@implementation Nil
+
++ (void) initialize
+{
+    one_nil_to_rule_them_all = [Nil new];
+}
+
++ (id) nil
+{
+    return one_nil_to_rule_them_all;
+}
+
+- (string) printForm
+{
+    return "()";
+}
+
+@end

ruamoko/scheme/Number.h

@@ -0,0 +1,14 @@
+#ifndef __Number_h
+#define __Number_h
+#include "SchemeObject.h"
+
+@interface Number: SchemeObject
+{
+    integer value;
+}
++ (id) newFromInt: (integer) i;
+- (id) initWithInt: (integer) i;
+- (integer) intValue;
+@end
+
+#endif //__Number_h

ruamoko/scheme/Number.r

@@ -0,0 +1,27 @@
+#include "Number.h"
+#include "string.h"
+
+@implementation Number
+
++ (id) newFromInt: (integer) i
+{
+    return [[self alloc] initWithInt: i];
+}
+
+- (id) initWithInt: (integer) i
+{
+    value = i;
+    return [super init];
+}
+
+- (integer) intValue
+{
+    return value;
+}
+
+- (string) printForm
+{
+    return itos (value);
+}
+
+@end

ruamoko/scheme/Parser.h

@@ -0,0 +1,14 @@
+#ifndef __Parser_h
+#define __Parser_h
+#include "Lexer.h"
+
+@interface Parser: Object
+{
+    Lexer lexer;
+}
++ (id) newFromSource: (string) s;
+- (id) initWithSource: (string) s;
+- (SchemeObject) read;
+@end
+
+#endif //__Parser_h

ruamoko/scheme/Parser.r

@@ -0,0 +1,55 @@
+#include "Cons.h"
+#include "Parser.h"
+#include "Nil.h"
+#include "defs.h"
+
+@implementation Parser
+
++ (id) newFromSource: (string) s
+{
+    return [[self alloc] initWithSource: s];
+}
+
+- (id) initWithSource: (string) s
+{
+    lexer = [Lexer newFromSource: s];
+    return [super init];
+}
+
+- (SchemeObject) readList
+{
+    local SchemeObject token;
+    
+    token = [self read];
+
+    if (!token)
+            return NIL;
+    
+    if (token == [Symbol rightParen]) {
+            return [Nil nil];
+    } else {
+            return [Cons newWithCar: token cdr: [self readList]];
+    }
+}
+
+- (SchemeObject) read
+{
+    local SchemeObject token;
+    local SchemeObject list;
+    
+    token = [lexer nextToken];
+
+    if (!token) {
+            return NIL;
+    }
+
+    
+    if (token == [Symbol leftParen]) {
+            list = [self readList];
+            return list;
+    } else if (token == [Symbol quote]) {
+            return cons([Symbol forString: "quote"], cons([self read], [Nil nil]));
+    } else return token;
+}
+
+@end

ruamoko/scheme/Primitive.h

@@ -0,0 +1,16 @@
+#ifndef __Primitive_h
+#define __Primitive_h
+#include "Procedure.h"
+#include "Machine.h"
+
+typedef SchemeObject (SchemeObject args, Machine m) primfunc_t;
+
+@interface Primitive: Procedure
+{
+    primfunc_t func;
+}
++ (id) newFromFunc: (primfunc_t) f;
+- (id) initWithFunc: (primfunc_t) f;
+@end
+
+#endif //__Procedure_h

ruamoko/scheme/Primitive.r

@@ -0,0 +1,27 @@
+#include "Primitive.h"
+#include "Machine.h"
+
+@implementation Primitive
++ (id) newFromFunc: (primfunc_t) f
+{
+    return [[self alloc] initWithFunc: f];
+}
+- (id) initWithFunc: (primfunc_t) f
+{
+    self = [super init];
+    func = f;
+    return self;
+}
+- (SchemeObject) invokeOnMachine: (Machine) m
+{
+    local SchemeObject value = func ([m stack], m);
+    [m value: value];
+    [[m continuation] invokeOnMachine: m];
+}
+
+- (string) printForm
+{
+    return "<primitive>";
+}
+
+@end

ruamoko/scheme/Procedure.h

@@ -0,0 +1,11 @@
+#ifndef __Procedure_h
+#define __Procedure_h
+#include "SchemeObject.h"
+
+@class Machine;
+
+@interface Procedure: SchemeObject
+- (void) invokeOnMachine: (Machine) m;
+@end
+
+#endif //__Procedure_h

ruamoko/scheme/Procedure.r

@@ -0,0 +1,14 @@
+#include "Procedure.h"
+
+@implementation Procedure
+- (void) invokeOnMachine: (Machine) m
+{
+    return;
+}
+
+- (string) printForm
+{
+    return "<procedure>";
+}
+
+@end

ruamoko/scheme/SchemeObject.h

@@ -0,0 +1,17 @@
+#ifndef __SchemeObject_h
+#define __SchemeObject_h
+#include "Object.h"
+#define true YES
+#define false NO
+
+@interface SchemeObject: Object
+{
+	BOOL marked;
+}
+- (void) mark;
+- (BOOL) sweep;
+//+ (id) alloc;
+- (string) printForm;
+@end
+
+#endif //__SchemeObject_h

ruamoko/scheme/SchemeObject.r

@@ -0,0 +1,32 @@
+#include "SchemeObject.h"
+
+@implementation SchemeObject
+
+/*
++ (id) alloc
+{
+    return [super alloc];
+}
+*/
+- (void) mark
+{
+    marked = true;
+}
+
+- (BOOL) sweep
+{
+    if (marked) {
+            marked = false;
+            return false;
+    } else {
+            [self release];
+            return true;
+    }
+}
+
+- (string) printForm
+{
+    return "<generic>";
+}
+
+@end

ruamoko/scheme/Scope.h

@@ -0,0 +1,20 @@
+#ifndef __Scope_h
+#define __Scope_h
+#include "SchemeObject.h"
+#include "Array.h"
+#include "Symbol.h"
+
+@interface Scope: SchemeObject
+{
+    Scope outerScope;
+    Array names;
+}
++ (id) newWithOuter: (Scope) o;
+- (id) initWithOuter: (Scope) o;
+- (integer) depthOf: (Symbol) sym;
+- (integer) indexOf: (Symbol) sym;
+- (void) addName: (Symbol) sym;
+
+@end
+
+#endif //__Scope_h

ruamoko/scheme/Scope.r

@@ -0,0 +1,77 @@
+#include "Scope.h"
+#include "defs.h"
+
+@implementation Scope
+
++ (id) newWithOuter: (Scope) o
+{
+    return [[self alloc] initWithOuter: o];
+}
+
+- (id) initWithOuter: (Scope) o
+{
+    self = [super init];
+    outerScope = o;
+    names = [Array new];
+    return self;
+}
+
+- (integer) indexLocal: (Symbol) sym
+{
+    local integer index;
+
+    for (index = 0; index < [names count]; index++) {
+            if (sym == [names getItemAt: index]) {
+                    return index;
+            }
+    }
+    return -1;
+}
+
+- (integer) indexOf: (Symbol) sym
+{
+    local integer index;
+
+    index = [self indexLocal: sym];
+
+    if (index < 0 && outerScope) {
+            return [outerScope indexOf: sym];
+    } else {
+            return index;
+    }
+}
+
+- (integer) depthOf: (Symbol) sym
+{
+    local integer index;
+    local integer res;
+
+    index = [self indexLocal: sym];
+
+    if (index < 0) {
+            if (outerScope) {
+                    res = [outerScope depthOf: sym];
+                    if (res < 0) {
+                            return -1;
+                    } else {
+                            return 1 + res;
+                    }
+            } else {
+                    return -1;
+            }
+    } else {
+            return 0;
+    }
+}
+
+- (void) addName: (Symbol) sym
+{
+    [names addItem: sym];
+}
+
+- (void) dealloc
+{
+    [names release];
+}
+
+@end

ruamoko/scheme/String.h

@@ -0,0 +1,14 @@
+#ifndef __String_h
+#define __String_h
+#include "SchemeObject.h"
+
+@interface String: SchemeObject
+{
+    string value;
+}
++ (id) newFromString: (string) s;
+- (id) initWithString: (string) s;
+- (string) stringValue;
+@end
+
+#endif //__String_h

ruamoko/scheme/String.r

@@ -0,0 +1,35 @@
+#include "string.h"
+#include "String.h"
+
+@implementation String
+
++ (id) newFromString: (string) s
+{
+    return [[self alloc] initWithString: s];
+}
+
+- (id) initWithString: (string) s
+{
+    self = [super init];
+    value = str_new();
+    str_copy(value, s);
+    return self;
+}
+
+- (string) stringValue
+{
+    return value;
+}
+
+- (string) printForm
+{
+    return value;
+}
+
+- (void) dealloc
+{
+    str_free (value);
+    [super dealloc];
+}
+
+@end

ruamoko/scheme/Symbol.h

@@ -0,0 +1,15 @@
+#ifndef __Symbol_h
+#define __Symbol_h
+#include "String.h"
+
+@interface Symbol: String
+{
+    string value;
+}
++ (void) initialize;
++ (Symbol) leftParen;
++ (Symbol) rightParen;
++ (Symbol) forString: (string) s;
+@end
+
+#endif //__Symbol_h

ruamoko/scheme/Symbol.r

@@ -0,0 +1,74 @@
+#include "Symbol.h"
+#include "hash.h"
+#include "defs.h"
+
+string SymbolGetKey (void [] ele, void [] data)
+{
+    local Symbol s = (Symbol) ele;
+
+    return [s stringValue];
+}
+
+void SymbolFree (void [] ele, void [] data)
+{
+    local Symbol s = (Symbol) ele;
+
+    [s release];
+}
+    
+hashtab_t symbols;
+Symbol lparen;
+Symbol rparen;
+Symbol quote;
+
+@implementation Symbol
++ (void) initialize
+{
+    symbols = Hash_NewTable (1024, SymbolGetKey, SymbolFree, NIL);
+    lparen = [Symbol forString: "("];
+    rparen = [Symbol forString: ")"];
+    quote = [Symbol forString: "'"];
+    
+}
+
++ (Symbol) forString: (string) s
+{
+    return (Symbol) [self newFromString: s];
+}
+
++ (Symbol) leftParen
+{
+    return lparen;
+}
+
++ (Symbol) rightParen
+{
+    return rparen;
+}
+
++ (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];
+}
+
+
+@end

ruamoko/scheme/Void.h

@@ -0,0 +1,13 @@
+#ifndef __Void_h
+#define __Void_h
+#include "SchemeObject.h"
+
+@interface Void: SchemeObject
+{
+}
++ (id) voidConstant;
+@end
+
+@extern Void voidConstant;
+
+#endif //__Void_h

ruamoko/scheme/Void.r

@@ -0,0 +1,22 @@
+#include "Void.h"
+
+Void voidConstant;
+
+@implementation Void
+
++ (void) initialize
+{
+    voidConstant = [Void new];
+}
+
++ (id) voidConstant
+{
+    return voidConstant;
+}
+
+- (string) printForm
+{
+    return "<void>";
+}
+
+@end

ruamoko/scheme/builtins.h

@@ -0,0 +1,8 @@
+#include "Primitive.h"
+
+@extern Primitive print_p;
+@extern Primitive newline_p;
+@extern Primitive add_p;
+@extern Primitive map_p;
+@extern Primitive for_each_p;
+@extern void builtin_init (void);

ruamoko/scheme/builtins.r

@@ -0,0 +1,94 @@
+#include "Void.h"
+#include "Nil.h"
+#include "Number.h"
+#include "builtins.h"
+#include "defs.h"
+#include "string.h"
+#include "Cons.h"
+#include "Continuation.h"
+
+Primitive print_p;
+Primitive newline_p;
+Primitive add_p;
+Primitive map_p;
+Primitive for_each_p;
+
+SchemeObject bi_print (SchemeObject args, Machine m)
+{
+    print([[args car] printForm]);
+    return [Void voidConstant];
+}
+
+SchemeObject bi_newline (SchemeObject args, Machine m)
+{
+    print("\n");
+    return [Void voidConstant];
+}
+
+SchemeObject bi_add (SchemeObject args, Machine m)
+{
+    local integer sum = 0;
+    local SchemeObject cur;
+
+    for (cur = args; cur != [Nil nil]; cur = [cur cdr]) {
+            sum += [(Number) [cur car] intValue];
+    }
+
+    return [Number newFromInt: sum];
+}
+
+SchemeObject bi_map (SchemeObject args, Machine m)
+{
+    local SchemeObject func = [args car];
+    local SchemeObject list = [[args cdr] car];
+    local SchemeObject output, cur, last, temp;
+    local Continuation oldcont;
+    
+    if (list == [Nil nil]) {
+            return list;
+    } else {
+            oldcont = [m continuation];
+            [m stack: cons([list car], [Nil nil])];
+            [m continuation: NIL];
+            [func invokeOnMachine: m];
+            output = last = cons([m run], [Nil nil]);
+            for (cur = [list cdr]; cur != [Nil nil]; cur = [cur cdr]) {
+                    [m stack: cons([cur car], [Nil nil])];
+                    [func invokeOnMachine: m];
+                    temp = cons([m run], [Nil nil]);
+                    [last cdr: temp];
+                    last = temp;
+            }
+            [m continuation: oldcont];
+            return output;
+    }
+}
+    
+SchemeObject bi_for_each (SchemeObject args, Machine m)
+{
+    local SchemeObject func = [args car];
+    local SchemeObject list = [[args cdr] car];
+    local SchemeObject cur;
+    local Continuation oldcont;
+    
+    if (list != [Nil nil]) { 
+            oldcont = [m continuation];
+            [m continuation: NIL];
+            for (cur = list; cur != [Nil nil]; cur = [cur cdr]) {
+                    [m stack: cons([cur car], [Nil nil])];
+                    [func invokeOnMachine: m];
+                    [m run];
+            }
+            [m continuation: oldcont];
+    }
+    return [Void voidConstant];
+}
+
+void builtin_init (void)
+{
+    print_p = [Primitive newFromFunc: bi_print];
+    newline_p = [Primitive newFromFunc: bi_newline];
+    add_p = [Primitive newFromFunc: bi_add];
+    map_p = [Primitive newFromFunc: bi_map];
+    for_each_p = [Primitive newFromFunc: bi_for_each];
+}

ruamoko/scheme/defs.h

@@ -0,0 +1,13 @@
+@extern void (string str) print = #0;
+@extern integer () errno = #0;
+@extern string (integer err) strerror = #0;
+@extern integer (...) open = #0; // string path, float flags[, float mode]
+@extern integer (integer handle) close = #0;
+@extern string (integer handle, integer count, integer []result) read = #0;
+@extern integer (integer handle, string buffer, integer count) write = #0;
+@extern integer (integer handle, integer pos, integer whence) seek = #0;
+
+//@extern void() traceon = #0;          // turns statment trace on
+//@extern void() traceoff = #0;
+
+@extern void (...) printf = #0;

ruamoko/scheme/defs.qc

@@ -0,0 +1,22 @@
+void (string str) print = #0;
+integer () errno = #0;
+string (integer err) strerror = #0;
+integer (...) open = #0; // string path, float flags[, float mode]
+integer (integer handle) close = #0;
+string (integer handle, integer count, integer []result) read = #0;
+integer (integer handle, string buffer, integer count) write = #0;
+integer (integer handle, integer pos, integer whence) seek = #0;
+
+//void() traceon = #0;          // turns statment trace on
+//void() traceoff = #0;
+
+void (...) printf = #0;
+
+
+float time;
+entity self;
+
+.float nextthink;
+.void() think;
+.float frame;
+.vector origin;

ruamoko/scheme/main.qc

@@ -0,0 +1,60 @@
+#include "Parser.h"
+#include "Nil.h"
+#include "Cons.h"
+#include "Lambda.h"
+#include "defs.h"
+#include "qfile.h"
+#include "string.h"
+#include "builtins.h"
+#include "Compiler.h"
+#include "Machine.h"
+#include "CompiledCode.h"
+
+string readfile (string filename)
+{
+    local string acc = "", res;
+    local QFile file = Qopen (filename, "r");
+    while (!Qeof (file)) {
+            acc += Qgetline (file) + "\n";
+    }
+    Qclose (file);
+    res = str_new();
+    str_copy(res, acc);
+    return res;
+}
+    
+
+integer main (integer argc, string []argv)
+{
+    local Parser parser; 
+    local CompiledCode code;
+    local Compiler comp;
+    local Machine vm;
+    local Lambda lm;
+    local SchemeObject stuff;
+
+    if (argc < 1) {
+            return -1;
+    }
+    
+    builtin_init();
+    parser = [Parser newFromSource: readfile(argv[1])];
+    vm = [Machine new];
+    [vm addGlobal: [Symbol forString: "display"] value: print_p];
+    [vm addGlobal: [Symbol forString: "newline"] value: newline_p];
+    [vm addGlobal: [Symbol forString: "+"] value: add_p];
+    [vm addGlobal: [Symbol forString: "map"] value: map_p];
+    [vm addGlobal: [Symbol forString: "for-each"] value: for_each_p];
+    while ((stuff = [parser read])) {
+            comp = [Compiler newWithLambda: cons ([Symbol forString: "lambda"],
+                                                  cons ([Nil nil],
+                                                        cons(stuff, [Nil nil])))
+                             scope: NIL];
+            [comp compile];
+            code = [comp code];
+            lm = [Lambda newWithCode: code environment: NIL];
+            [lm invokeOnMachine: vm];
+            [vm run];
+    }
+    return 0;
+}

ruamoko/scheme/state.h

@@ -0,0 +1,15 @@
+#ifndef __state_h
+#define __state_h
+
+#include "Instruction.h"
+#include "Frame.h"
+
+struct state_s = {
+    instruction_t [] program;
+    integer pc;
+    Frame literals;
+    SchemeObject stack;
+};
+
+typedef struct state_s state_t;
+#endif