cvsuser 03/12/04 22:36:05
Modified: imcc imcc.l imcc.y pbc.c
Log:
IMCC will generate error if register type is unknown.
P reg types are pmc, object, or a valid classname. Use pmc or
object for "generic" P register.
Also allow subs without _ prepending, allow @ to start labels.
Tweak the fixup code a bit to use flags rather than looking for _ in symbol
name. Add parser stubs for .global to grammar.
Revision Changes Path
1.82 +5 -3 parrot/imcc/imcc.l
Index: imcc.l
===================================================================
RCS file: /cvs/public/parrot/imcc/imcc.l,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -w -r1.81 -r1.82
--- imcc.l 4 Dec 2003 10:30:10 -0000 1.81
+++ imcc.l 5 Dec 2003 06:36:04 -0000 1.82
@@ -77,7 +77,7 @@
%option never-interactive
%option stack
-LETTER [a-zA-Z_]
+LETTER [EMAIL PROTECTED]
DIGIT [0-9]
DIGITS {DIGIT}+
HEX 0x[0-9A-Fa-f]+
@@ -158,7 +158,6 @@
return '\n';
}
-
^".emit"\n {
BEGIN(emit);
return(EMIT);
@@ -205,6 +204,7 @@
".field" return(FIELD);
".method" return(METHOD);
".local" return(LOCAL);
+".global" return(GLOBAL);
".const" return(CONST);
".globalconst" return(GLOBAL_CONST);
".param" return(PARAM);
@@ -224,8 +224,10 @@
"newsub" return(NEWSUB);
"defined" return(DEFINED);
"addr" return(ADDR);
-"global" return(GLOBAL);
+"global" return(GLOBALOP);
"clone" return(CLONE);
+"object" return(OBJECTV);
+"pmc" return(PMCV);
"string" return(STRINGV);
"call" return(CALL);
"saveall" return(SAVEALL);
1.113 +596 -510 parrot/imcc/imcc.y
Index: imcc.y
===================================================================
RCS file: /cvs/public/parrot/imcc/imcc.y,v
retrieving revision 1.112
retrieving revision 1.113
diff -u -w -r1.112 -r1.113
--- imcc.y 24 Nov 2003 06:03:23 -0000 1.112
+++ imcc.y 5 Dec 2003 06:36:04 -0000 1.113
@@ -109,7 +109,6 @@
* labels and such
*/
-
static void clear_state(void)
{
nargs = 0;
@@ -117,7 +116,6 @@
memset(regs, 0, sizeof(regs));
}
-
Instruction * INS_LABEL(IMC_Unit * unit, SymReg * r0, int emit)
{
@@ -144,19 +142,14 @@
return i;
}
-
static Instruction * iSUBROUTINE(IMC_Unit * unit, SymReg * r0) {
Instruction *i;
function = r0->name;
i = iLABEL(unit, r0);
i->line = line - 1;
- if (*r0->name != '_')
- fataly(EX_SOFTWARE, sourcefile, line,
- "illegal local label '%s'\n", r0->name);
return i;
}
-
/*
* substr or X = P[key]
*/
@@ -194,7 +187,6 @@
return 0;
}
-
static char * inv_op(char *op) {
int n;
return (char *) get_neg_op(op, &n);
@@ -223,9 +215,9 @@
%token <t> NAMESPACE ENDNAMESPACE CLASS ENDCLASS FIELD METHOD
%token <t> SUB SYM LOCAL CONST
%token <t> INC DEC GLOBAL_CONST
-%token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV DEFINED LOG_XOR
+%token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV PMCV OBJECTV DEFINED LOG_XOR
%token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
-%token <t> GLOBAL ADDR CLONE RESULT RETURN POW SHIFT_RIGHT_U LOG_AND LOG_OR
+%token <t> GLOBAL GLOBALOP ADDR CLONE RESULT RETURN POW SHIFT_RIGHT_U LOG_AND LOG_OR
%token <t> COMMA ESUB
%token <t> PCC_BEGIN PCC_END PCC_CALL PCC_SUB PCC_BEGIN_RETURN PCC_END_RETURN
%token <t> PCC_BEGIN_YIELD PCC_END_YIELD NCI_CALL
@@ -236,7 +228,7 @@
%token <s> PARROT_OP
%type <t> type newsub
%type <i> program class class_body member_decls member_decl field_decl method_decl
-%type <i> sub emit pcc_sub sub_body pcc_ret pcc_yield
+%type <i> global sub emit pcc_sub sub_body pcc_ret pcc_yield
%type <i> compilation_units compilation_unit
%type <s> classname relop
%type <i> labels _labels label statements statement sub_call
@@ -245,7 +237,7 @@
%type <sr> pcc_returns pcc_return pcc_call arg
%type <t> pcc_proto pcc_sub_proto
%type <i> instruction assignment if_statement labeled_inst opt_label
-%type <sr> target reg const var rc string
+%type <sr> target reg const var string
%type <sr> key keylist _keylist
%type <sr> vars _vars var_or_i _var_or_i label_op
%type <i> pasmcode pasmline pasm_inst
@@ -259,14 +251,25 @@
%start program
+/* In effort to make the grammar readable but not militaristic, please space indent
+ code blocks on 10 col boundaries and keep indentation same for all code blocks
+ in a rule. Indent rule tokens | and ; to 4th col and sub rules 6th col
+ */
+
%%
program:
compilation_units { $$ = 0; }
;
+compilation_units:
+ compilation_unit
+ | compilation_units compilation_unit
+ ;
+
compilation_unit:
class { $$ = $1; cur_unit = 0; }
+ | global { $$ = $1; }
| sub { $$ = $1; imc_close_unit(interp, cur_unit);
cur_unit = 0; }
| pcc_sub { $$ = $1; imc_close_unit(interp, cur_unit);
cur_unit = 0; }
| emit { $$ = $1; imc_close_unit(interp, cur_unit);
cur_unit = 0; }
@@ -274,29 +277,39 @@
| '\n' { $$ = 0; }
;
-compilation_units: compilation_unit
- | compilation_units compilation_unit
+global:
+ GLOBAL type IDENTIFIER
+ {
+ fataly(EX_SOFTWARE, sourcefile, line, ".global not implemented yet\n");
+ $$ = 0;
+ }
+ | GLOBAL type IDENTIFIER '=' const
+ {
+ fataly(EX_SOFTWARE, sourcefile, line, ".global not implemented yet\n");
+ $$ = 0;
+ }
;
-pasmcode: pasmline
+pasmcode:
+ pasmline
| pasmcode pasmline
;
-pasmline: labels pasm_inst '\n' { $$ = 0; }
+pasmline:
+ labels pasm_inst '\n' { $$ = 0; }
| MACRO '\n' { $$ = 0; }
| FILECOMMENT { $$ = 0; }
| LINECOMMENT { $$ = 0; }
;
pasm_inst: {clear_state();}
- PARROT_OP pasm_args { $$ = INS(interp, cur_unit,
- $2,0,regs,nargs,keyvec,1);
+ PARROT_OP pasm_args
+ { $$ = INS(interp, cur_unit, $2,0,regs,nargs,keyvec,1);
free($2); }
- | PCC_SUB LABEL {
- char *name = str_dup($2);
+ | PCC_SUB LABEL
+ { char *name = str_dup($2);
$$ = iSUBROUTINE(cur_unit, mk_sub_label($2));
- $$->r[1] = mk_pcc_sub(name, 0);
- }
+ $$->r[1] = mk_pcc_sub(name, 0); }
| /* none */ { $$ = 0;}
;
@@ -306,41 +319,35 @@
emit:
EMIT { cur_unit = imc_open_unit(interp, IMC_PASM);
- function = "(emit)";
- }
+ function = "(emit)"; }
pasmcode
EOM { /*
if (optimizer_level & OPT_PASM)
imc_compile_unit(interp,
IMC_INFO(interp)->cur_unit);
emit_flush(interp);
*/
- $$=0;
- }
+ $$=0; }
;
class:
CLASS IDENTIFIER
{
Symbol * sym = new_symbol($2);
-
cur_unit = imc_open_unit(interp, IMC_CLASS);
-
current_class = new_class(sym);
sym->p = (void*)current_class;
- store_symbol(&global_sym_tab, sym);
- }
+ store_symbol(&global_sym_tab, sym); }
'\n' class_body ENDCLASS
{
/* Do nothing for now. Need to parse metadata for
* PBC creation. */
current_class = NULL;
- $$ = 0;
- }
+ $$ = 0; }
;
class_body:
member_decls
- | { $$ = 0; }
+ | /* none */ { $$ = 0; }
;
member_decls:
@@ -365,8 +372,7 @@
}
sym->type = $2;
store_field_symbol(current_class, sym);
- $$ = 0;
- }
+ $$ = 0; }
;
method_decl:
@@ -402,31 +408,20 @@
sub_body { $$ = 0; }
;
-sub_params: /* empty */ { $$ = 0; } %prec LOW_PREC
+sub_params:
+ /* empty */ { $$ = 0; } %prec LOW_PREC
| '\n' { $$ = 0; }
| sub_params sub_param '\n' { add_pcc_param($<sr>0, $2);}
;
-sub_param: PARAM { is_def=1; }
+sub_param:
+ PARAM { is_def=1; }
type IDENTIFIER { $$ = mk_ident($4, $3); is_def=0; }
;
sub_body:
- statements ESUB
- {
- $$ = 0;
- }
- ;
-
-/*
-sub_start:
- SUB { cur_unit = imc_open_unit(interp,
IMC_PCCSUB); }
- IDENTIFIER '\n'
- { $$ = 0;
- iSUBROUTINE(cur_unit, mk_sub_label($3));
- }
+ statements ESUB { $$ = 0; }
;
-*/
pcc_sub:
PCC_SUB { cur_unit = imc_open_unit(interp, IMC_PCCSUB); }
@@ -441,26 +436,30 @@
sub_body { $$ = 0; }
;
-pcc_params: /* empty */ { $$ = 0; } %prec LOW_PREC
+pcc_params:
+ /* empty */ { $$ = 0; } %prec LOW_PREC
| '\n' { $$ = 0; }
| pcc_params pcc_param '\n' { add_pcc_param($<sr>0, $2);}
;
-pcc_param: PARAM { is_def=1; }
+pcc_param:
+ PARAM { is_def=1; }
type IDENTIFIER { $$ = mk_ident($4, $3); is_def=0; }
;
-pcc_sub_call: PCC_BEGIN pcc_proto '\n' {
+pcc_sub_call:
+ PCC_BEGIN pcc_proto '\n'
+ {
char name[128];
SymReg * r;
Instruction *i;
- sprintf(name, "_%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR, line - 1);
+ sprintf(name, "%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR, line - 1);
$<sr>$ = r = mk_pcc_sub(str_dup(name), 0);
r->pcc_sub->prototyped = $2;
/* this mid rule action has the semantic value of the
- sub SymReg.
- This is used below to append args & results
+ * sub SymReg.
+ * This is used below to append args & results
*/
i = iLABEL(cur_unit, r);
i->type = ITPCCSUB;
@@ -478,48 +477,61 @@
PCC_END '\n' { $$ = 0; }
;
-opt_label: /* empty */ { $$ = NULL; $<sr>-2 ->pcc_sub->label = 0; }
+opt_label:
+ /* empty */ { $$ = NULL; $<sr>-2 ->pcc_sub->label = 0; }
| label '\n' { $$ = NULL; $<sr>-2 ->pcc_sub->label = 1; }
;
-pcc_proto: PROTOTYPED { $$ = 1; }
+pcc_proto:
+ PROTOTYPED { $$ = 1; }
| NON_PROTOTYPED { $$ = 0; }
;
-pcc_sub_proto: /* empty */ { $$ = -1; }
+pcc_sub_proto:
+ /* empty */ { $$ = -1; }
| pcc_proto
;
-pcc_call: PCC_CALL var COMMA var '\n' {
+pcc_call:
+ PCC_CALL var COMMA var '\n'
+ {
add_pcc_sub($<sr>-1, $2);
add_pcc_cc($<sr>-1, $4);
}
- | PCC_CALL var '\n' {
- add_pcc_sub($<sr>-1, $2);
- }
- | NCI_CALL var '\n' {
+ | PCC_CALL var '\n'
+ { add_pcc_sub($<sr>-1, $2); }
+ | NCI_CALL var '\n'
+ {
add_pcc_sub($<sr>-1, $2);
$<sr>-1 ->pcc_sub->nci = 1;
}
;
-pcc_args: /* empty */ { $$ = 0; }
+pcc_args:
+ /* empty */ { $$ = 0; }
| pcc_args pcc_arg '\n' { add_pcc_arg($<sr>0, $2);}
;
-pcc_arg: ARG var { $$ = $2; }
+pcc_arg:
+ ARG var { $$ = $2; }
| FLATTEN_ARG target { $2->type |= VT_FLATTEN; $$ = $2; }
;
-pcc_results: /* empty */ { $$ = 0; }
+pcc_results:
+ /* empty */ { $$ = 0; }
| pcc_results pcc_result '\n' { if($2) add_pcc_result($<sr>-3, $2); }
;
-pcc_result: RESULT target { $$ = $2; }
- | LOCAL { is_def=1; } type IDENTIFIER { mk_ident($4, $3);is_def=0; $$=0; }
+pcc_result:
+ RESULT target
+ { $$ = $2; }
+ | LOCAL { is_def=1; } type IDENTIFIER
+ { mk_ident($4, $3); is_def=0; $$=0; }
;
-pcc_ret: PCC_BEGIN_RETURN '\n' {
+pcc_ret:
+ PCC_BEGIN_RETURN '\n'
+ {
Instruction *i, *ins;
SymReg *r;
char name[128];
@@ -527,16 +539,19 @@
if (!ins || !ins->r[1] || ins->r[1]->type != VT_PCC_SUB)
fataly(EX_SOFTWARE, sourcefile, line,
"pcc_return not inside pcc subroutine\n");
- sprintf(name, "_%cpcc_sub_ret_%d", IMCC_INTERNAL_CHAR, line - 1);
+ sprintf(name, "%cpcc_sub_ret_%d", IMCC_INTERNAL_CHAR, line - 1);
$<sr>$ = r = mk_pcc_sub(str_dup(name), 0);
i = iLABEL(cur_unit, r);
i->type = ITPCCSUB | ITLABEL;
}
pcc_returns
- PCC_END_RETURN '\n' { $$ = 0; }
+ PCC_END_RETURN '\n'
+ { $$ = 0; }
;
-pcc_yield: PCC_BEGIN_YIELD '\n' {
+pcc_yield:
+ PCC_BEGIN_YIELD '\n'
+ {
Instruction *i, *ins;
SymReg *r;
char name[128];
@@ -545,24 +560,30 @@
fataly(EX_SOFTWARE, sourcefile, line,
"pcc_yield not inside pcc subroutine\n");
ins->r[1]->pcc_sub->calls_a_sub = 1;
- sprintf(name, "_%cpcc_sub_yield_%d", IMCC_INTERNAL_CHAR, line - 1);
+ sprintf(name, "%cpcc_sub_yield_%d", IMCC_INTERNAL_CHAR, line - 1);
$<sr>$ = r = mk_pcc_sub(str_dup(name), 0);
i = iLABEL(cur_unit, r);
i->type = ITPCCSUB | ITLABEL | ITPCCYIELD;
}
pcc_returns
- PCC_END_YIELD '\n' { $$ = 0; }
+ PCC_END_YIELD '\n'
+ { $$ = 0; }
;
-pcc_returns: /* empty */ { $$ = 0; }
- | pcc_returns '\n' { if($1) add_pcc_return($<sr>0, $1); }
- | pcc_returns pcc_return '\n' { if($2) add_pcc_return($<sr>0, $2); }
+pcc_returns:
+ /* empty */ { $$ = 0; }
+ | pcc_returns '\n'
+ { if($1) add_pcc_return($<sr>0, $1); }
+ | pcc_returns pcc_return '\n'
+ { if($2) add_pcc_return($<sr>0, $2); }
;
-pcc_return: RETURN var { $$ = $2; }
+pcc_return:
+ RETURN var { $$ = $2; }
;
-statements: statement
+statements:
+ statement
| statements statement
;
@@ -573,10 +594,13 @@
* of the 'pcc_params' (which is what we want). However, yacc syntax
* doesn't propagate precedence to the dummy rules, so we have to
* split out the action just so that we can assign it a precedence. */
-helper_clear_state: { clear_state(); } %prec LOW_PREC
+
+helper_clear_state:
+ { clear_state(); } %prec LOW_PREC
;
-statement: helper_clear_state
+statement:
+ helper_clear_state
instruction { $$ = $2; }
| MACRO '\n' { $$ = 0; }
| sub_call { $$ = 0; current_call = NULL; }
@@ -587,19 +611,26 @@
| LINECOMMENT { $$ = 0; }
;
-labels: /* none */ { $$ = NULL; }
+labels:
+ /* none */ { $$ = NULL; }
| _labels
;
-_labels: _labels label
+_labels:
+ _labels label
| label
;
-label: LABEL { $$ = iLABEL(cur_unit, mk_address($1,
U_add_uniq_label)); }
+label:
+ LABEL {
+ /* $$ = iLABEL(cur_unit, mk_address($1, U_add_uniq_label)); */
+ $$ = iLABEL(cur_unit, mk_local_label(cur_unit, $1));
+ }
;
instruction:
- labels labeled_inst '\n' { $$ = $2; }
+ labels labeled_inst '\n'
+ { $$ = $2; }
;
labeled_inst:
@@ -626,8 +657,10 @@
| RESTOREALL { $$ = MK_I(interp, cur_unit, "restoreall"
,0); }
| END { $$ = MK_I(interp, cur_unit, "end" ,0); }
| NEWSUB { expect_pasm = 1; }
- pasm_args { $$ = INS(interp, cur_unit,
"newsub",0,regs,nargs,keyvec,1); }
- | PARROT_OP vars { $$ = INS(interp, cur_unit, $1, 0, regs, nargs,
keyvec, 1);
+ pasm_args
+ { $$ = INS(interp, cur_unit, "newsub",0,regs,nargs,keyvec,1); }
+ | PARROT_OP vars
+ { $$ = INS(interp, cur_unit, $1, 0, regs, nargs, keyvec, 1);
free($1); }
| /* none */ { $$ = 0;}
;
@@ -643,11 +676,18 @@
INTV { $$ = 'I'; }
| FLOATV { $$ = 'N'; }
| STRINGV { $$ = 'S'; }
+ | PMCV { $$ = 'P'; }
+ | OBJECTV { $$ = 'P'; }
| classname { $$ = 'P'; free($1); }
;
classname:
IDENTIFIER
+ {
+ if((pmc_type(interp, string_from_cstring(interp, $1, 0))) <= 0) {
+ fataly(1, sourcefile, line, "Unknown PMC type '%s'\n", $1);
+ }
+ }
;
assignment:
@@ -662,44 +702,69 @@
| target '=' var '/' var { $$ = MK_I(interp, cur_unit, "div",
3, $1, $3, $5); }
| target '=' var '%' var { $$ = MK_I(interp, cur_unit, "mod",
3, $1, $3, $5); }
| target '=' var '.' var { $$ = MK_I(interp, cur_unit,
"concat", 3, $1,$3,$5); }
- | target '=' var SHIFT_LEFT var { $$ = MK_I(interp, cur_unit, "shl", 3, $1,
$3, $5); }
- | target '=' var SHIFT_RIGHT var { $$ = MK_I(interp, cur_unit, "shr",
3, $1, $3, $5); }
- | target '=' var SHIFT_RIGHT_U var { $$ = MK_I(interp, cur_unit, "lsr",
3, $1, $3, $5); }
- | target '=' var LOG_AND var { $$ = MK_I(interp, cur_unit, "and", 3, $1,
$3, $5); }
- | target '=' var LOG_OR var { $$ = MK_I(interp, cur_unit, "or", 3, $1, $3,
$5); }
- | target '=' var LOG_XOR var { $$ = MK_I(interp, cur_unit, "xor", 3, $1,
$3, $5); }
- | target '=' var '&' var { $$ = MK_I(interp, cur_unit, "band",
3, $1, $3, $5); }
- | target '=' var '|' var { $$ = MK_I(interp, cur_unit, "bor",
3, $1, $3, $5); }
- | target '=' var '~' var { $$ = MK_I(interp, cur_unit, "bxor",
3, $1, $3, $5); }
- | target '=' var '[' keylist ']' { $$ = iINDEXFETCH(interp, cur_unit, $1,
$3, $5); }
- | var '[' keylist ']' '=' var { $$ = iINDEXSET(interp, cur_unit, $1, $3,
$6); }
- | target '=' NEW classname COMMA var { $$ = iNEW(interp, cur_unit, $1, $4, $6,
1); }
- | target '=' NEW classname { $$ = iNEW(interp, cur_unit, $1, $4,
NULL, 1); }
- | target '=' newsub IDENTIFIER { $$ = iNEWSUB(interp, cur_unit, $1, $3,
- mk_address($4, U_add_once), NULL,
1); }
- | target '=' newsub IDENTIFIER COMMA
- IDENTIFIER { /* XXX: Fix 4arg version of newsub PASM op
+ | target '=' var SHIFT_LEFT var
+ { $$ = MK_I(interp, cur_unit, "shl", 3, $1, $3, $5); }
+ | target '=' var SHIFT_RIGHT var
+ { $$ = MK_I(interp, cur_unit, "shr", 3, $1, $3, $5); }
+ | target '=' var SHIFT_RIGHT_U var
+ { $$ = MK_I(interp, cur_unit, "lsr", 3, $1, $3, $5); }
+ | target '=' var LOG_AND var
+ { $$ = MK_I(interp, cur_unit, "and", 3, $1, $3, $5); }
+ | target '=' var LOG_OR var
+ { $$ = MK_I(interp, cur_unit, "or", 3, $1, $3, $5); }
+ | target '=' var LOG_XOR var
+ { $$ = MK_I(interp, cur_unit, "xor", 3, $1, $3, $5); }
+ | target '=' var '&' var
+ { $$ = MK_I(interp, cur_unit, "band", 3, $1, $3, $5); }
+ | target '=' var '|' var
+ { $$ = MK_I(interp, cur_unit, "bor", 3, $1, $3, $5); }
+ | target '=' var '~' var
+ { $$ = MK_I(interp, cur_unit, "bxor", 3, $1, $3, $5); }
+ | target '=' var '[' keylist ']'
+ { $$ = iINDEXFETCH(interp, cur_unit, $1, $3, $5); }
+ | var '[' keylist ']' '=' var
+ { $$ = iINDEXSET(interp, cur_unit, $1, $3, $6); }
+ | target '=' NEW classname COMMA var
+ { $$ = iNEW(interp, cur_unit, $1, $4, $6, 1); }
+ | target '=' NEW classname
+ { $$ = iNEW(interp, cur_unit, $1, $4, NULL, 1); }
+ | target '=' newsub IDENTIFIER
+ { $$ = iNEWSUB(interp, cur_unit, $1, $3,
+ mk_sub_address($4), NULL, 1); }
+ | target '=' newsub IDENTIFIER COMMA IDENTIFIER
+ { /* XXX: Fix 4arg version of newsub PASM op
* to use $1 instead of implicit P0
*/
$$ = iNEWSUB(interp, cur_unit, NULL, $3,
- mk_address($4, U_add_once),
- mk_address($6, U_add_once), 1); }
- | target '=' DEFINED var { $$ = MK_I(interp, cur_unit,
"defined",2, $1,$4); }
- | target '=' DEFINED var '[' keylist ']' { keyvec=KEY_BIT(2);
+ mk_sub_address($4),
+ mk_sub_address($6), 1); }
+ | target '=' DEFINED var
+ { $$ = MK_I(interp, cur_unit, "defined", 2, $1, $4); }
+ | target '=' DEFINED var '[' keylist ']'
+ { keyvec=KEY_BIT(2);
$$ = MK_I(interp, cur_unit, "defined", 3, $1,
$4, $6); }
- | target '=' CLONE var { $$ = MK_I(interp, cur_unit, "clone",2, $1,
$4); }
- | target '=' ADDR IDENTIFIER { $$ = MK_I(interp, cur_unit, "set_addr",
- 2, $1, mk_address($4,U_add_once)); }
- | target '=' GLOBAL string { $$ = MK_I(interp, cur_unit, "find_global",2,
$1,$4); }
- | GLOBAL string '=' var { $$ = MK_I(interp, cur_unit, "store_global",2,
$2,$4); }
- /* NEW and NEWSUB are here because they are both PIR and PASM keywords so we
+ | target '=' CLONE var
+ { $$ = MK_I(interp, cur_unit, "clone",2, $1, $4); }
+ | target '=' ADDR IDENTIFIER
+ { $$ = MK_I(interp, cur_unit, "set_addr",
+ 2, $1, mk_label_address(cur_unit, $4)); }
+ | target '=' GLOBALOP string
+ { $$ = MK_I(interp, cur_unit, "find_global",2,$1,$4);}
+ | GLOBALOP string '=' var
+ { $$ = MK_I(interp, cur_unit, "store_global",2, $2,$4); }
+ /* NEW and is here because it is both PIR and PASM keywords so we
* have to handle the token here (or badly hack the lexer). */
- | NEW { expect_pasm = 1; }
- pasm_args { $$ = INS(interp, cur_unit, "new",0,regs,nargs,keyvec,1);
}
- | DEFINED target COMMA var { $$ = MK_I(interp, cur_unit, "defined", 2, $2,
$4); }
- | DEFINED target COMMA var '[' keylist ']' { keyvec=KEY_BIT(2);
+ | NEW
+ { expect_pasm = 1; }
+ pasm_args
+ { $$ = INS(interp, cur_unit, "new",0,regs,nargs,keyvec,1); }
+ | DEFINED target COMMA var
+ { $$ = MK_I(interp, cur_unit, "defined", 2, $2, $4); }
+ | DEFINED target COMMA var '[' keylist ']'
+ { keyvec=KEY_BIT(2);
$$ = MK_I(interp, cur_unit, "defined", 3, $2, $4,
$6); }
- | CLONE target COMMA var { $$ = MK_I(interp, cur_unit, "clone", 2, $2,
$4); }
+ | CLONE target COMMA var
+ { $$ = MK_I(interp, cur_unit, "clone", 2, $2, $4); }
/* Subroutine call the short way */
| target '=' sub_call
{
@@ -712,7 +777,7 @@
char name[128];
SymReg * r;
Instruction *i;
- sprintf(name, "_%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR, line - 1);
+ sprintf(name, "%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR, line - 1);
r = mk_pcc_sub(str_dup(name), 0);
current_call = i = iLABEL(cur_unit, r);
i->type = ITCALL | ITPCCSUB;
@@ -720,8 +785,8 @@
}
'(' targetlist ')' '=' IDENTIFIER '(' arglist ')'
{
- current_call->r[0]->pcc_sub->sub = mk_address($6, U_add_once);
- current_call->r[0]->pcc_sub->prototyped = 1;
+ current_call->r[0]->pcc_sub->sub = mk_sub_address($6);
+ current_call->r[0]->pcc_sub->prototyped = 0;
if (cur_unit->type == IMC_PCCSUB)
cur_unit->instructions->r[1]->pcc_sub->calls_a_sub = 1;
@@ -735,13 +800,13 @@
char name[128];
SymReg * r;
Instruction *i;
- sprintf(name, "_%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR, line - 1);
+ sprintf(name, "%cpcc_sub_call_%d", IMCC_INTERNAL_CHAR, line - 1);
r = mk_pcc_sub(str_dup(name), 0);
current_call = i = iLABEL(cur_unit, r);
i->type = ITCALL | ITPCCSUB;
$$ = i;
- current_call->r[0]->pcc_sub->sub = mk_address($1, U_add_once);
- current_call->r[0]->pcc_sub->prototyped = 1;
+ current_call->r[0]->pcc_sub->sub = mk_sub_address($1);
+ current_call->r[0]->pcc_sub->prototyped = 0;
if (cur_unit->type == IMC_PCCSUB)
cur_unit->instructions->r[1]->pcc_sub->calls_a_sub = 1;
}
@@ -749,13 +814,17 @@
{ $$ = $<i>2; }
;
-arglist: /* empty */ { $$ = 0; }
+arglist:
+ /* empty */ { $$ = 0; }
| arglist COMMA arg { $$ = 0; add_pcc_arg(current_call->r[0], $3); }
| arg { $$ = 0; add_pcc_arg(current_call->r[0], $1); }
;
-arg: var { $$ = $1; }
- | FLATTEN_ARG target { $2->type |= VT_FLATTEN; $$ = $2; }
+arg:
+ var
+ { $$ = $1; }
+ | FLATTEN_ARG target
+ { $2->type |= VT_FLATTEN; $$ = $2; }
;
targetlist:
@@ -764,14 +833,18 @@
;
if_statement:
- IF var relop var GOTO label_op {$$=MK_I(interp, cur_unit, $3, 3, $2, $4,
$6); }
- | UNLESS var relop var GOTO label_op {$$=MK_I(interp, cur_unit, inv_op($3),
- 3, $2,$4, $6); }
- | IF var GOTO label_op {$$= MK_I(interp, cur_unit, "if", 2, $2, $4);
}
- | UNLESS var GOTO label_op {$$= MK_I(interp, cur_unit, "unless",2, $2,
$4); }
- | IF var COMMA label_op {$$= MK_I(interp, cur_unit, "if", 2, $2, $4);
}
- | UNLESS var COMMA label_op {$$= MK_I(interp, cur_unit, "unless", 2, $2,
$4); }
-
+ IF var relop var GOTO label_op
+ { $$ =MK_I(interp, cur_unit, $3, 3, $2, $4, $6); }
+ | UNLESS var relop var GOTO label_op
+ { $$ =MK_I(interp, cur_unit, inv_op($3), 3, $2,$4, $6); }
+ | IF var GOTO label_op
+ { $$ = MK_I(interp, cur_unit, "if", 2, $2, $4); }
+ | UNLESS var GOTO label_op
+ { $$ = MK_I(interp, cur_unit, "unless",2, $2, $4); }
+ | IF var COMMA label_op
+ { $$ = MK_I(interp, cur_unit, "if", 2, $2, $4); }
+ | UNLESS var COMMA label_op
+ { $$ = MK_I(interp, cur_unit, "unless", 2, $2, $4); }
;
relop:
@@ -783,31 +856,39 @@
| RELOP_LTE { $$ = "le"; }
;
-target: VAR
+target:
+ VAR
| reg
;
-lhs: VAR /* duplicated because of reduce conflict */
+lhs:
+ VAR /* duplicated because of reduce conflict */
| reg
;
-vars: { $$ = NULL; }
+vars:
+ /* empty */ { $$ = NULL; }
| _vars { $$ = $1; }
;
-_vars: _vars COMMA _var_or_i { $$ = regs[0]; }
+_vars:
+ _vars COMMA _var_or_i { $$ = regs[0]; }
| _var_or_i
;
-_var_or_i: var_or_i { regs[nargs++] = $1; }
- | lhs '[' keylist ']' { regs[nargs++] = $1;
+_var_or_i:
+ var_or_i { regs[nargs++] = $1; }
+ | lhs '[' keylist ']'
+ {
+ regs[nargs++] = $1;
keyvec |= KEY_BIT(nargs);
- regs[nargs++] = $3; $$ = $1; }
+ regs[nargs++] = $3; $$ = $1;
+ }
;
label_op:
- IDENTIFIER { $$ = mk_address($1, U_add_once); }
- | PARROT_OP { $$ = mk_address($1, U_add_once); }
+ IDENTIFIER { $$ = mk_label_address(cur_unit, $1); }
+ | PARROT_OP { $$ = mk_label_address(cur_unit, $1); }
;
var_or_i:
@@ -815,42 +896,47 @@
| var
;
-var: VAR
- | rc
+var:
+ VAR
+ | reg
+ | const
;
keylist: { nkeys=0; }
_keylist { $$ = link_keys(nkeys, keys); }
;
-_keylist: key { keys[nkeys++] = $1; }
- | _keylist ';' key { keys[nkeys++] = $3; $$ = keys[0]; }
+_keylist:
+ key { keys[nkeys++] = $1; }
+ | _keylist ';' key
+ { keys[nkeys++] = $3; $$ = keys[0]; }
;
-key: var
- ;
-
-rc: reg
- | const
+key:
+ var
;
-reg: IREG { $$ = mk_symreg($1, 'I'); }
+reg:
+ IREG { $$ = mk_symreg($1, 'I'); }
| NREG { $$ = mk_symreg($1, 'N'); }
| SREG { $$ = mk_symreg($1, 'S'); }
| PREG { $$ = mk_symreg($1, 'P'); }
| REG { $$ = mk_pasm_reg($1); }
;
-const: INTC { $$ = mk_const($1, 'I'); }
+const:
+ INTC { $$ = mk_const($1, 'I'); }
| FLOATC { $$ = mk_const($1, 'N'); }
| STRINGC { $$ = mk_const($1, 'S'); }
;
-string: SREG { $$ = mk_symreg($1, 'S'); }
+string:
+ SREG { $$ = mk_symreg($1, 'S'); }
| STRINGC { $$ = mk_const($1, 'S'); }
;
+/* The End */
%%
1.61 +15 -2 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -w -r1.60 -r1.61
--- pbc.c 24 Nov 2003 06:03:23 -0000 1.60
+++ pbc.c 5 Dec 2003 06:36:04 -0000 1.61
@@ -279,6 +279,11 @@
bsr = _mk_address(globals.cs->subs->bsrs, str_dup(r->name), U_add_all);
bsr->color = pc;
bsr->score = offset; /* bsr = 1, set_addr I,x = 2, newsub = 3 */
+ /* This is hackish but its better to have it here than in the
+ * fixup code until we decide if we need the _globallabel semantic.
+ */
+ if(r->name[0] == '_')
+ bsr->usage |= U_FIXUP;
}
static void
@@ -369,7 +374,7 @@
for (ins = unit->instructions; ins ; ins = ins->next) {
SymReg *addr, *label;
if ((ins->type & ITLABEL) &&
- (has_compile || *ins->r[0]->name == '_')) {
+ (has_compile || ins->r[0]->usage & U_FIXUP)) {
/* XXX labels should be mangled with current subroutine name
* they should only be reachable from eval's in current sub
*/
@@ -453,8 +458,16 @@
for (s = globals.cs->first; s; s = s->next) {
for(i = 0; i < HASH_SIZE; i++) {
for(bsr = s->bsrs[i]; bsr; bsr = bsr->next ) {
- if (*bsr->name != '_')
+#if IMC_TRACE_HIGH
+ fprintf(stderr, "fixup_bsr %s\n", bsr->name);
+#endif
+ if (!(bsr->usage & U_FIXUP))
+ {
+#if IMC_TRACE_HIGH
+ fprintf(stderr, "skip fixup %s\n", bsr->name);
+#endif
continue;
+ }
lab = find_global_label(bsr->name, &pc);
if (!lab) {
/* TODO continue; */
