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