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 | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 4 | #include "lib/std.h" |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 5 | #include "plat/plat.h" |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 6 | |
| 7 | #include <dasm_proto.h> |
| 8 | #include <dasm_x86.h> |
| 9 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 10 | #define value_size sizeof(value_t) |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 11 | |
| 12 | |.arch x86; |
| 13 | |
| 14 | |.macro setup, nvars; |
| 15 | | push ebp; |
| 16 | | mov ebp, esp; |
swissChili | 8cfb7c4 | 2021-04-18 21:17:58 -0700 | [diff] [blame] | 17 | | sub esp, (value_size * nvars); |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 18 | |.endmacro; |
| 19 | |
| 20 | |.macro cleanup; |
| 21 | | mov esp, ebp; |
| 22 | | pop ebp; |
| 23 | | ret; |
| 24 | |.endmacro; |
| 25 | |
| 26 | dasm_State *d; |
| 27 | unsigned int npc = 8; |
| 28 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 29 | struct function *find_function(struct environment *env, char *name) |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 30 | { |
| 31 | struct function *f = env->first; |
| 32 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 33 | while (strcmp(f->name, name) != 0) |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 34 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 35 | if (f->prev) |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 36 | f = f->prev; |
| 37 | else |
| 38 | return NULL; |
| 39 | } |
| 40 | |
| 41 | return f; |
| 42 | } |
| 43 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 44 | void compile_tl(value_t val, struct environment *env) |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 45 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 46 | if (!listp(val)) |
| 47 | err("Top level must be a list"); |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 48 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 49 | value_t form = car(val); |
| 50 | value_t args = cdr(val); |
| 51 | |
| 52 | if (symstreq(form, "defun")) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 53 | { |
| 54 | dasm_State *d; |
| 55 | dasm_State **Dst = &d; |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 56 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 57 | |.section code; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 58 | dasm_init(&d, DASM_MAXSECTION); |
| 59 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 60 | |.globals lbl_; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 61 | void *labels[lbl__MAX]; |
| 62 | dasm_setupglobal(&d, labels, lbl__MAX); |
| 63 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 64 | |.actionlist lisp_actions; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 65 | dasm_setup(&d, lisp_actions); |
| 66 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 67 | struct local local; |
| 68 | local.first = NULL; |
| 69 | local.num_vars = 0; |
swissChili | a820dea | 2021-05-09 16:46:55 -0700 | [diff] [blame^] | 70 | local.npc = 8; |
| 71 | local.nextpc = 0; |
| 72 | |
| 73 | dasm_growpc(&d, local.npc); |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 74 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 75 | // Generate code |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 76 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 77 | | setup 0; |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 78 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 79 | value_t name = car(args); |
| 80 | args = cdr(args); |
| 81 | value_t arglist = car(args); |
| 82 | value_t body = cdr(args); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 83 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 84 | if ((name & HEAP_MASK) != SYMBOL_TAG) |
| 85 | err("function name must be a symbol"); |
| 86 | |
| 87 | for (; !nilp(body); body = cdr(body)) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 88 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 89 | compile_expression(env, &local, car(body), Dst); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 90 | } |
| 91 | |
| 92 | | cleanup; |
| 93 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 94 | add_function(env, (char *)(name ^ SYMBOL_TAG), link(Dst), |
| 95 | length(arglist)); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 96 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 97 | dasm_free(&d); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 98 | } |
| 99 | } |
| 100 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 101 | struct environment compile_all(struct istream *is) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 102 | { |
| 103 | value_t val; |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 104 | struct environment env; |
| 105 | env.first = NULL; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 106 | load_std(&env); |
| 107 | |
| 108 | while (read1(is, &val)) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 109 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 110 | compile_tl(val, &env); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 111 | } |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 112 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 113 | return env; |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 114 | } |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 115 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 116 | int nextpc(struct local *local, dasm_State **Dst) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 117 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 118 | int n = local->nextpc++; |
| 119 | if (n > local->npc) |
| 120 | { |
| 121 | local->npc += 16; |
| 122 | dasm_growpc(Dst, local->npc); |
| 123 | } |
| 124 | return n; |
| 125 | } |
| 126 | |
| 127 | void compile_expression(struct environment *env, struct local *local, |
| 128 | value_t val, dasm_State **Dst) |
| 129 | { |
| 130 | if (symstreq(val, "nil")) |
| 131 | { |
| 132 | | mov eax, (nil); |
| 133 | } |
| 134 | else if (integerp(val) || stringp(val) || symbolp(val)) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 135 | { |
| 136 | | mov eax, val; |
| 137 | } |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 138 | else if (listp(val)) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 139 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 140 | value_t fsym = car(val); |
| 141 | value_t args = cdr(val); |
| 142 | int nargs = length(args); |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 143 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 144 | if (!symbolp(fsym)) |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 145 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 146 | err("function name must be a symbol"); |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 147 | } |
| 148 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 149 | if (symstreq(fsym, "if")) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 150 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 151 | if (nargs < 2 || nargs > 3) |
| 152 | err("Must give at least 2 arguments to if"); |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 153 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 154 | compile_expression(env, local, car(args), Dst); |
| 155 | int false_label = nextpc(local, Dst), |
| 156 | after_label = nextpc(local, Dst); |
| 157 | |
| 158 | // result is in eax |
| 159 | | cmp eax, (nil); |
| 160 | | je =>false_label; |
| 161 | |
| 162 | compile_expression(env, local, elt(args, 1), Dst); |
swissChili | a820dea | 2021-05-09 16:46:55 -0700 | [diff] [blame^] | 163 | | jmp =>after_label; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 164 | |=>false_label: |
| 165 | if (nargs == 3) |
| 166 | compile_expression(env, local, elt(args, 2), Dst); |
| 167 | |=>after_label: |
| 168 | } |
| 169 | else |
| 170 | { |
| 171 | struct function *func = |
| 172 | find_function(env, (char *)(fsym ^ SYMBOL_TAG)); |
| 173 | |
| 174 | if (nargs != func->nargs) |
| 175 | err("wrong number of args"); |
| 176 | |
| 177 | for (int i = length(args) - 1; i >= 0; i--) |
| 178 | { |
| 179 | compile_expression(env, local, elt(args, i), Dst); |
| 180 | | push eax; |
| 181 | } |
| 182 | |
| 183 | | mov ebx, (func->code_addr); |
| 184 | | call ebx; |
| 185 | | add esp, (nargs * 4); |
| 186 | // result in eax |
| 187 | } |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 188 | } |
| 189 | } |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 190 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 191 | void compile_expr_to_func(struct environment *env, char *name, value_t val, |
| 192 | dasm_State **Dst) |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 193 | { |
| 194 | | setup 0; |
| 195 | |
| 196 | struct local local; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 197 | compile_expression(env, &local, val, Dst); |
| 198 | |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 199 | | cleanup; |
| 200 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame] | 201 | add_function(env, name, link(Dst), 0); |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 202 | } |