Add macros
diff --git a/src/lisp/Jmk b/src/lisp/Jmk
index ec4e5da..394e077 100644
--- a/src/lisp/Jmk
+++ b/src/lisp/Jmk
@@ -4,14 +4,17 @@
option(PLAT, "`platform to build for: either linux or bluejay'", linux)
-preset(optimize)
+# preset(optimize)
preset(32)
preset(debug)
preset(warn)
+preset(nasm)
-archetype(c, asm)
+archetype(c)
+archetype(asm)
CFLAGS += -Ivendor/luajit/dynasm
+ASMFLAGS += -felf -Fdwarf
OBJECTS = main.o \
lisp.o \
@@ -19,7 +22,8 @@
lib/std.o \
plat/linux.o \
istream.o \
- gc.o
+ gc.o \
+ call_list.o
LUA = vendor/luajit/src/host/minilua
@@ -33,9 +37,11 @@
type(executable)
+F ?= test.lisp
+
run: lisp
- status_log(LISP, test.lisp)
- @./lisp ./test.lisp
+ status_log(LISP, $(F))
+ @./lisp $(F)
format:
status_log(FORMAT, *)
diff --git a/src/lisp/call_list.s b/src/lisp/call_list.s
new file mode 100644
index 0000000..da0c00c
--- /dev/null
+++ b/src/lisp/call_list.s
@@ -0,0 +1,57 @@
+;;; TODO: figure out if I need to do something special with the GC here.
+
+ [bits 32]
+ [global _call_list]
+ [extern length]
+ [extern elt]
+ ;;; This function should call it's first argument with the arguments from
+ ;;; the cons-list passed as its second argument.
+
+ ;;; _call_list(function pointer, cons list)
+_call_list:
+ push ebp
+ mov ebp, esp
+
+ mov edi, [ebp + 12] ; Cons list
+
+ push edi
+ call length ; Length of cons list in eax
+ add esp, 4
+
+ mov ecx, eax ; Store length in counter
+
+ ;; Reserve space for all the stack items
+ shl eax, 2
+ sub esp, eax
+
+ mov esi, esp ; Pointer to top of stack
+
+ ;; Skip all of this if there are no arguments
+ cmp ecx, 0
+ je .done
+
+.loop:
+ ;; Get the previous item. At the start ecx = the length so to get the last
+ ;; index we need to subtract 1
+ dec ecx
+
+ push ecx
+ push edi
+ call elt
+ add esp, 4
+ pop ecx ; This is a scratch register, remember
+
+ ;; We now have the ecx-th item in eax
+ ;; Remember esi is the top of the stack area reserved, so
+ mov [esi + 4 * ecx], eax
+
+ jcxz .done
+ jmp .loop
+
+.done:
+ mov ebx, [ebp + 8] ; Function pointer
+ call ebx
+
+ mov esp, ebp
+ pop ebp
+ ret
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index 32e2713..ec14078 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -95,8 +95,13 @@
value_t form = car(val);
value_t args = cdr(val);
- if (symstreq(form, "defun"))
+ if (symstreq(form, "defun") || symstreq(form, "defmacro"))
{
+ enum namespace namespace = NS_FUNCTION;
+
+ if (symstreq(form, "defmacro"))
+ namespace = NS_MACRO;
+
dasm_State *d;
dasm_State **Dst = &d;
@@ -162,7 +167,7 @@
| cleanup;
add_function(env, (char *)(name ^ SYMBOL_TAG), link(Dst),
- length(arglist));
+ length(arglist), namespace);
dasm_free(&d);
free(local.stack_slots);
@@ -375,16 +380,28 @@
if (nargs != func->nargs)
err("wrong number of args");
- for (int i = length(args) - 1; i >= 0; i--)
+ if (func->namespace == NS_FUNCTION)
{
- compile_expression(env, local, elt(args, i), Dst);
- | push eax;
- }
+ for (int i = length(args) - 1; i >= 0; i--)
+ {
+ compile_expression(env, local, elt(args, i), Dst);
+ | push eax;
+ }
- | mov ebx, (func->code_addr);
- | call ebx;
- | add esp, (nargs * value_size);
- // result in eax
+ | mov ebx, (func->code_addr);
+ | call ebx;
+ | add esp, (nargs * value_size);
+ // result in eax
+ }
+ else if (func->namespace == NS_MACRO)
+ {
+ value_t expanded_to = call_list(func, args);
+
+ printf("Macro expanded to:\n");
+ printval(expanded_to, 2);
+
+ compile_expression(env, local, expanded_to, Dst);
+ }
}
}
else if (symbolp(val))
@@ -422,7 +439,7 @@
| cleanup;
- add_function(env, name, link(Dst), 0);
+ add_function(env, name, link(Dst), 0, NS_FUNCTION);
}
struct variable *add_variable(struct local *local, enum var_type type,
@@ -458,3 +475,10 @@
return v;
}
+
+extern value_t _call_list(void *addr, value_t list);
+
+value_t call_list(struct function *func, value_t list)
+{
+ return _call_list(func->code_ptr, list);
+}
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index 1cbd92d..ddf7ea0 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -5,12 +5,20 @@
#include <stdbool.h>
#include <stdint.h>
+enum namespace
+{
+ NS_FUNCTION,
+ NS_MACRO,
+};
+
struct function
{
char *name;
int nargs; // number of arguments
+ enum namespace namespace;
- union {
+ union
+ {
value_t (*def0)();
value_t (*def1)(value_t);
value_t (*def2)(value_t, value_t);
@@ -82,3 +90,8 @@
// Might return null
struct variable *find_variable(struct local *local, char *name);
void destroy_local(struct local *local);
+
+/**
+ * Like `apply` in lisp, calls func with list args and returns the result.
+ */
+value_t call_list(struct function *func, value_t list);
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index 03e17fc..485bf49 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -39,7 +39,7 @@
return nil;
}
-void add_function(struct environment *env, char *name, void *func, int nargs)
+void add_function(struct environment *env, char *name, void *func, int nargs, enum namespace ns)
{
struct function *last, *new = malloc(sizeof(struct function));
@@ -48,20 +48,21 @@
new->name = name;
new->nargs = nargs;
new->code_ptr = func;
+ new->namespace = ns;
env->first = new;
}
void load_std(struct environment *env)
{
- add_function(env, "+", l_plus, 2);
- add_function(env, "-", l_minus, 2);
- add_function(env, "*", l_times, 2);
- add_function(env, "/", l_divide, 2);
+ add_function(env, "+", l_plus, 2, NS_FUNCTION);
+ add_function(env, "-", l_minus, 2, NS_FUNCTION);
+ add_function(env, "*", l_times, 2, NS_FUNCTION);
+ add_function(env, "/", l_divide, 2, NS_FUNCTION);
- add_function(env, "car", car, 1);
- add_function(env, "cdr", cdr, 1);
- add_function(env, "cons", cons, 2);
+ add_function(env, "car", car, 1, NS_FUNCTION);
+ add_function(env, "cdr", cdr, 1, NS_FUNCTION);
+ add_function(env, "cons", cons, 2, NS_FUNCTION);
- add_function(env, "print", l_printval, 1);
+ add_function(env, "print", l_printval, 1, NS_FUNCTION);
}
diff --git a/src/lisp/lib/std.h b/src/lisp/lib/std.h
index 000129e..5162bab 100644
--- a/src/lisp/lib/std.h
+++ b/src/lisp/lib/std.h
@@ -5,5 +5,5 @@
value_t l_plus(value_t a, value_t b);
-void add_function(struct environment *env, char *name, void *func, int nargs);
+void add_function(struct environment *env, char *name, void *func, int nargs, enum namespace ns);
void load_std(struct environment *env);
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index 30b2861..0d305f2 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -34,6 +34,8 @@
c->car = car;
c->cdr = cdr;
+ c->line = 0;
+ c->name = NULL;
item->alloc.type_tag = CONS_TAG;
item->alloc.pool = current_pool;
@@ -344,6 +346,17 @@
return false;
}
+void set_cons_info(value_t cons, int line, char *name)
+{
+ if (!consp(cons))
+ return;
+
+ struct cons *ca = (void *)(cons ^ CONS_TAG);
+
+ ca->line = line;
+ ca->name = name;
+}
+
value_t readn(struct istream *is)
{
value_t first = nil;
@@ -353,7 +366,13 @@
while (read1(is, &read_val))
{
+ int line;
+ char *file;
+
+ is->getpos(is, &line, &file);
*last = cons(read_val, nil);
+ set_cons_info(*last, line, file);
+
last = cdrref(*last);
}
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index 56fa09f..eb9e5f6 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -23,11 +23,20 @@
struct cons;
+/// Represents a Lisp value
typedef unsigned int value_t;
struct cons
{
value_t car, cdr;
+
+ /// Line of the input file from where this was parsed, 0 if it was created
+ /// in Lisp.
+ int line;
+
+ /// Description of where the cons was parsed from, or NULL if generated in
+ /// code.
+ char *name;
};
/// Default pool (no pool)
diff --git a/src/lisp/test-macros.lisp b/src/lisp/test-macros.lisp
new file mode 100644
index 0000000..a075a9b
--- /dev/null
+++ b/src/lisp/test-macros.lisp
@@ -0,0 +1,6 @@
+(defmacro weird-const (a b)
+ a)
+
+(defun main ()
+ (let1 (var "this is var")
+ (print (weird-const var 13))))
diff --git a/src/lisp/test.lisp b/src/lisp/test.lisp
index ea78d4f..45c8be4 100644
--- a/src/lisp/test.lisp
+++ b/src/lisp/test.lisp
@@ -5,10 +5,17 @@
(print whatever)
(gc))
+(defmacro weird-identity (a)
+ a)
+
+(defmacro weird-const (a b)
+ a)
+
(defun main ()
(let1 (a (add-two 3))
(print "a is")
- (print a))
+ (print (weird-identity a))
+ (print (weird-const a 4)))
; These allocations should be freed
(list 12 34 56)