# New Ticket Created by Nicholas Clark # Please include the string: [perl #16114] # in the subject line of all future correspondence about this issue. # <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=16114 >
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. Before the patch Devel::DProf thought that this is where assemble.pl spends its time: %Time ExclSec CumulS #Calls sec/call Csec/c Name 33.0 146.5 293.80 1 146.51 293.80 Assembler::to_bytecode 17.6 78.30 77.599 43052 0.0018 0.0018 Assembler::_annotate_contents 15.0 66.92 114.67 1 66.926 114.67 Assembler::_generate_bytecode 11.1 49.41 47.747 88152 0.0006 0.0005 Parrot::Types::pack_op 6.54 29.02 29.029 2050 0.0142 0.0142 Macro::_expand_macro 3.65 16.17 97.771 8 2.0223 12.221 Assembler::BEGIN 3.40 15.07 15.070 1 15.070 15.070 Assembler::_adjust_labels 3.05 13.50 42.538 1 13.509 42.538 Macro::preprocess 2.17 9.612 9.589 2050 0.0047 0.0047 Assembler::_string_constant 1.44 6.390 6.390 1 6.3900 6.3900 Macro::new 1.21 5.370 5.370 1 5.3700 5.3700 Assembler::_collect_labels 0.39 1.747 1.709 2050 0.0009 0.0008 Assembler::_numeric_constant 0.24 1.069 1.637 6 0.1782 0.2728 FindBin::BEGIN 0.18 0.800 0.800 1 0.8000 0.8000 Assembler::_init 0.15 0.650 0.919 15 0.0433 0.0613 Exporter::import With the patch: %Time ExclSec CumulS #Calls sec/call Csec/c Name 35.2 132.3 270.97 1 132.32 270.97 Assembler::to_bytecode 17.3 65.28 109.01 1 65.280 109.01 Assembler::_generate_bytecode 12.5 47.01 46.206 43052 0.0011 0.0011 Assembler::_annotate_contents 12.0 45.31 43.731 79952 0.0006 0.0005 Parrot::Types::pack_op 5.23 19.63 19.637 2050 0.0096 0.0096 Macro::_expand_macro 4.04 15.17 64.715 9 1.6861 7.1905 Assembler::BEGIN 3.87 14.51 14.510 1 14.510 14.510 Assembler::_adjust_labels 2.77 10.38 10.367 2050 0.0051 0.0051 Assembler::_string_constant 2.44 9.167 28.804 1 9.1669 28.803 Macro::preprocess 1.68 6.310 6.590 2 3.1550 3.2948 Macro::BEGIN 1.03 3.870 3.870 1 3.8700 3.8700 Assembler::_collect_labels 0.28 1.039 1.267 6 0.1732 0.2111 FindBin::BEGIN 0.21 0.770 0.770 1 0.7700 0.7700 Assembler::constant_table 0.21 0.770 0.770 1 0.7700 0.7700 Assembler::_init 0.20 0.750 1.069 17 0.0441 0.0629 Exporter::import Look. I made Assembler::_generate_bytecode faster! :-) Unfortunately Devel::SmallProf currently doesn't work with 5.8.0 The patch is entirely about changing how the regexps are generated - it makes all the constant regexps built up by interpolating other regexps flagged as /o, and it stops the constituent regexps being constantly re-assigned to my variables inside subroutines. This patch doesn't include the near infinite speedup for 5.005_03, which is currently suffering from Warnock's Dilemma Nicholas Clark -- Even better than the real thing: http://nms-cgi.sourceforge.net/ --- assemble.pl.orig Mon Aug 5 20:07:04 2002 +++ assemble.pl Sat Aug 10 18:53:14 2002 @@ -93,8 +93,40 @@ This should eliminate the intermediary . # XXX have been added, and features -will- need to be added. # + +BEGIN { + package Syntax; + + use strict; + + use vars qw(@ISA @EXPORT_OK $str_re $label_re $reg_re $num_re + $bin_re $dec_re $hex_re $flt_re); + require Exporter; + @ISA = 'Exporter'; + @EXPORT_OK = qw($str_re $label_re $reg_re $num_re + $bin_re $dec_re $hex_re $flt_re); + + $reg_re = qr([INPS]\d+); + $bin_re = qr([-+]?0[bB][01]+); + $dec_re = qr([-+]?\d+); + $hex_re = qr([-+]?0[xX][0-9a-fA-F]+); + $flt_re = qr{[-+]?\d+ (?:(?:\.\d+(?:[eE][-+]?\d+)?) + | (?:[Ee][+-]?\d+))}x; + $str_re = qr(\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\" | + \'(?:[^\\\']*(?:\\.[^\\\']*)*)\' + )x; + $label_re = qr([a-zA-Z_][a-zA-Z0-9_]*); + $num_re = qr([-+]?\d+(\.\d+([eE][-+]?\d+)?)?); + + # until this gets broken out into a file Syntax.pm we need to cheat: + $INC{"Syntax.pm"} = $0; + # Otherwise use Syntax; will attempt to require 'Syntax.pm', which will fail +} + package Macro; +use Syntax qw($label_re $num_re); + =head2 Macro class =item new @@ -156,21 +188,20 @@ sub _expand_macro { my ($self,$macro_name,$macro_args) = @_; my %args; my @temp = @{$self->{macros}{$macro_name}{contents}}; - my $label_re = qr([a-zA-Z_][a-zA-Z0-9_]*); @args{@{$self->{macros}{$macro_name}{arguments}}} = @$macro_args; $self->{macros}{$macro_name}{gensym}++; for(@temp) { s{\.local\s+\$($label_re):} - {local__${macro_name}__${1}__$self->{macros}{$macro_name}{gensym}:}gx; + {local__${macro_name}__${1}__$self->{macros}{$macro_name}{gensym}:}gxo; s{\.\$($label_re)} - {local__${macro_name}__${1}__$self->{macros}{$macro_name}{gensym}}gx; + {local__${macro_name}__${1}__$self->{macros}{$macro_name}{gensym}}gxo; s{\.($label_re)} - {exists $self->{constants}{$1} ? $self->{constants}{$1} : ".$1"}gex; + {exists $self->{constants}{$1} ? $self->{constants}{$1} : ".$1"}gexo; s{\.($label_re)} - {exists $args{$1} ? $args{$1} : ".$1"}gex; + {exists $args{$1} ? $args{$1} : ".$1"}gexo; } @temp; } @@ -229,9 +260,6 @@ sub preprocess { my $self = shift; my $line = 0; my $in_macro; - my $label_re = qr([a-zA-Z_][a-zA-Z0-9_]*); - my $reg_re = qr([INSP]\d+); - my $num_re = qr([-+]?\d+(\.\d+([eE][-+]?\d+)?)?); my @todo=@{$self->{cur_contents}}; while(scalar(@todo)) { @@ -253,19 +281,19 @@ sub preprocess { if(/^\.constant \s+ ($label_re) \s+ - ([INSP]\d+)/x) { # .constant {name} {register} + ([INSP]\d+)/xo) { # .constant {name} {register} $self->{constants}{$1} = $2; } elsif(/^\.constant \s+ ($label_re) \s+ - ($num_re)/x) { # .constant {name} {number} + ($num_re)/xo) { # .constant {name} {number} $self->{constants}{$1} = $2; } elsif(/^\.constant \s+ ($label_re) \s+ (\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\" | \'(?:[^\\\']*(?:\\.[^\\\']*)*)\' - )/x) { # .constant {name} {string} + )/xo) { # .constant {name} {string} $self->{constants}{$1} = $2; } elsif(/^\.include \s+ @@ -288,7 +316,7 @@ sub preprocess { elsif(/^\.macro \s+ ($label_re) \s* \(([^)]*)\) - /x) { # .{name} (... + /xo) { # .{name} (... if($in_macro) { push @{$self->{contents}},$_; print STDERR @@ -323,7 +351,7 @@ sub preprocess { # push @{$self->{contents}},$_; # } elsif(/\.($label_re) \s* - \(([^)]*)\)/x) { # .{name} (... + \(([^)]*)\)/xo) { # .{name} (... if(defined $self->{macros}{$1}) { my $macro_name = $1; my $arguments = $2; @@ -340,7 +368,7 @@ sub preprocess { print STDERR "Couldn't find macro '.$1' at line $line.\n"; } } - elsif(/\.($label_re)/) { # .{name} + elsif(/\.($label_re)/o) { # .{name} if(defined $self->{constants}{$1}) { push @{$self->{contents}},$_; $self->{contents}[-1] =~ s/\.(\w+)/$self->{constants}{$1}/g; @@ -376,6 +404,8 @@ sub contents { package Assembler; +use Syntax qw($str_re $label_re $reg_re $bin_re $dec_re $hex_re $flt_re); + use POSIX; # Needed for strtol() use FindBin; @@ -429,14 +459,12 @@ arguments have been appropriately analyz sub _annotate_contents { my ($self,$line) = @_; - my $str_re = qr(\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\" | - \'(?:[^\\\']*(?:\\.[^\\\']*)*)\' - )x; $self->{pc}++; return if $line=~/^\s*$/ or $line=~/^\s*#/; # Filter out the comments and blank lines - $line=~s/^((?:[^'"]+|$str_re)*)#.*$/$1/; # Remove trailing comments - $line=~s/(^\s+|\s+$)//g; # Remove leading and trailing whitespace + $line=~s/^\s+//; # Remove leading whitespace + $line=~s/^((?:[^'"]+|$str_re)*)#.*$/$1/o; # Remove trailing comments + $line=~s/\s+\z//; # Remove trailing whitespace # # Accumulate lines that only have labels until an instruction is found. # XXX This could fail if a label occurs at the end of a file. @@ -489,13 +517,11 @@ Local labels aren't given special treatm sub _collect_labels { my $self = shift; - my $label_re = qr([a-zA-Z_][a-zA-Z0-9_]*); - # # Collect label definition points first # for(@{$self->{contents}}) { - while($_->[0] =~ s/^(\$?$label_re)\s*:\s*,?//) { + while($_->[0] =~ s/^(\$?$label_re)\s*:\s*,?//o) { my $label = $1; if($label=~/^\$/) { push @{$self->{local_labels}{$1}},$_->[1]; # Local label @@ -717,8 +743,7 @@ sub constant_table { return ('table' => $const, 'length' => $constl); } - - + =item output_bytecode Returns a string with the Packfile. @@ -841,16 +866,6 @@ instruction, and generates bytecode. It sub to_bytecode { my $self = shift; - my $reg_re = qr([INPS]\d+); - my $bin_re = qr([-+]?0[bB][01]+); - my $dec_re = qr([-+]?\d+); - my $hex_re = qr([-+]?0[xX][0-9a-fA-F]+); - my $flt_re = qr{[-+]?\d+ (?:(?:\.\d+(?:[eE][-+]?\d+)?) - | (?:[Ee][+-]?\d+))}x; - my $str_re = qr(\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\" | - \'(?:[^\\\']*(?:\\.[^\\\']*)*)\' - )x; - my $label_re = qr([a-zA-Z_][a-zA-Z0-9_]*); my $pc = 0; $self->_collect_labels(); # Collect labels in a separate pass @@ -869,7 +884,7 @@ sub to_bytecode { if($temp=~s/^#.*//) { # Skip flying comments. } - elsif($temp=~s/^($reg_re)//) { + 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"; @@ -888,7 +903,7 @@ sub to_bytecode { # XXX Nip off the first keyed register and replace the '[k' at the start # XXX of the string, so we can nip off another argument. # - elsif($temp=~s/^\[k;($reg_re)/\[k/) { + elsif($temp=~s/^\[k;($reg_re)/\[k/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"; @@ -918,54 +933,54 @@ sub to_bytecode { _to_keyed_integer($_); push @{$_->[0]}, ['s',$1]; } - elsif($temp=~s/^($flt_re)//) { + elsif($temp=~s/^($flt_re)//o) { $suffixes .= "_nc"; push @{$_->[0]}, $self->_numeric_constant($1); } - elsif($temp=~s/^\[($str_re)\]//) { + elsif($temp=~s/^\[($str_re)\]//o) { $suffixes .= "_sc"; _to_keyed($_); push @{$_->[0]}, $self->_string_constant($1); } - elsif($temp=~s/^\[($bin_re)\]//) { # P3[0b11101] + 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]]; } - elsif($temp=~s/^\[($hex_re)\]//) { # P7[0x1234] + elsif($temp=~s/^\[($hex_re)\]//o) { # P7[0x1234] $suffixes .= "_ic"; _to_keyed_integer($_); push @{$_->[0]}, ['ic',(strtol($1,16))[0]]; } - elsif($temp=~s/^\[($dec_re)\]//) { # P14[3] + elsif($temp=~s/^\[($dec_re)\]//o) { # P14[3] $suffixes .= "_ic"; _to_keyed_integer($_); push @{$_->[0]}, ['ic',0+$1]; } - elsif($temp=~s/^\[($flt_re)\]//) { + elsif($temp=~s/^\[($flt_re)\]//o) { $suffixes .= "_nc"; _to_keyed($_); push @{$_->[0]}, $self->_numeric_constant($1); } - elsif($temp=~s/^($bin_re)//) { # 0b1101 + elsif($temp=~s/^($bin_re)//o) { # 0b1101 my $val = $1;$val=~s/0b//; $suffixes .= "_ic"; push @{$_->[0]}, ['ic',(strtol($val,2))[0]]; } - elsif($temp=~s/^($hex_re)//) { # 0x12aF + elsif($temp=~s/^($hex_re)//o) { # 0x12aF $suffixes .= "_ic"; push @{$_->[0]}, ['ic',(strtol($1,16))[0]]; } - elsif($temp=~s/^($dec_re)//) { # -32 + elsif($temp=~s/^($dec_re)//o) { # -32 $suffixes .= "_ic"; push @{$_->[0]}, ['ic',0+$1]; } - elsif($temp=~s/^($str_re)//) { # "Hello World" + elsif($temp=~s/^($str_re)//o) { # "Hello World" $suffixes .= "_sc"; push @{$_->[0]}, $self->_string_constant($1); } - elsif($temp=~s/^($label_re)//) { + elsif($temp=~s/^($label_re)//o) { unless(defined $self->{global_labels}{$1}) { print STDERR "Couldn't find global label '$1' at line $_->[1].\n"; last;
