src/lisp/compiler.dasc

/* -*- mode:c -*- */

#include "compiler.h"
#include "plat/plat.h"
#include "lib/std.h"

#include <dasm_proto.h>
#include <dasm_x86.h>

#define value_size sizeof (value_t)

|.arch x86;

|.macro setup, nvars;
| push ebp;
| mov ebp, esp;
| sub esp, (value_size * nvars);
|.endmacro;

|.macro cleanup;
| mov esp, ebp;
| pop ebp;
| ret;
|.endmacro;

dasm_State *d;
unsigned int npc = 8;

struct function *find_function (struct environment *env, char *name)
{
	struct function *f = env->first;

	while ( strcmp (f->name, name) != 0 )
	{
		if ( f->prev )
			f = f->prev;
		else
			return NULL;
	}

	return f;
}

void compile_tl (value_t val, struct environment *env)
{
	if ( !listp (val) )
		err ("Top level must be a list");
	
	value_t form = car (val);
	value_t args = cdr (val);

	if ( symstreq (form, "defun") )
	{
		dasm_State *d;
		dasm_State **Dst = &d;

		|.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);

		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;
	load_std (&env);
	
	while ( read1 (is, &val) )
	{
		compile_tl (val, &env);
	}

	return env;
}

void compile_expression (struct environment *env, struct local *local,
                         value_t val, dasm_State **Dst)
{
	if ( integerp (val) || stringp (val) || symbolp (val) )
	{
		| mov eax, val;
	}
	else if ( listp (val) )
	{
		value_t fsym = car (val);

		if ( !symbolp (fsym) )
		{
			err ("function name must be a symbol");
		}

		struct function *func = find_function (env, (char *) (fsym ^ SYMBOL_TAG));
		value_t args = cdr (val);
		int nargs = length (args);

		if ( nargs != func->nargs )
			err ("wrong number of args");

		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 * 4);
		// result in eax
	}
}

void compile_expr_to_func (struct environment *env, char *name, value_t val,
                           dasm_State **Dst)
{
	| setup 0;

	struct local local;
	compile_expression (env, &local, val, Dst);
	
	| cleanup;

	add_function (env, name, link (Dst), 0);
}