cvsuser 04/11/12 07:09:15
Modified: imcc pcc.c
runtime/parrot/library/Data Dumper.imc
runtime/parrot/library/Data/Dumper Base.imc Default.imc
t/op gc.t
t/pmc exception.t
Log:
pcc fixes
* inactivate want_regno - it needs clarification s. comment
* removed explicit register usage in Dumper code
* adjust recursion depth tests - the reached leved is returned
so this should be ok
Revision Changes Path
1.76 +39 -18 parrot/imcc/pcc.c
Index: pcc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pcc.c,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -r1.75 -r1.76
--- pcc.c 12 Nov 2004 10:45:47 -0000 1.75
+++ pcc.c 12 Nov 2004 15:09:09 -0000 1.76
@@ -127,6 +127,7 @@
char buf[128];
p3 = NULL;
+ UNUSED(pcc_sub);
for (i = 0; i < REGSET_MAX; i++)
next[i] = FIRST_PARAM_REG;
/* insert params */
@@ -172,25 +173,19 @@
* if this subroutine calls another subroutine
* new registers are assigned so that
* they don't interfer with this sub's params
+ *
+ * And in a return sequence too, as the usage of
+ * returns and args might conflict.
*/
if (call) {
- if (pcc_sub->calls_a_sub) {
+ /* arg->reg->want_regno = next[set]; */
move_reg:
- regs[0] = arg;
- arg->reg->want_regno = next[set];
- sprintf(buf, "%c%d", arg->set, next[set]++);
- regs[1] = get_pasm_reg(buf);
- arg->used = regs[1];
- /* e.g. set $I0, I5 */
- ins = insINS(interpreter, unit, ins, "set", regs, 2);
- }
- else {
- /*
- * if no sub is called from here
- * just use the passed register numbers
- */
- arg->reg->color = next[set]++;
- }
+ regs[0] = arg;
+ sprintf(buf, "%c%d", arg->set, next[set]++);
+ regs[1] = get_pasm_reg(buf);
+ arg->used = regs[1];
+ /* e.g. set $I0, I5 */
+ ins = insINS(interpreter, unit, ins, "set", regs, 2);
}
else
goto move_reg;
@@ -282,7 +277,34 @@
if (set == REGSET_P &&
(flatten || (arg_reg->type & VT_FLATTEN)))
goto flatten;
- arg_reg->want_regno = next[set];
+ /*
+ * a remark WRT want_regno
+ *
+ * It should eventually designate the register
+ * number used during calls and returns according
+ * to parrot calling conventions.
+ *
+ * Currently these assigned colors are used if
+ * allocate_wante_regs() is turned on with -Oc.
+ *
+ * But with allocate regs a call that doesn't
+ * want return results breaks:
+ *
+ * P5 = arg1 # P5 is pre-assigned
+ * func1()
+ * func2(P5)
+ * ...
+ * func1:
+ * .return(Px) # P5
+ *
+ * The return sequence of func1 copies P5 and clobbers
+ * the caller's P5, because the caller thinks P5 is save
+ * to use over the call to func1()
+ *
+ * So currently want_regno isn't assigned at all.
+ */
+
+ /* arg_reg->want_regno = next[set]; */
}
sprintf(buf, "%c%d", arg_reg->set, next[set]++);
reg = get_pasm_reg(buf);
@@ -396,7 +418,6 @@
sprintf(buf, "%csub_%s_p1", IMCC_INTERNAL_CHAR, sub->name);
regs[1] = label1 = mk_address(str_dup(buf), U_add_uniq_label);
ins = insINS(interpreter, unit, ins, "if", regs, 2);
-
}
for (proto = ps; proto <= pe; ++proto) {
nargs = sub->pcc_sub->nargs;
1.2 +8 -8 parrot/runtime/parrot/library/Data/Dumper.imc
Index: Dumper.imc
===================================================================
RCS file: /cvs/public/parrot/runtime/parrot/library/Data/Dumper.imc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Dumper.imc 25 May 2004 18:06:29 -0000 1.1
+++ Dumper.imc 12 Nov 2004 15:09:12 -0000 1.2
@@ -1,8 +1,8 @@
.sub __library_data_dumper_onload @LOAD
- find_type I0, "Data::Dumper";
- if I0 > 1 goto END
+ find_type $I0, "Data::Dumper";
+ if $I0 > 1 goto END
load_bytecode "library/Data/Dumper/Default.imc"
- newclass P0, "Data::Dumper";
+ newclass $P0, "Data::Dumper";
END:
.pcc_begin_return
.pcc_end_return
@@ -41,15 +41,15 @@
GO:
# XXX: support different output styles
- find_type I0, "Data::Dumper::Default";
- if I0 < 1 goto ERROR2
- new style, I0
-
+ find_type $I0, "Data::Dumper::Default";
+ if $I0 < 1 goto ERROR2
+ new style, $I0
+
style."prepare"( self, indent )
style."dumpWithName"( name, name, dump )
print "\n"
-
+
.pcc_begin_return
.return 1
.pcc_end_return
1.3 +39 -39 parrot/runtime/parrot/library/Data/Dumper/Base.imc
Index: Base.imc
===================================================================
RCS file: /cvs/public/parrot/runtime/parrot/library/Data/Dumper/Base.imc,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Base.imc 30 Oct 2004 15:36:04 -0000 1.2
+++ Base.imc 12 Nov 2004 15:09:13 -0000 1.3
@@ -28,13 +28,13 @@
.const int attrCache = 3
.sub __library_data_dumper_base_onload @LOAD
- find_type I0, "Data::Dumper::Base";
- if I0 > 1 goto END
- newclass P0, "Data::Dumper::Base";
- addattribute P0, "dumper"
- addattribute P0, "level"
- addattribute P0, "indention"
- addattribute P0, "cache"
+ find_type $I0, "Data::Dumper::Base";
+ if $I0 > 1 goto END
+ newclass $P0, "Data::Dumper::Base";
+ addattribute $P0, "dumper"
+ addattribute $P0, "level"
+ addattribute $P0, "indention"
+ addattribute $P0, "cache"
END:
.pcc_begin_return
.pcc_end_return
@@ -52,27 +52,27 @@
.local string stemp
.local pmc temp
- classoffset I0, self, "Data::Dumper::Base";
- add I0, attrDumper
- setattribute self, I0, dumper
+ classoffset $I0, self, "Data::Dumper::Base";
+ add $I0, attrDumper
+ setattribute self, $I0, dumper
new temp, .PerlInt
set temp, 0
- classoffset I0, self, "Data::Dumper::Base";
- add I0, attrLevel
- setattribute self, I0, temp
-
+ classoffset $I0, self, "Data::Dumper::Base";
+ add $I0, attrLevel
+ setattribute self, $I0, temp
+
new temp, .PerlString
clone stemp, indent
set temp, stemp
- classoffset I0, self, "Data::Dumper::Base";
- add I0, attrIndention
- setattribute self, I0, temp
+ classoffset $I0, self, "Data::Dumper::Base";
+ add $I0, attrIndention
+ setattribute self, $I0, temp
new temp, .PerlArray
- classoffset I0, self, "Data::Dumper::Base";
- add I0, attrCache
- setattribute self, I0, temp
+ classoffset $I0, self, "Data::Dumper::Base";
+ add $I0, attrCache
+ setattribute self, $I0, temp
.pcc_begin_return
.pcc_end_return
@@ -91,9 +91,9 @@
.local string name
.local pmc pname
- classoffset I0, self, "Data::Dumper::Base";
- add I0, attrCache
- getattribute _cache, self, I0
+ classoffset $I0, self, "Data::Dumper::Base";
+ add $I0, attrCache
+ getattribute _cache, self, $I0
set i, _cache
LOOP:
@@ -131,13 +131,13 @@
.local pmc temp
.local string indent
- classoffset I0, self, "Data::Dumper::Base";
- add I0, attrIndention
- getattribute temp, self, I0
+ classoffset $I0, self, "Data::Dumper::Base";
+ add $I0, attrIndention
+ getattribute temp, self, $I0
set indent, temp
clone indent, indent
repeat indent, indent, level
-
+
.pcc_begin_return
.return indent
.pcc_end_return
@@ -151,10 +151,10 @@
.local pmc temp
.local string _indent
.local int level
-
- classoffset I0, self, "Data::Dumper::Base";
- add I0, attrLevel
- getattribute temp, self, I0
+
+ classoffset $I0, self, "Data::Dumper::Base";
+ add $I0, attrLevel
+ getattribute temp, self, $I0
set level, temp
_indent = self."createIndent"( level )
@@ -173,10 +173,10 @@
.local string indent1
.local string indent2
.local int level
-
- classoffset I0, self, "Data::Dumper::Base";
- add I0, attrLevel
- getattribute temp, self, I0
+
+ classoffset $I0, self, "Data::Dumper::Base";
+ add $I0, attrLevel
+ getattribute temp, self, $I0
set level, temp
inc temp
@@ -198,10 +198,10 @@
.local pmc temp
.local string indent
.local int level
-
- classoffset I0, self, "Data::Dumper::Base";
- add I0, attrLevel
- getattribute temp, self, I0
+
+ classoffset $I0, self, "Data::Dumper::Base";
+ add $I0, attrLevel
+ getattribute temp, self, $I0
dec temp
set level, temp
1.4 +19 -19 parrot/runtime/parrot/library/Data/Dumper/Default.imc
Index: Default.imc
===================================================================
RCS file: /cvs/public/parrot/runtime/parrot/library/Data/Dumper/Default.imc,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Default.imc 17 Aug 2004 09:16:21 -0000 1.3
+++ Default.imc 12 Nov 2004 15:09:13 -0000 1.4
@@ -19,13 +19,13 @@
=cut
.sub __library_data_dumper_default_onload @LOAD
- find_type I0, "Data::Dumper::Default";
- if I0 > 1 goto END
+ find_type $I0, "Data::Dumper::Default";
+ if $I0 > 1 goto END
load_bytecode "library/Data/Dumper/Base.imc"
load_bytecode "library/Data/Sort.imc"
load_bytecode "library/Data/Escape.imc"
- getclass P0, "Data::Dumper::Base";
- subclass P0, P0, "Data::Dumper::Default";
+ getclass $P0, "Data::Dumper::Base";
+ subclass $P0, $P0, "Data::Dumper::Default";
END:
.pcc_begin_return
.pcc_end_return
@@ -48,7 +48,7 @@
.param string name
.param pmc dump
.local int ret
-
+
print "\""
print shortname
print "\" => "
@@ -67,10 +67,10 @@
.sub dumpCached method
.param string name
.param pmc dump
-
+
print "\\"
print name
-
+
.pcc_begin_return
.return 1
.pcc_end_return
@@ -87,7 +87,7 @@
.local string name
.local pmc prop
.local int ret
-
+
ret = 1
isnull dump, END
prophash prop, dump
@@ -97,7 +97,7 @@
clone name, paramName
concat name, ".properties()"
ret = self."dump"( name, prop )
-
+
END:
.pcc_begin_return
.return ret
@@ -184,12 +184,12 @@
.param string char
.local string str
.local pmc escape
-
+
escape = find_global "Data::Escape";, "String"
str = var
str = escape( str, char )
print str
-
+
.pcc_begin_return
.return 1
.pcc_end_return
@@ -203,14 +203,14 @@
.param string name
.param pmc dump
.local string type
-
+
typeof type, dump
print "PMC '"
print type
print "' "
-
- can I0, dump, "__dump"
- if I0 goto CAN_DUMP
+
+ can $I0, dump, "__dump"
+ if $I0 goto CAN_DUMP
print "{ ... }"
branch END
CAN_DUMP:
@@ -275,7 +275,7 @@
$I0 = array[pos]
print $I0
-
+
# next array member
inc pos
@@ -392,7 +392,7 @@
print "PerlHash "
self."dumpHash"( name, hash )
-
+
.pcc_begin_return
.return 1
.pcc_end_return
@@ -516,7 +516,7 @@
.sub pmcManagedStruct method
print "ManagedStruct { ... }"
-
+
.pcc_begin_return
.return 1
.pcc_end_return
@@ -530,7 +530,7 @@
.sub pmcUnManagedStruct method
print "UnManagedStruct { ... }"
-
+
.pcc_begin_return
.return 1
.pcc_end_return
1.21 +2 -2 parrot/t/op/gc.t
Index: gc.t
===================================================================
RCS file: /cvs/public/parrot/t/op/gc.t,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- gc.t 28 Oct 2004 07:59:28 -0000 1.20
+++ gc.t 12 Nov 2004 15:09:14 -0000 1.21
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: gc.t,v 1.20 2004/10/28 07:59:28 leo Exp $
+# $Id: gc.t,v 1.21 2004/11/12 15:09:14 leo Exp $
=head1 NAME
@@ -481,7 +481,7 @@
.end
CODE
ok 1
-10
+9
OUTPUT
output_is(<<'CODE', <<OUTPUT, "write barrier 1");
1.12 +2 -2 parrot/t/pmc/exception.t
Index: exception.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/exception.t,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- exception.t 1 Oct 2004 21:16:52 -0000 1.11
+++ exception.t 12 Nov 2004 15:09:15 -0000 1.12
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: exception.t,v 1.11 2004/10/01 21:16:52 jrieks Exp $
+# $Id: exception.t,v 1.12 2004/11/12 15:09:15 leo Exp $
=head1 NAME
@@ -555,7 +555,7 @@
.end
CODE
ok 1
-100
+99
OUTPUT
1;
