~swisschili/bluejay

53e7cd1bb7ab772d4e921444bc9788926fba50e4 — swissChili 9 months ago 9d87678
Fix segfault in Lisp when calling variadic function.

Originally a segfault could occur due to an issue with how arguments
were cleaned up after a variadic function call. After the function
call the following assembly was generated:

add esp, nargs

Where nargs was the number of arguments passed to the function. This
did not take in to account that for variadic functions, the last
several arguments are CONS'd into one argument, meaning that calling a
variadic function with <>1 variadic argument would result in a broken
stack.

Specifically this issue came up in the implementation of REDUCE, which
relied on the variadic FUNCALL.
M lib/lisp/std/list-functions.lisp => lib/lisp/std/list-functions.lisp +5 -4
@@ 29,7 29,8 @@ accept two arguments and return the result of combining those
arguments. The first argument will be the result so far and the second
will be the n-th item of the list. For the first item of the list, the
result so far will be `initial-value`, or `nil` by default."
  (if (not list)
      initial-value
      (reduce fun (cdr list)
              (funcall fun initial-value (car list)))))
  (if (nilp list)
      initial-value 
	  (reduce fun (cdr list)
			  (funcall fun initial-value
					   (car list)))))

M lib/lisp/std/std.lisp => lib/lisp/std/std.lisp +0 -2
@@ 51,8 51,6 @@ final item."
    (read-stdin)))

(defun funcall (fun & list)
  (print fun)
  (print list)
  (apply fun list))

(load "list-functions.lisp")

M src/lisp/Jmk => src/lisp/Jmk +1 -1
@@ 13,7 13,7 @@ preset(nasm)
archetype(c)
archetype(asm)

CFLAGS += -Ivendor/luajit/dynasm -Werror -lreadline
CFLAGS += -Ivendor/luajit/dynasm -Werror -lreadline # -fsanitize=address
LDFLAGS += -lreadline
ASMFLAGS += -felf -Fdwarf


M src/lisp/compiler.dasc => src/lisp/compiler.dasc +26 -24
@@ 19,7 19,7 @@
|.arch x86;

|.macro setup, nvars;
|->function_start:;
|1:;
| push ebp;
| mov ebp, esp;
| sub esp, (value_size * nvars);


@@ 32,8 32,7 @@
|.endmacro;

|.macro call_extern, address;
| mov ebx, address;
| call ebx;
| call &address;
|.endmacro;

dasm_State *d;


@@ 318,8 317,6 @@ value_t load_relative(struct environment *env, char *to, value_t name)
	if (!stringp(name))
		return nil;

	fprintf(stderr, "Called load_relative\n");

	char *new_path = (char *)(name ^ STRING_TAG);
	char *relative_to = strdup(to);
	char full_path[512];


@@ 554,8 551,7 @@ void compile_expression(struct environment *env, struct local *local,
				// push the ith item
				| push eax;
				// cons the top two stack items
				| mov ebx, (cons);
				| call ebx;
				| call_extern cons;
				// remove the stack items from use
				| add esp, (2 * value_size);
				// put the new thing on the stack


@@ 581,8 577,7 @@ void compile_expression(struct environment *env, struct local *local,
			| push (new_local.num_closure_slots);
			| push (nargs_out);
			| push (func_ptr);
			| mov ebx, (create_closure);
			| call ebx;
			| call_extern create_closure;
			| add esp, 12;

			// Walk the generated local scope for V_FREE variables, since each


@@ 601,8 596,7 @@ void compile_expression(struct environment *env, struct local *local,

					// The capture offset
					| push (var->number);
					| mov ebx, (set_closure_capture_variable);
					| call ebx;
					| call_extern set_closure_capture_variable;
					// Skip the value and index
					| add esp, 8;
					// Pop the closure back in to eax


@@ 625,8 619,7 @@ void compile_expression(struct environment *env, struct local *local,
			compile_expression(env, local, car(args), Dst);
			| push eax;
			| push (env);
			| mov ebx, (eval);
			| call ebx;
			| call_extern eval;
		}
		else if (symstreq(fsym, "load"))
		{


@@ 639,8 632,7 @@ void compile_expression(struct environment *env, struct local *local,
			| push eax;
			| push (local->current_file_path);
			| push (env);
			| mov ebx, (load_relative);
			| call ebx;
			| call_extern load_relative;
		}
		else
		{


@@ 650,6 642,10 @@ void compile_expression(struct environment *env, struct local *local,
			bool is_recursive = false;
			struct args *nargs_needed = NULL;

			// The number of arguments actually passed on the stack,
			// i.e. all varargs are 1.
			int real_nargs = nargs;

			if (local->current_function_name &&
			    symstreq(fsym, local->current_function_name))
			{


@@ 675,11 671,21 @@ void compile_expression(struct environment *env, struct local *local,
				       nargs_needed->num_required, nargs);
			}

			int total_taken = nargs_needed->num_optional +
				nargs_needed->num_required;

			if (nargs > total_taken)
			{
				real_nargs = total_taken + 1;
			}
			else
			{
				real_nargs = total_taken;
			}

			if (is_recursive || func->namespace == NS_FUNCTION)
			{
				int nargs = length(args);
				int total_taken = nargs_needed->num_optional +
					nargs_needed->num_required;

				int line = cons_line(val);
				char *file = cons_file(val);


@@ 697,8 703,7 @@ void compile_expression(struct environment *env, struct local *local,
					{
						compile_expression(env, local, elt(args, i), Dst);
						| push eax;
						| mov ebx, (cons);
						| call ebx;
						| call_extern cons;
						| add esp, 8;
						| push eax;
					}


@@ 721,14 726,14 @@ void compile_expression(struct environment *env, struct local *local,

				if (is_recursive)
				{
					| call ->function_start;
					| call <1;
				}
				else
				{
					// | mov ebx, (func->code_addr);
					| call_extern func->code_addr;
				}
				| add esp, (nargs * value_size);
				| add esp, (real_nargs * value_size);
				// result in eax
			}
			else if (func->namespace == NS_MACRO)


@@ 828,9 833,6 @@ value_t call_list_args(void *code_ptr, struct args *args, value_t list,

	int nargs = length(list);

	printf("IN call_list_args\n");
	printval(list, 2);

	value_t *val = &list;

	for (value_t i = list; !nilp(i); i = cdr(i))

M src/lisp/gc.c => src/lisp/gc.c +1 -0
@@ 124,5 124,6 @@ void free_all()
		struct alloc *next = a->next;
		free_aligned(a);
		a = next;
//		fprintf(stderr, "a = %p\n", a);
	}
}

M src/lisp/istream.c => src/lisp/istream.c +13 -2
@@ 170,6 170,7 @@ int fistream_read(struct istream *is, char *buffer, int size)
	struct fistream_private *p = is->data;

	int offset = 0;
	char *buffer_o = buffer;

	if (p->has_next)
	{


@@ 180,12 181,22 @@ int fistream_read(struct istream *is, char *buffer, int size)
		offset = 1;
	}

	return (int)fread(buffer, 1, size, p->file) + offset;
	int read = (int)fread(buffer, 1, size, p->file) + offset;

	for (int i = 0; i < read; i++)
	{
		if (buffer_o[i] == '\n')
			p->line++;
	}

	return read;
}

void fistream_showpos(struct istream *s, FILE *out)
{
	// TODO: implement
	struct fistream_private *p = s->data;

	fprintf(out, "At %s:%d\n", p->path, p->line);
}

void fistream_getpos(struct istream *is, int *line, char **name)

M src/lisp/istream.h => src/lisp/istream.h +1 -1
@@ 29,4 29,4 @@ struct istream *new_stristream_nt(char *str);
void del_stristream(struct istream *stristream);

struct istream *new_fistream(char *path, bool binary);
void del_fistream(struct istream *fistream);
\ No newline at end of file
void del_fistream(struct istream *fistream);

M src/lisp/lib/std.c => src/lisp/lib/std.c +11 -0
@@ 104,12 104,23 @@ value_t l_read_stdin()
	return val;
}

value_t l_num_eq(value_t a, value_t b)
{
	if (!integerp(a) || !integerp(b))
	{
		return nil;
	}

	return (a >> 3) == (b >> 3) ? t : nil;
}

void load_std(struct environment *env)
{
	add_c_function(env, "+", l_plus, 2);
	add_c_function(env, "-", l_minus, 2);
	add_c_function(env, "*", l_times, 2);
	add_c_function(env, "/", l_divide, 2);
	add_c_function(env, "=", l_num_eq, 2);

	add_c_function(env, "car", car, 1);
	add_c_function(env, "cdr", cdr, 1);

M src/lisp/lisp.c => src/lisp/lisp.c +12 -10
@@ 103,7 103,7 @@ start:
bool isallowedchar(char c)
{
	return (c >= '#' && c <= '\'') || (c >= '*' && c <= '/') ||
	       (c >= '>' && c <= '@');
	       (c >= '<' && c <= '@');
}

bool issymstart(char c)


@@ 125,7 125,6 @@ bool readsym(struct istream *is, value_t *val)

	int size = 8;
	struct alloc *a = malloc_aligned(size + sizeof(struct alloc));
	add_this_alloc(a, SYMBOL_TAG);

	char *s = (char *)(a + 1);



@@ 133,15 132,15 @@ bool readsym(struct istream *is, value_t *val)

	for (int i = 1;; i++)
	{
		if (issym(is->peek(is)))
		if (i >= size)
		{
			if (i >= size)
			{
				size *= 2;
				a = realloc_aligned(a, size + sizeof(struct alloc));
				s = (char *)(a + 1);
			}
			size *= 2;
			a = realloc_aligned(a, size + sizeof(struct alloc));
			s = (char *)(a + 1);
		}

		if (issym(is->peek(is)))
		{
			s[i] = is->get(is);
		}
		else


@@ 150,6 149,7 @@ bool readsym(struct istream *is, value_t *val)
			*val = (value_t)s;
			*val |= SYMBOL_TAG;

			add_this_alloc(a, SYMBOL_TAG);
			return true;
		}
	}


@@ 166,7 166,6 @@ bool readstr(struct istream *is, value_t *val)
	int size = 8;

	struct alloc *a = malloc_aligned(size + sizeof(struct alloc));
	add_this_alloc(a, STRING_TAG);

	char *s = (char *)(a + 1);



@@ 209,6 208,7 @@ bool readstr(struct istream *is, value_t *val)
			*val = (value_t)s;
			*val |= STRING_TAG;

			add_this_alloc(a, STRING_TAG);
			return true;
		}
	}


@@ 276,6 276,8 @@ bool readlist(struct istream *is, value_t *val)

	*val = readn(is);

	skipws(is);

	if (is->peek(is) != ')')
	{
		is->showpos(is, stderr);

M src/lisp/main.c => src/lisp/main.c +9 -2
@@ 22,8 22,15 @@ int main(int argc, char **argv)

	value_t (*lisp_main)() = find_function(env, "main")->def0;

	gc_set_base_here();
	lisp_main();
	if (lisp_main)
	{
		gc_set_base_here();
		lisp_main();
	}
	else
	{
		fprintf(stderr, "No MAIN function defined! nothing to do\n");
	}

	free_all();
	del_env(env);

M src/lisp/test-closures.lisp => src/lisp/test-closures.lisp +3 -4
@@ 1,5 1,4 @@
(defun main ()
  (print (reduce (lambda (a b)
                   (+ a b))
                 (list 1 2 3 4 5)
                 0)))
  (print (reduce #'+
				 (list 1 2 3 4)
				 0)))