~swisschili/bluejay

fa496ccc893eb5cbc4a07825cc1b6694503e461e — swissChili 3 months ago 84aabed gc-segments
Fix bug in _do_gc with broken segmentation, update C functions to declare segments

Note: currently the GC is still broken:
- _mark does not work at all
- _sweep does not work on successive (gc) calls, suggesting that the allocation list is left in a broken state
M src/lisp/call_list.s => src/lisp/call_list.s +4 -2
@@ 4,6 4,7 @@
	[global _call_list]
	[extern length]
	[extern elt]
	[extern gc_resume]
	;;; This function should call it's first argument with the arguments from
	;;; the cons-list passed as its second argument.



@@ 53,9 54,10 @@ _call_list:
	jmp .loop

.done:
	mov ebx, [ebp + 16]						; Function pointer
	call gc_resume
	mov esi, [ebp + 16]						; Function pointer
	mov edi, [ebp + 24]						; Closure data pointer
	call ebx
	call esi 

	mov esp, ebp
	pop ebp

M src/lisp/compiler.dasc => src/lisp/compiler.dasc +30 -6
@@ 42,8 42,8 @@ unsigned int npc = 8;
| mov eax, esp;
| push ebp;
| push eax;
| mov eax, _do_gc;
| call eax;
| call_extern _do_gc;
| shl eax, 2; // to value_t
|.endmacro;

struct function *find_function(struct environment *env, char *name)


@@ 353,6 353,15 @@ struct error walk_and_alloc(struct environment *env, struct local *local, value_
	OKAY();
}

struct error read1_in_pool(struct istream *is, value_t *val, unsigned char pool)
{
	unsigned char pop = push_pool(pool);
	struct error res = read1(is, val);
	pop_pool(pop);

	return res;
}

bool load(struct environment *env, char *path)
{
	if (!file_exists(path))


@@ 361,7 370,6 @@ bool load(struct environment *env, char *path)
	add_load(env, path);

	unsigned char pool = make_pool();
	unsigned char pop = push_pool(pool);

	struct istream *is = new_fistream(path, false);
	if (!is)


@@ 371,7 379,7 @@ bool load(struct environment *env, char *path)

	struct error compile_error, read_error;

	while (IS_OKAY((read_error = read1(is, &val))))
	while (IS_OKAY((read_error = read1_in_pool(is, &val, pool))))
	{
		if (!IS_OKAY((compile_error = compile_tl(val, env, path))))
		{


@@ 386,7 394,6 @@ bool load(struct environment *env, char *path)
	}

	del_fistream(is);
	pop_pool(pop);

	return true;



@@ 399,6 406,8 @@ failure:

value_t load_relative(struct environment *env, char *to, value_t name)
{
	gc_skip(&name, name, nil);

	if (!stringp(name))
		return nil;



@@ 409,9 418,15 @@ value_t load_relative(struct environment *env, char *to, value_t name)
	snprintf(full_path, 512, "%s/%s", dirname(relative_to), new_path);

	if (load(env, full_path))
	{
		gc_endskip();
		return t;
	}
	else
	{
		gc_endskip();
		return nil;
	}
}

struct error compile_file(char *filename, struct environment **e)


@@ 521,6 536,7 @@ struct error compile_backquote(struct environment *env, struct local *local,

value_t eval(struct environment *env, value_t form)
{
	gc_skip(&form, form, nil);
	// Eval!
	value_t function = cons(nil, cons(form, nil));



@@ 534,13 550,19 @@ value_t eval(struct environment *env, value_t form)
										 &args, NULL, "/", &d))))
	{
		ereport(err);
		gc_endskip();
		return nil;
	}

	del_local(&local);

	value_t (*f)() = link_program(&d);
	return f();

	gc_resume();
	value_t res = f();

	gc_endskip();
	return res;
}

struct error compile_variable(struct variable *v, dasm_State *Dst)


@@ 968,7 990,9 @@ struct error compile_expression(struct environment *env, struct local *local,

				pop_pool(pool);

				gc_pushmark(expanded_to);
				TRY(compile_expression(env, local, expanded_to, false, Dst));
				gc_popmark();
			}
		}
	}

M src/lisp/gc.c => src/lisp/gc.c +29 -7
@@ 33,13 33,14 @@ void _mark(value_t value, unsigned int *marked)

			alloc->mark = gc_mark;

			// printf("[ GC ] val =");
			// printval(alloc_to_value(alloc), 2);
			printf("[ GC ] val =");
			printval(alloc_to_value(alloc), 2);

			switch (alloc->type_tag)
			{
			case CONS_TAG: {
				struct cons_alloc *cons = (struct cons_alloc *)alloc;

				_mark(cons->cons.car, marked);
				_mark(cons->cons.cdr, marked);
				break;


@@ 65,8 66,10 @@ value_t alloc_to_value(struct alloc *a)
	return (unsigned int)val | a->type_tag;
}

void _sweep()
unsigned int _sweep()
{
	unsigned int swept = 0;

	for (struct alloc *a = first_a; a;)
	{
		if (pool_alive(a->pool) || a->mark == gc_mark)


@@ 76,9 79,14 @@ void _sweep()
		}
		else
		{
			fprintf(stderr, "_sweeping:\n");
			printval(alloc_to_value(a), 2);

			// Free and remove from allocation list
			struct alloc *p = a->prev, *n = a->next;

			free_aligned(a);
			swept++;

			a = n;



@@ 89,9 97,13 @@ void _sweep()
				n->prev = p;
		}
	}

	fprintf(stderr, "current pool = %d, swept %d\n", current_pool, swept);

	return swept;
}

void _do_gc(unsigned int esp, unsigned int ebp)
unsigned int _do_gc(unsigned int esp, unsigned int ebp)
{
	value_t *esp_p = (value_t *)esp,
		*ebp_p = (value_t *)ebp;


@@ 100,12 112,12 @@ void _do_gc(unsigned int esp, unsigned int ebp)

	gc_mark++;

	for (int i = gc_current_segment; i <= 0; i--)
	for (int i = gc_current_segment; i >= 0; i--)
	{
		value_t *base = gc_segments[i].top;

		// For every stack frame until the base of the stack
		while (esp_p < base)
		while (esp_p && esp_p < base)
		{
			// Walk up the stack until we reach either the frame pointer or the base
			// of the stack. Basically walk to the top of this function's stack


@@ 132,7 144,7 @@ void _do_gc(unsigned int esp, unsigned int ebp)
		esp_p = gc_segments[i].bottom;
	}

	_sweep();
	return _sweep();
}

void free_all()


@@ 185,3 197,13 @@ void gc_endskip()
{
	gc_current_segment--;
}

void gc_pushmark(value_t val)
{
	gc_segments[gc_current_segment].mark[gc_segments[gc_current_segment].num_marked++] = val;
}

void gc_popmark()
{
	gc_segments[gc_current_segment].num_marked--;
}

M src/lisp/gc.h => src/lisp/gc.h +4 -2
@@ 22,9 22,9 @@ extern int gc_current_segment;
void gc_set_base_here();

value_t alloc_to_value(struct alloc *a);
void _do_gc(unsigned int esp, unsigned int ebp);
unsigned int _do_gc(unsigned int esp, unsigned int ebp);
void _mark(value_t value, unsigned int *marked);
void _sweep();
unsigned int _sweep();
void free_all();

// varargs should be a series of value_t's, followed by nil. Call this


@@ 35,3 35,5 @@ void gc_resume();
/// @param n Number of non-GC arguments passed to function
void gc_resumen(int n);
void gc_endskip();
void gc_pushmark(value_t val);
void gc_popmark();

M src/lisp/lib/std.c => src/lisp/lib/std.c +13 -3
@@ 1,4 1,5 @@
#include "std.h"
#include "../gc.h"
#include "../plat/plat.h"
#include <stdlib.h>
#include <string.h>


@@ 43,13 44,19 @@ value_t l_printval(value_t val)

value_t l_apply(value_t func, value_t args)
{
	gc_skip(&args, args, nil);

	if (!closurep(func))
		return nil;

	if (!listp(args))
		return nil;

	return call_list_closure((struct closure *)(func ^ CLOSURE_TAG), args);
	gc_resumen(2);
	value_t res = call_list_closure((struct closure *)(func ^ CLOSURE_TAG), args);

	gc_endskip();
	return res;
}

value_t l_nilp(value_t val)


@@ 166,9 173,12 @@ struct error load_std(struct environment *env)
	
	add_c_function(env, "elt", l_elt, 2);

	if (!load_library(env, "std"))
	if (!getenv("LISP_NO_STD"))
	{
		THROW(ENOTFOUND, "Could not load library `std`, make sure your $LISP_LIBRARY_PATH is correct.");
		if (!load_library(env, "std"))
		{
			THROW(ENOTFOUND, "Could not load library `std`, make sure your $LISP_LIBRARY_PATH is correct.");
		}
	}

	OKAY();

M src/lisp/lisp.c => src/lisp/lisp.c +4 -0
@@ 218,6 218,10 @@ void printval(value_t v, int depth)
	}
	else if (consp(v))
	{
		struct alloc *a = (struct alloc *)(v ^ CONS_TAG) - 1;

		printf("pool=%d ", a->pool);

		if (listp(v))
		{
			printf("list:\n");

A src/lisp/test-gc.lisp => src/lisp/test-gc.lisp +6 -0
@@ 0,0 1,6 @@
(defun main ()
  (let1 (val (cons 123 456))
        (cons 'a 'b)
        (gc)
        (cons 'c 'd)
        (gc)))