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 | |
| 67 | dasm_growpc(&d, npc); |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 68 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 69 | struct local local; |
| 70 | local.first = NULL; |
| 71 | local.num_vars = 0; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 72 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 73 | // Generate code |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 74 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 75 | | setup 0; |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 76 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 77 | value_t name = car(args); |
| 78 | args = cdr(args); |
| 79 | value_t arglist = car(args); |
| 80 | value_t body = cdr(args); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 81 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 82 | if ((name & HEAP_MASK) != SYMBOL_TAG) |
| 83 | err("function name must be a symbol"); |
| 84 | |
| 85 | for (; !nilp(body); body = cdr(body)) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 86 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 87 | compile_expression(env, &local, car(body), Dst); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 88 | } |
| 89 | |
| 90 | | cleanup; |
| 91 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 92 | add_function(env, (char *)(name ^ SYMBOL_TAG), link(Dst), |
| 93 | length(arglist)); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 94 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 95 | dasm_free(&d); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 96 | } |
| 97 | } |
| 98 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 99 | struct environment compile_all(struct istream *is) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 100 | { |
| 101 | value_t val; |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 102 | struct environment env; |
| 103 | env.first = NULL; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 104 | load_std(&env); |
| 105 | |
| 106 | while (read1(is, &val)) |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 107 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 108 | compile_tl(val, &env); |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 109 | } |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 110 | |
swissChili | 8fc5e2f | 2021-04-22 13:45:10 -0700 | [diff] [blame] | 111 | return env; |
swissChili | ca107a0 | 2021-04-14 12:07:30 -0700 | [diff] [blame] | 112 | } |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 113 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 114 | int nextpc(struct local *local, dasm_State **Dst) |
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 n = local->nextpc++; |
| 117 | if (n > local->npc) |
| 118 | { |
| 119 | local->npc += 16; |
| 120 | dasm_growpc(Dst, local->npc); |
| 121 | } |
| 122 | return n; |
| 123 | } |
| 124 | |
| 125 | void compile_expression(struct environment *env, struct local *local, |
| 126 | value_t val, dasm_State **Dst) |
| 127 | { |
| 128 | if (symstreq(val, "nil")) |
| 129 | { |
| 130 | | mov eax, (nil); |
| 131 | } |
| 132 | else if (integerp(val) || stringp(val) || symbolp(val)) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 133 | { |
| 134 | | mov eax, val; |
| 135 | } |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 136 | else if (listp(val)) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 137 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 138 | value_t fsym = car(val); |
| 139 | value_t args = cdr(val); |
| 140 | int nargs = length(args); |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 141 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 142 | if (!symbolp(fsym)) |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 143 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 144 | err("function name must be a symbol"); |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 145 | } |
| 146 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 147 | if (symstreq(fsym, "if")) |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 148 | { |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 149 | if (nargs < 2 || nargs > 3) |
| 150 | err("Must give at least 2 arguments to if"); |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 151 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 152 | compile_expression(env, local, car(args), Dst); |
| 153 | int false_label = nextpc(local, Dst), |
| 154 | after_label = nextpc(local, Dst); |
| 155 | |
| 156 | // result is in eax |
| 157 | | cmp eax, (nil); |
| 158 | | je =>false_label; |
| 159 | |
| 160 | compile_expression(env, local, elt(args, 1), Dst); |
| 161 | |
| 162 | |=>false_label: |
| 163 | if (nargs == 3) |
| 164 | compile_expression(env, local, elt(args, 2), Dst); |
| 165 | |=>after_label: |
| 166 | } |
| 167 | else |
| 168 | { |
| 169 | struct function *func = |
| 170 | find_function(env, (char *)(fsym ^ SYMBOL_TAG)); |
| 171 | |
| 172 | if (nargs != func->nargs) |
| 173 | err("wrong number of args"); |
| 174 | |
| 175 | for (int i = length(args) - 1; i >= 0; i--) |
| 176 | { |
| 177 | compile_expression(env, local, elt(args, i), Dst); |
| 178 | | push eax; |
| 179 | } |
| 180 | |
| 181 | | mov ebx, (func->code_addr); |
| 182 | | call ebx; |
| 183 | | add esp, (nargs * 4); |
| 184 | // result in eax |
| 185 | } |
swissChili | b3ca4fb | 2021-04-20 10:33:00 -0700 | [diff] [blame] | 186 | } |
| 187 | } |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 188 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 189 | void compile_expr_to_func(struct environment *env, char *name, value_t val, |
| 190 | dasm_State **Dst) |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 191 | { |
| 192 | | setup 0; |
| 193 | |
| 194 | struct local local; |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 195 | compile_expression(env, &local, val, Dst); |
| 196 | |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 197 | | cleanup; |
| 198 | |
swissChili | 53472e8 | 2021-05-08 16:06:32 -0700 | [diff] [blame^] | 199 | add_function(env, name, link(Dst), 0); |
swissChili | f3e7f18 | 2021-04-20 13:57:22 -0700 | [diff] [blame] | 200 | } |