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 "emit.h"
27 #include "vector.h"
28 #include "regalloc.h"
29 #endif
30 
31 /* Get a register */
janetc_allocfar(JanetCompiler * c)32 int32_t janetc_allocfar(JanetCompiler *c) {
33     int32_t reg = janetc_regalloc_1(&c->scope->ra);
34     if (reg > 0xFFFF) {
35         janetc_cerror(c, "ran out of internal registers");
36     }
37     return reg;
38 }
39 
40 /* Get a register less than 256 for temporary use. */
janetc_allocnear(JanetCompiler * c,JanetcRegisterTemp tag)41 int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
42     return janetc_regalloc_temp(&c->scope->ra, tag);
43 }
44 
45 /* Emit a raw instruction with source mapping. */
janetc_emit(JanetCompiler * c,uint32_t instr)46 void janetc_emit(JanetCompiler *c, uint32_t instr) {
47     janet_v_push(c->buffer, instr);
48     janet_v_push(c->mapbuffer, c->current_mapping);
49 }
50 
51 /* Add a constant to the current scope. Return the index of the constant. */
janetc_const(JanetCompiler * c,Janet x)52 static int32_t janetc_const(JanetCompiler *c, Janet x) {
53     JanetScope *scope = c->scope;
54     int32_t i, len;
55     /* Get the topmost function scope */
56     while (scope) {
57         if (scope->flags & JANET_SCOPE_FUNCTION)
58             break;
59         scope = scope->parent;
60     }
61     /* Check if already added */
62     len = janet_v_count(scope->consts);
63     for (i = 0; i < len; i++) {
64         if (janet_equals(x, scope->consts[i]))
65             return i;
66     }
67     /* Ensure not too many constants. */
68     if (len >= 0xFFFF) {
69         janetc_cerror(c, "too many constants");
70         return 0;
71     }
72     janet_v_push(scope->consts, x);
73     return len;
74 }
75 
76 /* Load a constant into a local register */
janetc_loadconst(JanetCompiler * c,Janet k,int32_t reg)77 static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
78     switch (janet_type(k)) {
79         case JANET_NIL:
80             janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
81             break;
82         case JANET_BOOLEAN:
83             janetc_emit(c, (reg << 8) |
84                         (janet_unwrap_boolean(k) ? JOP_LOAD_TRUE : JOP_LOAD_FALSE));
85             break;
86         case JANET_NUMBER: {
87             double dval = janet_unwrap_number(k);
88             if (dval < INT16_MIN || dval > INT16_MAX)
89                 goto do_constant;
90             int32_t i = (int32_t) dval;
91             if (dval != i)
92                 goto do_constant;
93             uint32_t iu = (uint32_t)i;
94             janetc_emit(c,
95                         (iu << 16) |
96                         (reg << 8) |
97                         JOP_LOAD_INTEGER);
98             break;
99         }
100         default:
101         do_constant: {
102                 int32_t cindex = janetc_const(c, k);
103                 janetc_emit(c,
104                             (cindex << 16) |
105                             (reg << 8) |
106                             JOP_LOAD_CONSTANT);
107                 break;
108             }
109     }
110 }
111 
112 /* Move a slot to a near register */
janetc_movenear(JanetCompiler * c,int32_t dest,JanetSlot src)113 static void janetc_movenear(JanetCompiler *c,
114                             int32_t dest,
115                             JanetSlot src) {
116     if (src.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) {
117         janetc_loadconst(c, src.constant, dest);
118         /* If we also are a reference, deref the one element array */
119         if (src.flags & JANET_SLOT_REF) {
120             janetc_emit(c,
121                         (dest << 16) |
122                         (dest << 8) |
123                         JOP_GET_INDEX);
124         }
125     } else if (src.envindex >= 0) {
126         janetc_emit(c,
127                     ((uint32_t)(src.index) << 24) |
128                     ((uint32_t)(src.envindex) << 16) |
129                     ((uint32_t)(dest) << 8) |
130                     JOP_LOAD_UPVALUE);
131     } else if (src.index > 0xFF || src.index != dest) {
132         janetc_emit(c,
133                     ((uint32_t)(src.index) << 16) |
134                     ((uint32_t)(dest) << 8) |
135                     JOP_MOVE_NEAR);
136     }
137 }
138 
139 /* Move a near register to a Slot. */
janetc_moveback(JanetCompiler * c,JanetSlot dest,int32_t src)140 static void janetc_moveback(JanetCompiler *c,
141                             JanetSlot dest,
142                             int32_t src) {
143     if (dest.flags & JANET_SLOT_REF) {
144         int32_t refreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_5);
145         janetc_loadconst(c, dest.constant, refreg);
146         janetc_emit(c,
147                     (src << 16) |
148                     (refreg << 8) |
149                     JOP_PUT_INDEX);
150         janetc_regalloc_freetemp(&c->scope->ra, refreg, JANETC_REGTEMP_5);
151     } else if (dest.envindex >= 0) {
152         janetc_emit(c,
153                     ((uint32_t)(dest.index) << 24) |
154                     ((uint32_t)(dest.envindex) << 16) |
155                     ((uint32_t)(src) << 8) |
156                     JOP_SET_UPVALUE);
157     } else if (dest.index != src) {
158         janetc_emit(c,
159                     ((uint32_t)(dest.index) << 16) |
160                     ((uint32_t)(src) << 8) |
161                     JOP_MOVE_FAR);
162     }
163 }
164 
165 /* Call this to release a register after emitting the instruction. */
janetc_free_regnear(JanetCompiler * c,JanetSlot s,int32_t reg,JanetcRegisterTemp tag)166 static void janetc_free_regnear(JanetCompiler *c, JanetSlot s, int32_t reg, JanetcRegisterTemp tag) {
167     if (reg != s.index ||
168             s.envindex >= 0 ||
169             s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) {
170         /* We need to free the temporary slot */
171         janetc_regalloc_freetemp(&c->scope->ra, reg, tag);
172     }
173 }
174 
175 /* Convert a slot to a two byte register */
janetc_regfar(JanetCompiler * c,JanetSlot s,JanetcRegisterTemp tag)176 static int32_t janetc_regfar(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp tag) {
177     /* check if already near register */
178     if (s.envindex < 0 && s.index >= 0) {
179         return s.index;
180     }
181     int32_t reg;
182     int32_t nearreg = janetc_regalloc_temp(&c->scope->ra, tag);
183     janetc_movenear(c, nearreg, s);
184     if (nearreg >= 0xF0) {
185         reg = janetc_allocfar(c);
186         janetc_emit(c, JOP_MOVE_FAR | (nearreg << 8) | (reg << 16));
187         janetc_regalloc_freetemp(&c->scope->ra, nearreg, tag);
188     } else {
189         reg = nearreg;
190         janetc_regalloc_freetemp(&c->scope->ra, nearreg, tag);
191         janetc_regalloc_touch(&c->scope->ra, reg);
192     }
193     return reg;
194 }
195 
196 /* Convert a slot to a temporary 1 byte register */
janetc_regnear(JanetCompiler * c,JanetSlot s,JanetcRegisterTemp tag)197 static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp tag) {
198     /* check if already near register */
199     if (s.envindex < 0 && s.index >= 0 && s.index <= 0xFF) {
200         return s.index;
201     }
202     int32_t reg = janetc_regalloc_temp(&c->scope->ra, tag);
203     janetc_movenear(c, reg, s);
204     return reg;
205 }
206 
207 /* Check if two slots are equal */
janetc_sequal(JanetSlot lhs,JanetSlot rhs)208 int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
209     if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
210             lhs.index == rhs.index &&
211             lhs.envindex == rhs.envindex) {
212         if (lhs.flags & (JANET_SLOT_REF | JANET_SLOT_CONSTANT)) {
213             return janet_equals(lhs.constant, rhs.constant);
214         } else {
215             return 1;
216         }
217     }
218     return 0;
219 }
220 
221 /* Move values from one slot to another. The destination must
222  * be writeable (not a literal). */
janetc_copy(JanetCompiler * c,JanetSlot dest,JanetSlot src)223 void janetc_copy(
224     JanetCompiler *c,
225     JanetSlot dest,
226     JanetSlot src) {
227     if (dest.flags & JANET_SLOT_CONSTANT) {
228         janetc_cerror(c, "cannot write to constant");
229         return;
230     }
231     if (janetc_sequal(dest, src)) return;
232     /* If dest is a near register */
233     if (dest.envindex < 0 && dest.index >= 0 && dest.index <= 0xFF) {
234         janetc_movenear(c, dest.index, src);
235         return;
236     }
237     /* If src is a near register */
238     if (src.envindex < 0 && src.index >= 0 && src.index <= 0xFF) {
239         janetc_moveback(c, dest, src.index);
240         return;
241     }
242     /* Process: src -> near -> dest */
243     int32_t nearreg = janetc_allocnear(c, JANETC_REGTEMP_3);
244     janetc_movenear(c, nearreg, src);
245     janetc_moveback(c, dest, nearreg);
246     /* Cleanup */
247     janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
248 }
249 
250 /* Instruction templated emitters */
251 
emit1s(JanetCompiler * c,uint8_t op,JanetSlot s,int32_t rest,int wr)252 static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
253     int32_t reg = janetc_regnear(c, s, JANETC_REGTEMP_0);
254     int32_t label = janet_v_count(c->buffer);
255     janetc_emit(c, op | (reg << 8) | ((uint32_t)rest << 16));
256     if (wr)
257         janetc_moveback(c, s, reg);
258     janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
259     return label;
260 }
261 
janetc_emit_s(JanetCompiler * c,uint8_t op,JanetSlot s,int wr)262 int32_t janetc_emit_s(JanetCompiler *c, uint8_t op, JanetSlot s, int wr) {
263     int32_t reg = janetc_regfar(c, s, JANETC_REGTEMP_0);
264     int32_t label = janet_v_count(c->buffer);
265     janetc_emit(c, op | (reg << 8));
266     if (wr)
267         janetc_moveback(c, s, reg);
268     janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
269     return label;
270 }
271 
janetc_emit_sl(JanetCompiler * c,uint8_t op,JanetSlot s,int32_t label)272 int32_t janetc_emit_sl(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t label) {
273     int32_t current = janet_v_count(c->buffer) - 1;
274     int32_t jump = label - current;
275     if (jump < INT16_MIN || jump > INT16_MAX) {
276         janetc_cerror(c, "jump is too far");
277     }
278     return emit1s(c, op, s, jump, 0);
279 }
280 
janetc_emit_st(JanetCompiler * c,uint8_t op,JanetSlot s,int32_t tflags)281 int32_t janetc_emit_st(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t tflags) {
282     return emit1s(c, op, s, tflags, 0);
283 }
284 
janetc_emit_si(JanetCompiler * c,uint8_t op,JanetSlot s,int16_t immediate,int wr)285 int32_t janetc_emit_si(JanetCompiler *c, uint8_t op, JanetSlot s, int16_t immediate, int wr) {
286     return emit1s(c, op, s, immediate, wr);
287 }
288 
janetc_emit_su(JanetCompiler * c,uint8_t op,JanetSlot s,uint16_t immediate,int wr)289 int32_t janetc_emit_su(JanetCompiler *c, uint8_t op, JanetSlot s, uint16_t immediate, int wr) {
290     return emit1s(c, op, s, (int32_t) immediate, wr);
291 }
292 
emit2s(JanetCompiler * c,uint8_t op,JanetSlot s1,JanetSlot s2,int32_t rest,int wr)293 static int32_t emit2s(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, int32_t rest, int wr) {
294     int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
295     int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
296     int32_t label = janet_v_count(c->buffer);
297     janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)rest << 24));
298     janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
299     if (wr)
300         janetc_moveback(c, s1, reg1);
301     janetc_free_regnear(c, s1, reg1, JANETC_REGTEMP_0);
302     return label;
303 }
304 
janetc_emit_ss(JanetCompiler * c,uint8_t op,JanetSlot s1,JanetSlot s2,int wr)305 int32_t janetc_emit_ss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, int wr) {
306     int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
307     int32_t reg2 = janetc_regfar(c, s2, JANETC_REGTEMP_1);
308     int32_t label = janet_v_count(c->buffer);
309     janetc_emit(c, op | (reg1 << 8) | (reg2 << 16));
310     janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
311     if (wr)
312         janetc_moveback(c, s1, reg1);
313     janetc_free_regnear(c, s1, reg1, JANETC_REGTEMP_0);
314     return label;
315 }
316 
janetc_emit_ssi(JanetCompiler * c,uint8_t op,JanetSlot s1,JanetSlot s2,int8_t immediate,int wr)317 int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, int8_t immediate, int wr) {
318     return emit2s(c, op, s1, s2, immediate, wr);
319 }
320 
janetc_emit_ssu(JanetCompiler * c,uint8_t op,JanetSlot s1,JanetSlot s2,uint8_t immediate,int wr)321 int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr) {
322     return emit2s(c, op, s1, s2, (int32_t) immediate, wr);
323 }
324 
janetc_emit_sss(JanetCompiler * c,uint8_t op,JanetSlot s1,JanetSlot s2,JanetSlot s3,int wr)325 int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr) {
326     int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
327     int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
328     int32_t reg3 = janetc_regnear(c, s3, JANETC_REGTEMP_2);
329     int32_t label = janet_v_count(c->buffer);
330     janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)reg3 << 24));
331     janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
332     janetc_free_regnear(c, s3, reg3, JANETC_REGTEMP_2);
333     if (wr)
334         janetc_moveback(c, s1, reg1);
335     janetc_free_regnear(c, s1, reg1, JANETC_REGTEMP_0);
336     return label;
337 }
338