blob: 7e71c5133d2f1399423d108d7bcc8492d7cbee30 [file] [log] [blame]
swissChili8cfb7c42021-04-18 21:17:58 -07001/* -*- mode:c -*- */
2
swissChilica107a02021-04-14 12:07:30 -07003#include "compiler.h"
swissChiliddc97542021-07-04 11:47:42 -07004#include "gc.h"
swissChili7e1393c2021-07-07 12:59:12 -07005#include "lib/std.h"
6#include "lisp.h"
7#include "plat/plat.h"
swissChilica107a02021-04-14 12:07:30 -07008
9#include <dasm_proto.h>
10#include <dasm_x86.h>
11
swissChili7e1393c2021-07-07 12:59:12 -070012#include <libgen.h>
13#include <stdio.h>
swissChili923b5362021-05-09 20:31:43 -070014#include <stdlib.h>
15#include <string.h>
16
swissChili53472e82021-05-08 16:06:32 -070017#define value_size sizeof(value_t)
swissChilica107a02021-04-14 12:07:30 -070018
19|.arch x86;
20
21|.macro setup, nvars;
swissChili53e7cd12021-08-02 21:55:53 -070022|1:;
swissChili484295d2021-07-09 21:25:55 -070023| push ebp;
swissChilica107a02021-04-14 12:07:30 -070024| mov ebp, esp;
swissChili8cfb7c42021-04-18 21:17:58 -070025| sub esp, (value_size * nvars);
swissChilica107a02021-04-14 12:07:30 -070026|.endmacro;
27
28|.macro cleanup;
29| mov esp, ebp;
30| pop ebp;
31| ret;
32|.endmacro;
33
swissChili484295d2021-07-09 21:25:55 -070034|.macro call_extern, address;
swissChili53e7cd12021-08-02 21:55:53 -070035| call &address;
swissChili67bdf282021-06-06 18:46:08 -070036|.endmacro;
37
swissChilica107a02021-04-14 12:07:30 -070038dasm_State *d;
39unsigned int npc = 8;
40
swissChili9e57da42021-06-15 22:22:46 -070041|.macro run_gc;
swissChilie9fec8b2021-06-22 13:59:33 -070042| mov eax, esp;
swissChili9e57da42021-06-15 22:22:46 -070043| push ebp;
swissChilie9fec8b2021-06-22 13:59:33 -070044| push eax;
swissChili9e57da42021-06-15 22:22:46 -070045| mov eax, _do_gc;
46| call eax;
47|.endmacro;
swissChili6d6525e2021-06-15 21:20:53 -070048
swissChili53472e82021-05-08 16:06:32 -070049struct function *find_function(struct environment *env, char *name)
swissChilica107a02021-04-14 12:07:30 -070050{
swissChilif68671f2021-07-05 14:14:44 -070051 struct function *f;
swissChilica107a02021-04-14 12:07:30 -070052
swissChilif68671f2021-07-05 14:14:44 -070053 for (f = env->first; f && strcmp(f->name, name); f = f->prev)
swissChilica107a02021-04-14 12:07:30 -070054 {
swissChilica107a02021-04-14 12:07:30 -070055 }
56
57 return f;
58}
59
swissChili67bdf282021-06-06 18:46:08 -070060unsigned int local_alloc(struct local *local)
61{
62 for (int i = 0; i < local->num_stack_slots; i++)
63 {
64 if (local->stack_slots[i] == false)
65 {
66 local->stack_slots[i] = true;
67
68 if (i >= local->num_stack_entries)
69 local->num_stack_entries++;
70
71 return i;
72 }
73 }
74
75 int old_size = local->num_stack_slots;
76 local->num_stack_slots += 4;
swissChili7e1393c2021-07-07 12:59:12 -070077 local->stack_slots =
78 realloc(local->stack_slots, local->num_stack_slots * sizeof(bool));
swissChili67bdf282021-06-06 18:46:08 -070079 // unreadable: set the remaining slots to unused
80 memset(local->stack_slots + old_size, 0, local->num_stack_slots - old_size);
81 local->stack_slots[old_size] = true;
82
83 return old_size;
84}
85
86void local_free(struct local *local, unsigned int slot)
87{
88 local->stack_slots[slot] = false;
89}
90
swissChili708d4c42021-07-04 17:40:07 -070091void del_local(struct local *local)
92{
93 free(local->stack_slots);
94
95 for (struct variable *next, *f = local->first; f; f = next)
96 {
97 next = f->prev;
98 free(f);
99 }
100}
101
102void del_env(struct environment *env)
103{
104 for (struct function *next, *f = env->first; f; f = next)
105 {
106 next = f->prev;
107 // We're not gonna bother munmap()ing the function
108 free(f);
109 }
swissChilif68671f2021-07-05 14:14:44 -0700110
111 for (struct loaded_file *next, *l = env->first_loaded; l; l = next)
112 {
113 next = l->previous;
114 free(l->resolved_path);
115 free(l);
116 }
swissChili7e1393c2021-07-07 12:59:12 -0700117
118 free(env);
swissChilif68671f2021-07-05 14:14:44 -0700119}
120
121void add_load(struct environment *env, char *path)
122{
123 static char buffer[512];
124 long size = readlink(path, buffer, 512);
125 buffer[size] = '\0';
126 char *resolved = strdup(buffer);
127
128 struct loaded_file *f = malloc(sizeof(struct loaded_file));
129 f->resolved_path = resolved;
130 f->previous = env->first_loaded;
131 env->first_loaded = f;
swissChili708d4c42021-07-04 17:40:07 -0700132}
133
swissChilif1ba8c12021-07-02 18:45:38 -0700134struct dasm_State *compile_function(value_t args, enum namespace namespace,
swissChili7e1393c2021-07-07 12:59:12 -0700135 struct environment *env,
136 struct local *local_out,
137 struct local *local_parent,
138 struct args **args_out, char *name,
139 char *path)
swissChilif1ba8c12021-07-02 18:45:38 -0700140{
141 dasm_State *d;
142 dasm_State **Dst = &d;
143
swissChili484295d2021-07-09 21:25:55 -0700144 |.section code, imports;
swissChilif1ba8c12021-07-02 18:45:38 -0700145 dasm_init(&d, DASM_MAXSECTION);
146
147 |.globals lbl_;
148 void *labels[lbl__MAX];
149 dasm_setupglobal(&d, labels, lbl__MAX);
150
151 |.actionlist lisp_actions;
152 dasm_setup(&d, lisp_actions);
153
154 struct local local;
155 local.parent = NULL;
156 local.first = NULL;
157 local.num_vars = 0;
158 local.npc = 8;
159 local.nextpc = 0;
160 local.stack_slots = malloc(sizeof(bool) * 4);
161 memset(local.stack_slots, 0, sizeof(bool) * 4);
162 local.num_stack_slots = 4;
163 local.num_stack_entries = 0;
swissChiliddc97542021-07-04 11:47:42 -0700164 local.num_closure_slots = 0;
165 local.parent = local_parent;
swissChili74348422021-07-04 13:23:24 -0700166 local.current_function_name = name;
swissChili7e1393c2021-07-07 12:59:12 -0700167 local.current_file_path = path;
swissChilif1ba8c12021-07-02 18:45:38 -0700168
169 dasm_growpc(&d, local.npc);
170
swissChilif1ba8c12021-07-02 18:45:38 -0700171 value_t arglist = car(args);
172 value_t body = cdr(args);
173
swissChili15f1cae2021-07-05 19:08:47 -0700174 // This will add the arguments to local too.
175 struct args *ar = list_to_args(env, arglist, &local);
176 local.args = ar;
swissChili74348422021-07-04 13:23:24 -0700177
swissChili15f1cae2021-07-05 19:08:47 -0700178 if (!ar)
swissChilif1ba8c12021-07-02 18:45:38 -0700179 {
swissChili15f1cae2021-07-05 19:08:47 -0700180 err("Malformed args list");
swissChilif1ba8c12021-07-02 18:45:38 -0700181 }
182
183 for (value_t body_ = body; !nilp(body_); body_ = cdr(body_))
184 {
185 walk_and_alloc(&local, car(body_));
186 }
187
swissChili484295d2021-07-09 21:25:55 -0700188 | setup (local.num_stack_entries);
swissChilif1ba8c12021-07-02 18:45:38 -0700189
190 memset(local.stack_slots, 0, local.num_stack_slots * sizeof(bool));
191 local.num_stack_entries = 0;
192
193 for (; !nilp(body); body = cdr(body))
194 {
swissChilib51552c2021-08-03 10:23:37 -0700195 bool tail = nilp(cdr(body));
196 compile_expression(env, &local, car(body), tail, Dst);
swissChilif1ba8c12021-07-02 18:45:38 -0700197 }
198
199 | cleanup;
200
201 if (local_out)
202 *local_out = local;
203
swissChili15f1cae2021-07-05 19:08:47 -0700204 if (args_out)
205 *args_out = ar;
swissChilif1ba8c12021-07-02 18:45:38 -0700206
207 return d;
208}
209
swissChili7e1393c2021-07-07 12:59:12 -0700210void compile_tl(value_t val, struct environment *env, char *fname)
swissChilica107a02021-04-14 12:07:30 -0700211{
swissChili53472e82021-05-08 16:06:32 -0700212 if (!listp(val))
213 err("Top level must be a list");
swissChilica107a02021-04-14 12:07:30 -0700214
swissChili53472e82021-05-08 16:06:32 -0700215 value_t form = car(val);
216 value_t args = cdr(val);
217
swissChili2999dd12021-07-02 14:19:53 -0700218 if (symstreq(form, "defun") || symstreq(form, "defmacro"))
swissChili8fc5e2f2021-04-22 13:45:10 -0700219 {
swissChili2999dd12021-07-02 14:19:53 -0700220 enum namespace namespace = NS_FUNCTION;
221
222 if (symstreq(form, "defmacro"))
swissChilia89ee442021-08-04 20:54:51 -0700223 namespace = NS_MACRO;
swissChili2999dd12021-07-02 14:19:53 -0700224
swissChili8fc5e2f2021-04-22 13:45:10 -0700225 struct local local;
swissChili15f1cae2021-07-05 19:08:47 -0700226 struct args *a;
swissChili74348422021-07-04 13:23:24 -0700227 char *name = (char *)(car(args) ^ SYMBOL_TAG);
swissChilif68671f2021-07-05 14:14:44 -0700228
swissChili7e1393c2021-07-07 12:59:12 -0700229 dasm_State *d = compile_function(cdr(args), namespace, env, &local,
230 NULL, &a, name, fname);
swissChilia820dea2021-05-09 16:46:55 -0700231
swissChili7e1393c2021-07-07 12:59:12 -0700232 add_function(env, name, link_program(&d), a, namespace);
swissChili8fc5e2f2021-04-22 13:45:10 -0700233
swissChili53472e82021-05-08 16:06:32 -0700234 dasm_free(&d);
swissChili708d4c42021-07-04 17:40:07 -0700235 del_local(&local);
swissChili67bdf282021-06-06 18:46:08 -0700236 }
swissChilif68671f2021-07-05 14:14:44 -0700237 else if (symstreq(form, "progn"))
238 {
239 for (value_t val = args; !nilp(val); val = cdr(val))
240 {
swissChili7e1393c2021-07-07 12:59:12 -0700241 compile_tl(car(val), env, fname);
swissChilif68671f2021-07-05 14:14:44 -0700242 }
243 }
swissChili484295d2021-07-09 21:25:55 -0700244 else if (symstreq(form, "load"))
245 {
246 if (length(args) != 1)
247 {
248 err_at(val, "load expects exactly 1 argument, %d given",
249 length(args));
250 }
251 load_relative(env, fname, car(args));
252 }
swissChili67bdf282021-06-06 18:46:08 -0700253}
254
255void walk_and_alloc(struct local *local, value_t body)
256{
swissChilib51552c2021-08-03 10:23:37 -0700257 // TODO: handle macros
swissChili67bdf282021-06-06 18:46:08 -0700258 if (!listp(body))
259 return;
260
261 value_t args = cdr(body);
262
263 if (symstreq(car(body), "let1"))
264 {
265 int slot = local_alloc(local);
266
267 value_t expr = cdr(args);
swissChilif1ba8c12021-07-02 18:45:38 -0700268 for (; !nilp(expr); expr = cdr(expr))
269 {
swissChiliddc97542021-07-04 11:47:42 -0700270 walk_and_alloc(local, car(expr));
swissChilif1ba8c12021-07-02 18:45:38 -0700271 }
swissChili67bdf282021-06-06 18:46:08 -0700272
273 local_free(local, slot);
274 }
swissChilif1ba8c12021-07-02 18:45:38 -0700275 else if (symstreq(car(body), "lambda"))
276 {
277 // We don't want to walk the lambda because it's another function. When
278 // the lambda is compiled it will be walked.
279 return;
280 }
swissChili67bdf282021-06-06 18:46:08 -0700281 else
282 {
283 for (; !nilp(args); args = cdr(args))
284 {
285 walk_and_alloc(local, car(args));
286 }
swissChili8fc5e2f2021-04-22 13:45:10 -0700287 }
288}
289
swissChilif68671f2021-07-05 14:14:44 -0700290bool load(struct environment *env, char *path)
swissChili8fc5e2f2021-04-22 13:45:10 -0700291{
swissChilif68671f2021-07-05 14:14:44 -0700292 if (!file_exists(path))
293 return false;
294
295 add_load(env, path);
296
swissChilib8fd4712021-06-23 15:32:04 -0700297 unsigned char pool = make_pool();
298 unsigned char pop = push_pool(pool);
299
swissChilif68671f2021-07-05 14:14:44 -0700300 struct istream *is = new_fistream(path, false);
301 if (!is)
302 return false;
303
swissChili8fc5e2f2021-04-22 13:45:10 -0700304 value_t val;
swissChili53472e82021-05-08 16:06:32 -0700305
306 while (read1(is, &val))
swissChili8fc5e2f2021-04-22 13:45:10 -0700307 {
swissChili7e1393c2021-07-07 12:59:12 -0700308 compile_tl(val, env, path);
swissChili8fc5e2f2021-04-22 13:45:10 -0700309 }
swissChilif3e7f182021-04-20 13:57:22 -0700310
swissChilif68671f2021-07-05 14:14:44 -0700311 del_fistream(is);
swissChilib8fd4712021-06-23 15:32:04 -0700312 pop_pool(pop);
313
swissChilif68671f2021-07-05 14:14:44 -0700314 return true;
315}
316
swissChili7e1393c2021-07-07 12:59:12 -0700317value_t load_relative(struct environment *env, char *to, value_t name)
318{
319 if (!stringp(name))
320 return nil;
321
322 char *new_path = (char *)(name ^ STRING_TAG);
323 char *relative_to = strdup(to);
324 char full_path[512];
325
326 snprintf(full_path, 512, "%s/%s", dirname(relative_to), new_path);
327
328 if (load(env, full_path))
329 return t;
330 else
331 return nil;
332}
333
334struct environment *compile_file(char *filename, bool *ok)
swissChilif68671f2021-07-05 14:14:44 -0700335{
336 value_t val;
swissChili7e1393c2021-07-07 12:59:12 -0700337 struct environment *env = malloc(sizeof(struct environment));
338 env->first = NULL;
339 env->first_loaded = NULL;
swissChilif68671f2021-07-05 14:14:44 -0700340
swissChili7e1393c2021-07-07 12:59:12 -0700341 add_load(env, filename);
342 load_std(env);
swissChilif68671f2021-07-05 14:14:44 -0700343
swissChili7e1393c2021-07-07 12:59:12 -0700344 bool ok_ = load(env, filename);
swissChilif68671f2021-07-05 14:14:44 -0700345
346 if (ok)
347 *ok = ok_;
348
swissChili8fc5e2f2021-04-22 13:45:10 -0700349 return env;
swissChilica107a02021-04-14 12:07:30 -0700350}
swissChilib3ca4fb2021-04-20 10:33:00 -0700351
swissChili53472e82021-05-08 16:06:32 -0700352int nextpc(struct local *local, dasm_State **Dst)
swissChilib3ca4fb2021-04-20 10:33:00 -0700353{
swissChili53472e82021-05-08 16:06:32 -0700354 int n = local->nextpc++;
355 if (n > local->npc)
356 {
357 local->npc += 16;
358 dasm_growpc(Dst, local->npc);
359 }
360 return n;
361}
362
swissChili6b47b6d2021-06-30 22:08:55 -0700363void compile_backquote(struct environment *env, struct local *local,
364 value_t val, dasm_State **Dst)
365{
366 if (!listp(val))
367 {
368 | mov eax, (val);
369 }
370 else
371 {
swissChili7e1393c2021-07-07 12:59:12 -0700372 value_t fsym = car(val), args = cdr(val);
swissChili9d151e62021-08-04 13:11:45 -0700373 int nargs = length(args),
374 n = length(val);
swissChili6b47b6d2021-06-30 22:08:55 -0700375
swissChili9d151e62021-08-04 13:11:45 -0700376 if (symstreq(fsym, "unquote"))
377 {
378 if (nargs != 1)
379 {
380 err_at(val, "unquote (or ,) takes exactly 1 argument");
381 }
382
383 compile_expression(env, local, car(args), false, Dst);
384 }
385 else
386 {
387 | push nil;
388
389 for (int i = n - 1; i >= 0; i--)
390 {
391 compile_backquote(env, local, elt(val, i), Dst);
392 | push eax;
393 | call_extern cons;
394 | add esp, 8;
395
396 // Remove unnecessary pop
397 | push eax;
398 }
swissChilia89ee442021-08-04 20:54:51 -0700399 | pop eax;
swissChili9d151e62021-08-04 13:11:45 -0700400 }
swissChili6b47b6d2021-06-30 22:08:55 -0700401 }
402}
403
swissChili7e1393c2021-07-07 12:59:12 -0700404value_t eval(struct environment *env, value_t form)
405{
406 // Eval!
407 value_t function = cons(nil, cons(form, nil));
408
409 struct local local;
410 struct args *args;
411
412 dasm_State *d = compile_function(function, NS_ANONYMOUS, env, &local, NULL,
413 &args, NULL, "/");
414
415 del_local(&local);
416
417 value_t (*f)() = link_program(&d);
418 return f();
419}
420
swissChiliddc97542021-07-04 11:47:42 -0700421void compile_variable(struct variable *v, dasm_State *Dst)
422{
423 switch (v->type)
424 {
425 case V_ARGUMENT:
swissChili7e1393c2021-07-07 12:59:12 -0700426 | mov eax, dword[ebp + (value_size * (v->number + 2))];
swissChiliddc97542021-07-04 11:47:42 -0700427 break;
428 case V_BOUND:
swissChili7e1393c2021-07-07 12:59:12 -0700429 | mov eax, dword[ebp - ((v->number + 1) * value_size)];
swissChiliddc97542021-07-04 11:47:42 -0700430 break;
431 case V_FREE:
432 // edi is the closure context pointer
swissChili7e1393c2021-07-07 12:59:12 -0700433 | mov eax, dword[edi + (v->number * value_size)];
swissChiliddc97542021-07-04 11:47:42 -0700434 break;
435 default:
swissChili7e1393c2021-07-07 12:59:12 -0700436 err("Sorry, can only access V_ARGUMENT, V_FREE and V_BOUND variables "
437 "for now :(");
swissChiliddc97542021-07-04 11:47:42 -0700438 }
439}
440
swissChili53472e82021-05-08 16:06:32 -0700441void compile_expression(struct environment *env, struct local *local,
swissChilib51552c2021-08-03 10:23:37 -0700442 value_t val, bool tail, dasm_State **Dst)
swissChili53472e82021-05-08 16:06:32 -0700443{
swissChili7e1393c2021-07-07 12:59:12 -0700444 if (symstreq(val, "nil") || nilp(val))
swissChili53472e82021-05-08 16:06:32 -0700445 {
446 | mov eax, (nil);
447 }
swissChili923b5362021-05-09 20:31:43 -0700448 else if (symstreq(val, "t"))
449 {
450 | mov eax, (t);
451 }
452 else if (integerp(val) || stringp(val))
swissChilib3ca4fb2021-04-20 10:33:00 -0700453 {
454 | mov eax, val;
455 }
swissChili53472e82021-05-08 16:06:32 -0700456 else if (listp(val))
swissChilib3ca4fb2021-04-20 10:33:00 -0700457 {
swissChili53472e82021-05-08 16:06:32 -0700458 value_t fsym = car(val);
459 value_t args = cdr(val);
460 int nargs = length(args);
swissChilib3ca4fb2021-04-20 10:33:00 -0700461
swissChili53472e82021-05-08 16:06:32 -0700462 if (!symbolp(fsym))
swissChilif3e7f182021-04-20 13:57:22 -0700463 {
swissChili7e1393c2021-07-07 12:59:12 -0700464 printval(val, 2);
465 err_at(val, "function name must be a symbol");
swissChilif3e7f182021-04-20 13:57:22 -0700466 }
467
swissChili53472e82021-05-08 16:06:32 -0700468 if (symstreq(fsym, "if"))
swissChilib3ca4fb2021-04-20 10:33:00 -0700469 {
swissChili53472e82021-05-08 16:06:32 -0700470 if (nargs < 2 || nargs > 3)
471 err("Must give at least 2 arguments to if");
swissChilib3ca4fb2021-04-20 10:33:00 -0700472
swissChilib51552c2021-08-03 10:23:37 -0700473 compile_expression(env, local, car(args), false, Dst);
swissChili53472e82021-05-08 16:06:32 -0700474 int false_label = nextpc(local, Dst),
475 after_label = nextpc(local, Dst);
476
477 // result is in eax
478 | cmp eax, (nil);
swissChili484295d2021-07-09 21:25:55 -0700479 | je =>false_label;
swissChili53472e82021-05-08 16:06:32 -0700480
swissChilib51552c2021-08-03 10:23:37 -0700481 compile_expression(env, local, elt(args, 1), tail, Dst);
swissChili484295d2021-07-09 21:25:55 -0700482 | jmp =>after_label;
483 |=>false_label:;
swissChili53472e82021-05-08 16:06:32 -0700484 if (nargs == 3)
swissChilib51552c2021-08-03 10:23:37 -0700485 compile_expression(env, local, elt(args, 2), tail, Dst);
swissChili484295d2021-07-09 21:25:55 -0700486 |=>after_label:;
swissChili53472e82021-05-08 16:06:32 -0700487 }
swissChilia89ee442021-08-04 20:54:51 -0700488 else if (symstreq(fsym, "and") || symstreq(fsym, "or"))
489 {
490 bool or = symstreq(fsym, "or"); // false == and
491
492 // Boolean and and or, short circuit like &&/||
493 if (nargs < 1)
494 {
495 err_at(val, "and & or require at least 1 argument.");
496 }
497
498 int after = nextpc(local, Dst);
499
500 for (; !nilp(args); args = cdr(args))
501 {
502 compile_expression(env, local, car(args), false, Dst);
503 if (!nilp(cdr(args)))
504 {
505 | cmp eax, nil;
506 if (or)
507 {
swissChilifbf525f2021-08-04 21:28:07 -0700508 | jne =>after;
swissChilia89ee442021-08-04 20:54:51 -0700509 }
510 else
511 {
swissChilifbf525f2021-08-04 21:28:07 -0700512 | je =>after;
swissChilia89ee442021-08-04 20:54:51 -0700513 }
514 }
515 }
516
517 |=>after:;
518 }
swissChilif68671f2021-07-05 14:14:44 -0700519 else if (symstreq(fsym, "progn"))
520 {
521 for (value_t val = args; !nilp(val); val = cdr(val))
522 {
swissChilib51552c2021-08-03 10:23:37 -0700523 bool t = tail && nilp(cdr(val));
524 compile_expression(env, local, car(val), t, Dst);
swissChilif68671f2021-07-05 14:14:44 -0700525 }
526 }
swissChili67bdf282021-06-06 18:46:08 -0700527 else if (symstreq(fsym, "let1"))
528 {
529 if (nargs < 2)
530 {
531 err("Must give at least 2 arguments to let1");
532 }
533 value_t binding = car(args);
534 value_t rest = cdr(args);
535
536 if (length(binding) != 2)
537 {
538 err("Binding list in let1 must contain exactly two entries");
539 }
540
541 value_t name = car(binding);
542 value_t value = car(cdr(binding));
543
swissChilib51552c2021-08-03 10:23:37 -0700544 compile_expression(env, local, value, false, Dst);
swissChili67bdf282021-06-06 18:46:08 -0700545
546 int i = local_alloc(local);
547
548 add_variable(local, V_BOUND, (char *)(name ^ SYMBOL_TAG), i);
549
swissChili7e1393c2021-07-07 12:59:12 -0700550 | mov dword[ebp - ((i + 1) * value_size)], eax;
swissChili67bdf282021-06-06 18:46:08 -0700551
552 for (; !nilp(rest); rest = cdr(rest))
553 {
swissChilib51552c2021-08-03 10:23:37 -0700554 bool t = tail && nilp(cdr(rest));
555 compile_expression(env, local, car(rest), t, Dst);
swissChili67bdf282021-06-06 18:46:08 -0700556 }
557
558 local_free(local, i);
559 }
swissChilie9fec8b2021-06-22 13:59:33 -0700560 else if (symstreq(fsym, "gc"))
561 {
562 if (nargs)
563 {
swissChili7e1393c2021-07-07 12:59:12 -0700564 err_at(val, "gc takes no arguments");
swissChilie9fec8b2021-06-22 13:59:33 -0700565 }
566
567 | run_gc;
568 }
swissChili6b47b6d2021-06-30 22:08:55 -0700569 else if (symstreq(fsym, "quote"))
570 {
571 if (nargs != 1)
572 err("quote should take exactly 1 argument");
573
574 // Simple!
575 | mov eax, (car(args));
576 }
577 else if (symstreq(fsym, "backquote"))
578 {
579 if (nargs != 1)
580 err("backquote should take exactly 1 argument");
581
582 compile_backquote(env, local, car(args), Dst);
583 }
swissChili74348422021-07-04 13:23:24 -0700584 else if (symstreq(fsym, "function"))
585 {
586 if (nargs != 1)
587 {
588 err("function should take exactly 1 argument");
589 }
590
591 if (!symbolp(car(args)))
592 {
swissChili7e1393c2021-07-07 12:59:12 -0700593 err("argument to function should be a symbol resolvable at "
594 "compile time");
swissChili74348422021-07-04 13:23:24 -0700595 }
596
swissChilia89ee442021-08-04 20:54:51 -0700597 char *name = (char *)(car(args) ^ SYMBOL_TAG);
swissChili74348422021-07-04 13:23:24 -0700598
swissChilia89ee442021-08-04 20:54:51 -0700599 if (!strcmp(name, local->current_function_name))
600 {
601 | push 0;
602 | push local->args;
603 | push <1;
604 | call_extern create_closure;
605 }
606 else
607 {
608 struct function *f = find_function(env, name);
609
610 if (!f)
611 {
612 err_at(val, "Function `%s' does not exist", (char *)(car(args) ^ SYMBOL_TAG));
613 }
614 value_t closure = create_closure(f->code_ptr, f->args, 0);
615 | mov eax, (closure);
616 }
swissChili74348422021-07-04 13:23:24 -0700617 }
swissChili6b47b6d2021-06-30 22:08:55 -0700618 else if (symstreq(fsym, "list"))
619 {
swissChili484295d2021-07-09 21:25:55 -0700620 | push (nil);
swissChili6b47b6d2021-06-30 22:08:55 -0700621
622 for (int i = nargs - 1; i >= 0; i--)
623 {
swissChilib51552c2021-08-03 10:23:37 -0700624 compile_expression(env, local, elt(args, i), false, Dst);
swissChili6b47b6d2021-06-30 22:08:55 -0700625
swissChili6b47b6d2021-06-30 22:08:55 -0700626 | push eax;
swissChili53e7cd12021-08-02 21:55:53 -0700627 | call_extern cons;
swissChili6b47b6d2021-06-30 22:08:55 -0700628 | add esp, (2 * value_size);
swissChili6b47b6d2021-06-30 22:08:55 -0700629 | push eax;
630 }
swissChili9d151e62021-08-04 13:11:45 -0700631 | pop eax;
swissChili6b47b6d2021-06-30 22:08:55 -0700632 }
swissChiliddc97542021-07-04 11:47:42 -0700633 else if (symstreq(fsym, "lambda"))
634 {
635 // Compile the function with this as the parent scope
636 struct local new_local;
637 int nargs_out;
swissChili7e1393c2021-07-07 12:59:12 -0700638 dasm_State *d = compile_function(
639 args, NS_ANONYMOUS, env, &new_local, local, &nargs_out,
640 "recurse", local->current_file_path);
swissChiliddc97542021-07-04 11:47:42 -0700641
642 // Link the function
swissChilif68671f2021-07-05 14:14:44 -0700643 void *func_ptr = link_program(&d);
swissChiliddc97542021-07-04 11:47:42 -0700644
645 // Create a closure object with the correct number of captures at
646 // runtime
swissChili484295d2021-07-09 21:25:55 -0700647 | push (new_local.num_closure_slots);
648 | push (nargs_out);
649 | push (func_ptr);
swissChili53e7cd12021-08-02 21:55:53 -0700650 | call_extern create_closure;
swissChiliddc97542021-07-04 11:47:42 -0700651 | add esp, 12;
652
653 // Walk the generated local scope for V_FREE variables, since each
654 // of these exists in our scope (or higher), evaluate it and set it
655 // as a member of the lambda capture.
656
657 for (struct variable *var = new_local.first; var; var = var->prev)
658 {
659 if (var->type == V_FREE)
660 {
661 // Closure in eax
662 | push eax;
663 // Variable now in eax
664 compile_variable(find_variable(local, var->name), Dst);
665 | push eax;
666
swissChiliddc97542021-07-04 11:47:42 -0700667 // The capture offset
swissChili484295d2021-07-09 21:25:55 -0700668 | push (var->number);
swissChili53e7cd12021-08-02 21:55:53 -0700669 | call_extern set_closure_capture_variable;
swissChiliddc97542021-07-04 11:47:42 -0700670 // Skip the value and index
671 | add esp, 8;
672 // Pop the closure back in to eax
673 | pop eax;
674 }
675 }
676
677 // Closure is still in eax
678
679 dasm_free(&d);
swissChili708d4c42021-07-04 17:40:07 -0700680 del_local(&new_local);
swissChiliddc97542021-07-04 11:47:42 -0700681 }
swissChili7e1393c2021-07-07 12:59:12 -0700682 else if (symstreq(fsym, "eval"))
683 {
684 if (nargs != 1)
685 {
686 err("eval takes exactly 1 argument");
687 }
688
swissChilib51552c2021-08-03 10:23:37 -0700689 compile_expression(env, local, car(args), false, Dst);
swissChili7e1393c2021-07-07 12:59:12 -0700690 | push eax;
swissChili484295d2021-07-09 21:25:55 -0700691 | push (env);
swissChili53e7cd12021-08-02 21:55:53 -0700692 | call_extern eval;
swissChili7e1393c2021-07-07 12:59:12 -0700693 }
694 else if (symstreq(fsym, "load"))
695 {
696 if (nargs != 1)
697 {
698 err_at(val, "load takes exactly 1 argument, %d given", nargs);
699 }
700
swissChilib51552c2021-08-03 10:23:37 -0700701 compile_expression(env, local, car(args), false, Dst);
swissChili7e1393c2021-07-07 12:59:12 -0700702 | push eax;
swissChili484295d2021-07-09 21:25:55 -0700703 | push (local->current_file_path);
704 | push (env);
swissChili53e7cd12021-08-02 21:55:53 -0700705 | call_extern load_relative;
swissChili7e1393c2021-07-07 12:59:12 -0700706 }
swissChili53472e82021-05-08 16:06:32 -0700707 else
708 {
swissChili74348422021-07-04 13:23:24 -0700709 char *name = (char *)(fsym ^ SYMBOL_TAG);
710 struct function *func = find_function(env, name);
swissChili7e1393c2021-07-07 12:59:12 -0700711
swissChili74348422021-07-04 13:23:24 -0700712 bool is_recursive = false;
swissChili15f1cae2021-07-05 19:08:47 -0700713 struct args *nargs_needed = NULL;
swissChili53472e82021-05-08 16:06:32 -0700714
swissChili53e7cd12021-08-02 21:55:53 -0700715 // The number of arguments actually passed on the stack,
716 // i.e. all varargs are 1.
swissChilib51552c2021-08-03 10:23:37 -0700717 int real_nargs;
swissChili53e7cd12021-08-02 21:55:53 -0700718
swissChili7e1393c2021-07-07 12:59:12 -0700719 if (local->current_function_name &&
720 symstreq(fsym, local->current_function_name))
swissChilif1ba8c12021-07-02 18:45:38 -0700721 {
swissChili74348422021-07-04 13:23:24 -0700722 is_recursive = true;
swissChili15f1cae2021-07-05 19:08:47 -0700723 nargs_needed = local->args;
swissChili74348422021-07-04 13:23:24 -0700724 }
725 else
726 {
727 if (func == NULL)
728 {
swissChili7e1393c2021-07-07 12:59:12 -0700729 err_at(val, "Function %s undefined", name);
swissChili74348422021-07-04 13:23:24 -0700730 }
731
swissChili15f1cae2021-07-05 19:08:47 -0700732 nargs_needed = func->args;
swissChili74348422021-07-04 13:23:24 -0700733 }
734
swissChili15f1cae2021-07-05 19:08:47 -0700735 if (!are_args_acceptable(nargs_needed, nargs))
swissChili74348422021-07-04 13:23:24 -0700736 {
swissChili7e1393c2021-07-07 12:59:12 -0700737 err_at(val,
738 "wrong number of args in function call: %s at %s:%d, "
739 "want %d args but given %d\n",
740 name, cons_file(val), cons_line(val),
741 nargs_needed->num_required, nargs);
swissChilif1ba8c12021-07-02 18:45:38 -0700742 }
swissChili53472e82021-05-08 16:06:32 -0700743
swissChili53e7cd12021-08-02 21:55:53 -0700744 int total_taken = nargs_needed->num_optional +
745 nargs_needed->num_required;
746
swissChilib51552c2021-08-03 10:23:37 -0700747 real_nargs = total_taken + (nargs_needed->variadic ? 1 : 0);
swissChili53e7cd12021-08-02 21:55:53 -0700748
swissChili74348422021-07-04 13:23:24 -0700749 if (is_recursive || func->namespace == NS_FUNCTION)
swissChili53472e82021-05-08 16:06:32 -0700750 {
swissChili15f1cae2021-07-05 19:08:47 -0700751 int nargs = length(args);
752
swissChili484295d2021-07-09 21:25:55 -0700753 int line = cons_line(val);
754 char *file = cons_file(val);
755
756 if (nargs_needed->variadic)
swissChili15f1cae2021-07-05 19:08:47 -0700757 {
swissChili484295d2021-07-09 21:25:55 -0700758 | push (nil);
759 }
760
761 if (nargs > total_taken && nargs_needed->variadic)
762 {
763 // We are passing varargs, which means we need to make a list
764
765 for (int i = nargs - 1; i >= total_taken; i--)
766 {
swissChilib51552c2021-08-03 10:23:37 -0700767 compile_expression(env, local, elt(args, i), false, Dst);
swissChili484295d2021-07-09 21:25:55 -0700768 | push eax;
swissChili53e7cd12021-08-02 21:55:53 -0700769 | call_extern cons;
swissChili484295d2021-07-09 21:25:55 -0700770 | add esp, 8;
771 | push eax;
772 }
swissChili15f1cae2021-07-05 19:08:47 -0700773 }
774
swissChili7e1393c2021-07-07 12:59:12 -0700775 for (int i = nargs_needed->num_optional - 1;
776 i >= nargs - nargs_needed->num_required; i--)
swissChili15f1cae2021-07-05 19:08:47 -0700777 {
778 // Push the default optional values
swissChili484295d2021-07-09 21:25:55 -0700779 | push (nargs_needed->optional_arguments[i].value);
swissChili15f1cae2021-07-05 19:08:47 -0700780 }
781
swissChili484295d2021-07-09 21:25:55 -0700782 int min = MIN(nargs, total_taken);
783
784 for (int i = min - 1; i >= 0; i--)
swissChili2999dd12021-07-02 14:19:53 -0700785 {
swissChilib51552c2021-08-03 10:23:37 -0700786 compile_expression(env, local, elt(args, i), false, Dst);
swissChili2999dd12021-07-02 14:19:53 -0700787 | push eax;
788 }
swissChili15f1cae2021-07-05 19:08:47 -0700789
swissChili74348422021-07-04 13:23:24 -0700790 if (is_recursive)
791 {
swissChilib51552c2021-08-03 10:23:37 -0700792 if (tail)
793 {
794 // Move all the arguments pushed to the stack
795 // back up to the argument bit of the stack.
796
797 for (int i = 0; i < real_nargs; i++)
798 {
799 | pop eax;
800 | mov dword[ebp + (value_size * (i + 2))], eax;
801 }
802
803 // Jmp back to start
804 | mov esp, ebp;
805 | pop ebp;
806 | jmp <1;
807 }
808 else
809 {
810 | call <1;
811 }
swissChili74348422021-07-04 13:23:24 -0700812 }
813 else
814 {
swissChili484295d2021-07-09 21:25:55 -0700815 // | mov ebx, (func->code_addr);
816 | call_extern func->code_addr;
swissChili74348422021-07-04 13:23:24 -0700817 }
swissChili53e7cd12021-08-02 21:55:53 -0700818 | add esp, (real_nargs * value_size);
swissChili2999dd12021-07-02 14:19:53 -0700819 // result in eax
820 }
821 else if (func->namespace == NS_MACRO)
822 {
swissChili7e1393c2021-07-07 12:59:12 -0700823 // Make sure that the stuff allocated by the macro isn't in a
824 // pool
swissChilif68671f2021-07-05 14:14:44 -0700825 unsigned char pool = push_pool(0);
826
swissChili2999dd12021-07-02 14:19:53 -0700827 value_t expanded_to = call_list(func, args);
828
swissChilif68671f2021-07-05 14:14:44 -0700829 pop_pool(pool);
830
swissChilib51552c2021-08-03 10:23:37 -0700831 compile_expression(env, local, expanded_to, false, Dst);
swissChili2999dd12021-07-02 14:19:53 -0700832 }
swissChili53472e82021-05-08 16:06:32 -0700833 }
swissChilib3ca4fb2021-04-20 10:33:00 -0700834 }
swissChili923b5362021-05-09 20:31:43 -0700835 else if (symbolp(val))
836 {
swissChili7e1393c2021-07-07 12:59:12 -0700837 if (symstreq(val, "+current-file+"))
swissChilie9fec8b2021-06-22 13:59:33 -0700838 {
swissChili7e1393c2021-07-07 12:59:12 -0700839 value_t file_name_val = strval(local->current_file_path);
840
841 | mov eax, (file_name_val);
swissChilie9fec8b2021-06-22 13:59:33 -0700842 }
swissChili7e1393c2021-07-07 12:59:12 -0700843 else
844 {
845 struct variable *v =
846 find_variable(local, (char *)(val ^ SYMBOL_TAG));
swissChili923b5362021-05-09 20:31:43 -0700847
swissChili7e1393c2021-07-07 12:59:12 -0700848 if (!v)
849 {
850 fprintf(stderr, "var: %s\n", (char *)(val ^ SYMBOL_TAG));
851 err("Variable unbound");
852 }
853
854 compile_variable(v, Dst);
855 }
swissChili923b5362021-05-09 20:31:43 -0700856 }
swissChilia89ee442021-08-04 20:54:51 -0700857 else if (closurep(val))
858 {
859 | mov eax, val;
860 }
861 else
862 {
863 printval(val, 1);
864 err_at(val, "Don't know how to compile this, sorry.");
865 }
swissChilib3ca4fb2021-04-20 10:33:00 -0700866}
swissChilif3e7f182021-04-20 13:57:22 -0700867
swissChili923b5362021-05-09 20:31:43 -0700868struct variable *add_variable(struct local *local, enum var_type type,
869 char *name, int number)
870{
871 struct variable *var = malloc(sizeof(struct variable));
872 var->prev = local->first;
873 var->type = type;
874 var->name = name;
875 var->number = number;
876
877 local->first = var;
878
879 return var;
880}
881
882void destroy_local(struct local *local)
883{
884 for (struct variable *v = local->first; v;)
885 {
886 struct variable *t = v;
887 v = v->prev;
888 free(t);
889 }
890}
891
892struct variable *find_variable(struct local *local, char *name)
893{
894 struct variable *v = local->first;
895
896 for (; v && strcmp(v->name, name) != 0; v = v->prev)
swissChili7e1393c2021-07-07 12:59:12 -0700897 {
898 }
swissChili923b5362021-05-09 20:31:43 -0700899
swissChiliddc97542021-07-04 11:47:42 -0700900 if (!v)
901 {
902 if (local->parent)
903 {
904 v = find_variable(local->parent, name);
905
906 if (v)
907 {
swissChili15f1cae2021-07-05 19:08:47 -0700908 // We found this in a parent scope, add it as a V_FREE variable
909 // to skip the search.
swissChili7e1393c2021-07-07 12:59:12 -0700910 v = add_variable(local, V_FREE, name,
911 local->num_closure_slots++);
swissChiliddc97542021-07-04 11:47:42 -0700912 }
913 }
914 }
swissChili923b5362021-05-09 20:31:43 -0700915 return v;
916}
swissChili2999dd12021-07-02 14:19:53 -0700917
swissChiliddc97542021-07-04 11:47:42 -0700918extern value_t _call_list(void *addr, value_t list, value_t *edi);
swissChili2999dd12021-07-02 14:19:53 -0700919
swissChili7e1393c2021-07-07 12:59:12 -0700920value_t call_list_args(void *code_ptr, struct args *args, value_t list,
921 void *data)
swissChili2999dd12021-07-02 14:19:53 -0700922{
swissChili15f1cae2021-07-05 19:08:47 -0700923 list = deep_copy(list);
swissChili484295d2021-07-09 21:25:55 -0700924
swissChili15f1cae2021-07-05 19:08:47 -0700925 int nargs = length(list);
926
swissChili484295d2021-07-09 21:25:55 -0700927 value_t *val = &list;
swissChili15f1cae2021-07-05 19:08:47 -0700928
929 for (value_t i = list; !nilp(i); i = cdr(i))
930 {
931 val = cdrref(i);
932 }
933
934 int total_required = args->num_required + args->num_optional;
935
936 if (nargs > total_required)
937 {
938 // Take the remainder of the list and put it as the last item in the
939 // list.
940 value_t trailing = cxdr(list, total_required);
941 value_t last_item = cons(trailing, nil);
942
943 *cxdrref(&list, total_required) = last_item;
944 }
945 else if (nargs < total_required)
946 {
947 for (int i = nargs - args->num_required; i < args->num_optional; i++)
948 {
949 // Append the i-th defualt argument
950 value_t appended = cons(args->optional_arguments[i].value, nil);
951 *val = appended;
952 val = cdrref(appended);
953 }
954 }
955
956 // We want to call this if we pass the correct # of arguments or less, just
957 // not if we have already passed varargs. Appends a nil argument.
958 if (nargs <= total_required)
959 {
960 // Enough real arguments but no variadic arguments. Pass a nil list.
961 *val = cons(nil, nil);
962 }
963
964 return _call_list(code_ptr, list, data);
965}
966
967value_t call_list(struct function *fun, value_t list)
968{
969 return call_list_args(fun->code_ptr, fun->args, list, NULL);
swissChiliddc97542021-07-04 11:47:42 -0700970}
971
972value_t call_list_closure(struct closure *c, value_t list)
973{
swissChili15f1cae2021-07-05 19:08:47 -0700974 return call_list_args(c->function, c->args, list, c->data);
975}
976
977struct args *new_args()
978{
979 struct args *a = malloc(sizeof(struct args));
980 a->num_optional = 0;
981 a->num_required = 0;
982 a->variadic = false;
983
984 return a;
985}
986
swissChili7e1393c2021-07-07 12:59:12 -0700987struct args *add_optional_arg(struct args *args, value_t name, value_t value)
swissChili15f1cae2021-07-05 19:08:47 -0700988{
989 int i = args->num_optional++;
swissChili7e1393c2021-07-07 12:59:12 -0700990 args =
991 realloc(args, sizeof(struct args) + sizeof(struct optional_argument) *
992 args->num_optional);
swissChili15f1cae2021-07-05 19:08:47 -0700993
swissChili7e1393c2021-07-07 12:59:12 -0700994 args->optional_arguments[i] = (struct optional_argument){
995 .value = value,
996 .name = name,
swissChili15f1cae2021-07-05 19:08:47 -0700997 };
998
999 return args;
1000}
1001
1002bool are_args_acceptable(struct args *args, int number)
1003{
1004 if (args->variadic)
1005 {
1006 return number >= args->num_required;
1007 }
1008 else
1009 {
1010 return number >= args->num_required &&
swissChili7e1393c2021-07-07 12:59:12 -07001011 number <= args->num_required + args->num_optional;
swissChili15f1cae2021-07-05 19:08:47 -07001012 }
1013}
1014
swissChili7e1393c2021-07-07 12:59:12 -07001015struct args *list_to_args(struct environment *env, value_t list,
1016 struct local *local)
swissChili15f1cae2021-07-05 19:08:47 -07001017{
1018 struct args *args = new_args();
1019
1020 bool in_optional = false;
1021
1022 for (value_t i = list; !nilp(i); i = cdr(i))
1023 {
1024 value_t val = car(i);
1025 if (symbolp(val))
1026 {
1027 if (!args->variadic && symstreq(val, "&"))
1028 {
1029 i = cdr(i);
1030 value_t name = car(i);
1031
1032 if (!symbolp(name))
1033 {
swissChili7e1393c2021-07-07 12:59:12 -07001034 err("You must provide a symbol after & in an argument list "
1035 "to bind the\n"
1036 "variadic arguments to.");
swissChili15f1cae2021-07-05 19:08:47 -07001037 }
1038
1039 args->variadic = true;
1040
1041 add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG),
swissChili7e1393c2021-07-07 12:59:12 -07001042 args->num_optional + args->num_required);
swissChili15f1cae2021-07-05 19:08:47 -07001043
1044 continue;
1045 }
1046
1047 if (!in_optional)
1048 {
swissChili7e1393c2021-07-07 12:59:12 -07001049 add_variable(local, V_ARGUMENT, (char *)(val ^ SYMBOL_TAG),
1050 args->num_required++);
swissChili15f1cae2021-07-05 19:08:47 -07001051 }
1052 else
1053 {
1054 char *name = (char *)(val ^ SYMBOL_TAG);
1055 if (name[0] == '&')
1056 {
swissChili7e1393c2021-07-07 12:59:12 -07001057 err("Non-optional argument following optional arguments "
1058 "starts with a &\n"
1059 "did you mean to declare a variadic argument? If so "
1060 "leave a space\n"
1061 "between the & and name.");
swissChili15f1cae2021-07-05 19:08:47 -07001062 }
1063 else
1064 {
swissChili7e1393c2021-07-07 12:59:12 -07001065 err("Cannot define a non-optional argument after an "
1066 "optional one.");
swissChili15f1cae2021-07-05 19:08:47 -07001067 }
1068 }
1069 }
1070 else if (listp(val))
1071 {
1072 in_optional = true;
1073 int len = length(val);
1074
1075 if (len != 2)
1076 {
swissChili7e1393c2021-07-07 12:59:12 -07001077 err("A list defining an optional value must be structured like "
1078 "(name expr)\n"
1079 "with exactly two arguments.");
swissChili15f1cae2021-07-05 19:08:47 -07001080 }
1081
1082 value_t name = car(val);
1083 value_t expr = car(cdr(val));
1084
1085 value_t function = cons(nil, cons(expr, nil));
1086
swissChili7e1393c2021-07-07 12:59:12 -07001087 dasm_State *d =
1088 compile_function(function, NS_ANONYMOUS, env, NULL, NULL, NULL,
1089 NULL, local->current_file_path);
swissChili15f1cae2021-07-05 19:08:47 -07001090
1091 // TODO: GC stack top!
1092 value_t (*compiled)() = link_program(&d);
1093
1094 value_t value = compiled();
1095 args = add_optional_arg(args, name, value);
1096
swissChili7e1393c2021-07-07 12:59:12 -07001097 add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG),
1098 args->num_required + args->num_optional - 1);
swissChili15f1cae2021-07-05 19:08:47 -07001099 }
1100 }
1101
1102 return args;
1103}
1104
1105void display_args(struct args *args)
1106{
1107 printf("Args object taking %d require arguments and %d optionals:\n",
swissChili7e1393c2021-07-07 12:59:12 -07001108 args->num_required, args->num_optional);
swissChili15f1cae2021-07-05 19:08:47 -07001109
1110 for (int i = 0; i < args->num_optional; i++)
1111 {
swissChili7e1393c2021-07-07 12:59:12 -07001112 printf(" %d\t%s\n", i,
1113 (char *)(args->optional_arguments[i].name ^ SYMBOL_TAG));
swissChili15f1cae2021-07-05 19:08:47 -07001114 printval(args->optional_arguments[i].value, 2);
1115 }
swissChili2999dd12021-07-02 14:19:53 -07001116}