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, Parrot Foundation.
 *
 * The tokenizer.
 *
 * $Id$
 *
 */


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

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

static int handle_identifier(PARROT_INTERP, YYSTYPE *valp, ARGIN(const char *id));

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

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

#define SET_LINE_NUMBER (IMCC_INFO(interp)->line = yylineno)

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

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

%}

%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}{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_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;
        }

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

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

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

        /* Newline in the heredoc. Realloc and cat 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);
    }

<heredoc2>.* {
        SET_LINE_NUMBER;
        /* 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);

            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 = mem_sys_strdup(yytext);
        IMCC_INFO(interp)->cur_unit->file = mem_sys_strdup(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} {
        yylineno = IMCC_INFO(interp)->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_INFO(interp)->expect_pasm == 2)
            BEGIN(INITIAL);

        IMCC_INFO(interp)->expect_pasm = 0;

        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;

        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_INFO(interp)->in_pod = 1;
        yy_push_state(pod, yyscanner);
    }

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

<pod>.* { SET_LINE_NUMBER; }

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

<*>".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;
":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, interp, " ", yyscanner);

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

        IMCC_INFO(interp)->cur_macro_name = 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", 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(interp, macro_name))
            macro_exists = 1;

        define_macro(interp, 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_INFO(interp)->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, interp, yyscanner);
    }

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

        if (c != STRINGC)
            return c;

        /* STRINGCs have a mem_sys_strdup()ed valp->s */
        mem_sys_free(valp->s);
        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();

            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 = mem_sys_strdup(yytext);

        return LABEL;
    }

<emit,INITIAL>{DOT}{LETTER}{LETTERDIGIT}* {
        char   * const macro_name = mem_sys_strdup(yytext + 1);
        int failed = expand_macro(interp, 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_strdup(yytext);

        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 = mem_sys_strdup(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 = mem_sys_strdup(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 = mem_sys_strdup(yytext);

        return REG;
    }


<emit,INITIAL>{ID} { return handle_identifier(interp, 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_INFO(interp)->frames->s.pasm_file) {
            IMCC_INFO(interp)->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, 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);

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

        return LABEL;
    }

<macro>".$"{ID} {
    if (valp) {
        if (!IMCC_INFO(interp)->cur_macro_name) {
            if (valp->s)
                mem_sys_free(valp->s);
            IMCC_fataly(interp, 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_INFO(interp)->cur_macro_name)
                                + yyleng + fmtlen;
            char * const label  = (char *)mem_sys_allocate(len);

            /* skip over ".$" prefix with the +2 */
            snprintf(label, len, fmt,
                IMCC_INFO(interp)->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 */
    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) {
    /* XXX non-reentrant */
    static int label   = 0;
    macro_frame_t * const tmp = mem_gc_allocate_zeroed_typed(interp, 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)
            tmp->s.file = mem_sys_strdup(IMCC_INFO(interp)->frames->s.file);
    }

    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;

    /* start at the effective *starting line* of the macro */
    IMCC_INFO(interp)->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->s.file);
    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 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, 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 *)mem_sys_realloc(current, len + 1);
        strcat(current,val.s);

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

    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, PARROT_INTERP, params_t *params,
             ARGIN(const char *macro_name), int need_id, void *yyscanner)
{
    YYSTYPE  val;
    size_t   len      = 0;
    char    *current  = mem_sys_strdup("");
    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                           = mem_sys_strdup("");
            len                               = 0;

            if (val.s)
                mem_sys_free(val.s);
            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);
            mem_sys_free(val.s);
            c       = yylex_skip(&val, interp, " \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, 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) {
        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_gc_allocate_zeroed_typed(interp, macro_t);

        if (!IMCC_INFO(interp)->macros)
            IMCC_INFO(interp)->macros = parrot_new_cstring_hash(interp);
        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 = mem_sys_strdup(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 * 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
         * first free any filename allocated in new_frame() */
        if (frame->s.file)
            mem_sys_free(frame->s.file);

        frame->s.file            = mem_sys_strdup(name);

        /* 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] = mem_sys_strdup("");
            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] = 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_INFO(interp)->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(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"))) {
        if (frame->s.file)
            mem_sys_free(frame->s.file);
        IMCC_fataly(interp, EXCEPTION_EXTERNAL_ERROR, strerror(errno));
    }

    if (frame->s.file)
        mem_sys_free(frame->s.file);
    mem_sys_free(s);
    frame->s.file            = mem_sys_strdup(file_name);
    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;
    const      int   oldline  = IMCC_INFO(interp)->line;
    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;

    /* let the start of line rule increment this to 1 */
    IMCC_INFO(interp)->line   = 0;

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

    IMCC_INFO(interp)->line   = oldline;
}

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  volatile 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_run_compilation(interp, yyscanner);

    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  volatile buffer;

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

    yy_scan_string(s, yyscanner);

    emit_open(interp, 1, NULL);

    imcc_run_compilation(interp, yyscanner);

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

void
imcc_run_compilation(PARROT_INTERP, void *yyscanner) {
    IMCC_TRY(IMCC_INFO(interp)->jump_buf, IMCC_INFO(interp)->error_code) {
        if (yyparse(yyscanner, interp)) {
            IMCC_INFO(interp)->error_code    = IMCC_PARSEFAIL_EXCEPTION;
            IMCC_INFO(interp)->error_message = string_from_literal(interp, "syntax error ... somewhere");
            return;
        }

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

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;

    /* 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_INFO(interp)->cur_unit)
        IMCC_INFO(interp)->cur_unit->file = mem_sys_strdup(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';
}

static int
handle_identifier(PARROT_INTERP, YYSTYPE *valp, const char *text)
{
    if (!IMCC_INFO(interp)->is_def) {
        SymReg *r = find_sym(interp, text);

        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(text, "self")) {
                valp->sr = mk_ident(interp, "self", 'P');
                IMCC_INFO(interp)->cur_unit->type |= IMC_HAS_SELF;
                return VAR;
            }
        }
    }

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

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