compilers/imcc/imcc.l

   1 %top{
   2
   3 /* ex: set ro ft=c:
   4  * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
   5  *
   6  * This file is generated automatically by the Parrot build process
   7  * from the file compilers/imcc/imcc.l.
   8  *
   9  * Any changes made here will be lost!
  10  *
  11 */
  12
  13 /* HEADERIZER HFILE: none */
  14 /* HEADERIZER STOP */
  15
  16 #ifndef __STDC_VERSION__
  17 #  define __STDC_VERSION__ 0
  18 #endif
  19
  20 }
  21
  22 %{
  23 /*
  24  * imcc.l
  25  *
  26  * Intermediate Code Compiler for Parrot
  27  *
  28  * Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
  29  * Copyright (C) 2002-2008, The Perl Foundation.
  30  *
  31  * The tokenizer.
  32  *
  33  * $Id$
  34  *
  35  */
  36
  37
  38 #include <stdio.h>
  39 #include <stdlib.h>
  40 #include <string.h>
  41 #include "imc.h"
  42 #include "parser.h"
  43
  44 #define MAX_PARAM 16
  45
  46 typedef struct yyguts_t       yyguts_t;
  47 typedef struct parser_state_t parser_state_t;
  48
  49 typedef struct params_t {
  50     char *name[MAX_PARAM];
  51     int   num_param;
  52 } params_t;
  53
  54 typedef struct macro_t {
  55     char    *expansion;
  56     int      line;
  57     params_t params;
  58 } macro_t;
  59
  60 /* parser state structure
  61  * the first few items are common to struct parser_state, but
  62  * we AFAIK need this hack as flex doesn't export YY_BUFFER_STATE
  63  */
  64 typedef struct macro_frame_t {
  65     struct parser_state_t s;
  66
  67     /* macro stuff */
  68     params_t       *params;
  69     char           *heredoc_rest;
  70
  71     params_t        expansion;
  72     int             label;
  73     int             is_macro;
  74     YY_BUFFER_STATE buffer;
  75 } macro_frame_t;
  76
  77 /* static function declarations */
  78 static void pop_parser_state(PARROT_INTERP, ARGMOD(void *yyscanner));
  79
  80 static struct macro_frame_t *new_frame(PARROT_INTERP);
  81
  82 static void define_macro(PARROT_INTERP, ARGIN(const char *name), ARGIN(const params_t *params),
  83         ARGIN(const char *expansion), int start_line);
  84
  85 static macro_t *find_macro(PARROT_INTERP, ARGIN(const char *name));
  86
  87 static void scan_string(macro_frame_t *frame, ARGIN(const char *expansion),
  88         ARGMOD(void *yyscanner));
  89
  90 static void scan_file(PARROT_INTERP, ARGIN(struct macro_frame_t *frame), ARGMOD(FILE *file),
  91         ARGMOD(void *yyscanner));
  92
  93 static int destroy_frame(macro_frame_t *frame, ARGMOD(void *yyscanner));
  94
  95 static int yylex_skip(YYSTYPE *valp, PARROT_INTERP, ARGIN(const char *skip),
  96         ARGMOD(void *yyscanner));
  97
  98 static int read_macro(YYSTYPE *valp, PARROT_INTERP, ARGMOD(void *yyscanner));
  99
 100 static int expand_macro(PARROT_INTERP, ARGIN(const char *name), ARGMOD(void *yyscanner));
 101
 102 static void include_file(PARROT_INTERP, char *file_name, ARGMOD(void *yyscanner));
 103
 104 #define YY_DECL int yylex(YYSTYPE *valp, yyscan_t yyscanner, PARROT_INTERP)
 105
 106 #define YYCHOP() (yytext[--yyleng] = '\0')
 107
 108 #define DUP_AND_RET(valp, token)             \
 109   do {                                       \
 110       if (valp) (valp)->s = str_dup(yytext); \
 111       return (token);                        \
 112   } while (0)
 113
 114 #define DUP_AND_RET_FREE(valp, token)        \
 115   do {                                       \
 116       if (valp) {                            \
 117           mem_sys_free((valp)->s);           \
 118           (valp)->s = str_dup(yytext);       \
 119           return (token);                    \
 120       }                                      \
 121   } while (0)
 122
 123 %}
 124
 125 %option reentrant
 126 %option never-interactive
 127 %option stack
 128
 129 LETTER          [a-zA-Z_@]
 130 DIGIT           [0-9]
 131 DIGITS          {DIGIT}+
 132 HEX             0[xX][0-9A-Fa-f]+
 133 OCT             0[oO][0-7]+
 134 BIN             0[bB][01]+
 135 DOT             [.]
 136 SIGN            [-+]
 137 BIGINT          {SIGN}?{DIGITS}"L"
 138 FLOATNUM        {SIGN}?(({DIGITS}{DOT}{DIGIT}*|{DOT}{DIGITS})([eE]{SIGN}?{DIGITS})?|{DIGITS}[eE]{SIGN}?{DIGITS})
 139 LETTERDIGIT     [a-zA-Z0-9_]
 140 LABELLETTERDIGIT([a-zA-Z0-9_@]|"::")
 141 ID              {LETTER}{LABELLETTERDIGIT}*
 142 DQ_STRING       \"(\\.|[^"\\\n])*\"
 143 ENCCHAR         {LETTER}|{DIGIT}|"-"
 144 ENCCHARS        {ENCCHAR}*
 145 ENC             {LETTER}{ENCCHARS}":"
 146 UNICODE         {ENC}{ENC}?{DQ_STRING}
 147 STRINGCONSTANT  {SQ_STRING}|{DQ_STRING}
 148 SQ_STRING       \'[^'\n]*\'
 149 RANKSPEC        \[[,]*\]
 150 EOL        \r?\n
 151 WS              [\t\f\r\x1a ]
 152 SP              [ ]
 153
 154 %x emit
 155 %x macro
 156 %x pod
 157 %x cmt1
 158 %x cmt2
 159 %x cmt3
 160 %x cmt4
 161 %x cmt5
 162 %x heredoc1
 163 %x heredoc2
 164
 165
 166 %%
 167         /* for emacs "*/
 168         if (IMCC_INFO(interp)->expect_pasm == 1 && !IMCC_INFO(interp)->in_pod) {
 169             IMCC_INFO(interp)->expect_pasm = 2;
 170             BEGIN(emit);
 171         }
 172
 173         if (IMCC_INFO(interp)->frames->s.pasm_file && YYSTATE == INITIAL &&
 174             !IMCC_INFO(interp)->in_pod)
 175         {
 176             if (IMCC_INFO(interp)->frames->s.pasm_file == 1) {
 177                 BEGIN(emit);
 178                 return EMIT;
 179             }
 180
 181             return 0;
 182         }
 183
 184 <heredoc1>.*{EOL} {
 185             IMCC_INFO(interp)->frames->heredoc_rest = str_dup(yytext);
 186             BEGIN(heredoc2);
 187     }
 188
 189 <heredoc2>{EOL} {
 190         /* heredocs have highest priority
 191          * arrange them befor all wildcard state matches
 192          */
 193
 194         /* Newline in the heredoc. Realloc and cat on. */
 195         IMCC_INFO(interp)->line++;
 196         IMCC_INFO(interp)->heredoc_content =
 197             (char*)mem_sys_realloc(IMCC_INFO(interp)->heredoc_content,
 198                             strlen(IMCC_INFO(interp)->heredoc_content) +
 199                             strlen(yytext) + 2);
 200         strcpy(IMCC_INFO(interp)->heredoc_content +
 201                strlen(IMCC_INFO(interp)->heredoc_content), yytext);
 202     }
 203
 204 <heredoc2>.* {
 205         /* Are we at the end of the heredoc? */
 206         if (STREQ(IMCC_INFO(interp)->heredoc_end, yytext)) {
 207             /* End of the heredoc. */
 208             yyguts_t * const yyg = (yyguts_t *)yyscanner;
 209             const int len        = strlen(IMCC_INFO(interp)->heredoc_content);
 210
 211             /* delim */
 212             IMCC_INFO(interp)->heredoc_content[len] =
 213                 IMCC_INFO(interp)->heredoc_content[0];
 214
 215             IMCC_INFO(interp)->heredoc_content[len + 1] = 0;
 216
 217             mem_sys_free(IMCC_INFO(interp)->heredoc_end);
 218             IMCC_INFO(interp)->heredoc_end = NULL;
 219
 220             IMCC_INFO(interp)->frames->buffer = YY_CURRENT_BUFFER;
 221             valp->s                           =
 222                 IMCC_INFO(interp)->heredoc_content;
 223
 224             yy_pop_state(yyscanner);
 225             yy_scan_string(IMCC_INFO(interp)->frames->heredoc_rest, yyscanner);
 226
 227             /* RT #42382 delete quotes, -> emit, pbc */
 228             return STRINGC;
 229         }
 230         else {
 231             /* Part of the heredoc. Realloc and cat the line on. */
 232             IMCC_INFO(interp)->heredoc_content =
 233                 (char *)mem_sys_realloc(IMCC_INFO(interp)->heredoc_content,
 234                                 strlen(IMCC_INFO(interp)->heredoc_content) +
 235                                 strlen(yytext) + 2);
 236             strcpy(IMCC_INFO(interp)->heredoc_content +
 237                    strlen(IMCC_INFO(interp)->heredoc_content), yytext);
 238         }
 239     }
 240
 241
 242 <*>^"#line"{SP}{DIGITS}{SP}["] {
 243         yy_push_state(cmt2, yyscanner);
 244         IMCC_INFO(interp)->line = atoi(yytext+6);
 245         return LINECOMMENT;
 246     }
 247
 248 <cmt2>[^"]+ {
 249         yy_pop_state(yyscanner);
 250         yy_push_state(cmt3, yyscanner);
 251
 252         IMCC_INFO(interp)->frames->s.file = str_dup(yytext);
 253         IMCC_INFO(interp)->cur_unit->file = str_dup(yytext);
 254
 255         return FILECOMMENT;
 256     }
 257
 258 <cmt3>["] {
 259         yy_pop_state(yyscanner);
 260         yy_push_state(cmt4, yyscanner);
 261     }
 262
 263 <*>setfile{SP}+["] { yy_push_state(cmt2, yyscanner); }
 264
 265 <*>setline{SP}+ { yy_push_state(cmt1, yyscanner);  }
 266
 267 <cmt1>{DIGITS} {
 268         IMCC_INFO(interp)->line = atoi(yytext);
 269         yy_pop_state(yyscanner);
 270         yy_push_state(cmt4, yyscanner);
 271         return LINECOMMENT;
 272     }
 273
 274 <cmt4>.*{EOL} {
 275         yy_pop_state(yyscanner);
 276         IMCC_INFO(interp)->line++;
 277     }
 278
 279 <INITIAL,emit>{EOL} {
 280         if (IMCC_INFO(interp)->expect_pasm == 2)
 281             BEGIN(INITIAL);
 282
 283         IMCC_INFO(interp)->expect_pasm = 0;
 284         IMCC_INFO(interp)->line++;
 285
 286         return '\n';
 287     }
 288
 289 <INITIAL,emit># {
 290         yy_push_state(cmt5, yyscanner);
 291     }
 292
 293 <cmt5>.*{EOL} {
 294         if (IMCC_INFO(interp)->expect_pasm == 2)
 295             BEGIN(INITIAL);
 296         else
 297             yy_pop_state(yyscanner);
 298
 299         IMCC_INFO(interp)->expect_pasm = 0;
 300         IMCC_INFO(interp)->line++;
 301
 302         return '\n';
 303     }
 304
 305
 306 <*>[ISNP]{DIGIT}{DIGIT}? {
 307         valp->s = str_dup(yytext);
 308         return REG;
 309     }
 310
 311 <INITIAL,emit,macro>^"=" {
 312         IMCC_INFO(interp)->in_pod = 1;
 313         yy_push_state(pod, yyscanner);
 314     }
 315
 316 <pod>^"=cut"{EOL} {
 317         IMCC_INFO(interp)->in_pod = 0;
 318         yy_pop_state(yyscanner);
 319         IMCC_INFO(interp)->line++;
 320     }
 321
 322 <pod>.*         { /*ignore*/ }
 323
 324 <pod>{EOL}      { IMCC_INFO(interp)->line++; }
 325
 326 <INITIAL,emit>".lex"     return LEXICAL;
 327 ".arg"                   return ARG;
 328 ".sub"                   return SUB;
 329 ".end"                   return ESUB;
 330 ".begin_call"            return PCC_BEGIN;
 331 ".end_call"              return PCC_END;
 332 ".call"                  return PCC_CALL;
 333 ".nci_call"              return NCI_CALL;
 334 ".meth_call"             return METH_CALL;
 335 ".invocant"              return INVOCANT;
 336 <emit,INITIAL>".pcc_sub" return PCC_SUB;
 337 ".begin_return"          return PCC_BEGIN_RETURN;
 338 ".end_return"            return PCC_END_RETURN;
 339 ".begin_yield"           return PCC_BEGIN_YIELD;
 340 ".end_yield"             return PCC_END_YIELD;
 341
 342 <emit,INITIAL>":method"    return METHOD;
 343 <emit,INITIAL>":multi"     return MULTI;
 344 <emit,INITIAL>":main"      return MAIN;
 345 <emit,INITIAL>":load"      return LOAD;
 346 <emit,INITIAL>":init"      return INIT;
 347 <emit,INITIAL>":immediate" return IMMEDIATE;
 348 <emit,INITIAL>":postcomp"  return POSTCOMP;
 349 <emit,INITIAL>":anon"      return ANON;
 350 <emit,INITIAL>":outer"     return OUTER;
 351 <emit,INITIAL>":lex"       return NEED_LEX;
 352 <emit,INITIAL>":vtable"    return VTABLE_METHOD;
 353 ":unique_reg"              return UNIQUE_REG;
 354 ":instanceof"              return SUB_INSTANCE_OF;
 355 ":lexid"                   return SUB_LEXID;
 356
 357 ".result"                  return RESULT;
 358 ".get_results"             return GET_RESULTS;
 359 ".yield"                   return YIELDT;
 360 ".return"                  return RETURN;
 361 <emit,INITIAL>".loadlib"   return LOADLIB;
 362
 363 ":flat"         return ADV_FLAT;
 364 ":slurpy"       return ADV_SLURPY;
 365 ":optional"     return ADV_OPTIONAL;
 366 ":opt_flag"     return ADV_OPT_FLAG;
 367 ":named"        return ADV_NAMED;
 368 "=>"            return ADV_ARROW;
 369 ":invocant"     return ADV_INVOCANT;
 370
 371 <emit,INITIAL>".namespace"    return NAMESPACE;
 372 <emit,INITIAL>".HLL"          return HLL;
 373 <emit,INITIAL>".HLL_map"      return HLL_MAP;
 374 ".endnamespace"               return ENDNAMESPACE;
 375 ".local"                      return LOCAL;
 376 ".global"                     return GLOBAL;
 377 <emit,INITIAL>".const"        return CONST;
 378 ".globalconst"                return GLOBAL_CONST;
 379 ".param"                      return PARAM;
 380 <*>".pragma"                  return PRAGMA;
 381 <*>"n_operators"              return N_OPERATORS;
 382 "goto"                        return GOTO;
 383 "if"                          return IF;
 384 "unless"                      return UNLESS;
 385 "null"                        return PNULL;
 386 "int"                         return INTV;
 387 "num"                         return FLOATV;
 388 "new"                         return NEW;
 389 "addr"                        return ADDR;
 390 "global"                      return GLOBALOP;
 391 "pmc"                         return PMCV;
 392 "string"                      return STRINGV;
 393 "<<"                          return SHIFT_LEFT;
 394 ">>"                          return SHIFT_RIGHT;
 395 ">>>"                         return SHIFT_RIGHT_U;
 396 "&&"                          return LOG_AND;
 397 "||"                          return LOG_OR;
 398 "~~"                          return LOG_XOR;
 399 "<"                           return RELOP_LT;
 400 "<="                          return RELOP_LTE;
 401 ">"                           return RELOP_GT;
 402 ">="                          return RELOP_GTE;
 403 "=="                          return RELOP_EQ;
 404 "!="                          return RELOP_NE;
 405 "**"                          return POW;
 406
 407 {WS}+"."{WS}+          return CONCAT;
 408 "."                    return DOT;
 409 <emit,INITIAL>".."     return DOTDOT;
 410 "+="                   return PLUS_ASSIGN;
 411 "-="                   return MINUS_ASSIGN;
 412 "*="                   return MUL_ASSIGN;
 413 "/="                   return DIV_ASSIGN;
 414 "%="                   return MOD_ASSIGN;
 415 "//"                   return FDIV;
 416 "//="                  return FDIV_ASSIGN;
 417 "&="                   return BAND_ASSIGN;
 418 "|="                   return BOR_ASSIGN;
 419 "~="                   return BXOR_ASSIGN;
 420 ">>="                  return SHR_ASSIGN;
 421 "<<="                  return SHL_ASSIGN;
 422 ">>>="                 return SHR_U_ASSIGN;
 423 ".="                   return CONCAT_ASSIGN;
 424
 425 <emit,INITIAL>".macro_const" {
 426         int c;
 427         int start_line;
 428         int start_cond  = YY_START;
 429
 430         BEGIN(macro);
 431         c = yylex_skip(valp, interp, " ", yyscanner);
 432
 433         if (c != IDENTIFIER)
 434             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 435                "Constant names must be identifiers");
 436
 437         IMCC_INFO(interp)->cur_macro_name = valp->s;
 438         start_line                        = IMCC_INFO(interp)->line;
 439
 440         c = yylex_skip(valp, interp, " ", yyscanner);
 441
 442         if (c != INTC && c != FLOATC && c != STRINGC && c != REG)
 443             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 444                 "Constant '%s' value must be a number, "
 445                 "stringliteral or register", IMCC_INFO(interp)->cur_macro_name);
 446
 447         define_macro(interp, IMCC_INFO(interp)->cur_macro_name, NULL, valp->s, start_line);
 448
 449         IMCC_INFO(interp)->cur_macro_name = NULL;
 450
 451         BEGIN(start_cond);
 452         return MACRO;
 453     }
 454
 455 <emit,INITIAL>".macro" {
 456         return read_macro(valp, interp, yyscanner);
 457     }
 458
 459 <emit,INITIAL>".include" {
 460         const int c = yylex(valp, yyscanner, interp);
 461         if (c != STRINGC)
 462             return c;
 463
 464         YYCHOP();
 465         include_file(interp, yytext + 1, yyscanner);
 466     }
 467
 468 <emit,INITIAL>{ID}"$:" {
 469         if (valp) {
 470             char *label;
 471             size_t len;
 472
 473             YYCHOP();
 474             YYCHOP();
 475
 476             if (!IMCC_INFO(interp)->frames || !IMCC_INFO(interp)->frames->label)
 477                     IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "missing space?");
 478
 479             len = yyleng + 10;
 480             label = (char *)mem_sys_allocate(len);
 481             snprintf(label, len, "%s%d", yytext, IMCC_INFO(interp)->frames->label);
 482
 483             /* XXX: free valp->s if it exists? */
 484             valp->s = label;
 485         }
 486
 487         return LABEL;
 488     }
 489
 490 <emit,INITIAL>{ID}"$" {
 491
 492         if (valp) {
 493             char *label;
 494             size_t len;
 495             YYCHOP();
 496
 497             /* RT #32421   if$I0 is parsed as if$ I0 */
 498             if (!IMCC_INFO(interp)->frames || !IMCC_INFO(interp)->frames->label)
 499                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "missing space?");
 500
 501             len = yyleng + 10;
 502             label = (char *)mem_sys_allocate(len);
 503             snprintf(label, len, "%s%d", yytext, IMCC_INFO(interp)->frames->label);
 504
 505             /* XXX: free valp->s if it exists? */
 506             valp->s = label;
 507         }
 508
 509         return IDENTIFIER;
 510      }
 511
 512 <emit,INITIAL>","             return COMMA;
 513
 514 <emit,INITIAL>{ID}":" {
 515         /* trim last ':' */
 516         YYCHOP();
 517
 518         if (valp)
 519             valp->s = yytext;
 520
 521         return LABEL;
 522     }
 523
 524 <emit,INITIAL>{DOT}{LETTER}{LETTERDIGIT}* {
 525         char   * const macro_name = yytext + 1;
 526         STRING * name_string      = string_from_cstring(interp, macro_name, 0);
 527         const int type            = pmc_type(interp, name_string);
 528
 529         if (type > 0) {
 530             const size_t len = 16;
 531             char * const buf = (char *)mem_sys_allocate(len);
 532             snprintf(buf, len, "%d", type);
 533
 534             /* XXX: free valp->s if already used? Sounds like a good idea, */
 535             /* but big segfaults if you do. */
 536             valp->s = buf;
 537             return INTC;
 538         }
 539
 540         if (!expand_macro(interp, macro_name, yyscanner)) {
 541             yyless(1);
 542             return DOT;
 543         }
 544     }
 545
 546 <emit,INITIAL>{ID} {
 547         if (!is_def) {
 548             SymReg *r = find_sym(interp, yytext);
 549
 550             if (r && (r->type & (VTIDENTIFIER|VT_CONSTP))) {
 551                 valp->sr = r;
 552                 return VAR;
 553             }
 554
 555             if (IMCC_INFO(interp)->cur_unit
 556             &&  IMCC_INFO(interp)->cur_unit->instructions
 557             && (r = IMCC_INFO(interp)->cur_unit->instructions->symregs[0])
 558             &&  r->pcc_sub)
 559             {
 560                 if (((r->pcc_sub->pragma & P_METHOD)
 561                 ||   (IMCC_INFO(interp)->cur_unit->is_vtable_method))
 562                 &&   !strcmp(yytext, "self")) {
 563                     valp->sr = mk_ident(interp, "self", 'P');
 564                     IMCC_INFO(interp)->cur_unit->type |= IMC_HAS_SELF;
 565                     return VAR;
 566                 }
 567             }
 568         }
 569
 570         valp->s = str_dup(yytext);
 571         return (!is_def && is_op(interp, valp->s) ? PARROT_OP : IDENTIFIER);
 572     }
 573
 574 <*>{FLOATNUM}         DUP_AND_RET(valp, FLOATC);
 575 <*>{SIGN}?{DIGIT}+    DUP_AND_RET(valp, INTC);
 576 <*>{HEX}              DUP_AND_RET(valp, INTC);
 577 <*>{BIN}              DUP_AND_RET(valp, INTC);
 578 <*>{OCT}              DUP_AND_RET(valp, INTC);
 579
 580 <*>{BIGINT} {
 581         valp->s = str_dup(yytext);
 582
 583         /* trailing 'L' */
 584         valp->s[strlen(valp->s) - 1] = '\0';
 585
 586         /* no BIGINT native format yet */
 587         return STRINGC;
 588     }
 589
 590 <*>{STRINGCONSTANT} {
 591         valp->s = str_dup(yytext);
 592
 593         /* RT #42382 delete quotes, -> emit, pbc */
 594         return STRINGC;
 595     }
 596
 597 <*>"<<"{STRINGCONSTANT} {
 598         macro_frame_t *frame;
 599
 600         /* Save the string we want to mark the end of the heredoc and snip
 601            off newline and quote. */
 602         if (IMCC_INFO(interp)->frames->heredoc_rest)
 603             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "nested heredoc not supported");
 604         IMCC_INFO(interp)->heredoc_end = str_dup(yytext + 3);
 605         IMCC_INFO(interp)->heredoc_end[strlen(IMCC_INFO(interp)->heredoc_end) - 1] = 0;
 606
 607         if (!strlen(IMCC_INFO(interp)->heredoc_end))
 608             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "empty heredoc delimiter");
 609
 610         frame                     = new_frame(interp);
 611         frame->s.next             = (parser_state_t *)IMCC_INFO(interp)->frames;
 612         IMCC_INFO(interp)->frames = frame;
 613
 614         /* Start slurping up the heredoc. */
 615         IMCC_INFO(interp)->heredoc_content    = (char *)mem_sys_allocate(2);
 616
 617         /* preserve delim */
 618         IMCC_INFO(interp)->heredoc_content[0] = yytext[2];
 619
 620         /* eos */
 621         IMCC_INFO(interp)->heredoc_content[1] = 0;
 622         yy_push_state(heredoc1, yyscanner);
 623     }
 624
 625 <*>{UNICODE} {
 626         /* charset:"..." */
 627         valp->s = str_dup(yytext);
 628
 629         /* this is actually not unicode but a string with a charset */
 630         return USTRINGC;
 631     }
 632
 633 <emit,INITIAL>\$I[0-9]+ {
 634         if (valp) (valp)->s = yytext;
 635         if (IMCC_INFO(interp)->state->pasm_file)
 636                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 637                     "'%s' is not a valid register name in pasm mode", yytext);
 638         return IREG;
 639     }
 640
 641 <emit,INITIAL>\$N[0-9]+ {
 642         if (valp) (valp)->s = yytext;
 643         if (IMCC_INFO(interp)->state->pasm_file)
 644                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 645                     "'%s' is not a valid register name in pasm mode", yytext);
 646         return NREG;
 647     }
 648
 649 <emit,INITIAL>\$S[0-9]+ {
 650         if (valp) (valp)->s = yytext;
 651         if (IMCC_INFO(interp)->state->pasm_file)
 652                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 653                     "'%s' is not a valid register name in pasm mode", yytext);
 654         return SREG;
 655     }
 656
 657 <emit,INITIAL>\$P[0-9]+ {
 658         if (valp) (valp)->s = yytext;
 659         if (IMCC_INFO(interp)->state->pasm_file)
 660                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 661                     "'%s' is not a valid register name in pasm mode", yytext);
 662         return PREG;
 663     }
 664
 665 <emit,INITIAL>\$[a-zA-Z0-9]+ {
 666         IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 667             "'%s' is not a valid register name", yytext);
 668     }
 669
 670
 671 <emit,INITIAL>{WS}+ /* skip */;
 672
 673 <emit,cmt1,cmt2,cmt3,cmt4,cmt5,INITIAL>. {
 674         /* catch all except for state macro */
 675         return yytext[0];
 676     }
 677
 678 <emit><<EOF>> {
 679         BEGIN(INITIAL);
 680
 681         if (IMCC_INFO(interp)->frames->s.pasm_file) {
 682             IMCC_INFO(interp)->frames->s.pasm_file = 2;
 683             return EOM;
 684         }
 685
 686         return 0;
 687     }
 688
 689 <INITIAL><<EOF>> yyterminate();
 690
 691 <macro>".endm"         DUP_AND_RET(valp, ENDM);
 692
 693 <macro>{WS}*{EOL} {
 694         IMCC_INFO(interp)->line++;
 695         DUP_AND_RET(valp, '\n');
 696     }
 697
 698 <macro>"$"{ID}":"  return LABEL;
 699
 700 <macro>".label"{WS}+ {
 701
 702         if (yylex(valp, yyscanner, interp) != LABEL)
 703                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "LABEL expected");
 704
 705         if (valp) {
 706             char *label;
 707             size_t len;
 708             YYCHOP();
 709
 710             len = strlen(IMCC_INFO(interp)->cur_macro_name) + yyleng + 15;
 711             label = (char *)mem_sys_allocate(len);
 712
 713             snprintf(label, len, "local__%s__%s__$:",
 714                 IMCC_INFO(interp)->cur_macro_name, yytext+1);
 715
 716             /* XXX: free valp->s if it exists? */
 717             valp->s = label;
 718         }
 719
 720         return LABEL;
 721     }
 722
 723 <macro>".$"{ID} {
 724         if (valp) {
 725             const size_t len = strlen(IMCC_INFO(interp)->cur_macro_name) + yyleng + 12;
 726             char * const label = (char *)mem_sys_allocate(len);
 727
 728             snprintf(label, len, "local__%s__%s__$",
 729                 IMCC_INFO(interp)->cur_macro_name, yytext+2);
 730
 731             valp->s = label;
 732         }
 733
 734         return IDENTIFIER;
 735     }
 736
 737 <macro>^{WS}+                       /* skip leading ws */;
 738 <macro>{WS}+                        DUP_AND_RET(valp, ' ');
 739 <macro>{ID}                         DUP_AND_RET(valp, IDENTIFIER);
 740 <macro>{DOT}{ID}                    DUP_AND_RET(valp, MACRO);
 741 <macro>.                            DUP_AND_RET(valp, yytext[0]);
 742 <macro><<EOF>>                      yyterminate();
 743
 744 %%
 745
 746 #ifdef yywrap
 747 #  undef yywrap
 748 #endif
 749
 750 int yywrap(void* yyscanner) {
 751     /* Add code here to open next source file and start scanning
 752      * yywrap returns 0 if scanning is to continue */
 753     Interp   * const interp = yyget_extra(yyscanner);
 754     yyguts_t * const yyg    = (yyguts_t *)yyscanner;
 755
 756     if (!interp) {
 757         fprintf(stderr, "Argh, interp not found\n");
 758         exit(1);
 759     }
 760
 761     yy_delete_buffer(YY_CURRENT_BUFFER, yyscanner);
 762
 763     /* pop old frame */
 764     if (IMCC_INFO(interp)->frames->s.next) {
 765         pop_parser_state(IMCC_INFO(interp)->frames->s.interp, yyscanner);
 766         if (YYSTATE == INITIAL || YYSTATE == emit)
 767             BEGIN(IMCC_INFO(interp)->frames->s.pasm_file ? emit : INITIAL);
 768         return 0;
 769     }
 770
 771     return 1;
 772 }
 773
 774 static macro_frame_t *
 775 new_frame(PARROT_INTERP) {
 776     static int label   = 0;
 777     macro_frame_t * const tmp = mem_allocate_zeroed_typed(macro_frame_t);
 778
 779     tmp->label         = ++label;
 780     tmp->s.line        = IMCC_INFO(interp)->line;
 781     tmp->s.handle      = NULL;
 782
 783     if (IMCC_INFO(interp)->frames) {
 784         tmp->s.pasm_file = IMCC_INFO(interp)->frames->s.pasm_file;
 785         tmp->s.file      = IMCC_INFO(interp)->frames->s.file;
 786         tmp->s.pragmas   = IMCC_INFO(interp)->frames->s.pragmas;
 787     }
 788
 789     tmp->s.interp = interp;
 790
 791     return tmp;
 792 }
 793
 794 static void
 795 scan_string(macro_frame_t *frame, ARGIN(const char *expansion), void *yyscanner)
 796 {
 797     yyguts_t * const yyg      = (yyguts_t *)yyscanner;
 798     Interp   * const interp   = yyget_extra(yyscanner);
 799
 800     frame->buffer             = YY_CURRENT_BUFFER;
 801     frame->s.next             = (parser_state_t *)IMCC_INFO(interp)->frames;
 802     IMCC_INFO(interp)->frames = frame;
 803
 804     yy_scan_string(expansion, yyscanner);
 805 }
 806
 807 static int
 808 destroy_frame(struct macro_frame_t *frame, void *yyscanner)
 809 {
 810     YY_BUFFER_STATE buffer = frame->buffer;
 811     int             ret    = 0;
 812     int             i;
 813
 814
 815     for (i = 0; i < frame->expansion.num_param; i++) {
 816         mem_sys_free(frame->expansion.name[i]);
 817         frame->expansion.name[i] = NULL;
 818     }
 819
 820     if (frame->heredoc_rest) {
 821         mem_sys_free(frame->heredoc_rest);
 822         frame->heredoc_rest = NULL;
 823     } else
 824         ret = frame->s.line;
 825
 826     /* RT #42383 if frame->s.file was allocated free it */
 827     mem_sys_free(frame);
 828
 829     if (buffer != NULL)
 830         yy_switch_to_buffer(buffer, yyscanner);
 831
 832     return ret;
 833 }
 834
 835 static int
 836 yylex_skip(YYSTYPE *valp, PARROT_INTERP, const char *skip, void *yyscanner)
 837 {
 838     int         c;
 839     const char *p;
 840     yyguts_t   * const yyg = (yyguts_t *)yyscanner;
 841
 842     do {
 843         c = yylex(valp, yyscanner, interp);
 844         p = skip;
 845
 846         while (*p && c != *p)
 847             p++;
 848
 849     } while (*p != '\0');
 850
 851     if (c)
 852         DUP_AND_RET_FREE(valp, c);
 853
 854     return c;
 855 }
 856
 857 static char*
 858 read_braced(YYSTYPE *valp, PARROT_INTERP, const char *macro_name,
 859              char *current, void *yyscanner)
 860 {
 861     YYSTYPE val;
 862     size_t  len   = strlen(current);
 863     int     c     = yylex(&val, yyscanner, interp);
 864     int     count = 0;
 865
 866     while (c != '}' || count > 0) {
 867
 868         if (c == '}')
 869             count--;
 870         else if (c == '{')
 871             count++;
 872
 873         if (c <= 0)
 874             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 875                         "End of file reached while reading arguments in '%s'",
 876                         macro_name);
 877
 878         len     += strlen(val.s);
 879         current  = (char *)realloc(current, len + 1);
 880         strcat(current,val.s);
 881
 882         mem_sys_free(val.s);
 883         val.s = NULL;
 884         c = yylex(&val, yyscanner, interp);
 885     }
 886
 887     if (valp)
 888         *valp = val;
 889     else
 890         mem_sys_free(val.s);
 891
 892     return current;
 893 }
 894
 895 static int
 896 read_params(YYSTYPE *valp, PARROT_INTERP, params_t *params,
 897              ARGIN(const char *macro_name), int need_id, void *yyscanner)
 898 {
 899     YYSTYPE  val;
 900     int      len      = 0;
 901     char    *current  = str_dup("");
 902     yyguts_t *yyg     = (yyguts_t *)yyscanner;
 903     int      c        = yylex_skip(&val, interp, " \n", yyscanner);
 904
 905     params->num_param = 0;
 906
 907     /* See http://rt.perl.org/rt3/Ticket/Display.html?id=50920 for the saga of this bug. */
 908     /* For some reason, we have to use a dupe of the macro name to pass in to */
 909     /* read_params, or we get a segfault. XXX Make it stop. */
 910     macro_name = str_dup(macro_name);
 911
 912     while (c != ')') {
 913         if (YYSTATE == heredoc2)
 914             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 915                         "Heredoc in macro '%s' not allowed", macro_name);
 916
 917         if (c <= 0)
 918             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 919                         "End of file reached while reading arguments in '%s'",
 920                         macro_name);
 921         else if (c == ',') {
 922             if (params->num_param == MAX_PARAM)
 923                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 924                             "More than %d params in '%s'",
 925                             MAX_PARAM, macro_name);
 926
 927             params->name[params->num_param++] = current;
 928             current                           = str_dup("");
 929             len                               = 0;
 930
 931             c = yylex_skip(&val, interp, " \n", yyscanner);
 932         }
 933         else if (need_id && (*current || c != IDENTIFIER) && c != ' ') {
 934             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
 935                         "Parameter definition in '%s' must be IDENTIFIER",
 936                         macro_name);
 937         }
 938         else if (c == '{') {
 939             current = read_braced(&val, interp, macro_name, current, yyscanner);
 940             c       = yylex_skip(&val, interp, " \n", yyscanner);
 941             len     = strlen(current);
 942         }
 943         else {
 944             if (!need_id || c != ' ') {
 945                 len     += strlen(val.s);
 946                 current  = (char *)realloc(current, len + 1);
 947                 strcat(current, val.s);
 948             }
 949
 950             mem_sys_free(val.s);
 951             val.s = NULL;
 952             c = yylex(&val, yyscanner, interp);
 953         }
 954     }
 955
 956     params->name[params->num_param++] = current;
 957
 958     if (valp)
 959         *valp = val;
 960     else
 961         mem_sys_free(val.s);
 962
 963     return c;
 964 }
 965
 966 static int
 967 read_macro(YYSTYPE *valp, PARROT_INTERP, void *yyscanner)
 968 {
 969     int       c, start_line;
 970     params_t  params;
 971     yyguts_t * const yyg  = (yyguts_t *)yyscanner;
 972     int       start_cond  = YY_START;
 973     int       buffer_size = 0;
 974     int       buffer_used = 0;
 975
 976     BEGIN(macro);
 977
 978     c = yylex_skip(valp, interp, " ", yyscanner);
 979
 980     if (c != IDENTIFIER)
 981         IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "Macro names must be identifiers");
 982
 983     IMCC_INFO(interp)->cur_macro_name = valp->s;
 984     start_line                        = IMCC_INFO(interp)->line++;
 985
 986     memset(&params, 0, sizeof (params_t));
 987
 988     /* white space is allowed between macro and opening paren) */
 989     c = yylex_skip(valp, interp, " ", yyscanner);
 990
 991     if (c == '(') {
 992         mem_sys_free(valp->s);
 993         valp->s = NULL;
 994
 995         c = read_params(NULL, interp, &params,
 996                         IMCC_INFO(interp)->cur_macro_name, 1, yyscanner);
 997
 998         c = yylex(valp, yyscanner, interp);
 999     }
1000
1001     while (c != ENDM) {
1002         int elem_len;
1003
1004         if (c <= 0)
1005             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
1006                         "File ended before macro '%s' was complete",
1007                         IMCC_INFO(interp)->cur_macro_name);
1008
1009         PARROT_ASSERT(valp->s);
1010         elem_len = strlen(valp->s);
1011
1012         if (buffer_used) {
1013             if (buffer_used + elem_len > buffer_size) {
1014                 buffer_size += elem_len;
1015                 buffer_size <<= 1;
1016
1017                 IMCC_INFO(interp)->macro_buffer =
1018                     (char *)mem_sys_realloc(IMCC_INFO(interp)->macro_buffer,
1019                         buffer_size);
1020             }
1021         }
1022         else {
1023             buffer_size = (elem_len << 1) > 1024 ? elem_len << 1 : 1024;
1024
1025             IMCC_INFO(interp)->macro_buffer =
1026                 (char *)mem_sys_allocate_zeroed(buffer_size);
1027         }
1028         strcat(IMCC_INFO(interp)->macro_buffer, valp->s);
1029         buffer_used += elem_len;
1030         mem_sys_free(valp->s);
1031         valp->s = NULL;
1032
1033         c = yylex(valp, yyscanner, interp);
1034     }
1035
1036     mem_sys_free(valp->s);
1037     valp->s = NULL;
1038
1039     BEGIN(start_cond);
1040
1041     define_macro(interp, IMCC_INFO(interp)->cur_macro_name,
1042                  &params, IMCC_INFO(interp)->macro_buffer, start_line);
1043
1044     mem_sys_free(IMCC_INFO(interp)->macro_buffer);
1045     IMCC_INFO(interp)->macro_buffer = NULL;
1046     IMCC_INFO(interp)->cur_macro_name = NULL;
1047
1048     return MACRO;
1049 }
1050
1051 static char *
1052 find_macro_param(PARROT_INTERP, const char *name)
1053 {
1054     macro_frame_t *f;
1055
1056     for (f = IMCC_INFO(interp)->frames; f; f = (macro_frame_t *)f->s.next) {
1057         if (f->params) {
1058             int i;
1059             for (i = 0; i < f->params->num_param; i++) {
1060                 if (STREQ(f->params->name[i], name))
1061                     return f->expansion.name[i];
1062             }
1063         }
1064     }
1065
1066     return NULL;
1067 }
1068
1069 static void
1070 define_macro(PARROT_INTERP, ARGIN(const char *name), ARGIN(const params_t *params),
1071              ARGIN(const char *expansion), int start_line)
1072 {
1073     macro_t *m = find_macro(interp, name);
1074
1075     if (m) {
1076         mem_sys_free(m->expansion);
1077         m->expansion = NULL;
1078     }
1079     else {
1080         m = mem_allocate_zeroed_typed(macro_t);
1081
1082         if (!IMCC_INFO(interp)->macros)
1083             parrot_new_cstring_hash(interp, &IMCC_INFO(interp)->macros);
1084         parrot_hash_put(interp, IMCC_INFO(interp)->macros, str_dup(name), m);
1085     }
1086
1087     if (params)
1088         m->params = *params;
1089     else
1090         memset(&m->params, 0, sizeof (params_t));
1091
1092     m->expansion = str_dup(expansion);
1093     m->line      = start_line;
1094 }
1095
1096 static macro_t *
1097 find_macro(PARROT_INTERP, const char *name)
1098 {
1099     if (!IMCC_INFO(interp)->macros)
1100         return NULL;
1101
1102     return (macro_t *)parrot_hash_get(interp, IMCC_INFO(interp)->macros, name);
1103 }
1104
1105 static int
1106 expand_macro(PARROT_INTERP, ARGIN(const char *name), void *yyscanner)
1107 {
1108     yyguts_t   * const yyg       = (yyguts_t *)yyscanner;
1109     const char * const expansion = find_macro_param(interp, name);
1110     macro_t    *m;
1111
1112     if (expansion) {
1113         macro_frame_t * const frame = new_frame(interp);
1114
1115         /* When an error occurs, then report it as being in a macro */
1116         frame->is_macro = 1;
1117         scan_string(frame, expansion, yyscanner);
1118         return 1;
1119     }
1120
1121     m = find_macro(interp, name);
1122     if (m) {
1123         int i,c,start_cond;
1124
1125         macro_frame_t * const frame = new_frame(interp);
1126         frame->params               = &m->params;
1127
1128         /* When an error occurs, then report it as being in a macro */
1129         frame->is_macro = 1;
1130
1131         /* remember macro name for error reporting
1132         RT #42384 check that all the .file text is malloced / freed */
1133         frame->s.file = str_dup(name);
1134
1135         /* whitespace can be safely ignored */
1136         do {
1137 #ifdef __cplusplus
1138             c = yyinput(yyscanner);
1139 #else
1140             c = input(yyscanner);
1141 #endif
1142         } while (c == ' ' || c == '\t');
1143
1144         if (c != '(') {
1145             if (m->params.num_param != 0)
1146                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
1147                             "Macro '%s' needs %d arguments",
1148                             name, m->params.num_param);
1149             unput(c);
1150             scan_string(frame, m->expansion, yyscanner);
1151             return 1;
1152         }
1153
1154         start_cond = YY_START;
1155         BEGIN(macro);
1156
1157         read_params(NULL, interp, &frame->expansion, name, 0, yyscanner);
1158
1159         BEGIN(start_cond);
1160
1161         if (frame->expansion.num_param == 0 && m->params.num_param == 1) {
1162             frame->expansion.name[0] = str_dup("");
1163             frame->expansion.num_param = 1;
1164         }
1165
1166         if (frame->expansion.num_param != m->params.num_param) {
1167             IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
1168                         "Macro '%s' requires %d arguments, but %d given",
1169                         name, m->params.num_param, frame->expansion.num_param);
1170         }
1171
1172         /* expand arguments */
1173         for (i = 0; i < frame->expansion.num_param; i++) {
1174             char * const current = frame->expansion.name[i];
1175
1176             /* parameter of outer macro */
1177             if (current[0] == '.') {
1178                 const char * const s = find_macro_param(interp, current + 1);
1179
1180                 if (s) {
1181                     frame->expansion.name[i] = str_dup(s);
1182                     mem_sys_free(current);
1183                 }
1184
1185             }
1186             else {
1187                 const size_t len = strlen(current);
1188                 if (len && (current[len - 1] == '$')) { /* local label */
1189                     const size_t slen = len + 10;
1190                     char * const s    = (char *)mem_sys_allocate(slen);
1191
1192                     current[len - 1] = '\0';
1193
1194                     snprintf(s, slen, "%s%d", current, IMCC_INFO(interp)->frames->label);
1195
1196                     frame->expansion.name[i] = s;
1197                     mem_sys_free(current);
1198                 }
1199             }
1200         }
1201
1202         IMCC_INFO(interp)->line = m->line;
1203         scan_string(frame, m->expansion, yyscanner);
1204         return 1;
1205     }
1206
1207     return 0;
1208 }
1209
1210 static void
1211 include_file(PARROT_INTERP, char *file_name, void *yyscanner)
1212 {
1213     yyguts_t      * const yyg   = (yyguts_t *)yyscanner;
1214     macro_frame_t * const frame = new_frame(interp);
1215     char *s              = Parrot_locate_runtime_file(interp, file_name,
1216                                    PARROT_RUNTIME_FT_INCLUDE);
1217     char *ext;
1218     FILE *file;
1219
1220     if (!s || !(file = fopen(s, "r")))
1221         IMCC_fataly(interp, EXCEPTION_EXTERNAL_ERROR, strerror(errno));
1222
1223     mem_sys_free(s);
1224     frame->s.file   = file_name;
1225     frame->s.handle = file;
1226     ext             = strrchr(file_name, '.');
1227
1228     if (ext) {
1229         if (STREQ(ext, ".pasm")) {
1230             frame->s.pasm_file = 1;
1231             BEGIN(emit);
1232         }
1233         else if (STREQ(ext, ".pir")) {
1234             frame->s.pasm_file = 0;
1235             BEGIN(INITIAL);
1236         }
1237     }
1238
1239     scan_file(interp, frame, file, yyscanner);
1240 }
1241
1242 static void
1243 scan_file(PARROT_INTERP, macro_frame_t *frame, FILE *file, void *yyscanner)
1244 {
1245     yyguts_t * const yyg      = (yyguts_t *)yyscanner;
1246     frame->buffer             = YY_CURRENT_BUFFER;
1247     frame->s.next             = (parser_state_t *)IMCC_INFO(interp)->frames;
1248     IMCC_INFO(interp)->frames = frame;
1249     IMCC_INFO(interp)->state  = (parser_state_t *)IMCC_INFO(interp)->frames;
1250
1251     IMCC_INFO(interp)->line   = 1;
1252
1253     yy_switch_to_buffer(yy_create_buffer(file, YY_BUF_SIZE, yyscanner),
1254         yyscanner);
1255 }
1256
1257 void
1258 IMCC_push_parser_state(PARROT_INTERP)
1259 {
1260     macro_frame_t * const frame = new_frame(interp);
1261     frame->s.next             = (parser_state_t *)IMCC_INFO(interp)->frames;
1262     IMCC_INFO(interp)->frames = frame;
1263     frame->s.line             = IMCC_INFO(interp)->line
1264                               = 1;
1265     IMCC_INFO(interp)->state  = (parser_state_t *)IMCC_INFO(interp)->frames;
1266 }
1267
1268 static void
1269 pop_parser_state(PARROT_INTERP, void *yyscanner)
1270 {
1271     macro_frame_t * const tmp = IMCC_INFO(interp)->frames;
1272     if (tmp) {
1273         int l;
1274         if (tmp->s.handle)
1275             fclose(tmp->s.handle);
1276
1277         IMCC_INFO(interp)->frames =
1278             (macro_frame_t *)IMCC_INFO(interp)->frames->s.next;
1279
1280         l = destroy_frame(tmp, yyscanner);
1281
1282         if (l)
1283             IMCC_INFO(interp)->line = l;
1284     }
1285
1286     IMCC_INFO(interp)->state = (parser_state_t *)IMCC_INFO(interp)->frames;
1287 }
1288
1289 void
1290 IMCC_pop_parser_state(PARROT_INTERP, void *yyscanner)
1291 {
1292     pop_parser_state(interp, yyscanner);
1293 }
1294
1295 void
1296 compile_file(PARROT_INTERP, FILE *file, void *yyscanner)
1297 {
1298     yyguts_t * const yyg = (yyguts_t *)yyscanner;
1299     YY_BUFFER_STATE  buffer;
1300
1301     IMCC_INFO(interp)->frames->s.next = NULL;
1302     buffer                            = YY_CURRENT_BUFFER;
1303
1304     yy_switch_to_buffer(yy_create_buffer(file, YY_BUF_SIZE, yyscanner),
1305         yyscanner);
1306
1307     emit_open(interp, 1, NULL);
1308
1309     IMCC_TRY(IMCC_INFO(interp)->jump_buf, IMCC_INFO(interp)->error_code) {
1310         yyparse(yyscanner, interp);
1311         imc_compile_all_units(interp);
1312     }
1313
1314     IMCC_CATCH(IMCC_FATAL_EXCEPTION) {
1315         IMCC_INFO(interp)->error_code = IMCC_FATAL_EXCEPTION;
1316     }
1317
1318     IMCC_CATCH(IMCC_FATALY_EXCEPTION) {
1319         IMCC_INFO(interp)->error_code = IMCC_FATALY_EXCEPTION;
1320     }
1321
1322     IMCC_END_TRY;
1323
1324     if (buffer)
1325         yy_switch_to_buffer(buffer, yyscanner);
1326 }
1327
1328 void
1329 compile_string(PARROT_INTERP, const char *s, void *yyscanner)
1330 {
1331     yyguts_t * const yyg = (yyguts_t *)yyscanner;
1332     YY_BUFFER_STATE  buffer;
1333
1334     IMCC_INFO(interp)->frames->s.next = NULL;
1335     buffer                            = YY_CURRENT_BUFFER;
1336
1337     yy_scan_string(s, yyscanner);
1338     emit_open(interp, 1, NULL);
1339
1340     IMCC_TRY(IMCC_INFO(interp)->jump_buf, IMCC_INFO(interp)->error_code) {
1341         yyparse(yyscanner, interp);
1342         imc_compile_all_units(interp);
1343     }
1344
1345     IMCC_CATCH(IMCC_FATAL_EXCEPTION) {
1346         IMCC_INFO(interp)->error_code = IMCC_FATAL_EXCEPTION;
1347     }
1348
1349     IMCC_CATCH(IMCC_FATALY_EXCEPTION) {
1350         IMCC_INFO(interp)->error_code = IMCC_FATALY_EXCEPTION;
1351     }
1352
1353     IMCC_END_TRY;
1354
1355     if (buffer)
1356         yy_switch_to_buffer(buffer, yyscanner);
1357 }
1358
1359 void
1360 IMCC_print_inc(PARROT_INTERP)
1361 {
1362     macro_frame_t *f;
1363     const char    *old = IMCC_INFO(interp)->frames->s.file;
1364
1365     if (IMCC_INFO(interp)->frames && IMCC_INFO(interp)->frames->is_macro)
1366         fprintf(stderr, "\n\tin macro '.%s' line %d\n",
1367                 IMCC_INFO(interp)->frames->s.file, IMCC_INFO(interp)->line);
1368     else
1369         fprintf(stderr, "\n\tin file '%s' line %d\n",
1370                 IMCC_INFO(interp)->frames->s.file, IMCC_INFO(interp)->line);
1371
1372
1373     for (f = IMCC_INFO(interp)->frames; f; f = (macro_frame_t *)f->s.next) {
1374         if (!STREQ(f->s.file, old)) {
1375             fprintf(stderr, "\tincluded from '%s' line %d\n",
1376                     f->s.file, f->s.line);
1377         }
1378
1379         old = f->s.file;
1380     }
1381 }
1382
1383 /* Functions to set and get yyin, as we can't decorate it for export
1384    (since it is defined in a file generated by yacc/bison). */
1385 FILE* imc_yyin_set(FILE* new_yyin, void *yyscanner)
1386 {
1387     yyguts_t * const yyg = (yyguts_t *)yyscanner;
1388     yyg->yyin_r   = new_yyin;
1389
1390     return yyg->yyin_r;
1391 }
1392
1393 FILE* imc_yyin_get(void *yyscanner)
1394 {
1395     const yyguts_t * const yyg = (yyguts_t *)yyscanner;
1396     return yyg->yyin_r;
1397 }
1398
1399 /* return true if scanner is at EOF */
1400 int at_eof(yyscan_t yyscanner)
1401 {
1402     yyguts_t * const yyg = (yyguts_t *)yyscanner;
1403     return yyg->yy_hold_char == '\0';
1404 }
1405
1406 /*
1407  * Local variables:
1408  *   c-file-style: "parrot"
1409  * End:
1410  * vim: expandtab shiftwidth=4:
1411  */