1 /* pkl-gen.c - Code generation phase for the poke compiler. */
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 #include <stdio.h>
21 #include <assert.h>
22 #include <string.h>
23
24 #include "pkl.h"
25 #include "pkl-gen.h"
26 #include "pkl-ast.h"
27 #include "pkl-pass.h"
28 #include "pkl-asm.h"
29 #include "pvm.h"
30
31 /* The following macros are used in the rules below, to reduce
32 verbosity. */
33
34 #define PKL_GEN_PAYLOAD ((pkl_gen_payload) PKL_PASS_PAYLOAD)
35
36 #define PKL_GEN_AN_ASM(ASM) \
37 (PKL_GEN_PAYLOAD->ASM[PKL_GEN_PAYLOAD->cur_##ASM])
38
39 #define PKL_GEN_ASM PKL_GEN_AN_ASM(pasm)
40 #define PKL_GEN_ASM2 PKL_GEN_AN_ASM(pasm2)
41
42 #define PKL_GEN_PUSH_AN_ASM(ASM,new_pasm) \
43 do \
44 { \
45 assert (PKL_GEN_PAYLOAD->cur_##ASM < PKL_GEN_MAX_PASM); \
46 PKL_GEN_PAYLOAD->ASM[++(PKL_GEN_PAYLOAD->cur_##ASM)] = (new_pasm); \
47 } \
48 while (0)
49
50 #define PKL_GEN_PUSH_ASM(new_pasm) PKL_GEN_PUSH_AN_ASM(pasm,new_pasm)
51 #define PKL_GEN_PUSH_ASM2(new_pasm) PKL_GEN_PUSH_AN_ASM(pasm2,new_pasm)
52
53 #define PKL_GEN_POP_AN_ASM(ASM) \
54 do \
55 { \
56 assert (PKL_GEN_PAYLOAD->cur_##ASM > 0); \
57 PKL_GEN_PAYLOAD->cur_##ASM -= 1; \
58 } \
59 while (0)
60
61 #define PKL_GEN_POP_ASM PKL_GEN_POP_AN_ASM(pasm)
62 #define PKL_GEN_POP_ASM2 PKL_GEN_POP_AN_ASM(pasm2)
63
64 #define PKL_GEN_IN_CTX_P(CTX) \
65 (PKL_GEN_PAYLOAD->context[PKL_GEN_PAYLOAD->cur_context] & (CTX))
66
67 #define PKL_GEN_DUP_CONTEXT \
68 do \
69 { \
70 assert (PKL_GEN_PAYLOAD->cur_context < PKL_GEN_MAX_CTX); \
71 PKL_GEN_PAYLOAD->context[PKL_GEN_PAYLOAD->cur_context + 1] \
72 = PKL_GEN_PAYLOAD->context[PKL_GEN_PAYLOAD->cur_context]; \
73 PKL_GEN_PAYLOAD->cur_context++; \
74 } \
75 while (0)
76
77 #define PKL_GEN_PUSH_CONTEXT \
78 do \
79 { \
80 assert (PKL_GEN_PAYLOAD->cur_context < PKL_GEN_MAX_CTX); \
81 PKL_GEN_PAYLOAD->context[PKL_GEN_PAYLOAD->cur_context + 1] \
82 = 0; \
83 PKL_GEN_PAYLOAD->cur_context++; \
84 } \
85 while (0)
86
87 #define PKL_GEN_POP_CONTEXT \
88 do \
89 { \
90 assert (PKL_GEN_PAYLOAD->cur_context > 0); \
91 PKL_GEN_PAYLOAD->cur_context--; \
92 } \
93 while (0)
94
95 #define PKL_GEN_SET_CONTEXT(CTX) \
96 do \
97 { \
98 PKL_GEN_PAYLOAD->context[PKL_GEN_PAYLOAD->cur_context] |= (CTX); \
99 } \
100 while (0)
101
102 #define PKL_GEN_CLEAR_CONTEXT(CTX) \
103 do \
104 { \
105 PKL_GEN_PAYLOAD->context[PKL_GEN_PAYLOAD->cur_context] &= ~(CTX); \
106 } \
107 while (0)
108
109
110 /* Code generated by RAS is used in the handlers below. Configure it
111 to use the main assembler in the GEN payload. Then just include
112 the assembled macros in this file. */
113 #define RAS_ASM PKL_GEN_ASM
114 #define RAS_PUSH_ASM PKL_GEN_PUSH_ASM
115 #define RAS_POP_ASM PKL_GEN_POP_ASM
116 #include "pkl-gen.pkc"
117
118 /*
119 * SRC
120 */
121
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_src)122 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_src)
123 {
124 PKL_GEN_PAYLOAD->in_file_p
125 = (PKL_AST_SRC_FILENAME (PKL_PASS_NODE) != NULL);
126 }
127 PKL_PHASE_END_HANDLER
128
129 /*
130 * PROGRAM
131 * | PROGRAM_ELEM
132 * | ...
133 *
134 * This function initializes the payload and also generates the
135 * standard prologue.
136 */
137
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_program)138 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_program)
139 {
140 PKL_GEN_ASM = pkl_asm_new (PKL_PASS_AST,
141 PKL_GEN_PAYLOAD->compiler,
142 1 /* prologue */);
143
144 PKL_GEN_PAYLOAD->in_file_p
145 = (!pkl_compiling_statement_p (PKL_GEN_PAYLOAD->compiler)
146 && !pkl_compiling_expression_p (PKL_GEN_PAYLOAD->compiler));
147 }
148 PKL_PHASE_END_HANDLER
149
150 /*
151 * | PROGRAM_ELEM
152 * | ...
153 * PROGRAM
154 */
155
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_program)156 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_program)
157 {
158 /* Make sure there is always some value returned in the stack, since
159 that is expected in the PVM. */
160 if (!pkl_compiling_expression_p (PKL_GEN_PAYLOAD->compiler)
161 && !(pkl_compiling_statement_p (PKL_GEN_PAYLOAD->compiler)
162 && PKL_AST_PROGRAM_ELEMS (PKL_PASS_NODE)
163 && PKL_AST_CODE (PKL_AST_PROGRAM_ELEMS (PKL_PASS_NODE)) == PKL_AST_EXP_STMT))
164 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
165
166 PKL_GEN_PAYLOAD->program = pkl_asm_finish (PKL_GEN_ASM,
167 1 /* prologue */);
168 }
169 PKL_PHASE_END_HANDLER
170
171 /*
172 * DECL
173 * | INITIAL
174 */
175
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_decl)176 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_decl)
177 {
178 pkl_ast_node decl = PKL_PASS_NODE;
179 pkl_ast_node initial = PKL_AST_DECL_INITIAL (decl);
180
181 /* mktysct only gets information from regular struct fields.
182 Therefore, we do not need to process declarations of variables,
183 types and methods inside struct types. */
184 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
185 PKL_PASS_BREAK;
186
187 switch (PKL_AST_DECL_KIND (decl))
188 {
189 case PKL_AST_DECL_KIND_UNIT:
190 /* Nothing to do with units at run-time, for now. */
191 PKL_PASS_BREAK;
192 break;
193 case PKL_AST_DECL_KIND_TYPE:
194 switch (PKL_AST_TYPE_CODE (initial))
195 {
196 case PKL_TYPE_STRUCT:
197 {
198 pvm_val mapper_closure;
199 pvm_val writer_closure;
200 pvm_val constructor_closure;
201 pvm_val comparator_closure;
202 pvm_val integrator_closure;
203
204 pkl_ast_node type_struct = initial;
205
206 /* Compile the struct closures, complete them using the
207 current environment and install them in the AST node.
208 But only if they haven't been compiled already. */
209
210 if (PKL_AST_TYPE_S_WRITER (type_struct) == PVM_NULL)
211 {
212 PKL_GEN_DUP_CONTEXT;
213 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
214 RAS_FUNCTION_STRUCT_WRITER (writer_closure, type_struct);
215 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, writer_closure); /* CLS */
216 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
217 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
218 PKL_GEN_POP_CONTEXT;
219
220 PKL_AST_TYPE_S_WRITER (type_struct) = writer_closure;
221 }
222
223 if (PKL_AST_TYPE_S_MAPPER (type_struct) == PVM_NULL)
224 {
225 PKL_GEN_DUP_CONTEXT;
226 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_MAPPER);
227
228 RAS_FUNCTION_STRUCT_MAPPER (mapper_closure, type_struct);
229 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, mapper_closure); /* CLS */
230 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
231 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
232
233 PKL_GEN_POP_CONTEXT;
234
235 PKL_AST_TYPE_S_MAPPER (type_struct) = mapper_closure;
236 }
237
238 if (PKL_AST_TYPE_S_CONSTRUCTOR (type_struct) == PVM_NULL)
239 {
240 PKL_GEN_DUP_CONTEXT;
241 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_CONSTRUCTOR);
242 RAS_FUNCTION_STRUCT_CONSTRUCTOR (constructor_closure,
243 type_struct); /* CLS */
244 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, constructor_closure); /* CLS */
245 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
246 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
247 PKL_GEN_POP_CONTEXT;
248
249 PKL_AST_TYPE_S_CONSTRUCTOR (type_struct) = constructor_closure;
250 }
251
252 if (PKL_AST_TYPE_S_COMPARATOR (type_struct) == PVM_NULL)
253 {
254 PKL_GEN_DUP_CONTEXT;
255 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_COMPARATOR);
256 RAS_FUNCTION_STRUCT_COMPARATOR (comparator_closure,
257 type_struct); /* CLS */
258 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, comparator_closure); /* CLS */
259 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
260 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
261 PKL_GEN_POP_CONTEXT;
262
263 PKL_AST_TYPE_S_COMPARATOR (type_struct) = comparator_closure;
264 }
265
266 if (PKL_AST_TYPE_S_ITYPE (type_struct)
267 && PKL_AST_TYPE_S_INTEGRATOR (type_struct) == PVM_NULL)
268 {
269 /* Yes, the in_writer context is also used for
270 integrators, since integrators do not call writers
271 nor the other way around. This eases sharing of
272 code in the pks. */
273 PKL_GEN_DUP_CONTEXT;
274 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
275 RAS_FUNCTION_STRUCT_INTEGRATOR (integrator_closure,
276 type_struct); /* CLS */
277 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, integrator_closure); /* CLS */
278 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
279 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
280 PKL_GEN_POP_CONTEXT;
281
282 PKL_AST_TYPE_S_INTEGRATOR (type_struct) = integrator_closure;
283 }
284
285 PKL_PASS_BREAK;
286 break;
287 }
288 case PKL_TYPE_ARRAY:
289 {
290 pvm_val mapper_closure;
291 pvm_val writer_closure;
292 pvm_val constructor_closure;
293
294 pkl_ast_node array_type = initial;
295
296 /* Compile the arrays closures and complete them using the
297 current environment. */
298
299 if (PKL_AST_TYPE_A_BOUNDER (array_type) == PVM_NULL)
300 {
301 /* The bounder closures for this array and possibly
302 contained sub-arrays are installed in the
303 pkl_gen_pr_type_array handler. This should be done
304 before compiling the rest of the closures below, to
305 assure the bounder closures capture the right
306 lexical context! This makes the calls to
307 in_array_bounder in array mappers/constructors to
308 only happen for anonymous array types. */
309 PKL_GEN_DUP_CONTEXT;
310 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_ARRAY_BOUNDER);
311 PKL_PASS_SUBPASS (array_type);
312 PKL_GEN_POP_CONTEXT;
313 }
314
315 if (PKL_AST_TYPE_A_WRITER (array_type) == PVM_NULL)
316 {
317 PKL_GEN_DUP_CONTEXT;
318 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
319 RAS_FUNCTION_ARRAY_WRITER (writer_closure, array_type);
320 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, writer_closure); /* CLS */
321 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
322 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
323 PKL_GEN_POP_CONTEXT;
324
325 PKL_AST_TYPE_A_WRITER (array_type) = writer_closure;
326 }
327
328 if (PKL_AST_TYPE_A_MAPPER (array_type) == PVM_NULL)
329 {
330 PKL_GEN_DUP_CONTEXT;
331 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_MAPPER);
332
333 RAS_FUNCTION_ARRAY_MAPPER (mapper_closure, array_type);
334 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, mapper_closure); /* CLS */
335 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
336 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
337 PKL_GEN_POP_CONTEXT;
338
339 PKL_AST_TYPE_A_MAPPER (array_type) = mapper_closure;
340 }
341
342 if (PKL_AST_TYPE_A_CONSTRUCTOR (array_type) == PVM_NULL)
343 {
344 PKL_GEN_DUP_CONTEXT;
345 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_CONSTRUCTOR);
346 RAS_FUNCTION_ARRAY_CONSTRUCTOR (constructor_closure,
347 array_type); /* CLS */
348 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, constructor_closure); /* CLS */
349 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
350 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
351 PKL_GEN_POP_CONTEXT;
352
353 PKL_AST_TYPE_A_CONSTRUCTOR (array_type) = constructor_closure;
354 }
355
356 PKL_PASS_BREAK;
357 break;
358 }
359 default:
360 break;
361 }
362 break;
363 case PKL_AST_DECL_KIND_FUNC:
364 {
365 pvm_program program;
366 pvm_val closure;
367
368 if (PKL_AST_FUNC_PROGRAM (initial))
369 program = PKL_AST_FUNC_PROGRAM (initial);
370 else
371 {
372 /* INITIAL is a PKL_AST_FUNC, that will compile into a
373 program containing the function code. Push a new
374 assembler to the stack of assemblers in the payload and
375 use it to process INITIAL. */
376 PKL_GEN_PUSH_ASM (pkl_asm_new (PKL_PASS_AST,
377 PKL_GEN_PAYLOAD->compiler,
378 0 /* prologue */));
379
380 PKL_PASS_SUBPASS (initial);
381
382 /* At this point the code for the function specification
383 INITIAL has been assembled in the current
384 macroassembler. Finalize the program and put it in a
385 PVM closure, along with the current environment. */
386
387 program = pkl_asm_finish (PKL_GEN_ASM,
388 0 /* epilogue */);
389 PKL_GEN_POP_ASM;
390 pvm_program_make_executable (program);
391
392 /* XXX */
393 // pvm_disassemble_program (program);
394 PKL_AST_FUNC_PROGRAM (initial) = program;
395 }
396
397 closure = pvm_make_cls (program);
398 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, closure);
399 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DUC);
400 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
401 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REGVAR);
402
403 PKL_PASS_BREAK;
404 break;
405 }
406 default:
407 break;
408 }
409 }
410 PKL_PHASE_END_HANDLER
411
412 /*
413 * | INITIAL
414 * DECL
415 */
416
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_decl)417 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_decl)
418 {
419 pkl_ast_node decl = PKL_PASS_NODE;
420 pkl_ast_node initial = PKL_AST_DECL_INITIAL (decl);
421
422 switch (PKL_AST_DECL_KIND (decl))
423 {
424 case PKL_AST_DECL_KIND_VAR:
425 /* The value is in the stack. Just register the variable. */
426 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REGVAR);
427 break;
428 case PKL_AST_DECL_KIND_TYPE:
429 if (PKL_AST_TYPE_CODE (initial) == PKL_TYPE_STRUCT
430 || PKL_AST_TYPE_CODE (initial) == PKL_TYPE_ARRAY)
431 assert (0);
432 break;
433 default:
434 assert (0);
435 break;
436 }
437 }
438 PKL_PHASE_END_HANDLER
439
440 /*
441 * VAR
442 */
443
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_var)444 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_var)
445 {
446 pkl_ast_node var = PKL_PASS_NODE;
447
448 if (PKL_PASS_PARENT == NULL
449 && PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_LVALUE))
450 {
451 /* This is a l-value in an assignment. Generate nothing, as
452 this node is only used as a recipient for the lexical address
453 of the variable. */
454 }
455 else
456 {
457 pkl_ast_node var_decl = PKL_AST_VAR_DECL (var);
458 pkl_ast_node var_type = PKL_AST_TYPE (var);
459 pkl_ast_node var_function = PKL_AST_VAR_FUNCTION (var);
460
461 /* If the declaration associated with the variable is in a
462 struct _and_ we are in a method body.
463
464 Instead of accessing the variable in the lexical environment,
465 we push the implicit struct and sref it with the name of the
466 variable. The implicit struct is the first argument passed
467 to the current function. */
468 if (var_function
469 && PKL_AST_FUNC_METHOD_P (var_function)
470 && (PKL_AST_DECL_STRUCT_FIELD_P (var_decl)
471 || (PKL_AST_DECL_KIND (var_decl) == PKL_AST_DECL_KIND_FUNC
472 && PKL_AST_FUNC_METHOD_P (PKL_AST_DECL_INITIAL (var_decl)))))
473 {
474 pkl_ast_node var_name = PKL_AST_VAR_NAME (var);
475 int var_function_back = PKL_AST_VAR_FUNCTION_BACK (var);
476
477 assert (var_name != NULL);
478
479 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR,
480 var_function_back, 0); /* SCT */
481 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
482 pvm_make_string (PKL_AST_IDENTIFIER_POINTER (var_name)));
483 /* SCT STR */
484 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SREF); /* SCT STR VAL */
485
486 if (PKL_AST_DECL_KIND (var_decl) == PKL_AST_DECL_KIND_FUNC)
487 /* Method call: leave the implicit struct so it is passed
488 as the last argument to the method. */
489 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
490 else
491 /* Normal field. */
492 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
493 }
494 else
495 /* Normal variable. */
496 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR,
497 PKL_AST_VAR_BACK (var), PKL_AST_VAR_OVER (var));
498
499 /* If the declaration associated with the variable is in a
500 struct and we are not in a method, i.e. we are in a context
501 like a constraint expression or an optional field condition,
502 then raise E_elem if the value is null. */
503 if (PKL_AST_DECL_STRUCT_FIELD_P (var_decl)
504 && !var_function)
505 {
506 pvm_program_label label
507 = pkl_asm_fresh_label (PKL_GEN_ASM);
508
509 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNN, label);
510 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
511 pvm_make_exception (PVM_E_ELEM, PVM_E_ELEM_MSG,
512 PVM_E_ELEM_ESTATUS));
513 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAISE);
514 pkl_asm_label (PKL_GEN_ASM, label);
515 }
516
517 /* If the value holds a value that could be mapped, then use the
518 REMAP instruction. */
519 if (PKL_AST_TYPE_CODE (var_type) == PKL_TYPE_ARRAY
520 || PKL_AST_TYPE_CODE (var_type) == PKL_TYPE_STRUCT)
521 {
522 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REMAP);
523 }
524 }
525 }
526 PKL_PHASE_END_HANDLER
527
528 /*
529 * LAMBDA
530 * | FUNCTION
531 */
532
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_lambda)533 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_lambda)
534 {
535 /* FUNCTION is a PKL_AST_FUNC, that will compile into a program
536 containing the function code. Push a new assembler. */
537 PKL_GEN_PUSH_ASM (pkl_asm_new (PKL_PASS_AST,
538 PKL_GEN_PAYLOAD->compiler,
539 0 /* prologue */));
540 }
541 PKL_PHASE_END_HANDLER
542
543 /*
544 * | FUNCTION
545 * LAMBDA
546 */
547
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_lambda)548 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_lambda)
549 {
550 /* At this point the code for FUNCTION has been assembled in the
551 current macroassembler. Finalize the program and put it in a PVM
552 closure, along with the current environment. */
553
554 pvm_program program = pkl_asm_finish (PKL_GEN_ASM,
555 0 /* epilogue */);
556 pvm_val closure;
557
558 PKL_GEN_POP_ASM;
559 pvm_program_make_executable (program);
560 closure = pvm_make_cls (program);
561
562 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, closure);
563 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DUC);
564 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
565 }
566 PKL_PHASE_END_HANDLER
567
568 /*
569 * NULL_STMT
570 */
571
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_null_stmt)572 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_null_stmt)
573 {
574 /* Null is nothing, nada. */
575 }
576 PKL_PHASE_END_HANDLER
577
578 /*
579 * COMP_STMT
580 * | (STMT | DECL)
581 * | ...
582 */
583
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_comp_stmt)584 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_comp_stmt)
585 {
586 pkl_ast_node comp_stmt = PKL_PASS_NODE;
587
588 if (PKL_AST_COMP_STMT_BUILTIN (comp_stmt) == PKL_AST_BUILTIN_NONE)
589 {
590 /* If the compound statement is empty, do not generate
591 anything. */
592 if (PKL_AST_COMP_STMT_STMTS (comp_stmt) == NULL)
593 PKL_PASS_BREAK;
594
595 /* Push a frame into the environment. */
596 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHF,
597 PKL_AST_COMP_STMT_NUMVARS (comp_stmt));
598 }
599 }
600 PKL_PHASE_END_HANDLER
601
602 /*
603 * | (STMT | DECL)
604 * | ...
605 * COMP_STMT
606 */
607
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_comp_stmt)608 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_comp_stmt)
609 {
610 pkl_ast_node comp_stmt = PKL_PASS_NODE;
611 int comp_stmt_builtin
612 = PKL_AST_COMP_STMT_BUILTIN (comp_stmt);
613
614 if (comp_stmt_builtin != PKL_AST_BUILTIN_NONE)
615 {
616 switch (comp_stmt_builtin)
617 {
618 case PKL_AST_BUILTIN_RAND:
619 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
620 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAND);
621 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
622 break;
623 case PKL_AST_BUILTIN_GET_ENDIAN:
624 /* Fallthrough. */
625 case PKL_AST_BUILTIN_GET_IOS:
626 if (comp_stmt_builtin == PKL_AST_BUILTIN_GET_ENDIAN)
627 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHEND);
628 else
629 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHIOS);
630 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
631 break;
632 case PKL_AST_BUILTIN_SET_ENDIAN:
633 /* Fallthrough. */
634 case PKL_AST_BUILTIN_SET_IOS:
635 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
636 if (comp_stmt_builtin == PKL_AST_BUILTIN_SET_ENDIAN)
637 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPEND);
638 else
639 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPIOS);
640 /* Always return `true' to facilitate using set_endian in
641 struct constraint expressions. */
642 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_int (1, 32));
643 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
644 break;
645 case PKL_AST_BUILTIN_OPEN:
646 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
647 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 1);
648 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OPEN);
649 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
650 break;
651 case PKL_AST_BUILTIN_CLOSE:
652 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
653 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CLOSE);
654 break;
655 case PKL_AST_BUILTIN_IOSIZE:
656 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
657 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_IOSIZE);
658 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
659 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
660 break;
661 case PKL_AST_BUILTIN_FORGET:
662 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
663 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 1);
664 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OGETM);
665 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
666 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FLUSH);
667 break;
668 case PKL_AST_BUILTIN_GET_TIME:
669 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TIME);
670 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
671 break;
672 case PKL_AST_BUILTIN_STRACE:
673 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_STRACE, 0);
674 break;
675 case PKL_AST_BUILTIN_GETENV:
676 {
677 pvm_program_label label = pkl_asm_fresh_label (PKL_GEN_ASM);
678
679 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
680 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_GETENV);
681 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
682 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNN, label);
683 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
684 pvm_make_exception (PVM_E_INVAL, PVM_E_INVAL_MSG,
685 PVM_E_INVAL_ESTATUS));
686 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAISE);
687 pkl_asm_label (PKL_GEN_ASM, label);
688 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
689
690 break;
691 }
692 case PKL_AST_BUILTIN_TERM_GET_COLOR:
693 case PKL_AST_BUILTIN_TERM_GET_BGCOLOR:
694 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
695 pvm_make_integral_type (pvm_make_ulong (32, 64),
696 pvm_make_int (1, 32)));
697 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
698 pvm_make_ulong (3, 64));
699 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKA); /* ARR */
700 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR); /* _ */
701 if (comp_stmt_builtin == PKL_AST_BUILTIN_TERM_GET_COLOR)
702 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHOC); /* R G B */
703 else
704 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHOBC); /* R G B */
705 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
706 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* B G R */
707 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR); /* B G R ARR */
708 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
709 pvm_make_ulong (0, 64));
710 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT);
711 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AINS); /* B G ARR */
712 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
713 pvm_make_ulong (1, 64));
714 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT);
715 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AINS); /* B ARR */
716 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
717 pvm_make_ulong (2, 64));
718 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT);
719 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AINS); /* ARR */
720 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
721 break;
722 case PKL_AST_BUILTIN_TERM_SET_COLOR:
723 case PKL_AST_BUILTIN_TERM_SET_BGCOLOR:
724 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
725 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
726 pvm_make_ulong (0, 64));
727 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AREF);
728 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR);
729 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
730 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
731 pvm_make_ulong (1, 64));
732 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AREF);
733 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR);
734 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
735 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
736 pvm_make_ulong (2, 64));
737 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AREF);
738 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR);
739 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
740 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
741 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR);
742 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR);
743 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR);
744 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
745 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT);
746 if (comp_stmt_builtin == PKL_AST_BUILTIN_TERM_SET_COLOR)
747 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOC);
748 else
749 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOBC);
750 break;
751 case PKL_AST_BUILTIN_TERM_BEGIN_CLASS:
752 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
753 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BEGINSC);
754 break;
755 case PKL_AST_BUILTIN_TERM_END_CLASS:
756 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
757 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ENDSC);
758 break;
759 case PKL_AST_BUILTIN_TERM_BEGIN_HYPERLINK:
760 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 0);
761 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR, 0, 1);
762 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BEGINHL);
763 break;
764 case PKL_AST_BUILTIN_TERM_END_HYPERLINK:
765 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ENDHL);
766 break;
767
768 default:
769 assert (0);
770 }
771 }
772 else
773 /* Pop the lexical frame created by the compound statement. */
774 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPF, 1);
775 }
776 PKL_PHASE_END_HANDLER
777
778 /*
779 * INCRDECR
780 * | EXP
781 * | ASS_STMT
782 */
783
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_incrdecr)784 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_incrdecr)
785 {
786 pkl_ast_node incrdecr = PKL_PASS_NODE;
787 pkl_ast_node incrdecr_exp = PKL_AST_INCRDECR_EXP (incrdecr);
788 pkl_ast_node incrdecr_ass_stmt = PKL_AST_INCRDECR_ASS_STMT (incrdecr);
789 int incrdecr_order = PKL_AST_INCRDECR_ORDER (incrdecr);
790
791 if (incrdecr_order == PKL_AST_ORDER_PRE)
792 PKL_PASS_SUBPASS (incrdecr_ass_stmt);
793
794 PKL_PASS_SUBPASS (incrdecr_exp);
795
796 if (incrdecr_order == PKL_AST_ORDER_POST)
797 PKL_PASS_SUBPASS (incrdecr_ass_stmt);
798
799 PKL_PASS_BREAK;
800 }
801 PKL_PHASE_END_HANDLER
802
803 /*
804 * ASS_STMT
805 * | EXP
806 * | LVALUE
807 */
808
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_ass_stmt)809 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_ass_stmt)
810 {
811 #define LMAP(TYPE) \
812 do \
813 { \
814 int lvalue_type_code = PKL_AST_TYPE_CODE ((TYPE)); \
815 \
816 switch (lvalue_type_code) \
817 { \
818 case PKL_TYPE_ARRAY: \
819 /* Make sure the array type has a writer. */ \
820 /* Note how anonymous array types from within structs */ \
821 /* need the writer to be re-compiled. This sucks :/ */ \
822 if (PKL_AST_TYPE_A_WRITER ((TYPE)) == PVM_NULL \
823 || !PKL_AST_TYPE_NAME ((TYPE))) \
824 { \
825 pvm_val writer; \
826 \
827 PKL_GEN_DUP_CONTEXT; \
828 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER); \
829 RAS_FUNCTION_ARRAY_WRITER (writer, (TYPE)); \
830 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, writer); /* CLS */ \
831 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */ \
832 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */ \
833 PKL_GEN_POP_CONTEXT; \
834 \
835 PKL_AST_TYPE_A_WRITER ((TYPE)) = writer; \
836 } \
837 /* Fallthrough. */ \
838 case PKL_TYPE_STRUCT: \
839 { \
840 pvm_val writer = \
841 (lvalue_type_code == PKL_TYPE_ARRAY \
842 ? PKL_AST_TYPE_A_WRITER ((TYPE)) \
843 : PKL_AST_TYPE_S_WRITER ((TYPE))); \
844 \
845 /* VAL IOS BOFF */ \
846 RAS_MACRO_COMPLEX_LMAP ((TYPE), writer); /* _ */ \
847 break; \
848 } \
849 default: \
850 /* The map at the l-value is of a simple type, i.e. of */ \
851 /* types whose values cannot be mapped (integers, offsets, */ \
852 /* strings, etc). The strategy here is simple: we just */ \
853 /* generate a writer for the type. */ \
854 \
855 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* IOS BOFF VAL */ \
856 \
857 PKL_GEN_DUP_CONTEXT; \
858 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER); \
859 PKL_PASS_SUBPASS ((TYPE)); \
860 PKL_GEN_POP_CONTEXT; \
861 break; \
862 } \
863 } \
864 while (0)
865
866 pkl_ast_node ass_stmt = PKL_PASS_NODE;
867 pkl_ast_node lvalue = PKL_AST_ASS_STMT_LVALUE (ass_stmt);
868 pkl_ast_node lvalue_type = PKL_AST_TYPE (lvalue);
869 pkl_ast_node exp = PKL_AST_ASS_STMT_EXP (ass_stmt);
870 pvm_program_label done = pkl_asm_fresh_label (PKL_GEN_ASM);
871
872 PKL_PASS_SUBPASS (exp);
873
874 PKL_GEN_DUP_CONTEXT;
875 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_LVALUE);
876 PKL_PASS_SUBPASS (lvalue);
877 PKL_GEN_POP_CONTEXT;
878
879 /* At this point the r-value, generated from executing EXP, is in
880 the stack. */
881
882 /* If the base array to the indexer, or the referred struct, are
883 mapped, and the assigned value is a complex value, then we have
884 to reflect the effect of the assignment in the corresponding IO
885 space. */
886 if ((PKL_AST_CODE (lvalue) == PKL_AST_INDEXER
887 || PKL_AST_CODE (lvalue) == PKL_AST_STRUCT_REF)
888 && (PKL_AST_TYPE_CODE (lvalue_type) == PKL_TYPE_ARRAY
889 || PKL_AST_TYPE_CODE (lvalue_type) == PKL_TYPE_STRUCT))
890 {
891 pvm_program_label not_mapped = pkl_asm_fresh_label (PKL_GEN_ASM);
892
893 /* Stack: VAL (SCT|ARR) (ID|IDX) */
894
895 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* VAL ID SCT */
896 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MM); /* VAL ID SCT MAPPED_P */
897 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BZI, not_mapped);
898 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* VAL ID SCT */
899 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* VAL SCT ID */
900
901 if (PKL_AST_CODE (lvalue) == PKL_AST_INDEXER)
902 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AREFO); /* VAL SCT ID BOFF */
903 else
904 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SREFO); /* VAL SCT ID BOFF */
905
906 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP); /* VAL SCT BOFF */
907 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* VAL BOFF SCT */
908 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MGETIOS); /* VAL BOFF SCT IOS */
909 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP); /* VAL BOFF IOS */
910 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* VAL IOS BOFF */
911
912 /* VAL IOS OFF */
913 LMAP (PKL_AST_TYPE (lvalue));
914
915 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BA, done);
916 pkl_asm_label (PKL_GEN_ASM, not_mapped);
917 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* VAL ID SCT */
918 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* VAL SCT ID */
919 }
920
921 /* All right, now assign the resulting rvalue to the lvalue. */
922 switch (PKL_AST_CODE (lvalue))
923 {
924 case PKL_AST_VAR:
925 {
926 /* Stack: VAL */
927
928 pkl_ast_node var = lvalue;
929 pkl_ast_node var_decl = PKL_AST_VAR_DECL (var);
930 pkl_ast_node var_function = PKL_AST_VAR_FUNCTION (var);
931
932 /* If the declaration associated with the variable is in a
933 struct _and_ we are in a method body, we update the
934 implicit struct argument. */
935 if (var_function
936 && PKL_AST_FUNC_METHOD_P (var_function)
937 && (PKL_AST_DECL_STRUCT_FIELD_P (var_decl)
938 || (PKL_AST_DECL_KIND (var_decl) == PKL_AST_DECL_KIND_FUNC
939 && PKL_AST_FUNC_METHOD_P (PKL_AST_DECL_INITIAL (var_decl)))))
940 {
941 pkl_ast_node var_name = PKL_AST_VAR_NAME (var);
942 int var_function_back = PKL_AST_VAR_FUNCTION_BACK (var);
943
944 assert (var_name != NULL);
945
946 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHVAR,
947 var_function_back, 0); /* VAL SCT */
948 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
949 pvm_make_string (PKL_AST_IDENTIFIER_POINTER (var_name)));
950 /* VAL SCT STR */
951 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* SCT STR VAL */
952 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SSET); /* SCT */
953 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_WRITE);
954 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
955 }
956 else
957 /* Normal variable. */
958 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPVAR,
959 PKL_AST_VAR_BACK (lvalue), PKL_AST_VAR_OVER (lvalue));
960 break;
961 }
962 case PKL_AST_INDEXER:
963 {
964 /* Stack: VAL ARRAY INDEX */
965
966 pkl_ast_node array = PKL_AST_INDEXER_ENTITY (lvalue);
967 pkl_ast_node array_type = PKL_AST_TYPE (array);
968 pkl_ast_node etype = PKL_AST_TYPE_A_ETYPE (array_type);
969
970 /* If the type of the array is ANY[], then check at runtime
971 that the type of the value matches the type of the elements
972 in the array. */
973 if (PKL_AST_TYPE_CODE (etype) == PKL_TYPE_ANY)
974 {
975 pvm_program_label label = pkl_asm_fresh_label (PKL_GEN_ASM);
976
977 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NROT); /* INDEX VAL ARRAY */
978 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TYPOF); /* INDEX VAL ARRAY ATYPE */
979 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TYAGETT); /* INDEX VAL ARRAY ATYPE ETYPE */
980 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP); /* INDEX VAL ARRAY ETYPE */
981 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* INDEX ARRAY ETYPE VAL */
982 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* INDEX ARRAY VAL ETYPE */
983 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ISA); /* INDEX ARRAY VAL ETYPE BOOL */
984 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP); /* INDEX ARRAY VAL BOOL */
985 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNZI, label);
986
987 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
988 pvm_make_exception (PVM_E_CONV, PVM_E_CONV_MSG,
989 PVM_E_CONV_ESTATUS));
990 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAISE);
991
992 pkl_asm_label (PKL_GEN_ASM, label);
993 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* INDEX ARRAY VAL */
994 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* INDEX VAL ARRAY */
995 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* VAL ARRAY INDEX */
996 }
997
998 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* ARRAY INDEX VAL */
999 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ASET); /* ARRAY */
1000 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_WRITE); /* ARRAY */
1001 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The array
1002 value. */
1003 break;
1004 }
1005 case PKL_AST_STRUCT_REF:
1006 {
1007 /* Stack: VAL SCT ID */
1008
1009 pkl_ast_node sct = PKL_AST_INDEXER_ENTITY (lvalue);
1010 pkl_ast_node struct_type = PKL_AST_TYPE (sct);
1011
1012 assert (PKL_AST_TYPE_S_CONSTRUCTOR (struct_type) != PVM_NULL);
1013
1014 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT);
1015 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SSETI, struct_type);
1016 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_WRITE);
1017 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The struct
1018 value. */
1019 break;
1020 }
1021 case PKL_AST_MAP:
1022 /* Stack: VAL IOS OFF */
1023 /* Convert the offset to a bit-offset. The offset is */
1024 /* guaranteed to be ulong<64> with unit bits, as per */
1025 /* promo. */
1026 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OGETM);
1027 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP); /* VAL IOS BOFF */
1028 LMAP (PKL_AST_TYPE (lvalue));
1029 break;
1030 default:
1031 break;
1032 }
1033
1034 if (PKL_AST_CODE (lvalue) == PKL_AST_INDEXER
1035 || PKL_AST_CODE (lvalue) == PKL_AST_STRUCT_REF)
1036 pkl_asm_label (PKL_GEN_ASM, done);
1037
1038 PKL_PASS_BREAK;
1039
1040 #undef LMAP
1041 }
1042 PKL_PHASE_END_HANDLER
1043
1044 /*
1045 * IF_STMT
1046 * | EXP
1047 * | THEN_STMT
1048 * | [ELSE_STMT]
1049 */
1050
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_if_stmt)1051 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_if_stmt)
1052 {
1053 pkl_ast_node if_stmt = PKL_PASS_NODE;
1054 pkl_ast_node if_exp = PKL_AST_IF_STMT_EXP (if_stmt);
1055 pkl_ast_node if_then_stmt = PKL_AST_IF_STMT_THEN_STMT (if_stmt);
1056 pkl_ast_node if_else_stmt = PKL_AST_IF_STMT_ELSE_STMT (if_stmt);
1057
1058 if (PKL_AST_CODE (if_exp) == PKL_AST_INTEGER)
1059 {
1060 uint64_t exp_value = PKL_AST_INTEGER_VALUE (if_exp);
1061
1062 if (exp_value == 0)
1063 {
1064 if (if_else_stmt)
1065 PKL_PASS_SUBPASS (if_else_stmt);
1066 }
1067 else
1068 {
1069 PKL_PASS_SUBPASS (if_then_stmt);
1070 }
1071
1072 PKL_PASS_BREAK;
1073 }
1074
1075 pkl_asm_if (PKL_GEN_ASM, if_exp);
1076 {
1077 PKL_PASS_SUBPASS (if_exp);
1078 }
1079 pkl_asm_then (PKL_GEN_ASM);
1080 {
1081 PKL_PASS_SUBPASS (if_then_stmt);
1082 }
1083 pkl_asm_else (PKL_GEN_ASM);
1084 {
1085 if (if_else_stmt)
1086 PKL_PASS_SUBPASS (if_else_stmt);
1087 }
1088 pkl_asm_endif (PKL_GEN_ASM);
1089
1090 PKL_PASS_BREAK;
1091 }
1092 PKL_PHASE_END_HANDLER
1093
1094 /*
1095 * BREAK_STMT
1096 */
1097
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_break_stmt)1098 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_break_stmt)
1099 {
1100 int nframes = PKL_AST_BREAK_STMT_NFRAMES (PKL_PASS_NODE);
1101
1102 if (nframes > 0)
1103 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPF, nframes);
1104 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BA,
1105 pkl_asm_break_label (PKL_GEN_ASM));
1106 }
1107 PKL_PHASE_END_HANDLER
1108
1109 /*
1110 * CONTINUE_STMT
1111 */
1112
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_continue_stmt)1113 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_continue_stmt)
1114 {
1115 int nframes = PKL_AST_CONTINUE_STMT_NFRAMES (PKL_PASS_NODE);
1116
1117 if (nframes > 0)
1118 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPF, nframes);
1119 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BA,
1120 pkl_asm_continue_label (PKL_GEN_ASM));
1121 }
1122 PKL_PHASE_END_HANDLER
1123
1124 /*
1125 * LOOP_STMT
1126 * | PARAMS
1127 * | BODY
1128 */
1129
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_loop_stmt)1130 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_loop_stmt)
1131 {
1132 pkl_ast_node loop_stmt = PKL_PASS_NODE;
1133 int loop_stmt_kind = PKL_AST_LOOP_STMT_KIND (loop_stmt);
1134 pkl_ast_node body = PKL_AST_LOOP_STMT_BODY (loop_stmt);
1135
1136 switch (loop_stmt_kind)
1137 {
1138 case PKL_AST_LOOP_STMT_KIND_WHILE:
1139 {
1140 pkl_ast_node condition
1141 = PKL_AST_LOOP_STMT_CONDITION (loop_stmt);
1142
1143 assert (condition && body);
1144
1145 if (PKL_AST_CODE (condition) == PKL_AST_INTEGER)
1146 {
1147 if (PKL_AST_INTEGER_VALUE (condition) == 0)
1148 ; /* while (0) is optimized away. */
1149 else
1150 {
1151 pkl_asm_loop (PKL_GEN_ASM);
1152 PKL_PASS_SUBPASS (body);
1153 pkl_asm_endloop (PKL_GEN_ASM);
1154 }
1155 }
1156 else
1157 {
1158 pkl_asm_while (PKL_GEN_ASM);
1159 {
1160 PKL_PASS_SUBPASS (condition);
1161 }
1162 pkl_asm_while_loop (PKL_GEN_ASM);
1163 {
1164 PKL_PASS_SUBPASS (body);
1165 }
1166 pkl_asm_while_endloop (PKL_GEN_ASM);
1167 }
1168
1169 break;
1170 }
1171 case PKL_AST_LOOP_STMT_KIND_FOR:
1172 {
1173 pkl_ast_node head = PKL_AST_LOOP_STMT_HEAD (loop_stmt);
1174
1175 pkl_asm_for (PKL_GEN_ASM, head);
1176 {
1177 for (; head; head = PKL_AST_CHAIN (head))
1178 PKL_PASS_SUBPASS (head);
1179 }
1180 pkl_asm_for_condition (PKL_GEN_ASM);
1181 {
1182 pkl_ast_node condition
1183 = PKL_AST_LOOP_STMT_CONDITION (loop_stmt);
1184
1185 if (condition)
1186 PKL_PASS_SUBPASS (condition);
1187 else
1188 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_int (1, 32));
1189 }
1190 pkl_asm_for_loop (PKL_GEN_ASM);
1191 {
1192 PKL_PASS_SUBPASS (body);
1193 }
1194 pkl_asm_for_tail (PKL_GEN_ASM);
1195 {
1196 pkl_ast_node tail = PKL_AST_LOOP_STMT_TAIL (loop_stmt);
1197
1198 for (; tail; tail = PKL_AST_CHAIN (tail))
1199 PKL_PASS_SUBPASS (tail);
1200 }
1201 pkl_asm_for_endloop (PKL_GEN_ASM);
1202
1203 break;
1204 }
1205 case PKL_AST_LOOP_STMT_KIND_FOR_IN:
1206 {
1207 pkl_ast_node condition
1208 = PKL_AST_LOOP_STMT_CONDITION (loop_stmt);
1209 pkl_ast_node loop_stmt_iterator
1210 = PKL_AST_LOOP_STMT_ITERATOR (loop_stmt);
1211 pkl_ast_node container = NULL;
1212 pkl_ast_node container_type = NULL;
1213
1214 assert (loop_stmt_iterator);
1215
1216 container = PKL_AST_LOOP_STMT_ITERATOR_CONTAINER (loop_stmt_iterator);
1217 container_type = PKL_AST_TYPE (container);
1218
1219 pkl_asm_for_in (PKL_GEN_ASM,
1220 PKL_AST_TYPE_CODE (container_type),
1221 condition);
1222 {
1223 PKL_PASS_SUBPASS (container);
1224 }
1225 pkl_asm_for_in_where (PKL_GEN_ASM);
1226 {
1227 if (condition)
1228 PKL_PASS_SUBPASS (condition);
1229 }
1230 pkl_asm_for_in_loop (PKL_GEN_ASM);
1231 {
1232 PKL_PASS_SUBPASS (body);
1233 }
1234 pkl_asm_for_in_endloop (PKL_GEN_ASM);
1235
1236 break;
1237 }
1238 default:
1239 assert (0);
1240 }
1241
1242 PKL_PASS_BREAK;
1243 }
1244 PKL_PHASE_END_HANDLER
1245
1246 /*
1247 * RETURN
1248 * | EXP
1249 */
1250
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_return_stmt)1251 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_return_stmt)
1252 {
1253 /* Clean the stack before returning. */
1254 size_t i;
1255
1256 for (i = 0; i < PKL_AST_RETURN_STMT_NDROPS (PKL_PASS_NODE); ++i)
1257 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
1258 }
1259 PKL_PHASE_END_HANDLER
1260
1261 /*
1262 * | EXP
1263 * RETURN
1264 */
1265
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_return_stmt)1266 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_return_stmt)
1267 {
1268 /* Return from the function: pop N frames and generate a return
1269 instruction. */
1270
1271 pkl_ast_node return_stmt = PKL_PASS_NODE;
1272 pkl_ast_node function = PKL_AST_RETURN_STMT_FUNCTION (return_stmt);
1273 pkl_ast_node function_type = PKL_AST_TYPE (function);
1274
1275 /* In a void function, return PVM_NULL in the stack. */
1276 if (PKL_AST_TYPE_CODE (PKL_AST_TYPE_F_RTYPE (function_type))
1277 == PKL_TYPE_VOID)
1278 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
1279
1280 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
1281 }
1282 PKL_PHASE_END_HANDLER
1283
1284 /*
1285 * | EXP
1286 * EXP_STMT
1287 */
1288
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_exp_stmt)1289 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_exp_stmt)
1290 {
1291 /* Drop the expression from the stack, but not if we are compiling a
1292 single statement. */
1293 if (!(pkl_compiling_statement_p (PKL_GEN_PAYLOAD->compiler)
1294 && PKL_PASS_PARENT
1295 && PKL_AST_CODE (PKL_PASS_PARENT) == PKL_AST_PROGRAM)
1296 || PKL_GEN_PAYLOAD->in_file_p)
1297 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
1298 }
1299 PKL_PHASE_END_HANDLER
1300
1301 /*
1302 * PRINT_STMT
1303 * | ARG
1304 * | ...
1305 */
1306
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_print_stmt)1307 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_print_stmt)
1308 {
1309 pkl_ast_node print_stmt = PKL_PASS_NODE;
1310 pkl_ast_node print_stmt_args = PKL_AST_PRINT_STMT_ARGS (print_stmt);
1311 pkl_ast_node print_stmt_fmt = PKL_AST_PRINT_STMT_FMT (print_stmt);
1312
1313 if (print_stmt_fmt)
1314 {
1315 pkl_ast_node arg;
1316 char *prefix = PKL_AST_PRINT_STMT_PREFIX (print_stmt);
1317 int nexp;
1318
1319 /* First, compute the arguments and push them to the stack. */
1320
1321 for (nexp = 0, arg = print_stmt_args;
1322 arg;
1323 arg = PKL_AST_CHAIN (arg))
1324 {
1325 pkl_ast_node exp = PKL_AST_PRINT_STMT_ARG_EXP (arg);
1326
1327 if (exp)
1328 {
1329 PKL_PASS_SUBPASS (exp);
1330 nexp++;
1331 }
1332 }
1333
1334 /* Reverse the arguments in the stack so we can print it in the
1335 right order. */
1336 if (nexp == 2)
1337 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
1338 else if (nexp == 3)
1339 {
1340 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
1341 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT);
1342 }
1343 else if (nexp > 1)
1344 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REVN, nexp);
1345
1346 /* Now print out the stuff. */
1347 if (prefix)
1348 {
1349 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_string (prefix));
1350 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PRINTS);
1351 }
1352
1353 for (arg = print_stmt_args; arg; arg = PKL_AST_CHAIN (arg))
1354 {
1355 /* Handle the argument. */
1356
1357 pkl_ast_node exp = PKL_AST_PRINT_STMT_ARG_EXP (arg);
1358 char *begin_sc = PKL_AST_PRINT_STMT_ARG_BEGIN_SC (arg);
1359 char *end_sc = PKL_AST_PRINT_STMT_ARG_END_SC (arg);
1360 char *suffix = PKL_AST_PRINT_STMT_ARG_SUFFIX (arg);
1361 int base = PKL_AST_PRINT_STMT_ARG_BASE (arg);
1362
1363 if (begin_sc)
1364 {
1365 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1366 pvm_make_string (begin_sc));
1367 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BEGINSC);
1368 }
1369
1370 if (end_sc)
1371 {
1372 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1373 pvm_make_string (end_sc));
1374 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ENDSC);
1375 }
1376
1377 if (exp)
1378 {
1379 if (PKL_AST_PRINT_STMT_ARG_VALUE_P (arg))
1380 {
1381 /* Generate code to print the value. */
1382 pkl_ast_node exp_type = PKL_AST_TYPE (exp);
1383 int arg_omode = PKL_AST_PRINT_STMT_ARG_PRINT_MODE (arg);
1384 int arg_odepth = PKL_AST_PRINT_STMT_ARG_PRINT_DEPTH (arg);
1385
1386 /* Set the argument's own omode and odepth, saving
1387 the VM's own. */
1388 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHOM); /* OMODE */
1389 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1390 pvm_make_int (arg_omode, 32)); /* OMODE NOMODE */
1391 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOM); /* OMODE */
1392
1393 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHOD); /* OMODE ODEPTH */
1394 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1395 pvm_make_int (arg_odepth, 32)); /* OMODE ODEPTH NODEPTH */
1396 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOD); /* OMODE ODEPTH */
1397
1398 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* OMODE ODEPTH EXP */
1399
1400 /* Print out the value. */
1401 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1402 pvm_make_int (0, 32)); /* OMODE ODEPTH EXP DEPTH */
1403 PKL_GEN_DUP_CONTEXT;
1404 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_PRINTER);
1405 PKL_PASS_SUBPASS (exp_type);
1406 PKL_GEN_POP_CONTEXT;
1407
1408 /* Restore the current omode and odepth in the VM. */
1409 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOD); /* OMODE */
1410 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POPOM); /* _ */
1411 }
1412 else
1413 {
1414 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1415 base ? pvm_make_int (base, 32) : PVM_NULL);
1416 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PRINT, PKL_AST_TYPE (exp));
1417 }
1418 }
1419
1420 if (suffix)
1421 {
1422 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_string (suffix));
1423 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PRINTS);
1424 }
1425 }
1426 }
1427 else
1428 {
1429 PKL_PASS_SUBPASS (print_stmt_args);
1430 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PRINTS);
1431 }
1432
1433 PKL_PASS_BREAK;
1434 }
1435 PKL_PHASE_END_HANDLER
1436
1437 /*
1438 * | [EXP]
1439 * RAISE_STMT
1440 */
1441
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_raise_stmt)1442 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_raise_stmt)
1443 {
1444 pkl_ast_node raise_stmt = PKL_PASS_NODE;
1445
1446 /* If the `raise' statement was anonymous, then we need to push the
1447 exception to raise, which by default, is 0. */
1448 if (PKL_AST_RAISE_STMT_EXP (raise_stmt) == NULL)
1449 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1450 pvm_make_exception (PVM_E_GENERIC, PVM_E_GENERIC_MSG,
1451 PVM_E_GENERIC_ESTATUS));
1452
1453 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAISE);
1454 }
1455 PKL_PHASE_END_HANDLER
1456
1457 /*
1458 * | CODE
1459 * | EXP
1460 * TRY_UNTIL_STMT
1461 */
1462
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_try_until_stmt)1463 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_try_until_stmt)
1464 {
1465 pkl_ast_node try_until_stmt = PKL_PASS_NODE;
1466 pkl_ast_node code = PKL_AST_TRY_UNTIL_STMT_CODE (try_until_stmt);
1467 pkl_ast_node exp = PKL_AST_TRY_UNTIL_STMT_EXP (try_until_stmt);
1468
1469 /* Push the exception to catch. */
1470 PKL_PASS_SUBPASS (exp);
1471 pkl_asm_try (PKL_GEN_ASM, NULL);
1472 {
1473 pkl_asm_loop (PKL_GEN_ASM);
1474 PKL_PASS_SUBPASS (code);
1475 pkl_asm_endloop (PKL_GEN_ASM);
1476 }
1477 pkl_asm_catch (PKL_GEN_ASM);
1478 {
1479 }
1480 pkl_asm_endtry (PKL_GEN_ASM);
1481
1482 PKL_PASS_BREAK;
1483 }
1484 PKL_PHASE_END_HANDLER
1485
1486 /*
1487 * | CODE
1488 * | HANDLER
1489 * | [ARG]
1490 * | [EXP]
1491 * TRY_CATCH_STMT
1492 */
1493
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_try_catch_stmt)1494 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_try_catch_stmt)
1495 {
1496 pkl_ast_node try_catch_stmt = PKL_PASS_NODE;
1497 pkl_ast_node code = PKL_AST_TRY_CATCH_STMT_CODE (try_catch_stmt);
1498 pkl_ast_node handler = PKL_AST_TRY_CATCH_STMT_HANDLER (try_catch_stmt);
1499 pkl_ast_node catch_arg = PKL_AST_TRY_CATCH_STMT_ARG (try_catch_stmt);
1500 pkl_ast_node catch_exp = PKL_AST_TRY_CATCH_STMT_EXP (try_catch_stmt);
1501
1502 /* Push the exception that will be catched by the sentence. This is
1503 EXP if it is defined, or E_generic if it isnt. */
1504 if (catch_exp)
1505 PKL_PASS_SUBPASS (catch_exp);
1506 else
1507 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1508 pvm_make_exception (PVM_E_GENERIC, PVM_E_GENERIC_MSG,
1509 PVM_E_GENERIC_ESTATUS));
1510
1511 pkl_asm_try (PKL_GEN_ASM, catch_arg);
1512 {
1513 PKL_PASS_SUBPASS (code);
1514 }
1515 pkl_asm_catch (PKL_GEN_ASM);
1516 {
1517 PKL_PASS_SUBPASS (handler);
1518 }
1519 pkl_asm_endtry (PKL_GEN_ASM);
1520
1521 PKL_PASS_BREAK;
1522 }
1523 PKL_PHASE_END_HANDLER
1524
1525 /*
1526 * | EXP
1527 * FUNCALL_ARG
1528 */
1529
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_funcall_arg)1530 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_funcall_arg)
1531 {
1532 /* No extra action is required here. */
1533 }
1534 PKL_PHASE_END_HANDLER
1535
1536
1537 /* FUNCALL
1538 * | [ARG]
1539 * | ...
1540 * | FUNCTION
1541 */
1542
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_funcall)1543 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_funcall)
1544 {
1545 pkl_ast_node funcall = PKL_PASS_NODE;
1546 pkl_ast_node function = PKL_AST_FUNCALL_FUNCTION (funcall);
1547 pkl_ast_node function_type = PKL_AST_TYPE (function);
1548 int vararg = PKL_AST_TYPE_F_VARARG (function_type);
1549 int i, aindex = 0, vararg_actual = 0, optionals_specified = 0;
1550 pkl_ast_node aa;
1551
1552 /* Push the actuals to the stack. */
1553 for (aa = PKL_AST_FUNCALL_ARGS (funcall); aa; aa = PKL_AST_CHAIN (aa))
1554 {
1555 if (PKL_AST_FUNCALL_ARG_FIRST_VARARG (aa))
1556 vararg_actual = 1;
1557
1558 if (vararg_actual)
1559 aindex++;
1560
1561 if (!PKL_AST_FUNCALL_ARG_EXP (aa))
1562 {
1563 /* This is a non-specified actual for a formal having a
1564 default value. */
1565 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
1566 optionals_specified++;
1567 }
1568 else
1569 PKL_PASS_SUBPASS (aa);
1570 }
1571
1572 if (vararg)
1573 {
1574 /* The actuals are stored in the stack in reverse order.
1575 Reverse them. */
1576 if (aindex == 2)
1577 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
1578 else if (aindex == 3)
1579 {
1580 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
1581 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT);
1582 }
1583 else if (aindex > 1)
1584 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REVN, aindex);
1585
1586 /* Create the array of variable arguments. */
1587 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_any_type ());
1588 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1589 pvm_make_ulong (aindex, 64));
1590 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKA);
1591
1592 /* Insert the elements in the array. */
1593 for (i = 0; i < aindex; ++i)
1594 {
1595 /* ... ELEM ARR */
1596 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1597 pvm_make_ulong (i, 64)); /* ... ELEM ARR IDX */
1598 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT); /* ... ARR IDX ELEM */
1599 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AINS); /* ... ARR */
1600 }
1601 }
1602
1603 /* Complete non-specified actuals for formals having default values.
1604 For these, we should push nulls. But beware the vararg! */
1605 {
1606 int non_specified
1607 = (PKL_AST_TYPE_F_NARG (function_type)
1608 - PKL_AST_FUNCALL_NARG (funcall)
1609 - PKL_AST_TYPE_F_VARARG (function_type)
1610 - optionals_specified);
1611
1612 for (i = 0; i < non_specified; ++i)
1613 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
1614 }
1615
1616 /* Push the closure for FUNCTION and call the bloody function. */
1617 PKL_GEN_DUP_CONTEXT;
1618 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_FUNCALL);
1619 PKL_PASS_SUBPASS (PKL_AST_FUNCALL_FUNCTION (funcall));
1620 PKL_GEN_POP_CONTEXT;
1621 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL);
1622 PKL_PASS_BREAK;
1623 }
1624 PKL_PHASE_END_HANDLER
1625
1626 /*
1627 * FUNC
1628 * | [TYPE]
1629 * | [FUNC_ARG]
1630 * | ...
1631 * | BODY
1632 */
1633
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_func)1634 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_func)
1635 {
1636 pkl_ast_node function = PKL_PASS_NODE;
1637 int nargs = PKL_AST_FUNC_NARGS (function);
1638 int method_p = PKL_AST_FUNC_METHOD_P (PKL_PASS_NODE);
1639
1640 /* This is a function prologue. */
1641 if (PKL_AST_FUNC_NAME (function))
1642 pkl_asm_note (PKL_GEN_ASM,
1643 PKL_AST_FUNC_NAME (function));
1644 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PROLOG);
1645
1646 if (nargs > 1)
1647 {
1648 /* Reverse the arguments.
1649
1650 Note that in methods the implicit struct argument is passed
1651 as the last actual. However, we have to process it as the
1652 _first_ formal. We achieve this by not reversing it, saving
1653 it in the return stack temporarily. */
1654
1655 if (method_p)
1656 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR);
1657
1658 if (nargs == 2)
1659 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
1660 else if (nargs == 3)
1661 {
1662 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
1663 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT);
1664 }
1665 else if (nargs > 1)
1666 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REVN, nargs);
1667
1668 if (method_p)
1669 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR);
1670 }
1671
1672 /* If the function's return type is an array type, make sure it has
1673 a bounder. If it hasn't one, then compute it in this
1674 environment. */
1675 {
1676 pkl_ast_node rtype = PKL_AST_FUNC_RET_TYPE (function);
1677
1678 if (PKL_AST_TYPE_CODE (rtype) == PKL_TYPE_ARRAY
1679 && PKL_AST_TYPE_A_BOUNDER (rtype) == PVM_NULL)
1680 {
1681 PKL_GEN_DUP_CONTEXT;
1682 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_ARRAY_BOUNDER);
1683 PKL_PASS_SUBPASS (rtype);
1684 PKL_GEN_POP_CONTEXT;
1685 }
1686 }
1687
1688 /* Push the function environment, for the arguments. */
1689 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHF,
1690 method_p ? nargs + 1 : nargs);
1691
1692 /* If in a method, register the implicit argument. */
1693 if (method_p)
1694 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REGVAR);
1695 }
1696 PKL_PHASE_END_HANDLER
1697
1698 /*
1699 * FUNC_ARG
1700 * | TYPE
1701 * | INITIAL
1702 */
1703
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_func_arg)1704 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_func_arg)
1705 {
1706 pkl_asm pasm = PKL_GEN_ASM;
1707 pkl_ast_node func_arg = PKL_PASS_NODE;
1708 pkl_ast_node func_arg_initial = PKL_AST_FUNC_ARG_INITIAL (func_arg);
1709 pkl_ast_node func_arg_type = PKL_AST_FUNC_ARG_TYPE (func_arg);
1710 pvm_program_label after_conv_label = pkl_asm_fresh_label (PKL_GEN_ASM);
1711
1712 /* Traverse the argument type in normal context. */
1713 PKL_GEN_PUSH_CONTEXT;
1714 PKL_PASS_SUBPASS (func_arg_type); /* _ */
1715 PKL_GEN_POP_CONTEXT;
1716
1717 if (func_arg_initial)
1718 {
1719 pvm_program_label label = pkl_asm_fresh_label (PKL_GEN_ASM);
1720
1721 /* If the value on the stack is `null', that means we need to
1722 use the default value for the argument. */
1723 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNN, label);
1724 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* Drop the null */
1725 PKL_PASS_SUBPASS (func_arg_initial);
1726 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BA, after_conv_label);
1727 pkl_asm_label (PKL_GEN_ASM, label);
1728 }
1729
1730 /* If the argument is an array, check/cast to its type, in order to
1731 perform whatever needed run-time checks. This is done here and
1732 not in a cast at funcall time because the argument's type is
1733 evaluated in the function's lexical environment. As per promo,
1734 we know that the value on the stack is an array with the same
1735 base type, but possibly different bounding.
1736
1737 Note that if the initial argument is used, then the flow jumps to
1738 `after_conv_label' and therefore the code below is not executed,
1739 as promo already performed a cast if needed. */
1740 if (PKL_AST_TYPE_CODE (func_arg_type) == PKL_TYPE_ARRAY)
1741 {
1742 /* Make sure the cast type has a bounder. If it doesn't,
1743 compile and install one. */
1744 int bounder_created_p = 0;
1745
1746 if (PKL_AST_TYPE_A_BOUNDER (func_arg_type) == PVM_NULL)
1747 {
1748 bounder_created_p = 1;
1749 PKL_GEN_DUP_CONTEXT;
1750 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_ARRAY_BOUNDER);
1751 PKL_PASS_SUBPASS (func_arg_type);
1752 PKL_GEN_POP_CONTEXT;
1753 }
1754
1755 pkl_asm_insn (pasm, PKL_INSN_ATOA,
1756 NULL /* from_type */, func_arg_type);
1757
1758 if (bounder_created_p)
1759 pkl_ast_array_type_remove_bounders (func_arg_type);
1760 }
1761
1762 pkl_asm_label (PKL_GEN_ASM, after_conv_label);
1763
1764 /* Pop the actual argument from the stack and put it in the current
1765 environment. */
1766 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REGVAR);
1767
1768 PKL_PASS_BREAK;
1769 }
1770 PKL_PHASE_END_HANDLER
1771
1772 /*
1773 * | [TYPE]
1774 * | [FUNC_ARG]
1775 * | ...
1776 * | BODY
1777 * FUNC
1778 */
1779
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_func)1780 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_func)
1781 {
1782 /* Function epilogue. */
1783
1784 pkl_ast_node function = PKL_PASS_NODE;
1785 pkl_ast_node function_type = PKL_AST_TYPE (function);
1786
1787 /* In a void function, return PVM_NULL in the stack. Otherwise, it
1788 is a run-time error to reach this point. */
1789 if (PKL_AST_TYPE_CODE (PKL_AST_TYPE_F_RTYPE (function_type))
1790 == PKL_TYPE_VOID)
1791 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
1792 else
1793 {
1794 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1795 pvm_make_exception (PVM_E_NO_RETURN, PVM_E_NO_RETURN_MSG,
1796 PVM_E_NO_RETURN_ESTATUS));
1797 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAISE);
1798 }
1799
1800 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
1801 }
1802 PKL_PHASE_END_HANDLER
1803
1804 /*
1805 * INTEGER
1806 */
1807
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_integer)1808 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_integer)
1809 {
1810 pkl_ast_node integer = PKL_PASS_NODE;
1811 pkl_ast_node type;
1812 pvm_val val;
1813 int size;
1814 uint64_t value;
1815
1816 type = PKL_AST_TYPE (integer);
1817 assert (type != NULL
1818 && PKL_AST_TYPE_CODE (type) == PKL_TYPE_INTEGRAL);
1819
1820 size = PKL_AST_TYPE_I_SIZE (type);
1821 value = PKL_AST_INTEGER_VALUE (integer);
1822
1823 if ((size - 1) & ~0x1f)
1824 {
1825 if (PKL_AST_TYPE_I_SIGNED_P (type))
1826 val = pvm_make_long (value, size);
1827 else
1828 val = pvm_make_ulong (value, size);
1829 }
1830 else
1831 {
1832 if (PKL_AST_TYPE_I_SIGNED_P (type))
1833 val = pvm_make_int (value, size);
1834 else
1835 val = pvm_make_uint (value, size);
1836 }
1837
1838 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, val);
1839 }
1840 PKL_PHASE_END_HANDLER
1841
1842 /*
1843 * IDENTIFIER
1844 */
1845
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_identifier)1846 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_identifier)
1847 {
1848 pkl_ast_node identifier = PKL_PASS_NODE;
1849 pvm_val val
1850 = pvm_make_string (PKL_AST_IDENTIFIER_POINTER (identifier));
1851
1852 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, val);
1853 }
1854 PKL_PHASE_END_HANDLER
1855
1856 /*
1857 * STRING
1858 */
1859
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_string)1860 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_string)
1861 {
1862 pkl_ast_node string = PKL_PASS_NODE;
1863 pvm_val val
1864 = pvm_make_string (PKL_AST_STRING_POINTER (string));
1865
1866 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, val);
1867 }
1868 PKL_PHASE_END_HANDLER
1869
1870 /*
1871 * TYPE_OFFSET
1872 * | BASE_TYPE
1873 * | UNIT
1874 */
1875
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_type_offset)1876 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_offset)
1877 {
1878 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_WRITER))
1879 {
1880 /* Stack: IOS BOFF VAL */
1881 /* The offset to poke is stored in the TOS. Replace the offset
1882 at the TOS with the magnitude of the offset and let the
1883 BASE_TYPE handler to tackle it. */
1884 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OGETM); /* IOS BOFF VAL VMAG */
1885 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP); /* IOS BOFF VMAG */
1886
1887 PKL_PASS_SUBPASS (PKL_AST_TYPE_O_BASE_TYPE (PKL_PASS_NODE)); /* _ */
1888 PKL_PASS_BREAK;
1889 }
1890 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER | PKL_GEN_CTX_IN_CONSTRUCTOR))
1891 {
1892 PKL_PASS_SUBPASS (PKL_AST_TYPE_O_BASE_TYPE (PKL_PASS_NODE)); /* VAL */
1893 PKL_PASS_SUBPASS (PKL_AST_TYPE_O_UNIT (PKL_PASS_NODE)); /* VAL UNIT */
1894 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKO); /* OFF */
1895 PKL_PASS_BREAK;
1896 }
1897 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_PRINTER))
1898 {
1899 /* VAL DEPTH */
1900 RAS_MACRO_OFFSET_PRINTER (PKL_PASS_NODE); /* _ */
1901 PKL_PASS_BREAK;
1902 }
1903 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
1904 {
1905 /* Just build an offset type. */
1906 PKL_PASS_SUBPASS (PKL_AST_TYPE_O_BASE_TYPE (PKL_PASS_NODE)); /* BASE_TYPE */
1907 PKL_PASS_SUBPASS (PKL_AST_TYPE_O_UNIT (PKL_PASS_NODE)); /* UNIT */
1908 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYO);
1909 PKL_PASS_BREAK;
1910 }
1911
1912 /* We are in the normal context. Process the base type, but not the
1913 unit as we don't need it. */
1914 PKL_PASS_SUBPASS (PKL_AST_TYPE_O_BASE_TYPE (PKL_PASS_NODE));
1915 PKL_PASS_BREAK;
1916 }
1917 PKL_PHASE_END_HANDLER
1918
1919 /*
1920 * | TYPE
1921 * | MAGNITUDE
1922 * | UNIT
1923 * OFFSET
1924 */
1925
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_offset)1926 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_offset)
1927 {
1928 pkl_asm pasm = PKL_GEN_ASM;
1929
1930 pkl_asm_insn (pasm, PKL_INSN_MKO);
1931 }
1932 PKL_PHASE_END_HANDLER
1933
1934 /*
1935 * | TYPE
1936 * | EXP
1937 * ISA
1938 */
1939
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_isa)1940 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_isa)
1941 {
1942 PKL_GEN_DUP_CONTEXT;
1943 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
1944 PKL_PASS_SUBPASS (PKL_AST_ISA_TYPE (PKL_PASS_NODE));
1945 PKL_GEN_POP_CONTEXT;
1946
1947 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ISA);
1948 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
1949 }
1950 PKL_PHASE_END_HANDLER
1951
1952 /*
1953 * CAST
1954 * | TYPE
1955 * | EXP
1956 */
1957
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_cast)1958 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_cast)
1959 {
1960 pkl_asm pasm = PKL_GEN_ASM;
1961 pkl_ast_node node = PKL_PASS_NODE;
1962
1963 pkl_ast_node exp;
1964 pkl_ast_node to_type;
1965 pkl_ast_node from_type;
1966
1967 exp = PKL_AST_CAST_EXP (node);
1968
1969 to_type = PKL_AST_CAST_TYPE (node);
1970 from_type = PKL_AST_TYPE (exp);
1971
1972 /* Traverse the type and expression in normal context. */
1973 PKL_GEN_PUSH_CONTEXT;
1974 PKL_PASS_SUBPASS (to_type); /* _ */
1975 PKL_PASS_SUBPASS (exp); /* EXP */
1976 PKL_GEN_POP_CONTEXT;
1977
1978 /* And finally generate code for the cast operation. */
1979 if (PKL_AST_TYPE_CODE (from_type) == PKL_TYPE_ANY)
1980 {
1981 pvm_program_label label = pkl_asm_fresh_label (PKL_GEN_ASM);
1982
1983 PKL_GEN_PUSH_CONTEXT;
1984 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
1985 PKL_PASS_SUBPASS (to_type);
1986 PKL_GEN_POP_CONTEXT;
1987
1988 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ISA);
1989 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
1990 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNZI, label);
1991 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
1992 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
1993 pvm_make_exception (PVM_E_CONV, PVM_E_CONV_MSG,
1994 PVM_E_CONV_ESTATUS));
1995 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAISE);
1996 pkl_asm_label (PKL_GEN_ASM, label);
1997 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
1998 }
1999 else if (PKL_AST_TYPE_CODE (from_type) == PKL_TYPE_INTEGRAL
2000 && PKL_AST_TYPE_CODE (to_type) == PKL_TYPE_INTEGRAL)
2001 {
2002 pkl_asm_insn (pasm, PKL_INSN_NTON,
2003 from_type, to_type);
2004 pkl_asm_insn (pasm, PKL_INSN_NIP);
2005 }
2006 else if (PKL_AST_TYPE_CODE (from_type) == PKL_TYPE_OFFSET
2007 && PKL_AST_TYPE_CODE (to_type) == PKL_TYPE_OFFSET)
2008 {
2009 pkl_ast_node to_unit = PKL_AST_TYPE_O_UNIT (to_type);
2010
2011 pkl_asm_insn (pasm, PKL_INSN_PUSH,
2012 pvm_make_ulong (PKL_AST_INTEGER_VALUE (to_unit), 64));
2013 pkl_asm_insn (pasm, PKL_INSN_OTO, from_type, to_type);
2014 }
2015 else if (PKL_AST_TYPE_CODE (to_type) == PKL_TYPE_STRING)
2016 {
2017 pkl_asm_insn (pasm, PKL_INSN_CTOS);
2018 pkl_asm_insn (pasm, PKL_INSN_NIP);
2019 }
2020 else if (PKL_AST_TYPE_CODE (to_type) == PKL_TYPE_ARRAY
2021 && PKL_AST_TYPE_CODE (from_type) == PKL_TYPE_ARRAY)
2022 {
2023 /* Make sure the cast type has a bounder. If it doesn't,
2024 compile and install one. */
2025 int bounder_created_p = 0;
2026
2027 if (PKL_AST_TYPE_A_BOUNDER (to_type) == PVM_NULL)
2028 {
2029 bounder_created_p = 1;
2030 PKL_GEN_DUP_CONTEXT;
2031 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_ARRAY_BOUNDER);
2032 PKL_PASS_SUBPASS (to_type);
2033 PKL_GEN_POP_CONTEXT;
2034 }
2035
2036 pkl_asm_insn (pasm, PKL_INSN_ATOA, from_type, to_type);
2037
2038 if (bounder_created_p)
2039 pkl_ast_array_type_remove_bounders (to_type);
2040 }
2041 else if (PKL_AST_TYPE_CODE (to_type) == PKL_TYPE_STRUCT
2042 && PKL_AST_TYPE_CODE (from_type) == PKL_TYPE_STRUCT)
2043 {
2044 pvm_val constructor = PKL_AST_TYPE_S_CONSTRUCTOR (to_type);
2045
2046 /* The constructor should exist, because a struct type specified
2047 in a cast shall be referred by name. */
2048 assert (constructor != PVM_NULL);
2049
2050 /* Apply the constructor to the expression, which is also a
2051 struct. */
2052 pkl_asm_insn (pasm, PKL_INSN_PUSH, constructor);
2053 pkl_asm_insn (pasm, PKL_INSN_CALL);
2054 }
2055 else if (PKL_AST_TYPE_CODE (to_type) == PKL_TYPE_INTEGRAL
2056 && PKL_AST_TYPE_CODE (from_type) == PKL_TYPE_STRUCT)
2057 {
2058 pkl_ast_node itype = PKL_AST_TYPE_S_ITYPE (from_type);
2059
2060 /* This is guaranteed as per typify. */
2061 assert (itype);
2062
2063 /* Make sure the struct type has an integrator. */
2064 if (PKL_AST_TYPE_S_INTEGRATOR (from_type) == PVM_NULL)
2065 {
2066 pvm_val integrator_closure;
2067
2068 /* See note about in_writer in pkl_gen_pr_decl. */
2069 PKL_GEN_DUP_CONTEXT;
2070 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
2071 RAS_FUNCTION_STRUCT_INTEGRATOR (integrator_closure,
2072 from_type); /* CLS */
2073
2074 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, integrator_closure); /* CLS */
2075 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
2076 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
2077 PKL_GEN_POP_CONTEXT;
2078
2079 PKL_AST_TYPE_S_INTEGRATOR (from_type) = integrator_closure;
2080 }
2081
2082 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2083 PKL_AST_TYPE_S_INTEGRATOR (from_type));
2084 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL);
2085 pkl_asm_insn (pasm, PKL_INSN_NTON, itype, to_type);
2086 pkl_asm_insn (pasm, PKL_INSN_NIP);
2087 }
2088 else
2089 assert (0);
2090
2091 PKL_PASS_BREAK;
2092 }
2093 PKL_PHASE_END_HANDLER
2094
2095 /*
2096 * | CONS_TYPE
2097 * | [CONS_VALUE]
2098 * CONS
2099 */
2100
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_cons)2101 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_cons)
2102 {
2103 pkl_ast_node cons = PKL_PASS_NODE;
2104 int cons_kind = PKL_AST_CONS_KIND (cons);
2105 pkl_ast_node cons_type = PKL_AST_CONS_TYPE (cons);
2106
2107 switch (cons_kind)
2108 {
2109 case PKL_AST_CONS_KIND_ARRAY:
2110 /* Build an array with default values. Note how array
2111 constructors do not use their argument. */
2112 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
2113 PKL_GEN_DUP_CONTEXT;
2114 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_CONSTRUCTOR);
2115 PKL_PASS_SUBPASS (cons_type);
2116 PKL_GEN_POP_CONTEXT;
2117
2118 /* If an initial value has been provided, set the elements of
2119 the array to this value. */
2120 if (PKL_AST_CONS_VALUE (cons))
2121 {
2122 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* ARR IVAL */
2123 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AFILL); /* ARR IVAL */
2124 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* ARR */
2125 }
2126 break;
2127 case PKL_AST_CONS_KIND_STRUCT:
2128 PKL_GEN_DUP_CONTEXT;
2129 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_CONSTRUCTOR);
2130 PKL_PASS_SUBPASS (cons_type);
2131 PKL_GEN_POP_CONTEXT;
2132 break;
2133 default:
2134 assert (0);
2135 }
2136 }
2137 PKL_PHASE_END_HANDLER
2138
2139 /*
2140 * MAP
2141 * | [MAP_IOS]
2142 * | MAP_OFFSET
2143 * | MAP_TYPE
2144 */
2145
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_map)2146 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_map)
2147 {
2148 pkl_ast_node map = PKL_PASS_NODE;
2149 pkl_ast_node map_offset = PKL_AST_MAP_OFFSET (map);
2150 pkl_ast_node map_ios = PKL_AST_MAP_IOS (map);
2151 pkl_ast_node map_type = PKL_AST_MAP_TYPE (map);
2152
2153 /* Traverse the map type in normal context. */
2154 PKL_GEN_PUSH_CONTEXT;
2155 PKL_PASS_SUBPASS (map_type);
2156 PKL_GEN_POP_CONTEXT;
2157
2158 if (PKL_PASS_PARENT == NULL
2159 && PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_LVALUE))
2160 {
2161 /* This is an l-value in an assignment. Generate code for the
2162 offset, which is expected by the ass_stmt PS handler. */
2163 if (map_ios)
2164 {
2165 PKL_GEN_DUP_CONTEXT;
2166 PKL_GEN_CLEAR_CONTEXT (PKL_GEN_CTX_IN_LVALUE);
2167 PKL_PASS_SUBPASS (map_ios);
2168 PKL_GEN_POP_CONTEXT;
2169 }
2170 else
2171 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
2172
2173 PKL_GEN_DUP_CONTEXT;
2174 PKL_GEN_CLEAR_CONTEXT (PKL_GEN_CTX_IN_LVALUE);
2175 PKL_PASS_SUBPASS (map_offset);
2176 PKL_GEN_POP_CONTEXT;
2177 }
2178 else
2179 {
2180 pkl_ast_node map_offset_magnitude = NULL;
2181
2182 /* Push the strictness to use for the map. */
2183 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2184 pvm_make_int (PKL_AST_MAP_STRICT_P (map), 32));
2185
2186 /* Push the IOS of the map. */
2187 if (map_ios)
2188 PKL_PASS_SUBPASS (map_ios);
2189 else
2190 /* PVM_NULL means use the current IO space, if any. */
2191 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSHIOS);
2192
2193 /* Push the offset of the map and convert to a bit-offset. Note
2194 that the offset is guaranteed to be an ulong<64> with unit
2195 bits, as per promo.
2196
2197 But optimize for offsets whose magnitude is an integer node,
2198 transforming to bit offsets at compile time. */
2199 if (PKL_AST_CODE (map_offset) == PKL_AST_OFFSET)
2200 map_offset_magnitude = PKL_AST_OFFSET_MAGNITUDE (map_offset);
2201
2202 if (map_offset_magnitude
2203 && PKL_AST_CODE (map_offset_magnitude) == PKL_AST_INTEGER)
2204 {
2205 uint64_t magnitude
2206 = PKL_AST_INTEGER_VALUE (map_offset_magnitude);
2207
2208 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2209 pvm_make_ulong (magnitude, 64));
2210 }
2211 else
2212 {
2213 PKL_PASS_SUBPASS (map_offset);
2214 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OGETM);
2215 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
2216 }
2217
2218 PKL_GEN_DUP_CONTEXT;
2219 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_MAPPER);
2220 PKL_PASS_SUBPASS (map_type);
2221 PKL_GEN_POP_CONTEXT;
2222 }
2223
2224 PKL_PASS_BREAK;
2225 }
2226 PKL_PHASE_END_HANDLER
2227
2228 /*
2229 * ARRAY_INITIALIZER
2230 * | ARRAY_INITIALIZER_INDEX
2231 * | ARRAY_INITIALIZER_EXP
2232 */
2233
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_array_initializer)2234 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_array_initializer)
2235 {
2236 /* Do nothing. */
2237 }
2238 PKL_PHASE_END_HANDLER
2239
2240 /*
2241 * | ARRAY_INITIALIZER_INDEX
2242 * | ARRAY_INITIALIZER_EXP
2243 * ARRAY_INITIALIZER
2244 */
2245
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_array_initializer)2246 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_array_initializer)
2247 {
2248 /* Insert this initializer in the array. */
2249 /* ARR IDX EXP */
2250 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AINS); /* ARR */
2251 }
2252 PKL_PHASE_END_HANDLER
2253
2254 /*
2255 * ARRAY
2256 * | ARRAY_INITIALIZER
2257 * | ...
2258 */
2259
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_array)2260 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_array)
2261 {
2262 pkl_ast_node array = PKL_PASS_NODE;
2263 pkl_ast_node array_type = PKL_AST_TYPE (array);
2264 pvm_val array_type_writer = PVM_NULL;
2265
2266 /* Create a new empty array of the right type, having the right
2267 number of elements. */
2268
2269 PKL_GEN_PUSH_CONTEXT;
2270 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
2271 PKL_PASS_SUBPASS (array_type); /* TYP */
2272 PKL_GEN_POP_CONTEXT;
2273
2274 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2275 pvm_make_ulong (PKL_AST_ARRAY_NELEM (array), 64));
2276 /* TYP NELEM */
2277 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKA); /* ARR */
2278
2279 /* Install a writer in the array. */
2280 PKL_GEN_DUP_CONTEXT;
2281 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
2282 RAS_FUNCTION_ARRAY_WRITER (array_type_writer, array_type);
2283 PKL_AST_TYPE_A_WRITER (array_type) = array_type_writer;
2284 PKL_GEN_POP_CONTEXT;
2285 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, array_type_writer); /* CLS */
2286 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
2287 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETW); /* ARR */
2288 }
2289 PKL_PHASE_END_HANDLER
2290
2291 /*
2292 * | ARRAY_TYPE
2293 * | ARRAY_INITIALIZER
2294 * | ...
2295 * ARRAY
2296 */
2297
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_array)2298 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_array)
2299 {
2300 /* Nothing to do here. */
2301 }
2302 PKL_PHASE_END_HANDLER
2303
2304 /*
2305 * TRIMMER
2306 * | ENTITY
2307 * | FROM
2308 * | TO
2309 * | ADDEND
2310 */
2311
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_trimmer)2312 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_trimmer)
2313 {
2314 pkl_ast_node trimmer = PKL_PASS_NODE;
2315 pkl_ast_node trimmer_type = PKL_AST_TYPE (trimmer);
2316 pkl_ast_node trimmer_entity = PKL_AST_TRIMMER_ENTITY (trimmer);
2317 pkl_ast_node trimmer_from = PKL_AST_TRIMMER_FROM (trimmer);
2318 pkl_ast_node trimmer_to = PKL_AST_TRIMMER_TO (trimmer);
2319
2320 PKL_PASS_SUBPASS (trimmer_entity);
2321 PKL_PASS_SUBPASS (trimmer_from);
2322 PKL_PASS_SUBPASS (trimmer_to);
2323
2324 switch (PKL_AST_TYPE_CODE (trimmer_type))
2325 {
2326 case PKL_TYPE_STRING:
2327 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SUBSTR);
2328 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
2329 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
2330 break;
2331 case PKL_TYPE_ARRAY:
2332 {
2333 pkl_ast_node array = PKL_AST_TRIMMER_ENTITY (trimmer);
2334
2335 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ATRIM,
2336 PKL_AST_TYPE (array));
2337 break;
2338 }
2339 default:
2340 assert (0);
2341 }
2342
2343 PKL_PASS_BREAK;
2344 }
2345 PKL_PHASE_END_HANDLER
2346
2347 /*
2348 * INDEXER
2349 * | INDEXER_ENTITY
2350 * | INDEXER_INDEX
2351 */
2352
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_indexer)2353 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_indexer)
2354 {
2355 pkl_ast_node indexer = PKL_PASS_NODE;
2356 pkl_ast_node indexer_entity = PKL_AST_INDEXER_ENTITY (indexer);
2357 pkl_ast_node indexer_index = PKL_AST_INDEXER_INDEX (indexer);
2358
2359 /* Traverse the entity and indexer in normal context. */
2360 PKL_GEN_PUSH_CONTEXT;
2361 PKL_PASS_SUBPASS (indexer_entity);
2362 PKL_PASS_SUBPASS (indexer_index);
2363 PKL_GEN_POP_CONTEXT;
2364
2365 if (PKL_PASS_PARENT == NULL
2366 && PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_LVALUE))
2367 {
2368 /* This is a l-value in an assignment. The array and the index
2369 are pushed to the stack for the ass_stmt PR handler. Nothing
2370 else to do here. Note that analf guarantees that the entity
2371 in this indexer is an array, not a string. */
2372 }
2373 else
2374 {
2375 pkl_ast_node indexer_type = PKL_AST_TYPE (indexer);
2376 pkl_ast_node container = PKL_AST_INDEXER_ENTITY (indexer);
2377 pkl_ast_node container_type = PKL_AST_TYPE (container);
2378
2379 switch (PKL_AST_TYPE_CODE (container_type))
2380 {
2381 case PKL_TYPE_ARRAY:
2382 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AREF);
2383 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
2384
2385 /* To cover cases where the referenced array is not mapped, but
2386 the value stored in it is a mapped value, we issue a
2387 REMAP. */
2388 switch (PKL_AST_TYPE_CODE (indexer_type))
2389 {
2390 case PKL_TYPE_ARRAY:
2391 case PKL_TYPE_STRUCT:
2392 /* XXX: this is redundant IO for many (most?) cases. */
2393 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REMAP);
2394 break;
2395 default:
2396 break;
2397 }
2398 break;
2399 case PKL_TYPE_STRING:
2400 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_STRREF);
2401 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
2402 break;
2403 default:
2404 assert (0);
2405 }
2406 }
2407
2408 PKL_PASS_BREAK;
2409 }
2410 PKL_PHASE_END_HANDLER
2411
2412 /*
2413 * STRUCT
2414 * | STRUCT_FIELD
2415 * | ...
2416 */
2417
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_struct)2418 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_struct)
2419 {
2420 /* The offset of the new struct, which should be PVM_NULL, as it is
2421 not mapped. */
2422 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
2423 }
2424 PKL_PHASE_END_HANDLER
2425
2426 /*
2427 * | STRUCT_FIELD
2428 * | ...
2429 * STRUCT
2430 */
2431
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_struct)2432 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_struct)
2433 {
2434 pkl_ast_node sct = PKL_PASS_NODE;
2435 pkl_ast_node sct_type = PKL_AST_TYPE (sct);
2436
2437 /* No methods in struct literals. */
2438 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_ulong (0, 64));
2439 /* The number of elements in struct literals corresponds to the
2440 number of fields, since there are no declarations in them. */
2441 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2442 pvm_make_ulong (PKL_AST_STRUCT_NELEM (sct), 64));
2443
2444 PKL_GEN_PUSH_CONTEXT;
2445 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_TYPE);
2446 PKL_PASS_SUBPASS (sct_type); /* TYP */
2447 PKL_GEN_POP_CONTEXT;
2448
2449 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKSCT);
2450 }
2451 PKL_PHASE_END_HANDLER
2452
2453 /*
2454 * STRUCT_FIELD
2455 * | [STRUCT_FIELD_NAME]
2456 * | STRUCT_FIELD_EXP
2457 */
2458
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_struct_field)2459 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_struct_field)
2460 {
2461 pkl_ast_node struct_field = PKL_PASS_NODE;
2462 pkl_ast_node struct_field_name
2463 = PKL_AST_STRUCT_FIELD_NAME (struct_field);
2464
2465 /* Element's offset. PVM_NULL means use the "natural" offset. */
2466 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
2467
2468 /* If the struct initializer doesn't include a name, generate a null
2469 value as expected by the mksct instruction. */
2470 if (!struct_field_name)
2471 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
2472 }
2473 PKL_PHASE_END_HANDLER
2474
2475 /*
2476 * | STRUCT
2477 * | IDENTIFIER
2478 * STRUCT_REF
2479 */
2480
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_struct_ref)2481 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_struct_ref)
2482 {
2483 if (PKL_PASS_PARENT == NULL
2484 && PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_LVALUE))
2485 {
2486 /* This is a -lvalue in an assignment. The struct and the
2487 identifier are pushed to the stack for the ass_stmt PS
2488 handler. Nothing else to do here. */
2489 }
2490 else
2491 {
2492 pkl_ast_node struct_ref = PKL_PASS_NODE;
2493 pkl_ast_node struct_ref_type = PKL_AST_TYPE (struct_ref);
2494 pkl_ast_node struct_ref_struct
2495 = PKL_AST_STRUCT_REF_STRUCT (struct_ref);
2496 pkl_ast_node struct_ref_identifier
2497 = PKL_AST_STRUCT_REF_IDENTIFIER (struct_ref);
2498 pkl_ast_node struct_ref_struct_type = PKL_AST_TYPE (struct_ref_struct);
2499 pkl_ast_node elem;
2500 int is_field_p = 0;
2501
2502 /* Determine whether the referred struct element is a field or a
2503 declaration. */
2504 for (elem = PKL_AST_TYPE_S_ELEMS (struct_ref_struct_type);
2505 elem;
2506 elem = PKL_AST_CHAIN (elem))
2507 {
2508 if (PKL_AST_CODE (elem) == PKL_AST_STRUCT_TYPE_FIELD)
2509 {
2510 pkl_ast_node field_name
2511 = PKL_AST_STRUCT_TYPE_FIELD_NAME (elem);
2512
2513 if (field_name != NULL
2514 && strcmp (PKL_AST_IDENTIFIER_POINTER (field_name),
2515 PKL_AST_IDENTIFIER_POINTER (struct_ref_identifier)) == 0)
2516 {
2517 is_field_p = 1;
2518 break;
2519 }
2520 }
2521 }
2522
2523 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SREF);
2524 /* If the parent is a funcall and the referred field is a struct
2525 method, then leave both the struct and the closure. */
2526 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_FUNCALL)
2527 && !PKL_PASS_PARENT && !is_field_p)
2528 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
2529 else
2530 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
2531
2532 /* To cover cases where the referenced struct is not mapped, but
2533 the value stored in it is a mapped value, we issue a
2534 REMAP. */
2535 switch (PKL_AST_TYPE_CODE (struct_ref_type))
2536 {
2537 case PKL_TYPE_ARRAY:
2538 case PKL_TYPE_STRUCT:
2539 /* XXX: this is redundant IO for many (most?) cases. */
2540 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_REMAP);
2541 break;
2542 default:
2543 break;
2544 }
2545 }
2546 }
2547 PKL_PHASE_END_HANDLER
2548
2549 /*
2550 * TYPE_VOID
2551 */
2552
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_type_void)2553 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_type_void)
2554 {
2555 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
2556 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYV);
2557 }
2558 PKL_PHASE_END_HANDLER
2559
2560 /*
2561 * TYPE_ANY
2562 */
2563
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_type_any)2564 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_type_any)
2565 {
2566 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
2567 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYANY);
2568 }
2569 PKL_PHASE_END_HANDLER
2570
2571 /*
2572 * TYPE_INTEGRAL
2573 */
2574
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_type_integral)2575 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_type_integral)
2576 {
2577 pkl_asm pasm = PKL_GEN_ASM;
2578 pkl_ast_node integral_type = PKL_PASS_NODE;
2579
2580 /* Note that the check for in_writer should appear first than the
2581 check for in_mapper. */
2582 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_WRITER))
2583 {
2584 /* Stack: IOS BOFF VAL */
2585 switch (PKL_GEN_PAYLOAD->endian)
2586 {
2587 case PKL_AST_ENDIAN_DFL:
2588 pkl_asm_insn (pasm, PKL_INSN_POKED, integral_type);
2589 break;
2590 case PKL_AST_ENDIAN_LSB:
2591 pkl_asm_insn (pasm, PKL_INSN_POKE, integral_type,
2592 IOS_NENC_2, IOS_ENDIAN_LSB);
2593 break;
2594 case PKL_AST_ENDIAN_MSB:
2595 pkl_asm_insn (pasm, PKL_INSN_POKE, integral_type,
2596 IOS_NENC_2, IOS_ENDIAN_MSB);
2597 break;
2598 default:
2599 assert (0);
2600 }
2601 }
2602 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER))
2603 {
2604 /* Stack: STRICT IOS BOFF */
2605 switch (PKL_GEN_PAYLOAD->endian)
2606 {
2607 case PKL_AST_ENDIAN_DFL:
2608 pkl_asm_insn (pasm, PKL_INSN_PEEKD, integral_type);
2609 break;
2610 case PKL_AST_ENDIAN_LSB:
2611 pkl_asm_insn (pasm, PKL_INSN_PEEK, integral_type,
2612 IOS_NENC_2, IOS_ENDIAN_LSB);
2613 break;
2614 case PKL_AST_ENDIAN_MSB:
2615 pkl_asm_insn (pasm, PKL_INSN_PEEK, integral_type,
2616 IOS_NENC_2, IOS_ENDIAN_MSB);
2617 break;
2618 default:
2619 assert (0);
2620 }
2621
2622 pkl_asm_insn (pasm, PKL_INSN_NIP); /* STRICT is not used. */
2623 }
2624 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_CONSTRUCTOR))
2625 {
2626 /* Stack: NULL */
2627 int size = PKL_AST_TYPE_I_SIZE (integral_type);
2628 pvm_val zero;
2629
2630 if (PKL_AST_TYPE_I_SIGNED_P (integral_type))
2631 {
2632 if (size <= 32)
2633 zero = pvm_make_int (0, size);
2634 else
2635 zero = pvm_make_long (0, size);
2636 }
2637 else
2638 {
2639 if (size <= 32)
2640 zero = pvm_make_uint (0, size);
2641 else
2642 zero = pvm_make_ulong (0, size);
2643 }
2644
2645 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The NULL */
2646 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, zero);
2647 }
2648 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_PRINTER))
2649 {
2650 /* VAL DEPTH */
2651 RAS_MACRO_INTEGRAL_PRINTER (PKL_PASS_NODE); /* _ */
2652 }
2653 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
2654 {
2655 pkl_asm_insn (pasm, PKL_INSN_PUSH,
2656 pvm_make_ulong (PKL_AST_TYPE_I_SIZE (integral_type),
2657 64));
2658
2659 pkl_asm_insn (pasm, PKL_INSN_PUSH,
2660 pvm_make_uint (PKL_AST_TYPE_I_SIGNED_P (integral_type),
2661 32));
2662
2663 pkl_asm_insn (pasm, PKL_INSN_MKTYI);
2664 }
2665 }
2666 PKL_PHASE_END_HANDLER
2667
2668 /*
2669 * FUNC_TYPE_ARG
2670 * | FUNC_TYPE_ARG_TYPE
2671 */
2672
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_func_type_arg)2673 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_func_type_arg)
2674 {
2675 /* Nothing to do. */
2676 }
2677 PKL_PHASE_END_HANDLER
2678
2679 /* TYPE_FUNCTION
2680 * | FUNC_TYPE_ARG
2681 * | ...
2682 * | FUNC_TYPE_RTYPE
2683 */
2684
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_type_function)2685 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_function)
2686 {
2687 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_WRITER))
2688 {
2689 /* Writing a function value is a NOP. */
2690 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The VAL */
2691 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The BOFF */
2692 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The IOS */
2693
2694 PKL_PASS_BREAK;
2695 }
2696 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER | PKL_GEN_CTX_IN_CONSTRUCTOR))
2697 {
2698 /* We construct the same function value for mappings and
2699 constructions. */
2700
2701 pkl_ast_node function_type = PKL_PASS_NODE;
2702 pkl_ast_node function_rtype = PKL_AST_TYPE_F_RTYPE (function_type);
2703 pvm_program program;
2704
2705 /* Compile the body for the function value. */
2706 PKL_GEN_PUSH_ASM (pkl_asm_new (PKL_PASS_AST,
2707 PKL_GEN_PAYLOAD->compiler,
2708 0 /* prologue */));
2709 {
2710 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PROLOG);
2711 int i;
2712
2713 /* Discard arguments. */
2714 for (i = 0; i < PKL_AST_TYPE_F_NARG (function_type); ++i)
2715 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
2716
2717 /* If the function returns a value, construct it. */
2718 if (PKL_AST_TYPE_CODE (function_rtype) == PKL_TYPE_VOID)
2719 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
2720 else
2721 {
2722 /* Constructor argument. */
2723 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
2724
2725 PKL_GEN_DUP_CONTEXT;
2726 PKL_GEN_CLEAR_CONTEXT (PKL_GEN_CTX_IN_MAPPER);
2727 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_CONSTRUCTOR);
2728 PKL_PASS_SUBPASS (function_rtype);
2729 PKL_GEN_POP_CONTEXT;
2730 }
2731
2732 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RETURN);
2733 }
2734
2735 program = pkl_asm_finish (PKL_GEN_ASM, 0 /* epilogue */);
2736 PKL_GEN_POP_ASM;
2737
2738 pvm_program_make_executable (program);
2739
2740 /* Discard constructor/mapper arguments. */
2741 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
2742 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER))
2743 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
2744
2745 /* Push the constructed closure and install the current lexical
2746 environment. */
2747 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_cls (program));
2748 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DUC);
2749 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
2750
2751 /* If in a mapper, get rid of the unused STRICT. */
2752 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER))
2753 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
2754
2755 PKL_PASS_BREAK;
2756 }
2757 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_PRINTER))
2758 {
2759 /* Stack: VAL DEPTH */
2760 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* DEPTH is not used. */
2761 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
2762 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2763 pvm_make_string ("#<closure>"));
2764 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PRINTS);
2765 PKL_PASS_BREAK;
2766 }
2767 }
2768 PKL_PHASE_END_HANDLER
2769
2770 /*
2771 * | FUNC_TYPE_ARG
2772 * | ...
2773 * | FUNC_TYPE_RTYPE
2774 * TYPE_FUNCTION
2775 */
2776
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_type_function)2777 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_type_function)
2778 {
2779 pkl_ast_node ftype = PKL_PASS_NODE;
2780
2781 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
2782 {
2783 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2784 pvm_make_ulong (PKL_AST_TYPE_F_NARG (ftype), 64));
2785 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYC);
2786 }
2787 }
2788 PKL_PHASE_END_HANDLER
2789
2790 /*
2791 * TYPE_ARRAY
2792 * | ETYPE
2793 * | NELEM
2794 */
2795
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_type_array)2796 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_array)
2797 {
2798 /* Note that the check for in_writer should appear first than the
2799 check for in_mapper. */
2800 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_WRITER))
2801 {
2802 /* Stack: IOS OFF ARR */
2803
2804 /* Note that we don't use the offset, nor the IOS, since these
2805 are attributes of the mapped value. */
2806 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_WRITE);
2807 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The array. */
2808 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The offset. */
2809 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The ios. */
2810
2811 PKL_PASS_BREAK;
2812 }
2813 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_ARRAY_BOUNDER))
2814 {
2815 pkl_ast_node array_type = PKL_PASS_NODE;
2816 pkl_ast_node etype = PKL_AST_TYPE_A_ETYPE (array_type);
2817 pvm_val bounder_closure;
2818
2819 if (PKL_AST_TYPE_CODE (etype) == PKL_TYPE_ARRAY)
2820 PKL_PASS_SUBPASS (etype);
2821
2822 if (PKL_AST_TYPE_A_BOUNDER (array_type) == PVM_NULL)
2823 {
2824 RAS_FUNCTION_ARRAY_BOUNDER (bounder_closure, array_type);
2825 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, bounder_closure); /* CLS */
2826 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
2827 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
2828 PKL_AST_TYPE_A_BOUNDER (array_type) = bounder_closure;
2829 }
2830
2831 PKL_PASS_BREAK;
2832 }
2833 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER))
2834 {
2835 pkl_ast_node array_type = PKL_PASS_NODE;
2836 pkl_ast_node array_type_bound = PKL_AST_TYPE_A_BOUND (array_type);
2837
2838 pvm_val array_type_mapper = PKL_AST_TYPE_A_MAPPER (array_type);
2839 pvm_val array_type_writer = PKL_AST_TYPE_A_WRITER (array_type);
2840
2841 int bounder_created = 0;
2842
2843 /* Make a copy of the IOS. We will need to install it in the
2844 resulting value later. */
2845 /* STRICT IOS OFF */
2846 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR); /* STRICT IOS [OFF] */
2847 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OVER);
2848 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OVER);
2849 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR);/* STRICT IOS STRICT IOS OFF */
2850
2851 /* Make sure the array type has a bounder. Note that this
2852 should be done before compiling mapper, writer, constructor,
2853 etc functions, in order to make sure the bounder closures are
2854 compiled in the right environment. */
2855
2856 PKL_GEN_PAYLOAD->mapper_depth++;
2857
2858 if (PKL_GEN_PAYLOAD->mapper_depth == 1
2859 && PKL_AST_TYPE_A_BOUNDER (array_type) == PVM_NULL)
2860 {
2861 /* Note that this only happens at the top-level of an
2862 anonymous array type, and compiles a bounder for it.
2863 Named array types have their bounder compiled in
2864 pkl_gen_pr_decl. */
2865 bounder_created = 1;
2866
2867 PKL_GEN_DUP_CONTEXT;
2868 PKL_GEN_CLEAR_CONTEXT (PKL_GEN_CTX_IN_MAPPER);
2869 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_ARRAY_BOUNDER);
2870 PKL_PASS_SUBPASS (array_type);
2871 PKL_GEN_POP_CONTEXT;
2872 }
2873
2874 if (array_type_mapper != PVM_NULL)
2875 {
2876 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2877 array_type_mapper); /* ... STRICT IOS OFF CLS */
2878 }
2879 else
2880 {
2881 /* Compile a mapper function and complete it using the
2882 current environment. */
2883 pvm_val mapper_closure;
2884
2885 RAS_FUNCTION_ARRAY_MAPPER (mapper_closure, array_type);
2886
2887 /* Complete the mapper closure with the current
2888 environment. */
2889 /* OFF */
2890 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, mapper_closure);
2891 /* ... STRICT IOS OFF CLS */
2892 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* ... STRICT IOS OFF CLS */
2893 }
2894
2895 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR); /* ... STRICT IOS OFF [CLS] */
2896 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ATR); /* ... STRICT IOS OFF CLS [CLS] */
2897 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NROT); /* ... STRICT CLS IOS OFF [CLS] */
2898 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR); /* ... STRICT CLS IOS [CLS OFF] */
2899 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR); /* ... STRICT CLS [CLS OFF IOS] */
2900 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* ... CLS STRICT [CLS OFF IOS] */
2901 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR); /* ... CLS STRICT IOS [CLS OFF] */
2902 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR); /* ... CLS STRICT IOS OFF [CLS] */
2903 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR); /* ... CLS STRICT IOS OFF CLS */
2904
2905 /* Build the arguments and call the mapper to get a mapped array
2906 value. Whether the mapping is bounded, and exactly how, is
2907 determined from the array type. */
2908 if (array_type_bound
2909 && (PKL_AST_TYPE_CODE (PKL_AST_TYPE (array_type_bound))
2910 == PKL_TYPE_INTEGRAL))
2911 {
2912 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2913 PKL_AST_TYPE_A_BOUNDER (array_type));
2914 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL);
2915 }
2916 else
2917 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
2918 /* ... CLS STRICT IOS OFF CLS EBOUND */
2919
2920 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* ... CLS STRICT IOS OFF EBOUND CLS */
2921
2922 if (array_type_bound
2923 && (PKL_AST_TYPE_CODE (PKL_AST_TYPE (array_type_bound))
2924 == PKL_TYPE_OFFSET))
2925 {
2926 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2927 PKL_AST_TYPE_A_BOUNDER (array_type));
2928 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL);
2929
2930 /* Convert to bit-offset. */
2931 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OGETM);
2932 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
2933 }
2934 else
2935 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
2936 /* ... CLS STRICT IOS OFF EBOUND CLS SBOUND */
2937
2938 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);
2939 /* ... CLS STRICT IOS OFF EBOUND SBOUND CLS */
2940 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* STRICT IOS CLS VAL */
2941
2942 /* Install the mapper into the value. */
2943 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* STRICT IOS VAL CLS */
2944 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETM); /* STRICT IOS VAL */
2945
2946 /* Install the IOS into the value. */
2947 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* STRICT VAL IOS */
2948 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETIOS); /* STRICT VAL */
2949
2950 /* Install the strictness attribute of the value. */
2951 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* VAL STRICT */
2952 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETS); /* VAL */
2953
2954 if (array_type_writer != PVM_NULL)
2955 {
2956 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
2957 array_type_writer); /* VAL CLS */
2958 }
2959 else
2960 {
2961 pvm_val writer_closure;
2962
2963 /* Compile a writer function to a closure. */
2964 PKL_GEN_DUP_CONTEXT;
2965 PKL_GEN_CLEAR_CONTEXT (PKL_GEN_CTX_IN_MAPPER);
2966 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
2967 RAS_FUNCTION_ARRAY_WRITER (writer_closure, array_type);
2968 PKL_GEN_POP_CONTEXT;
2969
2970 /* Complete the writer closure with the current
2971 environment. */
2972 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, writer_closure); /* VAL CLS */
2973 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* VAL CLS */
2974 }
2975
2976 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETW); /* VAL */
2977 /* Yay!, we are done ;) */
2978
2979 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER))
2980 PKL_GEN_PAYLOAD->mapper_depth--;
2981
2982 if (bounder_created)
2983 pkl_ast_array_type_remove_bounders (array_type);
2984
2985 PKL_PASS_BREAK;
2986 }
2987 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_PRINTER))
2988 {
2989 /* Stack: ARR DEPTH */
2990
2991 pkl_ast_node array_type = PKL_PASS_NODE;
2992 pvm_val printer_closure = PKL_AST_TYPE_A_PRINTER (array_type);
2993
2994 /* If the array type doesn't have a printer, compile one. */
2995 if (printer_closure == PVM_NULL)
2996 {
2997 RAS_FUNCTION_ARRAY_PRINTER (printer_closure, array_type);
2998 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, printer_closure);
2999 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
3000 }
3001 else
3002 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, printer_closure);
3003
3004 /* Invoke the printer. */
3005 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* _ */
3006 PKL_PASS_BREAK;
3007 }
3008 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_CONSTRUCTOR))
3009 {
3010 /* Stack: null */
3011 pkl_ast_node array_type = PKL_PASS_NODE;
3012 pkl_ast_node array_type_bound = PKL_AST_TYPE_A_BOUND (array_type);
3013 pvm_val array_type_constructor = PKL_AST_TYPE_A_CONSTRUCTOR (array_type);
3014 pvm_val array_type_writer = PKL_AST_TYPE_A_WRITER (array_type);
3015 int bounder_created = 0;
3016
3017 PKL_GEN_PAYLOAD->constructor_depth++;
3018
3019 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The null. */
3020
3021 /* Make sure the array type has a bounder. */
3022 if (PKL_GEN_PAYLOAD->constructor_depth == 1
3023 && PKL_AST_TYPE_A_BOUNDER (array_type) == PVM_NULL)
3024 {
3025 /* Note that this only happens at the top-level of an
3026 anonymous array type, and compiles a bounder for it.
3027 Named array types have their bounder compiled in
3028 pkl_gen_pr_decl. */
3029 bounder_created = 1;
3030 PKL_GEN_DUP_CONTEXT;
3031 PKL_GEN_CLEAR_CONTEXT (PKL_GEN_CTX_IN_CONSTRUCTOR);
3032 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_ARRAY_BOUNDER);
3033 PKL_PASS_SUBPASS (array_type);
3034 PKL_GEN_POP_CONTEXT;
3035 }
3036
3037 /* Push the EBOUND argument for the constructor. */
3038 if (array_type_bound
3039 && (PKL_AST_TYPE_CODE (PKL_AST_TYPE (array_type_bound))
3040 == PKL_TYPE_INTEGRAL))
3041 {
3042 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NOTE, pvm_make_string ("bounder"));
3043 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3044 PKL_AST_TYPE_A_BOUNDER (array_type));
3045 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL);
3046 }
3047 else
3048 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
3049
3050 /* Push the SBOUND argument for the constructor, converted to a
3051 bit-offset. */
3052 if (array_type_bound
3053 && (PKL_AST_TYPE_CODE (PKL_AST_TYPE (array_type_bound))
3054 == PKL_TYPE_OFFSET))
3055 {
3056 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3057 PKL_AST_TYPE_A_BOUNDER (array_type));
3058 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL);
3059
3060 /* Convert to bit-offset. */
3061 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OGETM);
3062 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
3063 }
3064 else
3065 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
3066
3067 /* Make sure the array type has a constructor, and call it. */
3068 if (array_type_constructor != PVM_NULL)
3069 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3070 array_type_constructor); /* EBOUND SBOUND CLS */
3071 else
3072 {
3073 RAS_FUNCTION_ARRAY_CONSTRUCTOR (array_type_constructor, array_type);
3074 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, array_type_constructor);
3075 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
3076 }
3077
3078 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* ARR */
3079
3080 /* Install a writer in the constructed array. This is needed
3081 when the value is used as the right-hand-side to a
3082 map-assignment operation. */
3083 if (array_type_writer == PVM_NULL)
3084 {
3085 PKL_GEN_DUP_CONTEXT;
3086 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
3087 RAS_FUNCTION_ARRAY_WRITER (array_type_writer, array_type);
3088 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, array_type_writer); /* CLS */
3089 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
3090 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
3091 PKL_GEN_POP_CONTEXT;
3092
3093 PKL_AST_TYPE_A_WRITER (array_type) = array_type_writer;
3094 }
3095
3096 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3097 array_type_writer); /* ARR CLS */
3098 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETW); /* ARR */
3099
3100 PKL_GEN_PAYLOAD->constructor_depth--;
3101
3102 if (bounder_created)
3103 pkl_ast_array_type_remove_bounders (array_type);
3104
3105 PKL_PASS_BREAK;
3106 }
3107 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
3108 {
3109 /* Generating a PVM array type. */
3110
3111 pkl_ast_node etype = PKL_AST_TYPE_A_ETYPE (PKL_PASS_NODE);
3112
3113 PKL_PASS_SUBPASS (etype);
3114
3115 /* XXX at the moment the run-time bound in array types is unused
3116 so we just push null here. If it is ever used, this will be
3117 problematic because due to the additional lexical level
3118 introduced by array mappers subpassing on bound here will
3119 result on invalid variable accesses. */
3120 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
3121 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYA);
3122
3123 PKL_PASS_BREAK;
3124 }
3125
3126 /* In normal context, just subpass on the type of the elements,
3127 ignoring the number of elements. */
3128 PKL_PASS_SUBPASS (PKL_AST_TYPE_A_ETYPE (PKL_PASS_NODE));
3129 PKL_PASS_BREAK;
3130 }
3131 PKL_PHASE_END_HANDLER
3132
3133 /*
3134 * TYPE_STRING
3135 */
3136
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_type_string)3137 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_type_string)
3138 {
3139 /* Note that the check for in_writer should appear first than the
3140 check for in_mapper. */
3141
3142 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_WRITER))
3143 {
3144 /* Stack: IOS BOFF STR */
3145 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_POKES);
3146 }
3147 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER))
3148 {
3149 /* Stack: STRICT IOS BOFF */
3150 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEEKS);
3151 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP); /* Get rid of STRICT */
3152 }
3153 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_CONSTRUCTOR))
3154 {
3155 /* Stack: NULL */
3156 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
3157 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_string (""));
3158 }
3159 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_PRINTER))
3160 {
3161 /* Stack: VAL DEPTH */
3162 RAS_MACRO_STRING_PRINTER; /* _ */
3163 }
3164 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
3165 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYS);
3166 }
3167 PKL_PHASE_END_HANDLER
3168
3169 /*
3170 * TYPE_STRUCT
3171 * | (STRUCT_TYPE_FIELD|DECL)
3172 * | ...
3173 */
3174
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_type_struct)3175 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_type_struct)
3176 {
3177 /* Note that the check for in_writer should appear first than the
3178 check for in_mapper. */
3179
3180 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_WRITER))
3181 {
3182 /* Stack: IOS OFF SCT */
3183
3184 /* Note that we don't use the offset, nor the IOS, because these
3185 are attributes of the mapped value. */
3186 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_WRITE);
3187 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The struct. */
3188 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The offset. */
3189 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The IOS. */
3190 PKL_PASS_BREAK;
3191 }
3192 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER))
3193 {
3194 /* Stack: STRICT IOS OFF */
3195 pkl_ast_node type_struct = PKL_PASS_NODE;
3196
3197 pvm_val type_struct_mapper = PKL_AST_TYPE_S_MAPPER (type_struct);
3198 pvm_val type_struct_writer = PKL_AST_TYPE_S_WRITER (type_struct);
3199
3200 /* Make a copy of the IOS and STRICT. We will need to install
3201 them in the resulting value later. */
3202
3203 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR); /* STRICT IOS [OFF] */
3204 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OVER);
3205 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OVER);
3206 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR); /* STRICT IOS STRICT IOS OFF */
3207
3208 if (type_struct_mapper != PVM_NULL)
3209 {
3210 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3211 type_struct_mapper);
3212 }
3213 else
3214 {
3215 /* Compile a mapper function and complete it using the
3216 current environment. */
3217 pvm_val mapper_closure;
3218
3219 RAS_FUNCTION_STRUCT_MAPPER (mapper_closure, type_struct);
3220 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, mapper_closure);
3221 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
3222 } /* ... STRICT IOS OFF CLS */
3223
3224 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR); /* ... STRICT IOS OFF [CLS] */
3225 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ATR); /* ... STRICT IOS OFF CLS [CLS] */
3226 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NROT); /* ... STRICT CLS IOS OFF [CLS] */
3227 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR); /* ... STRICT CLS IOS [CLS OFF] */
3228 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR); /* ... STRICT CLS [CLS OFF IOS] */
3229 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* ... CLS STRICT [CLS OFF IOS] */
3230 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR); /* ... CLS STRICT IOS [CLS OFF] */
3231 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR); /* ... CLS STRICT IOS OFF [CLS] */
3232
3233 /* Build the arguments and call the mapper to get a struct
3234 value. For structs, both EBOUND and SBOUND are always
3235 null. */
3236 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
3237 /* ... CLS STRICT IOS OFF EBOUND [CLS] */
3238 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
3239 /* ... CLS STRICT IOS OFF EBOUND SBOUND [CLS] */
3240 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR);
3241 /* ... CLS STRICT IOS OFF EBOUND SBOUND CLS */
3242 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL);
3243 /* STRICT IOS CLS VAL */
3244
3245 /* Install the mapper into the value. */
3246 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* STRICT IOS VAL CLS */
3247 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETM); /* STRICT IOS VAL */
3248
3249 /* Install the ios into the value. */
3250 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* STRICT VAL IOS */
3251 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETIOS); /* STRICT VAL */
3252
3253 /* Install the strictness property into the value. */
3254 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP); /* VAL STRICT */
3255 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETS); /* VAL */
3256
3257 if (type_struct_writer != PVM_NULL)
3258 {
3259 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3260 type_struct_writer); /* VAL CLS */
3261 }
3262 else
3263 {
3264 /* Compile a writer function and complete it using the
3265 current environment. */
3266 pvm_val writer_closure;
3267
3268 PKL_GEN_DUP_CONTEXT;
3269 PKL_GEN_CLEAR_CONTEXT (PKL_GEN_CTX_IN_MAPPER);
3270 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
3271 RAS_FUNCTION_STRUCT_WRITER (writer_closure, type_struct);
3272 PKL_GEN_POP_CONTEXT;
3273
3274 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, writer_closure); /* VAL CLS */
3275 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* VAL CLS */
3276 }
3277
3278 /* Install the writer into the value. */
3279 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETW); /* VAL */
3280
3281 /* And we are done. */
3282 PKL_PASS_BREAK;
3283 }
3284 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_CONSTRUCTOR))
3285 {
3286 /* Stack: SCT */
3287 pkl_ast_node type_struct = PKL_PASS_NODE;
3288 pvm_val type_struct_constructor = PKL_AST_TYPE_S_CONSTRUCTOR (type_struct);
3289 pvm_val type_struct_writer = PKL_AST_TYPE_S_WRITER (type_struct);
3290
3291 /* If the given structure is null, then create an empty AST
3292 struct of the right type. */
3293 {
3294 pvm_program_label label = pkl_asm_fresh_label (PKL_GEN_ASM);
3295 pkl_ast_node s = pkl_ast_make_struct (PKL_PASS_AST,
3296 0, NULL);
3297
3298 PKL_AST_TYPE (s) = ASTREF (type_struct);
3299
3300 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNN, label);
3301 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* The null */
3302 PKL_GEN_DUP_CONTEXT;
3303 PKL_GEN_CLEAR_CONTEXT (PKL_GEN_CTX_IN_CONSTRUCTOR);
3304 PKL_PASS_SUBPASS (s);
3305 PKL_GEN_POP_CONTEXT;
3306
3307 pkl_asm_label (PKL_GEN_ASM, label);
3308 s = ASTREF(s); pkl_ast_node_free (s);
3309 }
3310
3311 if (type_struct_constructor != PVM_NULL)
3312 {
3313 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3314 type_struct_constructor); /* SCT CLS */
3315 }
3316 else
3317 {
3318 /* Compile a constructor function and complete it using the
3319 current environment. */
3320 pvm_val constructor_closure;
3321
3322 RAS_FUNCTION_STRUCT_CONSTRUCTOR (constructor_closure, type_struct);
3323 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, constructor_closure);
3324 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* SCT CLS */
3325
3326 /* Since this is an anonymous struct, install the
3327 constructor in it. This is needed by other operations
3328 like sseti. */
3329 PKL_AST_TYPE_S_CONSTRUCTOR (type_struct) = constructor_closure;
3330 }
3331
3332 /* Call the constructor to get a new struct. */
3333 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* NSCT */
3334
3335 /* Install a writer in the constructed struct. This is needed
3336 when the value is used as the right-hand-side to a
3337 map-assignment operation. */
3338 if (type_struct_writer == PVM_NULL)
3339 {
3340 /* The struct type is anonymous and doesn't have a writer.
3341 Compile one in this environment. */
3342
3343 PKL_GEN_DUP_CONTEXT;
3344 PKL_GEN_SET_CONTEXT (PKL_GEN_CTX_IN_WRITER);
3345 RAS_FUNCTION_STRUCT_WRITER (type_struct_writer, type_struct);
3346 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, type_struct_writer); /* CLS */
3347 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC); /* CLS */
3348 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* _ */
3349 PKL_GEN_POP_CONTEXT;
3350
3351 PKL_AST_TYPE_S_WRITER (type_struct) = type_struct_writer;
3352 }
3353
3354 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3355 type_struct_writer); /* NCSCT CLS */
3356 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MSETW); /* NCSCT */
3357
3358 /* And we are done. */
3359 PKL_PASS_BREAK;
3360 }
3361 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_COMPARATOR))
3362 {
3363 /* Stack: SCT1 SCT2 */
3364
3365 pkl_ast_node type_struct = PKL_PASS_NODE;
3366 pvm_val comparator_closure
3367 = PKL_AST_TYPE_S_COMPARATOR (type_struct);
3368
3369 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OVER);
3370 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OVER);
3371
3372 if (comparator_closure == PVM_NULL)
3373 {
3374 /* Compile a comparator function and complete it using the
3375 current environment. */
3376 RAS_FUNCTION_STRUCT_COMPARATOR (comparator_closure, type_struct);
3377 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, comparator_closure);
3378 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
3379 }
3380 else
3381 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, comparator_closure);
3382
3383 /* Call the comparator. */
3384 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* SCT1 SCT2 INT */
3385 PKL_PASS_BREAK;
3386 }
3387 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_PRINTER))
3388 {
3389 /* Stack: SCT DEPTH */
3390
3391 pkl_ast_node struct_type = PKL_PASS_NODE;
3392 pvm_val printer_closure = PKL_AST_TYPE_S_PRINTER (struct_type);
3393
3394 /* If the struct type doesn't have a printer, compile one. */
3395 if (printer_closure == PVM_NULL)
3396 {
3397 RAS_FUNCTION_STRUCT_PRINTER (printer_closure, struct_type);
3398 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, printer_closure);
3399 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PEC);
3400 }
3401 else
3402 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, printer_closure);
3403
3404 /* Invoke the printer. */
3405 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_CALL); /* _ */
3406 PKL_PASS_BREAK;
3407 }
3408 else if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
3409 {
3410 /* Do nothing. See PS hook. */
3411 }
3412 else
3413 {
3414 /* In normal context, process the fields of the struct, but not
3415 the declarations contained within it. */
3416
3417 pkl_ast_node elem;
3418
3419 for (elem = PKL_AST_TYPE_S_ELEMS (PKL_PASS_NODE);
3420 elem;
3421 elem = PKL_AST_CHAIN (elem))
3422 {
3423 if (PKL_AST_CODE (elem) == PKL_AST_STRUCT_TYPE_FIELD)
3424 PKL_PASS_SUBPASS (elem);
3425 }
3426
3427 PKL_PASS_BREAK;
3428 }
3429 }
3430 PKL_PHASE_END_HANDLER
3431
3432 /*
3433 * | STRUCT_TYPE_FIELD
3434 * | ...
3435 * TYPE_STRUCT
3436 */
3437
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_type_struct)3438 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_type_struct)
3439 {
3440 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
3441 {
3442 /* We are generating a PVM struct type. */
3443
3444 pkl_ast_node struct_type = PKL_PASS_NODE;
3445 pkl_ast_node type_name = PKL_AST_TYPE_NAME (struct_type);
3446
3447 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3448 pvm_make_ulong (PKL_AST_TYPE_S_NFIELD (struct_type), 64));
3449 if (type_name)
3450 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3451 pvm_make_string (PKL_AST_IDENTIFIER_POINTER (type_name)));
3452 else
3453 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
3454
3455 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKTYSCT);
3456 }
3457 }
3458 PKL_PHASE_END_HANDLER
3459
3460 /*
3461 * STRUCT_TYPE_FIELD
3462 * | [STRUCT_TYPE_FIELD_NAME]
3463 * | STRUCT_TYPE_FIELD_TYPE
3464 */
3465
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_struct_type_field)3466 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_struct_type_field)
3467 {
3468 assert (!PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_MAPPER));
3469 assert (!PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_WRITER));
3470 assert (!PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_CONSTRUCTOR));
3471
3472 if (PKL_GEN_IN_CTX_P (PKL_GEN_CTX_IN_TYPE))
3473 {
3474 /* We are generating a PVM struct type. */
3475
3476 /* If the struct type element doesn't include a name, generate a
3477 null value as expected by the mktysct instruction. */
3478 if (!PKL_AST_STRUCT_TYPE_FIELD_NAME (PKL_PASS_NODE))
3479 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
3480 else
3481 PKL_PASS_SUBPASS (PKL_AST_STRUCT_TYPE_FIELD_NAME (PKL_PASS_NODE));
3482 PKL_PASS_SUBPASS (PKL_AST_STRUCT_TYPE_FIELD_TYPE (PKL_PASS_NODE));
3483
3484 PKL_PASS_BREAK;
3485 }
3486
3487 /* In normal context, subpass on the field type and ignore the
3488 name. */
3489 PKL_PASS_SUBPASS (PKL_AST_STRUCT_TYPE_FIELD_TYPE (PKL_PASS_NODE));
3490 PKL_PASS_BREAK;
3491 }
3492 PKL_PHASE_END_HANDLER
3493
3494 /*
3495 * Expression handlers.
3496 *
3497 * | OPERAND1
3498 * | [OPERAND2]
3499 * EXP
3500 */
3501
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_add)3502 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_add)
3503 {
3504 pkl_asm pasm = PKL_GEN_ASM;
3505 pkl_ast_node node = PKL_PASS_NODE;
3506 pkl_ast_node type = PKL_AST_TYPE (node);
3507
3508 switch (PKL_AST_TYPE_CODE (type))
3509 {
3510 case PKL_TYPE_INTEGRAL:
3511 pkl_asm_insn (pasm, PKL_INSN_ADD, type);
3512 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3513 break;
3514 case PKL_TYPE_STRING:
3515 pkl_asm_insn (pasm, PKL_INSN_SCONC);
3516 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3517 break;
3518 case PKL_TYPE_ARRAY:
3519 pkl_asm_insn (pasm, PKL_INSN_ACONC);
3520 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3521 break;
3522 case PKL_TYPE_OFFSET:
3523 {
3524 pkl_ast_node base_type = PKL_AST_TYPE_O_BASE_TYPE (type);
3525 pkl_ast_node unit = PKL_AST_TYPE_O_UNIT (type);
3526
3527 pkl_asm_insn (pasm, PKL_INSN_ADDO, base_type, unit);
3528 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3529 }
3530 break;
3531 default:
3532 assert (0);
3533 break;
3534 }
3535 }
3536 PKL_PHASE_END_HANDLER
3537
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_sub)3538 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_sub)
3539 {
3540 pkl_asm pasm = PKL_GEN_ASM;
3541 pkl_ast_node node = PKL_PASS_NODE;
3542 pkl_ast_node type = PKL_AST_TYPE (node);
3543
3544 switch (PKL_AST_TYPE_CODE (type))
3545 {
3546 case PKL_TYPE_INTEGRAL:
3547 pkl_asm_insn (pasm, PKL_INSN_SUB, type);
3548 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3549 break;
3550 case PKL_TYPE_OFFSET:
3551 {
3552 pkl_ast_node base_type = PKL_AST_TYPE_O_BASE_TYPE (type);
3553 pkl_ast_node unit = PKL_AST_TYPE_O_UNIT (type);
3554
3555 pkl_asm_insn (pasm, PKL_INSN_SUBO, base_type, unit);
3556 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3557 }
3558 break;
3559 default:
3560 assert (0);
3561 break;
3562 }
3563 }
3564 PKL_PHASE_END_HANDLER
3565
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_mul)3566 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_mul)
3567 {
3568 pkl_asm pasm = PKL_GEN_ASM;
3569 pkl_ast_node node = PKL_PASS_NODE;
3570 pkl_ast_node type = PKL_AST_TYPE (node);
3571
3572 switch (PKL_AST_TYPE_CODE (type))
3573 {
3574 case PKL_TYPE_INTEGRAL:
3575 pkl_asm_insn (pasm, PKL_INSN_MUL, type);
3576 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3577 break;
3578 case PKL_TYPE_OFFSET:
3579 {
3580 pkl_ast_node op1 = PKL_AST_EXP_OPERAND (node, 0);
3581 pkl_ast_node op2 = PKL_AST_EXP_OPERAND (node, 1);
3582 pkl_ast_node op1_type = PKL_AST_TYPE (op1);
3583 pkl_ast_node op2_type = PKL_AST_TYPE (op2);
3584 pkl_ast_node base_type;
3585
3586 if (PKL_AST_TYPE_CODE (op1_type) == PKL_TYPE_OFFSET)
3587 base_type = PKL_AST_TYPE_O_BASE_TYPE (op1_type);
3588 else
3589 {
3590 base_type = PKL_AST_TYPE_O_BASE_TYPE (op2_type);
3591 pkl_asm_insn (pasm, PKL_INSN_SWAP);
3592 }
3593
3594 pkl_asm_insn (pasm, PKL_INSN_MULO, base_type);
3595 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3596 }
3597 break;
3598 case PKL_TYPE_STRING:
3599 {
3600 pkl_ast_node op2 = PKL_AST_EXP_OPERAND (node, 1);
3601 pkl_ast_node op2_type = PKL_AST_TYPE (op2);
3602
3603 if (PKL_AST_TYPE_CODE (op2_type) == PKL_TYPE_STRING)
3604 pkl_asm_insn (pasm, PKL_INSN_SWAP);
3605
3606 pkl_asm_insn (pasm, PKL_INSN_MULS);
3607 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3608 }
3609 break;
3610 default:
3611 assert (0);
3612 break;
3613 }
3614 }
3615 PKL_PHASE_END_HANDLER
3616
3617 /*
3618 * | OP1
3619 * | OP2
3620 * DIV
3621 */
3622
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_div)3623 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_div)
3624 {
3625 pkl_ast_node node = PKL_PASS_NODE;
3626 pkl_asm pasm = PKL_GEN_ASM;
3627 pkl_ast_node type = PKL_AST_TYPE (node);
3628 pkl_ast_node op1 = PKL_AST_EXP_OPERAND (node, 0);
3629 pkl_ast_node op1_type = PKL_AST_TYPE (op1);
3630 int div_insn, offset_div_insn;
3631
3632 if (PKL_AST_EXP_CODE (node) == PKL_AST_OP_DIV)
3633 {
3634 div_insn = PKL_INSN_DIV;
3635 offset_div_insn = PKL_INSN_DIVO;
3636 }
3637 else
3638 {
3639 div_insn = PKL_INSN_CDIV;
3640 offset_div_insn = PKL_INSN_CDIVO;
3641 }
3642
3643 switch (PKL_AST_TYPE_CODE (type))
3644 {
3645 case PKL_TYPE_INTEGRAL:
3646 {
3647 if (PKL_AST_TYPE_CODE (op1_type) == PKL_TYPE_OFFSET)
3648 {
3649 /* This is O / O -> I */
3650 pkl_asm_insn (pasm, offset_div_insn,
3651 PKL_AST_TYPE_O_BASE_TYPE (op1_type));
3652 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3653 }
3654 else
3655 {
3656 /* This is I / I -> I */
3657 pkl_asm_insn (pasm, div_insn, type);
3658 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3659 }
3660 break;
3661 }
3662 case PKL_TYPE_OFFSET:
3663 {
3664 /* This is O / I -> O */
3665 pkl_ast_node op2 = PKL_AST_EXP_OPERAND (node, 1);
3666 pkl_ast_node op2_type = PKL_AST_TYPE (op2);
3667
3668 pkl_asm_insn (pasm, PKL_INSN_SWAP); /* OP2 OP1 */
3669 pkl_asm_insn (pasm, PKL_INSN_OGETM); /* OP2 OP1 OMAG1 */
3670 pkl_asm_insn (pasm, PKL_INSN_SWAP);
3671 pkl_asm_insn (pasm, PKL_INSN_OGETU);
3672 pkl_asm_insn (pasm, PKL_INSN_NIP); /* OP2 OMAG1 UNIT */
3673 pkl_asm_insn (pasm, PKL_INSN_NROT); /* UNIT OP2 OMAG1 */
3674 pkl_asm_insn (pasm, PKL_INSN_SWAP); /* UNIT OMAG1 OP2 */
3675 pkl_asm_insn (pasm, div_insn, op2_type);
3676 pkl_asm_insn (pasm, PKL_INSN_NIP2); /* UNIT (OMAG1/OP2) */
3677 pkl_asm_insn (pasm, PKL_INSN_SWAP);
3678 pkl_asm_insn (pasm, PKL_INSN_MKO);
3679 break;
3680 }
3681 default:
3682 assert (0);
3683 break;
3684 }
3685 }
3686 PKL_PHASE_END_HANDLER
3687
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_mod)3688 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_mod)
3689 {
3690 pkl_ast_node node = PKL_PASS_NODE;
3691
3692 pkl_asm pasm = PKL_GEN_ASM;
3693 pkl_ast_node type = PKL_AST_TYPE (node);
3694
3695 switch (PKL_AST_TYPE_CODE (type))
3696 {
3697 case PKL_TYPE_INTEGRAL:
3698 pkl_asm_insn (pasm, PKL_INSN_MOD, type);
3699 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3700 break;
3701 case PKL_TYPE_OFFSET:
3702 {
3703 pkl_ast_node base_type = PKL_AST_TYPE_O_BASE_TYPE (type);
3704 pkl_ast_node unit = PKL_AST_TYPE_O_UNIT (type);
3705
3706 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MODO, base_type, unit);
3707 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
3708 break;
3709 }
3710 default:
3711 assert (0);
3712 break;
3713 }
3714 }
3715 PKL_PHASE_END_HANDLER
3716
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_binexp)3717 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_binexp)
3718 {
3719 pkl_asm pasm = PKL_GEN_ASM;
3720
3721 pkl_ast_node node = PKL_PASS_NODE;
3722 pkl_ast_node type = PKL_AST_TYPE (node);
3723
3724 enum pkl_asm_insn insn;
3725
3726 if (PKL_AST_EXP_CODE (node) == PKL_AST_OP_POS)
3727 /* POS in both integers and offsets is basically a nop. */
3728 PKL_PASS_DONE;
3729
3730 switch (PKL_AST_EXP_CODE (node))
3731 {
3732 case PKL_AST_OP_BAND: insn = PKL_INSN_BAND; break;
3733 case PKL_AST_OP_BNOT: insn = PKL_INSN_BNOT; break;
3734 case PKL_AST_OP_NEG: insn = PKL_INSN_NEG; break;
3735 case PKL_AST_OP_IOR: insn = PKL_INSN_BOR; break;
3736 case PKL_AST_OP_XOR: insn = PKL_INSN_BXOR; break;
3737 case PKL_AST_OP_SL: insn = PKL_INSN_SL; break;
3738 case PKL_AST_OP_SR: insn = PKL_INSN_SR; break;
3739 case PKL_AST_OP_POW: insn = PKL_INSN_POW; break;
3740 default:
3741 assert (0);
3742 break;
3743 }
3744
3745 switch (PKL_AST_TYPE_CODE (type))
3746 {
3747 case PKL_TYPE_OFFSET:
3748 /* Fallthrough. */
3749 case PKL_TYPE_INTEGRAL:
3750 pkl_asm_insn (pasm, insn, type);
3751 pkl_asm_insn (pasm, PKL_INSN_NIP);
3752 if (insn != PKL_INSN_NEG
3753 && insn != PKL_INSN_BNOT)
3754 pkl_asm_insn (pasm, PKL_INSN_NIP);
3755 break;
3756 default:
3757 assert (0);
3758 break;
3759 }
3760 }
3761 PKL_PHASE_END_HANDLER
3762
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_op_and)3763 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_op_and)
3764 {
3765 pkl_ast_node op1 = PKL_AST_EXP_OPERAND (PKL_PASS_NODE, 0);
3766 pkl_ast_node op2 = PKL_AST_EXP_OPERAND (PKL_PASS_NODE, 1);
3767
3768 pvm_program_label label = pkl_asm_fresh_label (PKL_GEN_ASM);
3769
3770 PKL_PASS_SUBPASS (op1);
3771 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BZI, label);
3772 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
3773 PKL_PASS_SUBPASS (op2);
3774 pkl_asm_label (PKL_GEN_ASM, label);
3775
3776 /* Normalize the result to 0 or 1. */
3777 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NOT);
3778 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NOT);
3779 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
3780
3781 PKL_PASS_BREAK;
3782 }
3783 PKL_PHASE_END_HANDLER
3784
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_op_or)3785 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_op_or)
3786 {
3787 pkl_ast_node op1 = PKL_AST_EXP_OPERAND (PKL_PASS_NODE, 0);
3788 pkl_ast_node op2 = PKL_AST_EXP_OPERAND (PKL_PASS_NODE, 1);
3789
3790 pvm_program_label label = pkl_asm_fresh_label (PKL_GEN_ASM);
3791
3792 PKL_PASS_SUBPASS (op1);
3793 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNZI, label);
3794 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
3795 PKL_PASS_SUBPASS (op2);
3796 pkl_asm_label (PKL_GEN_ASM, label);
3797
3798 /* Normalize the result to 0 or 1. */
3799 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NOT);
3800 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NOT);
3801 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
3802
3803 PKL_PASS_BREAK;
3804 }
3805 PKL_PHASE_END_HANDLER
3806
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_not)3807 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_not)
3808 {
3809 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NOT);
3810 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
3811 }
3812 PKL_PHASE_END_HANDLER
3813
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_rela)3814 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_rela)
3815 {
3816 pkl_asm pasm = PKL_GEN_ASM;
3817 pkl_ast_node exp = PKL_PASS_NODE;
3818 int exp_code = PKL_AST_EXP_CODE (exp);
3819 pkl_ast_node op1 = PKL_AST_EXP_OPERAND (exp, 0);
3820 pkl_ast_node op1_type = PKL_AST_TYPE (op1);
3821
3822 enum pkl_asm_insn rela_insn;
3823
3824 switch (exp_code)
3825 {
3826 case PKL_AST_OP_EQ: rela_insn = PKL_INSN_EQ; break;
3827 case PKL_AST_OP_NE: rela_insn = PKL_INSN_NE; break;
3828 case PKL_AST_OP_LT: rela_insn = PKL_INSN_LT; break;
3829 case PKL_AST_OP_GT: rela_insn = PKL_INSN_GT; break;
3830 case PKL_AST_OP_LE: rela_insn = PKL_INSN_LE; break;
3831 case PKL_AST_OP_GE: rela_insn = PKL_INSN_GE; break;
3832 default:
3833 assert (0);
3834 break;
3835 }
3836
3837 switch (PKL_AST_TYPE_CODE (op1_type))
3838 {
3839 case PKL_TYPE_ARRAY:
3840 /* Fallthrough. */
3841 case PKL_TYPE_STRUCT:
3842 assert (exp_code == PKL_AST_OP_EQ
3843 || exp_code == PKL_AST_OP_NE);
3844 /* Fallthrough. */
3845 case PKL_TYPE_INTEGRAL:
3846 case PKL_TYPE_OFFSET:
3847 case PKL_TYPE_STRING:
3848 pkl_asm_insn (pasm, rela_insn, op1_type);
3849 pkl_asm_insn (pasm, PKL_INSN_NIP2);
3850 break;
3851 default:
3852 assert (0);
3853 break;
3854 }
3855 }
3856 PKL_PHASE_END_HANDLER
3857
3858 /*
3859 * | OPERAND1
3860 * EXP
3861 */
3862
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_attr)3863 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_attr)
3864 {
3865 pkl_ast_node exp = PKL_PASS_NODE;
3866 pkl_ast_node operand = PKL_AST_EXP_OPERAND (exp, 0);
3867 pkl_ast_node operand_type = PKL_AST_TYPE (operand);
3868 enum pkl_ast_attr attr = PKL_AST_EXP_ATTR (exp);
3869
3870 switch (attr)
3871 {
3872 case PKL_AST_ATTR_SIZE:
3873 /* If the value is an ANY, check the type is NOT a function
3874 value. */
3875 if (PKL_AST_TYPE_CODE (operand_type) == PKL_TYPE_ANY)
3876 {
3877 pvm_program_label label = pkl_asm_fresh_label (PKL_GEN_ASM);
3878
3879 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TYISC);
3880 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BZI, label);
3881
3882 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3883 pvm_make_exception (PVM_E_CONV, PVM_E_CONV_MSG,
3884 PVM_E_CONV_ESTATUS));
3885 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAISE);
3886
3887 pkl_asm_label (PKL_GEN_ASM, label);
3888 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
3889 }
3890 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SIZ);
3891 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3892 pvm_make_ulong (1, 64));
3893 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKO);
3894 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
3895 /* XXX up-unit to the highest possible power of 2. */
3896 break;
3897 case PKL_AST_ATTR_MAGNITUDE:
3898 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OGETM);
3899 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
3900 break;
3901 case PKL_AST_ATTR_UNIT:
3902 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_OGETU);
3903 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
3904 break;
3905 case PKL_AST_ATTR_SIGNED:
3906 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
3907 if (PKL_AST_TYPE_I_SIGNED_P (operand_type))
3908 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_int (1, 32));
3909 else
3910 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, pvm_make_int (0, 32));
3911 break;
3912 case PKL_AST_ATTR_LENGTH:
3913 switch (PKL_AST_TYPE_CODE (operand_type))
3914 {
3915 case PKL_TYPE_STRING:
3916 case PKL_TYPE_ARRAY:
3917 case PKL_TYPE_STRUCT:
3918 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SEL);
3919 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
3920 break;
3921 default:
3922 /* This should not happen. */
3923 assert (0);
3924 }
3925 break;
3926 case PKL_AST_ATTR_ALIGNMENT:
3927 /* XXX writeme */
3928 assert (0);
3929 break;
3930 case PKL_AST_ATTR_OFFSET:
3931 /* Fallthrough. */
3932 case PKL_AST_ATTR_IOS:
3933 switch (PKL_AST_TYPE_CODE (operand_type))
3934 {
3935 case PKL_TYPE_ANY:
3936 /* Fallthrough. */
3937 case PKL_TYPE_ARRAY:
3938 /* Fallthrough. */
3939 case PKL_TYPE_STRUCT:
3940 {
3941 pvm_program_label label = pkl_asm_fresh_label (PKL_GEN_ASM);
3942
3943 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MM); /* VAL MAPPED_P */
3944 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BNZI, label);
3945
3946 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3947 pvm_make_exception (PVM_E_MAP, PVM_E_MAP_MSG,
3948 PVM_E_MAP_ESTATUS));
3949 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAISE);
3950 pkl_asm_label (PKL_GEN_ASM, label);
3951
3952 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* VAL */
3953 if (attr == PKL_AST_ATTR_OFFSET)
3954 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MGETO);
3955 else
3956 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MGETIOS);
3957 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP); /* (BOFF|IOS) */
3958
3959 if (attr == PKL_AST_ATTR_OFFSET)
3960 {
3961 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3962 pvm_make_ulong (1, 64));
3963 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MKO);
3964 }
3965 break;
3966 }
3967 default:
3968 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3969 pvm_make_exception (PVM_E_MAP, PVM_E_MAP_MSG,
3970 PVM_E_MAP_ESTATUS));
3971 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_RAISE);
3972 break;
3973 }
3974 break;
3975 case PKL_AST_ATTR_MAPPED:
3976 switch (PKL_AST_TYPE_CODE (operand_type))
3977 {
3978 case PKL_TYPE_ANY:
3979 case PKL_TYPE_ARRAY:
3980 case PKL_TYPE_STRUCT:
3981 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MM);
3982 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
3983 break;
3984 default:
3985 /* Other types are never mapped. */
3986 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
3987 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
3988 pvm_make_int (0, 32));
3989 break;
3990 }
3991 break;
3992 case PKL_AST_ATTR_STRICT:
3993 switch (PKL_AST_TYPE_CODE (operand_type))
3994 {
3995 case PKL_TYPE_ANY:
3996 case PKL_TYPE_ARRAY:
3997 case PKL_TYPE_STRUCT:
3998 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_MGETS);
3999 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
4000 break;
4001 default:
4002 /* Other types are considered strict. */
4003 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);
4004 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
4005 pvm_make_int (1, 32));
4006 break;
4007 }
4008 break;
4009 default:
4010 PKL_ICE (PKL_AST_LOC (exp),
4011 "unhandled attribute expression code #%d in code generator",
4012 attr);
4013 PKL_PASS_ERROR;
4014 break;
4015 }
4016 }
4017 PKL_PHASE_END_HANDLER
4018
4019 /* | OPERAND1
4020 * | OPERAND2
4021 * EXP
4022 */
4023
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_bconc)4024 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_bconc)
4025 {
4026 pkl_ast_node exp = PKL_PASS_NODE;
4027 pkl_ast_node op1 = PKL_AST_EXP_OPERAND (exp, 0);
4028 pkl_ast_node op2 = PKL_AST_EXP_OPERAND (exp, 1);
4029
4030 pkl_ast_node op1_type = PKL_AST_TYPE (op1);
4031 pkl_ast_node op2_type = PKL_AST_TYPE (op2);
4032 pkl_ast_node exp_type = PKL_AST_TYPE (exp);
4033
4034 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BCONC,
4035 op1_type, op2_type, exp_type);
4036 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
4037 }
4038 PKL_PHASE_END_HANDLER
4039
4040 /*
4041 * | OPERAND1
4042 * EXP
4043 */
4044
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_unmap)4045 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_unmap)
4046 {
4047 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_UNMAP);
4048 }
4049 PKL_PHASE_END_HANDLER
4050
4051 /*
4052 * | OPERAND1
4053 * | OPERAND2
4054 * EXP
4055 */
4056
PKL_PHASE_BEGIN_HANDLER(pkl_gen_ps_op_in)4057 PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_op_in)
4058 {
4059 pkl_ast_node exp = PKL_PASS_NODE;
4060 // pkl_ast_node elem = PKL_AST_EXP_OPERAND (exp, 0);
4061 pkl_ast_node container = PKL_AST_EXP_OPERAND (exp, 1);
4062 pkl_ast_node container_type = PKL_AST_TYPE (container);
4063 // pkl_ast_node elem_type = PKL_AST_TYPE (elem);
4064
4065 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AIS, container_type);
4066 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2);
4067 }
4068 PKL_PHASE_END_HANDLER
4069
4070 /* The handler below generates and ICE if a given node isn't handled
4071 by the code generator. */
4072
PKL_PHASE_BEGIN_HANDLER(pkl_gen_noimpl)4073 PKL_PHASE_BEGIN_HANDLER (pkl_gen_noimpl)
4074 {
4075 pkl_ast_node node = PKL_PASS_NODE;
4076
4077 if (PKL_AST_CODE (node) == PKL_AST_EXP)
4078 {
4079 PKL_ICE (PKL_AST_LOC (node),
4080 "unhandled node #%" PRIu64 " with code %d opcode %d in code generator",
4081 PKL_AST_UID (node), PKL_AST_CODE (node), PKL_AST_EXP_CODE (node));
4082 }
4083 else if (PKL_AST_CODE (node) == PKL_AST_TYPE)
4084 {
4085 PKL_ICE (PKL_AST_LOC (node),
4086 "unhandled node #%" PRIu64 " with code %d typecode %d in code generator",
4087 PKL_AST_UID (node), PKL_AST_CODE (node), PKL_AST_TYPE_CODE (node));
4088 }
4089 else
4090 PKL_ICE (PKL_AST_LOC (node),
4091 "unhandled node #%" PRIu64 " with code %d in code generator",
4092 PKL_AST_UID (node), PKL_AST_CODE (node));
4093
4094 PKL_PASS_ERROR;
4095 }
4096 PKL_PHASE_END_HANDLER
4097
4098 /*
4099 * COND_EXP
4100 * | COND
4101 * | THENEXP
4102 * | ELSEEXP
4103 */
4104
PKL_PHASE_BEGIN_HANDLER(pkl_gen_pr_cond_exp)4105 PKL_PHASE_BEGIN_HANDLER (pkl_gen_pr_cond_exp)
4106 {
4107 pkl_ast_node cond_exp = PKL_PASS_NODE;
4108 pkl_ast_node cond = PKL_AST_COND_EXP_COND (cond_exp);
4109 pkl_ast_node thenexp = PKL_AST_COND_EXP_THENEXP (cond_exp);
4110 pkl_ast_node elseexp = PKL_AST_COND_EXP_ELSEEXP (cond_exp);
4111
4112 pvm_program_label label1 = pkl_asm_fresh_label (PKL_GEN_ASM);
4113 pvm_program_label label2 = pkl_asm_fresh_label (PKL_GEN_ASM);
4114
4115 PKL_PASS_SUBPASS (cond);
4116 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BZI, label1);
4117 PKL_PASS_SUBPASS (thenexp);
4118 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_BA, label2);
4119 pkl_asm_label (PKL_GEN_ASM, label1);
4120 PKL_PASS_SUBPASS (elseexp);
4121 pkl_asm_label (PKL_GEN_ASM, label2);
4122
4123 /* Get rid fo the condition expression. */
4124 pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
4125
4126 PKL_PASS_BREAK;
4127 }
4128 PKL_PHASE_END_HANDLER
4129
4130 struct pkl_phase pkl_phase_gen =
4131 {
4132 PKL_PHASE_PS_HANDLER (PKL_AST_SRC, pkl_gen_ps_src),
4133 PKL_PHASE_PR_HANDLER (PKL_AST_DECL, pkl_gen_pr_decl),
4134 PKL_PHASE_PS_HANDLER (PKL_AST_DECL, pkl_gen_ps_decl),
4135 PKL_PHASE_PS_HANDLER (PKL_AST_VAR, pkl_gen_ps_var),
4136 PKL_PHASE_PR_HANDLER (PKL_AST_LAMBDA, pkl_gen_pr_lambda),
4137 PKL_PHASE_PS_HANDLER (PKL_AST_LAMBDA, pkl_gen_ps_lambda),
4138 PKL_PHASE_PR_HANDLER (PKL_AST_COND_EXP, pkl_gen_pr_cond_exp),
4139 PKL_PHASE_PR_HANDLER (PKL_AST_COMP_STMT, pkl_gen_pr_comp_stmt),
4140 PKL_PHASE_PS_HANDLER (PKL_AST_COMP_STMT, pkl_gen_ps_comp_stmt),
4141 PKL_PHASE_PS_HANDLER (PKL_AST_NULL_STMT, pkl_gen_ps_null_stmt),
4142 PKL_PHASE_PR_HANDLER (PKL_AST_ASS_STMT, pkl_gen_pr_ass_stmt),
4143 PKL_PHASE_PR_HANDLER (PKL_AST_INCRDECR, pkl_gen_pr_incrdecr),
4144 PKL_PHASE_PR_HANDLER (PKL_AST_IF_STMT, pkl_gen_pr_if_stmt),
4145 PKL_PHASE_PS_HANDLER (PKL_AST_BREAK_STMT, pkl_gen_ps_break_stmt),
4146 PKL_PHASE_PS_HANDLER (PKL_AST_CONTINUE_STMT, pkl_gen_ps_continue_stmt),
4147 PKL_PHASE_PR_HANDLER (PKL_AST_LOOP_STMT, pkl_gen_pr_loop_stmt),
4148 PKL_PHASE_PR_HANDLER (PKL_AST_RETURN_STMT, pkl_gen_pr_return_stmt),
4149 PKL_PHASE_PS_HANDLER (PKL_AST_RETURN_STMT, pkl_gen_ps_return_stmt),
4150 PKL_PHASE_PS_HANDLER (PKL_AST_EXP_STMT, pkl_gen_ps_exp_stmt),
4151 PKL_PHASE_PR_HANDLER (PKL_AST_PRINT_STMT, pkl_gen_pr_print_stmt),
4152 PKL_PHASE_PS_HANDLER (PKL_AST_RAISE_STMT, pkl_gen_ps_raise_stmt),
4153 PKL_PHASE_PR_HANDLER (PKL_AST_TRY_CATCH_STMT, pkl_gen_pr_try_catch_stmt),
4154 PKL_PHASE_PR_HANDLER (PKL_AST_TRY_UNTIL_STMT, pkl_gen_pr_try_until_stmt),
4155 PKL_PHASE_PS_HANDLER (PKL_AST_FUNCALL_ARG, pkl_gen_ps_funcall_arg),
4156 PKL_PHASE_PR_HANDLER (PKL_AST_FUNCALL, pkl_gen_pr_funcall),
4157 PKL_PHASE_PR_HANDLER (PKL_AST_FUNC, pkl_gen_pr_func),
4158 PKL_PHASE_PS_HANDLER (PKL_AST_FUNC, pkl_gen_ps_func),
4159 PKL_PHASE_PR_HANDLER (PKL_AST_FUNC_ARG, pkl_gen_pr_func_arg),
4160 PKL_PHASE_PR_HANDLER (PKL_AST_FUNC_TYPE_ARG, pkl_gen_pr_func_type_arg),
4161 PKL_PHASE_PR_HANDLER (PKL_AST_PROGRAM, pkl_gen_pr_program),
4162 PKL_PHASE_PS_HANDLER (PKL_AST_PROGRAM, pkl_gen_ps_program),
4163 PKL_PHASE_PS_HANDLER (PKL_AST_INTEGER, pkl_gen_ps_integer),
4164 PKL_PHASE_PS_HANDLER (PKL_AST_IDENTIFIER, pkl_gen_ps_identifier),
4165 PKL_PHASE_PS_HANDLER (PKL_AST_STRING, pkl_gen_ps_string),
4166 PKL_PHASE_PS_HANDLER (PKL_AST_OFFSET, pkl_gen_ps_offset),
4167 PKL_PHASE_PR_HANDLER (PKL_AST_CAST, pkl_gen_pr_cast),
4168 PKL_PHASE_PS_HANDLER (PKL_AST_ISA, pkl_gen_ps_isa),
4169 PKL_PHASE_PR_HANDLER (PKL_AST_MAP, pkl_gen_pr_map),
4170 PKL_PHASE_PS_HANDLER (PKL_AST_CONS, pkl_gen_ps_cons),
4171 PKL_PHASE_PR_HANDLER (PKL_AST_ARRAY, pkl_gen_pr_array),
4172 PKL_PHASE_PS_HANDLER (PKL_AST_ARRAY, pkl_gen_ps_array),
4173 PKL_PHASE_PR_HANDLER (PKL_AST_TRIMMER, pkl_gen_pr_trimmer),
4174 PKL_PHASE_PR_HANDLER (PKL_AST_INDEXER, pkl_gen_pr_indexer),
4175 PKL_PHASE_PR_HANDLER (PKL_AST_ARRAY_INITIALIZER, pkl_gen_pr_array_initializer),
4176 PKL_PHASE_PS_HANDLER (PKL_AST_ARRAY_INITIALIZER, pkl_gen_ps_array_initializer),
4177 PKL_PHASE_PR_HANDLER (PKL_AST_STRUCT, pkl_gen_pr_struct),
4178 PKL_PHASE_PS_HANDLER (PKL_AST_STRUCT, pkl_gen_ps_struct),
4179 PKL_PHASE_PR_HANDLER (PKL_AST_STRUCT_FIELD, pkl_gen_pr_struct_field),
4180 PKL_PHASE_PS_HANDLER (PKL_AST_STRUCT_REF, pkl_gen_ps_struct_ref),
4181 PKL_PHASE_PR_HANDLER (PKL_AST_STRUCT_TYPE_FIELD, pkl_gen_pr_struct_type_field),
4182 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_ADD, pkl_gen_ps_op_add),
4183 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_SUB, pkl_gen_ps_op_sub),
4184 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_MUL, pkl_gen_ps_op_mul),
4185 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_MOD, pkl_gen_ps_op_mod),
4186 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_BAND, pkl_gen_ps_op_binexp),
4187 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_BNOT, pkl_gen_ps_op_binexp),
4188 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_NEG, pkl_gen_ps_op_binexp),
4189 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_POS, pkl_gen_ps_op_binexp),
4190 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_IOR, pkl_gen_ps_op_binexp),
4191 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_XOR, pkl_gen_ps_op_binexp),
4192 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_SL, pkl_gen_ps_op_binexp),
4193 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_SR, pkl_gen_ps_op_binexp),
4194 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_DIV, pkl_gen_ps_op_div),
4195 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_CEILDIV, pkl_gen_ps_op_div),
4196 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_POW, pkl_gen_ps_op_binexp),
4197 PKL_PHASE_PR_OP_HANDLER (PKL_AST_OP_AND, pkl_gen_pr_op_and),
4198 PKL_PHASE_PR_OP_HANDLER (PKL_AST_OP_OR, pkl_gen_pr_op_or),
4199 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_NOT, pkl_gen_ps_op_not),
4200 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_EQ, pkl_gen_ps_op_rela),
4201 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_NE, pkl_gen_ps_op_rela),
4202 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_LT, pkl_gen_ps_op_rela),
4203 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_LE, pkl_gen_ps_op_rela),
4204 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_GT, pkl_gen_ps_op_rela),
4205 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_GE, pkl_gen_ps_op_rela),
4206 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_ATTR, pkl_gen_ps_op_attr),
4207 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_BCONC, pkl_gen_ps_op_bconc),
4208 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_UNMAP, pkl_gen_ps_op_unmap),
4209 PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_IN, pkl_gen_ps_op_in),
4210 PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_VOID, pkl_gen_ps_type_void),
4211 PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_ANY, pkl_gen_ps_type_any),
4212 PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_INTEGRAL, pkl_gen_ps_type_integral),
4213 PKL_PHASE_PR_TYPE_HANDLER (PKL_TYPE_OFFSET, pkl_gen_pr_type_offset),
4214 PKL_PHASE_PR_TYPE_HANDLER (PKL_TYPE_FUNCTION, pkl_gen_pr_type_function),
4215 PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_FUNCTION, pkl_gen_ps_type_function),
4216 PKL_PHASE_PR_TYPE_HANDLER (PKL_TYPE_ARRAY, pkl_gen_pr_type_array),
4217 PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_STRING, pkl_gen_ps_type_string),
4218 PKL_PHASE_PR_TYPE_HANDLER (PKL_TYPE_STRUCT, pkl_gen_pr_type_struct),
4219 PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_STRUCT, pkl_gen_ps_type_struct),
4220 PKL_PHASE_ELSE_HANDLER (pkl_gen_noimpl),
4221 };
4222