cvsuser 05/03/27 05:14:22
Modified: classes integer.pmc
imcc imcc.y pbc.c symreg.c
src packfile.c packout.c
t/pmc pmc.t
Log:
PMC constants and more
* see note on p6i
Revision Changes Path
1.25 +8 -2 parrot/classes/integer.pmc
Index: integer.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/integer.pmc,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- integer.pmc 17 Mar 2005 11:45:25 -0000 1.24
+++ integer.pmc 27 Mar 2005 13:14:18 -0000 1.25
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: integer.pmc,v 1.24 2005/03/17 11:45:25 leo Exp $
+$Id: integer.pmc,v 1.25 2005/03/27 13:14:18 leo Exp $
=head1 NAME
@@ -100,6 +100,7 @@
PMC* instantiate() {
PMC *class = REG_PMC(2);
int argcP = REG_INT(3);
+ int argcS = REG_INT(2);
int base;
PMC *res, *arg;
STRING *num;
@@ -108,7 +109,12 @@
type = class->vtable->base_type;
if (!argcP) {
- return pmc_new(INTERP, type);
+ res = pmc_new(INTERP, type);
+ if (argcS) {
+ /* TODO bigint overflow */
+ PMC_int_val(res) = string_to_int(INTERP, REG_STR(5));
+ }
+ return res;
}
base = 10;
if (argcP == 2)
1.158 +8 -5 parrot/imcc/imcc.y
Index: imcc.y
===================================================================
RCS file: /cvs/public/parrot/imcc/imcc.y,v
retrieving revision 1.157
retrieving revision 1.158
diff -u -r1.157 -r1.158
--- imcc.y 25 Mar 2005 07:44:19 -0000 1.157
+++ imcc.y 27 Mar 2005 13:14:19 -0000 1.158
@@ -134,16 +134,19 @@
constant[len - 1] = '\0';
strcpy(name, constant + 1);
free(constant);
- rhs = mk_const(interp, name, 'p');
- r[1] = rhs;
switch (type_enum) {
case enum_class_Sub:
+ case enum_class_Coroutine:
+ rhs = mk_const(interp, name, 'p');
+ r[1] = rhs;
+ rhs->pmc_type = type_enum;
rhs->usage = U_FIXUP;
return INS(interp, unit, "set_p_pc", "", r, 2, 0, 1);
}
- IMCC_fataly(interp, E_SyntaxError,
- "Unknown PMC constant type %d", type_enum);
- return NULL;
+ rhs = mk_const(interp, name, 'P');
+ r[1] = rhs;
+ rhs->pmc_type = type_enum;
+ return INS(interp, unit, "set_p_pc", "", r, 2, 0, 1);
}
static Instruction*
1.114 +50 -4 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.113
retrieving revision 1.114
diff -u -r1.113 -r1.114
--- pbc.c 26 Mar 2005 12:07:26 -0000 1.113
+++ pbc.c 27 Mar 2005 13:14:19 -0000 1.114
@@ -34,7 +34,7 @@
*
*/
-#define PF_USE_FREEZE_THAW 0
+#define PF_USE_FREEZE_THAW 1
/*
* globals store the state between individual e_pbc_emit calls
@@ -596,13 +596,15 @@
int offs, int end)
{
int k;
+#if ! PF_USE_FREEZE_THAW
char buf[256];
opcode_t *rc;
+ char *class;
+#endif
struct PackFile_Constant *pfc;
SymReg *ns;
int ns_const = -1;
char *real_name;
- char *class;
struct PackFile_ConstTable *ct;
struct PackFile *pf;
@@ -873,6 +875,42 @@
}
static void
+make_pmc_const(Interp *interpreter, SymReg *r)
+{
+ STRING *s, *s5;
+ PMC *p, *class, *p2;
+ INTVAL i2, i3;
+ int k;
+
+ s = string_from_cstring(interpreter, r->name, 0);
+ /* preserver registers */
+ i2 = REG_INT(2);
+ i3 = REG_INT(3);
+ s5 = REG_STR(5);
+ p2 = REG_PMC(2);
+
+ class = REG_PMC(2) = Parrot_base_vtables[r->pmc_type]->class;
+ REG_INT(2) = 1;
+ REG_INT(3) = 0;
+ REG_STR(5) = s;
+ /* TODO create constant PMCs
+ * maybe VTABLE_instantiate_const
+ */
+ p = VTABLE_instantiate(interpreter, class);
+ /* restore regs */
+ REG_INT(2) = i2;
+ REG_INT(3) = i3;
+ REG_INT(2) = i2;
+ REG_STR(5) = s5;
+ REG_PMC(2) = p2;
+ /* append PMC constant */
+ k = PDB_extend_const_table(interpreter);
+ interpreter->code->const_table->constants[k]->type = PFC_PMC;
+ interpreter->code->const_table->constants[k]->u.key = p;
+ r->color = k;
+}
+
+static void
add_1_const(Interp *interpreter, SymReg *r)
{
if (r->color >= 0)
@@ -893,11 +931,19 @@
for (r = r->nextkey; r; r = r->nextkey)
if (r->type & VTCONST)
add_1_const(interpreter, r);
+ break;
+ case 'P':
+ make_pmc_const(interpreter, r);
+ IMCC_debug(interpreter, DEBUG_PBC_CONST,
+ "PMC const %s\tcolor %d\n",
+ r->name, r->color);
+ break;
default:
break;
}
- if (r /*&& r->set != 'I' */)
- IMCC_debug(interpreter, DEBUG_PBC_CONST,"const %s\tcolor %d
use_count %d\n",
+ if (r)
+ IMCC_debug(interpreter, DEBUG_PBC_CONST,
+ "const %s\tcolor %d use_count %d\n",
r->name, r->color, r->use_count);
}
1.62 +45 -2 parrot/imcc/symreg.c
Index: symreg.c
===================================================================
RCS file: /cvs/public/parrot/imcc/symreg.c,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- symreg.c 25 Mar 2005 07:44:19 -0000 1.61
+++ symreg.c 27 Mar 2005 13:14:19 -0000 1.62
@@ -274,6 +274,39 @@
return r;
}
+static SymReg*
+mk_pmc_const_2(Parrot_Interp interp, IMC_Unit *unit, SymReg *left, SymReg
*rhs)
+{
+ SymReg *r[IMCC_MAX_REGS];
+ char *name;
+ int len;
+
+ if (IMCC_INFO(interp)->state->pasm_file) {
+ IMCC_fataly(interp, E_SyntaxError,
+ "Ident as PMC constant",
+ " %s\n", left->name);
+ }
+ r[0] = left;
+ /* strip delimiters */
+ name = str_dup(rhs->name + 1);
+ len = strlen(name);
+ name[len - 1] = '\0';
+ free(rhs->name);
+ rhs->name = name;
+ rhs->set = 'P';
+ rhs->pmc_type = left->pmc_type;
+ switch (rhs->pmc_type) {
+ case enum_class_Sub:
+ case enum_class_Coroutine:
+ r[1] = rhs;
+ rhs->usage = U_FIXUP;
+ INS(interp, unit, "set_p_pc", "", r, 2, 0, 1);
+ return NULL;
+ }
+ r[1] = rhs;
+ INS(interp, unit, "set_p_pc", "", r, 2, 0, 1);
+ return NULL;
+}
/* Makes a new identifier constant with value val */
SymReg *
mk_const_ident(Interp *interp,
@@ -281,10 +314,20 @@
{
SymReg *r;
- if (global)
+ if (global) {
+ if (t == 'P') {
+ IMCC_fataly(interp, E_SyntaxError,
+ "global PMC constant not allowed");
+ }
r = _mk_symreg(IMCC_INFO(interp)->ghash, name, t);
- else
+ }
+ else {
+ if (t == 'P') {
+ r = mk_ident(interp, name, t);
+ return mk_pmc_const_2(interp, cur_unit, r, val);
+ }
r = mk_ident(interp, name, t);
+ }
r->type = VT_CONSTP;
r->reg = val;
return r;
1.193 +9 -2 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.192
retrieving revision 1.193
diff -u -r1.192 -r1.193
--- packfile.c 26 Mar 2005 12:07:29 -0000 1.192
+++ packfile.c 27 Mar 2005 13:14:20 -0000 1.193
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packfile.c,v 1.192 2005/03/26 12:07:29 leo Exp $
+$Id: packfile.c,v 1.193 2005/03/27 13:14:20 leo Exp $
=head1 NAME
@@ -33,7 +33,7 @@
#define TRACE_PACKFILE 0
#define TRACE_PACKFILE_PMC 0
-#define PF_USE_FREEZE_THAW 0
+#define PF_USE_FREEZE_THAW 1
/*
** Static functions
@@ -371,6 +371,7 @@
struct PackFile_FixupTable *ft;
struct PackFile_ConstTable *ct;
PMC *sub_pmc;
+ PMC *p;
STRING *name;
ft = cs->fixups;
@@ -389,6 +390,12 @@
name = PMC_sub(sub_pmc)->name;
if (name)
pobject_lives(interpreter, (PObj *)name);
+ p = PMC_sub(sub_pmc)->name_space;
+ if (!PMC_IS_NULL(p))
+ pobject_lives(interpreter, (PObj *)p);
+ p = PMC_sub(sub_pmc)->multi_signature;
+ if (!PMC_IS_NULL(p))
+ pobject_lives(interpreter, (PObj *)p);
break;
}
}
1.39 +2 -2 parrot/src/packout.c
Index: packout.c
===================================================================
RCS file: /cvs/public/parrot/src/packout.c,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- packout.c 25 Mar 2005 10:19:58 -0000 1.38
+++ packout.c 27 Mar 2005 13:14:20 -0000 1.39
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packout.c,v 1.38 2005/03/25 10:19:58 leo Exp $
+$Id: packout.c,v 1.39 2005/03/27 13:14:20 leo Exp $
=head1 NAME
@@ -29,7 +29,7 @@
#define TRACE_PACKFILE_PMC 0
-#define PF_USE_FREEZE_THAW 0
+#define PF_USE_FREEZE_THAW 1
extern struct PackFile_Directory *directory_new (Interp*, struct PackFile
*pf);
1.104 +30 -3 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.103
retrieving revision 1.104
diff -u -r1.103 -r1.104
--- pmc.t 23 Mar 2005 15:57:04 -0000 1.103
+++ pmc.t 27 Mar 2005 13:14:21 -0000 1.104
@@ -1,7 +1,7 @@
#! perl -w
# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.103 2005/03/23 15:57:04 leo Exp $
+# $Id: pmc.t,v 1.104 2005/03/27 13:14:21 leo Exp $
=head1 NAME
@@ -17,7 +17,7 @@
=cut
-use Parrot::Test tests => 20;
+use Parrot::Test tests => 23;
use Test::More;
use Parrot::PMC qw(%pmc_types);
my $max_pmc = scalar(keys(%pmc_types)) + 1;
@@ -496,4 +496,31 @@
Integer
OUT
-1;
+pir_output_is(<<'CODE', <<'OUT', "pmc constant 1");
+.sub main @MAIN
+ .const Integer i = "42"
+ print i
+ print "\n"
+.end
+CODE
+42
+OUT
+
+pir_output_is(<<'CODE', <<'OUT', "pmc constant 2");
+.sub main @MAIN
+ .const .Integer i = "42"
+ print i
+ print "\n"
+.end
+CODE
+42
+OUT
+
+output_is(<<'CODE', <<'OUT', "pmc constant PASM");
+ .const .Integer P0 = "42"
+ print P0
+ print "\n"
+ end
+CODE
+42
+OUT
