Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: RELEASE_1_2_0
Fetching contributors…

Cannot retrieve contributors at this time

1446 lines (1139 sloc) 41.694 kb
%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 yyguts_t yyguts_t;
typedef struct parser_state_t parser_state_t;
/* parser state structure
* the first few items are common to struct parser_state, but
* we AFAIK need this hack as flex doesn't export YY_BUFFER_STATE */
typedef struct macro_frame_t {
struct parser_state_t s;
/* macro stuff */
params_t *params;
char *heredoc_rest;
params_t expansion;
int label;
int is_macro;
YY_BUFFER_STATE buffer;
} macro_frame_t;
/* short ranged globals for lexer state */
int pesky_global__is_def = 0;
/* static function declarations */
static void pop_parser_state(PARROT_INTERP, ARGMOD(void *yyscanner));
static struct macro_frame_t *new_frame(PARROT_INTERP);
static void define_macro(PARROT_INTERP, ARGIN(const char *name), ARGIN(const params_t *params),
ARGIN(const char *expansion), int start_line);
static macro_t *find_macro(PARROT_INTERP, ARGIN(const char *name));
static void scan_string(macro_frame_t *frame, ARGIN(const char *expansion),
ARGMOD(void *yyscanner));
static void scan_file(PARROT_INTERP, ARGIN(struct macro_frame_t *frame), ARGMOD(FILE *file),
ARGMOD(void *yyscanner));
static int destroy_frame(macro_frame_t *frame, ARGMOD(void *yyscanner));
static int yylex_skip(YYSTYPE *valp, PARROT_INTERP, ARGIN(const char *skip),
ARGMOD(void *yyscanner));
static int read_macro(YYSTYPE *valp, PARROT_INTERP, ARGMOD(void *yyscanner));
static int expand_macro(PARROT_INTERP, ARGIN(const char *name), ARGMOD(void *yyscanner));
static void include_file(PARROT_INTERP, char *file_name, ARGMOD(void *yyscanner));
#define YY_DECL int yylex(YYSTYPE *valp, yyscan_t yyscanner, PARROT_INTERP)
#define YYCHOP() (yytext[--yyleng] = '\0')
#define DUP_AND_RET(valp, token) \
do { \
if (valp) (valp)->s = str_dup(yytext); \
return (token); \
} while (0)
#define DUP_AND_RET_FREE(valp, token) \
do { \
if (valp) { \
mem_sys_free((valp)->s); \
(valp)->s = str_dup(yytext); \
return (token); \
} \
} while (0)
%}
%option reentrant
%option never-interactive
%option stack
LETTER [a-zA-Z_@]
DIGIT [0-9]
DIGITS {DIGIT}+
HEX 0[xX][0-9A-Fa-f]+
OCT 0[oO][0-7]+
BIN 0[bB][01]+
DOT [.]
SIGN [-+]
BIGINT {SIGN}?{DIGITS}"L"
FLOATNUM {SIGN}?(({DIGITS}{DOT}{DIGIT}*|{DOT}{DIGITS})([eE]{SIGN}?{DIGITS})?|{DIGITS}[eE]{SIGN}?{DIGITS})
LETTERDIGIT [a-zA-Z0-9_]
LABELLETTERDIGIT([a-zA-Z0-9_@])
ID {LETTER}{LABELLETTERDIGIT}*
DQ_STRING \"(\\.|[^"\\\n])*\"
ENCCHAR {LETTER}|{DIGIT}|"-"
ENCCHARS {ENCCHAR}*
ENC {LETTER}{ENCCHARS}":"
UNICODE {ENC}{ENC}?{DQ_STRING}
STRINGCONSTANT {SQ_STRING}|{DQ_STRING}
SQ_STRING \'[^'\n]*\'
RANKSPEC \[[,]*\]
EOL \r?\n
WS [\t\f\r\x1a ]
SP [ ]
%x emit
%x macro
%x pod
%x cmt1
%x cmt2
%x cmt3
%x cmt4
%x cmt5
%x heredoc1
%x heredoc2
%%
/* for emacs "*/
if (IMCC_INFO(interp)->expect_pasm == 1 && !IMCC_INFO(interp)->in_pod) {
IMCC_INFO(interp)->expect_pasm = 2;
BEGIN(emit);
}
if (IMCC_INFO(interp)->frames->s.pasm_file && YYSTATE == INITIAL &&
!IMCC_INFO(interp)->in_pod)
{
if (IMCC_INFO(interp)->frames->s.pasm_file == 1) {
BEGIN(emit);
return EMIT;
}
return 0;
}
<heredoc1>.*{EOL} {
IMCC_INFO(interp)->frames->heredoc_rest = str_dup(yytext);
BEGIN(heredoc2);
}
<heredoc2>{EOL} {
/* heredocs have highest priority
* arrange them before all wildcard state matches
*/
/* Newline in the heredoc. Realloc and cat on. */
IMCC_INFO(interp)->line++;
IMCC_INFO(interp)->heredoc_content =
(char*)mem_sys_realloc(IMCC_INFO(interp)->heredoc_content,
strlen(IMCC_INFO(interp)->heredoc_content) +
strlen(yytext) + 2);
strcpy(IMCC_INFO(interp)->heredoc_content +
strlen(IMCC_INFO(interp)->heredoc_content), yytext);
}
<heredoc2>.* {
/* Are we at the end of the heredoc? */
if (STREQ(IMCC_INFO(interp)->heredoc_end, yytext)) {
/* End of the heredoc. */
yyguts_t * const yyg = (yyguts_t *)yyscanner;
const int len = strlen(IMCC_INFO(interp)->heredoc_content);
/* delim */
IMCC_INFO(interp)->heredoc_content[len] =
IMCC_INFO(interp)->heredoc_content[0];
IMCC_INFO(interp)->heredoc_content[len + 1] = 0;
mem_sys_free(IMCC_INFO(interp)->heredoc_end);
IMCC_INFO(interp)->heredoc_end = NULL;
IMCC_INFO(interp)->frames->buffer = YY_CURRENT_BUFFER;
valp->s =
IMCC_INFO(interp)->heredoc_content;
yy_pop_state(yyscanner);
yy_scan_string(IMCC_INFO(interp)->frames->heredoc_rest, yyscanner);
/* RT #42382 delete quotes, -> emit, pbc */
return STRINGC;
}
else {
/* Part of the heredoc. Realloc and cat the line on. */
IMCC_INFO(interp)->heredoc_content =
(char *)mem_sys_realloc(IMCC_INFO(interp)->heredoc_content,
strlen(IMCC_INFO(interp)->heredoc_content) +
strlen(yytext) + 2);
strcpy(IMCC_INFO(interp)->heredoc_content +
strlen(IMCC_INFO(interp)->heredoc_content), yytext);
}
}
<cmt2>[^"]+ {
yy_pop_state(yyscanner);
yy_push_state(cmt3, yyscanner);
IMCC_INFO(interp)->frames->s.file = str_dup(yytext);
IMCC_INFO(interp)->frames->s.file_needs_free = 1;
IMCC_INFO(interp)->cur_unit->file = str_dup(yytext);
return FILECOMMENT;
}
<cmt3>["] {
yy_pop_state(yyscanner);
yy_push_state(cmt4, yyscanner);
}
<*>setfile{SP}+["] { yy_push_state(cmt2, yyscanner); }
<*>setline{SP}+ { yy_push_state(cmt1, yyscanner); }
<cmt1>{DIGITS} {
IMCC_INFO(interp)->line = atoi(yytext);
yy_pop_state(yyscanner);
yy_push_state(cmt4, yyscanner);
return LINECOMMENT;
}
<cmt4>.*{EOL} {
yy_pop_state(yyscanner);
IMCC_INFO(interp)->line++;
}
<INITIAL,emit>{EOL} {
if (IMCC_INFO(interp)->expect_pasm == 2)
BEGIN(INITIAL);
IMCC_INFO(interp)->expect_pasm = 0;
IMCC_INFO(interp)->line++;
return '\n';
}
<INITIAL,emit># {
yy_push_state(cmt5, yyscanner);
}
<cmt5>.*{EOL} {
if (IMCC_INFO(interp)->expect_pasm == 2)
BEGIN(INITIAL);
else
yy_pop_state(yyscanner);
IMCC_INFO(interp)->expect_pasm = 0;
IMCC_INFO(interp)->line++;
return '\n';
}
<INITIAL,emit,macro>^"=cut"{EOL} {
/* this is a stand-alone =cut, but we're
* not in POD mode, so just ignore.
*/
}
<INITIAL,emit,macro>^"=" {
IMCC_INFO(interp)->in_pod = 1;
yy_push_state(pod, yyscanner);
}
<pod>^"=cut"{EOL} {
IMCC_INFO(interp)->in_pod = 0;
yy_pop_state(yyscanner);
IMCC_INFO(interp)->line++;
}
<pod>.* { /*ignore*/ }
<pod>{EOL} { IMCC_INFO(interp)->line++; }
<*>".line" return TK_LINE;
<*>".file" return TK_FILE;
<INITIAL,emit>".annotate" return ANNOTATE;
<INITIAL,emit>".lex" return LEXICAL;
".set_arg" return ARG;
".sub" return SUB;
".end" return ESUB;
".begin_call" return PCC_BEGIN;
".end_call" return PCC_END;
".call" return PCC_CALL;
".nci_call" return NCI_CALL;
".meth_call" return METH_CALL;
".invocant" return INVOCANT;
<emit,INITIAL>".pcc_sub" return PCC_SUB;
".begin_return" return PCC_BEGIN_RETURN;
".end_return" return PCC_END_RETURN;
".begin_yield" return PCC_BEGIN_YIELD;
".end_yield" return PCC_END_YIELD;
<emit,INITIAL>":method" return METHOD;
<emit,INITIAL>":multi" return MULTI;
<emit,INITIAL>":main" return MAIN;
<emit,INITIAL>":load" return LOAD;
<emit,INITIAL>":init" return INIT;
<emit,INITIAL>":immediate" return IMMEDIATE;
<emit,INITIAL>":postcomp" return POSTCOMP;
<emit,INITIAL>":anon" return ANON;
<emit,INITIAL>":outer" return OUTER;
<emit,INITIAL>":lex" return NEED_LEX;
<emit,INITIAL>":vtable" return VTABLE_METHOD;
<emit,INITIAL>":nsentry" return NS_ENTRY;
":unique_reg" return UNIQUE_REG;
":instanceof" return SUB_INSTANCE_OF;
":subid" return SUBID;
".get_result" return RESULT;
".get_results" return GET_RESULTS;
".yield" return YIELDT;
".set_yield" return SET_YIELD;
".return" return RETURN;
".set_return" return SET_RETURN;
".tailcall" return TAILCALL;
<emit,INITIAL>".loadlib" return LOADLIB;
":flat" return ADV_FLAT;
":slurpy" return ADV_SLURPY;
":optional" return ADV_OPTIONAL;
":opt_flag" return ADV_OPT_FLAG;
":named" return ADV_NAMED;
"=>" return ADV_ARROW;
":invocant" return ADV_INVOCANT;
<emit,INITIAL>".namespace" return NAMESPACE;
<emit,INITIAL>".HLL" return HLL;
".local" return LOCAL;
<emit,INITIAL>".const" return CONST;
".globalconst" return GLOBAL_CONST;
".param" return PARAM;
"goto" return GOTO;
"if" return IF;
"unless" return UNLESS;
"null" return PNULL;
"int" return INTV;
"num" return FLOATV;
"pmc" return PMCV;
"string" return STRINGV;
"<<" return SHIFT_LEFT;
">>" return SHIFT_RIGHT;
">>>" return SHIFT_RIGHT_U;
"&&" return LOG_AND;
"||" return LOG_OR;
"~~" return LOG_XOR;
"<" return RELOP_LT;
"<=" return RELOP_LTE;
">" return RELOP_GT;
">=" return RELOP_GTE;
"==" return RELOP_EQ;
"!=" return RELOP_NE;
"**" return POW;
{WS}+"."{WS}+ return CONCAT;
"." return DOT;
"+=" return PLUS_ASSIGN;
"-=" return MINUS_ASSIGN;
"*=" return MUL_ASSIGN;
"/=" return DIV_ASSIGN;
"%=" return MOD_ASSIGN;
"//" return FDIV;
"//=" return FDIV_ASSIGN;
"&=" return BAND_ASSIGN;
"|=" return BOR_ASSIGN;
"~=" return BXOR_ASSIGN;
">>=" return SHR_ASSIGN;
"<<=" return SHL_ASSIGN;
">>>=" return SHR_U_ASSIGN;
".=" return CONCAT_ASSIGN;
<emit,INITIAL>".macro_const" {
int c;
int start_line;
int start_cond = YY_START;
BEGIN(macro);
c = yylex_skip(valp, interp, " ", yyscanner);
if (c != IDENTIFIER)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"Constant names must be identifiers");
IMCC_INFO(interp)->cur_macro_name = valp->s;
start_line = IMCC_INFO(interp)->line;
c = yylex_skip(valp, interp, " ", yyscanner);
if (c != INTC && c != FLOATC && c != STRINGC && c != REG)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"Constant '%s' value must be a number, "
"stringliteral or register", IMCC_INFO(interp)->cur_macro_name);
define_macro(interp, IMCC_INFO(interp)->cur_macro_name, NULL, valp->s, start_line);
IMCC_INFO(interp)->cur_macro_name = NULL;
BEGIN(start_cond);
return MACRO;
}
<emit,INITIAL>".macro" {
return read_macro(valp, interp, yyscanner);
}
<emit,INITIAL>".include" {
const int c = yylex(valp, yyscanner, interp);
if (c != STRINGC)
return c;
YYCHOP();
include_file(interp, yytext + 1, yyscanner);
}
<emit,INITIAL>{ID}"$:" {
if (valp) {
char *label;
size_t len;
YYCHOP();
YYCHOP();
if (!IMCC_INFO(interp)->frames || !IMCC_INFO(interp)->frames->label)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "missing space?");
len = yyleng + 10;
label = (char *)mem_sys_allocate(len);
snprintf(label, len, "%s%d", yytext, IMCC_INFO(interp)->frames->label);
/* XXX: free valp->s if it exists? */
valp->s = label;
}
return LABEL;
}
<emit,INITIAL>{ID}"$" {
if (valp) {
char *label;
size_t len;
YYCHOP();
/* RT #32421 if$I0 is parsed as if$ I0 */
if (!IMCC_INFO(interp)->frames || !IMCC_INFO(interp)->frames->label)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "missing space?");
len = yyleng + 10;
label = (char *)mem_sys_allocate(len);
snprintf(label, len, "%s%d", yytext, IMCC_INFO(interp)->frames->label);
/* XXX: free valp->s if it exists? */
valp->s = label;
}
return IDENTIFIER;
}
<emit,INITIAL>"," return COMMA;
<emit,INITIAL>{ID}":" {
/* trim last ':' */
YYCHOP();
if (valp)
valp->s = yytext;
return LABEL;
}
<emit,INITIAL>{DOT}{LETTER}{LETTERDIGIT}* {
char * const macro_name = yytext + 1;
if (!expand_macro(interp, macro_name, yyscanner)) {
yyless(1);
return DOT;
}
}
<*>{FLOATNUM} DUP_AND_RET(valp, FLOATC);
<*>{SIGN}?{DIGIT}+ DUP_AND_RET(valp, INTC);
<*>{HEX} DUP_AND_RET(valp, INTC);
<*>{BIN} DUP_AND_RET(valp, INTC);
<*>{OCT} DUP_AND_RET(valp, INTC);
<*>{BIGINT} {
valp->s = str_dup(yytext);
/* trailing 'L' */
valp->s[strlen(valp->s) - 1] = '\0';
/* no BIGINT native format yet */
return STRINGC;
}
<*>{STRINGCONSTANT} {
valp->s = str_dup(yytext);
/* RT #42382 delete quotes, -> emit, pbc */
return STRINGC;
}
<*>"<<"{STRINGCONSTANT} {
macro_frame_t *frame;
/* Save the string we want to mark the end of the heredoc and snip
off newline and quote. */
if (IMCC_INFO(interp)->frames->heredoc_rest)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "nested heredoc not supported");
IMCC_INFO(interp)->heredoc_end = str_dup(yytext + 3);
IMCC_INFO(interp)->heredoc_end[strlen(IMCC_INFO(interp)->heredoc_end) - 1] = 0;
if (!strlen(IMCC_INFO(interp)->heredoc_end))
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "empty heredoc delimiter");
frame = new_frame(interp);
frame->s.next = (parser_state_t *)IMCC_INFO(interp)->frames;
IMCC_INFO(interp)->frames = frame;
/* Start slurping up the heredoc. */
IMCC_INFO(interp)->heredoc_content = (char *)mem_sys_allocate(2);
/* preserve delim */
IMCC_INFO(interp)->heredoc_content[0] = yytext[2];
/* eos */
IMCC_INFO(interp)->heredoc_content[1] = 0;
yy_push_state(heredoc1, yyscanner);
}
<*>{UNICODE} {
/* charset:"..." */
valp->s = str_dup(yytext);
/* this is actually not unicode but a string with a charset */
return USTRINGC;
}
<emit,INITIAL>\$I[0-9]+ {
if (valp) (valp)->s = yytext;
if (IMCC_INFO(interp)->state->pasm_file)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"'%s' is not a valid register name in pasm mode", yytext);
return IREG;
}
<emit,INITIAL>\$N[0-9]+ {
if (valp) (valp)->s = yytext;
if (IMCC_INFO(interp)->state->pasm_file)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"'%s' is not a valid register name in pasm mode", yytext);
return NREG;
}
<emit,INITIAL>\$S[0-9]+ {
if (valp) (valp)->s = yytext;
if (IMCC_INFO(interp)->state->pasm_file)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"'%s' is not a valid register name in pasm mode", yytext);
return SREG;
}
<emit,INITIAL>\$P[0-9]+ {
if (valp) (valp)->s = yytext;
if (IMCC_INFO(interp)->state->pasm_file)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"'%s' is not a valid register name in pasm mode", yytext);
return PREG;
}
<emit,INITIAL>\$[a-zA-Z0-9]+ {
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"'%s' is not a valid register name", yytext);
}
<emit,INITIAL>[ISNP]{DIGIT}{DIGIT}? {
if (IMCC_INFO(interp)->state->pasm_file == 0)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"'%s' is only a valid register name in PASM mode", yytext);
if (valp)
valp->s = str_dup(yytext);
return REG;
}
<emit,INITIAL>{ID} {
if (!pesky_global__is_def) {
SymReg *r = find_sym(interp, yytext);
if (r && (r->type & (VTIDENTIFIER|VT_CONSTP))) {
valp->sr = r;
return VAR;
}
if (IMCC_INFO(interp)->cur_unit
&& IMCC_INFO(interp)->cur_unit->instructions
&& (r = IMCC_INFO(interp)->cur_unit->instructions->symregs[0])
&& r->pcc_sub)
{
if (((r->pcc_sub->pragma & P_METHOD)
|| (IMCC_INFO(interp)->cur_unit->is_vtable_method))
&& !strcmp(yytext, "self")) {
valp->sr = mk_ident(interp, "self", 'P');
IMCC_INFO(interp)->cur_unit->type |= IMC_HAS_SELF;
return VAR;
}
}
}
valp->s = str_dup(yytext);
return (!pesky_global__is_def && is_op(interp, valp->s) ? PARROT_OP : IDENTIFIER);
}
<emit,INITIAL>{WS}+ /* skip */;
<emit,cmt1,cmt2,cmt3,cmt4,cmt5,INITIAL>. {
/* catch all except for state macro */
return yytext[0];
}
<emit><<EOF>> {
BEGIN(INITIAL);
if (IMCC_INFO(interp)->frames->s.pasm_file) {
IMCC_INFO(interp)->frames->s.pasm_file = 2;
return EOM;
}
return 0;
}
<INITIAL><<EOF>> yyterminate();
<macro>".endm" DUP_AND_RET(valp, ENDM);
<macro>{WS}*{EOL} {
IMCC_INFO(interp)->line++;
DUP_AND_RET(valp, '\n');
}
<macro>"$"{ID}":" return LABEL;
<macro>".label"{WS}+ {
if (yylex(valp, yyscanner, interp) != LABEL)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "LABEL expected");
if (valp) {
char *label;
size_t len;
YYCHOP();
len = strlen(IMCC_INFO(interp)->cur_macro_name) + yyleng + 15;
label = (char *)mem_sys_allocate(len);
snprintf(label, len, "local__%s__%s__$:",
IMCC_INFO(interp)->cur_macro_name, yytext+1);
/* XXX: free valp->s if it exists? */
valp->s = label;
}
return LABEL;
}
<macro>".$"{ID} {
if (valp) {
const size_t len = strlen(IMCC_INFO(interp)->cur_macro_name) + yyleng + 12;
char * const label = (char *)mem_sys_allocate(len);
snprintf(label, len, "local__%s__%s__$",
IMCC_INFO(interp)->cur_macro_name, yytext+2);
valp->s = label;
}
return IDENTIFIER;
}
<macro>^{WS}+ /* skip leading ws */;
<macro>{WS}+ DUP_AND_RET(valp, ' ');
<macro>[SNIP]{DIGITS} DUP_AND_RET(valp, REG);
<macro>"$"[SNIP]{DIGITS} DUP_AND_RET(valp, REG);
<macro>{ID} DUP_AND_RET(valp, IDENTIFIER);
<macro>{DOT}{ID} DUP_AND_RET(valp, MACRO);
<macro>. DUP_AND_RET(valp, yytext[0]);
<macro><<EOF>> yyterminate();
%%
#ifdef yywrap
# undef yywrap
#endif
int yywrap(void* yyscanner) {
/* Add code here to open next source file and start scanning
* yywrap returns 0 if scanning is to continue */
Interp * const interp = yyget_extra(yyscanner);
yyguts_t * const yyg = (yyguts_t *)yyscanner;
if (!interp) {
fprintf(stderr, "Argh, interp not found\n");
exit(1);
}
yy_delete_buffer(YY_CURRENT_BUFFER, yyscanner);
/* pop old frame */
if (IMCC_INFO(interp)->frames->s.next) {
pop_parser_state(IMCC_INFO(interp)->frames->s.interp, yyscanner);
if (YYSTATE == INITIAL || YYSTATE == emit)
BEGIN(IMCC_INFO(interp)->frames->s.pasm_file ? emit : INITIAL);
return 0;
}
return 1;
}
static macro_frame_t *
new_frame(PARROT_INTERP) {
static int label = 0;
macro_frame_t * const tmp = mem_allocate_zeroed_typed(macro_frame_t);
tmp->label = ++label;
tmp->s.line = IMCC_INFO(interp)->line;
tmp->s.handle = NULL;
if (IMCC_INFO(interp)->frames) {
tmp->s.pasm_file = IMCC_INFO(interp)->frames->s.pasm_file;
if (IMCC_INFO(interp)->frames->s.file_needs_free)
tmp->s.file = str_dup(IMCC_INFO(interp)->frames->s.file);
else
tmp->s.file = IMCC_INFO(interp)->frames->s.file;
tmp->s.file_needs_free = IMCC_INFO(interp)->frames->s.file_needs_free;
}
tmp->s.interp = interp;
return tmp;
}
static void
scan_string(macro_frame_t *frame, ARGIN(const char *expansion), void *yyscanner)
{
yyguts_t * const yyg = (yyguts_t *)yyscanner;
Interp * const interp = yyget_extra(yyscanner);
frame->buffer = YY_CURRENT_BUFFER;
frame->s.next = (parser_state_t *)IMCC_INFO(interp)->frames;
IMCC_INFO(interp)->frames = frame;
yy_scan_string(expansion, yyscanner);
}
static int
destroy_frame(struct macro_frame_t *frame, void *yyscanner)
{
YY_BUFFER_STATE buffer = frame->buffer;
int ret = 0;
int i;
for (i = 0; i < frame->expansion.num_param; i++) {
mem_sys_free(frame->expansion.name[i]);
frame->expansion.name[i] = NULL;
}
if (frame->heredoc_rest) {
mem_sys_free(frame->heredoc_rest);
frame->heredoc_rest = NULL;
} else
ret = frame->s.line;
/* RT #42383 if frame->s.file was allocated free it */
/* Update: This should do it! */
if (frame->s.file_needs_free) {
DECL_CONST_CAST;
mem_sys_free(PARROT_const_cast(char *,frame->s.file));
frame->s.file_needs_free = 0;
}
mem_sys_free(frame);
if (buffer != NULL)
yy_switch_to_buffer(buffer, yyscanner);
return ret;
}
static int
yylex_skip(YYSTYPE *valp, PARROT_INTERP, const char *skip, void *yyscanner)
{
int c;
const char *p;
yyguts_t * const yyg = (yyguts_t *)yyscanner;
do {
c = yylex(valp, yyscanner, interp);
p = skip;
while (*p && c != *p)
p++;
/* leave loop early if it gets found */
if (*p == '\0')
break;
/* free any str_dup()ed strings */
if (yytext)
mem_sys_free(valp->s);
} while (*p != '\0');
if (c)
DUP_AND_RET_FREE(valp, c);
return c;
}
static char*
read_braced(YYSTYPE *valp, PARROT_INTERP, const char *macro_name,
char *current, void *yyscanner)
{
YYSTYPE val;
size_t len = strlen(current);
int c = yylex(&val, yyscanner, interp);
int count = 0;
while (c != '}' || count > 0) {
if (c == '}')
count--;
else if (c == '{')
count++;
if (c <= 0)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"End of file reached while reading arguments in '%s'",
macro_name);
len += strlen(val.s);
current = (char *)realloc(current, len + 1);
strcat(current,val.s);
mem_sys_free(val.s);
val.s = NULL;
c = yylex(&val, yyscanner, interp);
}
if (valp)
*valp = val;
else
mem_sys_free(val.s);
return current;
}
static int
read_params(YYSTYPE *valp, PARROT_INTERP, params_t *params,
ARGIN(const char *macro_name), int need_id, void *yyscanner)
{
YYSTYPE val;
size_t len = 0;
char *current = str_dup("");
yyguts_t *yyg = (yyguts_t *)yyscanner;
int c = yylex_skip(&val, interp, " \n", yyscanner);
params->num_param = 0;
while (c != ')') {
if (YYSTATE == heredoc2)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"Heredoc in macro '%s' not allowed", macro_name);
if (c <= 0)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"End of file reached while reading arguments in '%s'",
macro_name);
else if (c == ',') {
if (params->num_param == MAX_PARAM)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"More than %d params in '%s'",
MAX_PARAM, macro_name);
params->name[params->num_param++] = current;
current = str_dup("");
len = 0;
c = yylex_skip(&val, interp, " \n", yyscanner);
}
else if (need_id && (*current || c != IDENTIFIER) && c != ' ') {
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"Parameter definition in '%s' must be IDENTIFIER",
macro_name);
}
else if (c == '{') {
current = read_braced(&val, interp, macro_name, current, yyscanner);
c = yylex_skip(&val, interp, " \n", yyscanner);
len = strlen(current);
}
else {
if (!need_id || c != ' ') {
len += strlen(val.s);
current = (char *)realloc(current, len + 1);
strcat(current, val.s);
}
mem_sys_free(val.s);
val.s = NULL;
c = yylex(&val, yyscanner, interp);
}
}
params->name[params->num_param++] = current;
if (valp)
*valp = val;
else
mem_sys_free(val.s);
return c;
}
static int
read_macro(YYSTYPE *valp, PARROT_INTERP, void *yyscanner)
{
int c, start_line;
params_t params;
yyguts_t * const yyg = (yyguts_t *)yyscanner;
int start_cond = YY_START;
size_t buffer_size = 0;
size_t buffer_used = 0;
BEGIN(macro);
c = yylex_skip(valp, interp, " ", yyscanner);
if (c != IDENTIFIER)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR, "Macro names must be identifiers");
IMCC_INFO(interp)->cur_macro_name = valp->s;
start_line = IMCC_INFO(interp)->line++;
memset(&params, 0, sizeof (params_t));
/* white space is allowed between macro and opening paren) */
c = yylex_skip(valp, interp, " ", yyscanner);
if (c == '(') {
mem_sys_free(valp->s);
valp->s = NULL;
c = read_params(NULL, interp, &params,
IMCC_INFO(interp)->cur_macro_name, 1, yyscanner);
c = yylex(valp, yyscanner, interp);
}
while (c != ENDM) {
char *old_s = valp->s;
int elem_len;
if (c <= 0) {
mem_sys_free(valp->s);
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"File ended before macro '%s' was complete",
IMCC_INFO(interp)->cur_macro_name);
}
if (valp->s) {
elem_len = strlen(valp->s);
if (buffer_used) {
if (buffer_used + elem_len > buffer_size) {
buffer_size += elem_len;
buffer_size <<= 1;
IMCC_INFO(interp)->macro_buffer =
(char *)mem_sys_realloc(IMCC_INFO(interp)->macro_buffer,
buffer_size);
}
}
else {
buffer_size = (elem_len << 1) > 1024 ? elem_len << 1 : 1024;
IMCC_INFO(interp)->macro_buffer =
(char *)mem_sys_allocate_zeroed(buffer_size);
}
strcat(IMCC_INFO(interp)->macro_buffer, valp->s);
buffer_used += elem_len;
mem_sys_free(valp->s);
valp->s = NULL;
}
c = yylex(valp, yyscanner, interp);
}
mem_sys_free(valp->s);
valp->s = NULL;
BEGIN(start_cond);
define_macro(interp, IMCC_INFO(interp)->cur_macro_name,
&params, IMCC_INFO(interp)->macro_buffer, start_line);
mem_sys_free(IMCC_INFO(interp)->macro_buffer);
IMCC_INFO(interp)->macro_buffer = NULL;
IMCC_INFO(interp)->cur_macro_name = NULL;
return MACRO;
}
static char *
find_macro_param(PARROT_INTERP, const char *name)
{
macro_frame_t *f;
for (f = IMCC_INFO(interp)->frames; f; f = (macro_frame_t *)f->s.next) {
if (f->params) {
int i;
for (i = 0; i < f->params->num_param; i++) {
if (STREQ(f->params->name[i], name))
return f->expansion.name[i];
}
}
}
return NULL;
}
static void
define_macro(PARROT_INTERP, ARGIN(const char *name), ARGIN(const params_t *params),
ARGIN(const char *expansion), int start_line)
{
DECL_CONST_CAST;
macro_t *m = find_macro(interp, name);
if (m) {
mem_sys_free(m->expansion);
m->expansion = NULL;
}
else {
m = mem_allocate_zeroed_typed(macro_t);
if (!IMCC_INFO(interp)->macros)
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 = str_dup(expansion);
m->line = start_line;
}
static macro_t *
find_macro(PARROT_INTERP, const char *name)
{
if (!IMCC_INFO(interp)->macros)
return NULL;
return (macro_t *)parrot_hash_get(interp, IMCC_INFO(interp)->macros, name);
}
static int
expand_macro(PARROT_INTERP, ARGIN(const char *name), void *yyscanner)
{
yyguts_t * const yyg = (yyguts_t *)yyscanner;
const char * const expansion = find_macro_param(interp, name);
macro_t *m;
if (expansion) {
macro_frame_t * const frame = new_frame(interp);
/* When an error occurs, then report it as being in a macro */
frame->is_macro = 1;
scan_string(frame, expansion, yyscanner);
return 1;
}
m = find_macro(interp, name);
if (m) {
int i,c,start_cond;
macro_frame_t * const frame = new_frame(interp);
frame->params = &m->params;
/* When an error occurs, then report it as being in a macro */
frame->is_macro = 1;
/* remember macro name for error reporting
RT #42384 check that all the .file text is malloced / freed */
frame->s.file = str_dup(name);
frame->s.file_needs_free = 1;
/* whitespace can be safely ignored */
do {
#ifdef __cplusplus
c = yyinput(yyscanner);
#else
c = input(yyscanner);
#endif
} while (c == ' ' || c == '\t');
if (c != '(') {
if (m->params.num_param != 0)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"Macro '%s' needs %d arguments",
name, m->params.num_param);
unput(c);
scan_string(frame, m->expansion, yyscanner);
return 1;
}
start_cond = YY_START;
BEGIN(macro);
read_params(NULL, interp, &frame->expansion, name, 0, yyscanner);
BEGIN(start_cond);
if (frame->expansion.num_param == 0 && m->params.num_param == 1) {
frame->expansion.name[0] = str_dup("");
frame->expansion.num_param = 1;
}
if (frame->expansion.num_param != m->params.num_param) {
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"Macro '%s' requires %d arguments, but %d given",
name, m->params.num_param, frame->expansion.num_param);
}
/* expand arguments */
for (i = 0; i < frame->expansion.num_param; i++) {
char * const current = frame->expansion.name[i];
/* parameter of outer macro */
if (current[0] == '.') {
const char * const s = find_macro_param(interp, current + 1);
if (s) {
frame->expansion.name[i] = str_dup(s);
mem_sys_free(current);
}
}
else {
const size_t len = strlen(current);
if (len && (current[len - 1] == '$')) { /* local label */
const size_t slen = len + 10;
char * const s = (char *)mem_sys_allocate(slen);
current[len - 1] = '\0';
snprintf(s, slen, "%s%d", current, IMCC_INFO(interp)->frames->label);
frame->expansion.name[i] = s;
mem_sys_free(current);
}
}
}
IMCC_INFO(interp)->line = m->line;
scan_string(frame, m->expansion, yyscanner);
return 1;
}
return 0;
}
static void
include_file(PARROT_INTERP, char *file_name, void *yyscanner)
{
yyguts_t * const yyg = (yyguts_t *)yyscanner;
macro_frame_t * const frame = new_frame(interp);
char *s = Parrot_locate_runtime_file(interp, file_name,
PARROT_RUNTIME_FT_INCLUDE);
char *ext;
FILE *file;
if (!s || !(file = fopen(s, "r")))
IMCC_fataly(interp, EXCEPTION_EXTERNAL_ERROR, strerror(errno));
mem_sys_free(s);
frame->s.file = file_name;
frame->s.file_needs_free = 0;
frame->s.handle = file;
ext = strrchr(file_name, '.');
if (ext) {
if (STREQ(ext, ".pasm")) {
frame->s.pasm_file = 1;
BEGIN(emit);
}
else if (STREQ(ext, ".pir")) {
frame->s.pasm_file = 0;
BEGIN(INITIAL);
}
}
scan_file(interp, frame, file, yyscanner);
}
static void
scan_file(PARROT_INTERP, macro_frame_t *frame, FILE *file, void *yyscanner)
{
yyguts_t * const yyg = (yyguts_t *)yyscanner;
frame->buffer = YY_CURRENT_BUFFER;
frame->s.next = (parser_state_t *)IMCC_INFO(interp)->frames;
IMCC_INFO(interp)->frames = frame;
IMCC_INFO(interp)->state = (parser_state_t *)IMCC_INFO(interp)->frames;
IMCC_INFO(interp)->line = 1;
yy_switch_to_buffer(yy_create_buffer(file, YY_BUF_SIZE, yyscanner),
yyscanner);
}
void
IMCC_push_parser_state(PARROT_INTERP)
{
macro_frame_t * const frame = new_frame(interp);
frame->s.next = (parser_state_t *)IMCC_INFO(interp)->frames;
IMCC_INFO(interp)->frames = frame;
frame->s.line = IMCC_INFO(interp)->line
= 1;
IMCC_INFO(interp)->state = (parser_state_t *)IMCC_INFO(interp)->frames;
}
static void
pop_parser_state(PARROT_INTERP, void *yyscanner)
{
macro_frame_t * const tmp = IMCC_INFO(interp)->frames;
if (tmp) {
int l;
if (tmp->s.handle)
fclose(tmp->s.handle);
IMCC_INFO(interp)->frames =
(macro_frame_t *)IMCC_INFO(interp)->frames->s.next;
l = destroy_frame(tmp, yyscanner);
if (l)
IMCC_INFO(interp)->line = l;
}
IMCC_INFO(interp)->state = (parser_state_t *)IMCC_INFO(interp)->frames;
}
void
IMCC_pop_parser_state(PARROT_INTERP, void *yyscanner)
{
pop_parser_state(interp, yyscanner);
}
void
compile_file(PARROT_INTERP, FILE *file, void *yyscanner)
{
yyguts_t * const yyg = (yyguts_t *)yyscanner;
YY_BUFFER_STATE buffer;
IMCC_INFO(interp)->frames->s.next = NULL;
buffer = YY_CURRENT_BUFFER;
yy_switch_to_buffer(yy_create_buffer(file, YY_BUF_SIZE, yyscanner),
yyscanner);
emit_open(interp, 1, NULL);
IMCC_TRY(IMCC_INFO(interp)->jump_buf, IMCC_INFO(interp)->error_code) {
yyparse(yyscanner, interp);
imc_compile_all_units(interp);
}
IMCC_CATCH(IMCC_FATAL_EXCEPTION) {
IMCC_INFO(interp)->error_code = IMCC_FATAL_EXCEPTION;
}
IMCC_CATCH(IMCC_FATALY_EXCEPTION) {
IMCC_INFO(interp)->error_code = IMCC_FATALY_EXCEPTION;
}
IMCC_END_TRY;
if (buffer)
yy_switch_to_buffer(buffer, yyscanner);
}
void
compile_string(PARROT_INTERP, const char *s, void *yyscanner)
{
yyguts_t * const yyg = (yyguts_t *)yyscanner;
YY_BUFFER_STATE buffer;
IMCC_INFO(interp)->frames->s.next = NULL;
buffer = YY_CURRENT_BUFFER;
yy_scan_string(s, yyscanner);
emit_open(interp, 1, NULL);
IMCC_TRY(IMCC_INFO(interp)->jump_buf, IMCC_INFO(interp)->error_code) {
yyparse(yyscanner, interp);
imc_compile_all_units(interp);
}
IMCC_CATCH(IMCC_FATAL_EXCEPTION) {
IMCC_INFO(interp)->error_code = IMCC_FATAL_EXCEPTION;
}
IMCC_CATCH(IMCC_FATALY_EXCEPTION) {
IMCC_INFO(interp)->error_code = IMCC_FATALY_EXCEPTION;
}
IMCC_END_TRY;
if (buffer)
yy_switch_to_buffer(buffer, yyscanner);
}
void
IMCC_print_inc(PARROT_INTERP)
{
macro_frame_t *f;
const char *old = IMCC_INFO(interp)->frames->s.file;
if (IMCC_INFO(interp)->frames && IMCC_INFO(interp)->frames->is_macro)
fprintf(stderr, "\n\tin macro '.%s' line %d\n",
IMCC_INFO(interp)->frames->s.file, IMCC_INFO(interp)->line);
else
fprintf(stderr, "\n\tin file '%s' line %d\n",
IMCC_INFO(interp)->frames->s.file, IMCC_INFO(interp)->line);
for (f = IMCC_INFO(interp)->frames; f; f = (macro_frame_t *)f->s.next) {
if (!STREQ(f->s.file, old)) {
fprintf(stderr, "\tincluded from '%s' line %d\n",
f->s.file, f->s.line);
}
old = f->s.file;
}
}
/*
void
set_filename(PARROT_INTERP, char * const filename)
Function to set the C<filename> as specified using the C<.line> directive.
The parser needs to call back into the lexer (this file), because the
parser does not have access to the lexer's private bits.
*/
void
set_filename(PARROT_INTERP, char * const filename)
{
IMCC_INFO(interp)->frames->s.file = filename;
IMCC_INFO(interp)->frames->s.file_needs_free = 1;
/* in case .line is used outside a .sub, then this
* can't be done; hence the check.
* The str_dup() is done, as the original #line implementation
* duplicated the string twice as well; one for the
* frames->s.file and one for cur_unit->file.
* During the parse, the STRINGC is already str_dup()ed once.
*/
if (IMCC_INFO(interp)->cur_unit)
IMCC_INFO(interp)->cur_unit->file = str_dup(filename);
}
/* Functions to set and get yyin, as we can't decorate it for export
(since it is defined in a file generated by yacc/bison). */
FILE* imc_yyin_set(FILE* new_yyin, void *yyscanner)
{
yyguts_t * const yyg = (yyguts_t *)yyscanner;
yyg->yyin_r = new_yyin;
return yyg->yyin_r;
}
FILE* imc_yyin_get(void *yyscanner)
{
const yyguts_t * const yyg = (yyguts_t *)yyscanner;
return yyg->yyin_r;
}
/* return true if scanner is at EOF */
int at_eof(yyscan_t yyscanner)
{
yyguts_t * const yyg = (yyguts_t *)yyscanner;
return yyg->yy_hold_char == '\0';
}
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4:
*/
Jump to Line
Something went wrong with that request. Please try again.