cvsuser 04/10/30 02:15:46
Modified: build_tools jit2h.pl
imcc parser_util.c pbc.c
lib/Parrot/OpTrans C.pm CGoto.pm CPrederef.pm Compiled.pm
lib/Parrot OpsFile.pm
ops core.ops ops.num set.ops
t/pmc pmc.t
Log:
PMC constants 1 - ops file parsing, code gen, set_p_pc opcode
Revision Changes Path
1.75 +3 -2 parrot/build_tools/jit2h.pl
Index: jit2h.pl
===================================================================
RCS file: /cvs/public/parrot/build_tools/jit2h.pl,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -r1.74 -r1.75
--- jit2h.pl 24 Oct 2004 12:33:04 -0000 1.74
+++ jit2h.pl 30 Oct 2004 09:15:41 -0000 1.75
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: jit2h.pl,v 1.74 2004/10/24 12:33:04 leo Exp $
+# $Id: jit2h.pl,v 1.75 2004/10/30 09:15:41 leo Exp $
=head1 NAME
@@ -29,6 +29,7 @@
my %type_to_arg = (
INT_CONST => 'ic',
NUM_CONST => 'nc',
+ PMC_CONST => 'pc',
STRING_CONST => 'sc',
STR_CONST => 'sc',
INT_REG => 'i',
@@ -95,7 +96,7 @@
'ic' => "cur_opcode[%ld]",
'nc' => "CONST(%ld)",
- 'pc' => "%ld /* ERROR: Don't know how to handle PMC constants yet! */",
+ 'pc' => "CONST(%ld)",
'sc' => "CONST(%ld)",
'kc' => "CONST(%ld)",
'kic' => "cur_opcode[%ld]"
1.78 +2 -0 parrot/imcc/parser_util.c
Index: parser_util.c
===================================================================
RCS file: /cvs/public/parrot/imcc/parser_util.c,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -r1.77 -r1.78
--- parser_util.c 7 Oct 2004 13:36:49 -0000 1.77
+++ parser_util.c 30 Oct 2004 09:15:42 -0000 1.78
@@ -292,6 +292,8 @@
op = interpreter->op_lib->op_code(name, 1);
if (op < 0) /* still wrong, try to find an existing op */
op = try_find_op(interpreter, unit, name, r, n, keyvec, emit);
+ else
+ strcpy(fullname, name);
if (op >= 0) {
op_info_t * op_info = &interpreter->op_info_table[op];
char format[128];
1.90 +1 -0 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -r1.89 -r1.90
--- pbc.c 8 Sep 2004 00:33:52 -0000 1.89
+++ pbc.c 30 Oct 2004 09:15:42 -0000 1.90
@@ -950,6 +950,7 @@
case PARROT_ARG_IC:
case PARROT_ARG_SC:
case PARROT_ARG_NC:
+ case PARROT_ARG_PC:
r = ins->r[i];
if (r->type & (VT_REGP | VT_CONSTP))
r = r->reg;
1.23 +2 -2 parrot/lib/Parrot/OpTrans/C.pm
Index: C.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/OpTrans/C.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- C.pm 22 Oct 2004 10:26:25 -0000 1.22
+++ C.pm 30 Oct 2004 09:15:43 -0000 1.23
@@ -1,5 +1,5 @@
# Copyright: 2002 The Perl Foundation. All Rights Reserved.
-# $Id: C.pm,v 1.22 2004/10/22 10:26:25 leo Exp $
+# $Id: C.pm,v 1.23 2004/10/30 09:15:43 leo Exp $
=head1 NAME
@@ -131,7 +131,7 @@
'ic' => "cur_opcode[%ld]",
'nc' => "CONST(%ld)->u.number",
- 'pc' => "%ld /* ERROR: Don't know how to handle PMC constants yet! */",
+ 'pc' => "CONST(%ld)->u.key",
'sc' => "CONST(%ld)->u.string",
'kc' => "CONST(%ld)->u.key",
'kic' => "cur_opcode[%ld]"
1.30 +2 -2 parrot/lib/Parrot/OpTrans/CGoto.pm
Index: CGoto.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/OpTrans/CGoto.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- CGoto.pm 29 Oct 2004 16:18:53 -0000 1.29
+++ CGoto.pm 30 Oct 2004 09:15:43 -0000 1.30
@@ -1,5 +1,5 @@
# Copyright: 2002 The Perl Foundation. All Rights Reserved.
-# $Id: CGoto.pm,v 1.29 2004/10/29 16:18:53 leo Exp $
+# $Id: CGoto.pm,v 1.30 2004/10/30 09:15:43 leo Exp $
=head1 NAME
@@ -216,7 +216,7 @@
'ic' => "cur_opcode[%ld]",
'nc' => "CONST(%ld)->u.number",
- 'pc' => "%ld /* ERROR: Don't know how to handle PMC constants yet! */",
+ 'pc' => "CONST(%ld)->u.key",
'sc' => "CONST(%ld)->u.string",
'kc' => "CONST(%ld)->u.key",
'kic' => "cur_opcode[%ld]"
1.25 +11 -11 parrot/lib/Parrot/OpTrans/CPrederef.pm
Index: CPrederef.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/OpTrans/CPrederef.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- CPrederef.pm 23 Apr 2004 09:21:03 -0000 1.24
+++ CPrederef.pm 30 Oct 2004 09:15:43 -0000 1.25
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: CPrederef.pm,v 1.24 2004/04/23 09:21:03 jrieks Exp $
+# $Id: CPrederef.pm,v 1.25 2004/10/30 09:15:43 leo Exp $
=head1 NAME
@@ -33,7 +33,7 @@
=cut
-sub core_type
+sub core_type
{
return 'PARROT_PREDEREF_CORE';
}
@@ -46,9 +46,9 @@
=cut
-sub prefix
-{
- return 'Parrot_pred_';
+sub prefix
+{
+ return 'Parrot_pred_';
}
=item C<defines()>
@@ -101,9 +101,9 @@
=cut
-sub opsarraytype
-{
- return 'void *'
+sub opsarraytype
+{
+ return 'void *'
};
=item C<gen_goto($where)>
@@ -188,17 +188,17 @@
my %arg_maps = (
'op' => "cur_opcode[%ld]",
-
+
'i' => "(*(INTVAL *)cur_opcode[%ld])",
'n' => "(*(FLOATVAL *)cur_opcode[%ld])",
'p' => "(*(PMC **)cur_opcode[%ld])",
's' => "(*(STRING **)cur_opcode[%ld])",
'k' => "(*(PMC **)cur_opcode[%ld])",
'ki' => "(*(INTVAL *)cur_opcode[%ld])",
-
+
'ic' => "(*(INTVAL *)cur_opcode[%ld])",
'nc' => "(*(FLOATVAL *)cur_opcode[%ld])",
- 'pc' => "%ld /* ERROR: Don't know how to handle PMC constants yet! */",
+ 'pc' => "(*(PMC **)cur_opcode[%ld])",
'sc' => "(*(STRING **)cur_opcode[%ld])",
'kc' => "(*(PMC **)cur_opcode[%ld])",
'kic' => "(*(INTVAL *)cur_opcode[%ld])"
1.16 +2 -2 parrot/lib/Parrot/OpTrans/Compiled.pm
Index: Compiled.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/OpTrans/Compiled.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- Compiled.pm 22 Oct 2004 10:26:25 -0000 1.15
+++ Compiled.pm 30 Oct 2004 09:15:43 -0000 1.16
@@ -1,5 +1,5 @@
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: Compiled.pm,v 1.15 2004/10/22 10:26:25 leo Exp $
+# $Id: Compiled.pm,v 1.16 2004/10/30 09:15:43 leo Exp $
=head1 NAME
@@ -180,7 +180,7 @@
'ic' => "%ld",
'nc' => "CONST(%ld)->u.number",
- 'pc' => "%ld /* ERROR: Don't know how to handle PMC constants yet! */",
+ 'pc' => "CONST(%ld)->u.key",
'sc' => "CONST(%ld)->u.string",
'kc' => "CONST(%ld)->u.key",
'kic' => "%ld",
1.44 +2 -4 parrot/lib/Parrot/OpsFile.pm
Index: OpsFile.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/OpsFile.pm,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- OpsFile.pm 26 Apr 2004 17:03:11 -0000 1.43
+++ OpsFile.pm 30 Oct 2004 09:15:44 -0000 1.44
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: OpsFile.pm,v 1.43 2004/04/26 17:03:11 leo Exp $
+# $Id: OpsFile.pm,v 1.44 2004/10/30 09:15:44 leo Exp $
=head1 NAME
@@ -315,6 +315,7 @@
# pc PMC constant index
# sc String constant index
# kc Key constant index
+ # kic Integer Key constant index (in-line)
#
if (/^(inline\s+)?op\s+([a-zA-Z]\w*)\s*\((.*)\)\s*(\S*)?\s*{/)
@@ -379,9 +380,6 @@
}
elsif ($use eq 'inconst')
{
- die "Parrot::OpsFile: Arg format 'inconst PMC' is not allowed!"
- if $type eq 'p';
-
push @temp, "${type}c";
push @argdirs, 'i';
}
1.372 +0 -4 parrot/ops/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/ops/core.ops,v
retrieving revision 1.371
retrieving revision 1.372
diff -u -r1.371 -r1.372
--- core.ops 22 Oct 2004 08:36:40 -0000 1.371
+++ core.ops 30 Oct 2004 09:15:45 -0000 1.372
@@ -1141,10 +1141,6 @@
goto NEXT();
}
-inline op bogus() {
- goto NEXT();
-}
-
op new_callback(out PMC, in PMC, in PMC, in STR) {
$1 = Parrot_make_cb(interpreter, $2, $3, $4);
goto NEXT();
1.42 +1 -1 parrot/ops/ops.num
Index: ops.num
===================================================================
RCS file: /cvs/public/parrot/ops/ops.num,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -r1.41 -r1.42
--- ops.num 26 Sep 2004 09:37:59 -0000 1.41
+++ ops.num 30 Oct 2004 09:15:45 -0000 1.42
@@ -773,7 +773,7 @@
singleton_p 746
class_p_p 747
classname_s_p 748
-bogus 749
+set_p_pc 749
new_p_i 750
new_p_ic 751
new_p_i_p 752
1.20 +7 -0 parrot/ops/set.ops
Index: set.ops
===================================================================
RCS file: /cvs/public/parrot/ops/set.ops,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- set.ops 9 Jul 2004 15:24:29 -0000 1.19
+++ set.ops 30 Oct 2004 09:15:45 -0000 1.20
@@ -86,6 +86,8 @@
=item B<set>(out INT, in PMC)
+=item B<set>(out INT, inconst PMC)
+
=item B<set>(out INT, in STR)
=item B<set>(out NUM, in INT)
@@ -181,6 +183,11 @@
goto NEXT();
}
+inline op set(out PMC, inconst PMC) :base_core {
+ $1 = $2;
+ goto NEXT();
+}
+
inline op set(in PMC, in INT) :base_core {
$1->vtable->set_integer_native(interpreter, $1, $2);
goto NEXT();
1.95 +16 -2 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.94
retrieving revision 1.95
diff -u -r1.94 -r1.95
--- pmc.t 1 Oct 2004 21:16:52 -0000 1.94
+++ pmc.t 30 Oct 2004 09:15:46 -0000 1.95
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.94 2004/10/01 21:16:52 jrieks Exp $
+# $Id: pmc.t,v 1.95 2004/10/30 09:15:46 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 95;
+use Parrot::Test tests => 96;
use Test::More;
use Parrot::PMC qw(%pmc_types);
my $max_pmc = scalar(keys(%pmc_types)) + 1;
@@ -2622,4 +2622,18 @@
0
OUTPUT
+output_is(<<'CODE', '1foo23', "set_p_pc - Sub constant");
+.pcc_sub foo: # be sure, this is constant #0
+ print 2
+ invoke P1
+.pcc_sub @MAIN main:
+ print 1
+ set_p_pc P0, 0
+ print P0
+ invokecc
+ print 3
+ end
+CODE
+
+
1;
