?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
tagged release 0.7.1
[parrot.git] / compilers / imcc / imcc.y
blobefaaf375b66ccd608f77007adedd50bc2908c33f
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-2008, The Perl 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 "pbc.h"
25 #include "parser.h"
26 #include "optimizer.h"
27
28 #ifndef YYENABLE_NLS
29 # define YYENABLE_NLS 0
30 #endif
31
32 #ifndef YYLTYPE_IS_TRIVIAL
33 # define YYLTYPE_IS_TRIVIAL 0
34 #endif
35
36 /* HEADERIZER HFILE: compilers/imcc/imc.h */
37
38 /* HEADERIZER BEGIN: static */
39 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
40
41 static void add_pcc_named_arg(PARROT_INTERP,
42 ARGMOD(SymReg *cur_call),
43 ARGIN(const char *name),
44 ARGIN(SymReg *value))
45 __attribute__nonnull__(1)
46 __attribute__nonnull__(2)
47 __attribute__nonnull__(3)
48 __attribute__nonnull__(4)
49 FUNC_MODIFIES(*cur_call);
50
51 static void add_pcc_named_param(PARROT_INTERP,
52 ARGMOD(SymReg *cur_call),
53 ARGIN(const char *name),
54 ARGIN(SymReg *value))
55 __attribute__nonnull__(1)
56 __attribute__nonnull__(2)
57 __attribute__nonnull__(3)
58 __attribute__nonnull__(4)
59 FUNC_MODIFIES(*cur_call);
60
61 static void add_pcc_named_result(PARROT_INTERP,
62 ARGMOD(SymReg *cur_call),
63 ARGIN(const char *name),
64 ARGIN(SymReg *value))
65 __attribute__nonnull__(1)
66 __attribute__nonnull__(2)
67 __attribute__nonnull__(3)
68 __attribute__nonnull__(4)
69 FUNC_MODIFIES(*cur_call);
70
71 static void add_pcc_named_return(PARROT_INTERP,
72 ARGMOD(SymReg *cur_call),
73 ARGIN(const char *name),
74 ARGIN(SymReg *value))
75 __attribute__nonnull__(1)
76 __attribute__nonnull__(2)
77 __attribute__nonnull__(3)
78 __attribute__nonnull__(4)
79 FUNC_MODIFIES(*cur_call);
80
81 static void adv_named_set(PARROT_INTERP, ARGIN(char *name))
82 __attribute__nonnull__(1)
83 __attribute__nonnull__(2);
84
85 static void begin_return_or_yield(PARROT_INTERP, int yield)
86 __attribute__nonnull__(1);
87
88 static void clear_state(PARROT_INTERP)
89 __attribute__nonnull__(1);
90
91 static void do_loadlib(PARROT_INTERP, ARGIN(const char *lib))
92 __attribute__nonnull__(1)
93 __attribute__nonnull__(2);
94
95 PARROT_WARN_UNUSED_RESULT
96 PARROT_CAN_RETURN_NULL
97 static Instruction* func_ins(PARROT_INTERP,
98 ARGMOD(IMC_Unit *unit),
99 ARGIN(SymReg *lhs),
100 ARGIN(const char *op),
101 ARGMOD(SymReg **r),
102 int n,
103 int keyv,
104 int emit)
105 __attribute__nonnull__(1)
106 __attribute__nonnull__(2)
107 __attribute__nonnull__(3)
108 __attribute__nonnull__(4)
109 __attribute__nonnull__(5)
110 FUNC_MODIFIES(*unit)
111 FUNC_MODIFIES(*r);
112
113 PARROT_CAN_RETURN_NULL
114 static Instruction * iINDEXFETCH(PARROT_INTERP,
115 ARGMOD(IMC_Unit *unit),
116 ARGIN(SymReg *r0),
117 ARGIN(SymReg *r1),
118 ARGIN(SymReg *r2))
119 __attribute__nonnull__(1)
120 __attribute__nonnull__(2)
121 __attribute__nonnull__(3)
122 __attribute__nonnull__(4)
123 __attribute__nonnull__(5)
124 FUNC_MODIFIES(*unit);
125
126 PARROT_CAN_RETURN_NULL
127 static Instruction * iINDEXSET(PARROT_INTERP,
128 ARGMOD(IMC_Unit *unit),
129 ARGIN(SymReg *r0),
130 ARGIN(SymReg *r1),
131 ARGIN(SymReg *r2))
132 __attribute__nonnull__(1)
133 __attribute__nonnull__(2)
134 __attribute__nonnull__(3)
135 __attribute__nonnull__(4)
136 __attribute__nonnull__(5)
137 FUNC_MODIFIES(*unit);
138
139 PARROT_CANNOT_RETURN_NULL
140 static Instruction * iLABEL(PARROT_INTERP,
141 ARGMOD_NULLOK(IMC_Unit *unit),
142 ARGMOD(SymReg *r0))
143 __attribute__nonnull__(1)
144 __attribute__nonnull__(3)
145 FUNC_MODIFIES(*r0);
146
147 PARROT_WARN_UNUSED_RESULT
148 PARROT_CAN_RETURN_NULL
149 static const char * inv_op(ARGIN(const char *op))
150 __attribute__nonnull__(1);
151
152 PARROT_CANNOT_RETURN_NULL
153 static Instruction * iSUBROUTINE(PARROT_INTERP,
154 ARGMOD_NULLOK(IMC_Unit *unit),
155 ARGMOD(SymReg *r))
156 __attribute__nonnull__(1)
157 __attribute__nonnull__(3)
158 FUNC_MODIFIES(*r);
159
160 PARROT_IGNORABLE_RESULT
161 PARROT_CAN_RETURN_NULL
162 static Instruction * MK_I(PARROT_INTERP,
163 ARGMOD(IMC_Unit *unit),
164 ARGIN(const char *fmt),
165 int n,
166 ...)
167 __attribute__nonnull__(1)
168 __attribute__nonnull__(2)
169 __attribute__nonnull__(3)
170 FUNC_MODIFIES(*unit);
171
172 PARROT_WARN_UNUSED_RESULT
173 PARROT_CAN_RETURN_NULL
174 static Instruction* mk_pmc_const(PARROT_INTERP,
175 ARGMOD(IMC_Unit *unit),
176 ARGIN(const char *type),
177 ARGMOD(SymReg *left),
178 ARGIN(const char *constant))
179 __attribute__nonnull__(1)
180 __attribute__nonnull__(2)
181 __attribute__nonnull__(3)
182 __attribute__nonnull__(4)
183 __attribute__nonnull__(5)
184 FUNC_MODIFIES(*unit)
185 FUNC_MODIFIES(*left);
186
187 PARROT_CANNOT_RETURN_NULL
188 static SymReg * mk_sub_address_fromc(PARROT_INTERP, ARGIN(const char *name))
189 __attribute__nonnull__(1)
190 __attribute__nonnull__(2);
191
192 PARROT_CANNOT_RETURN_NULL
193 static SymReg * mk_sub_address_u(PARROT_INTERP, ARGIN(const char *name))
194 __attribute__nonnull__(1)
195 __attribute__nonnull__(2);
196
197 static void set_lexical(PARROT_INTERP,
198 ARGMOD(SymReg *r),
199 ARGIN(const char *name))
200 __attribute__nonnull__(1)
201 __attribute__nonnull__(2)
202 __attribute__nonnull__(3)
203 FUNC_MODIFIES(*r);
204
205 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
206 /* HEADERIZER END: static */
207
208
209 #define YYDEBUG 1
210 #define YYERROR_VERBOSE 1
211
212 /*
213 * We use a pure parser with the interpreter as a parameter. However this still
214 * doesn't make the parser reentrant, as there are too many globals around.
215 */
216
217 /*
218 * Choosing instructions for Parrot is pretty easy since many are
219 * polymorphic.
220 */
221
222
223 /*
224 * MK_I: build and emitb instruction by INS
225 *
226 * fmt may contain:
227 * op %s, %s # comment
228 * or just
229 * op
230 *
231 *
232 * NOTE: Most usage of this function is with
233 * IMCC_INFO(interp)->cur_unit, but there are some
234 * exceptions. Thus, we can't easily factorize that piece of
235 * code.
236 */
237
238 PARROT_IGNORABLE_RESULT
239 PARROT_CAN_RETURN_NULL
240 static Instruction *
241 MK_I(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(const char *fmt), int n, ...)
242 {
243 char opname[64];
244 char *p;
245 const char *q;
246 va_list ap;
247 SymReg *r[IMCC_MAX_FIX_REGS];
248 int i;
249
250 for (p = opname, q = fmt; *q && *q != ' ';)
251 *p++ = *q++;
252 *p = 0;
253 if (!*q)
254 fmt = NULL;
255 else
256 fmt = ++q;
257 #ifdef OPDEBUG
258 fprintf(stderr, "op '%s' format '%s' (%d)\n", opname, fmt?:"", n);
259 #endif
260 va_start(ap, n);
261 i = 0;
262 for (i = 0; i < n; ++i) {
263 r[i] = va_arg(ap, SymReg *);
264 }
265 va_end(ap);
266 return INS(interp, unit, opname, fmt, r, n,
267 IMCC_INFO(interp)->keyvec, 1);
268 }
269
270 PARROT_WARN_UNUSED_RESULT
271 PARROT_CAN_RETURN_NULL
272 static Instruction*
273 mk_pmc_const(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(const char *type),
274 ARGMOD(SymReg *left), ARGIN(const char *constant))
275 {
276 const int type_enum = atoi(type);
277 const int ascii = (*constant == '\'' || *constant == '"');
278 SymReg *rhs;
279 SymReg *r[2];
280 char *name;
281
282 if (left->type == VTADDRESS) { /* IDENTIFIER */
283 if (IMCC_INFO(interp)->state->pasm_file) {
284 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
285 "Ident as PMC constant",
286 " %s\n", left->name);
287 }
288 left->type = VTIDENTIFIER;
289 left->set = 'P';
290 }
291 r[0] = left;
292 if (ascii) {
293 /* strip delimiters */
294 name = str_dup(constant + 1);
295 name[strlen(name) - 1] = '\0';
296 }
297 else {
298 name = str_dup(constant);
299 }
300
301 switch (type_enum) {
302 case enum_class_Sub:
303 case enum_class_Coroutine:
304 rhs = mk_const(interp, name, 'p');
305
306 if (!ascii)
307 rhs->type |= VT_ENCODED;
308
309 rhs->usage = U_FIXUP;
310 break;
311 default:
312 rhs = mk_const(interp, name, 'P');
313 break;
314 }
315
316 r[1] = rhs;
317 rhs->pmc_type = type_enum;
318
319 mem_sys_free(name);
320
321 return INS(interp, unit, "set_p_pc", "", r, 2, 0, 1);
322 }
323
324 PARROT_WARN_UNUSED_RESULT
325 PARROT_CAN_RETURN_NULL
326 static Instruction*
327 func_ins(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(SymReg *lhs), ARGIN(const char *op),
328 ARGMOD(SymReg **r), int n, int keyv, int emit)
329 {
330 int i;
331 /* shift regs up by 1 */
332 for (i = n - 1; i >= 0; --i)
333 r[i+1] = r[i];
334 r[0] = lhs;
335 /* shift keyvec */
336 keyv <<= 1;
337 return INS(interp, unit, op, "", r, n+1, keyv, emit);
338 }
339 /*
340 * special instructions
341 *
342 * labels and such
343 */
344
345 static void
346 clear_state(PARROT_INTERP)
347 {
348 IMCC_INFO(interp) -> nargs = 0;
349 IMCC_INFO(interp) -> keyvec = 0;
350 }
351
352 PARROT_CANNOT_RETURN_NULL
353 Instruction *
354 INS_LABEL(PARROT_INTERP, ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r0), int emit)
355 {
356
357 Instruction * const ins = _mk_instruction("", "%s:", 1, &r0, 0);
358 ins->type = ITLABEL;
359 r0->first_ins = ins;
360
361 if (emit)
362 emitb(interp, unit, ins);
363
364 return ins;
365 }
366
367 PARROT_CANNOT_RETURN_NULL
368 static Instruction *
369 iLABEL(PARROT_INTERP, ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r0))
370 {
371 Instruction * const i = INS_LABEL(interp, unit, r0, 1);
372 i->line = IMCC_INFO(interp)->line;
373
374 clear_state(interp);
375 return i;
376 }
377
378 PARROT_CANNOT_RETURN_NULL
379 static Instruction *
380 iSUBROUTINE(PARROT_INTERP, ARGMOD_NULLOK(IMC_Unit *unit), ARGMOD(SymReg *r))
381 {
382 Instruction * const i = iLABEL(interp, unit, r);
383
384 r->type = (r->type & VT_ENCODED) ? VT_PCC_SUB|VT_ENCODED : VT_PCC_SUB;
385 r->pcc_sub = mem_allocate_zeroed_typed(pcc_sub_t);
386
387 IMCC_INFO(interp)->cur_call = r;
388 i->line = IMCC_INFO(interp)->line;
389
390 add_namespace(interp, unit);
391 return i;
392 }
393
394 /*
395 * substr or X = P[key]
396 */
397 PARROT_CAN_RETURN_NULL
398 static Instruction *
399 iINDEXFETCH(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0), ARGIN(SymReg *r1),
400 ARGIN(SymReg *r2))
401 {
402 if (r0->set == 'S' && r1->set == 'S' && r2->set == 'I') {
403 SymReg * const r3 = mk_const(interp, "1", 'I');
404 return MK_I(interp, unit, "substr %s, %s, %s, 1", 4, r0, r1, r2, r3);
405 }
406
407 IMCC_INFO(interp) -> keyvec |= KEY_BIT(2);
408 return MK_I(interp, unit, "set %s, %s[%s]", 3, r0, r1, r2);
409 }
410
411 /*
412 * substr or P[key] = X
413 */
414
415 PARROT_CAN_RETURN_NULL
416 static Instruction *
417 iINDEXSET(PARROT_INTERP, ARGMOD(IMC_Unit *unit), ARGIN(SymReg *r0), ARGIN(SymReg *r1),
418 ARGIN(SymReg *r2))
419 {
420 if (r0->set == 'S' && r1->set == 'I' && r2->set == 'S') {
421 SymReg * const r3 = mk_const(interp, "1", 'I');
422 MK_I(interp, unit, "substr %s, %s, %s, %s", 4, r0, r1, r3, r2);
423 }
424 else if (r0->set == 'P') {
425 IMCC_INFO(interp)->keyvec |= KEY_BIT(1);
426 MK_I(interp, unit, "set %s[%s], %s", 3, r0, r1, r2);
427 }
428 else
429 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
430 "unsupported indexed set op\n");
431
432 return NULL;
433 }
434
435 PARROT_WARN_UNUSED_RESULT
436 PARROT_CAN_RETURN_NULL
437 static const char *
438 inv_op(ARGIN(const char *op))
439 {
440 int n;
441 return get_neg_op(op, &n);
442 }
443
444 PARROT_CANNOT_RETURN_NULL
445 Instruction *
446 IMCC_create_itcall_label(PARROT_INTERP)
447 {
448 char name[128];
449 SymReg *r;
450 Instruction *i;
451
452 snprintf(name, sizeof (name), "%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR,
453 IMCC_INFO(interp)->cnr++);
454
455 r = mk_pcc_sub(interp, name, 0);
456 i = iLABEL(interp, IMCC_INFO(interp)->cur_unit, r);
457 i->type = ITCALL | ITPCCSUB;
458
459 IMCC_INFO(interp)->cur_call = r;
460
461 return i;
462 }
463
464 PARROT_CANNOT_RETURN_NULL
465 static SymReg *
466 mk_sub_address_fromc(PARROT_INTERP, ARGIN(const char *name))
467 {
468 /* name is a quoted sub name */
469 SymReg *r;
470 char *name_copy = str_dup(name + 1);
471 name_copy[strlen(name_copy) - 1] = '\0';
472
473 r = mk_sub_address(interp, name_copy);
474 mem_sys_free(name_copy);
475
476 return r;
477 }
478
479 PARROT_CANNOT_RETURN_NULL
480 static SymReg *
481 mk_sub_address_u(PARROT_INTERP, ARGIN(const char *name))
482 {
483 SymReg * const r = mk_sub_address(interp, name);
484 r->type |= VT_ENCODED;
485
486 return r;
487 }
488
489 void
490 IMCC_itcall_sub(PARROT_INTERP, ARGIN(SymReg *sub))
491 {
492 IMCC_INFO(interp)->cur_call->pcc_sub->sub = sub;
493 if (IMCC_INFO(interp)->cur_obj) {
494 if (IMCC_INFO(interp)->cur_obj->set != 'P')
495 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "object isn't a PMC");
496 IMCC_INFO(interp)->cur_call->pcc_sub->object = IMCC_INFO(interp)->cur_obj;
497 IMCC_INFO(interp)->cur_obj = NULL;
498 }
499 if (IMCC_INFO(interp)->cur_call->pcc_sub->sub->pmc_type == enum_class_NCI)
500 IMCC_INFO(interp)->cur_call->pcc_sub->flags |= isNCI;
501 if (IMCC_INFO(interp)->cur_unit->type == IMC_PCCSUB)
502 IMCC_INFO(interp)->cur_unit->instructions->symregs[0]->pcc_sub->calls_a_sub |= 1;
503 }
504
505 static void
506 begin_return_or_yield(PARROT_INTERP, int yield)
507 {
508 Instruction *i;
509 Instruction * const ins = IMCC_INFO(interp)->cur_unit->instructions;
510 char name[128];
511
512 if (!ins || !ins->symregs[0] || !(ins->symregs[0]->type & VT_PCC_SUB))
513 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
514 "yield or return directive outside pcc subroutine\n");
515 if (yield)
516 ins->symregs[0]->pcc_sub->calls_a_sub = 1 | ITPCCYIELD;
517 snprintf(name, sizeof (name), yield ? "%cpcc_sub_yield_%d" : "%cpcc_sub_ret_%d",
518 IMCC_INTERNAL_CHAR, IMCC_INFO(interp)->cnr++);
519 interp->imc_info->sr_return = mk_pcc_sub(interp, name, 0);
520 i = iLABEL(interp, IMCC_INFO(interp)->cur_unit, interp->imc_info->sr_return);
521 i->type = yield ? ITPCCSUB | ITLABEL | ITPCCYIELD : ITPCCSUB | ITLABEL ;
522 interp->imc_info->asm_state = yield ? AsmInYield : AsmInReturn;
523 }
524
525 static void
526 set_lexical(PARROT_INTERP, ARGMOD(SymReg *r), ARGIN(const char *name))
527 {
528 SymReg * const n = mk_const(interp, name, 'S');
529
530 r->usage |= U_LEXICAL;
531
532 if (n == r->reg)
533 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
534 "register %s already declared as lexical %s", r->name, n->name);
535
536 /* chain all names in r->reg */
537 n->reg = r->reg;
538 r->reg = n;
539 r->use_count++;
540 }
541
542 static void
543 add_pcc_named_arg(PARROT_INTERP, ARGMOD(SymReg *cur_call), ARGIN(const char *name),
544 ARGIN(SymReg *value))
545 {
546 SymReg * const r = mk_const(interp, name, 'S');
547
548 r->type |= VT_NAMED;
549
550 add_pcc_arg(cur_call, r);
551 add_pcc_arg(cur_call, value);
552 }
553
554 static void
555 add_pcc_named_result(PARROT_INTERP, ARGMOD(SymReg *cur_call), ARGIN(const char *name),
556 ARGIN(SymReg *value))
557 {
558 SymReg * const r = mk_const(interp, name, 'S');
559 r->type |= VT_NAMED;
560
561 add_pcc_result(cur_call, r);
562 add_pcc_result(cur_call, value);
563 }
564
565 static void
566 add_pcc_named_param(PARROT_INTERP, ARGMOD(SymReg *cur_call), ARGIN(const char *name),
567 ARGIN(SymReg *value))
568 {
569 SymReg * const r = mk_const(interp, name, 'S');
570 r->type |= VT_NAMED;
571
572 add_pcc_arg(cur_call, r);
573 add_pcc_arg(cur_call, value);
574 }
575
576 static void
577 add_pcc_named_return(PARROT_INTERP, ARGMOD(SymReg *cur_call), ARGIN(const char *name),
578 ARGIN(SymReg *value))
579 {
580 SymReg * const r = mk_const(interp, name, 'S');
581 r->type |= VT_NAMED;
582
583 add_pcc_result(cur_call, r);
584 add_pcc_result(cur_call, value);
585 }
586
587 /* XXX Can name be consted? */
588 static void
589 adv_named_set(PARROT_INTERP, ARGIN(char *name))
590 {
591 if (IMCC_INFO(interp)->adv_named_id) {
592 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
593 "Named parameter with more than one name.\n");
594 }
595 IMCC_INFO(interp)->adv_named_id = name;
596 }
597
598 static void
599 do_loadlib(PARROT_INTERP, ARGIN(const char *lib))
600 {
601 STRING * const s = string_unescape_cstring(interp, lib + 1, '"', NULL);
602 PMC *ignored = Parrot_load_lib(interp, s, NULL);
603 UNUSED(ignored);
604 Parrot_register_HLL_lib(interp, s);
605 }
606
607 /* HEADERIZER STOP */
608
609 %}
610
611 %union {
612 IdList * idlist;
613 int t;
614 char * s;
615 SymReg * sr;
616 Instruction *i;
617 }
618
619 /* We need precedence for a few tokens to resolve a couple of conflicts */
620 %nonassoc LOW_PREC
621 %nonassoc '\n'
622 %nonassoc <t> PARAM
623
624 %token <t> PRAGMA N_OPERATORS HLL HLL_MAP
625 %token <t> GOTO ARG IF UNLESS PNULL
626 %token <t> ADV_FLAT ADV_SLURPY ADV_OPTIONAL ADV_OPT_FLAG ADV_NAMED ADV_ARROW
627 %token <t> NEW ADV_INVOCANT
628 %token <t> NAMESPACE ENDNAMESPACE DOT_METHOD
629 %token <t> SUB SYM LOCAL LEXICAL CONST
630 %token <t> INC DEC GLOBAL_CONST
631 %token <t> PLUS_ASSIGN MINUS_ASSIGN MUL_ASSIGN DIV_ASSIGN CONCAT_ASSIGN
632 %token <t> BAND_ASSIGN BOR_ASSIGN BXOR_ASSIGN FDIV FDIV_ASSIGN MOD_ASSIGN
633 %token <t> SHR_ASSIGN SHL_ASSIGN SHR_U_ASSIGN
634 %token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV PMCV LOG_XOR
635 %token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
636 %token <t> GLOBAL GLOBALOP ADDR RESULT RETURN YIELDT GET_RESULTS
637 %token <t> POW SHIFT_RIGHT_U LOG_AND LOG_OR
638 %token <t> COMMA ESUB DOTDOT
639 %token <t> PCC_BEGIN PCC_END PCC_CALL PCC_SUB PCC_BEGIN_RETURN PCC_END_RETURN
640 %token <t> PCC_BEGIN_YIELD PCC_END_YIELD NCI_CALL METH_CALL INVOCANT
641 %token <t> MAIN LOAD INIT IMMEDIATE POSTCOMP METHOD ANON OUTER NEED_LEX
642 %token <t> MULTI VTABLE_METHOD LOADLIB SUB_INSTANCE_OF SUB_LEXID
643 %token <t> UNIQUE_REG
644 %token <s> LABEL
645 %token <t> EMIT EOM
646 %token <s> IREG NREG SREG PREG IDENTIFIER REG MACRO ENDM
647 %token <s> STRINGC INTC FLOATC USTRINGC
648 %token <s> PARROT_OP
649 %type <t> type pragma_1 hll_def return_or_yield comma_or_goto opt_unique_reg
650 %type <i> program
651 %type <i> class_namespace
652 %type <i> constdef sub emit pcc_ret pcc_yield
653 %type <i> compilation_units compilation_unit pmc_const pragma
654 %type <s> classname relop any_string assign_op bin_op un_op
655 %type <i> labels _labels label statement sub_call
656 %type <i> pcc_sub_call
657 %type <sr> sub_param sub_params pcc_arg pcc_result pcc_args pcc_results sub_param_type_def
658 %type <sr> pcc_returns pcc_return pcc_call arg arglist the_sub multi_type
659 %type <t> argtype_list argtype paramtype_list paramtype
660 %type <t> pcc_return_many
661 %type <t> proto sub_proto sub_proto_list multi multi_types outer
662 %type <t> vtable instanceof lexid
663 %type <i> instruction assignment conditional_statement labeled_inst opt_label op_assign
664 %type <i> if_statement unless_statement
665 %type <i> func_assign get_results
666 %type <i> opt_invocant
667 %type <sr> target targetlist reg const var string result
668 %type <sr> keylist keylist_force _keylist key maybe_ns
669 %type <sr> vars _vars var_or_i _var_or_i label_op sub_label_op sub_label_op_c
670 %type <i> pasmcode pasmline pasm_inst
671 %type <sr> pasm_args
672 %type <i> var_returns
673 %token <sr> VAR
674
675 %token <t> LINECOMMENT
676 %token <s> FILECOMMENT
677 %type <idlist> id_list id_list_id
678
679 %nonassoc CONCAT DOT
680
681
682 /* %locations */
683 %pure_parser
684
685 /* Note that we pass interp last, because Bison only passes
686 the last param to yyerror(). (Tested on bison <= 2.3)
687 */
688 %parse-param {void *yyscanner}
689 %lex-param {void *yyscanner}
690 %parse-param {Parrot_Interp interp}
691 %lex-param {Parrot_Interp interp}
692
693 %start program
694
695 /* In effort to make the grammar readable but not militaristic, please space indent
696 code blocks on 10 col boundaries and keep indentation same for all code blocks
697 in a rule. Indent rule tokens | and ; to 4th col and sub rules 6th col
698 */
699
700 %%
701
702 program:
703 compilation_units { if (yynerrs) YYABORT; $$ = 0; }
704 ;
705
706 compilation_units:
707 compilation_unit
708 | compilation_units compilation_unit
709 ;
710
711 compilation_unit:
712 class_namespace { $$ = $1; }
713 | constdef { $$ = $1; }
714 | sub
715 {
716 $$ = $1;
717 imc_close_unit(interp, IMCC_INFO(interp)->cur_unit);
718 IMCC_INFO(interp)->cur_unit = 0;
719 }
720 | emit
721 {
722 $$ = $1;
723 imc_close_unit(interp, IMCC_INFO(interp)->cur_unit);
724 IMCC_INFO(interp)->cur_unit = 0;
725 }
726 | MACRO '\n' { $$ = 0; }
727 | pragma { $$ = 0; }
728 | '\n' { $$ = 0; }
729 ;
730
731 pragma:
732 PRAGMA pragma_1 '\n' { $$ = 0; }
733 | hll_def '\n' { $$ = 0; }
734 | LOADLIB STRINGC '\n'
735 {
736 $$ = 0;
737 do_loadlib(interp, $2);
738 mem_sys_free($2);
739 }
740 ;
741
742 pragma_1:
743 N_OPERATORS INTC
744 {
745 if ($2)
746 IMCC_INFO(interp)->state->pragmas |= PR_N_OPERATORS;
747 else
748 IMCC_INFO(interp)->state->pragmas &= ~PR_N_OPERATORS;
749 }
750 ;
751
752 hll_def:
753 HLL STRINGC COMMA STRINGC
754 {
755 STRING * const hll_name = string_unescape_cstring(interp, $2 + 1, '"', NULL);
756 CONTEXT(interp)->current_HLL =
757 Parrot_register_HLL(interp, hll_name);
758
759 /* don't bother loading the library for an empty string */
760 if (strlen($4) > 2) {
761 STRING * const hll_lib =
762 string_unescape_cstring(interp, $4 + 1, '"', NULL);
763 PMC *ignored = Parrot_load_lib(interp, hll_lib, NULL);
764 UNUSED(ignored);
765 Parrot_register_HLL_lib(interp, hll_lib);
766 }
767
768 IMCC_INFO(interp)->cur_namespace = NULL;
769 $$ = 0;
770 }
771 | HLL_MAP STRINGC comma_will_be_equals STRINGC
772 {
773 Parrot_Context *ctx = CONTEXT(interp);
774 STRING * const built_in_name =
775 string_unescape_cstring(interp, $2 + 1, '"', NULL);
776 STRING * const language_name =
777 string_unescape_cstring(interp, $4 + 1, '"', NULL);
778
779 int built_in_type = pmc_type(interp, built_in_name);
780 int language_type = pmc_type(interp, language_name);
781
782 Parrot_register_HLL_type(interp, ctx->current_HLL,
783 built_in_type, language_type);
784 $$ = 0;
785 }
786 ;
787
788 /* this rule is temporary for deprecation of the .HLL_map variant using
789 a comma; the comma will be replaced by a '=' character. */
790 comma_will_be_equals:
791 COMMA
792 | '='
793 ;
794
795 constdef:
796 CONST { is_def = 1; } type IDENTIFIER '=' const
797 {
798 mk_const_ident(interp, $4, $3, $6, 1);
799 mem_sys_free($4);
800 is_def = 0;
801 }
802 ;
803
804 pmc_const:
805 CONST { is_def=1; } INTC var_or_i '=' any_string
806 {
807 $$ = mk_pmc_const(interp, IMCC_INFO(interp)->cur_unit, $3, $4, $6);
808 is_def = 0;
809 }
810 ;
811 any_string:
812 STRINGC
813 | USTRINGC
814 ;
815
816 pasmcode:
817 pasmline
818 | pasmcode pasmline
819 ;
820
821 pasmline:
822 labels pasm_inst '\n' { $$ = 0; }
823 | MACRO '\n' { $$ = 0; }
824 | FILECOMMENT { $$ = 0; }
825 | LINECOMMENT { $$ = 0; }
826 | class_namespace { $$ = $1; }
827 | pmc_const
828 | pragma
829 ;
830
831 pasm_inst: { clear_state(interp); }
832 PARROT_OP pasm_args
833 {
834 $$ = INS(interp, IMCC_INFO(interp)->cur_unit,
835 $2, 0, IMCC_INFO(interp)->regs,
836 IMCC_INFO(interp)->nargs, IMCC_INFO(interp) -> keyvec, 1);
837 /* XXX: can't seem to mem_sys_free($1) here */
838 }
839 | PCC_SUB
840 {
841 imc_close_unit(interp, IMCC_INFO(interp)->cur_unit);
842 IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PASM);
843 }
844 sub_proto LABEL
845 {
846 $$ = iSUBROUTINE(interp,
847 IMCC_INFO(interp)->cur_unit,
848 mk_sub_label(interp, $4));
849 IMCC_INFO(interp)->cur_call->pcc_sub->pragma = $3;
850 }
851 | PNULL var
852 {
853 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "null", 1, $2);
854 }
855 | LEXICAL STRINGC COMMA REG
856 {
857 SymReg *r = mk_pasm_reg(interp, $4);
858 set_lexical(interp, r, $2);
859 $$ = 0;
860 mem_sys_free($2);
861 mem_sys_free($4);
862 }
863 | /* none */ { $$ = 0;}
864 ;
865
866 pasm_args:
867 vars
868 ;
869
870 emit: /* EMIT and EOM tokens are used when compiling a .pasm file. */
871 EMIT { IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PASM); }
872 opt_pasmcode
873 EOM
874 {
875 /* if (optimizer_level & OPT_PASM)
876 imc_compile_unit(interp, IMCC_INFO(interp)->cur_unit);
877 emit_flush(interp);
878 */
879 $$ = 0;
880 }
881 ;
882
883 opt_pasmcode:
884 /* empty */
885 | pasmcode
886 ;
887
888 class_namespace:
889 NAMESPACE maybe_ns '\n'
890 {
891 int re_open = 0;
892 $$ = 0;
893 if (IMCC_INFO(interp)->state->pasm_file && IMCC_INFO(interp)->cur_namespace) {
894 imc_close_unit(interp, IMCC_INFO(interp)->cur_unit);
895 re_open = 1;
896 }
897 IMCC_INFO(interp)->cur_namespace = $2;
898 if (re_open)
899 IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PASM);
900 }
901 ;
902
903 maybe_ns:
904 '[' keylist ']'
905 {
906 if (IMCC_INFO(interp)->in_slice)
907 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
908 "Slice not allowed in namespace.");
909
910 $$ = $2;
911 }
912 | '[' ']' { $$ = NULL; }
913 | { $$ = NULL; }
914 ;
915
916 sub:
917 SUB
918 {
919 IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PCCSUB);
920 }
921 sub_label_op_c
922 {
923 iSUBROUTINE(interp, IMCC_INFO(interp)->cur_unit, $3);
924 }
925 sub_proto '\n' { IMCC_INFO(interp)->cur_call->pcc_sub->pragma = $5; }
926 sub_params
927 sub_body ESUB { $$ = 0; IMCC_INFO(interp)->cur_call = NULL; }
928 ;
929
930 sub_params:
931 /* empty */ { $$ = 0; } %prec LOW_PREC
932 | '\n' { $$ = 0; }
933 | sub_params sub_param '\n'
934 {
935 if (IMCC_INFO(interp)->adv_named_id) {
936 add_pcc_named_param(interp, IMCC_INFO(interp)->cur_call,
937 IMCC_INFO(interp)->adv_named_id, $2);
938 IMCC_INFO(interp)->adv_named_id = NULL;
939 }
940 else
941 add_pcc_arg(IMCC_INFO(interp)->cur_call, $2);
942 }
943 ;
944
945 sub_param:
946 PARAM { is_def=1; } sub_param_type_def { $$ = $3; is_def=0; }
947 ;
948
949 sub_param_type_def:
950 type IDENTIFIER paramtype_list
951 {
952 if ($3 & VT_UNIQUE_REG)
953 $$ = mk_ident_ur(interp, $2, $1);
954 else
955 $$ = mk_ident(interp, $2, $1);
956 $$->type |= $3;
957 mem_sys_free($2);
958 }
959
960 /* don't free $2 here; adv_named_set uses the pointer directly */
961 | type STRINGC ADV_ARROW IDENTIFIER paramtype_list
962 {
963 if ($5 & VT_UNIQUE_REG)
964 $$ = mk_ident_ur(interp, $4, $1);
965 else
966 $$ = mk_ident(interp, $4, $1);
967 $$->type |= $5;
968 adv_named_set(interp, $2);
969 mem_sys_free($4);
970 }
971 ;
972
973
974
975 multi:
976 MULTI '(' multi_types ')' { $$ = 0; }
977 ;
978
979 outer:
980 OUTER '(' STRINGC ')'
981 {
982 $$ = 0;
983 IMCC_INFO(interp)->cur_unit->outer = mk_sub_address_fromc(interp, $3);
984 mem_sys_free($3);
985 }
986 | OUTER '(' IDENTIFIER ')'
987 {
988 $$ = 0;
989 IMCC_INFO(interp)->cur_unit->outer = mk_const(interp, $3, 'S');
990 mem_sys_free($3);
991 }
992 ;
993
994 vtable:
995 VTABLE_METHOD
996 {
997 $$ = 0;
998 IMCC_INFO(interp)->cur_unit->vtable_name = NULL;
999 IMCC_INFO(interp)->cur_unit->is_vtable_method = 1;
1000 }
1001 | VTABLE_METHOD '(' STRINGC ')'
1002 {
1003 $$ = 0;
1004 IMCC_INFO(interp)->cur_unit->vtable_name = $3;
1005 IMCC_INFO(interp)->cur_unit->is_vtable_method = 1;
1006 }
1007 ;
1008
1009 instanceof:
1010 SUB_INSTANCE_OF '(' STRINGC ')'
1011 {
1012 $$ = 0;
1013 IMCC_INFO(interp)->cur_unit->instance_of = $3;
1014 }
1015 ;
1016
1017 lexid:
1018 SUB_LEXID '(' STRINGC ')'
1019 {
1020 $$ = 0;
1021 IMCC_INFO(interp)->cur_unit->lexid = mk_const(interp, $3, 'S');
1022 mem_sys_free($3);
1023 }
1024 ;
1025
1026 multi_types:
1027 /* empty */
1028 {
1029 add_pcc_multi(IMCC_INFO(interp)->cur_call, NULL);
1030 }
1031 | multi_types COMMA multi_type
1032 {
1033 $$ = 0;
1034 add_pcc_multi(IMCC_INFO(interp)->cur_call, $3);
1035 }
1036 | multi_type
1037 {
1038 $$ = 0;
1039 add_pcc_multi(IMCC_INFO(interp)->cur_call, $1);
1040 }
1041 ;
1042
1043 multi_type:
1044 INTV { $$ = mk_const(interp, "INTVAL", 'S'); }
1045 | FLOATV { $$ = mk_const(interp, "FLOATVAL", 'S'); }
1046 | PMCV { $$ = mk_const(interp, "PMC", 'S'); }
1047 | STRINGV { $$ = mk_const(interp, "STRING", 'S'); }
1048 | IDENTIFIER
1049 {
1050 SymReg *r;
1051 if (strcmp($1, "_") != 0)
1052 r = mk_const(interp, $1, 'S');
1053 else {
1054 r = mk_const(interp, "PMC", 'S');
1055 }
1056 mem_sys_free($1);
1057 $$ = r;
1058 }
1059 | STRINGC
1060 {
1061 SymReg *r;
1062 if (strcmp($1, "_") != 0)
1063 r = mk_const(interp, $1, 'S');
1064 else {
1065 r = mk_const(interp, "PMC", 'S');
1066 }
1067 mem_sys_free($1);
1068 $$ = r;
1069 }
1070 | '[' keylist ']' { $$ = $2; }
1071 ;
1072
1073 sub_body:
1074 /* empty */
1075 | statements
1076 ;
1077
1078 pcc_sub_call:
1079 PCC_BEGIN '\n'
1080 {
1081 char name[128];
1082 SymReg *r, *r1;
1083 Instruction *i;
1084
1085 snprintf(name, sizeof (name), "%cpcc_sub_call_%d",
1086 IMCC_INTERNAL_CHAR, IMCC_INFO(interp)->cnr++);
1087 $<sr>$ = r = mk_pcc_sub(interp, name, 0);
1088 /* this mid rule action has the semantic value of the
1089 * sub SymReg.
1090 * This is used below to append args & results
1091 */
1092 i = iLABEL(interp, IMCC_INFO(interp)->cur_unit, r);
1093 IMCC_INFO(interp)->cur_call = r;
1094 i->type = ITPCCSUB;
1095 /*
1096 * if we are inside a pcc_sub mark the sub as doing a
1097 * sub call; the sub is in r[0] of the first ins
1098 */
1099 r1 = IMCC_INFO(interp)->cur_unit->instructions->symregs[0];
1100 if (r1 && r1->pcc_sub)
1101 r1->pcc_sub->calls_a_sub |= 1;
1102 }
1103 pcc_args
1104 opt_invocant
1105 pcc_call
1106 opt_label
1107 pcc_results
1108 PCC_END { $$ = 0; IMCC_INFO(interp)->cur_call = NULL; }
1109 ;
1110
1111 opt_label:
1112 /* empty */ { $$ = NULL; IMCC_INFO(interp)->cur_call->pcc_sub->label = 0; }
1113 | label '\n' { $$ = NULL; IMCC_INFO(interp)->cur_call->pcc_sub->label = 1; }
1114 ;
1115
1116 opt_invocant:
1117 /* empty */ { $$ = NULL; }
1118 | INVOCANT var '\n' { $$ = NULL; IMCC_INFO(interp)->cur_call->pcc_sub->object = $2; }
1119 ;
1120
1121 sub_proto:
1122 /* empty */ { $$ = 0; }
1123 | sub_proto_list
1124 ;
1125
1126 sub_proto_list:
1127 proto { $$ = $1; }
1128 | sub_proto_list proto { $$ = $1 | $2; }
1129 ;
1130
1131 proto:
1132 LOAD { $$ = P_LOAD; }
1133 | INIT { $$ = P_INIT; }
1134 | MAIN { $$ = P_MAIN; }
1135 | IMMEDIATE { $$ = P_IMMEDIATE; }
1136 | POSTCOMP { $$ = P_POSTCOMP; }
1137 | ANON { $$ = P_ANON; }
1138 | METHOD { $$ = P_METHOD; }
1139 | NEED_LEX { $$ = P_NEED_LEX; }
1140 | multi
1141 | outer
1142 | vtable
1143 | instanceof
1144 | lexid
1145 ;
1146
1147 pcc_call:
1148 PCC_CALL var COMMA var '\n'
1149 {
1150 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1151 add_pcc_cc(IMCC_INFO(interp)->cur_call, $4);
1152 }
1153 | PCC_CALL var '\n'
1154 {
1155 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1156 }
1157 | NCI_CALL var '\n'
1158 {
1159 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1160 IMCC_INFO(interp)->cur_call->pcc_sub->flags |= isNCI;
1161 }
1162 | METH_CALL target '\n'
1163 {
1164 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1165 }
1166 | METH_CALL STRINGC '\n'
1167 {
1168 add_pcc_sub(IMCC_INFO(interp)->cur_call, mk_const(interp, $2, 'S'));
1169 }
1170 | METH_CALL target COMMA var '\n'
1171 {
1172 add_pcc_sub(IMCC_INFO(interp)->cur_call, $2);
1173 add_pcc_cc(IMCC_INFO(interp)->cur_call, $4);
1174 }
1175 | METH_CALL STRINGC COMMA var '\n'
1176 {
1177 add_pcc_sub(IMCC_INFO(interp)->cur_call, mk_const(interp, $2, 'S'));
1178 add_pcc_cc(IMCC_INFO(interp)->cur_call, $4);
1179 }
1180 ;
1181
1182
1183 pcc_args:
1184 /* empty */ { $$ = 0; }
1185 | pcc_args pcc_arg '\n' { add_pcc_arg(IMCC_INFO(interp)->cur_call, $2); }
1186 ;
1187
1188 pcc_arg:
1189 ARG arg { $$ = $2; }
1190 ;
1191
1192
1193 pcc_results:
1194 /* empty */ { $$ = 0; }
1195 | pcc_results pcc_result '\n'
1196 {
1197 if ($2)
1198 add_pcc_result(IMCC_INFO(interp)->cur_call, $2);
1199 }
1200 ;
1201
1202 pcc_result:
1203 RESULT target paramtype_list { $$ = $2; $$->type |= $3; }
1204 | LOCAL { is_def=1; } type id_list_id
1205 {
1206 IdList *l = $4;
1207 SymReg *ignored;
1208 if (l->unique_reg)
1209 ignored = mk_ident_ur(interp, l->id, $3);
1210 else
1211 ignored = mk_ident(interp, l->id, $3);
1212 UNUSED(ignored);
1213 is_def=0;
1214 $$=0;
1215 }
1216 ;
1217
1218 paramtype_list:
1219 /* empty */ { $$ = 0; }
1220 | paramtype_list paramtype { $$ = $1 | $2; }
1221 ;
1222
1223 paramtype:
1224 ADV_SLURPY { $$ = VT_FLAT; }
1225 | ADV_OPTIONAL { $$ = VT_OPTIONAL; }
1226 | ADV_OPT_FLAG { $$ = VT_OPT_FLAG; }
1227 | ADV_NAMED { $$ = VT_NAMED; }
1228 | ADV_NAMED '(' STRINGC ')' { adv_named_set(interp, $3); $$ = 0; }
1229 | UNIQUE_REG { $$ = VT_UNIQUE_REG; }
1230 ;
1231
1232
1233 pcc_ret:
1234 PCC_BEGIN_RETURN '\n'
1235 {
1236 begin_return_or_yield(interp, 0);
1237 }
1238 pcc_returns PCC_END_RETURN
1239 {
1240 $$ = 0;
1241 IMCC_INFO(interp)->asm_state = AsmDefault;
1242 }
1243 | pcc_return_many
1244 {
1245 IMCC_INFO(interp)->asm_state = AsmDefault;
1246 $$ = 0;
1247 }
1248 ;
1249
1250 pcc_yield:
1251 PCC_BEGIN_YIELD '\n' { begin_return_or_yield(interp, 1); }
1252 pcc_returns
1253 PCC_END_YIELD { $$ = 0; IMCC_INFO(interp)->asm_state = AsmDefault; }
1254 ;
1255
1256 pcc_returns:
1257 /* empty */ { $$ = 0; }
1258 | pcc_returns '\n'
1259 {
1260 if ($1)
1261 add_pcc_result(IMCC_INFO(interp)->sr_return, $1);
1262 }
1263 | pcc_returns pcc_return '\n'
1264 {
1265 if ($2)
1266 add_pcc_result(IMCC_INFO(interp)->sr_return, $2);
1267 }
1268 ;
1269
1270 pcc_return:
1271 RETURN var argtype_list { $$ = $2; $$->type |= $3; }
1272 ;
1273
1274 pcc_return_many:
1275 return_or_yield '('
1276 {
1277 if (IMCC_INFO(interp)->asm_state == AsmDefault)
1278 begin_return_or_yield(interp, $1);
1279 }
1280 var_returns ')'
1281 {
1282 IMCC_INFO(interp)->asm_state = AsmDefault;
1283 $$ = 0;
1284 }
1285 ;
1286
1287 return_or_yield:
1288 RETURN { $$ = 0; }
1289 | YIELDT { $$ = 1; }
1290 ;
1291
1292 var_returns:
1293 /* empty */ { $$ = 0; }
1294 | arg
1295 {
1296 if (IMCC_INFO(interp)->adv_named_id) {
1297 add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return,
1298 IMCC_INFO(interp)->adv_named_id, $1);
1299 IMCC_INFO(interp)->adv_named_id = NULL;
1300 }
1301 else
1302 add_pcc_result(IMCC_INFO(interp)->sr_return, $1);
1303 }
1304 | STRINGC ADV_ARROW var
1305 {
1306 add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return, $1, $3);
1307 }
1308 | var_returns COMMA arg
1309 {
1310 if (IMCC_INFO(interp)->adv_named_id) {
1311 add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return,
1312 IMCC_INFO(interp)->adv_named_id, $3);
1313 IMCC_INFO(interp)->adv_named_id = NULL;
1314 }
1315 else
1316 add_pcc_result(IMCC_INFO(interp)->sr_return, $3);
1317 }
1318 | var_returns COMMA STRINGC ADV_ARROW var
1319 {
1320 add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return, $3, $5);
1321 }
1322 ;
1323
1324
1325 statements:
1326 statement
1327 | statements statement
1328 ;
1329
1330 /* This is ugly. Because 'instruction' can start with PARAM and in the
1331 * 'pcc_sub' rule, 'pcc_params' is followed by 'statement', we get a
1332 * shift/reduce conflict on PARAM between reducing to the dummy
1333 * { clear_state(); } rule and shifting the PARAM to be used as part
1334 * of the 'pcc_params' (which is what we want). However, yacc syntax
1335 * doesn't propagate precedence to the dummy rules, so we have to
1336 * split out the action just so that we can assign it a precedence. */
1337
1338 helper_clear_state:
1339 { clear_state(interp); } %prec LOW_PREC
1340 ;
1341
1342 statement:
1343 helper_clear_state
1344 instruction { $$ = $2; }
1345 | MACRO '\n' { $$ = 0; }
1346 | FILECOMMENT { $$ = 0; }
1347 | LINECOMMENT { $$ = 0; }
1348 ;
1349
1350 labels:
1351 /* none */ { $$ = NULL; }
1352 | _labels
1353 ;
1354
1355 _labels:
1356 _labels label
1357 | label
1358 ;
1359
1360 label:
1361 LABEL
1362 {
1363 $$ = iLABEL(interp, IMCC_INFO(interp)->cur_unit, mk_local_label(interp, $1));
1364 }
1365 ;
1366
1367
1368
1369 instruction:
1370 labels labeled_inst '\n' { $$ = $2; }
1371 | error '\n'
1372 {
1373 if (yynerrs >= PARROT_MAX_RECOVER_ERRORS) {
1374 IMCC_warning(interp, "Too many errors. Correct some first.\n");
1375 YYABORT;
1376 }
1377 yyerrok;
1378 }
1379 ;
1380
1381 id_list :
1382 id_list_id
1383 {
1384 IdList* l = $1;
1385 l->next = NULL;
1386 $$ = l;
1387 }
1388
1389 | id_list COMMA id_list_id
1390 {
1391 IdList* l = $3;
1392 l->next = $1;
1393 $$ = l;
1394 }
1395 ;
1396
1397 id_list_id :
1398 IDENTIFIER opt_unique_reg
1399 {
1400 IdList* const l = mem_allocate_n_zeroed_typed(1, IdList);
1401 l->id = $1;
1402 l->unique_reg = $2;
1403 $$ = l;
1404 }
1405 ;
1406
1407 opt_unique_reg:
1408 /* empty */ { $$ = 0; }
1409 | UNIQUE_REG { $$ = 1; }
1410 ;
1411
1412
1413 labeled_inst:
1414 assignment
1415 | conditional_statement
1416 | NAMESPACE IDENTIFIER { push_namespace(interp, $2); mem_sys_free($2); }
1417 | ENDNAMESPACE IDENTIFIER { pop_namespace(interp, $2); mem_sys_free($2); }
1418 | LOCAL { is_def=1; } type id_list
1419 {
1420 IdList *l = $4;
1421 while (l) {
1422 IdList *l1;
1423 if (l->unique_reg)
1424 mk_ident_ur(interp, l->id, $3);
1425 else
1426 mk_ident(interp, l->id, $3);
1427 l1 = l;
1428 l = l->next;
1429 mem_sys_free(l1->id);
1430 mem_sys_free(l1);
1431 }
1432 is_def=0; $$=0;
1433 }
1434 | LEXICAL STRINGC COMMA target
1435 {
1436 set_lexical(interp, $4, $2); $$ = 0;
1437 }
1438 | CONST { is_def=1; } type IDENTIFIER '=' const
1439 {
1440 mk_const_ident(interp, $4, $3, $6, 0);
1441 is_def=0;
1442 mem_sys_free($4);
1443 }
1444
1445 | pmc_const
1446 | GLOBAL_CONST { is_def=1; } type IDENTIFIER '=' const
1447 {
1448 mk_const_ident(interp, $4, $3, $6, 1);
1449 is_def=0;
1450 mem_sys_free($4);
1451 }
1452 | RETURN sub_call
1453 {
1454 $$ = NULL;
1455 IMCC_INFO(interp)->cur_call->pcc_sub->flags |= isTAIL_CALL;
1456 IMCC_INFO(interp)->cur_call = NULL;
1457 }
1458 | GOTO label_op { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "branch", 1, $2); }
1459 | PARROT_OP vars
1460 {
1461 $$ = INS(interp,
1462 IMCC_INFO(interp)->cur_unit,
1463 $1,
1464 0,
1465 IMCC_INFO(interp)->regs,
1466 IMCC_INFO(interp)->nargs,
1467 IMCC_INFO(interp)->keyvec,
1468 1);
1469 mem_sys_free($1);
1470 }
1471 | PNULL var { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "null", 1, $2); }
1472 | sub_call { $$ = 0; IMCC_INFO(interp)->cur_call = NULL; }
1473 | pcc_sub_call { $$ = 0; }
1474 | pcc_ret
1475 | pcc_yield
1476 | /* none */ { $$ = 0;}
1477 ;
1478
1479 type:
1480 INTV { $$ = 'I'; }
1481 | FLOATV { $$ = 'N'; }
1482 | STRINGV { $$ = 'S'; }
1483 | PMCV { $$ = 'P'; }
1484 ;
1485
1486 classname:
1487 IDENTIFIER
1488 {
1489 /* there'd normally be a str_dup() here, but the lexer already
1490 * copied the string, so it's safe to use directly */
1491 if ((IMCC_INFO(interp)->cur_pmc_type = pmc_type(interp,
1492 string_from_cstring(interp, $1, 0))) <= 0) {
1493 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
1494 "Unknown PMC type '%s'\n", $1);
1495 }
1496 }
1497 ;
1498
1499 assignment:
1500 target '=' var
1501 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "set", 2, $1, $3); }
1502 | target '=' un_op var
1503 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, $3, 2, $1, $4); }
1504 | target '=' var bin_op var
1505 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, $4, 3, $1, $3, $5); }
1506 | target '=' var '[' keylist ']'
1507 { $$ = iINDEXFETCH(interp, IMCC_INFO(interp)->cur_unit, $1, $3, $5); }
1508 | target '[' keylist ']' '=' var
1509 { $$ = iINDEXSET(interp, IMCC_INFO(interp)->cur_unit, $1, $3, $6); }
1510 | target '=' NEW classname COMMA var
1511 { $$ = iNEW(interp, IMCC_INFO(interp)->cur_unit, $1, $4, $6, 1); }
1512 | target '=' NEW classname '[' keylist ']'
1513 { $$ = iNEW(interp, IMCC_INFO(interp)->cur_unit, $1, $4, $6, 1); }
1514 | target '=' NEW classname
1515 { $$ = iNEW(interp, IMCC_INFO(interp)->cur_unit, $1, $4, NULL, 1); }
1516 | target '=' NEW var
1517 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 2, $1, $4); }
1518 | target '=' NEW maybe_ns
1519 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 2, $1, $4); }
1520 | target '=' NEW maybe_ns COMMA var
1521 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $1, $4, $6); }
1522 | target '=' NEW var COMMA var
1523 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $1, $4, $6); }
1524 | target '=' NEW var '[' keylist ']'
1525 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $1, $4, $6); }
1526 | target '=' ADDR IDENTIFIER
1527 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "set_addr",
1528 2, $1, mk_label_address(interp, $4)); mem_sys_free($4); }
1529 | target '=' GLOBALOP string
1530 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "find_global", 2, $1, $4);}
1531 | GLOBALOP string '=' var
1532 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "store_global", 2, $2, $4); }
1533 /* NEW is here because it is both PIR and PASM keywords so we
1534 * have to handle the token here (or badly hack the lexer). */
1535 | NEW target COMMA var
1536 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 2, $2, $4); }
1537 | NEW target COMMA var COMMA var
1538 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $2, $4, $6); }
1539 | NEW target COMMA var '[' keylist ']'
1540 { $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "new", 3, $2, $4, $6); }
1541 /* Subroutine call the short way */
1542 | target '=' sub_call
1543 {
1544 add_pcc_result($3->symregs[0], $1);
1545 IMCC_INFO(interp)->cur_call = NULL;
1546 $$ = 0;
1547 }
1548 | '('
1549 {
1550 $<i>$ = IMCC_create_itcall_label(interp);
1551 }
1552 targetlist ')' '=' the_sub '(' arglist ')'
1553 {
1554 IMCC_itcall_sub(interp, $6);
1555 IMCC_INFO(interp)->cur_call = NULL;
1556 }
1557 | get_results
1558 | op_assign
1559 | func_assign
1560 | target '=' PNULL
1561 {
1562 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "null", 1, $1);
1563 }
1564 ;
1565
1566 /* C++ hates implicit casts from string constants to char *, so be explicit */
1567 un_op:
1568 '!' { $$ = (char *)"not"; }
1569 | '~' { $$ = (char *)"bnot"; }
1570 | '-' { $$ = (char *)"neg"; }
1571 ;
1572
1573 bin_op:
1574 '-' { $$ = (char *)"sub"; }
1575 | '+' { $$ = (char *)"add"; }
1576 | '*' { $$ = (char *)"mul"; }
1577 | '/' { $$ = (char *)"div"; }
1578 | '%' { $$ = (char *)"mod"; }
1579 | FDIV { $$ = (char *)"fdiv"; }
1580 | POW { $$ = (char *)"pow"; }
1581 | CONCAT { $$ = (char *)"concat"; }
1582 | RELOP_EQ { $$ = (char *)"iseq"; }
1583 | RELOP_NE { $$ = (char *)"isne"; }
1584 | RELOP_GT { $$ = (char *)"isgt"; }
1585 | RELOP_GTE { $$ = (char *)"isge"; }
1586 | RELOP_LT { $$ = (char *)"islt"; }
1587 | RELOP_LTE { $$ = (char *)"isle"; }
1588 | SHIFT_LEFT { $$ = (char *)"shl"; }
1589 | SHIFT_RIGHT { $$ = (char *)"shr"; }
1590 | SHIFT_RIGHT_U { $$ = (char *)"lsr"; }
1591 | LOG_AND { $$ = (char *)"and"; }
1592 | LOG_OR { $$ = (char *)"or"; }
1593 | LOG_XOR { $$ = (char *)"xor"; }
1594 | '&' { $$ = (char *)"band"; }
1595 | '|' { $$ = (char *)"bor"; }
1596 | '~' { $$ = (char *)"bxor"; }
1597 ;
1598
1599
1600 get_results:
1601 GET_RESULTS
1602 {
1603 $$ = IMCC_create_itcall_label(interp);
1604 $$->type &= ~ITCALL;
1605 $$->type |= ITRESULT;
1606 }
1607 '(' targetlist ')' { $$ = 0; }
1608 ;
1609
1610
1611
1612 op_assign:
1613 target assign_op var
1614 {
1615 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, $2, 2, $1, $3);
1616 }
1617 ;
1618
1619 assign_op:
1620 PLUS_ASSIGN { $$ = (char *)"add"; }
1621 | MINUS_ASSIGN { $$ = (char *)"sub"; }
1622 | MUL_ASSIGN { $$ = (char *)"mul"; }
1623 | DIV_ASSIGN { $$ = (char *)"div"; }
1624 | MOD_ASSIGN { $$ = (char *)"mod"; }
1625 | FDIV_ASSIGN { $$ = (char *)"fdiv"; }
1626 | CONCAT_ASSIGN { $$ = (char *)"concat"; }
1627 | BAND_ASSIGN { $$ = (char *)"band"; }
1628 | BOR_ASSIGN { $$ = (char *)"bor"; }
1629 | BXOR_ASSIGN { $$ = (char *)"bxor"; }
1630 | SHR_ASSIGN { $$ = (char *)"shr"; }
1631 | SHL_ASSIGN { $$ = (char *)"shl"; }
1632 | SHR_U_ASSIGN { $$ = (char *)"lsr"; }
1633 ;
1634
1635
1636 func_assign:
1637 target '=' PARROT_OP pasm_args
1638 {
1639 $$ = func_ins(interp, IMCC_INFO(interp)->cur_unit, $1, $3,
1640 IMCC_INFO(interp) -> regs,
1641 IMCC_INFO(interp) -> nargs,
1642 IMCC_INFO(interp) -> keyvec, 1);
1643 mem_sys_free($3);
1644 }
1645 ;
1646
1647 the_sub:
1648 IDENTIFIER { $$ = mk_sub_address(interp, $1); mem_sys_free($1); }
1649 | STRINGC { $$ = mk_sub_address_fromc(interp, $1); mem_sys_free($1); }
1650 | USTRINGC { $$ = mk_sub_address_u(interp, $1); mem_sys_free($1); }
1651 | target
1652 {
1653 $$ = $1;
1654 if ($1->set != 'P')
1655 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "Sub isn't a PMC");
1656 }
1657 | target DOT sub_label_op { IMCC_INFO(interp)->cur_obj = $1; $$ = $3; }
1658 | target DOT STRINGC
1659 {
1660 IMCC_INFO(interp)->cur_obj = $1; $$ = mk_const(interp, $3, 'S');
1661 mem_sys_free($3);
1662 }
1663 | target DOT target { IMCC_INFO(interp)->cur_obj = $1; $$ = $3; }
1664 ;
1665
1666
1667 sub_call:
1668 the_sub
1669 {
1670 $$ = IMCC_create_itcall_label(interp);
1671 IMCC_itcall_sub(interp, $1);
1672 }
1673 '(' arglist ')' { $$ = $<i>2; }
1674 ;
1675
1676 arglist:
1677 /* empty */ { $$ = 0; }
1678 | arglist COMMA arg
1679 {
1680 $$ = 0;
1681 if (IMCC_INFO(interp)->adv_named_id) {
1682 add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call, IMCC_INFO(interp)->adv_named_id, $3);
1683 IMCC_INFO(interp)->adv_named_id = NULL;
1684 }
1685 else
1686 add_pcc_arg(IMCC_INFO(interp)->cur_call, $3);
1687 }
1688 | arg
1689 {
1690 $$ = 0;
1691 if (IMCC_INFO(interp)->adv_named_id) {
1692 add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call, IMCC_INFO(interp)->adv_named_id, $1);
1693 IMCC_INFO(interp)->adv_named_id = NULL;
1694 }
1695 else
1696 add_pcc_arg(IMCC_INFO(interp)->cur_call, $1);
1697 }
1698 | arglist COMMA STRINGC ADV_ARROW var
1699 {
1700 $$ = 0;
1701 add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call, $3, $5);
1702 mem_sys_free($3);
1703 }
1704 | STRINGC ADV_ARROW var
1705 {
1706 $$ = 0;
1707 add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call, $1, $3);
1708 mem_sys_free($1);
1709 }
1710 ;
1711
1712 arg:
1713 var argtype_list { $$ = $1; $$->type |= $2; }
1714 ;
1715
1716 argtype_list:
1717 /* empty */ { $$ = 0; }
1718 | argtype_list argtype { $$ = $1 | $2; }
1719 ;
1720
1721 argtype:
1722 ADV_FLAT { $$ = VT_FLAT; }
1723 | ADV_NAMED { $$ = VT_NAMED; }
1724
1725 /* don't free $3 here; adv_named_set uses the pointer directly */
1726 | ADV_NAMED '(' STRINGC ')' { adv_named_set(interp, $3); $$ = 0; }
1727 ;
1728
1729 result:
1730 target paramtype_list { $$ = $1; $$->type |= $2; }
1731 ;
1732
1733 targetlist:
1734 targetlist COMMA result
1735 {
1736 $$ = 0;
1737 if (IMCC_INFO(interp)->adv_named_id) {
1738 add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call, IMCC_INFO(interp)->adv_named_id, $3);
1739 IMCC_INFO(interp)->adv_named_id = NULL;
1740 }
1741 else
1742 add_pcc_result(IMCC_INFO(interp)->cur_call, $3);
1743 }
1744 | targetlist COMMA STRINGC ADV_ARROW target
1745 {
1746 add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call, $3, $5);
1747 mem_sys_free($3);
1748 }
1749 | result
1750 {
1751 $$ = 0;
1752 if (IMCC_INFO(interp)->adv_named_id) {
1753 add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call, IMCC_INFO(interp)->adv_named_id, $1);
1754 IMCC_INFO(interp)->adv_named_id = NULL;
1755 }
1756 else
1757 add_pcc_result(IMCC_INFO(interp)->cur_call, $1);
1758 }
1759 | STRINGC ADV_ARROW target
1760 {
1761 add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call, $1, $3);
1762 mem_sys_free($1);
1763 }
1764 | /* empty */ { $$ = 0; }
1765 ;
1766
1767 conditional_statement:
1768 if_statement { $$ = $1; }
1769 | unless_statement { $$ = $1; }
1770 ;
1771
1772 unless_statement:
1773 UNLESS var relop var GOTO label_op
1774 {
1775 $$ =MK_I(interp, IMCC_INFO(interp)->cur_unit, inv_op($3), 3, $2, $4, $6);
1776 }
1777 | UNLESS PNULL var GOTO label_op
1778 {
1779 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "unless_null", 2, $3, $5);
1780 }
1781 | UNLESS var comma_or_goto label_op
1782 {
1783 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "unless", 2, $2, $4);
1784 }
1785 ;
1786
1787 if_statement:
1788 IF var comma_or_goto label_op
1789 {
1790 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "if", 2, $2, $4);
1791 }
1792 | IF var relop var GOTO label_op
1793 {
1794 $$ =MK_I(interp, IMCC_INFO(interp)->cur_unit, $3, 3, $2, $4, $6);
1795 }
1796 | IF PNULL var GOTO label_op
1797 {
1798 $$ = MK_I(interp, IMCC_INFO(interp)->cur_unit, "if_null", 2, $3, $5);
1799 }
1800 ;
1801
1802 comma_or_goto:
1803 COMMA { $$ = 0; }
1804 | GOTO { $$ = 0; }
1805 ;
1806
1807 relop:
1808 RELOP_EQ { $$ = (char *)"eq"; }
1809 | RELOP_NE { $$ = (char *)"ne"; }
1810 | RELOP_GT { $$ = (char *)"gt"; }
1811 | RELOP_GTE { $$ = (char *)"ge"; }
1812 | RELOP_LT { $$ = (char *)"lt"; }
1813 | RELOP_LTE { $$ = (char *)"le"; }
1814 ;
1815
1816 target:
1817 VAR
1818 | reg
1819 ;
1820
1821 vars:
1822 /* empty */ { $$ = NULL; }
1823 | _vars { $$ = $1; }
1824 ;
1825
1826 _vars:
1827 _vars COMMA _var_or_i { $$ = IMCC_INFO(interp)->regs[0]; }
1828 | _var_or_i
1829 ;
1830
1831 _var_or_i:
1832 var_or_i { IMCC_INFO(interp)->regs[IMCC_INFO(interp)->nargs++] = $1; }
1833 | target '[' keylist ']'
1834 {
1835 IMCC_INFO(interp) -> regs[IMCC_INFO(interp)->nargs++] = $1;
1836 IMCC_INFO(interp) -> keyvec |= KEY_BIT(IMCC_INFO(interp)->nargs);
1837 IMCC_INFO(interp) -> regs[IMCC_INFO(interp)->nargs++] = $3;
1838 $$ = $1;
1839 }
1840 | '[' keylist_force ']'
1841 {
1842 IMCC_INFO(interp) -> regs[IMCC_INFO(interp)->nargs++] = $2;
1843 $$ = $2;
1844 }
1845 ;
1846 sub_label_op_c:
1847 sub_label_op
1848 | STRINGC { $$ = mk_sub_address_fromc(interp, $1); mem_sys_free($1); }
1849 | USTRINGC { $$ = mk_sub_address_u(interp, $1); mem_sys_free($1); }
1850 ;
1851
1852 sub_label_op:
1853 IDENTIFIER { $$ = mk_sub_address(interp, $1); mem_sys_free($1); }
1854 | PARROT_OP { $$ = mk_sub_address(interp, $1); mem_sys_free($1); }
1855 ;
1856
1857 label_op:
1858 IDENTIFIER { $$ = mk_label_address(interp, $1); mem_sys_free($1); }
1859 | PARROT_OP { $$ = mk_label_address(interp, $1); mem_sys_free($1); }
1860 ;
1861
1862 var_or_i:
1863 label_op
1864 | var
1865 ;
1866
1867 var:
1868 target
1869 | const
1870 ;
1871
1872 keylist:
1873 {
1874 IMCC_INFO(interp)->nkeys = 0;
1875 IMCC_INFO(interp)->in_slice = 0;
1876 }
1877 _keylist
1878 {
1879 $$ = link_keys(interp,
1880 IMCC_INFO(interp)->nkeys,
1881 IMCC_INFO(interp)->keys, 0);
1882 }
1883 ;
1884
1885 keylist_force:
1886 {
1887 IMCC_INFO(interp)->nkeys = 0;
1888 IMCC_INFO(interp)->in_slice = 0;
1889 }
1890 _keylist
1891 {
1892 $$ = link_keys(interp,
1893 IMCC_INFO(interp)->nkeys,
1894 IMCC_INFO(interp)->keys, 1);
1895 }
1896 ;
1897
1898 _keylist:
1899 key { IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = $1; }
1900 | _keylist ';' key
1901 {
1902 IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = $3;
1903 $$ = IMCC_INFO(interp)->keys[0];
1904 }
1905 | _keylist COMMA { IMCC_INFO(interp)->in_slice = 1; }
1906 key
1907 {
1908 IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = $4;
1909 $$ = IMCC_INFO(interp)->keys[0];
1910 }
1911 ;
1912
1913 key:
1914 var
1915 {
1916 if (IMCC_INFO(interp)->in_slice)
1917 $1->type |= VT_START_SLICE | VT_END_SLICE;
1918 $$ = $1;
1919 }
1920 | var DOTDOT var
1921 {
1922 $1->type |= VT_START_SLICE;
1923 $3->type |= VT_END_SLICE;
1924 IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = $1;
1925 $$ = $3;
1926 }
1927 | DOTDOT var { $2->type |= VT_START_ZERO | VT_END_SLICE; $$ = $2; }
1928 | var DOTDOT { $1->type |= VT_START_SLICE | VT_END_INF; $$ = $1; }
1929 ;
1930
1931 reg:
1932 IREG { $$ = mk_symreg(interp, $1, 'I'); }
1933 | NREG { $$ = mk_symreg(interp, $1, 'N'); }
1934 | SREG { $$ = mk_symreg(interp, $1, 'S'); }
1935 | PREG { $$ = mk_symreg(interp, $1, 'P'); }
1936 | REG { $$ = mk_pasm_reg(interp, $1); mem_sys_free($1); }
1937 ;
1938
1939 const:
1940 INTC { $$ = mk_const(interp, $1, 'I'); mem_sys_free($1); }
1941 | FLOATC { $$ = mk_const(interp, $1, 'N'); mem_sys_free($1); }
1942 | STRINGC { $$ = mk_const(interp, $1, 'S'); mem_sys_free($1); }
1943 | USTRINGC { $$ = mk_const(interp, $1, 'U'); mem_sys_free($1); }
1944 ;
1945
1946 string:
1947 SREG { $$ = mk_symreg(interp, $1, 'S'); mem_sys_free($1); }
1948 | STRINGC { $$ = mk_const(interp, $1, 'S'); mem_sys_free($1); }
1949 ;
1950
1951
1952 /* The End */
1953 %%
1954
1955 /* I need this prototype somewhere... */
1956 char *yyget_text(yyscan_t yyscanner);
1957
1958 /* I do not like this function, but, atm, it is the only way I can
1959 * make the code in yyerror work without segfault on some specific
1960 * cases.
1961 */
1962 /* int yyholds_char(yyscan_t yyscanner); */
1963
1964 int yyerror(void *yyscanner, PARROT_INTERP, const char *s)
1965 {
1966 /* If the error occurr in the end of the buffer (I mean, the last
1967 * token was already read), yyget_text will return a pointer
1968 * outside the bison buffer, and thus, not "accessible" by
1969 * us. This means it may segfault. */
1970 const char * const chr = yyget_text((yyscan_t)yyscanner);
1971
1972 /* IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, s); */
1973 /* --- This was called before, not sure if I should call some
1974 similar function that does not die like this one. */
1975
1976 /* Basically, if current token is a newline, it mean the error was
1977 * before the newline, and thus, line is the line *after* the
1978 * error. Instead of duplicating code for both cases (the 'newline' and
1979 * non-newline case, do the test twice; efficiency is not important when
1980 * we have an error anyway.
1981 */
1982 if (!at_eof(yyscanner)) {
1983 if (*chr == '\n') {
1984 IMCC_INFO(interp)->line--;
1985 }
1986
1987 IMCC_warning(interp, "error:imcc:%s", s);
1988 /* don't print the current token if it is a newline */
1989 if (*chr != '\n') {
1990 IMCC_warning(interp, " ('%s')", chr);
1991 }
1992 IMCC_print_inc(interp);
1993
1994 if (*chr == '\n') {
1995 IMCC_INFO(interp)->line++;
1996 }
1997
1998 }
1999 else { /* scanner is at end of file; just to be sure, do not print "current" token. */
2000 IMCC_warning(interp, "error:imcc:%s", s);
2001 IMCC_print_inc(interp);
2002 }
2003
2004 return 0;
2005 }
2006
2007 /*
2008 * Local variables:
2009 * c-file-style: "parrot"
2010 * End:
2011 * vim: expandtab shiftwidth=4:
2012 */
parrot vm git mirror