cvsuser 04/10/30 04:32:24
Modified: imcc imcc.l imcc.y pbc.c
imcc/t/syn const.t
src trace.c
t/pmc pmc.t
Log:
PMC constants 2 - .const .Sub foo syntax
Revision Changes Path
1.117 +1 -1 parrot/imcc/imcc.l
Index: imcc.l
===================================================================
RCS file: /cvs/public/parrot/imcc/imcc.l,v
retrieving revision 1.116
retrieving revision 1.117
diff -u -r1.116 -r1.117
--- imcc.l 7 Oct 2004 13:36:49 -0000 1.116
+++ imcc.l 30 Oct 2004 11:32:19 -0000 1.117
@@ -217,7 +217,7 @@
".method" return(DOT_METHOD);
".local" return(LOCAL);
".global" return(GLOBAL);
-".const" return(CONST);
+<emit,INITIAL>".const" return(CONST);
".globalconst" return(GLOBAL_CONST);
".param" return(PARAM);
"goto" return(GOTO);
1.148 +51 -8 parrot/imcc/imcc.y
Index: imcc.y
===================================================================
RCS file: /cvs/public/parrot/imcc/imcc.y,v
retrieving revision 1.147
retrieving revision 1.148
diff -u -r1.147 -r1.148
--- imcc.y 13 Oct 2004 07:05:17 -0000 1.147
+++ imcc.y 30 Oct 2004 11:32:19 -0000 1.148
@@ -109,6 +109,43 @@
}
static Instruction*
+mk_pmc_const(Parrot_Interp interp, IMC_Unit *unit,
+ char *type, SymReg *left, char *constant)
+{
+ int type_enum = atoi(type);
+ SymReg *rhs;
+ SymReg *r[IMCC_MAX_REGS];
+ char *name;
+ int len;
+
+ if (left->type == VTADDRESS) { /* IDENTIFIER */
+ if (pasm_file) {
+ fataly(EX_UNAVAILABLE, sourcefile, line, "Ident as PMC constant",
+ " %s\n", left->name);
+ }
+ left->type = VTIDENTIFIER;
+ left->set = 'P';
+ }
+ r[0] = left;
+ /* strip delimiters */
+ len = strlen(constant);
+ name = mem_sys_allocate(len);
+ constant[len - 1] = '\0';
+ strcpy(name, constant + 1);
+ free(constant);
+ rhs = mk_const(name, 'p');
+ r[1] = rhs;
+ switch (type_enum) {
+ case enum_class_Sub:
+ rhs->usage = U_FIXUP;
+ return INS(interp, unit, "set_p_pc", "", r, 2, 0, 1);
+ }
+ fataly(EX_UNAVAILABLE, sourcefile, line, "Unknown PMC constant",
+ " type %d", type_enum);
+ return NULL;
+}
+
+static Instruction*
func_ins(Parrot_Interp interp, IMC_Unit *unit, SymReg *lhs, char *op,
SymReg ** r, int n, int keyv, int emit)
{
@@ -287,7 +324,7 @@
%type <i> program class class_body member_decls member_decl field_decl
%type <i> method_decl class_namespace
%type <i> global constdef sub emit pcc_sub sub_body pcc_ret pcc_yield
-%type <i> compilation_units compilation_unit
+%type <i> compilation_units compilation_unit pmc_const
%type <s> classname relop
%type <i> labels _labels label statements statement sub_call
%type <i> pcc_sub_call
@@ -362,6 +399,10 @@
{ mk_const_ident($4, $3, $6, 1);is_def=0; }
;
+pmc_const:
+ CONST { is_def=1; } INTC var_or_i '=' STRINGC
+ { $$ = mk_pmc_const(interp, cur_unit, $3, $4, $6);is_def=0; }
+ ;
pasmcode:
pasmline
| pasmcode pasmline
@@ -373,6 +414,7 @@
| FILECOMMENT { $$ = 0; }
| LINECOMMENT { $$ = 0; }
| class_namespace { $$ = $1; }
+ | pmc_const
;
pasm_inst: { clear_state(); }
@@ -740,16 +782,16 @@
{ $$ = $2; }
;
-id_list : IDENTIFIER
+id_list : IDENTIFIER
{
- IdList* l = malloc(sizeof(IdList));
+ IdList* l = malloc(sizeof(IdList));
l->next = NULL;
l->id = $1;
$$ = l;
}
-
+
| id_list COMMA IDENTIFIER
- { IdList* l = malloc(sizeof(IdList));
+ { IdList* l = malloc(sizeof(IdList));
l->id = $3;
l->next = $1;
$$ = l;
@@ -761,21 +803,22 @@
| if_statement
| NAMESPACE IDENTIFIER { push_namespace($2); }
| ENDNAMESPACE IDENTIFIER { pop_namespace($2); }
- | LOCAL { is_def=1; } type id_list
+ | LOCAL { is_def=1; } type id_list
{
IdList* l = $4;
while(l) {
IdList* l1;
- mk_ident(l->id, $3);
+ mk_ident(l->id, $3);
l1 = l;
l = l->next;
free(l1);
}
is_def=0; $$=0;
-
+
}
| CONST { is_def=1; } type IDENTIFIER '=' const
{ mk_const_ident($4, $3, $6, 0);is_def=0; }
+ | pmc_const
| GLOBAL_CONST { is_def=1; } type IDENTIFIER '=' const
{ mk_const_ident($4, $3, $6, 1);is_def=0; }
| PARAM { is_def=1; } type IDENTIFIER { $$ = MK_I(interp, cur_unit, "restore",
1.91 +33 -1 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -r1.90 -r1.91
--- pbc.c 30 Oct 2004 09:15:42 -0000 1.90
+++ pbc.c 30 Oct 2004 11:32:19 -0000 1.91
@@ -276,6 +276,8 @@
{
SymReg * bsr;
bsr = _mk_address(globals.cs->subs->bsrs, str_dup(r->name), U_add_all);
+ if (r->set == 'p')
+ bsr->set = 'p';
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
@@ -352,6 +354,14 @@
else if (!strcmp(ins->op, "newsub"))
store_bsr(ins->r[2], pc, 3);
}
+ else if (ins->opsize == 3 && ins->r[1]->set == 'p') {
+ /*
+ * set_p_pc opcode
+ */
+ debug(interpreter, DEBUG_PBC_FIXUP, "PMC constant %s\n",
+ ins->r[1]->name);
+ store_bsr(ins->r[1], pc, 2);
+ }
pc += ins->opsize;
}
@@ -469,6 +479,28 @@
#endif
continue;
}
+ addr = jumppc + bsr->color;
+ if (bsr->set == 'p') {
+ struct PackFile_FixupEntry *fe;
+
+ lab = find_global_label(bsr->name, &pc);
+ if (!lab) {
+ fatal(1, "fixup_bsrs", "couldn't find sub 1 '%s'\n",
+ bsr->name);
+ }
+ fe = PackFile_find_fixup_entry(interpreter, enum_fixup_sub,
+ bsr->name);
+ if (!fe) {
+ fatal(1, "fixup_bsrs", "couldn't find sub 2 '%s'\n",
+ bsr->name);
+ }
+ interpreter->code->byte_code[addr+bsr->score] =
+ fe->offset;
+ debug(interpreter, DEBUG_PBC_FIXUP, "fixup const PMC"
+ " sub '%s' const nr: %d\n", bsr->name,
+ fe->offset);
+ continue;
+ }
lab = find_global_label(bsr->name, &pc);
if (!lab) {
/* TODO continue; */
@@ -476,7 +508,6 @@
fatal(1, "fixup_bsrs", "couldn't find addr of sub '%s'\n",
bsr->name);
}
- addr = jumppc + bsr->color;
/* patch the bsr __ instruction */
debug(interpreter, DEBUG_PBC_FIXUP, "fixup %s pc %d fix %d\n",
bsr->name, addr, pc - addr);
@@ -593,6 +624,7 @@
k = PDB_extend_const_table(interpreter);
interpreter->code->const_table->constants[k]->type = PFC_PMC;
interpreter->code->const_table->constants[k]->u.key = pfc->u.key;
+ r->color = k;
debug(interpreter, DEBUG_PBC_CONST,
"add_const_pmc_sub '%s' -> '%s' flags %d color %d\n\t%s\n",
1.9 +32 -1 parrot/imcc/t/syn/const.t
Index: const.t
===================================================================
RCS file: /cvs/public/parrot/imcc/t/syn/const.t,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- const.t 23 Oct 2003 17:03:01 -0000 1.8
+++ const.t 30 Oct 2004 11:32:20 -0000 1.9
@@ -1,6 +1,6 @@
#!perl
use strict;
-use TestCompiler tests => 4;
+use TestCompiler tests => 6;
##############################
output_is(<<'CODE', <<'OUT', "const 1");
@@ -93,3 +93,34 @@
"\"\"
OUT
+output_is(<<'CODE', <<'OUT', "PMC const 1 - Sub");
+.sub main @MAIN
+ .const .Sub $P0 = "foo"
+ print "ok 1\n"
+ $P0()
+ print "ok 3\n"
+.end
+.sub foo
+ print "ok 2\n"
+.end
+CODE
+ok 1
+ok 2
+ok 3
+OUT
+
+output_is(<<'CODE', <<'OUT', "PMC const 2 - Sub ident");
+.sub main @MAIN
+ .const .Sub func = "foo"
+ print "ok 1\n"
+ func()
+ print "ok 3\n"
+.end
+.sub foo
+ print "ok 2\n"
+.end
+CODE
+ok 1
+ok 2
+ok 3
+OUT
1.67 +4 -1 parrot/src/trace.c
Index: trace.c
===================================================================
RCS file: /cvs/public/parrot/src/trace.c,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -r1.66 -r1.67
--- trace.c 28 Oct 2004 07:59:26 -0000 1.66
+++ trace.c 30 Oct 2004 11:32:23 -0000 1.67
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: trace.c,v 1.66 2004/10/28 07:59:26 leo Exp $
+$Id: trace.c,v 1.67 2004/10/30 11:32:23 leo Exp $
=head1 NAME
@@ -237,6 +237,9 @@
case PARROT_ARG_NC:
PIO_eprintf(interpreter, "%vg", PCONST(o)->u.number);
break;
+ case PARROT_ARG_PC:
+ PIO_eprintf(interpreter, "PMC_C[%d]", (int)o);
+ break;
case PARROT_ARG_SC:
escaped = PDB_escape(PCONST(o)->u.string->strstart,
PCONST(o)->u.string->bufused);
1.96 +18 -2 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.95
retrieving revision 1.96
diff -u -r1.95 -r1.96
--- pmc.t 30 Oct 2004 09:15:46 -0000 1.95
+++ pmc.t 30 Oct 2004 11:32:24 -0000 1.96
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.95 2004/10/30 09:15:46 leo Exp $
+# $Id: pmc.t,v 1.96 2004/10/30 11:32:24 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 96;
+use Parrot::Test tests => 97;
use Test::More;
use Parrot::PMC qw(%pmc_types);
my $max_pmc = scalar(keys(%pmc_types)) + 1;
@@ -2635,5 +2635,21 @@
end
CODE
+output_is(<<'CODE', <<'OUT', ".const - Sub constant");
+.pcc_sub @MAIN main:
+ print "ok 1\n"
+ .const .Sub P0 = "foo"
+ invokecc
+ print "ok 3\n"
+ end
+.pcc_sub foo:
+ print "ok 2\n"
+ invoke P1
+CODE
+ok 1
+ok 2
+ok 3
+OUT
+
1;
