1 /*
2 * Copyright (c) 2021 Calvin Rose
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a copy
5 * of this software and associated documentation files (the "Software"), to
6 * deal in the Software without restriction, including without limitation the
7 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 * sell copies of the Software, and to permit persons to whom the Software is
9 * furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 * IN THE SOFTWARE.
21 */
22
23 #ifndef JANET_AMALG
24 #include "features.h"
25 #include <janet.h>
26 #include "compile.h"
27 #include "emit.h"
28 #include "vector.h"
29 #endif
30
arity1or2(JanetFopts opts,JanetSlot * args)31 static int arity1or2(JanetFopts opts, JanetSlot *args) {
32 (void) opts;
33 int32_t arity = janet_v_count(args);
34 return arity == 1 || arity == 2;
35 }
arity2or3(JanetFopts opts,JanetSlot * args)36 static int arity2or3(JanetFopts opts, JanetSlot *args) {
37 (void) opts;
38 int32_t arity = janet_v_count(args);
39 return arity == 2 || arity == 3;
40 }
fixarity1(JanetFopts opts,JanetSlot * args)41 static int fixarity1(JanetFopts opts, JanetSlot *args) {
42 (void) opts;
43 return janet_v_count(args) == 1;
44 }
maxarity1(JanetFopts opts,JanetSlot * args)45 static int maxarity1(JanetFopts opts, JanetSlot *args) {
46 (void) opts;
47 return janet_v_count(args) <= 1;
48 }
minarity2(JanetFopts opts,JanetSlot * args)49 static int minarity2(JanetFopts opts, JanetSlot *args) {
50 (void) opts;
51 return janet_v_count(args) >= 2;
52 }
fixarity2(JanetFopts opts,JanetSlot * args)53 static int fixarity2(JanetFopts opts, JanetSlot *args) {
54 (void) opts;
55 return janet_v_count(args) == 2;
56 }
fixarity3(JanetFopts opts,JanetSlot * args)57 static int fixarity3(JanetFopts opts, JanetSlot *args) {
58 (void) opts;
59 return janet_v_count(args) == 3;
60 }
61
62 /* Generic handling for $A = op $B */
genericSS(JanetFopts opts,int op,JanetSlot s)63 static JanetSlot genericSS(JanetFopts opts, int op, JanetSlot s) {
64 JanetSlot target = janetc_gettarget(opts);
65 janetc_emit_ss(opts.compiler, op, target, s, 1);
66 return target;
67 }
68
69 /* Generic handling for $A = $B op I */
genericSSI(JanetFopts opts,int op,JanetSlot s,int32_t imm)70 static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
71 JanetSlot target = janetc_gettarget(opts);
72 janetc_emit_ssi(opts.compiler, op, target, s, imm, 1);
73 return target;
74 }
75
76 /* Emit an insruction that implements a form by itself. */
opfunction(JanetFopts opts,JanetSlot * args,int op,Janet defaultArg2)77 static JanetSlot opfunction(
78 JanetFopts opts,
79 JanetSlot *args,
80 int op,
81 Janet defaultArg2) {
82 JanetCompiler *c = opts.compiler;
83 int32_t len;
84 len = janet_v_count(args);
85 JanetSlot t;
86 if (len == 1) {
87 t = janetc_gettarget(opts);
88 janetc_emit_sss(c, op, t, args[0], janetc_cslot(defaultArg2), 1);
89 return t;
90 } else {
91 /* len == 2 */
92 t = janetc_gettarget(opts);
93 janetc_emit_sss(c, op, t, args[0], args[1], 1);
94 }
95 return t;
96 }
97
98 /* Check if a value can be coerced to an immediate value */
can_be_imm(Janet x,int8_t * out)99 static int can_be_imm(Janet x, int8_t *out) {
100 if (!janet_checkint(x)) return 0;
101 int32_t integer = janet_unwrap_integer(x);
102 if (integer > 127 || integer < -127) return 0;
103 *out = (int8_t) integer;
104 return 1;
105 }
106
107 /* Check if a slot can be coerced to an immediate value */
can_slot_be_imm(JanetSlot s,int8_t * out)108 static int can_slot_be_imm(JanetSlot s, int8_t *out) {
109 if (!(s.flags & JANET_SLOT_CONSTANT)) return 0;
110 return can_be_imm(s.constant, out);
111 }
112
113 /* Emit a series of instructions instead of a function call to a math op */
opreduce(JanetFopts opts,JanetSlot * args,int op,int opim,Janet nullary)114 static JanetSlot opreduce(
115 JanetFopts opts,
116 JanetSlot *args,
117 int op,
118 int opim,
119 Janet nullary) {
120 JanetCompiler *c = opts.compiler;
121 int32_t i, len;
122 int8_t imm = 0;
123 int neg = opim < 0;
124 if (opim < 0) opim = -opim;
125 len = janet_v_count(args);
126 JanetSlot t;
127 if (len == 0) {
128 return janetc_cslot(nullary);
129 } else if (len == 1) {
130 t = janetc_gettarget(opts);
131 /* Special case subtract to be times -1 */
132 if (op == JOP_SUBTRACT) {
133 janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
134 } else {
135 janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
136 }
137 return t;
138 }
139 t = janetc_gettarget(opts);
140 if (opim && can_slot_be_imm(args[1], &imm)) {
141 janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
142 } else {
143 janetc_emit_sss(c, op, t, args[0], args[1], 1);
144 }
145 for (i = 2; i < len; i++) {
146 if (opim && can_slot_be_imm(args[i], &imm)) {
147 janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
148 } else {
149 janetc_emit_sss(c, op, t, t, args[i], 1);
150 }
151 }
152 return t;
153 }
154
155 /* Function optimizers */
156
do_propagate(JanetFopts opts,JanetSlot * args)157 static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
158 return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
159 }
do_error(JanetFopts opts,JanetSlot * args)160 static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
161 janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
162 return janetc_cslot(janet_wrap_nil());
163 }
do_debug(JanetFopts opts,JanetSlot * args)164 static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
165 (void)args;
166 int32_t len = janet_v_count(args);
167 JanetSlot t = janetc_gettarget(opts);
168 janetc_emit_ssu(opts.compiler, JOP_SIGNAL, t,
169 (len == 1) ? args[0] : janetc_cslot(janet_wrap_nil()),
170 JANET_SIGNAL_DEBUG,
171 1);
172 return t;
173 }
do_in(JanetFopts opts,JanetSlot * args)174 static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
175 return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
176 }
do_get(JanetFopts opts,JanetSlot * args)177 static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
178 if (janet_v_count(args) == 3) {
179 JanetCompiler *c = opts.compiler;
180 JanetSlot t = janetc_gettarget(opts);
181 int target_is_default = janetc_sequal(t, args[2]);
182 JanetSlot dflt_slot = args[2];
183 if (target_is_default) {
184 dflt_slot = janetc_farslot(c);
185 janetc_copy(c, dflt_slot, t);
186 }
187 janetc_emit_sss(c, JOP_GET, t, args[0], args[1], 1);
188 int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT_NIL, t, 0, 0);
189 janetc_copy(c, t, dflt_slot);
190 if (target_is_default) janetc_freeslot(c, dflt_slot);
191 int32_t current = janet_v_count(c->buffer);
192 c->buffer[label] |= (current - label) << 16;
193 return t;
194 } else {
195 return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
196 }
197 }
do_next(JanetFopts opts,JanetSlot * args)198 static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
199 return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
200 }
do_modulo(JanetFopts opts,JanetSlot * args)201 static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
202 return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
203 }
do_remainder(JanetFopts opts,JanetSlot * args)204 static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
205 return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
206 }
do_cmp(JanetFopts opts,JanetSlot * args)207 static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
208 return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
209 }
do_put(JanetFopts opts,JanetSlot * args)210 static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
211 if (opts.flags & JANET_FOPTS_DROP) {
212 janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
213 return janetc_cslot(janet_wrap_nil());
214 } else {
215 JanetSlot t = janetc_gettarget(opts);
216 janetc_copy(opts.compiler, t, args[0]);
217 janetc_emit_sss(opts.compiler, JOP_PUT, t, args[1], args[2], 0);
218 return t;
219 }
220 }
do_length(JanetFopts opts,JanetSlot * args)221 static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
222 return genericSS(opts, JOP_LENGTH, args[0]);
223 }
do_yield(JanetFopts opts,JanetSlot * args)224 static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
225 if (janet_v_count(args) == 0) {
226 return genericSSI(opts, JOP_SIGNAL, janetc_cslot(janet_wrap_nil()), 3);
227 } else {
228 return genericSSI(opts, JOP_SIGNAL, args[0], 3);
229 }
230 }
do_resume(JanetFopts opts,JanetSlot * args)231 static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
232 return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
233 }
do_cancel(JanetFopts opts,JanetSlot * args)234 static JanetSlot do_cancel(JanetFopts opts, JanetSlot *args) {
235 return opfunction(opts, args, JOP_CANCEL, janet_wrap_nil());
236 }
do_apply(JanetFopts opts,JanetSlot * args)237 static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
238 /* Push phase */
239 JanetCompiler *c = opts.compiler;
240 int32_t i;
241 for (i = 1; i < janet_v_count(args) - 3; i += 3)
242 janetc_emit_sss(c, JOP_PUSH_3, args[i], args[i + 1], args[i + 2], 0);
243 if (i == janet_v_count(args) - 3)
244 janetc_emit_ss(c, JOP_PUSH_2, args[i], args[i + 1], 0);
245 else if (i == janet_v_count(args) - 2)
246 janetc_emit_s(c, JOP_PUSH, args[i], 0);
247 /* Push array phase */
248 janetc_emit_s(c, JOP_PUSH_ARRAY, janet_v_last(args), 0);
249 /* Call phase */
250 JanetSlot target;
251 if (opts.flags & JANET_FOPTS_TAIL) {
252 janetc_emit_s(c, JOP_TAILCALL, args[0], 0);
253 target = janetc_cslot(janet_wrap_nil());
254 target.flags |= JANET_SLOT_RETURNED;
255 } else {
256 target = janetc_gettarget(opts);
257 janetc_emit_ss(c, JOP_CALL, target, args[0], 1);
258 }
259 return target;
260 }
261
262 /* Variadic operators specialization */
263
do_add(JanetFopts opts,JanetSlot * args)264 static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
265 return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
266 }
do_sub(JanetFopts opts,JanetSlot * args)267 static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
268 return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
269 }
do_mul(JanetFopts opts,JanetSlot * args)270 static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
271 return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
272 }
do_div(JanetFopts opts,JanetSlot * args)273 static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
274 return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
275 }
do_band(JanetFopts opts,JanetSlot * args)276 static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
277 return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
278 }
do_bor(JanetFopts opts,JanetSlot * args)279 static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
280 return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
281 }
do_bxor(JanetFopts opts,JanetSlot * args)282 static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
283 return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
284 }
do_lshift(JanetFopts opts,JanetSlot * args)285 static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
286 return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
287 }
do_rshift(JanetFopts opts,JanetSlot * args)288 static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
289 return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
290 }
do_rshiftu(JanetFopts opts,JanetSlot * args)291 static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
292 return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
293 }
do_bnot(JanetFopts opts,JanetSlot * args)294 static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
295 return genericSS(opts, JOP_BNOT, args[0]);
296 }
297
298 /* Specialization for comparators */
compreduce(JanetFopts opts,JanetSlot * args,int op,int opim,int invert)299 static JanetSlot compreduce(
300 JanetFopts opts,
301 JanetSlot *args,
302 int op,
303 int opim,
304 int invert) {
305 JanetCompiler *c = opts.compiler;
306 int32_t i, len;
307 int8_t imm = 0;
308 len = janet_v_count(args);
309 int32_t *labels = NULL;
310 JanetSlot t;
311 if (len < 2) {
312 return invert
313 ? janetc_cslot(janet_wrap_false())
314 : janetc_cslot(janet_wrap_true());
315 }
316 t = janetc_gettarget(opts);
317 for (i = 1; i < len; i++) {
318 if (opim && can_slot_be_imm(args[i], &imm)) {
319 janetc_emit_ssi(c, opim, t, args[i - 1], imm, 1);
320 } else {
321 janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
322 }
323 if (i != (len - 1)) {
324 int32_t label = janetc_emit_si(c, invert ? JOP_JUMP_IF : JOP_JUMP_IF_NOT, t, 0, 1);
325 janet_v_push(labels, label);
326 }
327 }
328 int32_t end = janet_v_count(c->buffer);
329 for (i = 0; i < janet_v_count(labels); i++) {
330 int32_t label = labels[i];
331 c->buffer[label] |= ((end - label) << 16);
332 }
333 janet_v_free(labels);
334 return t;
335 }
336
do_gt(JanetFopts opts,JanetSlot * args)337 static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
338 return compreduce(opts, args, JOP_GREATER_THAN, JOP_GREATER_THAN_IMMEDIATE, 0);
339 }
do_lt(JanetFopts opts,JanetSlot * args)340 static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
341 return compreduce(opts, args, JOP_LESS_THAN, JOP_LESS_THAN_IMMEDIATE, 0);
342 }
do_gte(JanetFopts opts,JanetSlot * args)343 static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
344 return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0, 0);
345 }
do_lte(JanetFopts opts,JanetSlot * args)346 static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
347 return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0, 0);
348 }
do_eq(JanetFopts opts,JanetSlot * args)349 static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
350 return compreduce(opts, args, JOP_EQUALS, JOP_EQUALS_IMMEDIATE, 0);
351 }
do_neq(JanetFopts opts,JanetSlot * args)352 static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
353 return compreduce(opts, args, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, 1);
354 }
355
356 /* Arranged by tag */
357 static const JanetFunOptimizer optimizers[] = {
358 {maxarity1, do_debug},
359 {fixarity1, do_error},
360 {minarity2, do_apply},
361 {maxarity1, do_yield},
362 {arity1or2, do_resume},
363 {fixarity2, do_in},
364 {fixarity3, do_put},
365 {fixarity1, do_length},
366 {NULL, do_add},
367 {NULL, do_sub},
368 {NULL, do_mul},
369 {NULL, do_div},
370 {NULL, do_band},
371 {NULL, do_bor},
372 {NULL, do_bxor},
373 {NULL, do_lshift},
374 {NULL, do_rshift},
375 {NULL, do_rshiftu},
376 {fixarity1, do_bnot},
377 {NULL, do_gt},
378 {NULL, do_lt},
379 {NULL, do_gte},
380 {NULL, do_lte},
381 {NULL, do_eq},
382 {NULL, do_neq},
383 {fixarity2, do_propagate},
384 {arity2or3, do_get},
385 {arity1or2, do_next},
386 {fixarity2, do_modulo},
387 {fixarity2, do_remainder},
388 {fixarity2, do_cmp},
389 {fixarity2, do_cancel},
390 };
391
janetc_funopt(uint32_t flags)392 const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
393 uint32_t tag = flags & JANET_FUNCDEF_FLAG_TAG;
394 if (tag == 0)
395 return NULL;
396 uint32_t index = tag - 1;
397 if (index >= (sizeof(optimizers) / sizeof(optimizers[0])))
398 return NULL;
399 return optimizers + index;
400 }
401
402