%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_
#endif
}
%{
/*
* imcc.l
*
* Intermediate Code Compiler for Parrot
*
* Copyright (C) 2002 Melvin Smith <melvin.smith@mindspring.com>
* Copyright (C) 2002-2006, The Perl Foundation.
*
* The tokenizer.
*
* $Id: imcc.l 23842 2007-12-13 12:31:17Z kjs $
*
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "imc.h"
#include "parser.h"
#define MAX_PARAM 16
typedef struct params_t {
char *name[MAX_PARAM];
int num_param;
} params_t;
typedef struct macro_t {
params_t params;
char *expansion;
int line;
} macro_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 */
YY_BUFFER_STATE buffer;
params_t *params;
params_t expansion;
int label;
int is_macro;
char *heredoc_rest;
} macro_frame_t;
/* static function declariations */
static void pop_parser_state(Interp* interp, void *yyscanner);
static struct macro_frame_t *new_frame(Interp*);
static void define_macro(Interp *interp, char *name, params_t *params,
char *expansion, int start_line);
static macro_t *find_macro(Interp *interp, const char *name);
static void scan_string(struct macro_frame_t *frame, const char *expansion, void *yyscanner);
static void scan_file(Interp* interp, struct macro_frame_t *frame, FILE *, void *yyscanner);
static int destroy_frame(struct macro_frame_t *frame, void *yyscanner);
static int yylex_skip(YYSTYPE *valp, Interp *interp, const char *skip, void *yyscanner);
static int read_macro(YYSTYPE *valp, Interp *interp, void *yyscanner);
static int expand_macro(YYSTYPE *valp, Interp *interp, const char *name, void *yyscanner);
static void include_file(Interp* interp, char *file_name, void *yyscanner);
#define YY_DECL int yylex(YYSTYPE *valp, yyscan_t yyscanner, Interp *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) { \
if ((valp)->s) \
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 (0)
yy_top_state(yyscanner); /* silent warning */
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 (strcmp(IMCC_INFO(interp)->heredoc_end, yytext) == 0)
{
/* End of the heredoc. */
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
int len = strlen(IMCC_INFO(interp)->heredoc_content);
IMCC_INFO(interp)->heredoc_content[len] = IMCC_INFO(interp)->heredoc_content[0]; /* delim */
IMCC_INFO(interp)->heredoc_content[len+1] = 0;
mem_sys_free(IMCC_INFO(interp)->heredoc_end);
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; /* RT#42382 delete quotes, -> emit, pbc */
}
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);
}
}
<*>^"#line"{SP}{DIGITS}{SP}["] {
yy_push_state(cmt2, yyscanner);
IMCC_INFO(interp)->line = atoi(yytext+6);
return LINECOMMENT;
}
<cmt2>[^"]+ {
yy_pop_state(yyscanner);
yy_push_state(cmt3, yyscanner);
IMCC_INFO(interp)->frames->s.file = str_dup(yytext);
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';
}
^".emit"\n {
BEGIN(emit);
return EMIT;
}
<emit>^".eom"\n {
BEGIN(INITIAL);
return EOM;
}
<*>[ISNP]{DIGIT}{DIGIT}? {
valp->s = str_dup(yytext);
return REG;
}
<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++; }
<INITIAL,emit>".lex" return LEXICAL;
".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;
":unique_reg" return UNIQUE_REG;
".result" return RESULT;
".get_results" return GET_RESULTS;
".yield" return YIELDT;
".return" return RETURN;
<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;
<emit,INITIAL>".namespace" return NAMESPACE;
<emit,INITIAL>".HLL" return HLL;
<emit,INITIAL>".HLL_map" return HLL_MAP;
".endnamespace" return ENDNAMESPACE;
".local" return LOCAL;
".global" return GLOBAL;
<emit,INITIAL>".const" return CONST;
".globalconst" return GLOBAL_CONST;
".param" return PARAM;
<*>".pragma" return PRAGMA;
<*>"n_operators" return N_OPERATORS;
"goto" return GOTO;
"if" return IF;
"unless" return UNLESS;
"null" return PNULL;
"int" return INTV;
"num" return FLOATV;
"new" return NEW;
"addr" return ADDR;
"global" return GLOBALOP;
"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;
<emit,INITIAL>".." return DOTDOT;
"+=" 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" {
return read_macro(valp, interp, yyscanner);
}
<emit>(".constant"|".macro_const") {
int c;
int start_line;
BEGIN(macro);
c = yylex_skip(valp, interp, " ", yyscanner);
if (c != IDENTIFIER)
IMCC_fataly(interp, E_SyntaxError,
"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, E_SyntaxError,
"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(emit);
return MACRO;
}
<emit,INITIAL>".include" {
int c;
c = yylex(valp, yyscanner, interp);
if (c != STRINGC) return c;
YYCHOP();
include_file(interp, str_dup(yytext + 1), yyscanner);
}
<emit,INITIAL>{ID}"$:" {
char *label;
if (valp) {
YYCHOP();
YYCHOP();
if (!IMCC_INFO(interp)->frames || !IMCC_INFO(interp)->frames->label)
IMCC_fataly(interp, E_SyntaxError, "missing space?");
label = (char*)mem_sys_allocate(yyleng+10);
sprintf(label, "%s%d", yytext, IMCC_INFO(interp)->frames->label);
valp->s = label;
}
return LABEL;
}
<emit,INITIAL>{ID}"$" {
char *label;
if (valp) {
YYCHOP();
/* #32421 if$I0 is parsed as if$ I0 */
if (!IMCC_INFO(interp)->frames || !IMCC_INFO(interp)->frames->label)
IMCC_fataly(interp, E_SyntaxError, "missing space?");
label = (char*)mem_sys_allocate(yyleng+10);
sprintf(label, "%s%d", yytext, IMCC_INFO(interp)->frames->label);
valp->s = label;
}
return IDENTIFIER;
}
<emit,INITIAL>"," return COMMA;
<emit,INITIAL>{ID}":" {
YYCHOP(); /* trim last ':' */
DUP_AND_RET(valp,LABEL);
}
<emit,INITIAL>{DOT}{LETTER}{LETTERDIGIT}* {
char *macro_name = str_dup(yytext+1);
int type = pmc_type(interp, string_from_cstring(interp, macro_name, 0));
if (type > 0) {
char *buf = (char*)malloc(16);
sprintf(buf, "%d", type);
valp->s = str_dup(buf);
mem_sys_free(buf);
free(macro_name);
return INTC;
}
if (!expand_macro(valp, interp, macro_name, yyscanner)) {
yyless(1);
free(macro_name);
return DOT;
}
free(macro_name);
}
<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->r[0]) &&
r->pcc_sub)
{
if ((r->pcc_sub->pragma & P_METHOD) && !strcmp(yytext, "self")) {
valp->sr = mk_ident(interp, str_dup("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);
}
<*>{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);
valp->s[strlen(valp->s) - 1] = '\0'; /* trailing 'L' */
return STRINGC; /* no BIGINT native format yet */
}
<*>{STRINGCONSTANT} {
valp->s = str_dup(yytext);
return STRINGC; /* RT#42382 delete quotes, -> emit, pbc */
}
<*>"<<"{STRINGCONSTANT} {
struct 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, E_SyntaxError,
"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, E_SyntaxError, "empty heredoc delimiter");
frame = new_frame(interp);
frame->s.next = (struct 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);
IMCC_INFO(interp)->heredoc_content[0] = yytext[2]; /* preserve delim */
IMCC_INFO(interp)->heredoc_content[1] = 0; /* eos */
yy_push_state(heredoc1, yyscanner);
}
<*>{UNICODE} {
valp->s = str_dup(yytext); /* charset:"..." */
/* this is actually not unicode but a string with a charset */
return USTRINGC;
}
<emit,INITIAL>\$I[0-9]+ DUP_AND_RET(valp, IREG);
<emit,INITIAL>\$N[0-9]+ DUP_AND_RET(valp, NREG);
<emit,INITIAL>\$S[0-9]+ DUP_AND_RET(valp, SREG);
<emit,INITIAL>\$P[0-9]+ DUP_AND_RET(valp, PREG);
<emit,INITIAL>\$[a-zA-Z0-9]+ {
IMCC_fataly(interp, E_SyntaxError, "'%s' is not a valid register name", 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" DUP_AND_RET(valp, ENDM);
<macro>{WS}*{EOL} {
IMCC_INFO(interp)->line++;
DUP_AND_RET(valp, '\n');
}
<macro>"$"{ID}":" return LABEL;
<macro>".label"{WS}+ {
char *label;
if (yylex(valp, yyscanner, interp) != LABEL)
IMCC_fataly(interp, E_SyntaxError, "LABEL expected");
if (valp) {
YYCHOP();
label = (char*)mem_sys_allocate(strlen(IMCC_INFO(interp)->cur_macro_name) + yyleng + 15);
sprintf(label, "local__%s__%s__$:", IMCC_INFO(interp)->cur_macro_name, yytext+1);
valp->s = label;
}
return LABEL;
}
<macro>".$"{ID} {
char *label;
if (valp) {
label = (char*)mem_sys_allocate(strlen(IMCC_INFO(interp)->cur_macro_name) + yyleng + 15);
sprintf(label, "local__%s__%s__$", IMCC_INFO(interp)->cur_macro_name, yytext+2);
valp->s = str_dup(label);
mem_sys_free(label);
}
return IDENTIFIER;
}
<macro>^{WS}+ /* skip leading ws */;
<macro>{WS}+ DUP_AND_RET(valp, ' ');
<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
*/
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
Interp* interp = yyget_extra(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 struct macro_frame_t *
new_frame(Interp* interp) {
static int label = 0;
macro_frame_t *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;
tmp->s.file = IMCC_INFO(interp)->frames->s.file;
tmp->s.pragmas = IMCC_INFO(interp)->frames->s.pragmas;
}
tmp->s.interp = interp;
return tmp;
}
static void
scan_string(struct macro_frame_t *frame, const char *expansion, void *yyscanner)
{
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
Interp *interp = yyget_extra(yyscanner);
frame->buffer = YY_CURRENT_BUFFER;
frame->s.next = (struct 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;
int i, ret = 0;
buffer = frame->buffer;
for (i = 0; i < frame->expansion.num_param; i++) {
free(frame->expansion.name[i]);
}
if (frame->heredoc_rest)
mem_sys_free(frame->heredoc_rest);
else
ret = frame->s.line;
/* RT#42383 if frame->s.file was allocated free it */
mem_sys_free(frame);
if (buffer != NULL)
yy_switch_to_buffer(buffer, yyscanner);
return ret;
}
static int
yylex_skip(YYSTYPE *valp, Interp *interp, const char *skip, void *yyscanner)
{
int c;
const char *p;
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
do {
c = yylex(valp, yyscanner, interp);
p = skip;
while (*p && c != *p)
p++;
} while (*p != '\0');
if (c)
DUP_AND_RET_FREE(valp, c);
return c;
}
static char*
read_braced(YYSTYPE *valp, Interp *interp, const char *macro_name,
char *current, void *yyscanner)
{
int c, count, len;
YYSTYPE val;
len = strlen(current);
c = yylex(&val, yyscanner, interp);
count = 0;
while (c != '}' || count > 0) {
if (c == '}') count--;
else if (c == '{') count++;
if (c <= 0)
IMCC_fataly(interp, E_SyntaxError,
"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);
free(val.s);
c = yylex(&val, yyscanner, interp);
}
if (valp)
*valp = val;
else
free(val.s);
return current;
}
static int
read_params(YYSTYPE *valp, Interp *interp, params_t *params,
const char *macro_name, int need_id, void *yyscanner)
{
int c;
YYSTYPE val;
char *current = str_dup("");
int len = 0;
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
params->num_param = 0;
c = yylex_skip(&val, interp, " \n", yyscanner);
while (c != ')') {
if (YYSTATE == heredoc2)
IMCC_fataly(interp, E_SyntaxError,
"Heredoc in macro '%s' not allowed",
macro_name);
if (c <= 0)
IMCC_fataly(interp, E_SyntaxError,
"End of file reached while reading arguments in '%s'",
macro_name);
else if (c == ',') {
if (params->num_param == MAX_PARAM)
IMCC_fataly(interp, E_SyntaxError,
"More then %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, E_SyntaxError,
"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);
}
else {
if (!need_id || c != ' ') {
len += strlen(val.s);
current = (char *)realloc(current, len + 1);
strcat(current, val.s);
}
free(val.s);
c = yylex(&val, yyscanner, interp);
}
}
params->name[params->num_param++] = current;
if (valp)
*valp = val;
else
free(val.s);
return c;
}
static int
read_macro(YYSTYPE *valp, Interp *interp, void *yyscanner)
{
int c;
int start_cond, start_line;
params_t params;
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
IMCC_INFO(interp)->temp_buffer[0]='\0';
start_cond = YY_START;
BEGIN(macro);
c = yylex_skip(valp, interp, " ", yyscanner);
if (c != IDENTIFIER)
IMCC_fataly(interp, E_SyntaxError,
"Macro names must be identifiers");
IMCC_INFO(interp)->cur_macro_name = valp->s;
start_line = IMCC_INFO(interp)->line++;
memset(¶ms, 0, sizeof (params_t));
/* white space is allowed between macro and opening paren) */
c = yylex_skip(valp, interp, " ", yyscanner);
if (c == '(') {
free(valp->s);
c = read_params(NULL, interp, ¶ms,
IMCC_INFO(interp)->cur_macro_name, 1, yyscanner);
c = yylex(valp, yyscanner, interp);
}
while (c != ENDM) {
if (c <= 0)
IMCC_fataly(interp, E_SyntaxError,
"File ended before macro '%s' was complete",
IMCC_INFO(interp)->cur_macro_name);
if (strlen(IMCC_INFO(interp)->temp_buffer) + strlen(valp->s) >=
sizeof (IMCC_INFO(interp)->temp_buffer))
IMCC_fataly(interp, E_SyntaxError,
"Macro '%s' is too big",
IMCC_INFO(interp)->cur_macro_name);
strcat(IMCC_INFO(interp)->temp_buffer, valp->s);
free(valp->s);
c = yylex(valp, yyscanner, interp);
}
free(valp->s);
BEGIN(start_cond);
define_macro(interp, IMCC_INFO(interp)->cur_macro_name,
¶ms, str_dup(IMCC_INFO(interp)->temp_buffer), start_line);
IMCC_INFO(interp)->cur_macro_name = NULL;
return MACRO;
}
static char *
find_macro_param(Interp *interp, const char *name)
{
struct macro_frame_t *f;
int i;
for (f = IMCC_INFO(interp)->frames; f; f = (struct macro_frame_t*)f->s.next) {
if (f->params) {
for (i = 0; i < f->params->num_param; i++) {
if (strcmp(f->params->name[i], name) == 0) {
return f->expansion.name[i];
}
}
}
}
return NULL;
}
static void
define_macro(Interp *interp, char *name, params_t *params,
char *expansion, int start_line)
{
macro_t *m;
m = find_macro(interp, name);
if (m) {
mem_sys_free(name);
mem_sys_free(m->expansion);
}
else {
m = mem_allocate_typed(macro_t);
memset(m, 0, sizeof (macro_t));
if (!IMCC_INFO(interp)->macros)
parrot_new_cstring_hash(interp, &IMCC_INFO(interp)->macros);
parrot_hash_put(interp, IMCC_INFO(interp)->macros, name, m);
}
if (params)
m->params = *params;
else
memset(&m->params, 0, sizeof (params_t));
m->expansion = expansion;
m->line = start_line;
}
static macro_t *
find_macro(Interp *interp, const char *name)
{
DECL_CONST_CAST_OF(char);
if (!IMCC_INFO(interp)->macros)
return NULL;
return (macro_t *)parrot_hash_get(interp,
IMCC_INFO(interp)->macros, const_cast(name));
}
static int
expand_macro(YYSTYPE *valp, Interp *interp, const char *name, void *yyscanner)
{
int c;
struct macro_frame_t *frame;
macro_t *m;
const char *expansion;
int start_cond;
int i;
char *current;
char *s;
int len;
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
UNUSED(valp);
expansion = find_macro_param(interp, name);
if (expansion) {
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) {
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);
/* whitespace can be savely ignored */
do {
c = input(yyscanner);
} while (c == ' ' || c == '\t');
if (c != '(') {
if (m->params.num_param != 0)
IMCC_fataly(interp, E_SyntaxError,
"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, E_SyntaxError,
"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 ++) {
current = frame->expansion.name[i];
if (current[0] == '.') { /* parameter of outer macro */
s = find_macro_param(interp, current + 1);
if (s) {
frame->expansion.name[i] = str_dup(s);
free(current);
}
}
else {
len = strlen(current) - 1;
if (len >= 0 && current[len] == '$') { /* local label */
current[len] = '\0';
s = (char *)mem_sys_allocate(len + 1 + 10);
sprintf(s, "%s%d", current, IMCC_INFO(interp)->frames->label);
frame->expansion.name[i] = s;
free(current);
}
}
}
IMCC_INFO(interp)->line = m->line;
scan_string(frame, m->expansion, yyscanner);
return 1;
}
return 0;
}
static void
include_file(Interp* interp, char *file_name, void *yyscanner)
{
struct macro_frame_t *frame;
FILE *file = 0;
char *ext, *s;
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
frame = new_frame(interp);
s = Parrot_locate_runtime_file(interp, file_name,
PARROT_RUNTIME_FT_INCLUDE);
if (s) {
file = fopen(s, "r");
mem_sys_free(s);
if (!file)
IMCC_fataly(interp, E_IOError, strerror(errno));
}
else
IMCC_fataly(interp, E_IOError, strerror(errno));
frame->s.file = file_name;
frame->s.handle = file;
ext = strrchr(file_name, '.');
if (ext) {
if (strcmp(ext, ".pasm") == 0) {
frame->s.pasm_file = 1;
BEGIN(emit);
}
else if (strcmp(ext, ".pir") == 0) {
frame->s.pasm_file = 0;
BEGIN(INITIAL);
}
}
scan_file(interp, frame, file, yyscanner);
}
static void
scan_file(Interp* interp, struct macro_frame_t *frame, FILE *file, void *yyscanner)
{
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
frame->buffer = YY_CURRENT_BUFFER;
frame->s.next = (struct parser_state_t*)IMCC_INFO(interp)->frames;
IMCC_INFO(interp)->frames = frame;
IMCC_INFO(interp)->state = (struct 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(Interp* interp)
{
struct macro_frame_t *frame;
frame = new_frame(interp);
frame->s.next = (struct parser_state_t*)IMCC_INFO(interp)->frames;
IMCC_INFO(interp)->frames = frame;
frame->s.line = IMCC_INFO(interp)->line = 1;
IMCC_INFO(interp)->state = (struct parser_state_t *) IMCC_INFO(interp)->frames;
}
static void
pop_parser_state(Interp* interp, void *yyscanner)
{
int l;
struct macro_frame_t *tmp;
tmp = IMCC_INFO(interp)->frames;
if (tmp) {
if (tmp->s.handle)
fclose(tmp->s.handle);
IMCC_INFO(interp)->frames = (struct 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 = (struct parser_state_t *) IMCC_INFO(interp)->frames;
}
void
IMCC_pop_parser_state(Interp* interp, void *yyscanner)
{
pop_parser_state(interp, yyscanner);
}
void
compile_file(Interp *interp, FILE *file, void *yyscanner)
{
struct yyguts_t * yyg = (struct 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 != NULL) {
yy_switch_to_buffer(buffer, yyscanner);
}
}
void
compile_string(Interp *interp, char *s, void *yyscanner)
{
struct yyguts_t * yyg = (struct 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 != NULL) {
yy_switch_to_buffer(buffer, yyscanner);
}
}
void
IMCC_print_inc(Interp *interp)
{
struct macro_frame_t *f;
const char *old;
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);
old = IMCC_INFO(interp)->frames->s.file;
for (f = IMCC_INFO(interp)->frames; f; f = (struct macro_frame_t *)f->s.next) {
if (strcmp(f->s.file, old)) {
fprintf(stderr, "\tincluded from '%s' line %d\n",
f->s.file, f->s.line);
}
old = f->s.file;
}
}
/* 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)
{
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
yyg->yyin_r = new_yyin;
return yyg->yyin_r;
}
FILE* imc_yyin_get(void *yyscanner)
{
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
return yyg->yyin_r;
}
/* return true if scanner is at EOF */
int at_eof(yyscan_t yyscanner)
{
struct yyguts_t * yyg = (struct yyguts_t*)yyscanner;
return yyg->yy_hold_char == '\0';
}
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4:
*/
syntax highlighted by Code2HTML, v. 0.9.1