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

#include "imc.h"
#include "parser.h"

}

%{
/*
 * imcc.l
 *
 * Intermediate Code Compiler for Parrot
 *
 * Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
 * Copyright (C) 2002-2008, Parrot Foundation.
 *
 * The tokenizer.
 *
 *
 */
/* static function declarations */
static void pop_parser_state(ARGMOD(imc_info_t *imcc), ARGMOD(void *yyscanner));

static struct macro_frame_t *new_frame(ARGMOD(imc_info_t *imcc));

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

static macro_t *find_macro(ARGMOD(imc_info_t *imcc), ARGIN(const char *name));

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

static void scan_file(ARGMOD(imc_info_t *imcc), ARGIN(struct macro_frame_t *frame), PIOHANDLE file,
        ARGMOD(void *yyscanner));

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

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

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

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

static void include_file(ARGMOD(imc_info_t *imcc), ARGIN(STRING *file_name), ARGMOD(void *yyscanner));

static int handle_identifier(ARGMOD(imc_info_t *imcc), YYSTYPE *valp, ARGIN(const char *id));

#define YY_DECL int yylex(YYSTYPE *valp, yyscan_t yyscanner, ARGMOD(imc_info_t *imcc))

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

#define SET_LINE_NUMBER (imcc->line = yylineno)

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

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

#define YY_INPUT(buf, result, max_size) \
    (result) = Parrot_io_internal_read((Interp *)yyextra->interp, (PIOHANDLE)yyin, (buf), (max_size))

%}

%option reentrant
%option never-interactive
%option stack
%option yylineno

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            [-+]
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}{DQ_STRING}
STRINGCONSTANT  {SQ_STRING}|{DQ_STRING}
SQ_STRING       \'[^'\n]*\'
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->expect_pasm == 1 && !imcc->in_pod) {
            imcc->expect_pasm = 2;
            BEGIN(emit);
        }

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

            return 0;
        }

<*>^{WS}*            { SET_LINE_NUMBER; }

<heredoc1>.*{EOL} {
            SET_LINE_NUMBER;
            imcc->frames->heredoc_rest = mem_sys_strndup(yytext, yyleng);
            BEGIN(heredoc2);
    }

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

        /* Newline in the heredoc. Realloc and cat on. */
        imcc->heredoc_content =
            (char*)mem_sys_realloc(imcc->heredoc_content,
                            strlen(imcc->heredoc_content) + 3);
        strcpy(imcc->heredoc_content +
               strlen(imcc->heredoc_content), "\n");
    }

<heredoc2>([^\r\n]|\r[^\n])* {
        SET_LINE_NUMBER;
        /* Are we at the end of the heredoc? */
        if (STREQ(imcc->heredoc_end, yytext)) {
            /* End of the heredoc. */
            yyguts_t * const yyg = (yyguts_t *)yyscanner;
            const int len        = strlen(imcc->heredoc_content);

            /* delim */
            imcc->heredoc_content[len] =
                imcc->heredoc_content[0];

            imcc->heredoc_content[len + 1] = 0;

            mem_sys_free(imcc->heredoc_end);
            imcc->heredoc_end = NULL;

            imcc->frames->buffer = YY_CURRENT_BUFFER;
            valp->s                           =
                imcc->heredoc_content;

            yy_pop_state(yyscanner);
            yy_scan_string(imcc->frames->heredoc_rest, yyscanner);

            return STRINGC;
        }
        else {
            /* Part of the heredoc. Realloc and cat the line on. */
            imcc->heredoc_content =
                (char *)mem_sys_realloc(imcc->heredoc_content,
                                strlen(imcc->heredoc_content) +
                                strlen(yytext) + 2);
            strcpy(imcc->heredoc_content +
                   strlen(imcc->heredoc_content), yytext);
        }
    }

<cmt2>[^"]+ {
        STRING *str;

        yy_pop_state(yyscanner);
        yy_push_state(cmt3, yyscanner);

        str = Parrot_str_new(imcc->interp, yytext,0);
        imcc->frames->s.file = str;
        imcc->cur_unit->file = str;

        return FILECOMMENT;
    }

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

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

<cmt4>.*{EOL} {
        yy_pop_state(yyscanner);
    }

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

        imcc->expect_pasm = 0;

        return '\n';
    }

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

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

        imcc->expect_pasm = 0;

        return '\n';
    }


<INITIAL,emit,macro>^"=cut"{EOL} {
    /* this is a stand-alone =cut, but we're not in POD mode, so ignore.  */
    SET_LINE_NUMBER;
}

<INITIAL,emit,macro>^"=".*{EOL} {
        SET_LINE_NUMBER;
        imcc->in_pod = 1;
        yy_push_state(pod, yyscanner);
    }

<pod>^"=cut"{EOL} {
        SET_LINE_NUMBER;
        imcc->in_pod = 0;
        yy_pop_state(yyscanner);
    }

<pod>.* { SET_LINE_NUMBER; }

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

<INITIAL,emit>".annotate" return ANNOTATE;
<INITIAL,emit>".lex"     return LEXICAL;
".set_arg"               return ARG;
".sub"                   { SET_LINE_NUMBER; return SUB; }
".end"                   return ESUB;
".begin_call"            return PCC_BEGIN;
".end_call"              return PCC_END;
".call"                  return PCC_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>":tag"       return SUBTAG;
<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;
":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;
":call_sig"     return ADV_CALL_SIG;

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

".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" {
        char *macro_name   = NULL;
        int   start_cond   = YY_START;
        int   macro_exists = 0;
        int   c;
        int   start_line;

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

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

        imcc->cur_macro_name = macro_name = valp->s;
        start_line = imcc->line;

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

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

        /* macro_name becomes a hash key
         * the first one needs to remain; destroying the hash frees it
         * subsequent macro_names need destruction here to avoid leaks */
        if (find_macro(imcc, macro_name))
            macro_exists = 1;

        define_macro(imcc, macro_name, NULL, valp->s, start_line);
        mem_sys_free(valp->s);

        /* don't leak these */
        if (macro_exists)
            mem_sys_free(macro_name);

        imcc->cur_macro_name = NULL;

        BEGIN(start_cond);
        return MACRO;
    }

<emit,INITIAL>".macro" {
        /* the initial whitespace catcher misses this one */
        SET_LINE_NUMBER;
        return read_macro(valp, imcc, yyscanner);
    }

<emit,INITIAL>".include" {
        const int c = yylex(valp, yyscanner, imcc);
        STRING *filename;

        if (c != STRINGC)
            return c;

        /* STRINGCs have a mem_sys_strdup()ed valp->s */
        mem_sys_free(valp->s);
        YYCHOP();
        filename = Parrot_str_new(imcc->interp, yytext + 1, 0);
        include_file(imcc, filename, yyscanner);
    }

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

            YYCHOP();
            YYCHOP();

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

            len = yyleng + 10;
            label = (char *)mem_sys_allocate(len);
            snprintf(label, len, "%s%d", yytext, imcc->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();

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

            len = yyleng + 10;
            label = (char *)mem_sys_allocate(len);
            snprintf(label, len, "%s%d", yytext, imcc->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 = mem_sys_strndup(yytext, yyleng);

        return LABEL;
    }

<emit,INITIAL>{DOT}{LETTER}{LETTERDIGIT}* {
        char   * const macro_name = mem_sys_strndup(yytext + 1, yyleng - 1);
        int failed = expand_macro(imcc, macro_name, yyscanner);
        mem_sys_free(macro_name);
        if (!failed) {
            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);

<*>{STRINGCONSTANT} {
        valp->s = mem_sys_strndup(yytext, yyleng);

        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->frames->heredoc_rest)
            IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR, "nested heredoc not supported");
        imcc->heredoc_end = mem_sys_strndup(yytext + 3, yyleng - 3);
        imcc->heredoc_end[strlen(imcc->heredoc_end) - 1] = 0;

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

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

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

        /* preserve delim */
        imcc->heredoc_content[0] = yytext[2];

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

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

        /* 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->state->pasm_file)
            IMCC_fataly(imcc, 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->state->pasm_file)
            IMCC_fataly(imcc, 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->state->pasm_file)
            IMCC_fataly(imcc, 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->state->pasm_file)
            IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
                "'%s' is not a valid register name in pasm mode", yytext);
        return PREG;
    }

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

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

        if (valp)
            valp->s = mem_sys_strndup(yytext, yyleng);

        return REG;
    }


<emit,INITIAL>{ID} { return handle_identifier(imcc, valp, yytext); }

<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->frames->s.pasm_file) {
            imcc->frames->s.pasm_file = 2;
            return EOM;
        }

        return 0;
    }

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

<macro>".endm"         {
        /* the initial whitespace catcher misses this one */
        SET_LINE_NUMBER;
        DUP_AND_RET(valp, ENDM);
}

<macro>{WS}*{EOL} {
        DUP_AND_RET(valp, '\n');
    }

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

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

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

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

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

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

            if (valp->s)
                mem_sys_free(valp->s);
            valp->s = label;
        }

        return LABEL;
    }

<macro>".$"{ID} {
    if (valp) {
        if (!imcc->cur_macro_name) {
            if (valp->s)
                mem_sys_free(valp->s);
            IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
                "Invalid LABEL outside of macro");
        }
        else {
            const char * const fmt    = "local__%s__%s__$";
            const size_t fmtlen = strlen(fmt) - (2 * strlen("%s"));
            const size_t len    = strlen(imcc->cur_macro_name)
                                + yyleng + fmtlen;
            char * const label  = (char *)mem_sys_allocate(len);

            /* skip over ".$" prefix with the +2 */
            snprintf(label, len, fmt,
                imcc->cur_macro_name, yytext + 2);

            if (valp->s)
                mem_sys_free(valp->s);
            valp->s = label;
        }
    }

    return IDENTIFIER;
}

<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 */
    imc_info_t * imcc = yyget_extra(yyscanner);
    yyguts_t * const yyg = (yyguts_t *)yyscanner;

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

    yy_delete_buffer(YY_CURRENT_BUFFER, yyscanner);

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

    return 1;
}

static macro_frame_t *
new_frame(ARGMOD(imc_info_t *imcc)) {
    macro_frame_t * const tmp = mem_gc_allocate_zeroed_typed(imcc->interp, macro_frame_t);

    tmp->label         = imcc->unique_count;
    imcc->unique_count++;
    tmp->s.line        = imcc->line;
    tmp->s.handle      = PIO_INVALID_HANDLE;

    if (imcc->frames) {
        tmp->s.pasm_file = imcc->frames->s.pasm_file;
        if (imcc->frames->s.file)
            tmp->s.file = imcc->frames->s.file;
    }

    tmp->s.interp = imcc->interp;

    return tmp;
}

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

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

    /* start at the effective *starting line* of the macro */
    imcc->line   = frame->s.line - 2;

    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;
    }

    mem_sys_free(frame);

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

    return ret;
}

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

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

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

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

        /* free any mem_sys_strdup()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, ARGMOD(imc_info_t *imcc), const char *macro_name,
             char *current, void *yyscanner)
{
    YYSTYPE val;
    size_t  len   = strlen(current);
    int     c     = yylex(&val, yyscanner, imcc);
    int     count = 0;

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

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

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

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

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

    if (valp) {
        if (valp->s)
            mem_sys_free(valp->s);
        *valp = val;
    }
    else
        mem_sys_free(val.s);

    return current;
}

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

    params->num_param = 0;

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

        if (c <= 0)
            IMCC_fataly(imcc, 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(imcc, EXCEPTION_SYNTAX_ERROR,
                            "More than %d params in '%s'",
                            MAX_PARAM, macro_name);

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

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

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

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

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

    return c;
}

static int
read_macro(YYSTYPE *valp, ARGMOD(imc_info_t *imcc), 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, imcc, " ", yyscanner);

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

    imcc->cur_macro_name = valp->s;
    start_line = imcc->line;

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

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

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

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

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

    while (c != ENDM) {
        int   elem_len;

        if (c <= 0) {
            mem_sys_free(valp->s);
            IMCC_fataly(imcc, EXCEPTION_SYNTAX_ERROR,
                        "File ended before macro '%s' was complete",
                        imcc->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->macro_buffer =
                        (char *)mem_sys_realloc(imcc->macro_buffer,
                            buffer_size);
                }
            }
            else {
                buffer_size = (elem_len << 1) > 1024 ? elem_len << 1 : 1024;

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

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

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

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

    BEGIN(start_cond);

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

    mem_sys_free(imcc->macro_buffer);
    imcc->macro_buffer   = NULL;
    imcc->cur_macro_name = NULL;

    return MACRO;
}

static char *
find_macro_param(ARGMOD(imc_info_t *imcc), const char *name)
{
    macro_frame_t *f;

    for (f = imcc->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(ARGMOD(imc_info_t *imcc), ARGIN(const char *name),
        ARGIN(const params_t *params), ARGIN(const char *expansion), int start_line)
{
    DECL_CONST_CAST;

    macro_t *m = find_macro(imcc, name);

    if (m) {
        mem_sys_free(m->expansion);
        m->expansion = NULL;
    }
    else {
        m = mem_gc_allocate_zeroed_typed(imcc->interp, macro_t);

        if (!imcc->macros)
            imcc->macros = Parrot_hash_new_cstring_hash(imcc->interp);
        Parrot_hash_put(imcc->interp, imcc->macros,
            PARROT_const_cast(char *, name), m);
    }

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

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

static macro_t *
find_macro(ARGMOD(imc_info_t *imcc), const char *name)
{
    if (!imcc->macros)
        return NULL;

    return (macro_t *)Parrot_hash_get(imcc->interp, imcc->macros, name);
}

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

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

        /* 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(imcc, name);
    if (m) {
        int i, c, start_cond;

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

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

        frame->s.file = Parrot_str_new(imcc->interp, name, 0);

        /* 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(imcc, 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, imcc, &frame->expansion, name, 0, yyscanner);

        BEGIN(start_cond);

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

        if (frame->expansion.num_param != m->params.num_param) {
            IMCC_fataly(imcc, 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(imcc, current + 1);

                if (s) {
                    frame->expansion.name[i] = mem_sys_strdup(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->frames->label);

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

        scan_string(frame, m->expansion, yyscanner);

        return 1;
    }

    return 0;
}

static void
include_file(ARGMOD(imc_info_t *imcc), ARGIN(STRING *file_name), void *yyscanner)
{
    yyguts_t      * const yyg   = (yyguts_t *)yyscanner;
    macro_frame_t * const frame = new_frame(imcc);
    STRING *s = Parrot_locate_runtime_file_str(imcc->interp,
                                    file_name, PARROT_RUNTIME_FT_INCLUDE);
    char      *ext;
    PIOHANDLE  file;

    if (STRING_IS_NULL(s)
    ||  (file = Parrot_io_internal_open(imcc->interp, s, PIO_F_READ)) == PIO_INVALID_HANDLE) {
        IMCC_fataly(imcc, EXCEPTION_EXTERNAL_ERROR,
            "No such file or directory '%Ss'", file_name);
    }

    frame->s.file   = file_name;
    frame->s.handle = file;

    /* TODO: We do checks like this elsewhere. Create a utility function to
             check file type */
    if (imcc_string_ends_with(imcc, file_name, ".pasm")) {
        frame->s.pasm_file = 1;
        BEGIN(emit);
    }
    else if (imcc_string_ends_with(imcc, file_name, ".pir")) {
        frame->s.pasm_file = 0;
        BEGIN(INITIAL);
    }

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

static void
scan_file(ARGMOD(imc_info_t *imcc), macro_frame_t *frame, PIOHANDLE file,
        void *yyscanner)
{
    yyguts_t * const yyg      = (yyguts_t *)yyscanner;
    const      int   oldline  = imcc->line;
    frame->buffer             = YY_CURRENT_BUFFER;
    frame->s.next             = (parser_state_t *)imcc->frames;
    imcc->frames = frame;
    imcc->state  = (parser_state_t *)imcc->frames;

    /* let the start of line rule increment this to 1 */
    imcc->line   = 0;

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

    imcc->line   = oldline;
}

void
IMCC_push_parser_state(ARGMOD(imc_info_t *imcc), STRING *filename,
        int is_file, int is_pasm)
{
    macro_frame_t * const frame = new_frame(imcc);
    frame->s.next = (parser_state_t *)imcc->frames;
    imcc->frames = frame;
    frame->s.line = imcc->line = 1;
    imcc->state = (parser_state_t *)imcc->frames;
    if (is_file)
        imcc->state->file = filename;
    else
        imcc->state->file = Parrot_str_new_constant(imcc->interp, "(file unknown)");
    imcc->state->pasm_file = is_pasm;
}

static void
pop_parser_state(ARGMOD(imc_info_t *imcc), void *yyscanner)
{
    macro_frame_t * const tmp = imcc->frames;
    if (tmp) {
        int l;
        if (tmp->s.handle != PIO_INVALID_HANDLE)
            Parrot_io_internal_close(imcc->interp, tmp->s.handle);

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

        l = destroy_frame(tmp, yyscanner);

        if (l)
            imcc->line = l;
    }

    imcc->state = (parser_state_t *)imcc->frames;
}

void
IMCC_pop_parser_state(ARGMOD(imc_info_t *imcc), void *yyscanner)
{
    pop_parser_state(imcc, yyscanner);
}

PIOHANDLE
determine_input_file_type(ARGMOD(imc_info_t * imcc), ARGIN(STRING *sourcefile))
{
    PIOHANDLE handle;

    if (!STRING_length(sourcefile))
        IMCC_fatal_standalone(imcc, 1, "main: No source file specified.\n");

    if (STRING_length(sourcefile) == 1
            && STRING_ord(imcc->interp, sourcefile, 0) ==  '-') {
        handle = Parrot_io_internal_std_os_handle(imcc->interp, PIO_STDIN_FILENO);

        if ((FILE *)handle == NULL) {
            /*
             * We have to dup the handle because the stdin fd is 0 on UNIX and
             * lex would think it's a NULL FILE pointer and reset it to the
             * stdin FILE pointer.
             */
            handle = Parrot_io_internal_dup(imcc->interp, handle);
        }
    }
    else {
        if (Parrot_file_stat_intval(imcc->interp, sourcefile, STAT_ISDIR))
            Parrot_ex_throw_from_c_args(imcc->interp, NULL, EXCEPTION_EXTERNAL_ERROR,
                "imcc_compile_file: '%Ss' is a directory\n", sourcefile);

        handle = Parrot_io_internal_open(imcc->interp, sourcefile, PIO_F_READ);
        if (handle == PIO_INVALID_HANDLE)
            IMCC_fatal_standalone(imcc, EXCEPTION_EXTERNAL_ERROR,
                                  "Error reading source file %Ss.\n",
                                  sourcefile);
        if (imcc_string_ends_with(imcc, sourcefile, ".pasm"))
            SET_STATE_PASM_FILE(imcc);
    }

    if (imcc->verbose) {
        IMCC_info(imcc, 1, "debug = 0x%x\n", imcc->debug);
        IMCC_info(imcc, 1, "Reading %Ss\n", sourcefile);
    }

    return handle;
}


static PIOHANDLE
imcc_setup_input(ARGMOD(imc_info_t * imcc), yyscan_t yyscanner,
        ARGIN(STRING *source), ARGIN(const char *source_c), int is_file)
{
    if (is_file) {
        PIOHANDLE file = determine_input_file_type(imcc, source);
        imc_yyin_set(file, yyscanner);
        yy_switch_to_buffer(
            yy_create_buffer((FILE *)file, YY_BUF_SIZE, yyscanner),
            yyscanner);
        return file;
    }
    else {
        yy_scan_string(source_c, yyscanner);
        return PIO_INVALID_HANDLE;
    }
}

static void
imcc_cleanup_input(ARGMOD(imc_info_t * imcc), PIOHANDLE file,
        ARGIN(char *source_c), int is_file)
{
    if (is_file)
        Parrot_io_internal_close(imcc->interp, file);

    Parrot_str_free_cstring(source_c);
}

INTVAL
imcc_compile_buffer_safe(ARGMOD(imc_info_t *imcc), yyscan_t yyscanner,
        ARGIN(STRING *source), int is_file, SHIM(int is_pasm))
{
    yyguts_t * const yyg = (yyguts_t *)yyscanner;
    YY_BUFFER_STATE  volatile buffer;
    char * source_c = Parrot_str_to_cstring(imcc->interp, source);
    PIOHANDLE file;
    INTVAL success = 0;

    imcc->frames->s.next = NULL;
    buffer = YY_CURRENT_BUFFER;

    file = imcc_setup_input(imcc, yyscanner, source, source_c, is_file);
    emit_open(imcc);
    success = imcc_run_compilation(imcc, yyscanner);
    imcc_cleanup_input(imcc, file, source_c, is_file);

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

static void
do_a_better_error_message(imc_info_t * imcc, SHIM(void * yyscanner))
{
    STRING * loc;
    imcc->error_code    = IMCC_PARSEFAIL_EXCEPTION;
    if (imcc->frames && imcc->frames->is_macro)
        loc = Parrot_sprintf_c(imcc->interp, "in macro '.%Ss' line %d",
                imcc->frames->s.file, imcc->line);
    else
        loc = Parrot_sprintf_c(imcc->interp, "in file '%Ss' line %d",
                imcc->frames->s.file, imcc->line);
    imcc->error_message = Parrot_sprintf_c(imcc->interp,
        "Unexpected parser exit. Unknown syntax error.\n"
        "\tLast line reported is %d\n"
        "\tLast file reported is %S", imcc->line, loc);
}

INTVAL
imcc_run_compilation(ARGMOD(imc_info_t *imcc), void *yyscanner) {
    /* TODO: Kill this stuff and use Parrot exceptions exclusively */
    IMCC_TRY(imcc->jump_buf, imcc->error_code) {
        if (yyparse(yyscanner, imcc)) {
            imcc->error_code = IMCC_PARSEFAIL_EXCEPTION;
            return 0;
        }

        imc_compile_all_units(imcc);
        return 1;
    }

    IMCC_CATCH(IMCC_FATAL_EXCEPTION) {
        imcc->error_code = IMCC_FATAL_EXCEPTION;
    }

    IMCC_CATCH(IMCC_FATALY_EXCEPTION) {
        imcc->error_code = IMCC_FATALY_EXCEPTION;
    }

    IMCC_END_TRY;
    return 0;
}

void
IMCC_print_inc(ARGMOD(imc_info_t *imcc))
{
    macro_frame_t *f;
    STRING        *old = imcc->frames->s.file;

    if (imcc->frames && imcc->frames->is_macro)
        IMCC_warning(imcc, "\n\tin macro '.%Ss' line %d\n",
                imcc->frames->s.file, imcc->line);
    else
        IMCC_warning(imcc, "\n\tin file '%Ss' line %d\n",
                imcc->frames->s.file, imcc->line);


    for (f = imcc->frames; f; f = (macro_frame_t *)f->s.next) {
        if (!STRING_equal(imcc->interp, f->s.file, old)) {
            IMCC_warning(imcc, "\tincluded from '%Ss' line %d\n",
                    f->s.file, f->s.line);
        }

        old = f->s.file;
    }
}

/*

void
set_filename(ARGMOD(imc_info_t *imcc), 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(ARGMOD(imc_info_t *imcc), char * const filename)
{
    STRING *str = Parrot_str_new(imcc->interp, filename, 0);

    imcc->frames->s.file = str;

    /* in case .line is used outside a .sub, then this
     * can't be done; hence the check.
     * The mem_sys_strdup() 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 mem_sys_strdup()ed once.
     */
    if (imcc->cur_unit)
        imcc->cur_unit->file = str;
}

/* 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). */
void imc_yyin_set(PIOHANDLE new_yyin, void *yyscanner)
{
    yyguts_t * const yyg = (yyguts_t *)yyscanner;
    yyg->yyin_r   = (FILE *)new_yyin;
}

PIOHANDLE imc_yyin_get(void *yyscanner)
{
    const yyguts_t * const yyg = (yyguts_t *)yyscanner;
    return (PIOHANDLE)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';
}

static int
handle_identifier(ARGMOD(imc_info_t *imcc), YYSTYPE *valp, const char *text)
{
    if (!imcc->is_def) {
        SymReg *r = find_sym(imcc, text);

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

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

    valp->s = mem_sys_strdup(text);
    return (!imcc->is_def && is_op(imcc, valp->s) ? PARROT_OP : IDENTIFIER);
}

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