Author: jkeenan
Date: Thu Aug 14 04:51:10 2008
New Revision: 30223
Modified:
branches/opsrenum/lib/Parrot/OpsRenumber.pm
branches/opsrenum/t/tools/ops2pm/05-renum_op_map_file.t
branches/opsrenum/tools/dev/opsrenumber.pl
Log:
Parrot::OpsRenumber::renum_op_map_file() now takes Parrot major version number
as argument. This will enable us to define different ops-remapping behavior
pre- and post-Parrot 1.0. Only pre-1.0 case implemented so far.
Modified: branches/opsrenum/lib/Parrot/OpsRenumber.pm
==============================================================================
--- branches/opsrenum/lib/Parrot/OpsRenumber.pm (original)
+++ branches/opsrenum/lib/Parrot/OpsRenumber.pm Thu Aug 14 04:51:10 2008
@@ -71,76 +71,89 @@
sub renum_op_map_file {
my $self = shift;
+ my $major_version = shift;
my $file = scalar(@_) ? shift : $self->{num_file};
- my ( $name, $number, @lines, %fixed, $fix );
- $fix = 1;
- # We open up the currently existing ops.num and file and read it
- # line-by-line. That file is basically divided into two halves separated
- # by the ###DYNAMIC### line. Above that line are found (a) inline
- # comments and (b) the first 7, never-to-be-altered opcodes. Below that
- # line are all the remaining opcodes. All opcode lines match the pattern
- # /^(\w+)\s+(\d+)$/. Everything above the line gets pushed into @lines
- # and, if it's an opcode line, get's split and pushed into %fixed as well.
- # Essentially nothing happens to the (opcode) lines below the DYNAMIC
- # line.
- open my $OP, '<', $file
- or die "Can't open $file, error $!";
- while (<$OP>) {
- push @lines, $_ if $fix;
- chomp;
- $fix = 0 if /^###DYNAMIC###/;
- s/#.*$//;
- s/\s*$//;
- s/^\s*//;
- next unless $_;
- ( $name, $number ) = split( /\s+/, $_ );
- $fixed{$name} = $number if ($fix);
- }
- close $OP;
- # Now we re-open the very same file we just read -- this time for writing.
- # We directly print all the lines n @lines, i.e., those above the DYNAMIC
- # line. For the purpose of renumbering, we create an index $n.
- open $OP, '>', $file
- or die "Can't open $file, error $!";
- print $OP @lines;
- my ($n);
-
- #
- # we can't use all autogenerated ops from oplib/core
- # there are unwanted permutations like 'add_i_ic_ic
- # which aren't opcodes but calced at compile-time
- #
-
- # The ops element is set by prepare_ops(), which is inherited from
- # Parrot::Ops2pm::Base. prepare_ops(), in turn, works off
- # Parrot::OpsFile.
-
- # So whether a particular opcode will appear in the *new* ops.num depends
- # entirely on whether or not it's found in @{ $self->{ops}->{OPS} }. If a
- # particular opcode has been deleted or gone missing from that array, then
- # it won't appear in the new ops.num. That's acceptable pre-version 1.0,
- # but not afterwards (per
- # http://rt.perl.org/rt3/Ticket/Display.html?id=53976). At and after 1.0,
- # the opcodes in ops.num will be non-deletable. New opcodes may be added
- # to the end of the list and numbered accordingly, but no opcodes may be
- # deleted. When we get to that point and need to renumber due to addition
- # of opcodes, we'll simply determine which opcodes are brand new and
- # append them to the end of the list in some order yet to be determined.
-
- for ( @{ $self->{ops}->{OPS} } ) {
- # To account for the number of opcodes above the line, we'll increment
- # the index by one for every element in %fixed.
- if ( defined $fixed{ $_->full_name } ) {
- $n = $fixed{ $_->full_name };
+ if ($major_version == 0) {
+
+ # We open up the currently existing ops.num and file and read it
+ # line-by-line. That file is basically divided into two halves
+ # separated by the ###DYNAMIC### line. Above that line are found (a)
+ # inline comments and (b) the first 7, never-to-be-altered opcodes.
+ # Below that line are all the remaining opcodes. All opcode lines
+ # match the pattern /^(\w+)\s+(\d+)$/. Everything above the line gets
+ # pushed into @lines and, if it's an opcode line, get's split and
+ # pushed into %fixed as well. Essentially nothing happens to the
+ # (opcode) lines below the DYNAMIC line.
+
+ my ( $name, $number, @lines, %fixed, $fix );
+ $fix = 1;
+ open my $OP, '<', $file
+ or die "Can't open $file, error $!";
+ while (<$OP>) {
+ push @lines, $_ if $fix;
+ chomp;
+ $fix = 0 if /^###DYNAMIC###/;
+ s/#.*$//;
+ s/\s*$//;
+ s/^\s*//;
+ next unless $_;
+ ( $name, $number ) = split( /\s+/, $_ );
+ $fixed{$name} = $number if ($fix);
}
- # For all other opcodes, we'll print the opcode, increment the index,
- # then print the index on that same line.
- else {
- printf $OP "%-31s%4d\n", $_->full_name, ++$n;
+ close $OP;
+
+ # Now we re-open the very same file we just read -- this time for
+ # writing. We directly print all the lines n @lines, i.e., those
+ # above the DYNAMIC line. For the purpose of renumbering, we create
+ # an index $n.
+
+ open $OP, '>', $file
+ or die "Can't open $file, error $!";
+ print $OP @lines;
+ my ($n);
+
+ #
+ # we can't use all autogenerated ops from oplib/core
+ # there are unwanted permutations like 'add_i_ic_ic
+ # which aren't opcodes but calced at compile-time
+ #
+
+ # The ops element is set by prepare_ops(), which is inherited from
+ # Parrot::Ops2pm::Base. prepare_ops(), in turn, works off
+ # Parrot::OpsFile.
+
+ # So whether a particular opcode will appear in the *new* ops.num
+ # depends entirely on whether or not it's found in @{
+ # $self->{ops}->{OPS} }. If a particular opcode has been deleted or
+ # gone missing from that array, then it won't appear in the new
+ # ops.num. That's acceptable pre-version 1.0, but not afterwards (per
+ # http://rt.perl.org/rt3/Ticket/Display.html?id=53976). At and after
+ # 1.0, the opcodes in ops.num will be non-deletable. New opcodes may
+ # be added to the end of the list and numbered accordingly, but no
+ # opcodes may be deleted. When we get to that point and need to
+ # renumber due to addition of opcodes, we'll simply determine which
+ # opcodes are brand new and append them to the end of the list in some
+ # order yet to be determined.
+
+ for ( @{ $self->{ops}->{OPS} } ) {
+
+ # To account for the number of opcodes above the line, we'll
+ # increment the index by one for every element in %fixed.
+
+ if ( defined $fixed{ $_->full_name } ) {
+ $n = $fixed{ $_->full_name };
+ }
+
+ # For all other opcodes, we'll print the opcode, increment the
+ # index, then print the index on that same line.
+
+ else {
+ printf $OP "%-31s%4d\n", $_->full_name, ++$n;
+ }
}
+ close $OP;
}
- close $OP;
return 1;
}
Modified: branches/opsrenum/t/tools/ops2pm/05-renum_op_map_file.t
==============================================================================
--- branches/opsrenum/t/tools/ops2pm/05-renum_op_map_file.t (original)
+++ branches/opsrenum/t/tools/ops2pm/05-renum_op_map_file.t Thu Aug 14
04:51:10 2008
@@ -29,6 +29,9 @@
ok(-d $samplesdir, "Able to locate samples directory");
{
+ ##### Test pre-Parrot 1.0 case
+ my $major_version = 0;
+
##### Prepare temporary directory for testing #####
my $tdir = tempdir( CLEANUP => 1 );
@@ -50,6 +53,7 @@
src/ops/bit.ops
) ],
$numoutput,
+ $major_version,
);
is($lastcode, q{bxors_s_sc_sc},
"Stage 1: Got expected last opcode");
@@ -66,6 +70,7 @@
src/ops/bit.ops
) ],
$numoutput,
+ $major_version,
);
is($lastcode, q{bxor_i_ic_ic},
"Stage 2: Got expected last opcode");
@@ -83,6 +88,7 @@
src/ops/pic.ops
) ],
$numoutput,
+ $major_version,
);
($lastcode, $lastnumber) = get_last_opcode($numoutput);
is($lastcode, q{pic_callr___pc},
@@ -99,7 +105,7 @@
#################### SUBROUTINES ####################
sub run_test_stage {
- my ($opsfilesref, $numoutput) = @_;
+ my ($opsfilesref, $numoutput, $major_version) = @_;
my $self = Parrot::OpsRenumber->new(
{
argv => $opsfilesref,
@@ -112,7 +118,7 @@
);
$self->prepare_ops();
- $self->renum_op_map_file();
+ $self->renum_op_map_file($major_version);
my ($lastcode, $lastnumber) = get_last_opcode($numoutput);
return ($lastcode, $lastnumber);
}
Modified: branches/opsrenum/tools/dev/opsrenumber.pl
==============================================================================
--- branches/opsrenum/tools/dev/opsrenumber.pl (original)
+++ branches/opsrenum/tools/dev/opsrenumber.pl Thu Aug 14 04:51:10 2008
@@ -6,6 +6,7 @@
use warnings;
use lib 'lib';
+use Parrot::Config qw( %PConfig );
use Parrot::OpsRenumber;
my $self = Parrot::OpsRenumber->new(
@@ -20,7 +21,7 @@
);
$self->prepare_ops();
-$self->renum_op_map_file();
+$self->renum_op_map_file($PConfig{MAJOR});
exit 0;
