imcc.l

%top{

/* ex: set ro ft=c:
 * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 *
 * This file is generated automatically by the Parrot build process
 * from the file compilers/imcc/imcc.l.
 *
 * Any changes made here will be lost!
 *
*/

/* HEADERIZER HFILE: none */
/* HEADERIZER STOP */

#ifndef __STDC_VERSION__
#  define __STDC_VERSION__ 0
#endif

}

%{
/*
 * imcc.l
 *
 * Intermediate Code Compiler for Parrot
 *
 * Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
 * Copyright (C) 2002-2008, The Perl Foundation.
 *
 * The tokenizer.
 *
 * $Id$
 *
 */


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "imc.h"
#include "parser.h"

typedef struct yyguts_t       yyguts_t;
typedef struct parser_state_t parser_state_t;

/* parser state structure
 * the first few items are common to struct parser_state, but
 * we AFAIK need this hack as flex doesn't export YY_BUFFER_STATE */
typedef struct macro_frame_t {
    struct parser_state_t s;

    /* macro stuff */
    params_t       *params;
    char           *heredoc_rest;

    params_t        expansion;
    int             label;
    int             is_macro;
    YY_BUFFER_STATE buffer;
} macro_frame_t;

/* static function declarations */
static void pop_parser_state(PARROT_INTERP, ARGMOD(void *yyscanner));

static struct macro_frame_t *new_frame(PARROT_INTERP);

static void define_macro(PARROT_INTERP, ARGIN(const char *name), ARGIN(const params_t *params),
        ARGIN(const char *expansion), int start_line);

static macro_t *find_macro(PARROT_INTERP, ARGIN(const char *name));

static void scan_string(macro_frame_t *frame, ARGIN(const char *expansion),
        ARGMOD(void *yyscanner));

static void scan_file(PARROT_INTERP, ARGIN(struct macro_frame_t *frame), ARGMOD(FILE *file),
        ARGMOD(void *yyscanner));

static int destroy_frame(macro_frame_t *frame, ARGMOD(void *yyscanner));

static int yylex_skip(YYSTYPE *valp, PARROT_INTERP, ARGIN(const char *skip),
        ARGMOD(void *yyscanner));

static int read_macro(YYSTYPE *valp, PARROT_INTERP, ARGMOD(void *yyscanner));

static int expand_macro(PARROT_INTERP, ARGIN(const char *name), ARGMOD(void *yyscanner));

static void include_file(PARROT_INTERP, char *file_name, ARGMOD(void *yyscanner));

#define YY_DECL int yylex(YYSTYPE *valp, yyscan_t yyscanner, PARROT_INTERP)

#define YYCHOP() (yytext[--yyleng] = '\0')

#define DUP_AND_RET(valp, token)             \
  do {                                       \
      if (valp) (valp)->s = str_dup(yytext); \
      return (token);                        \
  } while (0)

#define DUP_AND_RET_FREE(valp, token)        \
  do {                                       \
      if (valp) {                            \
          mem_sys_free((valp)->s);           \
          (valp)->s = str_dup(yytext);       \
          return (token);                    \
      }                                      \
  } while (0)

%}

%option reentrant
%option never-interactive
%option stack

LETTER          [a-zA-Z_@]
DIGIT           [0-9]
DIGITS          {DIGIT}+
HEX             0[xX][0-9A-Fa-f]+
OCT             0[oO][0-7]+
BIN             0[bB][01]+
DOT             [.]
SIGN            [-+]
BIGINT          {SIGN}?{DIGITS}"L"
FLOATNUM        {SIGN}?(({DIGITS}{DOT}{DIGIT}*|{DOT}{DIGITS})([eE]{SIGN}?{DIGITS})?|{DIGITS}[eE]{SIGN}?{DIGITS})
LETTERDIGIT     [a-zA-Z0-9_]
LABELLETTERDIGIT([a-zA-Z0-9_@])
ID              {LETTER}{LABELLETTERDIGIT}*
DQ_STRING       \"(\\.|[^"\\\n])*\"
ENCCHAR         {LETTER}|{DIGIT}|"-"
ENCCHARS        {ENCCHAR}*
ENC             {LETTER}{ENCCHARS}":"
UNICODE         {ENC}{ENC}?{DQ_STRING}
STRINGCONSTANT  {SQ_STRING}|{DQ_STRING}
SQ_STRING       \'[^'\n]*\'
RANKSPEC        \[[,]*\]
EOL        \r?\n
WS              [\t\f\r\x1a ]
SP              [ ]

%x emit
%x macro
%x pod
%x cmt1
%x cmt2
%x cmt3
%x cmt4
%x cmt5
%x heredoc1
%x heredoc2


%%
        /* for emacs "*/
        if (IMCC_INFO(interp)->expect_pasm == 1 && !IMCC_INFO(interp)->in_pod) {
            IMCC_INFO(interp)->expect_pasm = 2;
            BEGIN(emit);
        }

        if (IMCC_INFO(interp)->frames->s.pasm_file && YYSTATE == INITIAL &&
            !IMCC_INFO(interp)->in_pod)
        {
            if (IMCC_INFO(interp)->frames->s.pasm_file == 1) {
                BEGIN(emit);
                return EMIT;
            }

            return 0;
        }

<heredoc1>.*{EOL} {
            IMCC_INFO(interp)->frames->heredoc_rest = str_dup(yytext);
            BEGIN(heredoc2);
    }

<heredoc2>{EOL} {
        /* heredocs have highest priority
         * arrange them befor all wildcard state matches
         */

        /* Newline in the heredoc. Realloc and cat on. */
        IMCC_INFO(interp)->line++;
        IMCC_INFO(interp)->heredoc_content =
            (char*)mem_sys_realloc(IMCC_INFO(interp)->heredoc_content,
                            strlen(IMCC_INFO(interp)->heredoc_content) +
                            strlen(yytext) + 2);
        strcpy(IMCC_INFO(interp)->heredoc_content +
               strlen(IMCC_INFO(interp)->heredoc_content), yytext);
    }

<heredoc2>.* {
        /* Are we at the end of the heredoc? */
        if (STREQ(IMCC_INFO(interp)->heredoc_end, yytext)) {
            /* End of the heredoc. */
            yyguts_t * const yyg = (yyguts_t *)yyscanner;
            const int len        = strlen(IMCC_INFO(interp)->heredoc_content);

            /* delim */
            IMCC_INFO(interp)->heredoc_content[len] =
                IMCC_INFO(interp)->heredoc_content[0];

            IMCC_INFO(interp)->heredoc_content[len + 1] = 0;

            mem_sys_free(IMCC_INFO(interp)->heredoc_end);
            IMCC_INFO(interp)->heredoc_end = NULL;

            IMCC_INFO(interp)->frames->buffer = YY_CURRENT_BUFFER;
            valp->s                           =
                IMCC_INFO(interp)->heredoc_content;

            yy_pop_state(yyscanner);
            yy_scan_string(IMCC_INFO(interp)->frames->heredoc_rest, yyscanner);

            /* RT #42382 delete quotes, -> emit, pbc */
            return STRINGC;
        }
        else {
            /* Part of the heredoc. Realloc and cat the line on. */
            IMCC_INFO(interp)->heredoc_content =
                (char *)mem_sys_realloc(IMCC_INFO(interp)->heredoc_content,
                                strlen(IMCC_INFO(interp)->heredoc_content) +
                                strlen(yytext) + 2);
            strcpy(IMCC_INFO(interp)->heredoc_content +
                   strlen(IMCC_INFO(interp)->heredoc_content), yytext);
        }
    }

<cmt2>[^"]+ {
        yy_pop_state(yyscanner);
        yy_push_state(cmt3, yyscanner);

        IMCC_INFO(interp)->frames->s.file = str_dup(yytext);
        IMCC_INFO(interp)->frames->s.file_needs_free = 1;
        IMCC_INFO(interp)->cur_unit->file = str_dup(yytext);

        return FILECOMMENT;
    }

<cmt3>["] {
        yy_pop_state(yyscanner);
        yy_push_state(cmt4, yyscanner);
    }

<*>setfile{SP}+["] { yy_push_state(cmt2, yyscanner); }

<*>setline{SP}+ { yy_push_state(cmt1, yyscanner);  }

<cmt1>{DIGITS} {
        IMCC_INFO(interp)->line = atoi(yytext);
        yy_pop_state(yyscanner);
        yy_push_state(cmt4, yyscanner);
        return LINECOMMENT;
    }

<cmt4>.*{EOL} {
        yy_pop_state(yyscanner);
        IMCC_INFO(interp)->line++;
    }

<INITIAL,emit>{EOL} {
        if (IMCC_INFO(interp)->expect_pasm == 2)
            BEGIN(INITIAL);

        IMCC_INFO(interp)->expect_pasm = 0;
        IMCC_INFO(interp)->line++;

        return '\n';
    }

<INITIAL,emit># {
        yy_push_state(cmt5, yyscanner);
    }

<cmt5>.*{EOL} {
        if (IMCC_INFO(interp)->expect_pasm == 2)
            BEGIN(INITIAL);
        else
            yy_pop_state(yyscanner);

        IMCC_INFO(interp)->expect_pasm = 0;
        IMCC_INFO(interp)->line++;

        return '\n';
    }




<INITIAL,emit,macro>^"=" {
        IMCC_INFO(interp)->in_pod = 1;
        yy_push_state(pod, yyscanner);
    }

<pod>^"=cut"{EOL} {
        IMCC_INFO(interp)->in_pod = 0;
        yy_pop_state(yyscanner);
        IMCC_INFO(interp)->line++;
    }

<pod>.*         { /*ignore*/ }

<pod>{EOL}      { IMCC_INFO(interp)->line++; }

<*>".line"               return TK_LINE;
<*>".file"               return TK_FILE;
<INITIAL,emit>".annotate" return ANNOTATE;
<INITIAL,emit>".lex"     return LEXICAL;
".set_arg"               return ARG;
".sub"                   return SUB;
".end"                   return ESUB;
".begin_call"            return PCC_BEGIN;
".end_call"              return PCC_END;
".call"                  return PCC_CALL;
".nci_call"              return NCI_CALL;
".meth_call"             return METH_CALL;
".invocant"              return INVOCANT;
<emit,INITIAL>".pcc_sub" return PCC_SUB;
".begin_return"          return PCC_BEGIN_RETURN;
".end_return"            return PCC_END_RETURN;
".begin_yield"           return PCC_BEGIN_YIELD;
".end_yield"             return PCC_END_YIELD;

<emit,INITIAL>":method"    return METHOD;
<emit,INITIAL>":multi"     return MULTI;
<emit,INITIAL>":main"      return MAIN;
<emit,INITIAL>":load"      return LOAD;
<emit,INITIAL>":init"      return INIT;
<emit,INITIAL>":immediate" return IMMEDIATE;
<emit,INITIAL>":postcomp"  return POSTCOMP;
<emit,INITIAL>":anon"      return ANON;
<emit,INITIAL>":outer"     return OUTER;
<emit,INITIAL>":lex"       return NEED_LEX;
<emit,INITIAL>":vtable"    return VTABLE_METHOD;
<emit,INITIAL>":nsentry"   return NS_ENTRY;
":unique_reg"              return UNIQUE_REG;
":instanceof"              return SUB_INSTANCE_OF;
":subid"                   return SUBID;

".get_result"                  return RESULT;
".get_results"             return GET_RESULTS;
".yield"                   return YIELDT;
".set_yield"               return SET_YIELD;
".return"                  return RETURN;
".set_return"              return SET_RETURN;
".tailcall"                return TAILCALL;
<emit,INITIAL>".loadlib"   return LOADLIB;

":flat"         return ADV_FLAT;
":slurpy"       return ADV_SLURPY;
":optional"     return ADV_OPTIONAL;
":opt_flag"     return ADV_OPT_FLAG;
":named"        return ADV_NAMED;
"=>"            return ADV_ARROW;
":invocant"     return ADV_INVOCANT;

<emit,INITIAL>".namespace"    return NAMESPACE;
<emit,INITIAL>".HLL"          return HLL;
<emit,INITIAL>".HLL_map"      return HLL_MAP;

".local"                      return LOCAL;
<emit,INITIAL>".const"        return CONST;
".globalconst"                return GLOBAL_CONST;
".param"                      return PARAM;
"goto"                        return GOTO;
"if"                          return IF;
"unless"                      return UNLESS;
"null"                        return PNULL;
"int"                         return INTV;
"num"                         return FLOATV;

"pmc"                         return PMCV;
"string"                      return STRINGV;
"<<"                          return SHIFT_LEFT;
">>"                          return SHIFT_RIGHT;
">>>"                         return SHIFT_RIGHT_U;
"&&"                          return LOG_AND;
"||"                          return LOG_OR;
"~~"                          return LOG_XOR;
"<"                           return RELOP_LT;
"<="                          return RELOP_LTE;
">"                           return RELOP_GT;
">="                          return RELOP_GTE;
"=="                          return RELOP_EQ;
"!="                          return RELOP_NE;
"**"                          return POW;

{WS}+"."{WS}+          return CONCAT;
"."                    return DOT;

"+="                   return PLUS_ASSIGN;
"-="                   return MINUS_ASSIGN;
"*="                   return MUL_ASSIGN;
"/="                   return DIV_ASSIGN;
"%="                   return MOD_ASSIGN;
"//"                   return FDIV;
"//="                  return FDIV_ASSIGN;
"&="                   return BAND_ASSIGN;
"|="                   return BOR_ASSIGN;
"~="                   return BXOR_ASSIGN;
">>="                  return SHR_ASSIGN;
"<<="                  return SHL_ASSIGN;
">>>="                 return SHR_U_ASSIGN;
".="                   return CONCAT_ASSIGN;

<emit,INITIAL>".macro_const" {
        int c;
        int start_line;
        int start_cond  = YY_START;

        BEGIN(macro);
        c = yylex_skip(valp, interp, " ", yyscanner);

        if (c != IDENTIFIER)
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
               "Constant names must be identifiers");

        IMCC_INFO(interp)->cur_macro_name = valp->s;
        start_line                        = IMCC_INFO(interp)->line;

        c = yylex_skip(valp, interp, " ", yyscanner);

        if (c != INTC && c != FLOATC && c != STRINGC && c != REG)
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                "Constant '%s' value must be a number, "
                "stringliteral or register", IMCC_INFO(interp)->cur_macro_name);

        define_macro(interp, IMCC_INFO(interp)->cur_macro_name, NULL, valp->s, start_line);

        IMCC_INFO(interp)->cur_macro_name = NULL;

        BEGIN(start_cond);
        return MACRO;
    }

<emit,INITIAL>".macro" {
        return read_macro(valp, interp, yyscanner);
    }

<emit,INITIAL>".include" {
        const int c = yylex(valp, yyscanner, interp);
        if (c != STRINGC)
            return c;

        YYCHOP();
        include_file(interp, yytext + 1, yyscanner);
    }

<emit,INITIAL>{ID}"$:" {
        if (valp) {
            char *label;
            size_t len;

            YYCHOP();
            YYCHOP();

            if (!IMCC_INFO(interp)->frames || !IMCC_INFO(interp)->frames->label)
                    IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "missing space?");

            len = yyleng + 10;
            label = (char *)mem_sys_allocate(len);
            snprintf(label, len, "%s%d", yytext, IMCC_INFO(interp)->frames->label);

            /* XXX: free valp->s if it exists? */
            valp->s = label;
        }

        return LABEL;
    }

<emit,INITIAL>{ID}"$" {

        if (valp) {
            char *label;
            size_t len;
            YYCHOP();

            /* RT #32421   if$I0 is parsed as if$ I0 */
            if (!IMCC_INFO(interp)->frames || !IMCC_INFO(interp)->frames->label)
                IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "missing space?");

            len = yyleng + 10;
            label = (char *)mem_sys_allocate(len);
            snprintf(label, len, "%s%d", yytext, IMCC_INFO(interp)->frames->label);

            /* XXX: free valp->s if it exists? */
            valp->s = label;
        }

        return IDENTIFIER;
     }

<emit,INITIAL>","             return COMMA;

<emit,INITIAL>{ID}":" {
        /* trim last ':' */
        YYCHOP();

        if (valp)
            valp->s = yytext;

        return LABEL;
    }

<emit,INITIAL>{DOT}{LETTER}{LETTERDIGIT}* {
        char   * const macro_name = yytext + 1;

        if (!expand_macro(interp, macro_name, yyscanner)) {
            yyless(1);
            return DOT;
        }
    }



<*>{FLOATNUM}         DUP_AND_RET(valp, FLOATC);
<*>{SIGN}?{DIGIT}+    DUP_AND_RET(valp, INTC);
<*>{HEX}              DUP_AND_RET(valp, INTC);
<*>{BIN}              DUP_AND_RET(valp, INTC);
<*>{OCT}              DUP_AND_RET(valp, INTC);

<*>{BIGINT} {
        valp->s = str_dup(yytext);

        /* trailing 'L' */
        valp->s[strlen(valp->s) - 1] = '\0';

        /* no BIGINT native format yet */
        return STRINGC;
    }

<*>{STRINGCONSTANT} {
        valp->s = str_dup(yytext);

        /* RT #42382 delete quotes, -> emit, pbc */
        return STRINGC;
    }

<*>"<<"{STRINGCONSTANT} {
        macro_frame_t *frame;

        /* Save the string we want to mark the end of the heredoc and snip
           off newline and quote. */
        if (IMCC_INFO(interp)->frames->heredoc_rest)
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "nested heredoc not supported");
        IMCC_INFO(interp)->heredoc_end = str_dup(yytext + 3);
        IMCC_INFO(interp)->heredoc_end[strlen(IMCC_INFO(interp)->heredoc_end) - 1] = 0;

        if (!strlen(IMCC_INFO(interp)->heredoc_end))
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "empty heredoc delimiter");

        frame                     = new_frame(interp);
        frame->s.next             = (parser_state_t *)IMCC_INFO(interp)->frames;
        IMCC_INFO(interp)->frames = frame;

        /* Start slurping up the heredoc. */
        IMCC_INFO(interp)->heredoc_content    = (char *)mem_sys_allocate(2);

        /* preserve delim */
        IMCC_INFO(interp)->heredoc_content[0] = yytext[2];

        /* eos */
        IMCC_INFO(interp)->heredoc_content[1] = 0;
        yy_push_state(heredoc1, yyscanner);
    }

<*>{UNICODE} {
        /* charset:"..." */
        valp->s = str_dup(yytext);

        /* this is actually not unicode but a string with a charset */
        return USTRINGC;
    }

<emit,INITIAL>\$I[0-9]+ {
        if (valp) (valp)->s = yytext;
        if (IMCC_INFO(interp)->state->pasm_file)
                IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                    "'%s' is not a valid register name in pasm mode", yytext);
        return IREG;
    }

<emit,INITIAL>\$N[0-9]+ {
        if (valp) (valp)->s = yytext;
        if (IMCC_INFO(interp)->state->pasm_file)
                IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                    "'%s' is not a valid register name in pasm mode", yytext);
        return NREG;
    }

<emit,INITIAL>\$S[0-9]+ {
        if (valp) (valp)->s = yytext;
        if (IMCC_INFO(interp)->state->pasm_file)
                IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                    "'%s' is not a valid register name in pasm mode", yytext);
        return SREG;
    }

<emit,INITIAL>\$P[0-9]+ {
        if (valp) (valp)->s = yytext;
        if (IMCC_INFO(interp)->state->pasm_file)
                IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                    "'%s' is not a valid register name in pasm mode", yytext);
        return PREG;
    }

<emit,INITIAL>\$[a-zA-Z0-9]+ {
        IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
            "'%s' is not a valid register name", yytext);
    }

<emit,INITIAL>[ISNP]{DIGIT}{DIGIT}? {
        if (IMCC_INFO(interp)->state->pasm_file == 0)
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
            "'%s' is only a valid register name in PASM mode", yytext);

        if (valp)
            valp->s = str_dup(yytext);

        return REG;
    }

<emit,INITIAL>{ID} {
        if (!is_def) {
            SymReg *r = find_sym(interp, yytext);

            if (r && (r->type & (VTIDENTIFIER|VT_CONSTP))) {
                valp->sr = r;
                return VAR;
            }

            if (IMCC_INFO(interp)->cur_unit
            &&  IMCC_INFO(interp)->cur_unit->instructions
            && (r = IMCC_INFO(interp)->cur_unit->instructions->symregs[0])
            &&  r->pcc_sub)
            {
                if (((r->pcc_sub->pragma & P_METHOD)
                ||   (IMCC_INFO(interp)->cur_unit->is_vtable_method))
                &&   !strcmp(yytext, "self")) {
                    valp->sr = mk_ident(interp, "self", 'P');
                    IMCC_INFO(interp)->cur_unit->type |= IMC_HAS_SELF;
                    return VAR;
                }
            }
        }

        valp->s = str_dup(yytext);
        return (!is_def && is_op(interp, valp->s) ? PARROT_OP : IDENTIFIER);
    }


<emit,INITIAL>{WS}+ /* skip */;

<emit,cmt1,cmt2,cmt3,cmt4,cmt5,INITIAL>. {
        /* catch all except for state macro */
        return yytext[0];
    }

<emit><<EOF>> {
        BEGIN(INITIAL);

        if (IMCC_INFO(interp)->frames->s.pasm_file) {
            IMCC_INFO(interp)->frames->s.pasm_file = 2;
            return EOM;
        }

        return 0;
    }

<INITIAL><<EOF>> yyterminate();

<macro>".endm"         DUP_AND_RET(valp, ENDM);

<macro>{WS}*{EOL} {
        IMCC_INFO(interp)->line++;
        DUP_AND_RET(valp, '\n');
    }

<macro>"$"{ID}":"  return LABEL;

<macro>".label"{WS}+ {

        if (yylex(valp, yyscanner, interp) != LABEL)
                IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "LABEL expected");

        if (valp) {
            char *label;
            size_t len;
            YYCHOP();

            len = strlen(IMCC_INFO(interp)->cur_macro_name) + yyleng + 15;
            label = (char *)mem_sys_allocate(len);

            snprintf(label, len, "local__%s__%s__$:",
                IMCC_INFO(interp)->cur_macro_name, yytext+1);

            /* XXX: free valp->s if it exists? */
            valp->s = label;
        }

        return LABEL;
    }

<macro>".$"{ID} {
        if (valp) {
            const size_t len = strlen(IMCC_INFO(interp)->cur_macro_name) + yyleng + 12;
            char * const label = (char *)mem_sys_allocate(len);

            snprintf(label, len, "local__%s__%s__$",
                IMCC_INFO(interp)->cur_macro_name, yytext+2);

            valp->s = label;
        }

        return IDENTIFIER;
    }

<macro>^{WS}+                       /* skip leading ws */;
<macro>{WS}+                        DUP_AND_RET(valp, ' ');
<macro>[SNIP]{DIGITS}               DUP_AND_RET(valp, REG);
<macro>"$"[SNIP]{DIGITS}            DUP_AND_RET(valp, REG);
<macro>{ID}                         DUP_AND_RET(valp, IDENTIFIER);
<macro>{DOT}{ID}                    DUP_AND_RET(valp, MACRO);
<macro>.                            DUP_AND_RET(valp, yytext[0]);
<macro><<EOF>>                      yyterminate();

%%

#ifdef yywrap
#  undef yywrap
#endif

int yywrap(void* yyscanner) {
    /* Add code here to open next source file and start scanning
     * yywrap returns 0 if scanning is to continue */
    Interp   * const interp = yyget_extra(yyscanner);
    yyguts_t * const yyg    = (yyguts_t *)yyscanner;

    if (!interp) {
        fprintf(stderr, "Argh, interp not found\n");
        exit(1);
    }

    yy_delete_buffer(YY_CURRENT_BUFFER, yyscanner);

    /* pop old frame */
    if (IMCC_INFO(interp)->frames->s.next) {
        pop_parser_state(IMCC_INFO(interp)->frames->s.interp, yyscanner);
        if (YYSTATE == INITIAL || YYSTATE == emit)
            BEGIN(IMCC_INFO(interp)->frames->s.pasm_file ? emit : INITIAL);
        return 0;
    }

    return 1;
}

static macro_frame_t *
new_frame(PARROT_INTERP) {
    static int label   = 0;
    macro_frame_t * const tmp = mem_allocate_zeroed_typed(macro_frame_t);

    tmp->label         = ++label;
    tmp->s.line        = IMCC_INFO(interp)->line;
    tmp->s.handle      = NULL;

    if (IMCC_INFO(interp)->frames) {
        tmp->s.pasm_file = IMCC_INFO(interp)->frames->s.pasm_file;
        if (IMCC_INFO(interp)->frames->s.file_needs_free)
            tmp->s.file = str_dup(IMCC_INFO(interp)->frames->s.file);
        else
            tmp->s.file = IMCC_INFO(interp)->frames->s.file;
        tmp->s.file_needs_free = IMCC_INFO(interp)->frames->s.file_needs_free;
    }

    tmp->s.interp = interp;

    return tmp;
}

static void
scan_string(macro_frame_t *frame, ARGIN(const char *expansion), void *yyscanner)
{
    yyguts_t * const yyg      = (yyguts_t *)yyscanner;
    Interp   * const interp   = yyget_extra(yyscanner);

    frame->buffer             = YY_CURRENT_BUFFER;
    frame->s.next             = (parser_state_t *)IMCC_INFO(interp)->frames;
    IMCC_INFO(interp)->frames = frame;

    yy_scan_string(expansion, yyscanner);
}

static int
destroy_frame(struct macro_frame_t *frame, void *yyscanner)
{
    YY_BUFFER_STATE buffer = frame->buffer;
    int             ret    = 0;
    int             i;

    for (i = 0; i < frame->expansion.num_param; i++) {
        mem_sys_free(frame->expansion.name[i]);
        frame->expansion.name[i] = NULL;
    }

    if (frame->heredoc_rest) {
        mem_sys_free(frame->heredoc_rest);
        frame->heredoc_rest = NULL;
    } else
        ret = frame->s.line;

    /* RT #42383 if frame->s.file was allocated free it */
    /* Update: This should do it! */
    if (frame->s.file_needs_free) {
        DECL_CONST_CAST;
        mem_sys_free(PARROT_const_cast(char *,frame->s.file));
        frame->s.file_needs_free = 0;
    }
    mem_sys_free(frame);

    if (buffer != NULL)
        yy_switch_to_buffer(buffer, yyscanner);

    return ret;
}

static int
yylex_skip(YYSTYPE *valp, PARROT_INTERP, const char *skip, void *yyscanner)
{
    int         c;
    const char *p;
    yyguts_t   * const yyg = (yyguts_t *)yyscanner;

    do {
        c = yylex(valp, yyscanner, interp);
        p = skip;

        while (*p && c != *p)
            p++;

        /* leave loop early if it gets found */
        if (*p == '\0')
            break;

        /* free any str_dup()ed strings */
        if (yytext)
            mem_sys_free(valp->s);
    } while (*p != '\0');

    if (c)
        DUP_AND_RET_FREE(valp, c);

    return c;
}

static char*
read_braced(YYSTYPE *valp, PARROT_INTERP, const char *macro_name,
             char *current, void *yyscanner)
{
    YYSTYPE val;
    size_t  len   = strlen(current);
    int     c     = yylex(&val, yyscanner, interp);
    int     count = 0;

    while (c != '}' || count > 0) {

        if (c == '}')
            count--;
        else if (c == '{')
            count++;

        if (c <= 0)
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                        "End of file reached while reading arguments in '%s'",
                        macro_name);

        len     += strlen(val.s);
        current  = (char *)realloc(current, len + 1);
        strcat(current,val.s);

        mem_sys_free(val.s);
        val.s = NULL;
        c = yylex(&val, yyscanner, interp);
    }

    if (valp)
        *valp = val;
    else
        mem_sys_free(val.s);

    return current;
}

static int
read_params(YYSTYPE *valp, PARROT_INTERP, params_t *params,
             ARGIN(const char *macro_name), int need_id, void *yyscanner)
{
    YYSTYPE  val;
    size_t   len      = 0;
    char    *current  = str_dup("");
    yyguts_t *yyg     = (yyguts_t *)yyscanner;
    int      c        = yylex_skip(&val, interp, " \n", yyscanner);

    params->num_param = 0;

    while (c != ')') {
        if (YYSTATE == heredoc2)
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                        "Heredoc in macro '%s' not allowed", macro_name);

        if (c <= 0)
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                        "End of file reached while reading arguments in '%s'",
                        macro_name);
        else if (c == ',') {
            if (params->num_param == MAX_PARAM)
                IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                            "More than %d params in '%s'",
                            MAX_PARAM, macro_name);

            params->name[params->num_param++] = current;
            current                           = str_dup("");
            len                               = 0;

            c = yylex_skip(&val, interp, " \n", yyscanner);
        }
        else if (need_id && (*current || c != IDENTIFIER) && c != ' ') {
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                        "Parameter definition in '%s' must be IDENTIFIER",
                        macro_name);
        }
        else if (c == '{') {
            current = read_braced(&val, interp, macro_name, current, yyscanner);
            c       = yylex_skip(&val, interp, " \n", yyscanner);
            len     = strlen(current);
        }
        else {
            if (!need_id || c != ' ') {
                len     += strlen(val.s);
                current  = (char *)realloc(current, len + 1);
                strcat(current, val.s);
            }

            mem_sys_free(val.s);
            val.s = NULL;
            c = yylex(&val, yyscanner, interp);
        }
    }

    params->name[params->num_param++] = current;

    if (valp)
        *valp = val;
    else
        mem_sys_free(val.s);

    return c;
}

static int
read_macro(YYSTYPE *valp, PARROT_INTERP, void *yyscanner)
{
    int       c, start_line;
    params_t  params;
    yyguts_t * const yyg  = (yyguts_t *)yyscanner;
    int       start_cond  = YY_START;
    size_t    buffer_size = 0;
    size_t    buffer_used = 0;

    BEGIN(macro);

    c = yylex_skip(valp, interp, " ", yyscanner);

    if (c != IDENTIFIER)
        IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "Macro names must be identifiers");

    IMCC_INFO(interp)->cur_macro_name = valp->s;
    start_line                        = IMCC_INFO(interp)->line++;

    memset(&params, 0, sizeof (params_t));

    /* white space is allowed between macro and opening paren) */
    c = yylex_skip(valp, interp, " ", yyscanner);

    if (c == '(') {
        mem_sys_free(valp->s);
        valp->s = NULL;

        c = read_params(NULL, interp, &params,
                        IMCC_INFO(interp)->cur_macro_name, 1, yyscanner);

        c = yylex(valp, yyscanner, interp);
    }

    while (c != ENDM) {
        char *old_s = valp->s;
        int   elem_len;

        if (c <= 0) {
            mem_sys_free(valp->s);
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                        "File ended before macro '%s' was complete",
                        IMCC_INFO(interp)->cur_macro_name);
        }

        if (valp->s) {
            elem_len = strlen(valp->s);

            if (buffer_used) {
                if (buffer_used + elem_len > buffer_size) {
                    buffer_size += elem_len;
                    buffer_size <<= 1;

                    IMCC_INFO(interp)->macro_buffer =
                        (char *)mem_sys_realloc(IMCC_INFO(interp)->macro_buffer,
                            buffer_size);
                }
            }
            else {
                buffer_size = (elem_len << 1) > 1024 ? elem_len << 1 : 1024;

                IMCC_INFO(interp)->macro_buffer =
                    (char *)mem_sys_allocate_zeroed(buffer_size);
            }

            strcat(IMCC_INFO(interp)->macro_buffer, valp->s);
            buffer_used += elem_len;

            mem_sys_free(valp->s);
            valp->s = NULL;
        }
        c = yylex(valp, yyscanner, interp);
    }

    mem_sys_free(valp->s);
    valp->s = NULL;

    BEGIN(start_cond);

    define_macro(interp, IMCC_INFO(interp)->cur_macro_name,
                 &params, IMCC_INFO(interp)->macro_buffer, start_line);

    mem_sys_free(IMCC_INFO(interp)->macro_buffer);
    IMCC_INFO(interp)->macro_buffer   = NULL;
    IMCC_INFO(interp)->cur_macro_name = NULL;

    return MACRO;
}

static char *
find_macro_param(PARROT_INTERP, const char *name)
{
    macro_frame_t *f;

    for (f = IMCC_INFO(interp)->frames; f; f = (macro_frame_t *)f->s.next) {
        if (f->params) {
            int i;
            for (i = 0; i < f->params->num_param; i++) {
                if (STREQ(f->params->name[i], name))
                    return f->expansion.name[i];
            }
        }
    }

    return NULL;
}

static void
define_macro(PARROT_INTERP, ARGIN(const char *name), ARGIN(const params_t *params),
             ARGIN(const char *expansion), int start_line)
{
    DECL_CONST_CAST;

    macro_t *m = find_macro(interp, name);

    if (m) {
        mem_sys_free(m->expansion);
        m->expansion = NULL;
    }
    else {
        m = mem_allocate_zeroed_typed(macro_t);

        if (!IMCC_INFO(interp)->macros)
            parrot_new_cstring_hash(interp, &IMCC_INFO(interp)->macros);
        parrot_hash_put(interp, IMCC_INFO(interp)->macros,
            PARROT_const_cast(char *, name), m);
    }

    if (params)
        m->params = *params;
    else
        memset(&m->params, 0, sizeof (params_t));

    m->expansion = str_dup(expansion);
    m->line      = start_line;
}

static macro_t *
find_macro(PARROT_INTERP, const char *name)
{
    if (!IMCC_INFO(interp)->macros)
        return NULL;

    return (macro_t *)parrot_hash_get(interp, IMCC_INFO(interp)->macros, name);
}

static int
expand_macro(PARROT_INTERP, ARGIN(const char *name), void *yyscanner)
{
    yyguts_t   * const yyg       = (yyguts_t *)yyscanner;
    const char * const expansion = find_macro_param(interp, name);
    macro_t    *m;

    if (expansion) {
        macro_frame_t * const frame = new_frame(interp);

        /* When an error occurs, then report it as being in a macro */
        frame->is_macro = 1;
        scan_string(frame, expansion, yyscanner);
        return 1;
    }

    m = find_macro(interp, name);
    if (m) {
        int i,c,start_cond;

        macro_frame_t * const frame = new_frame(interp);
        frame->params               = &m->params;

        /* When an error occurs, then report it as being in a macro */
        frame->is_macro = 1;

        /* remember macro name for error reporting
        RT #42384 check that all the .file text is malloced / freed */
        frame->s.file = str_dup(name);
        frame->s.file_needs_free = 1;

        /* whitespace can be safely ignored */
        do {
#ifdef __cplusplus
            c = yyinput(yyscanner);
#else
            c = input(yyscanner);
#endif
        } while (c == ' ' || c == '\t');

        if (c != '(') {
            if (m->params.num_param != 0)
                IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                            "Macro '%s' needs %d arguments",
                            name, m->params.num_param);
            unput(c);
            scan_string(frame, m->expansion, yyscanner);
            return 1;
        }

        start_cond = YY_START;
        BEGIN(macro);

        read_params(NULL, interp, &frame->expansion, name, 0, yyscanner);

        BEGIN(start_cond);

        if (frame->expansion.num_param == 0 && m->params.num_param == 1) {
            frame->expansion.name[0] = str_dup("");
            frame->expansion.num_param = 1;
        }

        if (frame->expansion.num_param != m->params.num_param) {
            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
                        "Macro '%s' requires %d arguments, but %d given",
                        name, m->params.num_param, frame->expansion.num_param);
        }

        /* expand arguments */
        for (i = 0; i < frame->expansion.num_param; i++) {
            char * const current = frame->expansion.name[i];

            /* parameter of outer macro */
            if (current[0] == '.') {
                const char * const s = find_macro_param(interp, current + 1);

                if (s) {
                    frame->expansion.name[i] = str_dup(s);
                    mem_sys_free(current);
                }

            }
            else {
                const size_t len = strlen(current);
                if (len && (current[len - 1] == '$')) { /* local label */
                    const size_t slen = len + 10;
                    char * const s    = (char *)mem_sys_allocate(slen);

                    current[len - 1] = '\0';

                    snprintf(s, slen, "%s%d", current, IMCC_INFO(interp)->frames->label);

                    frame->expansion.name[i] = s;
                    mem_sys_free(current);
                }
            }
        }

        IMCC_INFO(interp)->line = m->line;
        scan_string(frame, m->expansion, yyscanner);
        return 1;
    }

    return 0;
}

static void
include_file(PARROT_INTERP, char *file_name, void *yyscanner)
{
    yyguts_t      * const yyg   = (yyguts_t *)yyscanner;
    macro_frame_t * const frame = new_frame(interp);
    char *s              = Parrot_locate_runtime_file(interp, file_name,
                                   PARROT_RUNTIME_FT_INCLUDE);
    char *ext;
    FILE *file;

    if (!s || !(file = fopen(s, "r")))
        IMCC_fataly(interp, EXCEPTION_EXTERNAL_ERROR, strerror(errno));

    mem_sys_free(s);
    frame->s.file   = file_name;
    frame->s.file_needs_free = 0;
    frame->s.handle = file;
    ext             = strrchr(file_name, '.');

    if (ext) {
        if (STREQ(ext, ".pasm")) {
            frame->s.pasm_file = 1;
            BEGIN(emit);
        }
        else if (STREQ(ext, ".pir")) {
            frame->s.pasm_file = 0;
            BEGIN(INITIAL);
        }
    }

    scan_file(interp, frame, file, yyscanner);
}

static void
scan_file(PARROT_INTERP, macro_frame_t *frame, FILE *file, void *yyscanner)
{
    yyguts_t * const yyg      = (yyguts_t *)yyscanner;
    frame->buffer             = YY_CURRENT_BUFFER;
    frame->s.next             = (parser_state_t *)IMCC_INFO(interp)->frames;
    IMCC_INFO(interp)->frames = frame;
    IMCC_INFO(interp)->state  = (parser_state_t *)IMCC_INFO(interp)->frames;

    IMCC_INFO(interp)->line   = 1;

    yy_switch_to_buffer(yy_create_buffer(file, YY_BUF_SIZE, yyscanner),
        yyscanner);
}

void
IMCC_push_parser_state(PARROT_INTERP)
{
    macro_frame_t * const frame = new_frame(interp);
    frame->s.next             = (parser_state_t *)IMCC_INFO(interp)->frames;
    IMCC_INFO(interp)->frames = frame;
    frame->s.line             = IMCC_INFO(interp)->line
                              = 1;
    IMCC_INFO(interp)->state  = (parser_state_t *)IMCC_INFO(interp)->frames;
}

static void
pop_parser_state(PARROT_INTERP, void *yyscanner)
{
    macro_frame_t * const tmp = IMCC_INFO(interp)->frames;
    if (tmp) {
        int l;
        if (tmp->s.handle)
            fclose(tmp->s.handle);

        IMCC_INFO(interp)->frames =
            (macro_frame_t *)IMCC_INFO(interp)->frames->s.next;

        l = destroy_frame(tmp, yyscanner);

        if (l)
            IMCC_INFO(interp)->line = l;
    }

    IMCC_INFO(interp)->state = (parser_state_t *)IMCC_INFO(interp)->frames;
}

void
IMCC_pop_parser_state(PARROT_INTERP, void *yyscanner)
{
    pop_parser_state(interp, yyscanner);
}

void
compile_file(PARROT_INTERP, FILE *file, void *yyscanner)
{
    yyguts_t * const yyg = (yyguts_t *)yyscanner;
    YY_BUFFER_STATE  buffer;

    IMCC_INFO(interp)->frames->s.next = NULL;
    buffer                            = YY_CURRENT_BUFFER;

    yy_switch_to_buffer(yy_create_buffer(file, YY_BUF_SIZE, yyscanner),
        yyscanner);

    emit_open(interp, 1, NULL);

    IMCC_TRY(IMCC_INFO(interp)->jump_buf, IMCC_INFO(interp)->error_code) {
        yyparse(yyscanner, interp);
        imc_compile_all_units(interp);
    }

    IMCC_CATCH(IMCC_FATAL_EXCEPTION) {
        IMCC_INFO(interp)->error_code = IMCC_FATAL_EXCEPTION;
    }

    IMCC_CATCH(IMCC_FATALY_EXCEPTION) {
        IMCC_INFO(interp)->error_code = IMCC_FATALY_EXCEPTION;
    }

    IMCC_END_TRY;

    if (buffer)
        yy_switch_to_buffer(buffer, yyscanner);
}

void
compile_string(PARROT_INTERP, const char *s, void *yyscanner)
{
    yyguts_t * const yyg = (yyguts_t *)yyscanner;
    YY_BUFFER_STATE  buffer;

    IMCC_INFO(interp)->frames->s.next = NULL;
    buffer                            = YY_CURRENT_BUFFER;

    yy_scan_string(s, yyscanner);
    emit_open(interp, 1, NULL);

    IMCC_TRY(IMCC_INFO(interp)->jump_buf, IMCC_INFO(interp)->error_code) {
        yyparse(yyscanner, interp);
        imc_compile_all_units(interp);
    }

    IMCC_CATCH(IMCC_FATAL_EXCEPTION) {
        IMCC_INFO(interp)->error_code = IMCC_FATAL_EXCEPTION;
    }

    IMCC_CATCH(IMCC_FATALY_EXCEPTION) {
        IMCC_INFO(interp)->error_code = IMCC_FATALY_EXCEPTION;
    }

    IMCC_END_TRY;

    if (buffer)
        yy_switch_to_buffer(buffer, yyscanner);
}

void
IMCC_print_inc(PARROT_INTERP)
{
    macro_frame_t *f;
    const char    *old = IMCC_INFO(interp)->frames->s.file;

    if (IMCC_INFO(interp)->frames && IMCC_INFO(interp)->frames->is_macro)
        fprintf(stderr, "\n\tin macro '.%s' line %d\n",
                IMCC_INFO(interp)->frames->s.file, IMCC_INFO(interp)->line);
    else
        fprintf(stderr, "\n\tin file '%s' line %d\n",
                IMCC_INFO(interp)->frames->s.file, IMCC_INFO(interp)->line);


    for (f = IMCC_INFO(interp)->frames; f; f = (macro_frame_t *)f->s.next) {
        if (!STREQ(f->s.file, old)) {
            fprintf(stderr, "\tincluded from '%s' line %d\n",
                    f->s.file, f->s.line);
        }

        old = f->s.file;
    }
}

/*

void
set_filename(PARROT_INTERP, char * const filename)

Function to set the C<filename> as specified using the C<.line> directive.
The parser needs to call back into the lexer (this file), because the
parser does not have access to the lexer's private bits.

*/
void
set_filename(PARROT_INTERP, char * const filename)
{
    IMCC_INFO(interp)->frames->s.file = filename;
    IMCC_INFO(interp)->frames->s.file_needs_free = 1;

    /* in case .line is used outside a .sub, then this
     * can't be done; hence the check.
     * The str_dup() is done, as the original #line implementation
     * duplicated the string twice as well; one for the
     * frames->s.file and one for cur_unit->file.
     * During the parse, the STRINGC is already str_dup()ed once.
     */
    if (IMCC_INFO(interp)->cur_unit)
        IMCC_INFO(interp)->cur_unit->file = str_dup(filename);
}

/* Functions to set and get yyin, as we can't decorate it for export
   (since it is defined in a file generated by yacc/bison). */
FILE* imc_yyin_set(FILE* new_yyin, void *yyscanner)
{
    yyguts_t * const yyg = (yyguts_t *)yyscanner;
    yyg->yyin_r   = new_yyin;

    return yyg->yyin_r;
}

FILE* imc_yyin_get(void *yyscanner)
{
    const yyguts_t * const yyg = (yyguts_t *)yyscanner;
    return yyg->yyin_r;
}

/* return true if scanner is at EOF */
int at_eof(yyscan_t yyscanner)
{
    yyguts_t * const yyg = (yyguts_t *)yyscanner;
    return yyg->yy_hold_char == '\0';
}

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */