blob: 331193d11109d60a5471d6cc22c8e66a5626d3d4 [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
swissChilic0acce42022-07-31 13:38:17 -0700108 if (f->args)
109 free(f->args);
swissChili708d4c42021-07-04 17:40:07 -0700110 free(f);
111 }
swissChilif68671f2021-07-05 14:14:44 -0700112
113 for (struct loaded_file *next, *l = env->first_loaded; l; l = next)
114 {
115 next = l->previous;
116 free(l->resolved_path);
117 free(l);
118 }
swissChili7e1393c2021-07-07 12:59:12 -0700119
120 free(env);
swissChilif68671f2021-07-05 14:14:44 -0700121}
122
123void add_load(struct environment *env, char *path)
124{
125 static char buffer[512];
126 long size = readlink(path, buffer, 512);
127 buffer[size] = '\0';
128 char *resolved = strdup(buffer);
129
130 struct loaded_file *f = malloc(sizeof(struct loaded_file));
131 f->resolved_path = resolved;
132 f->previous = env->first_loaded;
133 env->first_loaded = f;
swissChili708d4c42021-07-04 17:40:07 -0700134}
135
swissChili6d02af42021-08-05 19:49:01 -0700136struct error compile_function(value_t args, enum namespace namespace,
137 struct environment *env,
138 struct local *local_out,
139 struct local *local_parent,
140 struct args **args_out, char *name,
141 char *path,
142 dasm_State **state)
swissChilif1ba8c12021-07-02 18:45:38 -0700143{
swissChilia7568dc2021-08-08 16:52:52 -0700144 UNUSED(namespace);
145
swissChili6d02af42021-08-05 19:49:01 -0700146 E_INIT();
147
swissChilif1ba8c12021-07-02 18:45:38 -0700148 dasm_State *d;
149 dasm_State **Dst = &d;
150
swissChili484295d2021-07-09 21:25:55 -0700151 |.section code, imports;
swissChilif1ba8c12021-07-02 18:45:38 -0700152 dasm_init(&d, DASM_MAXSECTION);
153
154 |.globals lbl_;
155 void *labels[lbl__MAX];
156 dasm_setupglobal(&d, labels, lbl__MAX);
157
158 |.actionlist lisp_actions;
159 dasm_setup(&d, lisp_actions);
160
161 struct local local;
162 local.parent = NULL;
163 local.first = NULL;
164 local.num_vars = 0;
165 local.npc = 8;
166 local.nextpc = 0;
167 local.stack_slots = malloc(sizeof(bool) * 4);
168 memset(local.stack_slots, 0, sizeof(bool) * 4);
169 local.num_stack_slots = 4;
170 local.num_stack_entries = 0;
swissChiliddc97542021-07-04 11:47:42 -0700171 local.num_closure_slots = 0;
172 local.parent = local_parent;
swissChili74348422021-07-04 13:23:24 -0700173 local.current_function_name = name;
swissChili7e1393c2021-07-07 12:59:12 -0700174 local.current_file_path = path;
swissChilif1ba8c12021-07-02 18:45:38 -0700175
176 dasm_growpc(&d, local.npc);
177
swissChilif1ba8c12021-07-02 18:45:38 -0700178 value_t arglist = car(args);
179 value_t body = cdr(args);
180
swissChili15f1cae2021-07-05 19:08:47 -0700181 // This will add the arguments to local too.
swissChili6d02af42021-08-05 19:49:01 -0700182 struct args *ar;
183 TRY(list_to_args(env, arglist, &local, &ar));
swissChili15f1cae2021-07-05 19:08:47 -0700184 local.args = ar;
swissChili74348422021-07-04 13:23:24 -0700185
swissChili15f1cae2021-07-05 19:08:47 -0700186 if (!ar)
swissChilif1ba8c12021-07-02 18:45:38 -0700187 {
swissChili6d02af42021-08-05 19:49:01 -0700188 NEARVAL(arglist);
189 THROW(EMALFORMED, "Malformed argument list");
swissChilif1ba8c12021-07-02 18:45:38 -0700190 }
191
192 for (value_t body_ = body; !nilp(body_); body_ = cdr(body_))
193 {
swissChilifc5c9412021-08-08 19:08:26 -0700194 TRY(walk_and_alloc(env, &local, carref(body_), false));
swissChilif1ba8c12021-07-02 18:45:38 -0700195 }
196
swissChili484295d2021-07-09 21:25:55 -0700197 | setup (local.num_stack_entries);
swissChilif1ba8c12021-07-02 18:45:38 -0700198
199 memset(local.stack_slots, 0, local.num_stack_slots * sizeof(bool));
200 local.num_stack_entries = 0;
201
202 for (; !nilp(body); body = cdr(body))
203 {
swissChilib51552c2021-08-03 10:23:37 -0700204 bool tail = nilp(cdr(body));
swissChili6d02af42021-08-05 19:49:01 -0700205 TRY(compile_expression(env, &local, car(body), tail, Dst));
swissChilif1ba8c12021-07-02 18:45:38 -0700206 }
207
208 | cleanup;
209
210 if (local_out)
211 *local_out = local;
swissChilic0acce42022-07-31 13:38:17 -0700212 else
213 del_local(&local);
swissChilif1ba8c12021-07-02 18:45:38 -0700214
swissChili15f1cae2021-07-05 19:08:47 -0700215 if (args_out)
216 *args_out = ar;
swissChilif1ba8c12021-07-02 18:45:38 -0700217
swissChilic0acce42022-07-31 13:38:17 -0700218 if (!local_out && !args_out)
219 free(ar);
220
swissChili6d02af42021-08-05 19:49:01 -0700221 *state = d;
222
223 OKAY();
swissChilif1ba8c12021-07-02 18:45:38 -0700224}
225
swissChili6d02af42021-08-05 19:49:01 -0700226struct error compile_tl(value_t val, struct environment *env, char *fname)
swissChilica107a02021-04-14 12:07:30 -0700227{
swissChili6d02af42021-08-05 19:49:01 -0700228 E_INIT();
229
230 NEARVAL(val);
231
swissChili53472e82021-05-08 16:06:32 -0700232 if (!listp(val))
swissChili6d02af42021-08-05 19:49:01 -0700233 {
234 THROW(EEXPECTED, "Top level form must be a list");
235 }
swissChilica107a02021-04-14 12:07:30 -0700236
swissChili53472e82021-05-08 16:06:32 -0700237 value_t form = car(val);
238 value_t args = cdr(val);
239
swissChili2999dd12021-07-02 14:19:53 -0700240 if (symstreq(form, "defun") || symstreq(form, "defmacro"))
swissChili8fc5e2f2021-04-22 13:45:10 -0700241 {
swissChili2999dd12021-07-02 14:19:53 -0700242 enum namespace namespace = NS_FUNCTION;
243
244 if (symstreq(form, "defmacro"))
swissChilia89ee442021-08-04 20:54:51 -0700245 namespace = NS_MACRO;
swissChili2999dd12021-07-02 14:19:53 -0700246
swissChili8fc5e2f2021-04-22 13:45:10 -0700247 struct local local;
swissChili15f1cae2021-07-05 19:08:47 -0700248 struct args *a;
swissChili74348422021-07-04 13:23:24 -0700249 char *name = (char *)(car(args) ^ SYMBOL_TAG);
swissChilif68671f2021-07-05 14:14:44 -0700250
swissChili6d02af42021-08-05 19:49:01 -0700251 dasm_State *d;
252 TRY(compile_function(cdr(args), namespace, env, &local,
253 NULL, &a, name, fname, &d));
swissChilia820dea2021-05-09 16:46:55 -0700254
swissChili7e1393c2021-07-07 12:59:12 -0700255 add_function(env, name, link_program(&d), a, namespace);
swissChili8fc5e2f2021-04-22 13:45:10 -0700256
swissChili53472e82021-05-08 16:06:32 -0700257 dasm_free(&d);
swissChili708d4c42021-07-04 17:40:07 -0700258 del_local(&local);
swissChili67bdf282021-06-06 18:46:08 -0700259 }
swissChilif68671f2021-07-05 14:14:44 -0700260 else if (symstreq(form, "progn"))
261 {
262 for (value_t val = args; !nilp(val); val = cdr(val))
263 {
swissChili6d02af42021-08-05 19:49:01 -0700264 TRY(compile_tl(car(val), env, fname));
swissChilif68671f2021-07-05 14:14:44 -0700265 }
266 }
swissChili484295d2021-07-09 21:25:55 -0700267 else if (symstreq(form, "load"))
268 {
269 if (length(args) != 1)
270 {
swissChili6d02af42021-08-05 19:49:01 -0700271 NEARVAL(args);
272 THROW(EARGS, "load expects exactly 1 argument, %d given",
273 length(args));
swissChili484295d2021-07-09 21:25:55 -0700274 }
275 load_relative(env, fname, car(args));
276 }
swissChili6d02af42021-08-05 19:49:01 -0700277
278 OKAY();
swissChili67bdf282021-06-06 18:46:08 -0700279}
280
swissChilifc5c9412021-08-08 19:08:26 -0700281struct error walk_and_alloc(struct environment *env, struct local *local, value_t *bp, bool quoted)
swissChili67bdf282021-06-06 18:46:08 -0700282{
swissChilifc5c9412021-08-08 19:08:26 -0700283 // Note: this kind of sucks. Some of the quote-handling code is
284 // duplicated here and compile_expression. TODO: refactor
285 // eventually.
286
swissChili36f2c692021-08-08 14:31:44 -0700287 E_INIT();
288
289 value_t body = *bp;
290
swissChili67bdf282021-06-06 18:46:08 -0700291 if (!listp(body))
swissChili36f2c692021-08-08 14:31:44 -0700292 OKAY();
swissChili67bdf282021-06-06 18:46:08 -0700293
294 value_t args = cdr(body);
295
swissChilifc5c9412021-08-08 19:08:26 -0700296 if (!quoted && symstreq(car(body), "let1"))
swissChili67bdf282021-06-06 18:46:08 -0700297 {
298 int slot = local_alloc(local);
299
300 value_t expr = cdr(args);
swissChilif1ba8c12021-07-02 18:45:38 -0700301 for (; !nilp(expr); expr = cdr(expr))
302 {
swissChilifc5c9412021-08-08 19:08:26 -0700303 walk_and_alloc(env, local, carref(expr), false);
swissChilif1ba8c12021-07-02 18:45:38 -0700304 }
swissChili67bdf282021-06-06 18:46:08 -0700305
306 local_free(local, slot);
307 }
swissChilifc5c9412021-08-08 19:08:26 -0700308 else if (!quoted && symstreq(car(body), "lambda"))
swissChilif1ba8c12021-07-02 18:45:38 -0700309 {
310 // We don't want to walk the lambda because it's another function. When
311 // the lambda is compiled it will be walked.
swissChili36f2c692021-08-08 14:31:44 -0700312 OKAY();
swissChilif1ba8c12021-07-02 18:45:38 -0700313 }
swissChili67bdf282021-06-06 18:46:08 -0700314 else
315 {
swissChilifc5c9412021-08-08 19:08:26 -0700316 if (quoted)
swissChili67bdf282021-06-06 18:46:08 -0700317 {
swissChilifc5c9412021-08-08 19:08:26 -0700318 if (symstreq(car(body), "unquote") || symstreq(car(body), "unquote-splice"))
319 {
320 for (value_t b = cdr(body); !nilp(b); b = cdr(b))
321 {
322 walk_and_alloc(env, local, carref(b), false);
323 }
324 }
swissChili36f2c692021-08-08 14:31:44 -0700325 }
326 else
327 {
swissChilifc5c9412021-08-08 19:08:26 -0700328 // Is this a macro?
329
330 struct function *mac = NULL;
331
332 if (symbolp(car(body)))
333 mac = find_function(env, (char *)(car(body) ^ SYMBOL_TAG));
334 else if (consp(car(body))) // consp, not just listp, since we don't care about nil.
335 walk_and_alloc(env, local, carref(body), false);
336
337 if (mac && mac->namespace == NS_MACRO)
swissChili36f2c692021-08-08 14:31:44 -0700338 {
swissChilifc5c9412021-08-08 19:08:26 -0700339 unsigned char pool = push_pool(0);
340 value_t form = call_list(mac, args);
341 pop_pool(pool);
342
343 add_to_pool(form);
344 *bp = form;
345
346 walk_and_alloc(env, local, bp, false);
347 }
348 else
349 {
350 bool should_quote = symstreq(car(body), "quote") || symstreq(car(body), "backquote");
351
352 for (; !nilp(args); args = cdr(args))
353 {
354 walk_and_alloc(env, local, carref(args), should_quote);
355 }
swissChili36f2c692021-08-08 14:31:44 -0700356 }
swissChili67bdf282021-06-06 18:46:08 -0700357 }
swissChili8fc5e2f2021-04-22 13:45:10 -0700358 }
swissChili36f2c692021-08-08 14:31:44 -0700359
360 OKAY();
swissChili8fc5e2f2021-04-22 13:45:10 -0700361}
362
swissChilif68671f2021-07-05 14:14:44 -0700363bool load(struct environment *env, char *path)
swissChili8fc5e2f2021-04-22 13:45:10 -0700364{
swissChilif68671f2021-07-05 14:14:44 -0700365 if (!file_exists(path))
366 return false;
367
368 add_load(env, path);
369
swissChilib8fd4712021-06-23 15:32:04 -0700370 unsigned char pool = make_pool();
371 unsigned char pop = push_pool(pool);
372
swissChilif68671f2021-07-05 14:14:44 -0700373 struct istream *is = new_fistream(path, false);
374 if (!is)
375 return false;
376
swissChili8fc5e2f2021-04-22 13:45:10 -0700377 value_t val;
swissChili53472e82021-05-08 16:06:32 -0700378
swissChilifc5c9412021-08-08 19:08:26 -0700379 struct error compile_error, read_error;
swissChili36f2c692021-08-08 14:31:44 -0700380
381 while (IS_OKAY((read_error = read1(is, &val))))
swissChili8fc5e2f2021-04-22 13:45:10 -0700382 {
swissChilifc5c9412021-08-08 19:08:26 -0700383 if (!IS_OKAY((compile_error = compile_tl(val, env, path))))
swissChili36f2c692021-08-08 14:31:44 -0700384 {
swissChilifc5c9412021-08-08 19:08:26 -0700385 ereport(compile_error);
swissChili36f2c692021-08-08 14:31:44 -0700386 goto failure;
387 }
388 }
389
390 if (!read_error.safe_state)
391 {
392 goto failure;
swissChili8fc5e2f2021-04-22 13:45:10 -0700393 }
swissChilif3e7f182021-04-20 13:57:22 -0700394
swissChilif68671f2021-07-05 14:14:44 -0700395 del_fistream(is);
swissChilib8fd4712021-06-23 15:32:04 -0700396 pop_pool(pop);
397
swissChilif68671f2021-07-05 14:14:44 -0700398 return true;
swissChili36f2c692021-08-08 14:31:44 -0700399
400failure:
401 del_fistream(is);
402 pop_pool(pool);
403
404 return false;
swissChilif68671f2021-07-05 14:14:44 -0700405}
406
swissChili7e1393c2021-07-07 12:59:12 -0700407value_t load_relative(struct environment *env, char *to, value_t name)
408{
409 if (!stringp(name))
410 return nil;
411
412 char *new_path = (char *)(name ^ STRING_TAG);
413 char *relative_to = strdup(to);
414 char full_path[512];
415
416 snprintf(full_path, 512, "%s/%s", dirname(relative_to), new_path);
417
swissChilic0acce42022-07-31 13:38:17 -0700418 free(relative_to);
419
swissChili7e1393c2021-07-07 12:59:12 -0700420 if (load(env, full_path))
421 return t;
422 else
423 return nil;
424}
425
swissChili6d02af42021-08-05 19:49:01 -0700426struct error compile_file(char *filename, struct environment **e)
swissChilif68671f2021-07-05 14:14:44 -0700427{
swissChili6d02af42021-08-05 19:49:01 -0700428 E_INIT();
429
swissChilif68671f2021-07-05 14:14:44 -0700430 value_t val;
swissChili7e1393c2021-07-07 12:59:12 -0700431 struct environment *env = malloc(sizeof(struct environment));
432 env->first = NULL;
433 env->first_loaded = NULL;
swissChilif68671f2021-07-05 14:14:44 -0700434
swissChili7e1393c2021-07-07 12:59:12 -0700435 add_load(env, filename);
swissChili6d02af42021-08-05 19:49:01 -0700436 TRY(load_std(env));
swissChilif68671f2021-07-05 14:14:44 -0700437
swissChili7e1393c2021-07-07 12:59:12 -0700438 bool ok_ = load(env, filename);
swissChilif68671f2021-07-05 14:14:44 -0700439
swissChili6d02af42021-08-05 19:49:01 -0700440 if (!ok_)
441 {
442 free(env);
swissChili1e8b7562021-12-22 21:22:57 -0800443 NEARFL(filename, 1);
swissChili6d02af42021-08-05 19:49:01 -0700444 THROWSAFE(ENOTFOUND);
445 }
swissChilif68671f2021-07-05 14:14:44 -0700446
swissChili6d02af42021-08-05 19:49:01 -0700447 *e = env;
448
449 OKAY();
swissChilica107a02021-04-14 12:07:30 -0700450}
swissChilib3ca4fb2021-04-20 10:33:00 -0700451
swissChili53472e82021-05-08 16:06:32 -0700452int nextpc(struct local *local, dasm_State **Dst)
swissChilib3ca4fb2021-04-20 10:33:00 -0700453{
swissChili53472e82021-05-08 16:06:32 -0700454 int n = local->nextpc++;
455 if (n > local->npc)
456 {
457 local->npc += 16;
458 dasm_growpc(Dst, local->npc);
459 }
460 return n;
461}
462
swissChili6d02af42021-08-05 19:49:01 -0700463struct error compile_backquote(struct environment *env, struct local *local,
464 value_t val, dasm_State **Dst)
swissChili6b47b6d2021-06-30 22:08:55 -0700465{
swissChili6d02af42021-08-05 19:49:01 -0700466 E_INIT();
467
swissChili6b47b6d2021-06-30 22:08:55 -0700468 if (!listp(val))
469 {
470 | mov eax, (val);
471 }
472 else
473 {
swissChili7e1393c2021-07-07 12:59:12 -0700474 value_t fsym = car(val), args = cdr(val);
swissChili9d151e62021-08-04 13:11:45 -0700475 int nargs = length(args),
476 n = length(val);
swissChili6b47b6d2021-06-30 22:08:55 -0700477
swissChili6d02af42021-08-05 19:49:01 -0700478 NEARVAL(val);
479
swissChili9d151e62021-08-04 13:11:45 -0700480 if (symstreq(fsym, "unquote"))
481 {
482 if (nargs != 1)
483 {
swissChili6d02af42021-08-05 19:49:01 -0700484 THROW(EARGS, "unquote (or ,) takes exactly 1 argument");
swissChili9d151e62021-08-04 13:11:45 -0700485 }
486
swissChili6d02af42021-08-05 19:49:01 -0700487 TRY(compile_expression(env, local, car(args), false, Dst));
swissChili9d151e62021-08-04 13:11:45 -0700488 }
489 else
490 {
swissChili9d428a82022-08-01 20:47:40 -0700491 // tail of the list
swissChili9d151e62021-08-04 13:11:45 -0700492 | push nil;
493
494 for (int i = n - 1; i >= 0; i--)
495 {
swissChilia7568dc2021-08-08 16:52:52 -0700496 value_t v = elt(val, i);
swissChili9d151e62021-08-04 13:11:45 -0700497
swissChilia7568dc2021-08-08 16:52:52 -0700498 if (listp(v) && symstreq(car(v), "unquote-splice"))
499 {
500 NEARVAL(v);
501
502 if (length(v) != 2)
503 {
504 THROW(EARGS, "unquote-splice (or ,@) takes exactly 1 argument");
505 }
506
507 value_t expr = car(cdr(v));
508
swissChilia7568dc2021-08-08 16:52:52 -0700509 TRY(compile_expression(env, local, expr, false, Dst));
510 | push eax;
511 | call_extern merge2;
512 | add esp, 8;
513 | push eax;
514 }
515 else
516 {
517 TRY(compile_backquote(env, local, v, Dst));
518 | push eax;
519 | call_extern cons;
520 | add esp, 8;
521
522 // Remove unnecessary pop
523 | push eax;
524 }
swissChili9d151e62021-08-04 13:11:45 -0700525 }
swissChilia89ee442021-08-04 20:54:51 -0700526 | pop eax;
swissChili9d151e62021-08-04 13:11:45 -0700527 }
swissChili6b47b6d2021-06-30 22:08:55 -0700528 }
swissChili6d02af42021-08-05 19:49:01 -0700529
530 OKAY();
swissChili6b47b6d2021-06-30 22:08:55 -0700531}
532
swissChili7e1393c2021-07-07 12:59:12 -0700533value_t eval(struct environment *env, value_t form)
534{
swissChili80560312022-07-31 21:05:47 -0700535 gc_push_segment(&form, 1);
swissChili7e1393c2021-07-07 12:59:12 -0700536 // Eval!
537 value_t function = cons(nil, cons(form, nil));
538
swissChili80560312022-07-31 21:05:47 -0700539 gc_set_retained(0, function);
540
swissChili7e1393c2021-07-07 12:59:12 -0700541 struct local local;
542 struct args *args;
543
swissChili6d02af42021-08-05 19:49:01 -0700544 dasm_State *d;
545 struct error err;
546
547 if (!IS_OKAY((err = compile_function(function, NS_ANONYMOUS, env, &local, NULL,
swissChili8b5ec7a2022-08-05 22:26:17 -0700548 &args, "", "/", &d))))
swissChili6d02af42021-08-05 19:49:01 -0700549 {
550 ereport(err);
551 return nil;
552 }
swissChili7e1393c2021-07-07 12:59:12 -0700553
554 del_local(&local);
555
556 value_t (*f)() = link_program(&d);
swissChili80560312022-07-31 21:05:47 -0700557
swissChili16156be2022-07-31 21:14:02 -0700558 dasm_free(&d);
559 free(args);
560
swissChili80560312022-07-31 21:05:47 -0700561 gc_prepare_call(0);
562 value_t val = f();
563
564 gc_pop_segment();
565
566 return val;
swissChili7e1393c2021-07-07 12:59:12 -0700567}
568
swissChili6d02af42021-08-05 19:49:01 -0700569struct error compile_variable(struct variable *v, dasm_State *Dst)
swissChiliddc97542021-07-04 11:47:42 -0700570{
swissChili6d02af42021-08-05 19:49:01 -0700571 E_INIT();
swissChiliddc97542021-07-04 11:47:42 -0700572 switch (v->type)
573 {
574 case V_ARGUMENT:
swissChili7e1393c2021-07-07 12:59:12 -0700575 | mov eax, dword[ebp + (value_size * (v->number + 2))];
swissChiliddc97542021-07-04 11:47:42 -0700576 break;
577 case V_BOUND:
swissChili7e1393c2021-07-07 12:59:12 -0700578 | mov eax, dword[ebp - ((v->number + 1) * value_size)];
swissChiliddc97542021-07-04 11:47:42 -0700579 break;
580 case V_FREE:
581 // edi is the closure context pointer
swissChili7e1393c2021-07-07 12:59:12 -0700582 | mov eax, dword[edi + (v->number * value_size)];
swissChiliddc97542021-07-04 11:47:42 -0700583 break;
584 default:
swissChili6d02af42021-08-05 19:49:01 -0700585 THROW(EUNIMPL, "Sorry, can only access V_ARGUMENT, V_BOUND, and V_FREE vars");
swissChiliddc97542021-07-04 11:47:42 -0700586 }
swissChili6d02af42021-08-05 19:49:01 -0700587 OKAY();
swissChiliddc97542021-07-04 11:47:42 -0700588}
589
swissChili6d02af42021-08-05 19:49:01 -0700590struct error compile_expression(struct environment *env, struct local *local,
591 value_t val, bool tail, dasm_State **Dst)
swissChili53472e82021-05-08 16:06:32 -0700592{
swissChili6d02af42021-08-05 19:49:01 -0700593 E_INIT();
594
595 NEARVAL(val);
596
swissChili7e1393c2021-07-07 12:59:12 -0700597 if (symstreq(val, "nil") || nilp(val))
swissChili53472e82021-05-08 16:06:32 -0700598 {
599 | mov eax, (nil);
600 }
swissChili923b5362021-05-09 20:31:43 -0700601 else if (symstreq(val, "t"))
602 {
603 | mov eax, (t);
604 }
605 else if (integerp(val) || stringp(val))
swissChilib3ca4fb2021-04-20 10:33:00 -0700606 {
607 | mov eax, val;
608 }
swissChili53472e82021-05-08 16:06:32 -0700609 else if (listp(val))
swissChilib3ca4fb2021-04-20 10:33:00 -0700610 {
swissChili53472e82021-05-08 16:06:32 -0700611 value_t fsym = car(val);
612 value_t args = cdr(val);
613 int nargs = length(args);
swissChilib3ca4fb2021-04-20 10:33:00 -0700614
swissChili53472e82021-05-08 16:06:32 -0700615 if (!symbolp(fsym))
swissChilif3e7f182021-04-20 13:57:22 -0700616 {
swissChili6d02af42021-08-05 19:49:01 -0700617 THROW(EEXPECTED, "Function name must be a symbol");
swissChilif3e7f182021-04-20 13:57:22 -0700618 }
619
swissChili53472e82021-05-08 16:06:32 -0700620 if (symstreq(fsym, "if"))
swissChilib3ca4fb2021-04-20 10:33:00 -0700621 {
swissChili53472e82021-05-08 16:06:32 -0700622 if (nargs < 2 || nargs > 3)
swissChili6d02af42021-08-05 19:49:01 -0700623 {
624 THROW(EARGS, "Must give at least 2 arguments to if");
625 }
swissChilib3ca4fb2021-04-20 10:33:00 -0700626
swissChili6d02af42021-08-05 19:49:01 -0700627 TRY(compile_expression(env, local, car(args), false, Dst));
swissChili53472e82021-05-08 16:06:32 -0700628 int false_label = nextpc(local, Dst),
629 after_label = nextpc(local, Dst);
630
631 // result is in eax
632 | cmp eax, (nil);
swissChili484295d2021-07-09 21:25:55 -0700633 | je =>false_label;
swissChili53472e82021-05-08 16:06:32 -0700634
swissChili6d02af42021-08-05 19:49:01 -0700635 TRY(compile_expression(env, local, elt(args, 1), tail, Dst));
swissChili484295d2021-07-09 21:25:55 -0700636 | jmp =>after_label;
637 |=>false_label:;
swissChili53472e82021-05-08 16:06:32 -0700638 if (nargs == 3)
swissChili6d02af42021-08-05 19:49:01 -0700639 TRY(compile_expression(env, local, elt(args, 2), tail, Dst));
swissChili484295d2021-07-09 21:25:55 -0700640 |=>after_label:;
swissChili53472e82021-05-08 16:06:32 -0700641 }
swissChilia89ee442021-08-04 20:54:51 -0700642 else if (symstreq(fsym, "and") || symstreq(fsym, "or"))
643 {
644 bool or = symstreq(fsym, "or"); // false == and
645
646 // Boolean and and or, short circuit like &&/||
647 if (nargs < 1)
648 {
swissChili6d02af42021-08-05 19:49:01 -0700649 THROW(EARGS, "and & or require at least 1 argument.");
swissChilia89ee442021-08-04 20:54:51 -0700650 }
651
652 int after = nextpc(local, Dst);
653
654 for (; !nilp(args); args = cdr(args))
655 {
swissChili6d02af42021-08-05 19:49:01 -0700656 NEARVAL(args);
657
658 TRY(compile_expression(env, local, car(args), false, Dst));
swissChilia89ee442021-08-04 20:54:51 -0700659 if (!nilp(cdr(args)))
660 {
661 | cmp eax, nil;
662 if (or)
663 {
swissChilifbf525f2021-08-04 21:28:07 -0700664 | jne =>after;
swissChilia89ee442021-08-04 20:54:51 -0700665 }
666 else
667 {
swissChilifbf525f2021-08-04 21:28:07 -0700668 | je =>after;
swissChilia89ee442021-08-04 20:54:51 -0700669 }
670 }
671 }
672
673 |=>after:;
674 }
swissChilif68671f2021-07-05 14:14:44 -0700675 else if (symstreq(fsym, "progn"))
676 {
677 for (value_t val = args; !nilp(val); val = cdr(val))
678 {
swissChili6d02af42021-08-05 19:49:01 -0700679 NEARVAL(args);
680
swissChilib51552c2021-08-03 10:23:37 -0700681 bool t = tail && nilp(cdr(val));
swissChili6d02af42021-08-05 19:49:01 -0700682 TRY(compile_expression(env, local, car(val), t, Dst));
swissChilif68671f2021-07-05 14:14:44 -0700683 }
684 }
swissChili67bdf282021-06-06 18:46:08 -0700685 else if (symstreq(fsym, "let1"))
686 {
687 if (nargs < 2)
688 {
swissChili6d02af42021-08-05 19:49:01 -0700689 THROW(EARGS, "Must give at least 2 arguments to let1");
swissChili67bdf282021-06-06 18:46:08 -0700690 }
691 value_t binding = car(args);
692 value_t rest = cdr(args);
693
swissChili6d02af42021-08-05 19:49:01 -0700694 NEARVAL(binding);
swissChili67bdf282021-06-06 18:46:08 -0700695 if (length(binding) != 2)
696 {
swissChili9d428a82022-08-01 20:47:40 -0700697 printval(args, 0);
swissChili6d02af42021-08-05 19:49:01 -0700698 THROW(EARGS, "Binding list in let1 must contain exactly two entries");
swissChili67bdf282021-06-06 18:46:08 -0700699 }
700
swissChili6d02af42021-08-05 19:49:01 -0700701 NEARVAL(rest);
702
swissChili67bdf282021-06-06 18:46:08 -0700703 value_t name = car(binding);
704 value_t value = car(cdr(binding));
705
swissChili6d02af42021-08-05 19:49:01 -0700706 TRY(compile_expression(env, local, value, false, Dst));
swissChili67bdf282021-06-06 18:46:08 -0700707
708 int i = local_alloc(local);
709
710 add_variable(local, V_BOUND, (char *)(name ^ SYMBOL_TAG), i);
711
swissChili7e1393c2021-07-07 12:59:12 -0700712 | mov dword[ebp - ((i + 1) * value_size)], eax;
swissChili67bdf282021-06-06 18:46:08 -0700713
714 for (; !nilp(rest); rest = cdr(rest))
715 {
swissChilib51552c2021-08-03 10:23:37 -0700716 bool t = tail && nilp(cdr(rest));
swissChili6d02af42021-08-05 19:49:01 -0700717 NEARVAL(rest);
718 TRY(compile_expression(env, local, car(rest), t, Dst));
swissChili67bdf282021-06-06 18:46:08 -0700719 }
720
721 local_free(local, i);
722 }
swissChilie9fec8b2021-06-22 13:59:33 -0700723 else if (symstreq(fsym, "gc"))
724 {
725 if (nargs)
726 {
swissChili6d02af42021-08-05 19:49:01 -0700727 THROW(EARGS, "gc takes no arguments");
swissChilie9fec8b2021-06-22 13:59:33 -0700728 }
729
730 | run_gc;
731 }
swissChili6b47b6d2021-06-30 22:08:55 -0700732 else if (symstreq(fsym, "quote"))
733 {
734 if (nargs != 1)
swissChili6d02af42021-08-05 19:49:01 -0700735 THROW(EARGS, "quote should take exactly 1 argument");
swissChili6b47b6d2021-06-30 22:08:55 -0700736
737 // Simple!
738 | mov eax, (car(args));
739 }
740 else if (symstreq(fsym, "backquote"))
741 {
742 if (nargs != 1)
swissChili6d02af42021-08-05 19:49:01 -0700743 THROW(EARGS, "backquote should take exactly 1 argument");
swissChili6b47b6d2021-06-30 22:08:55 -0700744
swissChili6d02af42021-08-05 19:49:01 -0700745 TRY(compile_backquote(env, local, car(args), Dst));
swissChili6b47b6d2021-06-30 22:08:55 -0700746 }
swissChili74348422021-07-04 13:23:24 -0700747 else if (symstreq(fsym, "function"))
748 {
749 if (nargs != 1)
750 {
swissChili6d02af42021-08-05 19:49:01 -0700751 THROW(EARGS, "function should take exactly 1 argument");
swissChili74348422021-07-04 13:23:24 -0700752 }
753
swissChili6d02af42021-08-05 19:49:01 -0700754 NEARVAL(args);
swissChili74348422021-07-04 13:23:24 -0700755 if (!symbolp(car(args)))
756 {
swissChili6d02af42021-08-05 19:49:01 -0700757 THROW(EINVALID, "argument to function should be a symbol resolvable at "
swissChili7e1393c2021-07-07 12:59:12 -0700758 "compile time");
swissChili74348422021-07-04 13:23:24 -0700759 }
760
swissChilia89ee442021-08-04 20:54:51 -0700761 char *name = (char *)(car(args) ^ SYMBOL_TAG);
swissChili74348422021-07-04 13:23:24 -0700762
swissChilia89ee442021-08-04 20:54:51 -0700763 if (!strcmp(name, local->current_function_name))
764 {
765 | push 0;
766 | push local->args;
767 | push <1;
768 | call_extern create_closure;
769 }
770 else
771 {
772 struct function *f = find_function(env, name);
773
774 if (!f)
775 {
swissChili6d02af42021-08-05 19:49:01 -0700776 THROW(EINVALID, "Function `%s' does not exist", (char *)(car(args) ^ SYMBOL_TAG));
swissChilia89ee442021-08-04 20:54:51 -0700777 }
778 value_t closure = create_closure(f->code_ptr, f->args, 0);
779 | mov eax, (closure);
780 }
swissChili74348422021-07-04 13:23:24 -0700781 }
swissChili6b47b6d2021-06-30 22:08:55 -0700782 else if (symstreq(fsym, "list"))
783 {
swissChili484295d2021-07-09 21:25:55 -0700784 | push (nil);
swissChili6b47b6d2021-06-30 22:08:55 -0700785
786 for (int i = nargs - 1; i >= 0; i--)
787 {
swissChili6d02af42021-08-05 19:49:01 -0700788 TRY(compile_expression(env, local, elt(args, i), false, Dst));
swissChili6b47b6d2021-06-30 22:08:55 -0700789
swissChili6b47b6d2021-06-30 22:08:55 -0700790 | push eax;
swissChili53e7cd12021-08-02 21:55:53 -0700791 | call_extern cons;
swissChili6b47b6d2021-06-30 22:08:55 -0700792 | add esp, (2 * value_size);
swissChili6b47b6d2021-06-30 22:08:55 -0700793 | push eax;
794 }
swissChili6d02af42021-08-05 19:49:01 -0700795 | pop eax;
swissChili6b47b6d2021-06-30 22:08:55 -0700796 }
swissChiliddc97542021-07-04 11:47:42 -0700797 else if (symstreq(fsym, "lambda"))
798 {
799 // Compile the function with this as the parent scope
800 struct local new_local;
swissChilic0acce42022-07-31 13:38:17 -0700801 struct args *nargs_out;
swissChili6d02af42021-08-05 19:49:01 -0700802 dasm_State *d;
803 TRY(compile_function(
804 args, NS_ANONYMOUS, env, &new_local, local, &nargs_out,
805 "recurse", local->current_file_path, &d));
swissChiliddc97542021-07-04 11:47:42 -0700806
807 // Link the function
swissChilif68671f2021-07-05 14:14:44 -0700808 void *func_ptr = link_program(&d);
swissChiliddc97542021-07-04 11:47:42 -0700809
810 // Create a closure object with the correct number of captures at
811 // runtime
swissChili484295d2021-07-09 21:25:55 -0700812 | push (new_local.num_closure_slots);
813 | push (nargs_out);
814 | push (func_ptr);
swissChili53e7cd12021-08-02 21:55:53 -0700815 | call_extern create_closure;
swissChiliddc97542021-07-04 11:47:42 -0700816 | add esp, 12;
817
818 // Walk the generated local scope for V_FREE variables, since each
819 // of these exists in our scope (or higher), evaluate it and set it
820 // as a member of the lambda capture.
821
822 for (struct variable *var = new_local.first; var; var = var->prev)
823 {
824 if (var->type == V_FREE)
825 {
826 // Closure in eax
827 | push eax;
828 // Variable now in eax
swissChili6d02af42021-08-05 19:49:01 -0700829 TRY(compile_variable(find_variable(local, var->name), Dst));
swissChiliddc97542021-07-04 11:47:42 -0700830 | push eax;
831
swissChiliddc97542021-07-04 11:47:42 -0700832 // The capture offset
swissChili484295d2021-07-09 21:25:55 -0700833 | push (var->number);
swissChili53e7cd12021-08-02 21:55:53 -0700834 | call_extern set_closure_capture_variable;
swissChiliddc97542021-07-04 11:47:42 -0700835 // Skip the value and index
836 | add esp, 8;
837 // Pop the closure back in to eax
838 | pop eax;
839 }
840 }
841
842 // Closure is still in eax
843
844 dasm_free(&d);
swissChili708d4c42021-07-04 17:40:07 -0700845 del_local(&new_local);
swissChiliddc97542021-07-04 11:47:42 -0700846 }
swissChili7e1393c2021-07-07 12:59:12 -0700847 else if (symstreq(fsym, "eval"))
848 {
849 if (nargs != 1)
850 {
swissChili6d02af42021-08-05 19:49:01 -0700851 THROW(EARGS, "eval takes exactly 1 argument");
swissChili7e1393c2021-07-07 12:59:12 -0700852 }
853
swissChili6d02af42021-08-05 19:49:01 -0700854 TRY(compile_expression(env, local, car(args), false, Dst));
swissChili7e1393c2021-07-07 12:59:12 -0700855 | push eax;
swissChili484295d2021-07-09 21:25:55 -0700856 | push (env);
swissChili53e7cd12021-08-02 21:55:53 -0700857 | call_extern eval;
swissChili7e1393c2021-07-07 12:59:12 -0700858 }
859 else if (symstreq(fsym, "load"))
860 {
861 if (nargs != 1)
862 {
swissChili6d02af42021-08-05 19:49:01 -0700863 THROW(EARGS, "load takes exactly 1 argument, %d given", nargs);
swissChili7e1393c2021-07-07 12:59:12 -0700864 }
865
swissChili6d02af42021-08-05 19:49:01 -0700866 TRY(compile_expression(env, local, car(args), false, Dst));
swissChili7e1393c2021-07-07 12:59:12 -0700867 | push eax;
swissChili484295d2021-07-09 21:25:55 -0700868 | push (local->current_file_path);
869 | push (env);
swissChili53e7cd12021-08-02 21:55:53 -0700870 | call_extern load_relative;
swissChili7e1393c2021-07-07 12:59:12 -0700871 }
swissChili53472e82021-05-08 16:06:32 -0700872 else
873 {
swissChili74348422021-07-04 13:23:24 -0700874 char *name = (char *)(fsym ^ SYMBOL_TAG);
875 struct function *func = find_function(env, name);
swissChili7e1393c2021-07-07 12:59:12 -0700876
swissChili74348422021-07-04 13:23:24 -0700877 bool is_recursive = false;
swissChili15f1cae2021-07-05 19:08:47 -0700878 struct args *nargs_needed = NULL;
swissChili53472e82021-05-08 16:06:32 -0700879
swissChili53e7cd12021-08-02 21:55:53 -0700880 // The number of arguments actually passed on the stack,
881 // i.e. all varargs are 1.
swissChilib51552c2021-08-03 10:23:37 -0700882 int real_nargs;
swissChili53e7cd12021-08-02 21:55:53 -0700883
swissChili7e1393c2021-07-07 12:59:12 -0700884 if (local->current_function_name &&
885 symstreq(fsym, local->current_function_name))
swissChilif1ba8c12021-07-02 18:45:38 -0700886 {
swissChili74348422021-07-04 13:23:24 -0700887 is_recursive = true;
swissChili15f1cae2021-07-05 19:08:47 -0700888 nargs_needed = local->args;
swissChili74348422021-07-04 13:23:24 -0700889 }
890 else
891 {
892 if (func == NULL)
893 {
swissChili6d02af42021-08-05 19:49:01 -0700894 THROW(EINVALID, "Function %s undefined", name);
swissChili74348422021-07-04 13:23:24 -0700895 }
896
swissChili15f1cae2021-07-05 19:08:47 -0700897 nargs_needed = func->args;
swissChili74348422021-07-04 13:23:24 -0700898 }
899
swissChili15f1cae2021-07-05 19:08:47 -0700900 if (!are_args_acceptable(nargs_needed, nargs))
swissChili74348422021-07-04 13:23:24 -0700901 {
swissChili6d02af42021-08-05 19:49:01 -0700902 THROW(EARGS,
903 "wrong number of args in function call: %s, "
904 "want %d args but given %d\n",
905 name, nargs_needed->num_required, nargs);
swissChilif1ba8c12021-07-02 18:45:38 -0700906 }
swissChili53472e82021-05-08 16:06:32 -0700907
swissChili53e7cd12021-08-02 21:55:53 -0700908 int total_taken = nargs_needed->num_optional +
909 nargs_needed->num_required;
910
swissChilib51552c2021-08-03 10:23:37 -0700911 real_nargs = total_taken + (nargs_needed->variadic ? 1 : 0);
swissChili53e7cd12021-08-02 21:55:53 -0700912
swissChili74348422021-07-04 13:23:24 -0700913 if (is_recursive || func->namespace == NS_FUNCTION)
swissChili53472e82021-05-08 16:06:32 -0700914 {
swissChili15f1cae2021-07-05 19:08:47 -0700915 int nargs = length(args);
916
swissChili484295d2021-07-09 21:25:55 -0700917 int line = cons_line(val);
918 char *file = cons_file(val);
919
920 if (nargs_needed->variadic)
swissChili15f1cae2021-07-05 19:08:47 -0700921 {
swissChili484295d2021-07-09 21:25:55 -0700922 | push (nil);
923 }
924
925 if (nargs > total_taken && nargs_needed->variadic)
926 {
927 // We are passing varargs, which means we need to make a list
928
929 for (int i = nargs - 1; i >= total_taken; i--)
930 {
swissChili6d02af42021-08-05 19:49:01 -0700931 TRY(compile_expression(env, local, elt(args, i), false, Dst));
swissChili484295d2021-07-09 21:25:55 -0700932 | push eax;
swissChili53e7cd12021-08-02 21:55:53 -0700933 | call_extern cons;
swissChili484295d2021-07-09 21:25:55 -0700934 | add esp, 8;
935 | push eax;
936 }
swissChili15f1cae2021-07-05 19:08:47 -0700937 }
938
swissChili7e1393c2021-07-07 12:59:12 -0700939 for (int i = nargs_needed->num_optional - 1;
940 i >= nargs - nargs_needed->num_required; i--)
swissChili15f1cae2021-07-05 19:08:47 -0700941 {
942 // Push the default optional values
swissChili484295d2021-07-09 21:25:55 -0700943 | push (nargs_needed->optional_arguments[i].value);
swissChili15f1cae2021-07-05 19:08:47 -0700944 }
945
swissChili484295d2021-07-09 21:25:55 -0700946 int min = MIN(nargs, total_taken);
947
948 for (int i = min - 1; i >= 0; i--)
swissChili2999dd12021-07-02 14:19:53 -0700949 {
swissChili6d02af42021-08-05 19:49:01 -0700950 TRY(compile_expression(env, local, elt(args, i), false, Dst));
swissChili2999dd12021-07-02 14:19:53 -0700951 | push eax;
952 }
swissChili15f1cae2021-07-05 19:08:47 -0700953
swissChili74348422021-07-04 13:23:24 -0700954 if (is_recursive)
955 {
swissChilib51552c2021-08-03 10:23:37 -0700956 if (tail)
957 {
958 // Move all the arguments pushed to the stack
959 // back up to the argument bit of the stack.
960
961 for (int i = 0; i < real_nargs; i++)
962 {
963 | pop eax;
964 | mov dword[ebp + (value_size * (i + 2))], eax;
965 }
966
967 // Jmp back to start
968 | mov esp, ebp;
969 | pop ebp;
970 | jmp <1;
971 }
972 else
973 {
974 | call <1;
975 }
swissChili74348422021-07-04 13:23:24 -0700976 }
977 else
978 {
swissChili484295d2021-07-09 21:25:55 -0700979 // | mov ebx, (func->code_addr);
980 | call_extern func->code_addr;
swissChili74348422021-07-04 13:23:24 -0700981 }
swissChili53e7cd12021-08-02 21:55:53 -0700982 | add esp, (real_nargs * value_size);
swissChili2999dd12021-07-02 14:19:53 -0700983 // result in eax
984 }
985 else if (func->namespace == NS_MACRO)
986 {
swissChili7e1393c2021-07-07 12:59:12 -0700987 // Make sure that the stuff allocated by the macro isn't in a
988 // pool
swissChilif68671f2021-07-05 14:14:44 -0700989 unsigned char pool = push_pool(0);
990
swissChili2999dd12021-07-02 14:19:53 -0700991 value_t expanded_to = call_list(func, args);
992
swissChilif68671f2021-07-05 14:14:44 -0700993 pop_pool(pool);
994
swissChili6d02af42021-08-05 19:49:01 -0700995 TRY(compile_expression(env, local, expanded_to, false, Dst));
swissChili2999dd12021-07-02 14:19:53 -0700996 }
swissChili53472e82021-05-08 16:06:32 -0700997 }
swissChilib3ca4fb2021-04-20 10:33:00 -0700998 }
swissChili923b5362021-05-09 20:31:43 -0700999 else if (symbolp(val))
1000 {
swissChili7e1393c2021-07-07 12:59:12 -07001001 if (symstreq(val, "+current-file+"))
swissChilie9fec8b2021-06-22 13:59:33 -07001002 {
swissChili7e1393c2021-07-07 12:59:12 -07001003 value_t file_name_val = strval(local->current_file_path);
1004
1005 | mov eax, (file_name_val);
swissChilie9fec8b2021-06-22 13:59:33 -07001006 }
swissChili04d94162022-07-30 21:46:49 -07001007 else if (symstreq(val, "+current-env+"))
1008 {
1009 // TODO: we return this as a raw "integer", which is a bad
1010 // idea. Once classes are added this needs to be wrapped
1011 // in a class.
1012 | mov eax, (env);
1013 }
swissChili7e1393c2021-07-07 12:59:12 -07001014 else
1015 {
1016 struct variable *v =
1017 find_variable(local, (char *)(val ^ SYMBOL_TAG));
swissChili923b5362021-05-09 20:31:43 -07001018
swissChili7e1393c2021-07-07 12:59:12 -07001019 if (!v)
1020 {
swissChili6d02af42021-08-05 19:49:01 -07001021 THROW(EINVALID, "Variable `%s' unbound", (char *)(val ^ SYMBOL_TAG));
swissChili7e1393c2021-07-07 12:59:12 -07001022 }
1023
swissChili6d02af42021-08-05 19:49:01 -07001024 TRY(compile_variable(v, Dst));
swissChili7e1393c2021-07-07 12:59:12 -07001025 }
swissChili923b5362021-05-09 20:31:43 -07001026 }
swissChilia89ee442021-08-04 20:54:51 -07001027 else if (closurep(val))
1028 {
1029 | mov eax, val;
1030 }
1031 else
1032 {
1033 printval(val, 1);
swissChili6d02af42021-08-05 19:49:01 -07001034 THROW(EUNIMPL, "Don't know how to compile this, sorry.");
swissChilia89ee442021-08-04 20:54:51 -07001035 }
swissChili6d02af42021-08-05 19:49:01 -07001036
1037 OKAY();
swissChilib3ca4fb2021-04-20 10:33:00 -07001038}
swissChilif3e7f182021-04-20 13:57:22 -07001039
swissChili923b5362021-05-09 20:31:43 -07001040struct variable *add_variable(struct local *local, enum var_type type,
1041 char *name, int number)
1042{
1043 struct variable *var = malloc(sizeof(struct variable));
1044 var->prev = local->first;
1045 var->type = type;
1046 var->name = name;
1047 var->number = number;
1048
1049 local->first = var;
1050
1051 return var;
1052}
1053
1054void destroy_local(struct local *local)
1055{
1056 for (struct variable *v = local->first; v;)
1057 {
1058 struct variable *t = v;
1059 v = v->prev;
1060 free(t);
1061 }
1062}
1063
1064struct variable *find_variable(struct local *local, char *name)
1065{
1066 struct variable *v = local->first;
1067
1068 for (; v && strcmp(v->name, name) != 0; v = v->prev)
swissChili7e1393c2021-07-07 12:59:12 -07001069 {
1070 }
swissChili923b5362021-05-09 20:31:43 -07001071
swissChiliddc97542021-07-04 11:47:42 -07001072 if (!v)
1073 {
1074 if (local->parent)
1075 {
1076 v = find_variable(local->parent, name);
1077
1078 if (v)
1079 {
swissChili15f1cae2021-07-05 19:08:47 -07001080 // We found this in a parent scope, add it as a V_FREE variable
1081 // to skip the search.
swissChili7e1393c2021-07-07 12:59:12 -07001082 v = add_variable(local, V_FREE, name,
1083 local->num_closure_slots++);
swissChiliddc97542021-07-04 11:47:42 -07001084 }
1085 }
1086 }
swissChili923b5362021-05-09 20:31:43 -07001087 return v;
1088}
swissChili2999dd12021-07-02 14:19:53 -07001089
swissChiliddc97542021-07-04 11:47:42 -07001090extern value_t _call_list(void *addr, value_t list, value_t *edi);
swissChili2999dd12021-07-02 14:19:53 -07001091
swissChili7e1393c2021-07-07 12:59:12 -07001092value_t call_list_args(void *code_ptr, struct args *args, value_t list,
1093 void *data)
swissChili2999dd12021-07-02 14:19:53 -07001094{
swissChili15f1cae2021-07-05 19:08:47 -07001095 list = deep_copy(list);
swissChili484295d2021-07-09 21:25:55 -07001096
swissChili15f1cae2021-07-05 19:08:47 -07001097 int nargs = length(list);
1098
swissChili484295d2021-07-09 21:25:55 -07001099 value_t *val = &list;
swissChili15f1cae2021-07-05 19:08:47 -07001100
1101 for (value_t i = list; !nilp(i); i = cdr(i))
1102 {
1103 val = cdrref(i);
1104 }
1105
1106 int total_required = args->num_required + args->num_optional;
1107
1108 if (nargs > total_required)
1109 {
1110 // Take the remainder of the list and put it as the last item in the
1111 // list.
1112 value_t trailing = cxdr(list, total_required);
1113 value_t last_item = cons(trailing, nil);
1114
1115 *cxdrref(&list, total_required) = last_item;
1116 }
1117 else if (nargs < total_required)
1118 {
1119 for (int i = nargs - args->num_required; i < args->num_optional; i++)
1120 {
1121 // Append the i-th defualt argument
1122 value_t appended = cons(args->optional_arguments[i].value, nil);
1123 *val = appended;
1124 val = cdrref(appended);
1125 }
1126 }
1127
1128 // We want to call this if we pass the correct # of arguments or less, just
1129 // not if we have already passed varargs. Appends a nil argument.
1130 if (nargs <= total_required)
1131 {
1132 // Enough real arguments but no variadic arguments. Pass a nil list.
1133 *val = cons(nil, nil);
1134 }
1135
1136 return _call_list(code_ptr, list, data);
1137}
1138
1139value_t call_list(struct function *fun, value_t list)
1140{
1141 return call_list_args(fun->code_ptr, fun->args, list, NULL);
swissChiliddc97542021-07-04 11:47:42 -07001142}
1143
1144value_t call_list_closure(struct closure *c, value_t list)
1145{
swissChili15f1cae2021-07-05 19:08:47 -07001146 return call_list_args(c->function, c->args, list, c->data);
1147}
1148
1149struct args *new_args()
1150{
1151 struct args *a = malloc(sizeof(struct args));
1152 a->num_optional = 0;
1153 a->num_required = 0;
1154 a->variadic = false;
1155
1156 return a;
1157}
1158
swissChili7e1393c2021-07-07 12:59:12 -07001159struct args *add_optional_arg(struct args *args, value_t name, value_t value)
swissChili15f1cae2021-07-05 19:08:47 -07001160{
1161 int i = args->num_optional++;
swissChili7e1393c2021-07-07 12:59:12 -07001162 args =
1163 realloc(args, sizeof(struct args) + sizeof(struct optional_argument) *
1164 args->num_optional);
swissChili15f1cae2021-07-05 19:08:47 -07001165
swissChili7e1393c2021-07-07 12:59:12 -07001166 args->optional_arguments[i] = (struct optional_argument){
1167 .value = value,
1168 .name = name,
swissChili15f1cae2021-07-05 19:08:47 -07001169 };
1170
1171 return args;
1172}
1173
1174bool are_args_acceptable(struct args *args, int number)
1175{
1176 if (args->variadic)
1177 {
1178 return number >= args->num_required;
1179 }
1180 else
1181 {
1182 return number >= args->num_required &&
swissChili7e1393c2021-07-07 12:59:12 -07001183 number <= args->num_required + args->num_optional;
swissChili15f1cae2021-07-05 19:08:47 -07001184 }
1185}
1186
swissChili6d02af42021-08-05 19:49:01 -07001187struct error list_to_args(struct environment *env, value_t list,
1188 struct local *local, struct args **a)
swissChili15f1cae2021-07-05 19:08:47 -07001189{
swissChili6d02af42021-08-05 19:49:01 -07001190 E_INIT();
1191
swissChili15f1cae2021-07-05 19:08:47 -07001192 struct args *args = new_args();
1193
1194 bool in_optional = false;
1195
1196 for (value_t i = list; !nilp(i); i = cdr(i))
1197 {
1198 value_t val = car(i);
swissChili6d02af42021-08-05 19:49:01 -07001199 NEARVAL(i);
1200
swissChili15f1cae2021-07-05 19:08:47 -07001201 if (symbolp(val))
1202 {
1203 if (!args->variadic && symstreq(val, "&"))
1204 {
1205 i = cdr(i);
1206 value_t name = car(i);
1207
1208 if (!symbolp(name))
1209 {
swissChili6d02af42021-08-05 19:49:01 -07001210 THROW(EEXPECTED, "You must provide a symbol after & in an argument list "
1211 "to bind the\n"
1212 "variadic arguments to.");
swissChili15f1cae2021-07-05 19:08:47 -07001213 }
1214
1215 args->variadic = true;
1216
1217 add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG),
swissChili7e1393c2021-07-07 12:59:12 -07001218 args->num_optional + args->num_required);
swissChili15f1cae2021-07-05 19:08:47 -07001219
1220 continue;
1221 }
1222
1223 if (!in_optional)
1224 {
swissChili7e1393c2021-07-07 12:59:12 -07001225 add_variable(local, V_ARGUMENT, (char *)(val ^ SYMBOL_TAG),
1226 args->num_required++);
swissChili15f1cae2021-07-05 19:08:47 -07001227 }
1228 else
1229 {
1230 char *name = (char *)(val ^ SYMBOL_TAG);
1231 if (name[0] == '&')
1232 {
swissChili6d02af42021-08-05 19:49:01 -07001233 THROW(EINVALID, "Non-optional argument following optional arguments "
1234 "starts with a &\n"
1235 "did you mean to declare a variadic argument? If so "
1236 "leave a space\n"
1237 "between the & and name.");
swissChili15f1cae2021-07-05 19:08:47 -07001238 }
1239 else
1240 {
swissChili6d02af42021-08-05 19:49:01 -07001241 THROW(EINVALID, "Cannot define a non-optional argument after an "
1242 "optional one.");
swissChili15f1cae2021-07-05 19:08:47 -07001243 }
1244 }
1245 }
1246 else if (listp(val))
1247 {
swissChili6d02af42021-08-05 19:49:01 -07001248 NEARVAL(val);
1249
swissChili15f1cae2021-07-05 19:08:47 -07001250 in_optional = true;
1251 int len = length(val);
1252
1253 if (len != 2)
1254 {
swissChili6d02af42021-08-05 19:49:01 -07001255 THROW(EINVALID, "A list defining an optional value must be structured like "
1256 "(name expr)\n"
1257 "with exactly two arguments.");
swissChili15f1cae2021-07-05 19:08:47 -07001258 }
1259
1260 value_t name = car(val);
1261 value_t expr = car(cdr(val));
1262
1263 value_t function = cons(nil, cons(expr, nil));
1264
swissChili6d02af42021-08-05 19:49:01 -07001265 dasm_State *d;
1266 TRY(compile_function(function, NS_ANONYMOUS, env, NULL, NULL, NULL,
1267 NULL, local->current_file_path, &d));
swissChili15f1cae2021-07-05 19:08:47 -07001268
1269 // TODO: GC stack top!
1270 value_t (*compiled)() = link_program(&d);
1271
1272 value_t value = compiled();
1273 args = add_optional_arg(args, name, value);
1274
swissChili7e1393c2021-07-07 12:59:12 -07001275 add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG),
1276 args->num_required + args->num_optional - 1);
swissChilic0acce42022-07-31 13:38:17 -07001277
1278 dasm_free(&d);
swissChili15f1cae2021-07-05 19:08:47 -07001279 }
1280 }
1281
swissChili6d02af42021-08-05 19:49:01 -07001282 *a = args;
1283 OKAY();
swissChili15f1cae2021-07-05 19:08:47 -07001284}
1285
1286void display_args(struct args *args)
1287{
1288 printf("Args object taking %d require arguments and %d optionals:\n",
swissChili7e1393c2021-07-07 12:59:12 -07001289 args->num_required, args->num_optional);
swissChili15f1cae2021-07-05 19:08:47 -07001290
1291 for (int i = 0; i < args->num_optional; i++)
1292 {
swissChili7e1393c2021-07-07 12:59:12 -07001293 printf(" %d\t%s\n", i,
1294 (char *)(args->optional_arguments[i].name ^ SYMBOL_TAG));
swissChili15f1cae2021-07-05 19:08:47 -07001295 printval(args->optional_arguments[i].value, 2);
1296 }
swissChili2999dd12021-07-02 14:19:53 -07001297}