Author: paultcochrane
Date: Wed Apr 11 14:02:56 2007
New Revision: 18147
Modified:
trunk/lib/Parrot/Configure/Options.pm
trunk/lib/Parrot/Distribution.pm
trunk/lib/Parrot/Docs/Section/C.pm
trunk/lib/Parrot/Pmc2c.pm
trunk/lib/Parrot/Pmc2c/PCCMETHOD.pm
trunk/lib/Parrot/Pmc2c/Utils.pm
trunk/lib/Parrot/Vtable.pm
Log:
[lib] Tidied code with perltidy
Modified: trunk/lib/Parrot/Configure/Options.pm
==============================================================================
--- trunk/lib/Parrot/Configure/Options.pm (original)
+++ trunk/lib/Parrot/Configure/Options.pm Wed Apr 11 14:02:56 2007
@@ -10,14 +10,14 @@
);
sub get_valid_options {
- return qw(ask bindir cage cc ccflags ccwarn cgoto cxx datadir
- debugging define exec-prefix execcapable floatval gc help icu-config
- icudatadir icuheaders icushared includedir infodir inline intval
- jitcapable ld ldflags lex libdir libexecdir libs link linkflags
- localstatedir m maintainer mandir miniparrot nomanicheck oldincludedir
- opcode ops optimize parrot_is_shared pmc prefix profile sbindir
- sharedstatedir step sysconfdir verbose verbose-step version without-gdbm
- without-gmp without-icu yacc);
+ return qw(ask bindir cage cc ccflags ccwarn cgoto cxx datadir
+ debugging define exec-prefix execcapable floatval gc help icu-config
+ icudatadir icuheaders icushared includedir infodir inline intval
+ jitcapable ld ldflags lex libdir libexecdir libs link linkflags
+ localstatedir m maintainer mandir miniparrot nomanicheck oldincludedir
+ opcode ops optimize parrot_is_shared pmc prefix profile sbindir
+ sharedstatedir step sysconfdir verbose verbose-step version
without-gdbm
+ without-gmp without-icu yacc);
}
sub process_options {
@@ -32,7 +32,7 @@
die "Must provide argument 'svnid'"
unless $optionsref->{svnid};
my %args;
- for (@{$optionsref->{argv}}) {
+ for ( @{ $optionsref->{argv} } ) {
my ( $key, $value ) = m/--([-\w]+)(?:=(.*))?/;
$key = 'help' unless defined $key;
$value = 1 unless defined $value;
@@ -42,12 +42,12 @@
}
for ($key) {
- if ($key =~ m/version/) {
+ if ( $key =~ m/version/ ) {
print_version_info($optionsref);
return;
}
- if ($key =~ m/help/) {
+ if ( $key =~ m/help/ ) {
print_help($optionsref);
return;
}
@@ -187,7 +187,7 @@
--mandir=DIR man documentation [PREFIX/man]
EOT
-};
+}
1;
Modified: trunk/lib/Parrot/Distribution.pm
==============================================================================
--- trunk/lib/Parrot/Distribution.pm (original)
+++ trunk/lib/Parrot/Distribution.pm Wed Apr 11 14:02:56 2007
@@ -184,7 +184,7 @@
ops => { file_exts => ['ops'] },
lex => {
file_exts => ['l'],
- except_dirs => [ qw{ languages/lisp examples/library } ],
+ except_dirs => [qw{ languages/lisp examples/library }],
},
yacc => { file_exts => ['y'] },
perl => {
@@ -490,9 +490,7 @@
sub get_pir_language_files {
my $self = shift;
- my @pir_files = (
- $self->pir_source_files,
- );
+ my @pir_files = ( $self->pir_source_files, );
return @pir_files;
}
@@ -693,45 +691,49 @@
# manicheck.pl is probably only useful for checked out revisions
# Checkout is done either with svn or svk
- my $cmd = (-d '.svn') ? 'svn' : 'svk';
+ my $cmd = ( -d '.svn' ) ? 'svn' : 'svk';
# Find all directories in the Parrot distribution
my %dir_list = map {
+
#uniq
$_, undef;
- } grep {
+ } grep {
+
# directories only...
-d $_
- } map {
+ } map {
+
# extract directory component, if any
my $dir = ( File::Spec->splitpath($_) )[1];
- } map {
+ } map {
+
# strip off any .svn components.
# (lets us match dirs with no versioned files)
s/\.svn.*//;
$_;
- } keys %{ ExtUtils::Manifest::manifind() }; # start with everything
+ } keys %{ ExtUtils::Manifest::manifind() }; # start with everything
- $dir_list{'.'} = undef; # check top level directory too.
+ $dir_list{'.'} = undef; # check top level
directory too.
- my @skip; # regular expressions for files to skip
+ my @skip; # regular expressions
for files to skip
- my @dirs = (sort keys %dir_list);
+ my @dirs = ( sort keys %dir_list );
my $ignore_cmd = "$cmd propget svn:ignore @dirs";
- my ($patterns, $err, $code) = capture_output($ignore_cmd);
+ my ( $patterns, $err, $code ) = capture_output($ignore_cmd);
die $err if $code;
- my @patterns_list = split(/\n/, $patterns);
+ my @patterns_list = split( /\n/, $patterns );
my ($dir);
- foreach my $pattern ( @patterns_list ) {
+ foreach my $pattern (@patterns_list) {
next if $pattern =~ m/^\s*$/;
- if ($pattern =~ s/^(.*?) - //) {
+ if ( $pattern =~ s/^(.*?) - // ) {
$dir = $1;
- if ($dir eq ".") {
+ if ( $dir eq "." ) {
$dir = q{};
}
else {
@@ -743,10 +745,10 @@
# whatever's left must be a pattern to ignore in the previously
# found directory.
- $pattern =~ s/\./\\./g; # . is simply a dot
- $pattern =~ s/\*/.*/g; # * is any amount of chars
- push @skip, "^${dir}$pattern\$"; # SVN globs are specific to a dir
- push @skip, "^${dir}$pattern/"; # SVN globs are specific to a dir
+ $pattern =~ s/\./\\./g; # . is simply a dot
+ $pattern =~ s/\*/.*/g; # * is any amount of chars
+ push @skip, "^${dir}$pattern\$"; # SVN globs are specific to a dir
+ push @skip, "^${dir}$pattern/"; # SVN globs are specific to a dir
}
return [EMAIL PROTECTED];
Modified: trunk/lib/Parrot/Docs/Section/C.pm
==============================================================================
--- trunk/lib/Parrot/Docs/Section/C.pm (original)
+++ trunk/lib/Parrot/Docs/Section/C.pm Wed Apr 11 14:02:56 2007
@@ -250,10 +250,7 @@
$self->new_group(
'Garbage Collection',
'',
- $self->c_item(
- 'Parrot\'s garbage collection subsystem.',
- 'contents' => ['src/gc']
- ),
+ $self->c_item( 'Parrot\'s garbage collection subsystem.',
'contents' => ['src/gc'] ),
),
$self->new_group(
'Debugging',
Modified: trunk/lib/Parrot/Pmc2c.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c.pm (original)
+++ trunk/lib/Parrot/Pmc2c.pm Wed Apr 11 14:02:56 2007
@@ -550,7 +550,8 @@
my $total_body;
if ( $method->{loc} eq 'vtable' ) {
- $total_body = $self->rewrite_vtable_method( $classname, $meth, $super,
$self->{super}, $body );
+ $total_body =
+ $self->rewrite_vtable_method( $classname, $meth, $super,
$self->{super}, $body );
}
else {
$total_body = $self->rewrite_nci_method( $classname, $meth, $body );
@@ -1000,8 +1001,7 @@
foreach my $method ( @{ $self->{methods} } ) {
next unless $method->{loc} eq 'nci';
my $proto = proto( $method->{type}, $method->{parameters} );
- my $symbol_name = defined $method->{symbol} ?
- $method->{symbol} : $method->{meth};
+ my $symbol_name = defined $method->{symbol} ? $method->{symbol} :
$method->{meth};
if ( exists $method->{pre_block} ) {
$cout .= <<"EOC";
register_raw_nci_method_in_ns(interp, entry,
Modified: trunk/lib/Parrot/Pmc2c/PCCMETHOD.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/PCCMETHOD.pm (original)
+++ trunk/lib/Parrot/Pmc2c/PCCMETHOD.pm Wed Apr 11 14:02:56 2007
@@ -7,7 +7,6 @@
use Data::Dumper;
use Carp qw(longmess croak);
-
=pod
$SIG{__WARN__} = sub {
@@ -105,14 +104,14 @@
=cut
our $reg_type_info = {
+
# s is string, ss is short string, at is arg type
- +(REGNO_INT) => { s => "INTVAL", ss => "INT", at => PARROT_ARG_INTVAL,
},
+ +(REGNO_INT) => { s => "INTVAL", ss => "INT", at => PARROT_ARG_INTVAL, },
+(REGNO_NUM) => { s => "FLOATVAL", ss => "NUM", at => PARROT_ARG_FLOATVAL,
},
- +(REGNO_STR) => { s => "STRING*", ss => "STR", at => PARROT_ARG_STRING,
},
- +(REGNO_PMC) => { s => "PMC*", ss => "PMC", at => PARROT_ARG_PMC,
},
+ +(REGNO_STR) => { s => "STRING*", ss => "STR", at => PARROT_ARG_STRING, },
+ +(REGNO_PMC) => { s => "PMC*", ss => "PMC", at => PARROT_ARG_PMC, },
};
-
# Declare the subroutines
sub trim($);
sub ltrim($);
@@ -163,33 +162,33 @@
sub convert_type_string_to_reg_type {
($_) = @_;
- return REGNO_INT if /INTVAL|int/i ;
- return REGNO_NUM if /FLOATVAL|double/i ;
- return REGNO_STR if /STRING/i ;
- return REGNO_PMC if /PMC/i ;
+ return REGNO_INT if /INTVAL|int/i;
+ return REGNO_NUM if /FLOATVAL|double/i;
+ return REGNO_STR if /STRING/i;
+ return REGNO_PMC if /PMC/i;
croak "$_ not recognized as INTVAL, FLOATVAL, STRING, or PMC";
}
sub gen_arg_flags {
- my ($param) = @_;
+ my ($param) = @_;
- return PARROT_ARG_INTVAL | PARROT_ARG_OPT_FLAG if exists
$param->{attrs}->{opt_flag};
+ return PARROT_ARG_INTVAL | PARROT_ARG_OPT_FLAG if exists
$param->{attrs}->{opt_flag};
my $flag = $reg_type_info->{ $param->{type} }->{at};
- $flag |= PARROT_ARG_CONSTANT if exists $param->{attrs}->{constant};
- $flag |= PARROT_ARG_OPTIONAL if exists $param->{attrs}->{optional};
- $flag |= PARROT_ARG_FLATTEN if exists $param->{attrs}->{flatten};
- $flag |= PARROT_ARG_SLURPY_ARRAY if exists $param->{attrs}->{slurpy};
- $flag |= PARROT_ARG_NAME if exists $param->{attrs}->{name};
- $flag |= PARROT_ARG_NAME if exists $param->{attrs}->{named};
+ $flag |= PARROT_ARG_CONSTANT if exists $param->{attrs}->{constant};
+ $flag |= PARROT_ARG_OPTIONAL if exists $param->{attrs}->{optional};
+ $flag |= PARROT_ARG_FLATTEN if exists $param->{attrs}->{flatten};
+ $flag |= PARROT_ARG_SLURPY_ARRAY if exists $param->{attrs}->{slurpy};
+ $flag |= PARROT_ARG_NAME if exists $param->{attrs}->{name};
+ $flag |= PARROT_ARG_NAME if exists $param->{attrs}->{named};
return $flag;
}
sub gen_arg_accessor {
my ( $arg, $arg_type ) = @_;
my ( $name, $reg_type, $index ) = ( $arg->{name}, $arg->{type},
$arg->{index} );
- my $tis = $reg_type_info->{$reg_type}->{s}; #reg_type_info string
- my $tiss = $reg_type_info->{$reg_type}->{ss}; #reg_type_info short string
+ my $tis = $reg_type_info->{$reg_type}->{s}; #reg_type_info string
+ my $tiss = $reg_type_info->{$reg_type}->{ss}; #reg_type_info short
string
if ( 'arg' eq $arg_type ) {
return " $tis $name = CTX_REG_$tiss(ctx, $index);\n";
@@ -200,7 +199,7 @@
elsif ( 'name' eq $arg_type ) {
return " CTX_REG_$tiss(ctx, $index) =
string_from_const_cstring(interp, $name, 0);\n";
}
- else { #$arg_type eq 'param' or $arg_type eq 'return'
+ else { #$arg_type eq 'param' or
$arg_type eq 'return'
return " CTX_REG_$tiss(ctx, $index) = $name;\n";
}
}
@@ -213,8 +212,8 @@
sub rewrite_PCCRETURNs {
my ( $self, $body ) = @_;
- my $method_name = $self->{meth};
- my $regs_used = [];
+ my $method_name = $self->{meth};
+ my $regs_used = [];
my $signature_re = qr{
(PCCRETURN #method name
\s* #optional whitespace
@@ -227,17 +226,16 @@
}
while ( $$body and $$body =~ m/$signature_re/ ) {
- my ($match, $returns) = ( $1, $2 );
+ my ( $match, $returns ) = ( $1, $2 );
my $goto_string = "goto ${method_name}_returns;";
my ( $returns_n_regs_used, $returns_indexes, $returns_flags,
$returns_accessors ) =
- process_pccmethod_args( parse_p_args_string( $returns ), 'return'
);
+ process_pccmethod_args( parse_p_args_string($returns), 'return' );
push @$regs_used, $returns_n_regs_used;
my $file = '"' . __FILE__ . '"';
my $lineno1 = __LINE__ + 2;
my $lineno2 = __LINE__ + 7;
- my $replacement =
-<<END;
+ my $replacement = <<END;
#line $lineno1 $file
/*BEGIN PCCRETURN $returns */
/*BEGIN GENERATED ACCESSORS */
@@ -278,17 +276,17 @@
sub is_named {
my ($arg) = @_;
while ( my ( $k, $v ) = each( %{ $arg->{attrs} } ) ) {
- return ( 1, $1 ) if ( $k =~ /named\[(.*)\]/ );
+ return ( 1, $1 ) if ( $k =~ /named\[(.*)\]/ );
}
return ( 0, '' );
}
sub process_pccmethod_args {
my ( $linear_args, $arg_type ) = @_;
- my $n_regs_used_a = [ 0, 0, 0, 0 ]; # INT, FLOAT, STRING, PMC
- my $args = [ [], [], [], [] ]; # actual INT, FLOAT, STRING,
PMC arg stuctures
- my $args_indexes_a = []; # arg index into the
interpreter context
- my $args_flags_a = []; # arg flags
+ my $n_regs_used_a = [ 0, 0, 0, 0 ]; # INT, FLOAT, STRING, PMC
+ my $args = [ [], [], [], [] ]; # actual INT, FLOAT, STRING,
PMC arg stuctures
+ my $args_indexes_a = []; # arg index into the
interpreter context
+ my $args_flags_a = []; # arg flags
my $args_accessors = "";
my $named_names = "";
@@ -305,14 +303,14 @@
push @{ $args->[ +(REGNO_STR) ] }, $argn;
$argn->{index} = $n_regs_used_a->[ +(REGNO_STR) ]++;
push @$args_indexes_a, $argn->{index};
- push @$args_flags_a, PARROT_ARG_STRING | PARROT_ARG_NAME;
+ push @$args_flags_a, PARROT_ARG_STRING | PARROT_ARG_NAME;
$named_names .= gen_arg_accessor( $argn, 'name' );
}
push @{ $args->[ $arg->{type} ] }, $arg;
$arg->{index} = $n_regs_used_a->[ $arg->{type} ]++;
push @$args_indexes_a, $arg->{index};
- push @$args_flags_a, gen_arg_flags($arg);
+ push @$args_flags_a, gen_arg_flags($arg);
$args_accessors .= gen_arg_accessor( $arg, $arg_type );
}
@@ -346,24 +344,23 @@
# parse pccmethod parameters, then unshift the a PMC arg for the invocant
my $linear_args = parse_p_args_string( $self->{parameters} );
unshift @$linear_args,
- {
+ {
type => convert_type_string_to_reg_type('PMC'),
name => 'pmc',
attrs => parse_adverb_attributes(':object')
- };
+ };
my ( $params_n_regs_used, $params_indexes, $params_flags,
$params_accessors, $named_names ) =
- process_pccmethod_args( $linear_args, 'arg' );
+ process_pccmethod_args( $linear_args, 'arg' );
- my $n_regs = rewrite_PCCRETURNs( $self, \$self->{body} );
+ my $n_regs = rewrite_PCCRETURNs( $self, \$self->{body} );
rewrite_pccinvoke( $self->{meth}, \$self->{body} );
unshift @$n_regs, $params_n_regs_used;
my $n_regs_used = find_max_regs($n_regs);
my $file = '"' . __FILE__ . '"';
my $lineno = __LINE__ + 5;
- my $PRE_STUB =
-<<END;
+ my $PRE_STUB = <<END;
{
#line $lineno $file
INTVAL n_regs_used[] = { $n_regs_used };
@@ -462,31 +459,31 @@
)
}sx;
-
while ( $$body and $$body =~ m/$signature_re/ ) {
- my ($match, $result_clause, $results, $parameters) = ( $1, $2, $3, $4
);
+ my ( $match, $result_clause, $results, $parameters ) = ( $1, $2, $3,
$4 );
#optional results portion of pccinvoke statement
- my ( $result_n_regs_used, $result_indexes, $result_flags,
$result_accessors )
- = ( defined $results) ? process_pccmethod_args(
parse_p_args_string( $results ), 'result')
+ my ( $result_n_regs_used, $result_indexes, $result_flags,
$result_accessors ) =
+ ( defined $results )
+ ? process_pccmethod_args( parse_p_args_string($results), 'result' )
: ( [ 0, 0, 0, 0 ], "0", "\"\"", "" );
#parameters portion of pccinvoke statement
- my ($interp, $invocant, $method_name, $arguments)
- = map { $_ = trim($_) } split( /,/, $parameters, 4 );
+ my ( $interp, $invocant, $method_name, $arguments ) =
+ map { $_ = trim($_) } split( /,/, $parameters, 4 );
$arguments = "PMC* $invocant" . ( $arguments ? ", $arguments" : "" );
my ( $args_n_regs_used, $arg_indexes, $arg_flags, $arg_accessors,
$named_names ) =
- process_pccmethod_args( parse_p_args_string( $arguments ), 'param'
);
+ process_pccmethod_args( parse_p_args_string($arguments), 'param' );
- my $n_regs_used = find_max_regs( [$result_n_regs_used,
$args_n_regs_used ] );
+ my $n_regs_used = find_max_regs( [ $result_n_regs_used,
$args_n_regs_used ] );
- $method_name = "string_from_const_cstring(interp, $method_name, 0)" if
isquoted($method_name);
+ $method_name = "string_from_const_cstring(interp, $method_name, 0)"
+ if isquoted($method_name);
my $file = '"' . __FILE__ . '"';
my $lineno = __LINE__ + 8;
- my $replacement .=
-<<END;
+ my $replacement .= <<END;
/*BEGIN PCCINVOKE $invocant */
#line $lineno $file
Modified: trunk/lib/Parrot/Pmc2c/Utils.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/Utils.pm (original)
+++ trunk/lib/Parrot/Pmc2c/Utils.pm Wed Apr 11 14:02:56 2007
@@ -694,15 +694,16 @@
$class_init = $method_hash;
}
else {
+
# Name-mangle NCI methods to avoid conflict with vtable methods.
if ($flag) {
- $method_hash->{loc} = "nci" ;
- $method_hash->{meth} = "nci_$methodname";
+ $method_hash->{loc} = "nci";
+ $method_hash->{meth} = "nci_$methodname";
$method_hash->{symbol} = $methodname;
}
# name => method idx mapping
- $meth_hash{$method_hash->{meth}} = scalar @methods;
+ $meth_hash{ $method_hash->{meth} } = scalar @methods;
$method_hash->{mmds} = [ ( $methodblock =~ /MMD_(\w+):/g ) ];
push @methods, $method_hash;
Modified: trunk/lib/Parrot/Vtable.pm
==============================================================================
--- trunk/lib/Parrot/Vtable.pm (original)
+++ trunk/lib/Parrot/Vtable.pm Wed Apr 11 14:02:56 2007
@@ -378,15 +378,15 @@
my $type = shift;
my %typemap = (
- 'STRING*' => 'Parrot_STRING',
- 'void*' => 'void*',
- 'INTVAL' => 'Parrot_Int',
- 'PMC*' => 'Parrot_PMC',
- 'FLOATVAL' => 'Parrot_Float',
- 'void' => 'void',
- 'UINTVAL' => 'Parrot_Int',
- 'size_t' => 'size_t',
- 'opcode_t*' => 'Parrot_Opcode*',
+ 'STRING*' => 'Parrot_STRING',
+ 'void*' => 'void*',
+ 'INTVAL' => 'Parrot_Int',
+ 'PMC*' => 'Parrot_PMC',
+ 'FLOATVAL' => 'Parrot_Float',
+ 'void' => 'void',
+ 'UINTVAL' => 'Parrot_Int',
+ 'size_t' => 'size_t',
+ 'opcode_t*' => 'Parrot_Opcode*',
);
die "Unknown type $type\n" unless exists $typemap{$type};
