Add compile_tl (), compile `defun's
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index 2594abd..eac885a 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -41,30 +41,73 @@
return f;
}
-void compile (value_t val)
+void compile_tl (value_t val, struct environment *env)
{
- |.section code;
- dasm_init (&d, DASM_MAXSECTION);
+ if ( !listp (val) )
+ err ("Top level must be a list");
+
+ value_t form = car (val);
+ value_t args = cdr (val);
- |.globals lbl_;
- void *labels[ lbl__MAX ];
- dasm_setupglobal (&d, labels, lbl__MAX);
+ if ( symstreq (form, "defun") )
+ {
+ dasm_State *d;
+ dasm_State **Dst = &d;
- |.actionlist lisp_actions;
- dasm_setup (&d, lisp_actions);
+ |.section code;
+ dasm_init (&d, DASM_MAXSECTION);
+
+ |.globals lbl_;
+ void *labels[ lbl__MAX ];
+ dasm_setupglobal (&d, labels, lbl__MAX);
+
+ |.actionlist lisp_actions;
+ dasm_setup (&d, lisp_actions);
+
+ dasm_growpc (&d, npc);
- dasm_growpc (&d, npc);
+ struct local local;
+ local.first = NULL;
+ local.num_vars = 0;
+
+ // Generate code
+
+ | setup 0;
+
+ value_t name = car (args);
+ args = cdr (args);
+ value_t arglist = car (args);
+ value_t body = cdr (args);
+ if ( (name & HEAP_MASK) != SYMBOL_TAG )
+ err ("function name must be a symbol");
+
+ for ( ; !nilp (body); body = cdr (body) )
+ {
+ compile_expression (env, &local, car (body), Dst);
+ }
+
+ | cleanup;
+
+ add_function (env, (char *) (name ^ SYMBOL_TAG), link (Dst), length (arglist));
+
+ dasm_free (&d);
+ }
+}
+
+struct environment compile_all (struct istream *is)
+{
+ value_t val;
struct environment env;
env.first = NULL;
- char *name = "main";
load_std (&env);
+
+ while ( read1 (is, &val) )
+ {
+ compile_tl (val, &env);
+ }
- printval (val, 0);
- compile_expr_to_func (&env, name, val, &d);
-
- value_t (*fun)() = find_function (&env, name)->def0;
- printval (fun (), 0);
+ return env;
}
void compile_expression (struct environment *env, struct local *local,
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index 37eaeba..b3bd89c 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -37,8 +37,6 @@
// local environment
struct local
{
- // temps are accessed at ebp - 8 * (num_vars + temp)
- bool temps[ 64 ];
int num_vars;
struct variable *first;
};
@@ -47,5 +45,7 @@
value_t val, dasm_State **Dst);
void compile_expr_to_func (struct environment *env, char *name, value_t val,
dasm_State **Dst);
-void compile (value_t val);
+// Compile top-level declaration
+void compile_tl (value_t val, struct environment *env);
+struct environment compile_all (struct istream *is);
struct function *find_function (struct environment *env, char *name);
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index 8175940..9c1f3cb 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -33,6 +33,12 @@
return (((a >> 2) / (b >> 2)) << 2) | INT_TAG;
}
+value_t l_printval (value_t val)
+{
+ printval (val, 0);
+ return nil;
+}
+
void add_function (struct environment *env, char *name, void *func, int nargs)
{
struct function *last,
@@ -53,4 +59,10 @@
add_function (env, "-", l_minus, 2);
add_function (env, "*", l_times, 2);
add_function (env, "/", l_divide, 2);
+
+ add_function (env, "car", car, 1);
+ add_function (env, "cdr", cdr, 1);
+ add_function (env, "cons", cons, 2);
+
+ add_function (env, "print", l_printval, 1);
}
diff --git a/src/lisp/lisp b/src/lisp/lisp
index 492c456..807bf9f 100755
--- a/src/lisp/lisp
+++ b/src/lisp/lisp
Binary files differ
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index 6a008f1..e2b02be 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -505,3 +505,11 @@
return car (v);
}
+
+bool symstreq (value_t sym, char *str)
+{
+ if ( (sym & HEAP_MASK) != SYMBOL_TAG )
+ return false;
+
+ return strcmp ((char *) (sym ^ SYMBOL_TAG), str) == 0;
+}
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index b781828..ba69a87 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -102,11 +102,6 @@
void err (const char *msg);
-extern value_t nil;
+bool symstreq (value_t sym, char *str);
-#define FOREACH(item, list) \
- for ( ; listp (list); ) \
- for ( value_t item = car (list), _foreach_current = list; \
- !nilp (_foreach_current); \
- _foreach_current = cdr (_foreach_current), \
- item = car (_foreach_current) )
+extern value_t nil;
diff --git a/src/lisp/main.c b/src/lisp/main.c
index 1bda5f1..5c217fc 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -10,17 +10,10 @@
}
struct istream *is = new_stristream_nt (argv[ 1 ]);
- value_t val;
- while ( read1 (is, &val) )
- {
-// printval (val, 0);
- compile (val);
- }
+ struct environment env = compile_all (is);
+ value_t (*lisp_main) () = find_function(&env, "main")->def0;
+ lisp_main ();
- /* printf ("COMPILING\n"); */
-
- return 0;
-
- del_stristream (is);
+// del_stristream (is);
}
diff --git a/src/lisp/test.lisp b/src/lisp/test.lisp
index a4836eb..68cc615 100644
--- a/src/lisp/test.lisp
+++ b/src/lisp/test.lisp
@@ -1,5 +1,6 @@
-(defun my-fun (a b)
- (display t "%a\n" (+ a b)))
+(defun two-plus-two ()
+ (+ 2 2))
(defun main ()
- (my-fun pi 4 773832))
+ (print "64 / (2 + 2) =")
+ (print (/ 64 (two-plus-two))))