"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Gen/PP/PDLCode.pm" between
PDL-2.076.tar.gz and PDL-2.077.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

PDLCode.pm  (PDL-2.076):PDLCode.pm  (PDL-2.077)
skipping to change at line 25 skipping to change at line 25
my @code_args_always = qw(BadFlag SignatureObj GenericTypes ExtraGenericSwitches HaveBroadcasting Name); my @code_args_always = qw(BadFlag SignatureObj GenericTypes ExtraGenericSwitches HaveBroadcasting Name);
sub make_args { sub make_args {
my ($which) = @_; my ($which) = @_;
("Parsed$which", [$which,\"Bad$which",@code_args_always]); ("Parsed$which", [$which,\"Bad$which",@code_args_always]);
} }
# Do the appropriate substitutions in the code. # Do the appropriate substitutions in the code.
sub new { sub new {
my($class,$code,$badcode, my($class,$code,$badcode,
$handlebad, $sig,$generictypes,$extrageneric,$havebroadcasting,$name, $handlebad, $sig,$generictypes,$extrageneric,$havebroadcasting,$name,
$dont_add_brcloop, $backcode ) = @_; $dont_add_brcloop, $backcode, $nulldatacheck) = @_;
my $parnames = $sig->names_sorted; my $parnames = $sig->names_sorted;
die "Error: missing name argument to PDL::PP::Code->new call!\n" die "Error: missing name argument to PDL::PP::Code->new call!\n"
unless defined $name; unless defined $name;
confess "Error: empty or undefined GenericTypes!\n" confess "Error: empty or undefined GenericTypes!\n"
unless @{$generictypes || []}; unless @{$generictypes || []};
$badcode //= $code if $handlebad; $badcode //= $code if $handlebad;
# last two arguments may not be supplied # last two arguments may not be supplied
skipping to change at line 70 skipping to change at line 70
my $this = bless { my $this = bless {
IndObjs => $sig->dims_obj, IndObjs => $sig->dims_obj,
ParNames => $parnames, ParNames => $parnames,
ParObjs => $sig->objs, ParObjs => $sig->objs,
Sig => $sig, Sig => $sig,
Gencurtype => [], # stack to hold GenType in generic loops Gencurtype => [], # stack to hold GenType in generic loops
ftypes_vars => {}, ftypes_vars => {},
ftypes_type => undef, ftypes_type => undef,
Generictypes => $generictypes, # so that MacroAccess can check it Generictypes => $generictypes, # so that MacroAccess can check it
Name => $name, Name => $name,
NullDataCheck => $nulldatacheck,
}, $class; }, $class;
# First, separate the code into an array of C fragments (strings), # First, separate the code into an array of C fragments (strings),
# variable references (strings starting with $) and # variable references (strings starting with $) and
# loops (array references, 1. item = variable. # loops (array references, 1. item = variable.
# #
my ( $broadcastloops, $coderef, $sizeprivs ) = my ( $broadcastloops, $coderef, $sizeprivs ) =
$this->separate_code( "{\n$code\n}" ); $this->separate_code( "{\n$code\n}" );
# Now, if there is no explicit broadcastlooping in the code, # Now, if there is no explicit broadcastlooping in the code,
skipping to change at line 173 skipping to change at line 174
join('',map $_->get_incregisters, @$pobjs{sort keys %$pobjs}). join('',map $_->get_incregisters, @$pobjs{sort keys %$pobjs}).
$coderef->get_str($this,[]) $coderef->get_str($this,[])
; ;
$this->{Code}; $this->{Code};
} # new() } # new()
sub params_declare { sub params_declare {
my ($this) = @_; my ($this) = @_;
my ($ord,$pdls) = $this->get_pdls; my ($ord,$pdls) = $this->get_pdls;
my @decls = map $_->get_xsdatapdecl("PDL_PARAMTYPE_".$_->name), my @decls = map $_->get_xsdatapdecl("PDL_PARAMTYPE_".$_->name, $this->{NullD ataCheck}),
map $pdls->{$_}, @$ord; map $pdls->{$_}, @$ord;
my @param_names = map "PDL_PARAMTYPE_$_", @$ord; my @param_names = map "PDL_PARAMTYPE_$_", @$ord;
PDL::PP::pp_line_numbers(__LINE__, <<EOF); PDL::PP::pp_line_numbers(__LINE__, <<EOF);
#define PDL_DECLARE_PARAMS_$this->{Name}(@{[join ',', @param_names]}) \\ #ifndef PDL_DECLARE_PARAMS_$this->{Name}_$this->{NullDataCheck}
#define PDL_DECLARE_PARAMS_$this->{Name}_$this->{NullDataCheck}(@{[join ',', @pa
ram_names]}) \\
@{[join " \\\n", @decls]} @{[join " \\\n", @decls]}
#endif
EOF EOF
} }
sub func_name { $_[1] ? "writebackdata" : "readdata" } sub func_name { $_[1] ? "writebackdata" : "readdata" }
sub broadcastloop_start { sub broadcastloop_start {
my ($this, $funcname) = @_; my ($this, $funcname) = @_;
my ($ord,$pdls) = $this->get_pdls; my ($ord,$pdls) = $this->get_pdls;
<<EOF; <<EOF;
PDL_BROADCASTLOOP_START( PDL_BROADCASTLOOP_START(
skipping to change at line 503 skipping to change at line 506
my @GENTYPE_ATTRS = qw(integer real unsigned); my @GENTYPE_ATTRS = qw(integer real unsigned);
sub myitemstart { sub myitemstart {
my ($this,$parent,$nth) = @_; my ($this,$parent,$nth) = @_;
my $item = $this->[0][$nth] || return ""; my $item = $this->[0][$nth] || return "";
$parent->{Gencurtype}[-1] = $item; $parent->{Gencurtype}[-1] = $item;
@$parent{qw(ftypes_type ftypes_vars)} = ($item, $this->[2]) if defined $this ->[1]; @$parent{qw(ftypes_type ftypes_vars)} = ($item, $this->[2]) if defined $this ->[1];
my ($ord,$pdls) = $parent->get_pdls; my ($ord,$pdls) = $parent->get_pdls;
my @param_ctypes = map $pdls->{$_}->adjusted_type($item)->ctype, @$ord; my @param_ctypes = map $pdls->{$_}->adjusted_type($item)->ctype, @$ord;
my $decls = keys %{$this->[2]} == @$ord my $decls = keys %{$this->[2]} == @$ord
? PDL::PP::pp_line_numbers(__LINE__-1, "\t\tPDL_DECLARE_PARAMS_$parent->{N ? PDL::PP::pp_line_numbers(__LINE__-1, "\t\tPDL_DECLARE_PARAMS_$parent->{N
ame}(@{[join ',', @param_ctypes]})\n") ame}_$parent->{NullDataCheck}(@{[join ',', @param_ctypes]})\n")
: join '', map $_->get_xsdatapdecl($_->adjusted_type($item)->ctype), : join '', map $_->get_xsdatapdecl($_->adjusted_type($item)->ctype, $paren
t->{NullDataCheck}),
map $parent->{ParObjs}{$_}, sort keys %{$this->[2]}; map $parent->{ParObjs}{$_}, sort keys %{$this->[2]};
my @gentype_decls = map "#define PDL_IF_GENTYPE_".uc($_)."(t,f) ". my @gentype_decls = map "#define PDL_IF_GENTYPE_".uc($_)."(t,f) ".
($item->$_ ? 't' : 'f')."\n", ($item->$_ ? 't' : 'f')."\n",
@GENTYPE_ATTRS; @GENTYPE_ATTRS;
join '', join '',
PDL::PP::pp_line_numbers(__LINE__-1, "case @{[$item->sym]}: {\n"), PDL::PP::pp_line_numbers(__LINE__-1, "case @{[$item->sym]}: {\n"),
@gentype_decls, @gentype_decls,
$decls; $decls;
} }
 End of changes. 6 change blocks. 
6 lines changed or deleted 11 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)