A few more tweaks:
- inline and remove _to_keyed and _to_keyed_integer.
- inline pack_op
- reorder the big elsif to test for /^\[/ once at the top, then only match
against keyed/non-keyed.
At this point, startup time dominates for anything as small as our test
programs, so for testing purposes we may want to look at some sort of
"batch mode".
/s
On Sun, 11 Aug 2002, Nicholas Clark wrote:
> On Sat, Aug 10, 2002 at 07:12:52PM -0400, Dan Sugalski wrote:
> > At 10:49 PM +0000 8/10/02, Nicholas Clark (via RT) wrote:
> > >Appended patch makes the assembler faster. The speedup was 1.8% on on machine
> > >I tested on, 1.3% on another. (Cumulative time to loop round all the .pasm
> > >files created by the test suite and assemble them)
> > >I feel there' still a way to go with speedups.
> >
> > Applied, thanks. D'you have the message number for the patch in
> > limbo, perchance?
>
> [perl #16024]
>
> But it won't apply cleanly as some bugger called "Nicholas Clark (via RT)"
> :-) has just sent a patch that reworked the context line
>
> $line=~s/(^\s+|\s+$)//g; # Remove leading and trailing whitespace
>
> as two separate regexps without the alternation.
> (that was the only non ///o bit of the other patch. Not benchmarked, but
> I seem to remember reading that two regexps for that is faster than
> alternation. And why that ///g?
>
> Nicholas Clark
>
Index: assemble.pl
===================================================================
RCS file: /cvs/public/parrot/assemble.pl,v
retrieving revision 1.85
diff -p -u -w -r1.85 assemble.pl
--- assemble.pl 10 Aug 2002 23:12:32 -0000 1.85
+++ assemble.pl 10 Aug 2002 23:48:05 -0000
@@ -410,7 +410,7 @@ use POSIX; # Needed for strtol()
use FindBin;
use lib "$FindBin::Bin/lib";
-use Parrot::Types; # For pack_op()
+use Parrot::Types; # For how_to_pack()
use Parrot::OpLib::core;
use Parrot::Config;
@@ -441,7 +441,8 @@ sub new {
}
elsif(exists $args{-contents}) {
for(@{$args{-contents}}) {
- _annotate_contents($self,$_);
+ $self->{pc}++;
+ _annotate_contents($self, $_) unless /^\s*#/ or /^\s*$/; # Filter out the
+comments and blank lines
}
}
bless _init($self),$class;
@@ -460,8 +461,6 @@ arguments have been appropriately analyz
sub _annotate_contents {
my ($self,$line) = @_;
- $self->{pc}++;
- return if $line=~/^\s*$/ or $line=~/^\s*#/; # Filter out the comments and blank
lines
$line=~s/^\s+//; # Remove leading whitespace
$line=~s/^((?:[^'"]+|$str_re)*)#.*$/$1/o; # Remove trailing comments
$line=~s/\s+\z//; # Remove trailing whitespace
@@ -499,7 +498,8 @@ sub _init {
open FILE,"< $file" or
die "Couldn't read from '$file': $!";
while(<FILE>) {
- _annotate_contents($self,$_);
+ $self->{pc}++;
+ _annotate_contents($self, $_) unless /^\s*#/ or /^\s*$/; # Filter out the
+comments and blank lines
}
close FILE;
}
@@ -550,23 +550,24 @@ packed into the appropriate areas.
sub _generate_bytecode {
my $self = shift;
+ my $fmt = how_to_pack('op');
for my $op (@{$self->{contents}}) {
if(defined $self->{fullops}{$op->[0][0]}) {
$op->[0][0] = $self->{fullops}{$op->[0][0]};
- $self->{bytecode} .= pack_op($op->[0][0]);
+ $self->{bytecode} .= pack($fmt, $op->[0][0]);
for(@{$op->[0]}) {
next unless ref($_) eq 'ARRAY'; # XXX Probably should loop smarter than this
if ($_->[0] =~ /^[ispn]$/) { # Register
$_->[1] =~ /(\d+)/;
- $self->{bytecode} .= pack_op($1);
+ $self->{bytecode} .= pack($fmt, $1);
}
elsif ($_->[0] =~ /^([spn])c$/) { # String/num/PMC constant
- $self->{bytecode} .= pack_op($_->[1]);
+ $self->{bytecode} .= pack($fmt, $_->[1]);
}
elsif ($_->[0] eq "ic") { # Integer constant
- $self->{bytecode} .= pack_op($_->[1]);
+ $self->{bytecode} .= pack($fmt, $_->[1]);
}
#
# Not sure if this is actually used...
@@ -574,7 +575,7 @@ sub _generate_bytecode {
elsif ($_->[0] eq "r") {
my %r_types = ("I" => 0, "N"=>1, "S"=>2, "P"=>3);
$_->[1]=~/([PSNI])(\d+)/i;
- $self->{bytecode} .= pack_op($r_types{uc $1} >> 6 + $2);
+ $self->{bytecode} .= pack($fmt, $r_types{uc $1} >> 6 + $2);
}
}
}
@@ -661,31 +662,6 @@ sub _numeric_constant {
return ['nc',$self->{constants}{n}{$constant}];
}
-=item _to_keyed
-
-Convert the operator to a keyed operator. Admittedly it's not much of a
-transformation, but it's a way to mark the code.
-
-=cut
-
-sub _to_keyed {
- my $operator = shift;
- return if $operator->[0][0] =~ /^[a-zA-Z]+_keyed/;
- $operator->[0][0] =~ s/^([a-zA-Z]+)/${1}_keyed/;
-}
-
-=item _to_keyed_integer
-
-Convert the operator to a keyed operator
-
-=cut
-
-sub _to_keyed_integer {
- my $operator = shift;
- return if $operator->[0][0] =~ /^[a-zA-Z]+_keyed_integer/;
- $operator->[0][0] =~ s/^([a-zA-Z]+)/${1}_keyed_integer/;
-}
-
=item constant_table
Constant table returns a hash with the length in bytes of the constant table
@@ -884,20 +860,12 @@ sub to_bytecode {
if($temp=~s/^#.*//) {
# Skip flying comments.
}
- elsif($temp=~s/^($reg_re)//o) {
- my $reg_idx = substr($1,1);
- unless($reg_idx >= 0 and $reg_idx <= 31) {
- print STDERR "Caught out-of-bounds register $1 at line $_->[1].\n";
- last;
- }
- $suffixes .= "_".lc(substr($1,0,1));
- push @{$_->[0]}, [lc(substr($1,0,1)),$1];
- }
+ elsif($temp=~/^\[/) {
#
# XXX '[k]' should be the result of one or more chained '[k;I3]' type
# XXX arguments. '[k;I3;N0]' gets transformed to '[k;N0]', then just '[k]'
#
- elsif($temp=~s/^\[k\]//) {
+ if($temp=~s/^\[k\]//) {
}
#
# XXX Nip off the first keyed register and replace the '[k' at the start
@@ -910,8 +878,8 @@ sub to_bytecode {
last;
}
$suffixes .= "_k";
- _to_keyed($_);
push @{$_->[0]}, ['k',$1];
+ $_->[0][0] =~ s/^([a-zA-Z]+)(?:_keyed)?/${1}_keyed/;
}
elsif($temp=~s/^\[(S\d+)\]//) { # The only key register should be Sn
my $reg_idx = substr($1,1);
@@ -920,8 +888,8 @@ sub to_bytecode {
last;
}
$suffixes .= "_s";
- _to_keyed($_);
push @{$_->[0]}, ['s',$1];
+ $_->[0][0] =~ s/^([a-zA-Z]+)(?:_keyed)?/${1}_keyed/;
}
elsif($temp=~s/^\[(I\d+)\]//) { # The only key register should be Sn
my $reg_idx = substr($1,1);
@@ -930,37 +898,49 @@ sub to_bytecode {
last;
}
$suffixes .= "_k";
- _to_keyed_integer($_);
push @{$_->[0]}, ['s',$1];
- }
- elsif($temp=~s/^($flt_re)//o) {
- $suffixes .= "_nc";
- push @{$_->[0]}, $self->_numeric_constant($1);
+ $_->[0][0] =~ s/^([a-zA-Z]+)(?:_keyed_integer)?/${1}_keyed_integer/;
}
elsif($temp=~s/^\[($str_re)\]//o) {
$suffixes .= "_sc";
- _to_keyed($_);
push @{$_->[0]}, $self->_string_constant($1);
+ $_->[0][0] =~ s/^([a-zA-Z]+)(?:_keyed)?/${1}_keyed/;
}
elsif($temp=~s/^\[($bin_re)\]//o) { # P3[0b11101]
my $val = $1;$val=~s/0b//;
$suffixes .= "_ic";
- _to_keyed_integer($_);
push @{$_->[0]}, ['ic',(strtol($val,2))[0]];
+ $_->[0][0] =~ s/^([a-zA-Z]+)(?:_keyed_integer)?/${1}_keyed_integer/;
}
elsif($temp=~s/^\[($hex_re)\]//o) { # P7[0x1234]
$suffixes .= "_ic";
- _to_keyed_integer($_);
push @{$_->[0]}, ['ic',(strtol($1,16))[0]];
+ $_->[0][0] =~ s/^([a-zA-Z]+)(?:_keyed_integer)?/${1}_keyed_integer/;
}
elsif($temp=~s/^\[($dec_re)\]//o) { # P14[3]
$suffixes .= "_ic";
- _to_keyed_integer($_);
push @{$_->[0]}, ['ic',0+$1];
+ $_->[0][0] =~ s/^([a-zA-Z]+)(?:_keyed_integer)?/${1}_keyed_integer/;
}
elsif($temp=~s/^\[($flt_re)\]//o) {
$suffixes .= "_nc";
- _to_keyed($_);
+ push @{$_->[0]}, $self->_numeric_constant($1);
+ $_->[0][0] =~ s/^([a-zA-Z]+)(?:_keyed)?/${1}_keyed/;
+ } else {
+ die;
+ }
+ }
+ elsif($temp=~s/^($reg_re)//o) {
+ my $reg_idx = substr($1,1);
+ unless($reg_idx >= 0 and $reg_idx <= 31) {
+ print STDERR "Caught out-of-bounds register $1 at line $_->[1].\n";
+ last;
+ }
+ $suffixes .= "_".lc(substr($1,0,1));
+ push @{$_->[0]}, [lc(substr($1,0,1)),$1];
+ }
+ elsif($temp=~s/^($flt_re)//o) {
+ $suffixes .= "_nc";
push @{$_->[0]}, $self->_numeric_constant($1);
}
elsif($temp=~s/^($bin_re)//o) { # 0b1101
Index: lib/Parrot/Types.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Types.pm,v
retrieving revision 1.3
diff -p -u -w -r1.3 Types.pm
--- lib/Parrot/Types.pm 14 Jul 2002 10:34:50 -0000 1.3
+++ lib/Parrot/Types.pm 10 Aug 2002 23:48:05 -0000
@@ -34,6 +34,7 @@ use Parrot::Config;
&shift_sv
&shift_op
&shift_arg
+ &how_to_pack
);
my %pack_type = (
@@ -77,6 +78,7 @@ sub pack_intval { return pack ($how_t
sub pack_floatval { return pack ($how_to_pack{floatval}, shift) }
sub pack_sv { return shift->pack }
sub pack_op { return pack ($how_to_pack{op}, shift) }
+sub how_to_pack { return $how_to_pack{+shift} }
sub unpack_byte { return unpack($how_to_pack{byte}, shift) }
sub unpack_intval { return unpack($how_to_pack{intval}, shift) }
