swissChili | 8cfb7c4 | 2021-04-18 21:17:58 -0700 | [diff] [blame] | 1 | /* -*- mode:c -*- */ |
| 2 | |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 3 | #include "compiler.h" |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 4 | #include "gc.h" |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 5 | #include "lib/std.h" |
| 6 | #include "lisp.h" |
| 7 | #include "plat/plat.h" |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 8 | |
| 9 | #include <dasm_proto.h> |
| 10 | #include <dasm_x86.h> |
| 11 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 12 | #include <libgen.h> |
| 13 | #include <stdio.h> |
swissChili | 923b536 | 2021-05-09 20:31:43 -0700 | [diff] [blame] | 14 | #include <stdlib.h> |
| 15 | #include <string.h> |
| 16 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 17 | #define value_size sizeof(value_t) |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 18 | |
| 19 | |.arch x86; |
| 20 | |
| 21 | |.macro setup, nvars; |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 22 | |1:; |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 23 | | push ebp; |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 24 | | mov ebp, esp; |
swissChili | 8cfb7c4 | 2021-04-18 21:17:58 -0700 | [diff] [blame] | 25 | | sub esp, (value_size * nvars); |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 26 | |.endmacro; |
| 27 | |
| 28 | |.macro cleanup; |
| 29 | | mov esp, ebp; |
| 30 | | pop ebp; |
| 31 | | ret; |
| 32 | |.endmacro; |
| 33 | |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 34 | |.macro call_extern, address; |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 35 | | call &address; |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 36 | |.endmacro; |
| 37 | |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 38 | dasm_State *d; |
| 39 | unsigned int npc = 8; |
| 40 | |
swissChili | 9e57da4 | 2021-06-15 22:22:46 -0700 | [diff] [blame] | 41 | |.macro run_gc; |
swissChili | e9fec8b | 2021-06-22 13:59:33 -0700 | [diff] [blame] | 42 | | mov eax, esp; |
swissChili | 9e57da4 | 2021-06-15 22:22:46 -0700 | [diff] [blame] | 43 | | push ebp; |
swissChili | e9fec8b | 2021-06-22 13:59:33 -0700 | [diff] [blame] | 44 | | push eax; |
swissChili | 9e57da4 | 2021-06-15 22:22:46 -0700 | [diff] [blame] | 45 | | mov eax, _do_gc; |
| 46 | | call eax; |
| 47 | |.endmacro; |
swissChili | 6d6525e | 2021-06-15 21:20:53 -0700 | [diff] [blame] | 48 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 49 | struct function *find_function(struct environment *env, char *name) |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 50 | { |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 51 | struct function *f; |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 52 | |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 53 | for (f = env->first; f && strcmp(f->name, name); f = f->prev) |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 54 | { |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 55 | } |
| 56 | |
| 57 | return f; |
| 58 | } |
| 59 | |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 60 | unsigned 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; |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 77 | local->stack_slots = |
| 78 | realloc(local->stack_slots, local->num_stack_slots * sizeof(bool)); |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 79 | // 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 | |
| 86 | void local_free(struct local *local, unsigned int slot) |
| 87 | { |
| 88 | local->stack_slots[slot] = false; |
| 89 | } |
| 90 | |
swissChili | 708d4c4 | 2021-07-04 17:40:07 -0700 | [diff] [blame] | 91 | void 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 | |
| 102 | void 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 | } |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 110 | |
| 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 | } |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 117 | |
| 118 | free(env); |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 119 | } |
| 120 | |
| 121 | void 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; |
swissChili | 708d4c4 | 2021-07-04 17:40:07 -0700 | [diff] [blame] | 132 | } |
| 133 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 134 | struct error compile_function(value_t args, enum namespace namespace, |
| 135 | struct environment *env, |
| 136 | struct local *local_out, |
| 137 | struct local *local_parent, |
| 138 | struct args **args_out, char *name, |
| 139 | char *path, |
| 140 | dasm_State **state) |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 141 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 142 | E_INIT(); |
| 143 | |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 144 | dasm_State *d; |
| 145 | dasm_State **Dst = &d; |
| 146 | |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 147 | |.section code, imports; |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 148 | dasm_init(&d, DASM_MAXSECTION); |
| 149 | |
| 150 | |.globals lbl_; |
| 151 | void *labels[lbl__MAX]; |
| 152 | dasm_setupglobal(&d, labels, lbl__MAX); |
| 153 | |
| 154 | |.actionlist lisp_actions; |
| 155 | dasm_setup(&d, lisp_actions); |
| 156 | |
| 157 | struct local local; |
| 158 | local.parent = NULL; |
| 159 | local.first = NULL; |
| 160 | local.num_vars = 0; |
| 161 | local.npc = 8; |
| 162 | local.nextpc = 0; |
| 163 | local.stack_slots = malloc(sizeof(bool) * 4); |
| 164 | memset(local.stack_slots, 0, sizeof(bool) * 4); |
| 165 | local.num_stack_slots = 4; |
| 166 | local.num_stack_entries = 0; |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 167 | local.num_closure_slots = 0; |
| 168 | local.parent = local_parent; |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 169 | local.current_function_name = name; |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 170 | local.current_file_path = path; |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 171 | |
| 172 | dasm_growpc(&d, local.npc); |
| 173 | |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 174 | value_t arglist = car(args); |
| 175 | value_t body = cdr(args); |
| 176 | |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 177 | // This will add the arguments to local too. |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 178 | struct args *ar; |
| 179 | TRY(list_to_args(env, arglist, &local, &ar)); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 180 | local.args = ar; |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 181 | |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 182 | if (!ar) |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 183 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 184 | NEARVAL(arglist); |
| 185 | THROW(EMALFORMED, "Malformed argument list"); |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 186 | } |
| 187 | |
| 188 | for (value_t body_ = body; !nilp(body_); body_ = cdr(body_)) |
| 189 | { |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 190 | TRY(walk_and_alloc(env, &local, carref(body_))); |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 191 | } |
| 192 | |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 193 | | setup (local.num_stack_entries); |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 194 | |
| 195 | memset(local.stack_slots, 0, local.num_stack_slots * sizeof(bool)); |
| 196 | local.num_stack_entries = 0; |
| 197 | |
| 198 | for (; !nilp(body); body = cdr(body)) |
| 199 | { |
swissChili | b51552c | 2021-08-03 10:23:37 -0700 | [diff] [blame] | 200 | bool tail = nilp(cdr(body)); |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 201 | TRY(compile_expression(env, &local, car(body), tail, Dst)); |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 202 | } |
| 203 | |
| 204 | | cleanup; |
| 205 | |
| 206 | if (local_out) |
| 207 | *local_out = local; |
| 208 | |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 209 | if (args_out) |
| 210 | *args_out = ar; |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 211 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 212 | *state = d; |
| 213 | |
| 214 | OKAY(); |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 215 | } |
| 216 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 217 | struct error compile_tl(value_t val, struct environment *env, char *fname) |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 218 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 219 | E_INIT(); |
| 220 | |
| 221 | NEARVAL(val); |
| 222 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 223 | if (!listp(val)) |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 224 | { |
| 225 | THROW(EEXPECTED, "Top level form must be a list"); |
| 226 | } |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 227 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 228 | value_t form = car(val); |
| 229 | value_t args = cdr(val); |
| 230 | |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 231 | if (symstreq(form, "defun") || symstreq(form, "defmacro")) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 232 | { |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 233 | enum namespace namespace = NS_FUNCTION; |
| 234 | |
| 235 | if (symstreq(form, "defmacro")) |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 236 | namespace = NS_MACRO; |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 237 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 238 | struct local local; |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 239 | struct args *a; |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 240 | char *name = (char *)(car(args) ^ SYMBOL_TAG); |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 241 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 242 | dasm_State *d; |
| 243 | TRY(compile_function(cdr(args), namespace, env, &local, |
| 244 | NULL, &a, name, fname, &d)); |
swissChili | a820dea | 2021-05-09 16:46:55 -0700 | [diff] [blame] | 245 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 246 | add_function(env, name, link_program(&d), a, namespace); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 247 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 248 | dasm_free(&d); |
swissChili | 708d4c4 | 2021-07-04 17:40:07 -0700 | [diff] [blame] | 249 | del_local(&local); |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 250 | } |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 251 | else if (symstreq(form, "progn")) |
| 252 | { |
| 253 | for (value_t val = args; !nilp(val); val = cdr(val)) |
| 254 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 255 | TRY(compile_tl(car(val), env, fname)); |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 256 | } |
| 257 | } |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 258 | else if (symstreq(form, "load")) |
| 259 | { |
| 260 | if (length(args) != 1) |
| 261 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 262 | NEARVAL(args); |
| 263 | THROW(EARGS, "load expects exactly 1 argument, %d given", |
| 264 | length(args)); |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 265 | } |
| 266 | load_relative(env, fname, car(args)); |
| 267 | } |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 268 | |
| 269 | OKAY(); |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 270 | } |
| 271 | |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 272 | struct error walk_and_alloc(struct environment *env, struct local *local, value_t *bp) |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 273 | { |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 274 | E_INIT(); |
| 275 | |
| 276 | value_t body = *bp; |
| 277 | |
swissChili | b51552c | 2021-08-03 10:23:37 -0700 | [diff] [blame] | 278 | // TODO: handle macros |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 279 | if (!listp(body)) |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 280 | OKAY(); |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 281 | |
| 282 | value_t args = cdr(body); |
| 283 | |
| 284 | if (symstreq(car(body), "let1")) |
| 285 | { |
| 286 | int slot = local_alloc(local); |
| 287 | |
| 288 | value_t expr = cdr(args); |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 289 | for (; !nilp(expr); expr = cdr(expr)) |
| 290 | { |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 291 | walk_and_alloc(env, local, carref(expr)); |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 292 | } |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 293 | |
| 294 | local_free(local, slot); |
| 295 | } |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 296 | else if (symstreq(car(body), "lambda")) |
| 297 | { |
| 298 | // We don't want to walk the lambda because it's another function. When |
| 299 | // the lambda is compiled it will be walked. |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 300 | OKAY(); |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 301 | } |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 302 | else |
| 303 | { |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 304 | // Is this a macro? |
| 305 | |
| 306 | struct function *mac = NULL; |
| 307 | |
| 308 | if (symbolp(car(body))) |
| 309 | mac = find_function(env, (char *)(car(body) ^ SYMBOL_TAG)); |
| 310 | else |
| 311 | walk_and_alloc(env, local, carref(body)); |
| 312 | |
| 313 | if (mac && mac->namespace == NS_MACRO) |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 314 | { |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 315 | unsigned char pool = push_pool(0); |
| 316 | value_t form = call_list(mac, args); |
| 317 | pop_pool(pool); |
| 318 | |
| 319 | add_to_pool(form); |
| 320 | *bp = form; |
| 321 | |
| 322 | walk_and_alloc(env, local, bp); |
| 323 | } |
| 324 | else |
| 325 | { |
| 326 | for (; !nilp(args); args = cdr(args)) |
| 327 | { |
| 328 | walk_and_alloc(env, local, carref(args)); |
| 329 | } |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 330 | } |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 331 | } |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 332 | |
| 333 | OKAY(); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 334 | } |
| 335 | |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 336 | bool load(struct environment *env, char *path) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 337 | { |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 338 | if (!file_exists(path)) |
| 339 | return false; |
| 340 | |
| 341 | add_load(env, path); |
| 342 | |
swissChili | b8fd471 | 2021-06-23 15:32:04 -0700 | [diff] [blame] | 343 | unsigned char pool = make_pool(); |
| 344 | unsigned char pop = push_pool(pool); |
| 345 | |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 346 | struct istream *is = new_fistream(path, false); |
| 347 | if (!is) |
| 348 | return false; |
| 349 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 350 | value_t val; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 351 | |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 352 | struct error read_error; |
| 353 | |
| 354 | while (IS_OKAY((read_error = read1(is, &val)))) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 355 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 356 | if (!IS_OKAY(compile_tl(val, env, path))) |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 357 | { |
| 358 | goto failure; |
| 359 | } |
| 360 | } |
| 361 | |
| 362 | if (!read_error.safe_state) |
| 363 | { |
| 364 | goto failure; |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 365 | } |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 366 | |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 367 | del_fistream(is); |
swissChili | b8fd471 | 2021-06-23 15:32:04 -0700 | [diff] [blame] | 368 | pop_pool(pop); |
| 369 | |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 370 | return true; |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 371 | |
| 372 | failure: |
| 373 | del_fistream(is); |
| 374 | pop_pool(pool); |
| 375 | |
| 376 | return false; |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 377 | } |
| 378 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 379 | value_t load_relative(struct environment *env, char *to, value_t name) |
| 380 | { |
| 381 | if (!stringp(name)) |
| 382 | return nil; |
| 383 | |
| 384 | char *new_path = (char *)(name ^ STRING_TAG); |
| 385 | char *relative_to = strdup(to); |
| 386 | char full_path[512]; |
| 387 | |
| 388 | snprintf(full_path, 512, "%s/%s", dirname(relative_to), new_path); |
| 389 | |
| 390 | if (load(env, full_path)) |
| 391 | return t; |
| 392 | else |
| 393 | return nil; |
| 394 | } |
| 395 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 396 | struct error compile_file(char *filename, struct environment **e) |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 397 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 398 | E_INIT(); |
| 399 | |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 400 | value_t val; |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 401 | struct environment *env = malloc(sizeof(struct environment)); |
| 402 | env->first = NULL; |
| 403 | env->first_loaded = NULL; |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 404 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 405 | add_load(env, filename); |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 406 | TRY(load_std(env)); |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 407 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 408 | bool ok_ = load(env, filename); |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 409 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 410 | if (!ok_) |
| 411 | { |
| 412 | free(env); |
| 413 | THROWSAFE(ENOTFOUND); |
| 414 | } |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 415 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 416 | *e = env; |
| 417 | |
| 418 | OKAY(); |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 419 | } |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 420 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 421 | int nextpc(struct local *local, dasm_State **Dst) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 422 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 423 | int n = local->nextpc++; |
| 424 | if (n > local->npc) |
| 425 | { |
| 426 | local->npc += 16; |
| 427 | dasm_growpc(Dst, local->npc); |
| 428 | } |
| 429 | return n; |
| 430 | } |
| 431 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 432 | struct error compile_backquote(struct environment *env, struct local *local, |
| 433 | value_t val, dasm_State **Dst) |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 434 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 435 | E_INIT(); |
| 436 | |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 437 | if (!listp(val)) |
| 438 | { |
| 439 | | mov eax, (val); |
| 440 | } |
| 441 | else |
| 442 | { |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 443 | value_t fsym = car(val), args = cdr(val); |
swissChili | 9d151e6 | 2021-08-04 13:11:45 -0700 | [diff] [blame] | 444 | int nargs = length(args), |
| 445 | n = length(val); |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 446 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 447 | NEARVAL(val); |
| 448 | |
swissChili | 9d151e6 | 2021-08-04 13:11:45 -0700 | [diff] [blame] | 449 | if (symstreq(fsym, "unquote")) |
| 450 | { |
| 451 | if (nargs != 1) |
| 452 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 453 | THROW(EARGS, "unquote (or ,) takes exactly 1 argument"); |
swissChili | 9d151e6 | 2021-08-04 13:11:45 -0700 | [diff] [blame] | 454 | } |
| 455 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 456 | TRY(compile_expression(env, local, car(args), false, Dst)); |
swissChili | 9d151e6 | 2021-08-04 13:11:45 -0700 | [diff] [blame] | 457 | } |
swissChili | 36f2c69 | 2021-08-08 14:31:44 -0700 | [diff] [blame^] | 458 | else if (symstreq(fsym, "unquote-splice")) |
| 459 | { |
| 460 | |
| 461 | } |
swissChili | 9d151e6 | 2021-08-04 13:11:45 -0700 | [diff] [blame] | 462 | else |
| 463 | { |
| 464 | | push nil; |
| 465 | |
| 466 | for (int i = n - 1; i >= 0; i--) |
| 467 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 468 | TRY(compile_backquote(env, local, elt(val, i), Dst)); |
swissChili | 9d151e6 | 2021-08-04 13:11:45 -0700 | [diff] [blame] | 469 | | push eax; |
| 470 | | call_extern cons; |
| 471 | | add esp, 8; |
| 472 | |
| 473 | // Remove unnecessary pop |
| 474 | | push eax; |
| 475 | } |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 476 | | pop eax; |
swissChili | 9d151e6 | 2021-08-04 13:11:45 -0700 | [diff] [blame] | 477 | } |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 478 | } |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 479 | |
| 480 | OKAY(); |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 481 | } |
| 482 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 483 | value_t eval(struct environment *env, value_t form) |
| 484 | { |
| 485 | // Eval! |
| 486 | value_t function = cons(nil, cons(form, nil)); |
| 487 | |
| 488 | struct local local; |
| 489 | struct args *args; |
| 490 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 491 | dasm_State *d; |
| 492 | struct error err; |
| 493 | |
| 494 | if (!IS_OKAY((err = compile_function(function, NS_ANONYMOUS, env, &local, NULL, |
| 495 | &args, NULL, "/", &d)))) |
| 496 | { |
| 497 | ereport(err); |
| 498 | return nil; |
| 499 | } |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 500 | |
| 501 | del_local(&local); |
| 502 | |
| 503 | value_t (*f)() = link_program(&d); |
| 504 | return f(); |
| 505 | } |
| 506 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 507 | struct error compile_variable(struct variable *v, dasm_State *Dst) |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 508 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 509 | E_INIT(); |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 510 | switch (v->type) |
| 511 | { |
| 512 | case V_ARGUMENT: |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 513 | | mov eax, dword[ebp + (value_size * (v->number + 2))]; |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 514 | break; |
| 515 | case V_BOUND: |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 516 | | mov eax, dword[ebp - ((v->number + 1) * value_size)]; |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 517 | break; |
| 518 | case V_FREE: |
| 519 | // edi is the closure context pointer |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 520 | | mov eax, dword[edi + (v->number * value_size)]; |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 521 | break; |
| 522 | default: |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 523 | THROW(EUNIMPL, "Sorry, can only access V_ARGUMENT, V_BOUND, and V_FREE vars"); |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 524 | } |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 525 | OKAY(); |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 526 | } |
| 527 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 528 | struct error compile_expression(struct environment *env, struct local *local, |
| 529 | value_t val, bool tail, dasm_State **Dst) |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 530 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 531 | E_INIT(); |
| 532 | |
| 533 | NEARVAL(val); |
| 534 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 535 | if (symstreq(val, "nil") || nilp(val)) |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 536 | { |
| 537 | | mov eax, (nil); |
| 538 | } |
swissChili | 923b536 | 2021-05-09 20:31:43 -0700 | [diff] [blame] | 539 | else if (symstreq(val, "t")) |
| 540 | { |
| 541 | | mov eax, (t); |
| 542 | } |
| 543 | else if (integerp(val) || stringp(val)) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 544 | { |
| 545 | | mov eax, val; |
| 546 | } |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 547 | else if (listp(val)) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 548 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 549 | value_t fsym = car(val); |
| 550 | value_t args = cdr(val); |
| 551 | int nargs = length(args); |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 552 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 553 | if (!symbolp(fsym)) |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 554 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 555 | THROW(EEXPECTED, "Function name must be a symbol"); |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 556 | } |
| 557 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 558 | if (symstreq(fsym, "if")) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 559 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 560 | if (nargs < 2 || nargs > 3) |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 561 | { |
| 562 | THROW(EARGS, "Must give at least 2 arguments to if"); |
| 563 | } |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 564 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 565 | TRY(compile_expression(env, local, car(args), false, Dst)); |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 566 | int false_label = nextpc(local, Dst), |
| 567 | after_label = nextpc(local, Dst); |
| 568 | |
| 569 | // result is in eax |
| 570 | | cmp eax, (nil); |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 571 | | je =>false_label; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 572 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 573 | TRY(compile_expression(env, local, elt(args, 1), tail, Dst)); |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 574 | | jmp =>after_label; |
| 575 | |=>false_label:; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 576 | if (nargs == 3) |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 577 | TRY(compile_expression(env, local, elt(args, 2), tail, Dst)); |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 578 | |=>after_label:; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 579 | } |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 580 | else if (symstreq(fsym, "and") || symstreq(fsym, "or")) |
| 581 | { |
| 582 | bool or = symstreq(fsym, "or"); // false == and |
| 583 | |
| 584 | // Boolean and and or, short circuit like &&/|| |
| 585 | if (nargs < 1) |
| 586 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 587 | THROW(EARGS, "and & or require at least 1 argument."); |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 588 | } |
| 589 | |
| 590 | int after = nextpc(local, Dst); |
| 591 | |
| 592 | for (; !nilp(args); args = cdr(args)) |
| 593 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 594 | NEARVAL(args); |
| 595 | |
| 596 | TRY(compile_expression(env, local, car(args), false, Dst)); |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 597 | if (!nilp(cdr(args))) |
| 598 | { |
| 599 | | cmp eax, nil; |
| 600 | if (or) |
| 601 | { |
swissChili | fbf525f | 2021-08-04 21:28:07 -0700 | [diff] [blame] | 602 | | jne =>after; |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 603 | } |
| 604 | else |
| 605 | { |
swissChili | fbf525f | 2021-08-04 21:28:07 -0700 | [diff] [blame] | 606 | | je =>after; |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 607 | } |
| 608 | } |
| 609 | } |
| 610 | |
| 611 | |=>after:; |
| 612 | } |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 613 | else if (symstreq(fsym, "progn")) |
| 614 | { |
| 615 | for (value_t val = args; !nilp(val); val = cdr(val)) |
| 616 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 617 | NEARVAL(args); |
| 618 | |
swissChili | b51552c | 2021-08-03 10:23:37 -0700 | [diff] [blame] | 619 | bool t = tail && nilp(cdr(val)); |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 620 | TRY(compile_expression(env, local, car(val), t, Dst)); |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 621 | } |
| 622 | } |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 623 | else if (symstreq(fsym, "let1")) |
| 624 | { |
| 625 | if (nargs < 2) |
| 626 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 627 | THROW(EARGS, "Must give at least 2 arguments to let1"); |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 628 | } |
| 629 | value_t binding = car(args); |
| 630 | value_t rest = cdr(args); |
| 631 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 632 | NEARVAL(binding); |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 633 | if (length(binding) != 2) |
| 634 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 635 | THROW(EARGS, "Binding list in let1 must contain exactly two entries"); |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 636 | } |
| 637 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 638 | NEARVAL(rest); |
| 639 | |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 640 | value_t name = car(binding); |
| 641 | value_t value = car(cdr(binding)); |
| 642 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 643 | TRY(compile_expression(env, local, value, false, Dst)); |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 644 | |
| 645 | int i = local_alloc(local); |
| 646 | |
| 647 | add_variable(local, V_BOUND, (char *)(name ^ SYMBOL_TAG), i); |
| 648 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 649 | | mov dword[ebp - ((i + 1) * value_size)], eax; |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 650 | |
| 651 | for (; !nilp(rest); rest = cdr(rest)) |
| 652 | { |
swissChili | b51552c | 2021-08-03 10:23:37 -0700 | [diff] [blame] | 653 | bool t = tail && nilp(cdr(rest)); |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 654 | NEARVAL(rest); |
| 655 | TRY(compile_expression(env, local, car(rest), t, Dst)); |
swissChili | 67bdf28 | 2021-06-06 18:46:08 -0700 | [diff] [blame] | 656 | } |
| 657 | |
| 658 | local_free(local, i); |
| 659 | } |
swissChili | e9fec8b | 2021-06-22 13:59:33 -0700 | [diff] [blame] | 660 | else if (symstreq(fsym, "gc")) |
| 661 | { |
| 662 | if (nargs) |
| 663 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 664 | THROW(EARGS, "gc takes no arguments"); |
swissChili | e9fec8b | 2021-06-22 13:59:33 -0700 | [diff] [blame] | 665 | } |
| 666 | |
| 667 | | run_gc; |
| 668 | } |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 669 | else if (symstreq(fsym, "quote")) |
| 670 | { |
| 671 | if (nargs != 1) |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 672 | THROW(EARGS, "quote should take exactly 1 argument"); |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 673 | |
| 674 | // Simple! |
| 675 | | mov eax, (car(args)); |
| 676 | } |
| 677 | else if (symstreq(fsym, "backquote")) |
| 678 | { |
| 679 | if (nargs != 1) |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 680 | THROW(EARGS, "backquote should take exactly 1 argument"); |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 681 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 682 | TRY(compile_backquote(env, local, car(args), Dst)); |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 683 | } |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 684 | else if (symstreq(fsym, "function")) |
| 685 | { |
| 686 | if (nargs != 1) |
| 687 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 688 | THROW(EARGS, "function should take exactly 1 argument"); |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 689 | } |
| 690 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 691 | NEARVAL(args); |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 692 | if (!symbolp(car(args))) |
| 693 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 694 | THROW(EINVALID, "argument to function should be a symbol resolvable at " |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 695 | "compile time"); |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 696 | } |
| 697 | |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 698 | char *name = (char *)(car(args) ^ SYMBOL_TAG); |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 699 | |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 700 | if (!strcmp(name, local->current_function_name)) |
| 701 | { |
| 702 | | push 0; |
| 703 | | push local->args; |
| 704 | | push <1; |
| 705 | | call_extern create_closure; |
| 706 | } |
| 707 | else |
| 708 | { |
| 709 | struct function *f = find_function(env, name); |
| 710 | |
| 711 | if (!f) |
| 712 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 713 | THROW(EINVALID, "Function `%s' does not exist", (char *)(car(args) ^ SYMBOL_TAG)); |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 714 | } |
| 715 | value_t closure = create_closure(f->code_ptr, f->args, 0); |
| 716 | | mov eax, (closure); |
| 717 | } |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 718 | } |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 719 | else if (symstreq(fsym, "list")) |
| 720 | { |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 721 | | push (nil); |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 722 | |
| 723 | for (int i = nargs - 1; i >= 0; i--) |
| 724 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 725 | TRY(compile_expression(env, local, elt(args, i), false, Dst)); |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 726 | |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 727 | | push eax; |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 728 | | call_extern cons; |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 729 | | add esp, (2 * value_size); |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 730 | | push eax; |
| 731 | } |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 732 | | pop eax; |
swissChili | 6b47b6d | 2021-06-30 22:08:55 -0700 | [diff] [blame] | 733 | } |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 734 | else if (symstreq(fsym, "lambda")) |
| 735 | { |
| 736 | // Compile the function with this as the parent scope |
| 737 | struct local new_local; |
| 738 | int nargs_out; |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 739 | dasm_State *d; |
| 740 | TRY(compile_function( |
| 741 | args, NS_ANONYMOUS, env, &new_local, local, &nargs_out, |
| 742 | "recurse", local->current_file_path, &d)); |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 743 | |
| 744 | // Link the function |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 745 | void *func_ptr = link_program(&d); |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 746 | |
| 747 | // Create a closure object with the correct number of captures at |
| 748 | // runtime |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 749 | | push (new_local.num_closure_slots); |
| 750 | | push (nargs_out); |
| 751 | | push (func_ptr); |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 752 | | call_extern create_closure; |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 753 | | add esp, 12; |
| 754 | |
| 755 | // Walk the generated local scope for V_FREE variables, since each |
| 756 | // of these exists in our scope (or higher), evaluate it and set it |
| 757 | // as a member of the lambda capture. |
| 758 | |
| 759 | for (struct variable *var = new_local.first; var; var = var->prev) |
| 760 | { |
| 761 | if (var->type == V_FREE) |
| 762 | { |
| 763 | // Closure in eax |
| 764 | | push eax; |
| 765 | // Variable now in eax |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 766 | TRY(compile_variable(find_variable(local, var->name), Dst)); |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 767 | | push eax; |
| 768 | |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 769 | // The capture offset |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 770 | | push (var->number); |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 771 | | call_extern set_closure_capture_variable; |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 772 | // Skip the value and index |
| 773 | | add esp, 8; |
| 774 | // Pop the closure back in to eax |
| 775 | | pop eax; |
| 776 | } |
| 777 | } |
| 778 | |
| 779 | // Closure is still in eax |
| 780 | |
| 781 | dasm_free(&d); |
swissChili | 708d4c4 | 2021-07-04 17:40:07 -0700 | [diff] [blame] | 782 | del_local(&new_local); |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 783 | } |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 784 | else if (symstreq(fsym, "eval")) |
| 785 | { |
| 786 | if (nargs != 1) |
| 787 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 788 | THROW(EARGS, "eval takes exactly 1 argument"); |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 789 | } |
| 790 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 791 | TRY(compile_expression(env, local, car(args), false, Dst)); |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 792 | | push eax; |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 793 | | push (env); |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 794 | | call_extern eval; |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 795 | } |
| 796 | else if (symstreq(fsym, "load")) |
| 797 | { |
| 798 | if (nargs != 1) |
| 799 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 800 | THROW(EARGS, "load takes exactly 1 argument, %d given", nargs); |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 801 | } |
| 802 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 803 | TRY(compile_expression(env, local, car(args), false, Dst)); |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 804 | | push eax; |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 805 | | push (local->current_file_path); |
| 806 | | push (env); |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 807 | | call_extern load_relative; |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 808 | } |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 809 | else |
| 810 | { |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 811 | char *name = (char *)(fsym ^ SYMBOL_TAG); |
| 812 | struct function *func = find_function(env, name); |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 813 | |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 814 | bool is_recursive = false; |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 815 | struct args *nargs_needed = NULL; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 816 | |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 817 | // The number of arguments actually passed on the stack, |
| 818 | // i.e. all varargs are 1. |
swissChili | b51552c | 2021-08-03 10:23:37 -0700 | [diff] [blame] | 819 | int real_nargs; |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 820 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 821 | if (local->current_function_name && |
| 822 | symstreq(fsym, local->current_function_name)) |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 823 | { |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 824 | is_recursive = true; |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 825 | nargs_needed = local->args; |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 826 | } |
| 827 | else |
| 828 | { |
| 829 | if (func == NULL) |
| 830 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 831 | THROW(EINVALID, "Function %s undefined", name); |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 832 | } |
| 833 | |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 834 | nargs_needed = func->args; |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 835 | } |
| 836 | |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 837 | if (!are_args_acceptable(nargs_needed, nargs)) |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 838 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 839 | THROW(EARGS, |
| 840 | "wrong number of args in function call: %s, " |
| 841 | "want %d args but given %d\n", |
| 842 | name, nargs_needed->num_required, nargs); |
swissChili | f1ba8c1 | 2021-07-02 18:45:38 -0700 | [diff] [blame] | 843 | } |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 844 | |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 845 | int total_taken = nargs_needed->num_optional + |
| 846 | nargs_needed->num_required; |
| 847 | |
swissChili | b51552c | 2021-08-03 10:23:37 -0700 | [diff] [blame] | 848 | real_nargs = total_taken + (nargs_needed->variadic ? 1 : 0); |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 849 | |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 850 | if (is_recursive || func->namespace == NS_FUNCTION) |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 851 | { |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 852 | int nargs = length(args); |
| 853 | |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 854 | int line = cons_line(val); |
| 855 | char *file = cons_file(val); |
| 856 | |
| 857 | if (nargs_needed->variadic) |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 858 | { |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 859 | | push (nil); |
| 860 | } |
| 861 | |
| 862 | if (nargs > total_taken && nargs_needed->variadic) |
| 863 | { |
| 864 | // We are passing varargs, which means we need to make a list |
| 865 | |
| 866 | for (int i = nargs - 1; i >= total_taken; i--) |
| 867 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 868 | TRY(compile_expression(env, local, elt(args, i), false, Dst)); |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 869 | | push eax; |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 870 | | call_extern cons; |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 871 | | add esp, 8; |
| 872 | | push eax; |
| 873 | } |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 874 | } |
| 875 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 876 | for (int i = nargs_needed->num_optional - 1; |
| 877 | i >= nargs - nargs_needed->num_required; i--) |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 878 | { |
| 879 | // Push the default optional values |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 880 | | push (nargs_needed->optional_arguments[i].value); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 881 | } |
| 882 | |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 883 | int min = MIN(nargs, total_taken); |
| 884 | |
| 885 | for (int i = min - 1; i >= 0; i--) |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 886 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 887 | TRY(compile_expression(env, local, elt(args, i), false, Dst)); |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 888 | | push eax; |
| 889 | } |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 890 | |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 891 | if (is_recursive) |
| 892 | { |
swissChili | b51552c | 2021-08-03 10:23:37 -0700 | [diff] [blame] | 893 | if (tail) |
| 894 | { |
| 895 | // Move all the arguments pushed to the stack |
| 896 | // back up to the argument bit of the stack. |
| 897 | |
| 898 | for (int i = 0; i < real_nargs; i++) |
| 899 | { |
| 900 | | pop eax; |
| 901 | | mov dword[ebp + (value_size * (i + 2))], eax; |
| 902 | } |
| 903 | |
| 904 | // Jmp back to start |
| 905 | | mov esp, ebp; |
| 906 | | pop ebp; |
| 907 | | jmp <1; |
| 908 | } |
| 909 | else |
| 910 | { |
| 911 | | call <1; |
| 912 | } |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 913 | } |
| 914 | else |
| 915 | { |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 916 | // | mov ebx, (func->code_addr); |
| 917 | | call_extern func->code_addr; |
swissChili | 7434842 | 2021-07-04 13:23:24 -0700 | [diff] [blame] | 918 | } |
swissChili | 53e7cd1 | 2021-08-02 21:55:53 -0700 | [diff] [blame] | 919 | | add esp, (real_nargs * value_size); |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 920 | // result in eax |
| 921 | } |
| 922 | else if (func->namespace == NS_MACRO) |
| 923 | { |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 924 | // Make sure that the stuff allocated by the macro isn't in a |
| 925 | // pool |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 926 | unsigned char pool = push_pool(0); |
| 927 | |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 928 | value_t expanded_to = call_list(func, args); |
| 929 | |
swissChili | f68671f | 2021-07-05 14:14:44 -0700 | [diff] [blame] | 930 | pop_pool(pool); |
| 931 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 932 | TRY(compile_expression(env, local, expanded_to, false, Dst)); |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 933 | } |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 934 | } |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 935 | } |
swissChili | 923b536 | 2021-05-09 20:31:43 -0700 | [diff] [blame] | 936 | else if (symbolp(val)) |
| 937 | { |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 938 | if (symstreq(val, "+current-file+")) |
swissChili | e9fec8b | 2021-06-22 13:59:33 -0700 | [diff] [blame] | 939 | { |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 940 | value_t file_name_val = strval(local->current_file_path); |
| 941 | |
| 942 | | mov eax, (file_name_val); |
swissChili | e9fec8b | 2021-06-22 13:59:33 -0700 | [diff] [blame] | 943 | } |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 944 | else |
| 945 | { |
| 946 | struct variable *v = |
| 947 | find_variable(local, (char *)(val ^ SYMBOL_TAG)); |
swissChili | 923b536 | 2021-05-09 20:31:43 -0700 | [diff] [blame] | 948 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 949 | if (!v) |
| 950 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 951 | THROW(EINVALID, "Variable `%s' unbound", (char *)(val ^ SYMBOL_TAG)); |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 952 | } |
| 953 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 954 | TRY(compile_variable(v, Dst)); |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 955 | } |
swissChili | 923b536 | 2021-05-09 20:31:43 -0700 | [diff] [blame] | 956 | } |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 957 | else if (closurep(val)) |
| 958 | { |
| 959 | | mov eax, val; |
| 960 | } |
| 961 | else |
| 962 | { |
| 963 | printval(val, 1); |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 964 | THROW(EUNIMPL, "Don't know how to compile this, sorry."); |
swissChili | a89ee44 | 2021-08-04 20:54:51 -0700 | [diff] [blame] | 965 | } |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 966 | |
| 967 | OKAY(); |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 968 | } |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 969 | |
swissChili | 923b536 | 2021-05-09 20:31:43 -0700 | [diff] [blame] | 970 | struct variable *add_variable(struct local *local, enum var_type type, |
| 971 | char *name, int number) |
| 972 | { |
| 973 | struct variable *var = malloc(sizeof(struct variable)); |
| 974 | var->prev = local->first; |
| 975 | var->type = type; |
| 976 | var->name = name; |
| 977 | var->number = number; |
| 978 | |
| 979 | local->first = var; |
| 980 | |
| 981 | return var; |
| 982 | } |
| 983 | |
| 984 | void destroy_local(struct local *local) |
| 985 | { |
| 986 | for (struct variable *v = local->first; v;) |
| 987 | { |
| 988 | struct variable *t = v; |
| 989 | v = v->prev; |
| 990 | free(t); |
| 991 | } |
| 992 | } |
| 993 | |
| 994 | struct variable *find_variable(struct local *local, char *name) |
| 995 | { |
| 996 | struct variable *v = local->first; |
| 997 | |
| 998 | for (; v && strcmp(v->name, name) != 0; v = v->prev) |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 999 | { |
| 1000 | } |
swissChili | 923b536 | 2021-05-09 20:31:43 -0700 | [diff] [blame] | 1001 | |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 1002 | if (!v) |
| 1003 | { |
| 1004 | if (local->parent) |
| 1005 | { |
| 1006 | v = find_variable(local->parent, name); |
| 1007 | |
| 1008 | if (v) |
| 1009 | { |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1010 | // We found this in a parent scope, add it as a V_FREE variable |
| 1011 | // to skip the search. |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1012 | v = add_variable(local, V_FREE, name, |
| 1013 | local->num_closure_slots++); |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 1014 | } |
| 1015 | } |
| 1016 | } |
swissChili | 923b536 | 2021-05-09 20:31:43 -0700 | [diff] [blame] | 1017 | return v; |
| 1018 | } |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 1019 | |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 1020 | extern value_t _call_list(void *addr, value_t list, value_t *edi); |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 1021 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1022 | value_t call_list_args(void *code_ptr, struct args *args, value_t list, |
| 1023 | void *data) |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 1024 | { |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1025 | list = deep_copy(list); |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 1026 | |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1027 | int nargs = length(list); |
| 1028 | |
swissChili | 484295d | 2021-07-09 21:25:55 -0700 | [diff] [blame] | 1029 | value_t *val = &list; |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1030 | |
| 1031 | for (value_t i = list; !nilp(i); i = cdr(i)) |
| 1032 | { |
| 1033 | val = cdrref(i); |
| 1034 | } |
| 1035 | |
| 1036 | int total_required = args->num_required + args->num_optional; |
| 1037 | |
| 1038 | if (nargs > total_required) |
| 1039 | { |
| 1040 | // Take the remainder of the list and put it as the last item in the |
| 1041 | // list. |
| 1042 | value_t trailing = cxdr(list, total_required); |
| 1043 | value_t last_item = cons(trailing, nil); |
| 1044 | |
| 1045 | *cxdrref(&list, total_required) = last_item; |
| 1046 | } |
| 1047 | else if (nargs < total_required) |
| 1048 | { |
| 1049 | for (int i = nargs - args->num_required; i < args->num_optional; i++) |
| 1050 | { |
| 1051 | // Append the i-th defualt argument |
| 1052 | value_t appended = cons(args->optional_arguments[i].value, nil); |
| 1053 | *val = appended; |
| 1054 | val = cdrref(appended); |
| 1055 | } |
| 1056 | } |
| 1057 | |
| 1058 | // We want to call this if we pass the correct # of arguments or less, just |
| 1059 | // not if we have already passed varargs. Appends a nil argument. |
| 1060 | if (nargs <= total_required) |
| 1061 | { |
| 1062 | // Enough real arguments but no variadic arguments. Pass a nil list. |
| 1063 | *val = cons(nil, nil); |
| 1064 | } |
| 1065 | |
| 1066 | return _call_list(code_ptr, list, data); |
| 1067 | } |
| 1068 | |
| 1069 | value_t call_list(struct function *fun, value_t list) |
| 1070 | { |
| 1071 | return call_list_args(fun->code_ptr, fun->args, list, NULL); |
swissChili | ddc9754 | 2021-07-04 11:47:42 -0700 | [diff] [blame] | 1072 | } |
| 1073 | |
| 1074 | value_t call_list_closure(struct closure *c, value_t list) |
| 1075 | { |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1076 | return call_list_args(c->function, c->args, list, c->data); |
| 1077 | } |
| 1078 | |
| 1079 | struct args *new_args() |
| 1080 | { |
| 1081 | struct args *a = malloc(sizeof(struct args)); |
| 1082 | a->num_optional = 0; |
| 1083 | a->num_required = 0; |
| 1084 | a->variadic = false; |
| 1085 | |
| 1086 | return a; |
| 1087 | } |
| 1088 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1089 | struct args *add_optional_arg(struct args *args, value_t name, value_t value) |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1090 | { |
| 1091 | int i = args->num_optional++; |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1092 | args = |
| 1093 | realloc(args, sizeof(struct args) + sizeof(struct optional_argument) * |
| 1094 | args->num_optional); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1095 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1096 | args->optional_arguments[i] = (struct optional_argument){ |
| 1097 | .value = value, |
| 1098 | .name = name, |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1099 | }; |
| 1100 | |
| 1101 | return args; |
| 1102 | } |
| 1103 | |
| 1104 | bool are_args_acceptable(struct args *args, int number) |
| 1105 | { |
| 1106 | if (args->variadic) |
| 1107 | { |
| 1108 | return number >= args->num_required; |
| 1109 | } |
| 1110 | else |
| 1111 | { |
| 1112 | return number >= args->num_required && |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1113 | number <= args->num_required + args->num_optional; |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1114 | } |
| 1115 | } |
| 1116 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1117 | struct error list_to_args(struct environment *env, value_t list, |
| 1118 | struct local *local, struct args **a) |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1119 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1120 | E_INIT(); |
| 1121 | |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1122 | struct args *args = new_args(); |
| 1123 | |
| 1124 | bool in_optional = false; |
| 1125 | |
| 1126 | for (value_t i = list; !nilp(i); i = cdr(i)) |
| 1127 | { |
| 1128 | value_t val = car(i); |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1129 | NEARVAL(i); |
| 1130 | |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1131 | if (symbolp(val)) |
| 1132 | { |
| 1133 | if (!args->variadic && symstreq(val, "&")) |
| 1134 | { |
| 1135 | i = cdr(i); |
| 1136 | value_t name = car(i); |
| 1137 | |
| 1138 | if (!symbolp(name)) |
| 1139 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1140 | THROW(EEXPECTED, "You must provide a symbol after & in an argument list " |
| 1141 | "to bind the\n" |
| 1142 | "variadic arguments to."); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1143 | } |
| 1144 | |
| 1145 | args->variadic = true; |
| 1146 | |
| 1147 | add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG), |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1148 | args->num_optional + args->num_required); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1149 | |
| 1150 | continue; |
| 1151 | } |
| 1152 | |
| 1153 | if (!in_optional) |
| 1154 | { |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1155 | add_variable(local, V_ARGUMENT, (char *)(val ^ SYMBOL_TAG), |
| 1156 | args->num_required++); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1157 | } |
| 1158 | else |
| 1159 | { |
| 1160 | char *name = (char *)(val ^ SYMBOL_TAG); |
| 1161 | if (name[0] == '&') |
| 1162 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1163 | THROW(EINVALID, "Non-optional argument following optional arguments " |
| 1164 | "starts with a &\n" |
| 1165 | "did you mean to declare a variadic argument? If so " |
| 1166 | "leave a space\n" |
| 1167 | "between the & and name."); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1168 | } |
| 1169 | else |
| 1170 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1171 | THROW(EINVALID, "Cannot define a non-optional argument after an " |
| 1172 | "optional one."); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1173 | } |
| 1174 | } |
| 1175 | } |
| 1176 | else if (listp(val)) |
| 1177 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1178 | NEARVAL(val); |
| 1179 | |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1180 | in_optional = true; |
| 1181 | int len = length(val); |
| 1182 | |
| 1183 | if (len != 2) |
| 1184 | { |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1185 | THROW(EINVALID, "A list defining an optional value must be structured like " |
| 1186 | "(name expr)\n" |
| 1187 | "with exactly two arguments."); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1188 | } |
| 1189 | |
| 1190 | value_t name = car(val); |
| 1191 | value_t expr = car(cdr(val)); |
| 1192 | |
| 1193 | value_t function = cons(nil, cons(expr, nil)); |
| 1194 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1195 | dasm_State *d; |
| 1196 | TRY(compile_function(function, NS_ANONYMOUS, env, NULL, NULL, NULL, |
| 1197 | NULL, local->current_file_path, &d)); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1198 | |
| 1199 | // TODO: GC stack top! |
| 1200 | value_t (*compiled)() = link_program(&d); |
| 1201 | |
| 1202 | value_t value = compiled(); |
| 1203 | args = add_optional_arg(args, name, value); |
| 1204 | |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1205 | add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG), |
| 1206 | args->num_required + args->num_optional - 1); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1207 | } |
| 1208 | } |
| 1209 | |
swissChili | 6d02af4 | 2021-08-05 19:49:01 -0700 | [diff] [blame] | 1210 | *a = args; |
| 1211 | OKAY(); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1212 | } |
| 1213 | |
| 1214 | void display_args(struct args *args) |
| 1215 | { |
| 1216 | printf("Args object taking %d require arguments and %d optionals:\n", |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1217 | args->num_required, args->num_optional); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1218 | |
| 1219 | for (int i = 0; i < args->num_optional; i++) |
| 1220 | { |
swissChili | 7e1393c | 2021-07-07 12:59:12 -0700 | [diff] [blame] | 1221 | printf(" %d\t%s\n", i, |
| 1222 | (char *)(args->optional_arguments[i].name ^ SYMBOL_TAG)); |
swissChili | 15f1cae | 2021-07-05 19:08:47 -0700 | [diff] [blame] | 1223 | printval(args->optional_arguments[i].value, 2); |
| 1224 | } |
swissChili | 2999dd1 | 2021-07-02 14:19:53 -0700 | [diff] [blame] | 1225 | } |