1 %{
2 /*
3 * imcc.y
4 *
5 * Intermediate Code Compiler for Parrot.
6 *
7 * Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
8 * Copyright (C) 2002-2014, Parrot Foundation.
9 *
10 * Grammar of the PIR language parser.
11 *
12 *
13 */
14
15 /*
16
17 =pod
18
19 =head1 NAME
20
21 compilers/imcc/imcc.y - Intermediate Code Compiler for Parrot.
22
23 =head1 DESCRIPTION
24
25 This file contains the grammar of the PIR language parser.
26
27 =cut
28
29 */
30
31 #include <string.h>
32 #include <stdio.h>
33 #include <stdlib.h>
34
35 #define _PARSER
36 #define PARSER_MAIN
37 #include "imc.h"
38 #include "parrot/dynext.h"
39 #include "pmc/pmc_callcontext.h"
40 #include "pbc.h"
41 #include "parser.h"
42 #include "optimizer.h"
43 #include "instructions.h"
44 #include "symreg.h"
45
46 /* prevent declarations of malloc() and free() in the generated parser. */
47 #define YYMALLOC
48 #define YYFREE(Ptr) do { /* empty */; } while (0)
49
50 #ifndef YYENABLE_NLS
51 # define YYENABLE_NLS 0
52 #endif
53
54 #ifndef YYLTYPE_IS_TRIVIAL
55 # define YYLTYPE_IS_TRIVIAL 0
56 #endif
57
58 /* HEADERIZER HFILE: compilers/imcc/imc.h */
59
60 /* HEADERIZER BEGIN: static */
61 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
62
63 static void add_pcc_named_arg(
64 ARGMOD(imc_info_t *imcc),
65 ARGMOD(SymReg *cur_call),
66 ARGMOD(SymReg *name),
67 ARGMOD(SymReg *value))
68 __attribute__nonnull__(1)
69 __attribute__nonnull__(2)
70 __attribute__nonnull__(3)
71 __attribute__nonnull__(4)
72 FUNC_MODIFIES(*imcc)
73 FUNC_MODIFIES(*cur_call)
74 FUNC_MODIFIES(*name)
75 FUNC_MODIFIES(*value);
76
77 static void add_pcc_named_arg_var(
78 ARGMOD(imc_info_t *imcc),
79 ARGMOD(SymReg *cur_call),
80 ARGMOD(SymReg *name),
81 ARGMOD(SymReg *value))
82 __attribute__nonnull__(1)
83 __attribute__nonnull__(2)
84 __attribute__nonnull__(3)
85 __attribute__nonnull__(4)
86 FUNC_MODIFIES(*imcc)
87 FUNC_MODIFIES(*cur_call)
88 FUNC_MODIFIES(*name)
89 FUNC_MODIFIES(*value);
90
91 static void add_pcc_named_param(
92 ARGMOD(imc_info_t *imcc),
93 ARGMOD(SymReg *cur_call),
94 ARGMOD(SymReg *name),
95 ARGMOD(SymReg *value))
96 __attribute__nonnull__(1)
97 __attribute__nonnull__(2)
98 __attribute__nonnull__(3)
99 __attribute__nonnull__(4)
100 FUNC_MODIFIES(*imcc)
101 FUNC_MODIFIES(*cur_call)
102 FUNC_MODIFIES(*name)
103 FUNC_MODIFIES(*value);
104
105 static void add_pcc_named_result(
106 ARGMOD(imc_info_t *imcc),
107 ARGMOD(SymReg *cur_call),
108 ARGMOD(SymReg *name),
109 ARGMOD(SymReg *value))
110 __attribute__nonnull__(1)
111 __attribute__nonnull__(2)
112 __attribute__nonnull__(3)
113 __attribute__nonnull__(4)
114 FUNC_MODIFIES(*imcc)
115 FUNC_MODIFIES(*cur_call)
116 FUNC_MODIFIES(*name)
117 FUNC_MODIFIES(*value);
118
119 static void add_pcc_named_return(
120 ARGMOD(imc_info_t *imcc),
121 ARGMOD(SymReg *cur_call),
122 ARGMOD(SymReg *name),
123 ARGMOD(SymReg *value))
124 __attribute__nonnull__(1)
125 __attribute__nonnull__(2)
126 __attribute__nonnull__(3)
127 __attribute__nonnull__(4)
128 FUNC_MODIFIES(*imcc)
129 FUNC_MODIFIES(*cur_call)
130 FUNC_MODIFIES(*name)
131 FUNC_MODIFIES(*value);
132
133 static void adv_named_set(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
134 __attribute__nonnull__(1)
135 __attribute__nonnull__(2)
136 FUNC_MODIFIES(*imcc);
137
138 static void adv_named_set_u(
139 ARGMOD(imc_info_t *imcc),
140 ARGIN(const char *name))
141 __attribute__nonnull__(1)
142 __attribute__nonnull__(2)
143 FUNC_MODIFIES(*imcc);
144
145 static void begin_return_or_yield(ARGMOD(imc_info_t *imcc), int yield)
146 __attribute__nonnull__(1)
147 FUNC_MODIFIES(*imcc);
148
149 static void clear_state(ARGMOD(imc_info_t *imcc))
150 __attribute__nonnull__(1)
151 FUNC_MODIFIES(*imcc);
152
153 static void do_loadlib(ARGMOD(imc_info_t *imcc), ARGIN(const char *lib))
154 __attribute__nonnull__(1)
155 __attribute__nonnull__(2)
156 FUNC_MODIFIES(*imcc);
157
158 PARROT_WARN_UNUSED_RESULT
159 PARROT_CAN_RETURN_NULL
160 static Instruction* func_ins(
161 ARGMOD(imc_info_t *imcc),
162 ARGMOD(IMC_Unit *unit),
163 ARGIN(SymReg *lhs),
164 ARGIN(const char *op),
165 ARGMOD(SymReg **r),
166 int n,
167 int keyv,
168 int emit)
169 __attribute__nonnull__(1)
170 __attribute__nonnull__(2)
171 __attribute__nonnull__(3)
172 __attribute__nonnull__(4)
173 __attribute__nonnull__(5)
174 FUNC_MODIFIES(*imcc)
175 FUNC_MODIFIES(*unit)
176 FUNC_MODIFIES(*r);
177
178 PARROT_WARN_UNUSED_RESULT
179 PARROT_CAN_RETURN_NULL
180 static Instruction * iINDEXFETCH(
181 ARGMOD(imc_info_t *imcc),
182 ARGMOD(IMC_Unit *unit),
183 ARGIN(SymReg *r0),
184 ARGIN(SymReg *r1),
185 ARGIN(SymReg *r2))
186 __attribute__nonnull__(1)
187 __attribute__nonnull__(2)
188 __attribute__nonnull__(3)
189 __attribute__nonnull__(4)
190 __attribute__nonnull__(5)
191 FUNC_MODIFIES(*imcc)
192 FUNC_MODIFIES(*unit);
193
194 PARROT_WARN_UNUSED_RESULT
195 PARROT_CAN_RETURN_NULL
196 static Instruction * iINDEXSET(
197 ARGMOD(imc_info_t *imcc),
198 ARGMOD(IMC_Unit *unit),
199 ARGIN(SymReg *r0),
200 ARGIN(SymReg *r1),
201 ARGIN(SymReg *r2))
202 __attribute__nonnull__(1)
203 __attribute__nonnull__(2)
204 __attribute__nonnull__(3)
205 __attribute__nonnull__(4)
206 __attribute__nonnull__(5)
207 FUNC_MODIFIES(*imcc)
208 FUNC_MODIFIES(*unit);
209
210 PARROT_WARN_UNUSED_RESULT
211 PARROT_CANNOT_RETURN_NULL
212 static Instruction * iLABEL(
213 ARGMOD(imc_info_t *imcc),
214 ARGMOD_NULLOK(IMC_Unit *unit),
215 ARGMOD(SymReg *r0))
216 __attribute__nonnull__(1)
217 __attribute__nonnull__(3)
218 FUNC_MODIFIES(*imcc)
219 FUNC_MODIFIES(*unit)
220 FUNC_MODIFIES(*r0);
221
222 PARROT_WARN_UNUSED_RESULT
223 PARROT_CAN_RETURN_NULL
224 static const char * inv_op(ARGIN(const char *op))
225 __attribute__nonnull__(1);
226
227 PARROT_IGNORABLE_RESULT
228 PARROT_CANNOT_RETURN_NULL
229 static Instruction * iSUBROUTINE(
230 ARGMOD(imc_info_t *imcc),
231 ARGMOD_NULLOK(IMC_Unit *unit),
232 ARGMOD(SymReg *r))
233 __attribute__nonnull__(1)
234 __attribute__nonnull__(3)
235 FUNC_MODIFIES(*imcc)
236 FUNC_MODIFIES(*unit)
237 FUNC_MODIFIES(*r);
238
239 PARROT_IGNORABLE_RESULT
240 PARROT_CAN_RETURN_NULL
241 static Instruction * MK_I(
242 ARGMOD(imc_info_t *imcc),
243 ARGMOD(IMC_Unit *unit),
244 ARGIN(const char *fmt),
245 int n,
246 ...)
247 __attribute__nonnull__(1)
248 __attribute__nonnull__(2)
249 __attribute__nonnull__(3)
250 FUNC_MODIFIES(*imcc)
251 FUNC_MODIFIES(*unit);
252
253 PARROT_WARN_UNUSED_RESULT
254 PARROT_CAN_RETURN_NULL
255 static Instruction* mk_pmc_const_named(
256 ARGMOD(imc_info_t *imcc),
257 ARGMOD(IMC_Unit *unit),
258 ARGIN(const char *name),
259 ARGMOD(SymReg *left),
260 ARGIN(const char *constant))
261 __attribute__nonnull__(1)
262 __attribute__nonnull__(2)
263 __attribute__nonnull__(3)
264 __attribute__nonnull__(4)
265 __attribute__nonnull__(5)
266 FUNC_MODIFIES(*imcc)
267 FUNC_MODIFIES(*unit)
268 FUNC_MODIFIES(*left);
269
270 PARROT_WARN_UNUSED_RESULT
271 PARROT_CANNOT_RETURN_NULL
272 static SymReg * mk_sub_address_fromc(
273 ARGMOD(imc_info_t *imcc),
274 ARGIN(const char *name))
275 __attribute__nonnull__(1)
276 __attribute__nonnull__(2)
277 FUNC_MODIFIES(*imcc);
278
279 PARROT_WARN_UNUSED_RESULT
280 PARROT_CANNOT_RETURN_NULL
281 static SymReg * mk_sub_address_u(
282 ARGMOD(imc_info_t *imcc),
283 ARGIN(const char *name))
284 __attribute__nonnull__(1)
285 __attribute__nonnull__(2)
286 FUNC_MODIFIES(*imcc);
287
288 static void set_lexical(
289 ARGMOD(imc_info_t *imcc),
290 ARGMOD(SymReg *r),
291 ARGMOD(SymReg *name))
292 __attribute__nonnull__(1)
293 __attribute__nonnull__(2)
294 __attribute__nonnull__(3)
295 FUNC_MODIFIES(*imcc)
296 FUNC_MODIFIES(*r)
297 FUNC_MODIFIES(*name);
298
299 #define ASSERT_ARGS_add_pcc_named_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
300 PARROT_ASSERT_ARG(imcc) \
301 , PARROT_ASSERT_ARG(cur_call) \
302 , PARROT_ASSERT_ARG(name) \
303 , PARROT_ASSERT_ARG(value))
304 #define ASSERT_ARGS_add_pcc_named_arg_var __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
305 PARROT_ASSERT_ARG(imcc) \
306 , PARROT_ASSERT_ARG(cur_call) \
307 , PARROT_ASSERT_ARG(name) \
308 , PARROT_ASSERT_ARG(value))
309 #define ASSERT_ARGS_add_pcc_named_param __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
310 PARROT_ASSERT_ARG(imcc) \
311 , PARROT_ASSERT_ARG(cur_call) \
312 , PARROT_ASSERT_ARG(name) \
313 , PARROT_ASSERT_ARG(value))
314 #define ASSERT_ARGS_add_pcc_named_result __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
315 PARROT_ASSERT_ARG(imcc) \
316 , PARROT_ASSERT_ARG(cur_call) \
317 , PARROT_ASSERT_ARG(name) \
318 , PARROT_ASSERT_ARG(value))
319 #define ASSERT_ARGS_add_pcc_named_return __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
320 PARROT_ASSERT_ARG(imcc) \
321 , PARROT_ASSERT_ARG(cur_call) \
322 , PARROT_ASSERT_ARG(name) \
323 , PARROT_ASSERT_ARG(value))
324 #define ASSERT_ARGS_adv_named_set __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
325 PARROT_ASSERT_ARG(imcc) \
326 , PARROT_ASSERT_ARG(name))
327 #define ASSERT_ARGS_adv_named_set_u __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
328 PARROT_ASSERT_ARG(imcc) \
329 , PARROT_ASSERT_ARG(name))
330 #define ASSERT_ARGS_begin_return_or_yield __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
331 PARROT_ASSERT_ARG(imcc))
332 #define ASSERT_ARGS_clear_state __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
333 PARROT_ASSERT_ARG(imcc))
334 #define ASSERT_ARGS_do_loadlib __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
335 PARROT_ASSERT_ARG(imcc) \
336 , PARROT_ASSERT_ARG(lib))
337 #define ASSERT_ARGS_func_ins __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
338 PARROT_ASSERT_ARG(imcc) \
339 , PARROT_ASSERT_ARG(unit) \
340 , PARROT_ASSERT_ARG(lhs) \
341 , PARROT_ASSERT_ARG(op) \
342 , PARROT_ASSERT_ARG(r))
343 #define ASSERT_ARGS_iINDEXFETCH __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
344 PARROT_ASSERT_ARG(imcc) \
345 , PARROT_ASSERT_ARG(unit) \
346 , PARROT_ASSERT_ARG(r0) \
347 , PARROT_ASSERT_ARG(r1) \
348 , PARROT_ASSERT_ARG(r2))
349 #define ASSERT_ARGS_iINDEXSET __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
350 PARROT_ASSERT_ARG(imcc) \
351 , PARROT_ASSERT_ARG(unit) \
352 , PARROT_ASSERT_ARG(r0) \
353 , PARROT_ASSERT_ARG(r1) \
354 , PARROT_ASSERT_ARG(r2))
355 #define ASSERT_ARGS_iLABEL __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
356 PARROT_ASSERT_ARG(imcc) \
357 , PARROT_ASSERT_ARG(r0))
358 #define ASSERT_ARGS_inv_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
359 PARROT_ASSERT_ARG(op))
360 #define ASSERT_ARGS_iSUBROUTINE __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
361 PARROT_ASSERT_ARG(imcc) \
362 , PARROT_ASSERT_ARG(r))
363 #define ASSERT_ARGS_MK_I __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
364 PARROT_ASSERT_ARG(imcc) \
365 , PARROT_ASSERT_ARG(unit) \
366 , PARROT_ASSERT_ARG(fmt))
367 #define ASSERT_ARGS_mk_pmc_const_named __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
368 PARROT_ASSERT_ARG(imcc) \
369 , PARROT_ASSERT_ARG(unit) \
370 , PARROT_ASSERT_ARG(name) \
371 , PARROT_ASSERT_ARG(left) \
372 , PARROT_ASSERT_ARG(constant))
373 #define ASSERT_ARGS_mk_sub_address_fromc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
374 PARROT_ASSERT_ARG(imcc) \
375 , PARROT_ASSERT_ARG(name))
376 #define ASSERT_ARGS_mk_sub_address_u __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
377 PARROT_ASSERT_ARG(imcc) \
378 , PARROT_ASSERT_ARG(name))
379 #define ASSERT_ARGS_set_lexical __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
380 PARROT_ASSERT_ARG(imcc) \
381 , PARROT_ASSERT_ARG(r) \
382 , PARROT_ASSERT_ARG(name))
383 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
384 /* HEADERIZER END: static */
385
386 #undef YYDEBUG
387 #define YYDEBUG 1
388 #define YYERROR_VERBOSE 1
389
390 /* Warning: parser is probably not reentrant */
391
392 /*
393 * Choosing instructions for Parrot is pretty easy since many are
394 * polymorphic.
395 */
396
397
398 /*
399
400 =over 4
401
402 =item C<static Instruction * MK_I(imc_info_t *imcc, IMC_Unit *unit, const char
403 *fmt, int n, ...)>
404
405 build and emitb instruction by INS. fmt may contain:
406
407 op %s, %s # comment
408
409 or just
410
411 op
412
413 NOTE: Most usage of this function is with
414 imcc->cur_unit, but there are some
415 exceptions. Thus, we can't easily factorize that piece of
416 code.
417
418 =cut
419
420 */
421
422 PARROT_IGNORABLE_RESULT
423 PARROT_CAN_RETURN_NULL
424 static Instruction *
MK_I(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGIN (const char * fmt),int n,...)425 MK_I(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(const char *fmt), int n, ...)
426 {
427 ASSERT_ARGS(MK_I)
428 char opname[64];
429 char *p;
430 const char *q;
431 va_list ap;
432 SymReg *r[IMCC_MAX_FIX_REGS];
433 int i;
434
435 for (p = opname, q = fmt; *q && *q != ' ';)
436 *p++ = *q++;
437 *p = '\0';
438 if (!*q)
439 fmt = NULL;
440 else
441 fmt = ++q;
442 #ifdef OPDEBUG
443 fprintf(stderr, "op '%s' format '%s' (%d)\n", opname, fmt?:"", n);
444 #endif
445 va_start(ap, n);
446 i = 0;
447 for (i = 0; i < n; ++i) {
448 r[i] = va_arg(ap, SymReg *);
449 }
450 va_end(ap);
451 return INS(imcc, unit, opname, fmt, r, n, imcc->keyvec, 1);
452 }
453
454 /*
455
456 =item C<static Instruction* mk_pmc_const_named(imc_info_t *imcc, IMC_Unit *unit,
457 const char *name, SymReg *left, const char *constant)>
458
459 =cut
460
461 */
462
463 PARROT_WARN_UNUSED_RESULT
464 PARROT_CAN_RETURN_NULL
465 static Instruction*
mk_pmc_const_named(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGIN (const char * name),ARGMOD (SymReg * left),ARGIN (const char * constant))466 mk_pmc_const_named(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit),
467 ARGIN(const char *name), ARGMOD(SymReg *left), ARGIN(const char *constant))
468 {
469 ASSERT_ARGS(mk_pmc_const_named)
470 SymReg *rhs;
471 SymReg *r[3];
472 char *const_name;
473 const int ascii = (*constant == '\'' || *constant == '"');
474 char *unquoted_name = mem_sys_strdup(name + 1);
475 size_t name_length = strlen(unquoted_name) - 1;
476
477 unquoted_name[name_length] = 0;
478
479 if (left->type == VTADDRESS) { /* IDENTIFIER */
480 if (imcc->state->pasm_file) {
481 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
482 "Ident as PMC constant",
483 " %s\n", left->name);
484 }
485 left->type = VTIDENTIFIER;
486 left->set = 'P';
487 }
488 r[0] = left;
489 if (ascii) {
490 /* strip delimiters */
491 const_name = mem_sys_strdup(constant + 1);
492 const_name[strlen(const_name) - 1] = 0;
493 }
494 else {
495 const_name = mem_sys_strdup(constant);
496 }
497
498 /* With an empty name here, like .const '' $Pxx = "constant"
499 can only be a Sub. name_length = 0 matches all */
500 if ((strncmp(unquoted_name, "Sub", name_length) == 0)
501 || (strncmp(unquoted_name, "Coroutine", name_length) == 0)) {
502 rhs = mk_const(imcc, const_name, 'p');
503 if (!ascii)
504 rhs->type |= VT_ENCODED;
505 rhs->usage |= U_FIXUP | U_SUBID_LOOKUP;
506 }
507 else if (strncmp(unquoted_name, "LexInfo", name_length) == 0) {
508 rhs = mk_const(imcc, const_name, 'l');
509 if (!ascii)
510 rhs->type |= VT_ENCODED;
511 rhs->usage |= U_FIXUP | U_LEXINFO_LOOKUP;
512 }
513 else {
514 rhs = mk_const(imcc, const_name, 'P');
515 }
516
517 r[1] = rhs;
518 rhs->pmc_type = Parrot_pmc_get_type_str(imcc->interp,
519 Parrot_str_new(imcc->interp, unquoted_name, name_length));
520
521 mem_sys_free(unquoted_name);
522 mem_sys_free(const_name);
523
524 return INS(imcc, unit, "set_p_pc", "", r, 2, 0, 1);
525 }
526
527 /*
528
529 =item C<static Instruction* func_ins(imc_info_t *imcc, IMC_Unit *unit, SymReg
530 *lhs, const char *op, SymReg **r, int n, int keyv, int emit)>
531
532 =cut
533
534 */
535
536 PARROT_WARN_UNUSED_RESULT
537 PARROT_CAN_RETURN_NULL
538 static Instruction*
func_ins(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGIN (SymReg * lhs),ARGIN (const char * op),ARGMOD (SymReg ** r),int n,int keyv,int emit)539 func_ins(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *lhs),
540 ARGIN(const char *op), ARGMOD(SymReg **r), int n, int keyv, int emit)
541 {
542 ASSERT_ARGS(func_ins)
543 int i;
544 /* shift regs up by 1 */
545 for (i = n - 1; i >= 0; --i)
546 r[i+1] = r[i];
547 r[0] = lhs;
548 /* shift keyvec */
549 keyv <<= 1;
550 return INS(imcc, unit, op, "", r, n+1, keyv, emit);
551 }
552
553 /*
554
555 =item C<static void clear_state(imc_info_t *imcc)>
556
557 =cut
558
559 */
560
561 static void
clear_state(ARGMOD (imc_info_t * imcc))562 clear_state(ARGMOD(imc_info_t *imcc))
563 {
564 ASSERT_ARGS(clear_state)
565 imcc -> nargs = 0;
566 imcc -> keyvec = 0;
567 }
568
569 /*
570
571 =item C<Instruction * INS_LABEL(imc_info_t *imcc, IMC_Unit *unit, SymReg *r0,
572 int emit)>
573
574 =cut
575
576 */
577
578 PARROT_WARN_UNUSED_RESULT
579 PARROT_CANNOT_RETURN_NULL
580 Instruction *
INS_LABEL(ARGMOD (imc_info_t * imcc),ARGMOD_NULLOK (IMC_Unit * unit),ARGMOD (SymReg * r0),int emit)581 INS_LABEL(ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit),
582 ARGMOD(SymReg *r0), int emit)
583 {
584 ASSERT_ARGS(INS_LABEL)
585
586 Instruction * const ins = _mk_instruction("", "%s:", 1, &r0, 0);
587 ins->type = ITLABEL;
588 r0->first_ins = ins;
589
590 if (emit)
591 emitb(imcc, unit, ins);
592
593 return ins;
594 }
595
596 /*
597
598 =item C<static Instruction * iLABEL(imc_info_t *imcc, IMC_Unit *unit, SymReg
599 *r0)>
600
601 =cut
602
603 */
604
605 PARROT_WARN_UNUSED_RESULT
606 PARROT_CANNOT_RETURN_NULL
607 static Instruction *
iLABEL(ARGMOD (imc_info_t * imcc),ARGMOD_NULLOK (IMC_Unit * unit),ARGMOD (SymReg * r0))608 iLABEL(ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit),
609 ARGMOD(SymReg *r0))
610 {
611 ASSERT_ARGS(iLABEL)
612 Instruction * const i = INS_LABEL(imcc, unit, r0, 1);
613 i->line = imcc->line;
614
615 clear_state(imcc);
616 return i;
617 }
618
619 /*
620
621 =item C<static Instruction * iSUBROUTINE(imc_info_t *imcc, IMC_Unit *unit,
622 SymReg *r)>
623
624 =cut
625
626 */
627
628 PARROT_IGNORABLE_RESULT
629 PARROT_CANNOT_RETURN_NULL
630 static Instruction *
iSUBROUTINE(ARGMOD (imc_info_t * imcc),ARGMOD_NULLOK (IMC_Unit * unit),ARGMOD (SymReg * r))631 iSUBROUTINE(ARGMOD(imc_info_t *imcc), ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r))
632 {
633 ASSERT_ARGS(iSUBROUTINE)
634 Instruction * const i = iLABEL(imcc, unit, r);
635 i->type |= ITPCCPARAM;
636
637 r->type = (r->type & VT_ENCODED) ? VT_PCC_SUB|VT_ENCODED : VT_PCC_SUB;
638 r->pcc_sub = mem_gc_allocate_zeroed_typed(imcc->interp, pcc_sub_t);
639
640 imcc->cur_call = r;
641 i->line = imcc->line;
642
643 add_namespace(imcc, unit);
644 return i;
645 }
646
647 /*
648
649 =item C<static Instruction * iINDEXFETCH(imc_info_t *imcc, IMC_Unit *unit,
650 SymReg *r0, SymReg *r1, SymReg *r2)>
651
652 substr or X = P[key]
653
654 =cut
655
656 */
657
658 PARROT_WARN_UNUSED_RESULT
659 PARROT_CAN_RETURN_NULL
660 static Instruction *
iINDEXFETCH(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGIN (SymReg * r0),ARGIN (SymReg * r1),ARGIN (SymReg * r2))661 iINDEXFETCH(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0),
662 ARGIN(SymReg *r1), ARGIN(SymReg *r2))
663 {
664 ASSERT_ARGS(iINDEXFETCH)
665 imcc -> keyvec |= KEY_BIT(2);
666 return MK_I(imcc, unit, "set %s, %s[%s]", 3, r0, r1, r2);
667 }
668
669 /*
670
671 =item C<static Instruction * iINDEXSET(imc_info_t *imcc, IMC_Unit *unit, SymReg
672 *r0, SymReg *r1, SymReg *r2)>
673
674 substr or P[key] = X
675
676 =cut
677
678 */
679
680 PARROT_WARN_UNUSED_RESULT
681 PARROT_CAN_RETURN_NULL
682 static Instruction *
iINDEXSET(ARGMOD (imc_info_t * imcc),ARGMOD (IMC_Unit * unit),ARGIN (SymReg * r0),ARGIN (SymReg * r1),ARGIN (SymReg * r2))683 iINDEXSET(ARGMOD(imc_info_t *imcc), ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0),
684 ARGIN(SymReg *r1), ARGIN(SymReg *r2))
685 {
686 ASSERT_ARGS(iINDEXSET)
687 if (r0->set == 'P') {
688 imcc->keyvec |= KEY_BIT(1);
689 MK_I(imcc, unit, "set %s[%s], %s", 3, r0, r1, r2);
690 }
691 else
692 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
693 "unsupported indexed set op\n");
694
695 return NULL;
696 }
697
698 /*
699
700 =item C<static const char * inv_op(const char *op)>
701
702 =cut
703
704 */
705
706 PARROT_WARN_UNUSED_RESULT
707 PARROT_CAN_RETURN_NULL
708 static const char *
inv_op(ARGIN (const char * op))709 inv_op(ARGIN(const char *op))
710 {
711 ASSERT_ARGS(inv_op)
712 int n;
713 return get_neg_op(op, &n);
714 }
715
716 /*
717
718 =item C<Instruction * IMCC_create_itcall_label(imc_info_t *imcc)>
719
720 =cut
721
722 */
723
724 PARROT_WARN_UNUSED_RESULT
725 PARROT_CANNOT_RETURN_NULL
726 Instruction *
IMCC_create_itcall_label(ARGMOD (imc_info_t * imcc))727 IMCC_create_itcall_label(ARGMOD(imc_info_t *imcc))
728 {
729 ASSERT_ARGS(IMCC_create_itcall_label)
730 char name[128];
731 SymReg *r;
732 Instruction *i;
733
734 snprintf(name, sizeof (name), "%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR,
735 imcc->cnr++);
736
737 r = mk_pcc_sub(imcc, name, 0);
738 i = iLABEL(imcc, imcc->cur_unit, r);
739 i->type = ITCALL | ITPCCSUB;
740
741 imcc->cur_call = r;
742
743 return i;
744 }
745
746 /*
747
748 =item C<static SymReg * mk_sub_address_fromc(imc_info_t *imcc, const char
749 *name)>
750
751 =cut
752
753 */
754
755 PARROT_WARN_UNUSED_RESULT
756 PARROT_CANNOT_RETURN_NULL
757 static SymReg *
mk_sub_address_fromc(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))758 mk_sub_address_fromc(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
759 {
760 ASSERT_ARGS(mk_sub_address_fromc)
761 /* name is a quoted sub name */
762 SymReg *r;
763 char *name_copy;
764
765 /* interpolate only if the first character is a double-quote */
766 if (*name == '"') {
767 STRING *unescaped = Parrot_str_unescape(imcc->interp, name, '"', NULL);
768 name_copy = Parrot_str_to_cstring(imcc->interp, unescaped);
769 }
770 else {
771 name_copy = mem_sys_strdup(name);
772 name_copy[strlen(name) - 1] = 0;
773 }
774
775 r = mk_sub_address(imcc, name_copy + 1);
776 mem_sys_free(name_copy);
777
778 return r;
779 }
780
781 /*
782
783 =item C<static SymReg * mk_sub_address_u(imc_info_t *imcc, const char *name)>
784
785 =cut
786
787 */
788
789 PARROT_WARN_UNUSED_RESULT
790 PARROT_CANNOT_RETURN_NULL
791 static SymReg *
mk_sub_address_u(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))792 mk_sub_address_u(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
793 {
794 ASSERT_ARGS(mk_sub_address_u)
795 SymReg * const r = mk_sub_address(imcc, name);
796 r->type |= VT_ENCODED;
797
798 return r;
799 }
800
801 /*
802
803 =item C<void IMCC_itcall_sub(imc_info_t *imcc, SymReg *sub)>
804
805 =cut
806
807 */
808
809 void
IMCC_itcall_sub(ARGMOD (imc_info_t * imcc),ARGIN (SymReg * sub))810 IMCC_itcall_sub(ARGMOD(imc_info_t *imcc), ARGIN(SymReg *sub))
811 {
812 ASSERT_ARGS(IMCC_itcall_sub)
813 imcc->cur_call->pcc_sub->sub = sub;
814
815 if (imcc->cur_obj) {
816 if (imcc->cur_obj->set != 'P')
817 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "object isn't a PMC");
818
819 imcc->cur_call->pcc_sub->object = imcc->cur_obj;
820 imcc->cur_obj = NULL;
821 }
822 }
823
824
825 /*
826
827 =item C<static void begin_return_or_yield(imc_info_t *imcc, int yield)>
828
829 =cut
830
831 */
832
833 static void
begin_return_or_yield(ARGMOD (imc_info_t * imcc),int yield)834 begin_return_or_yield(ARGMOD(imc_info_t *imcc), int yield)
835 {
836 ASSERT_ARGS(begin_return_or_yield)
837 Instruction *i;
838 Instruction * const ins = imcc->cur_unit->instructions;
839 char name[128];
840
841 if (!ins || !ins->symregs[0] || !(ins->symregs[0]->type & VT_PCC_SUB))
842 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
843 "yield or return directive outside pcc subroutine\n");
844 ins->symregs[0]->pcc_sub->yield = yield;
845 snprintf(name, sizeof (name), yield ? "%cpcc_sub_yield_%d" : "%cpcc_sub_ret_%d",
846 IMCC_INTERNAL_CHAR, imcc->cnr++);
847 imcc->sr_return = mk_pcc_sub(imcc, name, 0);
848 i = iLABEL(imcc, imcc->cur_unit, imcc->sr_return);
849 i->type = yield ? ITPCCSUB | ITLABEL | ITPCCYIELD : ITPCCSUB | ITLABEL ;
850 imcc->asm_state = yield ? AsmInYield : AsmInReturn;
851 }
852
853 /*
854
855 =item C<static void set_lexical(imc_info_t *imcc, SymReg *r, SymReg *name)>
856
857 =cut
858
859 */
860
861 static void
set_lexical(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * r),ARGMOD (SymReg * name))862 set_lexical(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *r), ARGMOD(SymReg *name))
863 {
864 ASSERT_ARGS(set_lexical)
865
866 r->usage |= U_LEXICAL;
867
868 IMCC_debug(imcc, DEBUG_MKCONST, "# .lex '%s'\n", name->name);
869 if (name == r->reg)
870 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
871 "register %s already declared as lexical %s", r->name, name->name);
872
873 /* chain all names in r->reg */
874 name->reg = r->reg;
875 r->reg = name;
876 name->usage |= U_LEXICAL;
877 r->use_count++;
878 }
879
880
881 /*
882
883 =item C<static void add_pcc_named_arg(imc_info_t *imcc, SymReg *cur_call, SymReg
884 *name, SymReg *value)>
885
886 =cut
887
888 */
889
890 static void
add_pcc_named_arg(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * cur_call),ARGMOD (SymReg * name),ARGMOD (SymReg * value))891 add_pcc_named_arg(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
892 ARGMOD(SymReg *name), ARGMOD(SymReg *value))
893 {
894 ASSERT_ARGS(add_pcc_named_arg)
895 name->type |= VT_NAMED;
896
897 add_pcc_arg(imcc, cur_call, name);
898 add_pcc_arg(imcc, cur_call, value);
899 }
900
901 /*
902
903 =item C<static void add_pcc_named_arg_var(imc_info_t *imcc, SymReg *cur_call,
904 SymReg *name, SymReg *value)>
905
906 =cut
907
908 */
909
910 static void
add_pcc_named_arg_var(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * cur_call),ARGMOD (SymReg * name),ARGMOD (SymReg * value))911 add_pcc_named_arg_var(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
912 ARGMOD(SymReg *name), ARGMOD(SymReg *value))
913 {
914 ASSERT_ARGS(add_pcc_named_arg_var)
915 name->type |= VT_NAMED;
916 add_pcc_arg(imcc, cur_call, name);
917 add_pcc_arg(imcc, cur_call, value);
918 }
919
920 /*
921
922 =item C<static void add_pcc_named_result(imc_info_t *imcc, SymReg *cur_call,
923 SymReg *name, SymReg *value)>
924
925 =cut
926
927 */
928
929 static void
add_pcc_named_result(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * cur_call),ARGMOD (SymReg * name),ARGMOD (SymReg * value))930 add_pcc_named_result(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
931 ARGMOD(SymReg *name), ARGMOD(SymReg *value))
932 {
933 ASSERT_ARGS(add_pcc_named_result)
934 name->type |= VT_NAMED;
935
936 add_pcc_result(imcc, cur_call, name);
937 add_pcc_result(imcc, cur_call, value);
938 }
939
940 /*
941
942 =item C<static void add_pcc_named_param(imc_info_t *imcc, SymReg *cur_call,
943 SymReg *name, SymReg *value)>
944
945 =cut
946
947 */
948
949 static void
add_pcc_named_param(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * cur_call),ARGMOD (SymReg * name),ARGMOD (SymReg * value))950 add_pcc_named_param(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
951 ARGMOD(SymReg *name), ARGMOD(SymReg *value))
952 {
953 ASSERT_ARGS(add_pcc_named_param)
954 name->type |= VT_NAMED;
955
956 add_pcc_arg(imcc, cur_call, name);
957 add_pcc_arg(imcc, cur_call, value);
958 }
959
960 /*
961
962 =item C<static void add_pcc_named_return(imc_info_t *imcc, SymReg *cur_call,
963 SymReg *name, SymReg *value)>
964
965 =cut
966
967 */
968
969 static void
add_pcc_named_return(ARGMOD (imc_info_t * imcc),ARGMOD (SymReg * cur_call),ARGMOD (SymReg * name),ARGMOD (SymReg * value))970 add_pcc_named_return(ARGMOD(imc_info_t *imcc), ARGMOD(SymReg *cur_call),
971 ARGMOD(SymReg *name), ARGMOD(SymReg *value))
972 {
973 ASSERT_ARGS(add_pcc_named_return)
974 name->type |= VT_NAMED;
975
976 add_pcc_result(imcc, cur_call, name);
977 add_pcc_result(imcc, cur_call, value);
978 }
979
980 /*
981
982 =item C<static void adv_named_set(imc_info_t *imcc, const char *name)>
983
984 =item C<static void adv_named_set_u(imc_info_t *imcc, const char *name)>
985
986 Sets the name of the current named argument.
987
988 C<adv_named_set_u> is the Unicode version of this function.
989
990 =cut
991
992 */
993
994 static void
adv_named_set(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))995 adv_named_set(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
996 {
997 ASSERT_ARGS(adv_named_set)
998 if (imcc->adv_named_id)
999 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
1000 "Named parameter with more than one name.\n");
1001
1002 imcc->adv_named_id = mk_const(imcc, name, 'S');
1003 }
1004
1005 static void
adv_named_set_u(ARGMOD (imc_info_t * imcc),ARGIN (const char * name))1006 adv_named_set_u(ARGMOD(imc_info_t *imcc), ARGIN(const char *name))
1007 {
1008 ASSERT_ARGS(adv_named_set_u)
1009 if (imcc->adv_named_id)
1010 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
1011 "Named parameter with more than one name.\n");
1012
1013 imcc->adv_named_id = mk_const(imcc, name, 'U');
1014 }
1015
1016 /*
1017
1018 =item C<static void do_loadlib(imc_info_t *imcc, const char *lib)>
1019
1020 =cut
1021
1022 */
1023
1024 static void
do_loadlib(ARGMOD (imc_info_t * imcc),ARGIN (const char * lib))1025 do_loadlib(ARGMOD(imc_info_t *imcc), ARGIN(const char *lib))
1026 {
1027 ASSERT_ARGS(do_loadlib)
1028 STRING * const s = Parrot_str_unescape(imcc->interp, lib + 1, '"', NULL);
1029 PMC * const lib_pmc = Parrot_dyn_load_lib(imcc->interp, s, NULL);
1030 if (PMC_IS_NULL(lib_pmc) || !VTABLE_get_bool(imcc->interp, lib_pmc)) {
1031 IMCC_fataly(imcc, EXCEPTION_LIBRARY_ERROR,
1032 "loadlib directive could not find library `%S'", s);
1033 }
1034
1035 /* store non-dynoplib library deps here, dynoplibs are treated separately for now */
1036 /* TODO: This is very ugly and heavily nested. Can we avoid this? */
1037 if (!STRING_equal(imcc->interp,
1038 VTABLE_get_string(imcc->interp,
1039 Parrot_pmc_getprop(imcc->interp, lib_pmc,
1040 Parrot_str_new_constant(imcc->interp, "_type"))),
1041 Parrot_str_new_constant(imcc->interp, "Ops")))
1042 imcc_pbc_add_libdep(imcc, s);
1043 }
1044
1045 /* HEADERIZER STOP */
1046
1047 %}
1048
1049 %union {
1050 IdList * idlist;
1051 int t;
1052 char * s;
1053 SymReg * sr;
1054 Instruction *i;
1055 }
1056
1057 /* We need precedence for a few tokens to resolve a couple of conflicts */
1058 %nonassoc LOW_PREC
1059 %nonassoc '\n'
1060 %nonassoc <t> PARAM
1061
1062 %token <t> SOL HLL
1063 %token <t> GOTO ARG IF UNLESS PNULL SET_RETURN SET_YIELD
1064 %token <t> ADV_FLAT ADV_SLURPY ADV_OPTIONAL ADV_OPT_FLAG ADV_NAMED ADV_ARROW
1065 %token <t> ADV_INVOCANT ADV_CALL_SIG
1066 %token <t> NAMESPACE DOT_METHOD
1067 %token <t> SUB SYM LOCAL LEXICAL CONST ANNOTATE
1068 %token <t> GLOBAL_CONST
1069 %token <t> PLUS_ASSIGN MINUS_ASSIGN MUL_ASSIGN DIV_ASSIGN CONCAT_ASSIGN
1070 %token <t> BAND_ASSIGN BOR_ASSIGN BXOR_ASSIGN FDIV FDIV_ASSIGN MOD_ASSIGN
1071 %token <t> SHR_ASSIGN SHL_ASSIGN SHR_U_ASSIGN
1072 %token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV PMCV LOG_XOR
1073 %token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
1074 %token <t> RESULT RETURN TAILCALL YIELDT GET_RESULTS
1075 %token <t> POW SHIFT_RIGHT_U LOG_AND LOG_OR
1076 %token <t> COMMA ESUB DOTDOT
1077 %token <t> PCC_BEGIN PCC_END PCC_CALL PCC_SUB PCC_BEGIN_RETURN PCC_END_RETURN
1078 %token <t> PCC_BEGIN_YIELD PCC_END_YIELD INVOCANT
1079 %token <t> MAIN LOAD INIT IMMEDIATE POSTCOMP METHOD ANON OUTER NEED_LEX
1080 %token <t> MULTI SUBTAG VTABLE_METHOD LOADLIB SUB_INSTANCE_OF SUBID
1081 %token <t> NS_ENTRY
1082 %token <s> LABEL
1083 %token <t> EMIT EOM
1084 %token <s> IREG NREG SREG PREG IDENTIFIER REG MACRO ENDM
1085 %token <s> STRINGC INTC FLOATC USTRINGC
1086 %token <s> PARROT_OP
1087 %type <t> type hll_def return_or_yield comma_or_goto
1088 %type <i> program
1089 %type <i> class_namespace
1090 %type <i> constdef sub emit pcc_ret pcc_yield
1091 %type <i> compilation_units compilation_unit pmc_const pragma
1092 %type <s> relop any_string assign_op bin_op un_op
1093 %type <i> labels _labels label statement sub_call
1094 %type <i> pcc_sub_call
1095 %type <sr> sub_param pcc_arg pcc_result pcc_args pcc_results sub_param_type_def
1096 %type <sr> pcc_returns pcc_yields pcc_return pcc_call arg arglist the_sub multi_type
1097 %type <sr> subtags
1098 %type <t> argtype_list argtype paramtype_list paramtype
1099 %type <t> pcc_return_many
1100 %type <t> proto sub_proto sub_proto_list multi subtag multi_types outer
1101 %type <t> vtable instanceof subid
1102 %type <t> method ns_entry_name
1103 %type <i> instruction assignment conditional_statement labeled_inst opt_label op_assign
1104 %type <i> if_statement unless_statement
1105 %type <i> func_assign get_results
1106 %type <i> opt_invocant
1107 %type <i> annotate_directive
1108 %type <sr> target targetlist reg const stringc var result pcc_set_yield
1109 %type <sr> keylist keylist_force _keylist key maybe_ns nslist _nslist
1110 %type <sr> vars _vars var_or_i _var_or_i label_op sub_label_op sub_label_op_c
1111 %type <i> pasmcode pasmline pasm_inst
1112 %type <sr> pasm_args
1113 %type <i> var_returns
1114 %token <sr> VAR
1115
1116 %token <t> LINECOMMENT
1117 %token <s> FILECOMMENT
1118 %type <idlist> id_list id_list_id
1119
1120 %nonassoc CONCAT DOT
1121
1122 /* %locations */
1123 %pure-parser
1124
1125 %parse-param {void *yyscanner}
1126 %lex-param {void *yyscanner}
1127 %parse-param {imc_info_t *imcc}
1128 %lex-param {imc_info_t *imcc}
1129
1130 %start program
1131
1132 /* In effort to make the grammar readable but not militaristic, please space indent
1133 code blocks on 10 col boundaries and keep indentation same for all code blocks
1134 in a rule. Indent rule tokens | and ; to 4th col and sub rules 6th col
1135 */
1136
1137 %%
1138
1139 program:
1140 compilation_units { if (yynerrs) YYABORT; $$ = 0; }
1141 ;
1142
1143 compilation_units:
1144 compilation_unit
1145 | compilation_units compilation_unit
1146 ;
1147
1148 compilation_unit:
1149 class_namespace { $$ = $1; }
1150 | constdef { $$ = $1; }
1151 | sub
1152 {
1153 $$ = $1;
1154 imc_close_unit(imcc, imcc->cur_unit);
1155 imcc->cur_unit = 0;
1156 }
1157 | emit
1158 {
1159 $$ = $1;
1160 imc_close_unit(imcc, imcc->cur_unit);
1161 imcc->cur_unit = 0;
1162 }
1163 | MACRO '\n' { $$ = 0; }
1164 | pragma { $$ = 0; }
1165 | '\n' { $$ = 0; }
1166 ;
1167
1168 pragma:
1169 hll_def '\n' { $$ = 0; }
1170 | LOADLIB STRINGC '\n'
1171 {
1172 $$ = 0;
1173 do_loadlib(imcc, $2);
1174 mem_sys_free($2);
1175 }
1176 ;
1177
1178 annotate_directive:
1179 ANNOTATE STRINGC COMMA const
1180 {
1181 /* We'll want to store an entry while emitting instructions, so just
1182 * store annotation like it's an instruction. */
1183 SymReg * const key = mk_const(imcc, $2, 'S');
1184 $$ = MK_I(imcc, imcc->cur_unit, ".annotate", 2, key, $4);
1185 mem_sys_free($2);
1186 }
1187 ;
1188
1189 hll_def:
1190
1191 HLL STRINGC
1192 {
1193 STRING * const hll_name = Parrot_str_unescape(imcc->interp, $2 + 1, '"', NULL);
1194 Parrot_pcc_set_HLL(imcc->interp, CURRENT_CONTEXT(imcc->interp),
1195 Parrot_hll_register_HLL(imcc->interp, hll_name));
1196
1197 imcc->cur_namespace = NULL;
1198 mem_sys_free($2);
1199 $$ = 0;
1200 }
1201 ;
1202
1203 constdef:
1204 CONST { imcc->is_def = 1; } type IDENTIFIER '=' const
1205 {
1206 mk_const_ident(imcc, $4, $3, $6, 1);
1207 mem_sys_free($4);
1208 imcc->is_def = 0;
1209 }
1210 ;
1211
1212 pmc_const:
1213 CONST { imcc->is_def = 1; } STRINGC var_or_i '=' any_string
1214 {
1215 $$ = mk_pmc_const_named(imcc, imcc->cur_unit, $3, $4, $6);
1216 mem_sys_free($3);
1217 mem_sys_free($6);
1218 imcc->is_def = 0;
1219 }
1220 ;
1221 any_string:
1222 STRINGC
1223 | USTRINGC
1224 ;
1225
1226 pasmcode:
1227 pasmline
1228 | pasmcode pasmline
1229 ;
1230
1231 pasmline:
1232 labels pasm_inst '\n' { $$ = 0; }
1233 | MACRO '\n' { $$ = 0; }
1234 | FILECOMMENT { $$ = 0; }
1235 | LINECOMMENT { $$ = 0; }
1236 | class_namespace { $$ = $1; }
1237 | pmc_const
1238 | pragma
1239 ;
1240
1241 pasm_inst: { clear_state(imcc); }
1242 PARROT_OP pasm_args
1243 {
1244 $$ = INS(imcc, imcc->cur_unit, $2, 0, imcc->regs,
1245 imcc->nargs, imcc -> keyvec, 1);
1246 mem_sys_free($2);
1247 }
1248 | PCC_SUB
1249 {
1250 imc_close_unit(imcc, imcc->cur_unit);
1251 imcc->cur_unit = imc_open_unit(imcc, IMC_PASM);
1252 }
1253 sub_proto LABEL
1254 {
1255 $$ = iSUBROUTINE(imcc, imcc->cur_unit, mk_sub_label(imcc, $4));
1256 imcc->cur_call->pcc_sub->pragma = $3;
1257 mem_sys_free($4);
1258 }
1259 | PNULL var
1260 {
1261 $$ = MK_I(imcc, imcc->cur_unit, "null", 1, $2);
1262 }
1263 | LEXICAL STRINGC COMMA REG
1264 {
1265 char *name;
1266 SymReg *n;
1267 SymReg *r = mk_pasm_reg(imcc, $4);
1268 if (*$2 == '"') {
1269 STRING *unescaped = Parrot_str_unescape(imcc->interp, $2 + 1, '"', NULL);
1270 name = Parrot_str_to_cstring(imcc->interp, unescaped);
1271 }
1272 else {
1273 name = mem_sys_strdup($2 + 1);
1274 name[strlen(name) - 1] = 0;
1275 }
1276 n = mk_const(imcc, name, 'S');
1277 set_lexical(imcc, r, n);
1278 $$ = 0;
1279 mem_sys_free($2);
1280 mem_sys_free($4);
1281 mem_sys_free(name);
1282 }
1283 | /* none */ { $$ = 0;}
1284 ;
1285
1286 pasm_args:
1287 vars
1288 ;
1289
1290 emit: /* EMIT and EOM tokens are used when compiling a .pasm file. */
1291 EMIT { imcc->cur_unit = imc_open_unit(imcc, IMC_PASM); }
1292 opt_pasmcode
1293 EOM
1294 {
1295 /* if (optimizer_level & OPT_PASM)
1296 imc_compile_unit(interp, imcc->cur_unit);
1297 emit_flush(interp);
1298 */
1299 $$ = 0;
1300 }
1301 ;
1302
1303 opt_pasmcode:
1304 /* empty */
1305 | pasmcode
1306 ;
1307
1308 class_namespace:
1309 NAMESPACE maybe_ns '\n'
1310 {
1311 int re_open = 0;
1312 $$ = 0;
1313 if (imcc->state->pasm_file && imcc->cur_namespace) {
1314 imc_close_unit(imcc, imcc->cur_unit);
1315 re_open = 1;
1316 }
1317 imcc->cur_namespace = $2;
1318 if (re_open)
1319 imcc->cur_unit = imc_open_unit(imcc, IMC_PASM);
1320 }
1321 ;
1322
1323 maybe_ns:
1324 '[' nslist ']' { $$ = $2; }
1325 | '[' ']' { $$ = NULL; }
1326 ;
1327
1328 nslist:
1329 {
1330 imcc->nkeys = 0;
1331 }
1332 _nslist
1333 {
1334 $$ = link_keys(imcc, imcc->nkeys, imcc->keys, 0);
1335 }
1336 ;
1337
1338 _nslist:
1339 stringc { imcc->keys[imcc->nkeys++] = $1; }
1340 | _nslist ';' stringc
1341 {
1342 imcc->keys[imcc->nkeys++] = $3;
1343 $$ = imcc->keys[0];
1344 }
1345 ;
1346
1347 sub:
1348 SUB
1349 {
1350 imcc->cur_unit = imc_open_unit(imcc, IMC_PCCSUB);
1351 }
1352 sub_label_op_c
1353 {
1354 iSUBROUTINE(imcc, imcc->cur_unit, $3);
1355 }
1356 sub_proto '\n'
1357 {
1358 imcc->cur_call->pcc_sub->pragma = $5;
1359 if (!imcc->cur_unit->instructions->symregs[0]->subid) {
1360 imcc->cur_unit->instructions->symregs[0]->subid =
1361 imcc->cur_unit->instructions->symregs[0];
1362 }
1363 }
1364 sub_body ESUB { $$ = 0; imcc->cur_call = NULL; }
1365 ;
1366
1367 sub_param:
1368 PARAM
1369 { imcc->is_def = 1; }
1370 sub_param_type_def '\n'
1371 {
1372 if (/* IMCC_INFO(interp)->cur_unit->last_ins->op
1373 || */ !(imcc->cur_unit->last_ins->type & ITPCCPARAM)) {
1374 SymReg *r;
1375 Instruction *i;
1376 char name[128];
1377 snprintf(name, sizeof (name), "%cpcc_params_%d",
1378 IMCC_INTERNAL_CHAR, imcc->cnr++);
1379 r = mk_symreg(imcc, name, 0);
1380 r->type = VT_PCC_SUB;
1381 r->pcc_sub = mem_gc_allocate_zeroed_typed(imcc->interp, pcc_sub_t);
1382 i = iLABEL(imcc, imcc->cur_unit, r);
1383 imcc->cur_call = r;
1384 i->type = ITPCCPARAM;
1385 }
1386 if (imcc->adv_named_id) {
1387 add_pcc_named_param(imcc, imcc->cur_call,
1388 imcc->adv_named_id, $3);
1389 imcc->adv_named_id = NULL;
1390 }
1391 else
1392 add_pcc_arg(imcc, imcc->cur_call, $3);
1393 }
1394 { imcc->is_def = 0; }
1395 ;
1396
1397 sub_param_type_def:
1398 type IDENTIFIER paramtype_list
1399 {
1400 if ($3 & VT_OPT_FLAG && $1 != 'I') {
1401 const char *type;
1402 switch ($1) {
1403 case 'N': type = "num"; break;
1404 case 'S': type = "string"; break;
1405 case 'P': type = "pmc"; break;
1406 default: type = "strange"; break;
1407 }
1408
1409 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
1410 ":opt_flag parameter must be of type 'int', not '%s'", type);
1411 }
1412 if ($3 & VT_NAMED && !($3 & VT_FLAT) && !imcc->adv_named_id)
1413 adv_named_set(imcc, $2);
1414 $$ = mk_ident(imcc, $2, $1, VTIDENTIFIER);
1415 $$->type |= $3;
1416 mem_sys_free($2);
1417 }
1418 ;
1419
1420
1421
1422 multi:
1423 MULTI '(' multi_types ')' { $$ = 0; }
1424 ;
1425
1426 multi_types:
1427 /* empty */
1428 {
1429 add_pcc_multi(imcc, imcc->cur_call, NULL);
1430 }
1431 | multi_types COMMA multi_type
1432 {
1433 $$ = 0;
1434 add_pcc_multi(imcc, imcc->cur_call, $3);
1435 }
1436 | multi_type
1437 {
1438 $$ = 0;
1439 add_pcc_multi(imcc, imcc->cur_call, $1);
1440 }
1441 ;
1442
1443 multi_type:
1444 INTV { $$ = mk_const(imcc, "INTVAL", 'S'); }
1445 | FLOATV { $$ = mk_const(imcc, "FLOATVAL", 'S'); }
1446 | PMCV { $$ = mk_const(imcc, "PMC", 'S'); }
1447 | STRINGV { $$ = mk_const(imcc, "STRING", 'S'); }
1448 | IDENTIFIER
1449 {
1450 SymReg *r;
1451 if (strcmp($1, "_") != 0)
1452 r = mk_const(imcc, $1, 'S');
1453 else {
1454 r = mk_const(imcc, "PMC", 'S');
1455 }
1456 mem_sys_free($1);
1457 $$ = r;
1458 }
1459 | STRINGC
1460 {
1461 SymReg *r;
1462 if (strcmp($1, "\"_\"") == 0 || strcmp($1, "'_'") == 0)
1463 r = mk_const(imcc, "PMC", 'S');
1464 else {
1465 r = mk_const(imcc, $1, 'S');
1466 }
1467 mem_sys_free($1);
1468 $$ = r;
1469 }
1470 | '[' keylist ']' { $$ = $2; }
1471 ;
1472
1473
1474 subtag:
1475 SUBTAG '(' subtags ')' { $$ = 0; }
1476 ;
1477
1478 subtags:
1479 subtags COMMA STRINGC
1480 {
1481 SymReg * const r = mk_const(imcc, $3, 'S');
1482 add_pcc_flag_str(imcc, imcc->cur_call, r);
1483 mem_sys_free($3);
1484 $$ = r;
1485 }
1486 | STRINGC
1487 {
1488 SymReg * const r = mk_const(imcc, $1, 'S');
1489 add_pcc_flag_str(imcc, imcc->cur_call, r);
1490 mem_sys_free($1);
1491 $$ = r;
1492 }
1493 ;
1494
1495
1496 outer:
1497 OUTER '(' STRINGC ')'
1498 {
1499 $$ = 0;
1500 imcc->cur_unit->outer = mk_sub_address_fromc(imcc, $3);
1501 mem_sys_free($3);
1502 }
1503 | OUTER '(' IDENTIFIER ')'
1504 {
1505 $$ = 0;
1506 imcc->cur_unit->outer = mk_const(imcc, $3, 'S');
1507 mem_sys_free($3);
1508 }
1509 ;
1510
1511 vtable:
1512 VTABLE_METHOD
1513 {
1514 $$ = P_VTABLE;
1515 imcc->cur_unit->vtable_name = NULL;
1516 imcc->cur_unit->is_vtable_method = 1;
1517 }
1518 | VTABLE_METHOD '(' STRINGC ')'
1519 {
1520 $$ = P_VTABLE;
1521 imcc->cur_unit->vtable_name = $3;
1522 imcc->cur_unit->is_vtable_method = 1;
1523 }
1524 ;
1525
1526 method:
1527 METHOD
1528 {
1529 $$ = P_METHOD;
1530 imcc->cur_unit->method_name = NULL;
1531 imcc->cur_unit->is_method = 1;
1532 }
1533 | METHOD '(' any_string ')'
1534 {
1535 $$ = P_METHOD;
1536 imcc->cur_unit->method_name = $3;
1537 imcc->cur_unit->is_method = 1;
1538 }
1539 ;
1540
1541 ns_entry_name:
1542 NS_ENTRY
1543 {
1544 $$ = P_NSENTRY;
1545 imcc->cur_unit->ns_entry_name = NULL;
1546 imcc->cur_unit->has_ns_entry_name = 1;
1547 }
1548 | NS_ENTRY '(' any_string ')'
1549 {
1550 $$ = P_NSENTRY;
1551 imcc->cur_unit->ns_entry_name = $3;
1552 imcc->cur_unit->has_ns_entry_name = 1;
1553 }
1554 ;
1555
1556 instanceof:
1557 SUB_INSTANCE_OF '(' STRINGC ')'
1558 {
1559 $$ = 0;
1560 imcc->cur_unit->instance_of = $3;
1561 }
1562 ;
1563
1564 subid:
1565 SUBID
1566 {
1567 $$ = 0;
1568 imcc->cur_unit->subid = NULL;
1569 }
1570 | SUBID '(' any_string ')'
1571 {
1572 SymReg *r = mk_const(imcc, $3, 'S');
1573 $$ = 0;
1574 imcc->cur_unit->subid = r;
1575 imcc->cur_unit->instructions->symregs[0]->subid = r;
1576 mem_sys_free($3);
1577 }
1578 ;
1579
1580 sub_body:
1581 /* empty */
1582 | statements
1583 ;
1584
1585 pcc_sub_call:
1586 PCC_BEGIN '\n'
1587 {
1588 char name[128];
1589 SymReg *r;
1590 Instruction *i;
1591
1592 snprintf(name, sizeof (name), "%cpcc_sub_call_%d",
1593 IMCC_INTERNAL_CHAR, imcc->cnr++);
1594 $<sr>$ = r = mk_pcc_sub(imcc, name, 0);
1595 /* this mid rule action has the semantic value of the
1596 * sub SymReg.
1597 * This is used below to append args & results
1598 */
1599 i = iLABEL(imcc, imcc->cur_unit, r);
1600 imcc->cur_call = r;
1601 i->type = ITPCCSUB;
1602 }
1603 pcc_args
1604 opt_invocant
1605 pcc_call
1606 opt_label
1607 pcc_results
1608 PCC_END { $$ = 0; imcc->cur_call = NULL; }
1609 ;
1610
1611 opt_label:
1612 /* empty */ { $$ = NULL; imcc->cur_call->pcc_sub->label = 0; }
1613 | label '\n' { $$ = NULL; imcc->cur_call->pcc_sub->label = 1; }
1614 ;
1615
1616 opt_invocant:
1617 /* empty */ { $$ = NULL; }
1618 | INVOCANT var '\n' { $$ = NULL; imcc->cur_call->pcc_sub->object = $2; }
1619 ;
1620
1621 sub_proto:
1622 /* empty */ { $$ = 0; }
1623 | sub_proto_list
1624 ;
1625
1626 sub_proto_list:
1627 proto { $$ = $1; }
1628 | sub_proto_list proto { $$ = $1 | $2; }
1629 ;
1630
1631 proto:
1632 LOAD {
1633 $$ = P_LOAD;
1634 /*
1635 SymReg * const r = mk_const(imcc, "load", 'S');
1636 add_pcc_flag_str(imcc, imcc->cur_call, r);
1637 $$ = r;
1638 */
1639 }
1640 | INIT {
1641 $$ = P_INIT;
1642 /*
1643 SymReg * const r = mk_const(imcc, "load", 'S');
1644 add_pcc_flag_str(imcc, imcc->cur_call, r);
1645 $$ = r;
1646 */
1647 }
1648 | MAIN { $$ = P_MAIN; }
1649 | IMMEDIATE { $$ = P_IMMEDIATE; }
1650 | POSTCOMP { $$ = P_POSTCOMP; }
1651 | ANON { $$ = P_ANON; }
1652 | NEED_LEX { $$ = P_NEED_LEX; }
1653 | multi
1654 | subtag
1655 | outer
1656 | vtable
1657 | method
1658 | ns_entry_name
1659 | instanceof
1660 | subid
1661 ;
1662
1663 pcc_call:
1664 PCC_CALL var COMMA var '\n'
1665 {
1666 add_pcc_sub(imcc->cur_call, $2);
1667 add_pcc_cc(imcc->cur_call, $4);
1668 }
1669 | PCC_CALL var '\n'
1670 {
1671 add_pcc_sub(imcc->cur_call, $2);
1672 }
1673
1674
1675 pcc_args:
1676 /* empty */ { $$ = 0; }
1677 | pcc_args pcc_arg '\n'
1678 {
1679 if (imcc->adv_named_id) {
1680 add_pcc_named_param(imcc, imcc->cur_call,
1681 imcc->adv_named_id, $2);
1682 imcc->adv_named_id = NULL;
1683 }
1684 else
1685 add_pcc_arg(imcc, imcc->cur_call, $2);
1686 }
1687 ;
1688
1689 pcc_arg:
1690 ARG arg { $$ = $2; }
1691 ;
1692
1693
1694 pcc_results:
1695 /* empty */ { $$ = 0; }
1696 | pcc_results pcc_result '\n'
1697 {
1698 if ($2)
1699 add_pcc_result(imcc, imcc->cur_call, $2);
1700 }
1701 ;
1702
1703 pcc_result:
1704 RESULT target paramtype_list { $$ = $2; $$->type |= $3; }
1705 | LOCAL { imcc->is_def = 1; } type id_list_id
1706 {
1707 IdList * const l = $4;
1708 (void)mk_ident(imcc, l->id, $3, VTIDENTIFIER);
1709 imcc->is_def = 0;
1710 $$ = 0;
1711 }
1712 ;
1713
1714 paramtype_list:
1715 /* empty */ { $$ = 0; }
1716 | paramtype_list paramtype { $$ = $1 | $2; }
1717 ;
1718
1719 paramtype:
1720 ADV_SLURPY { $$ = VT_FLAT; }
1721 | ADV_OPTIONAL { $$ = VT_OPTIONAL; }
1722 | ADV_OPT_FLAG { $$ = VT_OPT_FLAG; }
1723 | ADV_NAMED { $$ = VT_NAMED; }
1724 | ADV_NAMED '(' STRINGC ')' { adv_named_set(imcc, $3); $$ = VT_NAMED; mem_sys_free($3); }
1725 | ADV_NAMED '(' USTRINGC ')' { adv_named_set_u(imcc, $3); $$ = VT_NAMED; mem_sys_free($3); }
1726 | ADV_CALL_SIG { $$ = VT_CALL_SIG; }
1727 ;
1728
1729
1730 pcc_ret:
1731 PCC_BEGIN_RETURN '\n' { begin_return_or_yield(imcc, 0); }
1732 pcc_returns
1733 PCC_END_RETURN { $$ = 0; imcc->asm_state = AsmDefault; }
1734 | pcc_return_many
1735 {
1736 imcc->asm_state = AsmDefault;
1737 $$ = 0;
1738 }
1739 ;
1740
1741 pcc_yield:
1742 PCC_BEGIN_YIELD '\n' { begin_return_or_yield(imcc, 1); }
1743 pcc_yields
1744 PCC_END_YIELD { $$ = 0; imcc->asm_state = AsmDefault; }
1745 ;
1746
1747 pcc_returns:
1748 /* empty */ { $$ = 0; }
1749 | pcc_returns '\n'
1750 {
1751 if ($1)
1752 add_pcc_result(imcc, imcc->sr_return, $1);
1753 }
1754 | pcc_returns pcc_return '\n'
1755 {
1756 if ($2)
1757 add_pcc_result(imcc, imcc->sr_return, $2);
1758 }
1759 ;
1760
1761 pcc_yields:
1762 /* empty */ { $$ = 0; }
1763 | pcc_yields '\n'
1764 {
1765 if ($1)
1766 add_pcc_result(imcc, imcc->sr_return, $1);
1767 }
1768 | pcc_yields pcc_set_yield '\n'
1769 {
1770 if ($2)
1771 add_pcc_result(imcc, imcc->sr_return, $2);
1772 }
1773 ;
1774
1775 pcc_return:
1776 SET_RETURN var argtype_list { $$ = $2; $$->type |= $3; }
1777 ;
1778
1779 pcc_set_yield:
1780 SET_YIELD var argtype_list { $$ = $2; $$->type |= $3; }
1781 ;
1782
1783 pcc_return_many:
1784 return_or_yield '('
1785 {
1786 if (imcc->asm_state == AsmDefault)
1787 begin_return_or_yield(imcc, $1);
1788 }
1789 var_returns ')'
1790 {
1791 imcc->asm_state = AsmDefault;
1792 $$ = 0;
1793 }
1794 ;
1795
1796 return_or_yield:
1797 RETURN { $$ = 0; }
1798 | YIELDT { $$ = 1; }
1799 ;
1800
1801 var_returns:
1802 /* empty */ { $$ = 0; }
1803 | arg
1804 {
1805 if (imcc->adv_named_id) {
1806 add_pcc_named_return(imcc, imcc->sr_return,
1807 imcc->adv_named_id, $1);
1808 imcc->adv_named_id = NULL;
1809 }
1810 else
1811 add_pcc_result(imcc, imcc->sr_return, $1);
1812 }
1813 | STRINGC ADV_ARROW var
1814 {
1815 SymReg * const name = mk_const(imcc, $1, 'S');
1816 add_pcc_named_return(imcc, imcc->sr_return, name, $3);
1817 }
1818 | var_returns COMMA arg
1819 {
1820 if (imcc->adv_named_id) {
1821 add_pcc_named_return(imcc, imcc->sr_return,
1822 imcc->adv_named_id, $3);
1823 imcc->adv_named_id = NULL;
1824 }
1825 else
1826 add_pcc_result(imcc, imcc->sr_return, $3);
1827 }
1828 | var_returns COMMA STRINGC ADV_ARROW var
1829 {
1830 SymReg * const name = mk_const(imcc, $3, 'S');
1831 add_pcc_named_return(imcc, imcc->sr_return, name, $5);
1832 }
1833 ;
1834
1835
1836 statements:
1837 statement
1838 | statements statement
1839 ;
1840
1841 /* This is ugly. Because 'instruction' can start with PARAM and in the
1842 * 'pcc_sub' rule, 'pcc_params' is followed by 'statement', we get a
1843 * shift/reduce conflict on PARAM between reducing to the dummy
1844 * { clear_state(); } rule and shifting the PARAM to be used as part
1845 * of the 'pcc_params' (which is what we want). However, yacc syntax
1846 * doesn't propagate precedence to the dummy rules, so we have to
1847 * split out the action just so that we can assign it a precedence. */
1848
1849 helper_clear_state:
1850 { clear_state(imcc); } %prec LOW_PREC
1851 ;
1852
1853 statement:
1854 sub_param { $$ = 0; }
1855 | helper_clear_state
1856 instruction { $$ = $2; }
1857 | MACRO '\n' { $$ = 0; }
1858 | FILECOMMENT { $$ = 0; }
1859 | LINECOMMENT { $$ = 0; }
1860 | annotate_directive { $$ = $1; }
1861 ;
1862
1863 labels:
1864 /* none */ { $$ = NULL; }
1865 | _labels
1866 ;
1867
1868 _labels:
1869 _labels label
1870 | label
1871 ;
1872
1873 label:
1874 LABEL
1875 {
1876 Instruction * const i = iLABEL(imcc, imcc->cur_unit,
1877 mk_local_label(imcc, $1));
1878 mem_sys_free($1);
1879 $$ = i;
1880 }
1881 ;
1882
1883
1884
1885 instruction:
1886 labels labeled_inst '\n' { $$ = $2; }
1887 | error '\n'
1888 {
1889 if (yynerrs >= PARROT_MAX_RECOVER_ERRORS) {
1890 IMCC_warning(imcc, "Too many errors. Correct some first.\n");
1891 YYABORT;
1892 }
1893 yyerrok;
1894 }
1895 ;
1896
1897 id_list :
1898 id_list_id
1899 {
1900 IdList* const l = $1;
1901 l->next = NULL;
1902 $$ = l;
1903 }
1904
1905 | id_list COMMA id_list_id
1906 {
1907 IdList* const l = $3;
1908 l->next = $1;
1909 $$ = l;
1910 }
1911 ;
1912
1913 id_list_id :
1914 IDENTIFIER
1915 {
1916 IdList* const l = mem_gc_allocate_n_zeroed_typed(imcc->interp, 1, IdList);
1917 l->id = $1;
1918 $$ = l;
1919 }
1920 ;
1921
1922 labeled_inst:
1923 assignment
1924 | conditional_statement
1925 | LOCAL { imcc->is_def = 1; } type id_list
1926 {
1927 IdList *l = $4;
1928 while (l) {
1929 IdList *l1;
1930 mk_ident(imcc, l->id, $3, VTIDENTIFIER);
1931 l1 = l;
1932 l = l->next;
1933 mem_sys_free(l1->id);
1934 mem_sys_free(l1);
1935 }
1936 imcc->is_def = 0; $$ = 0;
1937 }
1938 | LEXICAL STRINGC COMMA target
1939 {
1940 SymReg *n;
1941 char *name;
1942 if (*$2 == '"') {
1943 STRING *unescaped = Parrot_str_unescape(imcc->interp, $2 + 1, '"', NULL);
1944 name = Parrot_str_to_cstring(imcc->interp, unescaped);
1945 }
1946 else {
1947 name = mem_sys_strdup($2 + 1);
1948 name[strlen(name) - 1] = 0;
1949 }
1950 n = mk_const(imcc, name, 'S');
1951 set_lexical(imcc, $4, n);
1952 $$ = 0;
1953 mem_sys_free($2);
1954 mem_sys_free(name);
1955 }
1956 | LEXICAL USTRINGC COMMA target
1957 {
1958 SymReg *n = mk_const(imcc, $2, 'U');
1959 set_lexical(imcc, $4, n); $$ = 0;
1960 mem_sys_free($2);
1961 }
1962 | CONST { imcc->is_def = 1; } type IDENTIFIER '=' const
1963 {
1964 mk_const_ident(imcc, $4, $3, $6, 0);
1965 imcc->is_def = 0;
1966 mem_sys_free($4);
1967 }
1968
1969 | pmc_const
1970 | GLOBAL_CONST { imcc->is_def = 1; } type IDENTIFIER '=' const
1971 {
1972 mk_const_ident(imcc, $4, $3, $6, 1);
1973 imcc->is_def = 0;
1974 mem_sys_free($4);
1975 }
1976 | TAILCALL sub_call
1977 {
1978 $$ = NULL;
1979 imcc->cur_call->pcc_sub->tailcall = 1;
1980 imcc->cur_call = NULL;
1981 }
1982 | GOTO label_op
1983 {
1984 $$ = MK_I(imcc, imcc->cur_unit, "branch", 1, $2);
1985 }
1986 | PARROT_OP vars
1987 {
1988 $$ = INS(imcc, imcc->cur_unit, $1, 0, imcc->regs, imcc->nargs,
1989 imcc->keyvec, 1);
1990 mem_sys_free($1);
1991 }
1992 | PNULL var { $$ = MK_I(imcc, imcc->cur_unit, "null", 1, $2);
1993 $$->type = ITPUREFUNC; }
1994 | sub_call { $$ = 0; imcc->cur_call = NULL; }
1995 | pcc_sub_call { $$ = 0; }
1996 | pcc_ret
1997 | pcc_yield
1998 | /* none */ { $$ = 0;}
1999 ;
2000
2001 type:
2002 INTV {$$ = 'I'; }
2003 | FLOATV { $$ = 'N'; }
2004 | STRINGV { $$ = 'S'; }
2005 | PMCV { $$ = 'P'; }
2006 ;
2007
2008 assignment:
2009 target '=' var
2010 { $$ = MK_I(imcc, imcc->cur_unit, "set", 2, $1, $3); }
2011 | target '=' un_op var
2012 { $$ = MK_I(imcc, imcc->cur_unit, $3, 2, $1, $4);
2013 $$->type = ITPUREFUNC; }
2014 | target '=' var bin_op var
2015 { $$ = MK_I(imcc, imcc->cur_unit, $4, 3, $1, $3, $5);
2016 $$->type = ITPUREFUNC; }
2017 | target '=' var '[' keylist ']'
2018 { $$ = iINDEXFETCH(imcc, imcc->cur_unit, $1, $3, $5); }
2019 | target '[' keylist ']' '=' var
2020 { $$ = iINDEXSET(imcc, imcc->cur_unit, $1, $3, $6); }
2021 /* Subroutine call the short way */
2022 | target '=' sub_call
2023 {
2024 add_pcc_result(imcc, $3->symregs[0], $1);
2025 imcc->cur_call = NULL;
2026 $$ = 0;
2027 }
2028 | '('
2029 {
2030 $<i>$ = IMCC_create_itcall_label(imcc);
2031 }
2032 targetlist ')' '=' the_sub '(' arglist ')'
2033 {
2034 IMCC_itcall_sub(imcc, $6);
2035 imcc->cur_call = NULL;
2036 }
2037 | get_results
2038 | op_assign
2039 | func_assign
2040 | target '=' PNULL
2041 {
2042 $$ = MK_I(imcc, imcc->cur_unit, "null", 1, $1);
2043 $$->type = ITPUREFUNC;
2044 }
2045 ;
2046
2047 /* C++ hates implicit casts from string constants to char *, so be explicit */
2048 un_op:
2049 '!' { $$ = (char *)"not"; }
2050 | '~' { $$ = (char *)"bnot"; }
2051 | '-' { $$ = (char *)"neg"; }
2052 ;
2053
2054 bin_op:
2055 '-' { $$ = (char *)"sub"; }
2056 | '+' { $$ = (char *)"add"; }
2057 | '*' { $$ = (char *)"mul"; }
2058 | '/' { $$ = (char *)"div"; }
2059 | '%' { $$ = (char *)"mod"; }
2060 | FDIV { $$ = (char *)"fdiv"; }
2061 | POW { $$ = (char *)"pow"; }
2062 | CONCAT { $$ = (char *)"concat"; }
2063 | RELOP_EQ { $$ = (char *)"iseq"; }
2064 | RELOP_NE { $$ = (char *)"isne"; }
2065 | RELOP_GT { $$ = (char *)"isgt"; }
2066 | RELOP_GTE { $$ = (char *)"isge"; }
2067 | RELOP_LT { $$ = (char *)"islt"; }
2068 | RELOP_LTE { $$ = (char *)"isle"; }
2069 | SHIFT_LEFT { $$ = (char *)"shl"; }
2070 | SHIFT_RIGHT { $$ = (char *)"shr"; }
2071 | SHIFT_RIGHT_U { $$ = (char *)"lsr"; }
2072 | LOG_AND { $$ = (char *)"and"; }
2073 | LOG_OR { $$ = (char *)"or"; }
2074 | LOG_XOR { $$ = (char *)"xor"; }
2075 | '&' { $$ = (char *)"band"; }
2076 | '|' { $$ = (char *)"bor"; }
2077 | '~' { $$ = (char *)"bxor"; }
2078 ;
2079
2080
2081 get_results:
2082 GET_RESULTS
2083 {
2084 $<i>$ = IMCC_create_itcall_label(imcc);
2085 $<i>$->type &= ~ITCALL;
2086 $<i>$->type |= ITRESULT;
2087 }
2088 '(' targetlist ')' { $$ = 0; }
2089 ;
2090
2091
2092
2093 op_assign:
2094 target assign_op var
2095 { $$ = MK_I(imcc, imcc->cur_unit, $2, 2, $1, $3);
2096 $$->type = ITPUREFUNC; }
2097 | target CONCAT_ASSIGN var
2098 {
2099 if ($1->set == 'P')
2100 $$ = MK_I(imcc, imcc->cur_unit, "concat", 2, $1, $3);
2101 else
2102 $$ = MK_I(imcc, imcc->cur_unit, "concat", 3, $1, $1, $3);
2103 $$->type = ITPUREFUNC;
2104 }
2105 ;
2106
2107 assign_op:
2108 PLUS_ASSIGN { $$ = (char *)"add"; }
2109 | MINUS_ASSIGN { $$ = (char *)"sub"; }
2110 | MUL_ASSIGN { $$ = (char *)"mul"; }
2111 | DIV_ASSIGN { $$ = (char *)"div"; }
2112 | MOD_ASSIGN { $$ = (char *)"mod"; }
2113 | FDIV_ASSIGN { $$ = (char *)"fdiv"; }
2114 | BAND_ASSIGN { $$ = (char *)"band"; }
2115 | BOR_ASSIGN { $$ = (char *)"bor"; }
2116 | BXOR_ASSIGN { $$ = (char *)"bxor"; }
2117 | SHR_ASSIGN { $$ = (char *)"shr"; }
2118 | SHL_ASSIGN { $$ = (char *)"shl"; }
2119 | SHR_U_ASSIGN { $$ = (char *)"lsr"; }
2120 ;
2121
2122
2123 func_assign:
2124 target '=' PARROT_OP pasm_args
2125 {
2126 $$ = func_ins(imcc, imcc->cur_unit, $1, $3, imcc -> regs,
2127 imcc -> nargs, imcc -> keyvec, 1);
2128 mem_sys_free($3);
2129 }
2130 ;
2131
2132 the_sub:
2133 IDENTIFIER { $$ = mk_sub_address(imcc, $1); mem_sys_free($1); }
2134 | STRINGC { $$ = mk_sub_address_fromc(imcc, $1); mem_sys_free($1); }
2135 | USTRINGC { $$ = mk_sub_address_u(imcc, $1); mem_sys_free($1); }
2136 | target
2137 {
2138 $$ = $1;
2139 if ($1->set != 'P')
2140 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "Sub isn't a PMC");
2141 }
2142 | target DOT sub_label_op
2143 {
2144 /* disallow bareword method names; SREG name constants are fine */
2145 const char * const name = $3->name;
2146 if (!($3->type & VTREG)) {
2147 if (*name != '\'' && *name != '\"')
2148 IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
2149 "Bareword method name '%s' not allowed in PIR",
2150 name);
2151 }
2152
2153 imcc->cur_obj = $1;
2154 $$ = $3;
2155 }
2156 | target DOT USTRINGC
2157 {
2158 imcc->cur_obj = $1;
2159 $$ = mk_const(imcc, $3, 'U');
2160 mem_sys_free($3);
2161 }
2162 | target DOT STRINGC
2163 {
2164 imcc->cur_obj = $1;
2165 $$ = mk_const(imcc, $3, 'S');
2166 mem_sys_free($3);
2167 }
2168 | target DOT target
2169 {
2170 imcc->cur_obj = $1;
2171 $$ = $3;
2172 }
2173 ;
2174
2175
2176 sub_call:
2177 the_sub
2178 {
2179 $<i>$ = IMCC_create_itcall_label(imcc);
2180 IMCC_itcall_sub(imcc, $1);
2181 }
2182 '(' arglist ')' { $$ = $<i>2; }
2183 ;
2184
2185 arglist:
2186 /* empty */ { $$ = 0; }
2187 | arglist COMMA arg
2188 {
2189 $$ = 0;
2190 if (imcc->adv_named_id) {
2191 add_pcc_named_arg(imcc, imcc->cur_call, imcc->adv_named_id, $3);
2192 imcc->adv_named_id = NULL;
2193 }
2194 else
2195 add_pcc_arg(imcc, imcc->cur_call, $3);
2196 }
2197 | arg
2198 {
2199 $$ = 0;
2200 if (imcc->adv_named_id) {
2201 add_pcc_named_arg(imcc, imcc->cur_call, imcc->adv_named_id, $1);
2202 imcc->adv_named_id = NULL;
2203 }
2204 else
2205 add_pcc_arg(imcc, imcc->cur_call, $1);
2206 }
2207 | arglist COMMA STRINGC ADV_ARROW var
2208 {
2209 $$ = 0;
2210 add_pcc_named_arg(imcc, imcc->cur_call, mk_const(imcc, $3, 'S'), $5);
2211 mem_sys_free($3);
2212 }
2213 | var ADV_ARROW var
2214 {
2215 $$ = 0;
2216 add_pcc_named_arg_var(imcc, imcc->cur_call, $1, $3);
2217 }
2218 | STRINGC ADV_ARROW var /* State 385 conflicts: 1 shift/reduce
2219 State 385
2220 263 arglist: STRINGC . ADV_ARROW var
2221 326 stringc: STRINGC .
2222
2223 ADV_ARROW shift, and go to state 446
2224
2225 ADV_ARROW [reduce using rule 326 (stringc)]
2226 $default reduce using rule 326 (stringc)
2227 */
2228 {
2229 $$ = 0;
2230 add_pcc_named_arg(imcc, imcc->cur_call,
2231 mk_const(imcc, $1, 'S'), $3);
2232 mem_sys_free($1);
2233 }
2234 ;
2235
2236 arg:
2237 var argtype_list { $$ = $1; $$->type |= $2; }
2238 ;
2239
2240 argtype_list:
2241 /* empty */ { $$ = 0; }
2242 | argtype_list argtype { $$ = $1 | $2; }
2243 ;
2244
2245 argtype:
2246 ADV_FLAT { $$ = VT_FLAT; }
2247 | ADV_NAMED { $$ = VT_NAMED; }
2248 | ADV_CALL_SIG { $$ = VT_CALL_SIG; }
2249
2250 | ADV_NAMED '(' USTRINGC ')'
2251 {
2252 adv_named_set_u(imcc, $3);
2253 mem_sys_free($3);
2254 $$ = 0;
2255 }
2256 | ADV_NAMED '(' STRINGC ')'
2257 {
2258 adv_named_set(imcc, $3);
2259 mem_sys_free($3);
2260 $$ = 0;
2261 }
2262 ;
2263
2264 result:
2265 target paramtype_list { $$ = $1; $$->type |= $2; }
2266 ;
2267
2268 targetlist:
2269 targetlist COMMA result
2270 {
2271 $$ = 0;
2272 if (imcc->adv_named_id) {
2273 add_pcc_named_result(imcc, imcc->cur_call, imcc->adv_named_id, $3);
2274 imcc->adv_named_id = NULL;
2275 }
2276 else
2277 add_pcc_result(imcc, imcc->cur_call, $3);
2278 }
2279 | targetlist COMMA STRINGC ADV_ARROW target
2280 {
2281 add_pcc_named_result(imcc, imcc->cur_call,
2282 mk_const(imcc, $3, 'S'), $5);
2283 mem_sys_free($3);
2284 }
2285 | result
2286 {
2287 $$ = 0;
2288 if (imcc->adv_named_id) {
2289 add_pcc_named_result(imcc, imcc->cur_call, imcc->adv_named_id, $1);
2290 imcc->adv_named_id = NULL;
2291 }
2292 else
2293 add_pcc_result(imcc, imcc->cur_call, $1);
2294 }
2295 | STRINGC ADV_ARROW target
2296 {
2297 add_pcc_named_result(imcc, imcc->cur_call, mk_const(imcc, $1, 'S'), $3);
2298 mem_sys_free($1);
2299 }
2300 | /* empty */ { $$ = 0; }
2301 ;
2302
2303 conditional_statement:
2304 if_statement { $$ = $1; }
2305 | unless_statement { $$ = $1; }
2306 ;
2307
2308 unless_statement:
2309 UNLESS var relop var GOTO label_op
2310 {
2311 $$ = MK_I(imcc, imcc->cur_unit, inv_op($3), 3, $2, $4, $6);
2312 }
2313 | UNLESS PNULL var GOTO label_op
2314 {
2315 $$ = MK_I(imcc, imcc->cur_unit, "unless_null", 2, $3, $5);
2316 }
2317 | UNLESS var comma_or_goto label_op
2318 {
2319 $$ = MK_I(imcc, imcc->cur_unit, "unless", 2, $2, $4);
2320 }
2321 ;
2322
2323 if_statement:
2324 IF var comma_or_goto label_op
2325 {
2326 $$ = MK_I(imcc, imcc->cur_unit, "if", 2, $2, $4);
2327 }
2328 | IF var relop var GOTO label_op
2329 {
2330 $$ = MK_I(imcc, imcc->cur_unit, $3, 3, $2, $4, $6);
2331 }
2332 | IF PNULL var GOTO label_op
2333 {
2334 $$ = MK_I(imcc, imcc->cur_unit, "if_null", 2, $3, $5);
2335 }
2336 ;
2337
2338 comma_or_goto:
2339 COMMA { $$ = 0; }
2340 | GOTO { $$ = 0; }
2341 ;
2342
2343 relop:
2344 RELOP_EQ { $$ = (char *)"eq"; }
2345 | RELOP_NE { $$ = (char *)"ne"; }
2346 | RELOP_GT { $$ = (char *)"gt"; }
2347 | RELOP_GTE { $$ = (char *)"ge"; }
2348 | RELOP_LT { $$ = (char *)"lt"; }
2349 | RELOP_LTE { $$ = (char *)"le"; }
2350 ;
2351
2352 target:
2353 VAR
2354 | reg
2355 ;
2356
2357 vars:
2358 /* empty */ { $$ = NULL; }
2359 | _vars { $$ = $1; }
2360 ;
2361
2362 _vars:
2363 _vars COMMA _var_or_i { $$ = imcc->regs[0]; }
2364 | _var_or_i
2365 ;
2366
2367 _var_or_i:
2368 var_or_i { imcc->regs[imcc->nargs++] = $1; }
2369 | target '[' keylist ']'
2370 {
2371 imcc -> regs[imcc->nargs++] = $1;
2372 imcc -> keyvec |= KEY_BIT(imcc->nargs);
2373 imcc -> regs[imcc->nargs++] = $3;
2374 $$ = $1;
2375 }
2376 | '[' keylist_force ']'
2377 {
2378 imcc -> regs[imcc->nargs++] = $2;
2379 $$ = $2;
2380 }
2381 ;
2382 sub_label_op_c:
2383 sub_label_op
2384 | STRINGC { $$ = mk_sub_address_fromc(imcc, $1); mem_sys_free($1); }
2385 | USTRINGC { $$ = mk_sub_address_u(imcc, $1); mem_sys_free($1); }
2386 ;
2387
2388 sub_label_op:
2389 IDENTIFIER { $$ = mk_sub_address(imcc, $1); mem_sys_free($1); }
2390 | PARROT_OP { $$ = mk_sub_address(imcc, $1); mem_sys_free($1); }
2391 ;
2392
2393 label_op:
2394 IDENTIFIER { $$ = mk_label_address(imcc, $1); mem_sys_free($1); }
2395 | PARROT_OP { $$ = mk_label_address(imcc, $1); mem_sys_free($1); }
2396 ;
2397
2398 var_or_i:
2399 label_op
2400 | var
2401 ;
2402
2403 var:
2404 target
2405 | const
2406 ;
2407
2408 keylist:
2409 {
2410 imcc->nkeys = 0;
2411 }
2412 _keylist
2413 {
2414 $$ = link_keys(imcc, imcc->nkeys, imcc->keys, 0);
2415 }
2416 ;
2417
2418 keylist_force:
2419 {
2420 imcc->nkeys = 0;
2421 }
2422 _keylist
2423 {
2424 $$ = link_keys(imcc,
2425 imcc->nkeys,
2426 imcc->keys, 1);
2427 }
2428 ;
2429
2430 _keylist:
2431 key { imcc->keys[imcc->nkeys++] = $1; }
2432 | _keylist ';' key
2433 {
2434 imcc->keys[imcc->nkeys++] = $3;
2435 $$ = imcc->keys[0];
2436 }
2437 ;
2438
2439 key:
2440 var
2441 {
2442 $$ = $1;
2443 }
2444 ;
2445
2446 reg:
2447 IREG { $$ = mk_symreg(imcc, $1, 'I'); }
2448 | NREG { $$ = mk_symreg(imcc, $1, 'N'); }
2449 | SREG { $$ = mk_symreg(imcc, $1, 'S'); }
2450 | PREG { $$ = mk_symreg(imcc, $1, 'P'); }
2451 | REG { $$ = mk_pasm_reg(imcc, $1); mem_sys_free($1); }
2452 ;
2453
2454 stringc:
2455 STRINGC { $$ = mk_const(imcc, $1, 'S'); mem_sys_free($1); }
2456 | USTRINGC { $$ = mk_const(imcc, $1, 'U'); mem_sys_free($1); }
2457 ;
2458
2459 const:
2460 INTC { $$ = mk_const(imcc, $1, 'I'); mem_sys_free($1); }
2461 | FLOATC { $$ = mk_const(imcc, $1, 'N'); mem_sys_free($1); }
2462 | stringc { $$ = $1; }
2463 ;
2464
2465 /* The End */
2466 %%
2467
2468 /* I need this prototype somewhere... */
2469 char *yyget_text(yyscan_t yyscanner);
2470
2471 /* I do not like this function, but, atm, it is the only way I can
2472 * make the code in yyerror work without segfault on some specific
2473 * cases.
2474 */
2475 /* int yyholds_char(yyscan_t yyscanner); */
2476
yyerror(void * yyscanner,ARGMOD (imc_info_t * imcc),const char * s)2477 int yyerror(void *yyscanner, ARGMOD(imc_info_t *imcc), const char *s)
2478 {
2479 /* If the error occurr in the end of the buffer (I mean, the last
2480 * token was already read), yyget_text will return a pointer
2481 * outside the bison buffer, and thus, not "accessible" by
2482 * us. This means it may segfault. */
2483 const char * const chr = yyget_text((yyscan_t)yyscanner);
2484
2485 /* IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, s); */
2486 /* --- This was called before, not sure if I should call some
2487 similar function that does not die like this one. */
2488
2489 /* Basically, if current token is a newline, it mean the error was
2490 * before the newline, and thus, line is the line *after* the
2491 * error. Instead of duplicating code for both cases (the 'newline' and
2492 * non-newline case, do the test twice; efficiency is not important when
2493 * we have an error anyway. */
2494 if (!at_eof(yyscanner)) {
2495 IMCC_warning(imcc, "error:imcc:%s", s);
2496
2497 /* don't print the current token if it is a newline */
2498 if (*chr != '\n')
2499 IMCC_warning(imcc, " ('%s')", chr);
2500
2501 IMCC_print_inc(imcc);
2502 }
2503
2504 /* scanner is at EOF; just to be sure, don't print "current" token */
2505 else {
2506 IMCC_warning(imcc, "error:imcc:%s", s);
2507 IMCC_print_inc(imcc);
2508 }
2509
2510 return 0;
2511 }
2512
2513 /*
2514
2515 =back
2516
2517 */
2518 /*
2519 * Local variables:
2520 * c-file-style: "parrot"
2521 * End:
2522 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
2523 */
2524