1 /* pkl-asm.c - Macro-assembler for the Poke Virtual Machine. */
2
3 /* Copyright (C) 2019, 2020, 2021 Jose E. Marchesi */
4
5 /* This program is free software: you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 */
18
19 #include <config.h>
20
21 #include <stdarg.h>
22 #include <string.h>
23 #include <assert.h>
24
25 #include "pvm.h"
26 #include "pkl.h"
27 #include "ios.h"
28
29 #include "pkl-asm.h"
30 #include "pkl-env.h"
31 #include "pvm-alloc.h"
32
33 /* Code generated by RAS is used to implement many macro-instructions.
34 Configure it to use the right assembler, and include the assembled
35 macros. */
36 #define RAS_ASM pasm
37 #include "pkl-asm.pkc"
38
39 /* In order to support nested multi-function macros, like conditionals
40 and loops, the assembler implements the notion of "nesting levels".
41 For example, consider the following conditional code:
42
43 ... top-level ...
44
45 pkl_asm_dotimes (pasm, exp);
46 {
47 ... level-1 ...
48
49 pkl_asm_if (pasm, exp);
50 {
51 ... level-2 ...
52 }
53 pkl_asm_end_if (pasm);
54 }
55 pkl_asm_end_dotimes (pasm);
56
57 Levels are stacked and managed using the `pkl_asm_pushlevel' and
58 `pkl_asm_poplevel' functions defined below.
59
60 CURRENT_ENV identifies what kind of instruction created the level.
61 This can be either PKL_ASM_ENV_NULL, PKL_ASM_ENV_CONDITIONAL,
62 PKL_ASM_ENV_LOOP, PKL_ASM_ENV_FOR_IN_LOOP, PKL_ASM_ENV_TRY.
63 PKL_ASM_ENV_NULL should only be used at the top-level.
64
65 PARENT is the parent level, i.e. the level containing this one.
66 This is NULL at the top-level.
67
68 The meaning of the LABEL* and NODE* fields depend on the particular
69 kind of environment. See the details in the implementation of the
70 functions below. */
71
72 #define PKL_ASM_ENV_NULL 0
73 #define PKL_ASM_ENV_CONDITIONAL 1
74 #define PKL_ASM_ENV_LOOP 2
75 #define PKL_ASM_ENV_TRY 3
76 #define PKL_ASM_ENV_FOR_IN_LOOP 4
77 #define PKL_ASM_ENV_FOR_LOOP 5
78
79 struct pkl_asm_level
80 {
81 int current_env;
82 struct pkl_asm_level *parent;
83 pvm_program_label label1;
84 pvm_program_label label2;
85 pvm_program_label label3;
86 pkl_ast_node node1;
87 pkl_ast_node node2;
88 int int1;
89
90 pvm_program_label break_label;
91 pvm_program_label continue_label;
92 };
93
94 /* An assembler instance.
95
96 COMPILER is the PKL compiler using the macro-assembler.
97
98 PROGRAM is the PVM program being assembled.
99
100 LEVEL is a pointer to the top of a stack of levels.
101
102 AST is for creating ast nodes whenever needed.
103
104 ERROR_LABEL marks the generic error handler defined in the standard
105 prologue. */
106
107 #define PKL_ASM_LEVEL(PASM) ((PASM)->level)
108
109 struct pkl_asm
110 {
111 pkl_compiler compiler;
112 pvm_program program;
113 struct pkl_asm_level *level;
114 pkl_ast ast;
115 pvm_program_label error_label;
116 };
117
118 /* Return a PVM value to hold an integral value VALUE of size SIZE and
119 sign SIGNED. */
120
121 static pvm_val
pvm_make_integral(uint64_t value,int size,int signed_p)122 pvm_make_integral (uint64_t value, int size, int signed_p)
123 {
124 pvm_val res;
125
126 if (size < 33)
127 {
128 if (signed_p)
129 res = pvm_make_int (value, size);
130 else
131 res = pvm_make_uint (value, size);
132 }
133 else
134 {
135 if (signed_p)
136 res = pvm_make_long (value, size);
137 else
138 res = pvm_make_ulong (value, size);
139 }
140
141 return res;
142 }
143
144 /* Push a new level to PASM's level stack with ENV. */
145
146 static void
pkl_asm_pushlevel(pkl_asm pasm,int env)147 pkl_asm_pushlevel (pkl_asm pasm, int env)
148 {
149 struct pkl_asm_level *level
150 = pvm_alloc (sizeof (struct pkl_asm_level));
151
152 memset (level, 0, sizeof (struct pkl_asm_level));
153 level->parent = pasm->level;
154 level->current_env = env;
155 pasm->level = level;
156 }
157
158 /* Pop the innermost level from PASM's level stack. */
159
160 static void __attribute__((unused))
pkl_asm_poplevel(pkl_asm pasm)161 pkl_asm_poplevel (pkl_asm pasm)
162 {
163 struct pkl_asm_level *level = pasm->level;
164
165 pasm->level = level->parent;
166 }
167
168 /* Macro-instruction: OTO from_type, to_type
169 ( OFF(from_type) TOUNIT -- OFF(to_type) )
170
171 Generate code to convert an offset value from FROM_TYPE to
172 TO_TYPE. */
173
174 static void
pkl_asm_insn_oto(pkl_asm pasm,pkl_ast_node from_type,pkl_ast_node to_type)175 pkl_asm_insn_oto (pkl_asm pasm,
176 pkl_ast_node from_type,
177 pkl_ast_node to_type)
178 {
179 pkl_ast_node from_base_type = PKL_AST_TYPE_O_BASE_TYPE (from_type);
180 pkl_ast_node from_base_unit = PKL_AST_TYPE_O_UNIT (from_type);
181 pkl_ast_node to_base_type = PKL_AST_TYPE_O_BASE_TYPE (to_type);
182 pkl_ast_node unit_type = PKL_AST_TYPE (from_base_unit);
183
184 RAS_MACRO_OFFSET_CAST (from_base_type, to_base_type, unit_type);
185 }
186
187 /* Macro-instruction: ATOA from_type to_type
188 ( ARR(from_type) -- ARR(to_type) )
189
190 Generate code to convert an array value from FROM_TYPE to TO_TYPE.
191 Both types should be array types, equal but for the boundaries.
192 FROM_TYPE can be NULL. */
193
194 static void
pkl_asm_insn_atoa(pkl_asm pasm,pkl_ast_node from_type,pkl_ast_node to_type)195 pkl_asm_insn_atoa (pkl_asm pasm,
196 pkl_ast_node from_type,
197 pkl_ast_node to_type)
198 {
199 pkl_ast_node to_type_etype = PKL_AST_TYPE_A_ETYPE (to_type);
200 pkl_ast_node bound = PKL_AST_TYPE_A_BOUND (to_type);
201
202 pkl_ast_node from_type_etype = NULL;
203 pkl_ast_node from_bound = NULL;
204
205 if (from_type)
206 {
207 from_type_etype = PKL_AST_TYPE_A_ETYPE (from_type);
208 from_bound = PKL_AST_TYPE_A_BOUND (from_type);
209 }
210
211 /* If the array element is also an array, then convert each of its
212 elements, recursively. */
213 if (PKL_AST_TYPE_CODE (to_type_etype) == PKL_TYPE_ARRAY)
214 {
215 pkl_asm_for_in (pasm, PKL_TYPE_ARRAY, NULL /* selector */);
216 {
217 /* The array is already in the stack. */
218 pkl_asm_insn (pasm, PKL_INSN_DUP);
219 }
220 pkl_asm_for_in_where (pasm);
221 {
222 /* No condition. */
223 }
224 pkl_asm_for_in_loop (pasm);
225 {
226 pkl_asm_insn (pasm, PKL_INSN_PUSHVAR, 0, 0); /* ELEM */
227 pkl_asm_insn_atoa (pasm, from_type_etype, to_type_etype); /* ELEM */
228 pkl_asm_insn (pasm, PKL_INSN_DROP); /* _ */
229 }
230 pkl_asm_for_in_endloop (pasm);
231 }
232
233 /* Now process the array itself. */
234 if (bound == NULL)
235 {
236 if (from_type && from_bound == NULL)
237 /* Both array types are unbounded, hence they are identical =>
238 no need to do anything. */
239 return;
240
241 /* No checks are due in this case, but the value itself
242 should be typed as an unbound array. */
243 pkl_asm_insn (pasm, PKL_INSN_PUSH, PVM_NULL); /* ARR NULL */
244 pkl_asm_insn (pasm, PKL_INSN_ASETTB); /* ARR */
245 }
246 else
247 {
248 pkl_ast_node bound_type = PKL_AST_TYPE (bound);
249 pvm_val bounder = PKL_AST_TYPE_A_BOUNDER (to_type);
250
251 switch (PKL_AST_TYPE_CODE (bound_type))
252 {
253 case PKL_TYPE_INTEGRAL:
254 RAS_MACRO_ARRAY_CONV_SEL (bounder);
255 break;
256 case PKL_TYPE_OFFSET:
257 RAS_MACRO_ARRAY_CONV_SIZ (bounder);
258 break;
259 default:
260 assert (0);
261 }
262 }
263 }
264
265 /* Macro-instruction: BCONC op1_type, op2_type, res_type
266 ( VAL VAL -- VAL VAL VAL )
267
268 Generate code to bit-concatenate the arguments. */
269
270 static void
pkl_asm_insn_bconc(pkl_asm pasm,pkl_ast_node op1_type,pkl_ast_node op2_type,pkl_ast_node res_type)271 pkl_asm_insn_bconc (pkl_asm pasm,
272 pkl_ast_node op1_type,
273 pkl_ast_node op2_type,
274 pkl_ast_node res_type)
275 {
276 RAS_MACRO_BCONC (pvm_make_uint (PKL_AST_TYPE_I_SIZE (op2_type), 32),
277 op1_type, op2_type, res_type);
278 }
279
280 /* Macro-instruction: NTON from_type, to_type
281 ( VAL(from_type) -- VAL(from_type) VAL(to_type) )
282
283 Generate code to convert an integer value from FROM_TYPE to
284 TO_TYPE. Both types should be integral types. */
285
286 static void
pkl_asm_insn_nton(pkl_asm pasm,pkl_ast_node from_type,pkl_ast_node to_type)287 pkl_asm_insn_nton (pkl_asm pasm,
288 pkl_ast_node from_type,
289 pkl_ast_node to_type)
290 {
291 size_t from_type_size = PKL_AST_TYPE_I_SIZE (from_type);
292 int from_type_signed_p = PKL_AST_TYPE_I_SIGNED_P (from_type);
293
294 size_t to_type_size = PKL_AST_TYPE_I_SIZE (to_type);
295 int to_type_signed_p = PKL_AST_TYPE_I_SIGNED_P (to_type);
296
297 if (from_type_size == to_type_size
298 && from_type_signed_p == to_type_signed_p)
299 {
300 /* Wheee, nothing to convert. Just dup. */
301 pkl_asm_insn (pasm, PKL_INSN_DUP);
302 return;
303 }
304 else
305 {
306 static const int cast_table[2][2][2][2] =
307 {
308 /* Source is int. */
309 {
310 /* Destination is int. */
311 {
312 {PKL_INSN_IUTOIU, PKL_INSN_IUTOI},
313 {PKL_INSN_ITOIU, PKL_INSN_ITOI}
314 },
315 /* Destination is long. */
316 {
317 {PKL_INSN_IUTOLU, PKL_INSN_IUTOL},
318 {PKL_INSN_ITOLU, PKL_INSN_ITOL}
319 },
320 },
321 /* Source is long. */
322 {
323 /* Destination is int. */
324 {
325 {PKL_INSN_LUTOIU, PKL_INSN_LUTOI},
326 {PKL_INSN_LTOIU, PKL_INSN_LTOI}
327 },
328 {
329 /* Destination is long. */
330 {PKL_INSN_LUTOLU, PKL_INSN_LUTOL},
331 {PKL_INSN_LTOLU, PKL_INSN_LTOL}
332 },
333 }
334 };
335
336 int fl = !!((from_type_size - 1) & ~0x1f);
337 int fs = from_type_signed_p;
338 int tl = !!((to_type_size - 1) & ~0x1f);
339 int ts = to_type_signed_p;
340
341 pkl_asm_insn (pasm,
342 cast_table [fl][tl][fs][ts],
343 (unsigned int) to_type_size);
344 }
345 }
346
347 /* Macro-instruction: REMAP
348 ( VAL -- VAL )
349
350 Given a mapeable PVM value on the TOS, remap it. */
351
352 static void
pkl_asm_insn_remap(pkl_asm pasm)353 pkl_asm_insn_remap (pkl_asm pasm)
354 {
355 RAS_MACRO_REMAP;
356 }
357
358 /* Macro-instruction: WRITE
359 ( VAL -- VAL )
360
361 Given a mapeable PVM value on the TOS, invoke its writer. */
362
363 static void
pkl_asm_insn_write(pkl_asm pasm)364 pkl_asm_insn_write (pkl_asm pasm)
365 {
366 RAS_MACRO_WRITE;
367 }
368
369 /* Macro-instruction: PEEK type, endian, nenc
370 ( -- VAL )
371
372 Generate code for a peek operation to TYPE, which should be an
373 integral type. */
374
375 static void
pkl_asm_insn_peek(pkl_asm pasm,pkl_ast_node type,unsigned int nenc,unsigned int endian)376 pkl_asm_insn_peek (pkl_asm pasm, pkl_ast_node type,
377 unsigned int nenc, unsigned int endian)
378 {
379 int type_code = PKL_AST_TYPE_CODE (type);
380
381 if (type_code == PKL_TYPE_INTEGRAL)
382 {
383 size_t size = PKL_AST_TYPE_I_SIZE (type);
384 int sign = PKL_AST_TYPE_I_SIGNED_P (type);
385
386 static const int peek_table[2][2] =
387 {
388 {PKL_INSN_PEEKIU, PKL_INSN_PEEKI},
389 {PKL_INSN_PEEKLU, PKL_INSN_PEEKL}
390 };
391
392 int tl = !!((size - 1) & ~0x1f);
393
394 if (sign)
395 pkl_asm_insn (pasm, peek_table[tl][sign],
396 nenc, endian,
397 (unsigned int) size);
398 else
399 pkl_asm_insn (pasm, peek_table[tl][sign],
400 endian,
401 (unsigned int) size);
402 }
403 else
404 assert (0);
405 }
406
407 /* Macro-instruction: PEEKD type
408 ( -- VAL )
409
410 Generate code for a peek operation to TYPE, which should be an
411 integral type. */
412
413 static void
pkl_asm_insn_peekd(pkl_asm pasm,pkl_ast_node type)414 pkl_asm_insn_peekd (pkl_asm pasm, pkl_ast_node type)
415 {
416 int type_code = PKL_AST_TYPE_CODE (type);
417
418 if (type_code == PKL_TYPE_INTEGRAL)
419 {
420 size_t size = PKL_AST_TYPE_I_SIZE (type);
421 int sign = PKL_AST_TYPE_I_SIGNED_P (type);
422
423 static const int peekd_table[2][2] =
424 {
425 {PKL_INSN_PEEKDIU, PKL_INSN_PEEKDI},
426 {PKL_INSN_PEEKDLU, PKL_INSN_PEEKDL}
427 };
428
429 int tl = !!((size - 1) & ~0x1f);
430
431 pkl_asm_insn (pasm, peekd_table[tl][sign],
432 (unsigned int) size);
433 }
434 else
435 assert (0);
436 }
437
438 /* Macro-instruction: PRINT type
439 ( OBASE VAL -- )
440 */
441
442 static void
pkl_asm_insn_print(pkl_asm pasm,pkl_ast_node type)443 pkl_asm_insn_print (pkl_asm pasm, pkl_ast_node type)
444 {
445 int type_code = PKL_AST_TYPE_CODE (type);
446
447 if (type_code == PKL_TYPE_STRING)
448 {
449 pkl_asm_insn (pasm, PKL_INSN_DROP); /* The base. */
450 pkl_asm_insn (pasm, PKL_INSN_PRINTS);
451 }
452 else if (type_code == PKL_TYPE_ANY)
453 {
454 assert (0);
455 }
456 else if (type_code == PKL_TYPE_INTEGRAL)
457 {
458 size_t size = PKL_AST_TYPE_I_SIZE (type);
459 int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
460
461 static const int print_table[2][2] =
462 {
463 {PKL_INSN_PRINTIU, PKL_INSN_PRINTI},
464 {PKL_INSN_PRINTLU, PKL_INSN_PRINTL}
465 };
466
467 int tl = !!((size - 1) & ~0x1f);
468
469 pkl_asm_insn (pasm, print_table[tl][signed_p],
470 (unsigned int) size);
471 }
472 else
473 assert (0);
474 }
475
476 /* Macro-instruction: POKE type, endian, nenc
477 ( -- VAL )
478
479 Generate code for a poke operation to TYPE, which should be an
480 integral type. */
481
482 static void
pkl_asm_insn_poke(pkl_asm pasm,pkl_ast_node type,unsigned int nenc,unsigned int endian)483 pkl_asm_insn_poke (pkl_asm pasm, pkl_ast_node type,
484 unsigned int nenc, unsigned int endian)
485 {
486 int type_code = PKL_AST_TYPE_CODE (type);
487
488 if (type_code == PKL_TYPE_INTEGRAL)
489 {
490 size_t size = PKL_AST_TYPE_I_SIZE (type);
491 int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
492
493 static const int poke_table[2][2] =
494 {
495 {PKL_INSN_POKEIU, PKL_INSN_POKEI},
496 {PKL_INSN_POKELU, PKL_INSN_POKEL}
497 };
498
499 int tl = !!((size - 1) & ~0x1f);
500
501 if (signed_p)
502 pkl_asm_insn (pasm, poke_table[tl][signed_p],
503 nenc, endian,
504 (unsigned int) size);
505 else
506 pkl_asm_insn (pasm, poke_table[tl][signed_p],
507 endian,
508 (unsigned int) size);
509 }
510 else
511 assert (0);
512 }
513
514
515 /* Macro-instruction: POKED type
516 ( OFF VAL -- )
517
518 Generate code for a poke operation to TYPE, which should be an
519 integral type. */
520
521 static void
pkl_asm_insn_poked(pkl_asm pasm,pkl_ast_node type)522 pkl_asm_insn_poked (pkl_asm pasm, pkl_ast_node type)
523 {
524 int type_code = PKL_AST_TYPE_CODE (type);
525
526 if (type_code == PKL_TYPE_INTEGRAL)
527 {
528 size_t size = PKL_AST_TYPE_I_SIZE (type);
529 int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
530
531 static const int poked_table[2][2] =
532 {
533 {PKL_INSN_POKEDIU, PKL_INSN_POKEDI},
534 {PKL_INSN_POKEDLU, PKL_INSN_POKEDL}
535 };
536
537 int tl = !!((size - 1) & ~0x1f);
538
539 pkl_asm_insn (pasm, poked_table[tl][signed_p],
540 (unsigned int) size);
541 }
542 else
543 assert (0);
544 }
545
546 /* Macro-instruction: NEG type
547 ( VAL -- VAL )
548
549 Macro-instruction: ADD type
550 ( VAL VAL -- VAL VAL VAL )
551
552 Macro-instruction: SUB type
553 ( VAL VAL -- VAL VAL VAL )
554
555 Macro-instruction: MUL type
556 ( VAL VAL -- VAL VAL VAL )
557
558 Macro-instruction: DIV type
559 ( VAL VAL -- VAL VAL VAL )
560
561 Macro-instruction: MOD type
562 ( VAL VAL -- VAL VAL VAL )
563
564 Macro-instruction: BNOT type
565 ( VAL -- VAL VAL VAL )
566
567 Macro-instruction: BAND type
568 ( VAL VAL -- VAL VAL VAL )
569
570 Macro-instruction: BOR type
571 ( VAL VAL -- VAL VAL VAL )
572
573 Macro-instruction: BXOR type
574 ( VAL VAL -- VAL VAL VAL )
575
576 Macro-instruction: SL type
577 ( VAL VAL -- VAL VAL VAL )
578
579 Macro-instruction: SR type
580 ( VAL VAL -- VAL VAL VAL )
581
582 Macro-instruction: POW type
583 ( VAL VAL -- VAL VAL VAL )
584
585 Generate code for performing negation, addition, subtraction,
586 multiplication, division, remainder and bit shift to integral and
587 offset operands. Also exponentiation. INSN identifies the
588 operation to perform, and TYPE the type of the operands and the
589 result. */
590
591 static void
pkl_asm_insn_binop(pkl_asm pasm,enum pkl_asm_insn insn,pkl_ast_node type)592 pkl_asm_insn_binop (pkl_asm pasm,
593 enum pkl_asm_insn insn,
594 pkl_ast_node type)
595 {
596 if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_INTEGRAL)
597 {
598 static const int neg_table[2][2] = {{ PKL_INSN_NEGIU, PKL_INSN_NEGI },
599 { PKL_INSN_NEGLU, PKL_INSN_NEGL }};
600
601 static const int add_table[2][2] = {{ PKL_INSN_ADDIU, PKL_INSN_ADDI },
602 { PKL_INSN_ADDLU, PKL_INSN_ADDL }};
603
604 static const int sub_table[2][2] = {{ PKL_INSN_SUBIU, PKL_INSN_SUBI },
605 { PKL_INSN_SUBLU, PKL_INSN_SUBL }};
606
607 static const int mul_table[2][2] = {{ PKL_INSN_MULIU, PKL_INSN_MULI },
608 { PKL_INSN_MULLU, PKL_INSN_MULL }};
609
610 static const int div_table[2][2] = {{ PKL_INSN_DIVIU, PKL_INSN_DIVI },
611 { PKL_INSN_DIVLU, PKL_INSN_DIVL }};
612
613 static const int mod_table[2][2] = {{ PKL_INSN_MODIU, PKL_INSN_MODI },
614 { PKL_INSN_MODLU, PKL_INSN_MODL }};
615
616 static const int bnot_table[2][2] = {{ PKL_INSN_BNOTIU, PKL_INSN_BNOTI },
617 { PKL_INSN_BNOTLU, PKL_INSN_BNOTL }};
618
619 static const int band_table[2][2] = {{ PKL_INSN_BANDIU, PKL_INSN_BANDI },
620 { PKL_INSN_BANDLU, PKL_INSN_BANDL }};
621
622 static const int bor_table[2][2] = {{ PKL_INSN_BORIU, PKL_INSN_BORI },
623 { PKL_INSN_BORLU, PKL_INSN_BORL }};
624
625 static const int bxor_table[2][2] = {{ PKL_INSN_BXORIU, PKL_INSN_BXORI },
626 { PKL_INSN_BXORLU, PKL_INSN_BXORL }};
627
628 static const int sl_table[2][2] = {{ PKL_INSN_SLIU, PKL_INSN_SLI },
629 { PKL_INSN_SLLU, PKL_INSN_SLL }};
630
631 static const int sr_table[2][2] = {{ PKL_INSN_SRIU, PKL_INSN_SRI },
632 { PKL_INSN_SRLU, PKL_INSN_SRL }};
633
634 static const int pow_table[2][2] = {{ PKL_INSN_POWIU, PKL_INSN_POWI },
635 { PKL_INSN_POWLU, PKL_INSN_POWL }};
636
637 uint64_t size = PKL_AST_TYPE_I_SIZE (type);
638 int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
639 int tl = !!((size - 1) & ~0x1f);
640
641 switch (insn)
642 {
643 case PKL_INSN_NEG:
644 pkl_asm_insn (pasm, neg_table[tl][signed_p]);
645 break;
646 case PKL_INSN_ADD:
647 pkl_asm_insn (pasm, add_table[tl][signed_p]);
648 break;
649 case PKL_INSN_SUB:
650 pkl_asm_insn (pasm, sub_table[tl][signed_p]);
651 break;
652 case PKL_INSN_MUL:
653 pkl_asm_insn (pasm, mul_table[tl][signed_p]);
654 break;
655 case PKL_INSN_DIV:
656 pkl_asm_insn (pasm, div_table[tl][signed_p]);
657 break;
658 case PKL_INSN_MOD:
659 pkl_asm_insn (pasm, mod_table[tl][signed_p]);
660 break;
661 case PKL_INSN_BNOT:
662 pkl_asm_insn (pasm, bnot_table[tl][signed_p]);
663 break;
664 case PKL_INSN_BAND:
665 pkl_asm_insn (pasm, band_table[tl][signed_p]);
666 break;
667 case PKL_INSN_BOR:
668 pkl_asm_insn (pasm, bor_table[tl][signed_p]);
669 break;
670 case PKL_INSN_BXOR:
671 pkl_asm_insn (pasm, bxor_table[tl][signed_p]);
672 break;
673 case PKL_INSN_SL:
674 pkl_asm_insn (pasm, sl_table[tl][signed_p]);
675 break;
676 case PKL_INSN_SR:
677 pkl_asm_insn (pasm, sr_table[tl][signed_p]);
678 break;
679 case PKL_INSN_POW:
680 pkl_asm_insn (pasm, pow_table[tl][signed_p]);
681 break;
682 default:
683 assert (0);
684 }
685 }
686 else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_OFFSET)
687 {
688 pkl_ast_node base_type = PKL_AST_TYPE_O_BASE_TYPE (type);
689 pkl_ast_node unit = PKL_AST_TYPE_O_UNIT (type);
690
691 if (insn == PKL_INSN_NEG || insn == PKL_INSN_BNOT)
692 {
693 pkl_asm_insn (pasm, PKL_INSN_OGETM); /* OFF OMAG */
694 pkl_asm_insn_binop (pasm, insn, base_type); /* OFF OMAG NOMAG */
695 pkl_asm_insn (pasm, PKL_INSN_NIP); /* OFF NOMAG */
696 pkl_asm_insn (pasm, PKL_INSN_PUSH,
697 pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
698 /* OFF NOMAG RUNIT */
699 pkl_asm_insn (pasm, PKL_INSN_MKO); /* OFF ROFF */
700 }
701 else if (insn == PKL_INSN_SL
702 || insn == PKL_INSN_SR
703 || insn == PKL_INSN_POW)
704 {
705 pkl_asm_insn (pasm, PKL_INSN_OVER); /* OFF UINT OFF */
706 pkl_asm_insn (pasm, PKL_INSN_OGETM); /* OFF UINT OFF OMAG */
707 pkl_asm_insn (pasm, PKL_INSN_NIP); /* OFF UINT OMAG */
708 pkl_asm_insn (pasm, PKL_INSN_SWAP); /* OFF OMAG UINT */
709 pkl_asm_insn_binop (pasm, insn, base_type); /* OFF OMAG UINT NOMAG */
710 pkl_asm_insn (pasm, PKL_INSN_ROT); /* OFF UINT NOMAG OMAG */
711 pkl_asm_insn (pasm, PKL_INSN_DROP); /* OFF UINT NOMAG */
712 pkl_asm_insn (pasm, PKL_INSN_PUSH,
713 pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
714 /* OFF UINT NOMAG RUNIT */
715 pkl_asm_insn (pasm, PKL_INSN_MKO); /* OFF1 OFF2 ROFF */
716 }
717 else
718 {
719 pkl_asm_insn (pasm, PKL_INSN_OVER); /* OFF1 OFF2 OFF1 */
720 pkl_asm_insn (pasm, PKL_INSN_OVER); /* OFF1 OFF2 OFF1 OFF2 */
721 pkl_asm_insn (pasm, PKL_INSN_OGETM); /* ... OFF1 OFF2 OMAG2 */
722 pkl_asm_insn (pasm, PKL_INSN_NIP); /* ... OFF1 OMAG2 */
723 pkl_asm_insn (pasm, PKL_INSN_SWAP); /* ... OMAG2 OFF1 */
724 pkl_asm_insn (pasm, PKL_INSN_OGETM); /* ... OMAG2 OFF1 OMAG1 */
725 pkl_asm_insn (pasm, PKL_INSN_NIP); /* ... OMAG2 OMAG1 */
726 pkl_asm_insn (pasm, PKL_INSN_SWAP); /* ... OMAG1 OMAG2 */
727 pkl_asm_insn_binop (pasm, insn, base_type); /* ... OMAG1 OMAG2 RMAG */
728 pkl_asm_insn (pasm, PKL_INSN_NIP2); /* OFF1 OFF2 RMAG */
729 pkl_asm_insn (pasm, PKL_INSN_PUSH,
730 pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
731 /* OFF1 OFF2 RMAG RUNIT */
732 pkl_asm_insn (pasm, PKL_INSN_MKO); /* OFF1 OFF2 ROFF */
733 }
734 }
735 else
736 assert (0);
737 }
738
739 /*
740 Macro-instruction: CDIV type
741 ( VAL VAL -- VAL VAL VAL )
742 */
743
744 static void
pkl_asm_insn_cdiv(pkl_asm pasm,enum pkl_asm_insn insn,pkl_ast_node type)745 pkl_asm_insn_cdiv (pkl_asm pasm,
746 enum pkl_asm_insn insn,
747 pkl_ast_node type)
748 {
749 pvm_val one = pvm_make_integral (1,
750 PKL_AST_TYPE_I_SIZE (type),
751 PKL_AST_TYPE_I_SIGNED_P (type));
752
753 RAS_MACRO_CDIV (one, type);
754 }
755
756 /*
757 Macro-instruction: CDIVO type
758 ( VAL VAL -- VAL VAL VAL )
759 */
760
761 static void
pkl_asm_insn_cdivo(pkl_asm pasm,enum pkl_asm_insn insn,pkl_ast_node base_type)762 pkl_asm_insn_cdivo (pkl_asm pasm,
763 enum pkl_asm_insn insn,
764 pkl_ast_node base_type)
765 {
766 RAS_MACRO_CDIVO (base_type);
767 }
768
769 /* Macro-instruction: EQ type
770 ( VAL VAL -- INT )
771
772 Macro-instruction: NE type
773 ( VAL VAL -- INT )
774
775 Macro-instruction: LT type
776 ( VAL VAL -- INT )
777
778 Macro-instruction: GT type
779 ( VAL VAL -- INT )
780
781 Macro-instruction: GE type
782 ( VAL VAL -- INT )
783
784 Macro-instruction: LE type
785 ( VAL VAL -- INT )
786
787 Generate code for perfoming a comparison operation, to either
788 integral or string operands. INSN identifies the operation to
789 perform, and TYPE the type of the operands. */
790
791 static void
pkl_asm_insn_cmp(pkl_asm pasm,enum pkl_asm_insn insn,pkl_ast_node type)792 pkl_asm_insn_cmp (pkl_asm pasm,
793 enum pkl_asm_insn insn,
794 pkl_ast_node type)
795 {
796 enum pkl_asm_insn oinsn;
797
798 /* Decide what instruction to assembly. */
799 if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_STRING)
800 {
801 switch (insn)
802 {
803 case PKL_INSN_EQ: oinsn = PKL_INSN_EQS; break;
804 case PKL_INSN_NE: oinsn = PKL_INSN_NES; break;
805 case PKL_INSN_LT: oinsn = PKL_INSN_LTS; break;
806 case PKL_INSN_GT: oinsn = PKL_INSN_GTS; break;
807 case PKL_INSN_GE: oinsn = PKL_INSN_GES; break;
808 case PKL_INSN_LE: oinsn = PKL_INSN_LES; break;
809 default:
810 assert (0);
811 }
812
813 /* Assembly the instruction. */
814 pkl_asm_insn (pasm, oinsn);
815 }
816 else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_INTEGRAL)
817 {
818 static const int eq_table[2][2] = {{ PKL_INSN_EQIU, PKL_INSN_EQI },
819 { PKL_INSN_EQLU, PKL_INSN_EQL }};
820
821 static const int ne_table[2][2] = {{ PKL_INSN_NEIU, PKL_INSN_NEI },
822 { PKL_INSN_NELU, PKL_INSN_NEL }};
823 static const int lt_table[2][2] = {{ PKL_INSN_LTIU, PKL_INSN_LTI },
824 { PKL_INSN_LTLU, PKL_INSN_LTL }};
825
826 static const int gt_table[2][2] = {{ PKL_INSN_GTIU, PKL_INSN_GTI },
827 { PKL_INSN_GTLU, PKL_INSN_GTL }};
828
829 static const int ge_table[2][2] = {{ PKL_INSN_GEIU, PKL_INSN_GEI },
830 { PKL_INSN_GELU, PKL_INSN_GEL }};
831
832 static const int le_table[2][2] = {{ PKL_INSN_LEIU, PKL_INSN_LEI },
833 { PKL_INSN_LELU, PKL_INSN_LEL }};
834
835 uint64_t size = PKL_AST_TYPE_I_SIZE (type);
836 int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
837 int tl = !!((size - 1) & ~0x1f);
838
839 switch (insn)
840 {
841 case PKL_INSN_EQ: oinsn = eq_table[tl][signed_p]; break;
842 case PKL_INSN_NE: oinsn = ne_table[tl][signed_p]; break;
843 case PKL_INSN_LT: oinsn = lt_table[tl][signed_p]; break;
844 case PKL_INSN_GT: oinsn = gt_table[tl][signed_p]; break;
845 case PKL_INSN_GE: oinsn = ge_table[tl][signed_p]; break;
846 case PKL_INSN_LE: oinsn = le_table[tl][signed_p]; break;
847 default:
848 assert (0);
849 break;
850 }
851
852 /* Assembly the instruction. */
853 pkl_asm_insn (pasm, oinsn);
854 }
855 else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_OFFSET)
856 {
857 pkl_ast_node base_type = PKL_AST_TYPE_O_BASE_TYPE (type);
858
859 pkl_asm_insn (pasm, PKL_INSN_SWAP); /* OFF2 OFF1 */
860 pkl_asm_insn (pasm, PKL_INSN_OGETM); /* OFF2 OFF1 OFF1M */
861 pkl_asm_insn (pasm, PKL_INSN_ROT); /* OFF1 OFF1M OFF2 */
862 pkl_asm_insn (pasm, PKL_INSN_OGETM); /* OFF1 OFF1M OFF2 OFF2M */
863 pkl_asm_insn (pasm, PKL_INSN_ROT); /* OFF1 OFF2 OFF2M OFF1M */
864 pkl_asm_insn (pasm, PKL_INSN_SWAP); /* OFF1 OFF2 OFF1M OFF2M */
865 pkl_asm_insn (pasm, insn, base_type);
866 pkl_asm_insn (pasm, PKL_INSN_NIP2); /* OFF1 OFF2 (OFF1M?OFF2M) */
867 }
868 else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_ARRAY)
869 {
870 assert (insn == PKL_INSN_EQ || insn == PKL_INSN_NE);
871
872 RAS_MACRO_EQA (PKL_AST_TYPE_A_ETYPE (type));
873 if (insn == PKL_INSN_NE)
874 {
875 pkl_asm_insn (pasm, PKL_INSN_NOT);
876 pkl_asm_insn (pasm, PKL_INSN_NIP);
877 }
878 }
879 else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_STRUCT)
880 {
881 pvm_val struct_comparator = PKL_AST_TYPE_S_COMPARATOR (type);
882
883 assert (insn == PKL_INSN_EQ || insn == PKL_INSN_NE);
884
885 /* Call the comparator of the struct type, which must exist at
886 this point. */
887 assert (struct_comparator != PVM_NULL);
888 pkl_asm_insn (pasm, PKL_INSN_OVER); /* SCT1 SCT2 SCT1 */
889 pkl_asm_insn (pasm, PKL_INSN_OVER); /* SCT1 SCT2 SCT1 SCT2 */
890 pkl_asm_insn (pasm, PKL_INSN_PUSH, struct_comparator); /* SCT1 SCT2 SCT1 SCT2 CLS */
891 pkl_asm_insn (pasm, PKL_INSN_CALL); /* SCT1 SCT2 INT */
892
893 if (insn == PKL_INSN_NE)
894 {
895 pkl_asm_insn (pasm, PKL_INSN_NOT);
896 pkl_asm_insn (pasm, PKL_INSN_NIP);
897 }
898 }
899 else if (PKL_AST_TYPE_CODE (type) == PKL_TYPE_FUNCTION)
900 {
901 /* Function values are never equal. */
902 pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_int (0, 32));
903 }
904 else
905 assert (0);
906 }
907
908 /* Macro-instruction: SSETI struct_type
909 ( SCT STR VAL -- SCT )
910
911 Given a struct, a string containing the name of a struct element,
912 and a value, set the value to the referred element. If setting the
913 element causes a problem with the integrity of the data stored in
914 the struct (for example, a constraint expresssion fails) then the
915 operation is aborted and PVM_E_CONSTRAINT is raised. */
916
917 static void
pkl_asm_insn_sseti(pkl_asm pasm,pkl_ast_node struct_type)918 pkl_asm_insn_sseti (pkl_asm pasm, pkl_ast_node struct_type)
919 {
920 RAS_MACRO_SSETI (struct_type);
921 }
922
923 /* Macro-instruction: ACONC array_elem_type
924 ( ARR ARR -- ARR ARR ARR )
925
926 Given two arrays of the same type (but with potentially different
927 bounds) generate code to push a new array value with the
928 concatenation of the elements of both arrays. */
929
930 static void
pkl_asm_insn_aconc(pkl_asm pasm)931 pkl_asm_insn_aconc (pkl_asm pasm)
932 {
933 RAS_MACRO_ACONC;
934 }
935
936 /* Macro-instruction: AFILL
937 ( ARR VAL -- ARR VAL )
938
939 Given an array and a value of the right type, set all the
940 elements of the array to the given value. */
941
942 static void
pkl_asm_insn_afill(pkl_asm pasm)943 pkl_asm_insn_afill (pkl_asm pasm)
944 {
945 RAS_MACRO_AFILL;
946 }
947
948 /* Macro-instruction: ATRIM array_type
949 ( ARR ULONG ULONG -- ARR ULONG ULONG ARR )
950
951 Given an array and two indexes, generate code to push the trim
952 of the array. */
953
954 static void
pkl_asm_insn_atrim(pkl_asm pasm,pkl_ast_node array_type)955 pkl_asm_insn_atrim (pkl_asm pasm, pkl_ast_node array_type)
956 {
957 RAS_MACRO_ATRIM (array_type);
958 }
959
960 /* Macro-instruction: GCD type
961 ( VAL VAL -- VAL VAL )
962
963 Calculate the greatest common divisor of the integral values at the
964 TOS, which should be of type TYPE. */
965
966 static void
pkl_asm_insn_gcd(pkl_asm pasm,pkl_ast_node type)967 pkl_asm_insn_gcd (pkl_asm pasm, pkl_ast_node type)
968 {
969 RAS_MACRO_GCD (type);
970 }
971
972 /* Macro-instruction: ADDO base_type
973 ( OFF OFF -- OFF OFF OFF )
974
975 Add the two given offsets in the stack, which must be of the given
976 base type.
977
978 The base type of the result is BASE_TYPE. */
979
980 static void
pkl_asm_insn_addo(pkl_asm pasm,pkl_ast_node base_type,pkl_ast_node unit)981 pkl_asm_insn_addo (pkl_asm pasm, pkl_ast_node base_type,
982 pkl_ast_node unit)
983 {
984 RAS_MACRO_ADDO (base_type,
985 pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
986 }
987
988 /* Macro-instruction: SUBO base_type
989 ( OFF OFF -- OFF OFF OFF )
990
991 Subtract the two given offsets in the stack, which must be of the given
992 base type.
993
994 The base type of the result is BASE_TYPE. */
995
996 static void
pkl_asm_insn_subo(pkl_asm pasm,pkl_ast_node base_type,pkl_ast_node unit)997 pkl_asm_insn_subo (pkl_asm pasm, pkl_ast_node base_type,
998 pkl_ast_node unit)
999 {
1000 RAS_MACRO_SUBO (base_type,
1001 pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
1002 }
1003
1004 /* Macro-instruction: MULO base_type
1005 ( OFF VAL -- OFF VAL OFF )
1006
1007 Multiply an offset with a magnitude. The types of both the offset
1008 base type and the magnitude type is BASE_TYPE. */
1009
1010 static void
pkl_asm_insn_mulo(pkl_asm pasm,pkl_ast_node base_type)1011 pkl_asm_insn_mulo (pkl_asm pasm, pkl_ast_node base_type)
1012 {
1013 RAS_MACRO_MULO (base_type);
1014 }
1015
1016 /* Macro-instruction: DIVO base_type
1017 ( OFF OFF -- OFF OFF VAL )
1018
1019 Divide an offset by another offset. The result of the operation is
1020 a magnitude. The types of both the offsets base type and the
1021 magnitude type is BASE_TYPE. */
1022
1023 static void
pkl_asm_insn_divo(pkl_asm pasm,pkl_ast_node base_type)1024 pkl_asm_insn_divo (pkl_asm pasm, pkl_ast_node base_type)
1025 {
1026 RAS_MACRO_DIVO (base_type);
1027 }
1028
1029 /* Macro-instruction: MODO base_type
1030 ( OFF OFF -- OFF OFF OFF )
1031
1032 Calculate the modulus of two offsets. The result of the operation
1033 is an offset. */
1034
1035 static void
pkl_asm_insn_modo(pkl_asm pasm,pkl_ast_node base_type,pkl_ast_node unit)1036 pkl_asm_insn_modo (pkl_asm pasm, pkl_ast_node base_type,
1037 pkl_ast_node unit)
1038 {
1039 RAS_MACRO_MODO (base_type,
1040 pvm_make_ulong (PKL_AST_INTEGER_VALUE (unit), 64));
1041 }
1042
1043
1044 /* Macro-instruction: SWAPGT type
1045 ( VAL VAL -- VAL VAL )
1046
1047 Swap the integral values at the top of the stack, of type TYPE, if
1048 the value at the under-top is greater than the value at the
1049 top. */
1050
1051 static void
pkl_asm_insn_swapgt(pkl_asm pasm,pkl_ast_node type)1052 pkl_asm_insn_swapgt (pkl_asm pasm, pkl_ast_node type)
1053 {
1054 static const int swapgt_table[2][2] = {{PKL_INSN_SWAPGTIU, PKL_INSN_SWAPGTI},
1055 {PKL_INSN_SWAPGTLU, PKL_INSN_SWAPGTL}};
1056
1057 size_t size = PKL_AST_TYPE_I_SIZE (type);
1058 int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
1059
1060 int tl = !!((size - 1) & ~0x1f);
1061 pkl_asm_insn (pasm, swapgt_table[tl][signed_p]);
1062 }
1063
1064 /* Macro-instruction: BZ type, label
1065 ( -- )
1066
1067 Branch to LABEL if the integer value of type TYPE at the top of the
1068 stack is zero. */
1069
1070 static void
pkl_asm_insn_bz(pkl_asm pasm,pkl_ast_node type,pvm_program_label label)1071 pkl_asm_insn_bz (pkl_asm pasm,
1072 pkl_ast_node type,
1073 pvm_program_label label)
1074 {
1075 static const int bz_table[2][2] = {{PKL_INSN_BZIU, PKL_INSN_BZI},
1076 {PKL_INSN_BZLU, PKL_INSN_BZL}};
1077
1078 size_t size = PKL_AST_TYPE_I_SIZE (type);
1079 int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
1080
1081 int tl = !!((size - 1) & ~0x1f);
1082
1083 pkl_asm_insn (pasm, bz_table[tl][signed_p], label);
1084 }
1085
1086 /* Macro-instruction: BNZ type, label
1087 ( -- )
1088
1089 Branch to LABEL if the integer value of type TYPE at the top of the
1090 stack is not zero. */
1091
1092 static void
pkl_asm_insn_bnz(pkl_asm pasm,pkl_ast_node type,pvm_program_label label)1093 pkl_asm_insn_bnz (pkl_asm pasm,
1094 pkl_ast_node type,
1095 pvm_program_label label)
1096 {
1097 static const int bnz_table[2][2] = {{PKL_INSN_BNZIU, PKL_INSN_BNZI},
1098 {PKL_INSN_BNZLU, PKL_INSN_BNZL}};
1099
1100 size_t size = PKL_AST_TYPE_I_SIZE (type);
1101 int signed_p = PKL_AST_TYPE_I_SIGNED_P (type);
1102
1103 int tl = !!((size - 1) & ~0x1f);
1104
1105 pkl_asm_insn (pasm, bnz_table[tl][signed_p], label);
1106 }
1107
1108 /* Macro-instruction: AIS type
1109 ( VAL ARR -- VAL ARR BOOL )
1110
1111 Push 0 (false) if the given VAL is not found in the container ARR.
1112 Push 1 (true) otherwise. */
1113
1114 static void
pkl_asm_insn_ais(pkl_asm pasm,pkl_ast_node atype)1115 pkl_asm_insn_ais (pkl_asm pasm, pkl_ast_node atype)
1116 {
1117 RAS_MACRO_AIS (PKL_AST_TYPE_A_ETYPE (atype));
1118 }
1119
1120 /* Create a new instance of an assembler. This initializes a new
1121 routine. */
1122
1123 pkl_asm
pkl_asm_new(pkl_ast ast,pkl_compiler compiler,int prologue)1124 pkl_asm_new (pkl_ast ast, pkl_compiler compiler,
1125 int prologue)
1126 {
1127 pkl_asm pasm = pvm_alloc (sizeof (struct pkl_asm));
1128 pvm_program program = pvm_program_new ();
1129
1130 memset (pasm, 0, sizeof (struct pkl_asm));
1131 pkl_asm_pushlevel (pasm, PKL_ASM_ENV_NULL);
1132
1133 pasm->compiler = compiler;
1134 pasm->ast = ast;
1135 pasm->error_label = pvm_program_fresh_label (program);
1136 pasm->program = program;
1137
1138 if (prologue)
1139 {
1140 /* Standard prologue. */
1141 pkl_asm_note (pasm, "#begin prologue");
1142
1143 /* Install the stack canary. */
1144 pkl_asm_insn (pasm, PKL_INSN_CANARY);
1145
1146 /* Initialize the IO base register to [0 b]. */
1147 pkl_asm_insn (pasm, PKL_INSN_PUSH,
1148 pvm_make_offset (pvm_make_int (0, 32),
1149 pvm_make_ulong (1, 64)));
1150 pkl_asm_insn (pasm, PKL_INSN_POPR, 0);
1151
1152 /* Install the default signal handler. */
1153 pkl_asm_insn (pasm, PKL_INSN_PUSH,
1154 pvm_make_exception (PVM_E_GENERIC, PVM_E_GENERIC_MSG,
1155 PVM_E_GENERIC_ESTATUS));
1156 pkl_asm_insn (pasm, PKL_INSN_PUSHE, pasm->error_label);
1157 pkl_asm_note (pasm, "#end prologue");
1158 }
1159
1160 return pasm;
1161 }
1162
1163 /* Finish the assembly of the current program and return it. This
1164 function frees all resources used by the assembler instance, and
1165 `pkl_asm_new' should be called again in order to assemble another
1166 program. */
1167
1168 pvm_program
pkl_asm_finish(pkl_asm pasm,int epilogue)1169 pkl_asm_finish (pkl_asm pasm, int epilogue)
1170 {
1171 pvm_program program = pasm->program;
1172
1173 if (epilogue)
1174 {
1175 pkl_asm_note (pasm, "#begin epilogue");
1176
1177 /* Successful program finalization. */
1178 pkl_asm_insn (pasm, PKL_INSN_POPE);
1179 pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_int (PVM_EXIT_OK, 32));
1180 pkl_asm_insn (pasm, PKL_INSN_EXIT);
1181
1182 pvm_program_append_label (pasm->program, pasm->error_label);
1183
1184 /* Default exception handler. If we are bootstrapping the
1185 compiler, then use a very simple one inlined here in
1186 assembly. Otherwise, call the _pkl_exception_handler
1187 function which is part of the compiler run-time. */
1188 if (pkl_bootstrapped_p (pasm->compiler))
1189 pkl_asm_call (pasm, "_pkl_exception_handler");
1190 else
1191 {
1192 pkl_asm_insn (pasm, PKL_INSN_DROP); /* Discard the exception. */
1193 pkl_asm_insn (pasm, PKL_INSN_PUSH,
1194 pvm_make_string ("unhandled exception while bootstrapping\n"));
1195 pkl_asm_insn (pasm, PKL_INSN_PRINTS);
1196 pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_int (PVM_EXIT_ERROR, 32));
1197 }
1198
1199 /* The exit status is now on the stack. Add the result value of
1200 the execution, which in this case is null. */
1201 pkl_asm_insn (pasm, PKL_INSN_PUSH, PVM_NULL);
1202 pkl_asm_insn (pasm, PKL_INSN_SWAP);
1203
1204 pkl_asm_insn (pasm, PKL_INSN_EXIT);
1205 pkl_asm_note (pasm, "#end epilogue");
1206 }
1207
1208 /* Free the first level. */
1209 pkl_asm_poplevel (pasm);
1210
1211 /* Free the assembler instance and return the assembled program to
1212 the user. */
1213 return program;
1214 }
1215
1216 /* Assemble an instruction INSN and append it to the program being
1217 assembled in PASM. If the instruction takes any argument, they
1218 follow after INSN. */
1219
1220 void
pkl_asm_insn(pkl_asm pasm,enum pkl_asm_insn insn,...)1221 pkl_asm_insn (pkl_asm pasm, enum pkl_asm_insn insn, ...)
1222 {
1223 static const char *insn_names[] =
1224 {
1225 #define PKL_DEF_INSN(SYM, ARGS, NAME) NAME,
1226 # include "pkl-insn.def"
1227 #undef PKL_DEF_INSN
1228 };
1229
1230 static const char *insn_args[] =
1231 {
1232 #define PKL_DEF_INSN(SYM, ARGS, NAME) ARGS,
1233 # include "pkl-insn.def"
1234 #undef PKL_DEF_INSN
1235 };
1236
1237 va_list valist;
1238
1239 if (insn == PKL_INSN_PUSH)
1240 {
1241 pvm_val val;
1242
1243 va_start (valist, insn);
1244 val = va_arg (valist, pvm_val);
1245 va_end (valist);
1246
1247 pvm_program_append_push_instruction (pasm->program, val);
1248 }
1249 else if (insn < PKL_INSN_MACRO)
1250 {
1251 /* This is a PVM instruction. Process its arguments and append
1252 it to the PVM program. */
1253
1254 const char *insn_name = insn_names[insn];
1255 const char *p;
1256
1257 pvm_program_append_instruction (pasm->program, insn_name);
1258
1259 va_start (valist, insn);
1260 for (p = insn_args[insn]; *p != '\0'; ++p)
1261 {
1262 char arg_class = *p;
1263
1264 switch (arg_class)
1265 {
1266 case 'v':
1267 {
1268 pvm_val val = va_arg (valist, pvm_val);
1269
1270 /* This is to be removed when Jitter is fixed so it
1271 can use 64-bit elements in 32-bit machines. We
1272 have hacks to prevent the assert below in both
1273 pkl_asm_note and the push instructions. */
1274 #if defined POKE_HOST_32BIT
1275 assert (0);
1276 #endif
1277 pvm_program_append_val_parameter (pasm->program, val);
1278 break;
1279 }
1280 case 'n':
1281 {
1282 unsigned int n = va_arg (valist, unsigned int);
1283 pvm_program_append_unsigned_parameter (pasm->program, n);
1284 break;
1285 }
1286 case 'l':
1287 {
1288 pvm_program_label label
1289 = va_arg (valist, pvm_program_label);
1290 pvm_program_append_label_parameter (pasm->program, label);
1291 break;
1292 }
1293 case 'r':
1294 {
1295 pvm_register reg = va_arg (valist, pvm_register);
1296 pvm_program_append_register_parameter (pasm->program, reg);
1297 break;
1298 }
1299 case 'a':
1300 /* Fallthrough. */
1301 case 'i':
1302 assert (0);
1303 break;
1304 }
1305 }
1306 va_end (valist);
1307 }
1308 else
1309 {
1310 /* This is a macro-instruction. Dispatch to the corresponding
1311 macro-instruction handler. */
1312
1313 switch (insn)
1314 {
1315 case PKL_INSN_BCONC:
1316 {
1317 pkl_ast_node op1_type, op2_type;
1318 pkl_ast_node res_type;
1319
1320 va_start (valist, insn);
1321 op1_type = va_arg (valist, pkl_ast_node);
1322 op2_type = va_arg (valist, pkl_ast_node);
1323 res_type = va_arg (valist, pkl_ast_node);
1324 va_end (valist);
1325
1326 pkl_asm_insn_bconc (pasm, op1_type, op2_type, res_type);
1327 break;
1328 }
1329 case PKL_INSN_NTON:
1330 case PKL_INSN_OTO:
1331 case PKL_INSN_ATOA:
1332 {
1333 pkl_ast_node from_type;
1334 pkl_ast_node to_type;
1335
1336 va_start (valist, insn);
1337 from_type = va_arg (valist, pkl_ast_node);
1338 to_type = va_arg (valist, pkl_ast_node);
1339 va_end (valist);
1340
1341 if (insn == PKL_INSN_NTON)
1342 pkl_asm_insn_nton (pasm, from_type, to_type);
1343 else if (insn == PKL_INSN_ATOA)
1344 pkl_asm_insn_atoa (pasm, from_type, to_type);
1345 else
1346 pkl_asm_insn_oto (pasm, from_type, to_type);
1347 break;
1348 }
1349 case PKL_INSN_PEEK:
1350 case PKL_INSN_POKE:
1351 {
1352 pkl_ast_node type;
1353 unsigned int endian, nenc;
1354
1355 va_start (valist, insn);
1356 type = va_arg (valist, pkl_ast_node);
1357 nenc = va_arg (valist, unsigned int);
1358 endian = va_arg (valist, unsigned int);
1359 va_end (valist);
1360
1361 if (insn == PKL_INSN_PEEK)
1362 pkl_asm_insn_peek (pasm, type, nenc, endian);
1363 else
1364 pkl_asm_insn_poke (pasm, type, nenc, endian);
1365 break;
1366 }
1367 case PKL_INSN_PRINT:
1368 {
1369 pkl_ast_node type;
1370
1371 va_start (valist, insn);
1372 type = va_arg (valist, pkl_ast_node);
1373 va_end (valist);
1374
1375 pkl_asm_insn_print (pasm, type);
1376 break;
1377 }
1378 case PKL_INSN_PEEKD:
1379 case PKL_INSN_POKED:
1380 {
1381 pkl_ast_node integral_type;
1382
1383 va_start (valist, insn);
1384 integral_type = va_arg (valist, pkl_ast_node);
1385 va_end (valist);
1386
1387 if (insn == PKL_INSN_PEEKD)
1388 pkl_asm_insn_peekd (pasm, integral_type);
1389 else
1390 pkl_asm_insn_poked (pasm, integral_type);
1391 break;
1392 }
1393 case PKL_INSN_BZ:
1394 {
1395 pkl_ast_node type;
1396 pvm_program_label label;
1397
1398 va_start (valist, insn);
1399 type = va_arg (valist, pkl_ast_node);
1400 label = va_arg (valist, pvm_program_label);
1401 va_end (valist);
1402
1403 pkl_asm_insn_bz (pasm, type, label);
1404 break;
1405 }
1406 case PKL_INSN_BNZ:
1407 {
1408 pkl_ast_node type;
1409 pvm_program_label label;
1410
1411 va_start (valist, insn);
1412 type = va_arg (valist, pkl_ast_node);
1413 label = va_arg (valist, pvm_program_label);
1414 va_end (valist);
1415
1416 pkl_asm_insn_bnz (pasm, type, label);
1417 break;
1418 }
1419 case PKL_INSN_SWAPGT:
1420 {
1421 pkl_ast_node type;
1422
1423 va_start (valist, insn);
1424 type = va_arg (valist, pkl_ast_node);
1425 va_end (valist);
1426
1427 pkl_asm_insn_swapgt (pasm, type);
1428 break;
1429 }
1430 case PKL_INSN_AIS:
1431 {
1432 pkl_ast_node atype;
1433
1434 va_start (valist, insn);
1435 atype = va_arg (valist, pkl_ast_node);
1436 va_end (valist);
1437
1438 pkl_asm_insn_ais (pasm, atype);
1439 break;
1440 }
1441 case PKL_INSN_NEG:
1442 case PKL_INSN_ADD:
1443 case PKL_INSN_SUB:
1444 case PKL_INSN_MUL:
1445 case PKL_INSN_DIV:
1446 case PKL_INSN_MOD:
1447 case PKL_INSN_BNOT:
1448 case PKL_INSN_BAND:
1449 case PKL_INSN_BOR:
1450 case PKL_INSN_BXOR:
1451 case PKL_INSN_SL:
1452 case PKL_INSN_SR:
1453 case PKL_INSN_POW:
1454 {
1455 pkl_ast_node type;
1456
1457 va_start (valist, insn);
1458 type = va_arg (valist, pkl_ast_node);
1459 va_end (valist);
1460
1461 pkl_asm_insn_binop (pasm, insn, type);
1462 break;
1463 }
1464 case PKL_INSN_CDIV:
1465 case PKL_INSN_CDIVO:
1466 {
1467 pkl_ast_node type;
1468
1469 va_start (valist, insn);
1470 type = va_arg (valist, pkl_ast_node);
1471 va_end (valist);
1472
1473 if (insn == PKL_INSN_CDIV)
1474 pkl_asm_insn_cdiv (pasm, insn, type);
1475 else
1476 pkl_asm_insn_cdivo (pasm, insn, type);
1477 break;
1478 }
1479 case PKL_INSN_EQ:
1480 case PKL_INSN_NE:
1481 case PKL_INSN_LT:
1482 case PKL_INSN_GT:
1483 case PKL_INSN_GE:
1484 case PKL_INSN_LE:
1485 {
1486 pkl_ast_node type;
1487
1488 va_start (valist, insn);
1489 type = va_arg (valist, pkl_ast_node);
1490 va_end (valist);
1491
1492 pkl_asm_insn_cmp (pasm, insn, type);
1493 break;
1494 }
1495 case PKL_INSN_GCD:
1496 {
1497 pkl_ast_node type;
1498
1499 va_start (valist, insn);
1500 type = va_arg (valist, pkl_ast_node);
1501 va_end (valist);
1502
1503 pkl_asm_insn_gcd (pasm, type);
1504 break;
1505 }
1506 case PKL_INSN_ATRIM:
1507 {
1508 pkl_ast_node array_type;
1509
1510 va_start (valist, insn);
1511 array_type = va_arg (valist, pkl_ast_node);
1512 va_end (valist);
1513
1514 pkl_asm_insn_atrim (pasm, array_type);
1515 break;
1516 }
1517 case PKL_INSN_ADDO:
1518 case PKL_INSN_SUBO:
1519 case PKL_INSN_MULO:
1520 case PKL_INSN_DIVO:
1521 case PKL_INSN_MODO:
1522 {
1523 pkl_ast_node base_type;
1524 pkl_ast_node unit = NULL;
1525
1526 va_start (valist, insn);
1527 base_type = va_arg (valist, pkl_ast_node);
1528 if (insn == PKL_INSN_ADDO || insn == PKL_INSN_SUBO
1529 || insn == PKL_INSN_MODO)
1530 unit = va_arg (valist, pkl_ast_node);
1531 va_end (valist);
1532
1533 if (insn == PKL_INSN_ADDO)
1534 pkl_asm_insn_addo (pasm, base_type, unit);
1535 else if (insn == PKL_INSN_SUBO)
1536 pkl_asm_insn_subo (pasm, base_type, unit);
1537 else if (insn == PKL_INSN_MULO)
1538 pkl_asm_insn_mulo (pasm, base_type);
1539 else if (insn == PKL_INSN_DIVO)
1540 pkl_asm_insn_divo (pasm, base_type);
1541 else if (insn == PKL_INSN_MODO)
1542 pkl_asm_insn_modo (pasm, base_type, unit);
1543 else
1544 assert (0);
1545 break;
1546 }
1547 case PKL_INSN_REMAP:
1548 pkl_asm_insn_remap (pasm);
1549 break;
1550 case PKL_INSN_WRITE:
1551 pkl_asm_insn_write (pasm);
1552 break;
1553 case PKL_INSN_ACONC:
1554 pkl_asm_insn_aconc (pasm);
1555 break;
1556 case PKL_INSN_AFILL:
1557 pkl_asm_insn_afill (pasm);
1558 break;
1559 case PKL_INSN_SSETI:
1560 {
1561 pkl_ast_node struct_type;
1562
1563 va_start (valist, insn);
1564 struct_type = va_arg (valist, pkl_ast_node);
1565 va_end (valist);
1566
1567 pkl_asm_insn_sseti (pasm, struct_type);
1568 break;
1569 }
1570 case PKL_INSN_MACRO:
1571 default:
1572 assert (0);
1573 }
1574 }
1575 }
1576
1577 /* Emit a .note directive with STR as its contents. */
1578
1579 void
pkl_asm_note(pkl_asm pasm,const char * str)1580 pkl_asm_note (pkl_asm pasm, const char *str)
1581 {
1582 /* note doesn't work in 32-bit because of jitter's inability to pass
1583 64-bit pointers as arguments to instructions in 32-bit. */
1584 #if !defined POKE_HOST_32BIT
1585 pkl_asm_insn (pasm, PKL_INSN_NOTE, pvm_make_string (str));
1586 #endif
1587 }
1588
1589 /* The following functions implement conditional constructions. The
1590 code generated is:
1591
1592 ... condition expression ...
1593 BZ label1;
1594 POP the condition expression
1595 ... then body ...
1596 BA label2;
1597 label1:
1598 POP the condition expression
1599 ... else body ...
1600 label2:
1601
1602 Thus, conditionals use two labels. */
1603
1604 void
pkl_asm_if(pkl_asm pasm,pkl_ast_node exp)1605 pkl_asm_if (pkl_asm pasm, pkl_ast_node exp)
1606 {
1607 pkl_asm_pushlevel (pasm, PKL_ASM_ENV_CONDITIONAL);
1608
1609 pasm->level->label1 = pvm_program_fresh_label (pasm->program);
1610 pasm->level->label2 = pvm_program_fresh_label (pasm->program);
1611 pasm->level->node1 = ASTREF (exp);
1612 }
1613
1614 void
pkl_asm_then(pkl_asm pasm)1615 pkl_asm_then (pkl_asm pasm)
1616 {
1617 assert (pasm->level->current_env == PKL_ASM_ENV_CONDITIONAL);
1618
1619 pkl_asm_insn (pasm, PKL_INSN_BZ,
1620 PKL_AST_TYPE (pasm->level->node1),
1621 pasm->level->label1);
1622 /* Pop the expression condition from the stack. */
1623 pkl_asm_insn (pasm, PKL_INSN_DROP);
1624 }
1625
1626 void
pkl_asm_else(pkl_asm pasm)1627 pkl_asm_else (pkl_asm pasm)
1628 {
1629 assert (pasm->level->current_env == PKL_ASM_ENV_CONDITIONAL);
1630
1631 pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label2);
1632 pvm_program_append_label (pasm->program, pasm->level->label1);
1633 /* Pop the expression condition from the stack. */
1634 pkl_asm_insn (pasm, PKL_INSN_DROP);
1635 }
1636
1637 void
pkl_asm_endif(pkl_asm pasm)1638 pkl_asm_endif (pkl_asm pasm)
1639 {
1640 assert (pasm->level->current_env == PKL_ASM_ENV_CONDITIONAL);
1641 pvm_program_append_label (pasm->program, pasm->level->label2);
1642
1643 /* Cleanup and pop the current level. */
1644 pkl_ast_node_free (pasm->level->node1);
1645 pkl_asm_poplevel (pasm);
1646 }
1647
1648 /* The following functions implement try-catch blocks. The code
1649 generated is:
1650
1651 PUSH-REGISTERS
1652 PUSHE label1
1653 ... code ...
1654 POPE
1655 POP-REGISTERS
1656 BA label2
1657 label1:
1658 ... handler ...
1659 label2:
1660
1661 Thus, try-catch blocks use two labels.
1662
1663 Note that pkl_asm_try expects to find an Exception at the top of
1664 the main stack. */
1665
1666 void
pkl_asm_try(pkl_asm pasm,pkl_ast_node arg)1667 pkl_asm_try (pkl_asm pasm, pkl_ast_node arg)
1668 {
1669 pkl_asm_pushlevel (pasm, PKL_ASM_ENV_TRY);
1670
1671 if (arg)
1672 pasm->level->node1 = ASTREF (arg);
1673 pasm->level->label1 = pvm_program_fresh_label (pasm->program);
1674 pasm->level->label2 = pvm_program_fresh_label (pasm->program);
1675
1676 /* pkl_asm_note (pasm, "PUSH-REGISTERS"); */
1677 pkl_asm_insn (pasm, PKL_INSN_PUSHE, pasm->level->label1);
1678 }
1679
1680 void
pkl_asm_catch(pkl_asm pasm)1681 pkl_asm_catch (pkl_asm pasm)
1682 {
1683 assert (pasm->level->current_env == PKL_ASM_ENV_TRY);
1684
1685 pkl_asm_insn (pasm, PKL_INSN_POPE);
1686 pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label2);
1687 pvm_program_append_label (pasm->program, pasm->level->label1);
1688
1689 /* At this point the Exception is at the top of the stack. If the
1690 catch block received an argument, push a new environment and set
1691 it as a local. Otherwise, just discard it. */
1692
1693 if (pasm->level->node1)
1694 {
1695 pkl_asm_insn (pasm, PKL_INSN_PUSHF, 1);
1696 pkl_asm_insn (pasm, PKL_INSN_REGVAR);
1697 }
1698 else
1699 pkl_asm_insn (pasm, PKL_INSN_DROP);
1700 }
1701
1702 void
pkl_asm_endtry(pkl_asm pasm)1703 pkl_asm_endtry (pkl_asm pasm)
1704 {
1705 assert (pasm->level->current_env == PKL_ASM_ENV_TRY);
1706
1707 /* Pop the catch frame if it is was created. */
1708 if (pasm->level->node1)
1709 pkl_asm_insn (pasm, PKL_INSN_POPF, 1);
1710
1711 pvm_program_append_label (pasm->program, pasm->level->label2);
1712
1713 /* Cleanup and pop the current level. */
1714 pkl_ast_node_free (pasm->level->node1);
1715 pkl_asm_poplevel (pasm);
1716 }
1717
1718 /* The following functions implement simple unrestricted loops. The
1719 code generated is:
1720
1721 label1:
1722 ... loop body ...
1723 continue_label:
1724 SYNC
1725 BA label1;
1726 break_label:
1727 */
1728
1729 void
pkl_asm_loop(pkl_asm pasm)1730 pkl_asm_loop (pkl_asm pasm)
1731 {
1732 pkl_asm_pushlevel (pasm, PKL_ASM_ENV_LOOP);
1733
1734 pasm->level->label1 = pvm_program_fresh_label (pasm->program);
1735 pasm->level->break_label = pvm_program_fresh_label (pasm->program);
1736 pasm->level->continue_label = pvm_program_fresh_label (pasm->program);
1737 pvm_program_append_label (pasm->program, pasm->level->label1);
1738 }
1739
1740 void
pkl_asm_endloop(pkl_asm pasm)1741 pkl_asm_endloop (pkl_asm pasm)
1742 {
1743 pvm_program_append_label (pasm->program, pasm->level->continue_label);
1744 pkl_asm_insn (pasm, PKL_INSN_SYNC);
1745 pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label1);
1746 pvm_program_append_label (pasm->program, pasm->level->break_label);
1747
1748 /* Cleanup and pop the current level. */
1749 pkl_asm_poplevel (pasm);
1750 }
1751
1752 /* The following functions implement while loops. The code generated
1753 is:
1754
1755 label1:
1756 ... loop condition expression ...
1757 BZ label2;
1758 POP the condition expression
1759 ... loop body ...
1760 continue_label:
1761 SYNC
1762 BA label1;
1763 label2:
1764 POP the condition expression
1765 break_label:
1766
1767 Thus, loops use two labels. */
1768
1769 void
pkl_asm_while(pkl_asm pasm)1770 pkl_asm_while (pkl_asm pasm)
1771 {
1772 pkl_asm_pushlevel (pasm, PKL_ASM_ENV_LOOP);
1773
1774 pasm->level->label1 = pvm_program_fresh_label (pasm->program);
1775 pasm->level->label2 = pvm_program_fresh_label (pasm->program);
1776 pasm->level->break_label = pvm_program_fresh_label (pasm->program);
1777 pasm->level->continue_label = pvm_program_fresh_label (pasm->program);
1778
1779 pvm_program_append_label (pasm->program, pasm->level->label1);
1780 }
1781
1782 void
pkl_asm_while_loop(pkl_asm pasm)1783 pkl_asm_while_loop (pkl_asm pasm)
1784 {
1785 pkl_asm_insn (pasm, PKL_INSN_BZI, pasm->level->label2);
1786 /* Pop the loop condition from the stack. */
1787 pkl_asm_insn (pasm, PKL_INSN_DROP);
1788 }
1789
1790 void
pkl_asm_while_endloop(pkl_asm pasm)1791 pkl_asm_while_endloop (pkl_asm pasm)
1792 {
1793 pvm_program_append_label (pasm->program,
1794 pasm->level->continue_label);
1795 pkl_asm_insn (pasm, PKL_INSN_SYNC);
1796 pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label1);
1797 pvm_program_append_label (pasm->program, pasm->level->label2);
1798 /* Pop the loop condition from the stack. */
1799 pkl_asm_insn (pasm, PKL_INSN_DROP);
1800
1801 pvm_program_append_label (pasm->program, pasm->level->break_label);
1802
1803 /* Cleanup and pop the current level. */
1804 pkl_asm_poplevel (pasm);
1805 }
1806
1807 /* The following functions implement for loops. The code generated
1808 is:
1809
1810 FOR (HEAD; CONDITION; TAIL) { BODY }
1811
1812 PUHSF
1813 ... HEAD ...
1814 label1:
1815 ... condition ...
1816 label2:
1817 ... BODY ...
1818 continue_label:
1819 ... TAIL ...
1820 BA label1
1821 label3:
1822 DROP
1823 break_label:
1824 POPF
1825 */
1826
1827 void
pkl_asm_for(pkl_asm pasm,pkl_ast_node head)1828 pkl_asm_for (pkl_asm pasm, pkl_ast_node head)
1829 {
1830 pkl_asm_pushlevel (pasm, PKL_ASM_ENV_FOR_LOOP);
1831
1832 pasm->level->node1 = ASTREF (head);
1833 pasm->level->label1 = pvm_program_fresh_label (pasm->program);
1834 pasm->level->label2 = pvm_program_fresh_label (pasm->program);
1835 pasm->level->label3 = pvm_program_fresh_label (pasm->program);
1836 pasm->level->continue_label = pvm_program_fresh_label (pasm->program);
1837 pasm->level->break_label = pvm_program_fresh_label (pasm->program);
1838
1839 if (head)
1840 pkl_asm_insn (pasm, PKL_INSN_PUSHF, 0);
1841 }
1842
1843 void
pkl_asm_for_condition(pkl_asm pasm)1844 pkl_asm_for_condition (pkl_asm pasm)
1845 {
1846 pvm_program_append_label (pasm->program, pasm->level->label1);
1847 }
1848
1849 void
pkl_asm_for_loop(pkl_asm pasm)1850 pkl_asm_for_loop (pkl_asm pasm)
1851 {
1852 pkl_asm_insn (pasm, PKL_INSN_BZI, pasm->level->label3);
1853 /* Pop the loop condition from the stack. */
1854 pkl_asm_insn (pasm, PKL_INSN_DROP);
1855 /* XXX label2 is unused. */
1856 pvm_program_append_label (pasm->program, pasm->level->label2);
1857 }
1858
1859 void
pkl_asm_for_tail(pkl_asm pasm)1860 pkl_asm_for_tail (pkl_asm pasm)
1861 {
1862 pvm_program_append_label (pasm->program, pasm->level->continue_label);
1863 }
1864
1865 void
pkl_asm_for_endloop(pkl_asm pasm)1866 pkl_asm_for_endloop (pkl_asm pasm)
1867 {
1868 pkl_asm_insn (pasm, PKL_INSN_SYNC);
1869 pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label1);
1870 pvm_program_append_label (pasm->program, pasm->level->label3);
1871 pkl_asm_insn (pasm, PKL_INSN_DROP); /* The condition boolean */
1872 pvm_program_append_label (pasm->program, pasm->level->break_label);
1873
1874 if (pasm->level->node1)
1875 pkl_asm_insn (pasm, PKL_INSN_POPF, 1);
1876
1877 /* Cleanup and pop the current level. */
1878 pkl_ast_node_free (pasm->level->node1);
1879 pkl_asm_poplevel (pasm);
1880 }
1881
1882 /* The following functions implement for-in-where loops. The code
1883 generated is:
1884
1885 FOR (VAR in CONTAINER where CONDITION) { BODY }
1886
1887 State to keep: CONTAINER length. index in CONTAINER.
1888
1889 ; CONTAINER
1890 label1:
1891 PUSHF
1892 PUSH NULL ; CONTAINER NULL
1893 REGVAR ; CONTAINER
1894 SEL ; CONTAINER NELEMS
1895 PUSH 0UL ; CONTAINER NELEMS 0
1896 SWAP ; CONTAINER 0 NELEMS
1897 PUSH NULL ; CONTAINER 0 NELEMS NULL
1898 label2:
1899 DROP ; CONTAINER I NELEMS
1900 EQLU ; CONTAINER I NELEMS BOOL
1901 BNZI label3
1902 POP ; CONTAINER I NELEMS
1903 ; Set the iterator for this iteration.
1904 ROT ; I NELEMS CONTAINER
1905 ROT ; NELEMS CONTAINER I
1906 AREF|STRREF ; NELEMS CONTAINER I IVAL
1907 POPVAR 0,0 ; NELEMS CONTAINER I
1908 ROT ; CONTAINER I NELEMS
1909 ; Increase the iterator counter
1910 SWAP ; CONTAINER NELEMS I
1911 PUSH 1UL ; CONTAINER NELEMS I 1
1912 ADDLU ; CONTAINER NELEMS I 1 (I+1)
1913 NIP2 ; CONTAINER NELEMS (I+1)
1914 SWAP ; CONTAINER (I+1) NELEMS
1915 #if SELECTOR
1916 ; Evaluate the selector and skip this iteration if it is
1917 ; not true
1918
1919 ... CONDITION ... ; CONTAINER (I+1) NELEMS BOOL
1920 BZ label2;
1921 DROP ; CONTAINER (I+1) NELEMS
1922 #endif
1923
1924 ... BODY ...
1925
1926 continue_label:
1927 PUSH null ; CONTAINER (I+1) NELEMS null
1928 BA label2
1929 label3:
1930 DROP ; CONTAINER I NELEMS
1931 break_label:
1932 DROP ; CONTAINER I
1933 DROP ; CONTAINER
1934 DROP ; _
1935 POPF 1
1936 */
1937
1938 void
pkl_asm_for_in(pkl_asm pasm,int container_type,pkl_ast_node selector)1939 pkl_asm_for_in (pkl_asm pasm, int container_type,
1940 pkl_ast_node selector)
1941 {
1942 pkl_asm_pushlevel (pasm, PKL_ASM_ENV_FOR_IN_LOOP);
1943
1944 pasm->level->label1 = pvm_program_fresh_label (pasm->program);
1945 pasm->level->label2 = pvm_program_fresh_label (pasm->program);
1946 pasm->level->label3 = pvm_program_fresh_label (pasm->program);
1947 pasm->level->break_label = pvm_program_fresh_label (pasm->program);
1948 pasm->level->continue_label = pvm_program_fresh_label (pasm->program);
1949
1950 if (selector)
1951 pasm->level->node1 = ASTREF (selector);
1952 assert (container_type == PKL_TYPE_ARRAY
1953 || container_type == PKL_TYPE_STRING);
1954 pasm->level->int1 = container_type;
1955 }
1956
1957 void
pkl_asm_for_in_where(pkl_asm pasm)1958 pkl_asm_for_in_where (pkl_asm pasm)
1959 {
1960 pvm_program_append_label (pasm->program, pasm->level->label1);
1961
1962 pkl_asm_insn (pasm, PKL_INSN_PUSHF, 1);
1963 pkl_asm_insn (pasm, PKL_INSN_PUSH, PVM_NULL);
1964 pkl_asm_insn (pasm, PKL_INSN_REGVAR);
1965 pkl_asm_insn (pasm, PKL_INSN_SEL);
1966 pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_ulong (0, 64));
1967 pkl_asm_insn (pasm, PKL_INSN_SWAP);
1968 pkl_asm_insn (pasm, PKL_INSN_PUSH, PVM_NULL);
1969
1970 pvm_program_append_label (pasm->program, pasm->level->label2);
1971
1972 pkl_asm_insn (pasm, PKL_INSN_DROP);
1973 pkl_asm_insn (pasm, PKL_INSN_EQLU);
1974 pkl_asm_insn (pasm, PKL_INSN_BNZI, pasm->level->label3);
1975 pkl_asm_insn (pasm, PKL_INSN_DROP);
1976
1977 /* Set the iterator for this iteration. */
1978 pkl_asm_insn (pasm, PKL_INSN_ROT);
1979 pkl_asm_insn (pasm, PKL_INSN_ROT);
1980 if (pasm->level->int1 == PKL_TYPE_ARRAY)
1981 pkl_asm_insn (pasm, PKL_INSN_AREF);
1982 else
1983 pkl_asm_insn (pasm, PKL_INSN_STRREF);
1984 pkl_asm_insn (pasm, PKL_INSN_POPVAR, 0, 0);
1985 pkl_asm_insn (pasm, PKL_INSN_ROT);
1986
1987 /* Increase the iterator counter. */
1988 pkl_asm_insn (pasm, PKL_INSN_SWAP);
1989 pkl_asm_insn (pasm, PKL_INSN_PUSH, pvm_make_ulong (1, 64));
1990 pkl_asm_insn (pasm, PKL_INSN_ADDLU);
1991 pkl_asm_insn (pasm, PKL_INSN_NIP2);
1992 pkl_asm_insn (pasm, PKL_INSN_SWAP);
1993 }
1994
1995 void
pkl_asm_for_in_loop(pkl_asm pasm)1996 pkl_asm_for_in_loop (pkl_asm pasm)
1997 {
1998 if (pasm->level->node1)
1999 {
2000 /* A selector condition has been evaluated and it is at the top
2001 of the stack. */
2002 pkl_asm_insn (pasm, PKL_INSN_BZ,
2003 PKL_AST_TYPE (pasm->level->node1),
2004 pasm->level->label2);
2005 pkl_asm_insn (pasm, PKL_INSN_DROP);
2006 }
2007 }
2008
2009 void
pkl_asm_for_in_endloop(pkl_asm pasm)2010 pkl_asm_for_in_endloop (pkl_asm pasm)
2011 {
2012 pvm_program_append_label (pasm->program,
2013 pasm->level->continue_label);
2014 pkl_asm_insn (pasm, PKL_INSN_SYNC);
2015 pkl_asm_insn (pasm, PKL_INSN_PUSH, PVM_NULL);
2016 pkl_asm_insn (pasm, PKL_INSN_BA, pasm->level->label2);
2017
2018 pvm_program_append_label (pasm->program, pasm->level->label3);
2019
2020 /* Cleanup the stack, and pop the current frame from the
2021 environment. */
2022 pkl_asm_insn (pasm, PKL_INSN_DROP);
2023 pvm_program_append_label (pasm->program, pasm->level->break_label);
2024 pkl_asm_insn (pasm, PKL_INSN_DROP);
2025 pkl_asm_insn (pasm, PKL_INSN_DROP);
2026 pkl_asm_insn (pasm, PKL_INSN_DROP);
2027 pkl_asm_insn (pasm, PKL_INSN_POPF, 1);
2028
2029 /* Cleanup and pop the current level. */
2030 pkl_ast_node_free (pasm->level->node1);
2031 pkl_asm_poplevel (pasm);
2032 }
2033
2034 void
pkl_asm_call(pkl_asm pasm,const char * funcname)2035 pkl_asm_call (pkl_asm pasm, const char *funcname)
2036 {
2037 pkl_env compiler_env = pkl_get_env (pasm->compiler);
2038 int back, over;
2039 pkl_ast_node tmp;
2040
2041 assert (pkl_env_toplevel_p (compiler_env));
2042
2043 tmp = pkl_env_lookup (compiler_env, PKL_ENV_NS_MAIN,
2044 funcname, &back, &over);
2045 assert (tmp != NULL);
2046 assert (back == 0);
2047
2048 pkl_asm_insn (pasm, PKL_INSN_PUSHTOPVAR, over);
2049 pkl_asm_insn (pasm, PKL_INSN_CALL);
2050 }
2051
2052 static pvm_program_label
pkl_asm_break_label_1(struct pkl_asm_level * level)2053 pkl_asm_break_label_1 (struct pkl_asm_level *level)
2054 {
2055 switch (level->current_env)
2056 {
2057 case PKL_ASM_ENV_LOOP:
2058 case PKL_ASM_ENV_FOR_LOOP:
2059 case PKL_ASM_ENV_FOR_IN_LOOP:
2060 return level->break_label;
2061 break;
2062 default:
2063 return pkl_asm_break_label_1 (level->parent);
2064 break;
2065 }
2066
2067 /* The compiler must guarantee this does NOT happen. */
2068 assert (0);
2069 }
2070
2071 pvm_program_label
pkl_asm_break_label(pkl_asm pasm)2072 pkl_asm_break_label (pkl_asm pasm)
2073 {
2074 return pkl_asm_break_label_1 (pasm->level);
2075 }
2076
2077 /* XXX avoid code duplication with the break statement. */
2078 static pvm_program_label
pkl_asm_continue_label_1(struct pkl_asm_level * level)2079 pkl_asm_continue_label_1 (struct pkl_asm_level *level)
2080 {
2081 switch (level->current_env)
2082 {
2083 case PKL_ASM_ENV_LOOP:
2084 case PKL_ASM_ENV_FOR_LOOP:
2085 case PKL_ASM_ENV_FOR_IN_LOOP:
2086 return level->continue_label;
2087 break;
2088 default:
2089 return pkl_asm_continue_label_1 (level->parent);
2090 break;
2091 }
2092
2093 /* The compiler must guarantee this does NOT happen. */
2094 assert (0);
2095 }
2096
2097 pvm_program_label
pkl_asm_continue_label(pkl_asm pasm)2098 pkl_asm_continue_label (pkl_asm pasm)
2099 {
2100 return pkl_asm_continue_label_1 (pasm->level);
2101 }
2102
2103 pvm_program_label
pkl_asm_fresh_label(pkl_asm pasm)2104 pkl_asm_fresh_label (pkl_asm pasm)
2105 {
2106 return pvm_program_fresh_label (pasm->program);
2107 }
2108
2109 void
pkl_asm_label(pkl_asm pasm,pvm_program_label label)2110 pkl_asm_label (pkl_asm pasm, pvm_program_label label)
2111 {
2112 pvm_program_append_label (pasm->program, label);
2113 }
2114