"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Gen/PP/PdlParObj.pm" between
PDL-2.081.tar.gz and PDL-2.082.tar.gz

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

PdlParObj.pm  (PDL-2.081):PdlParObj.pm  (PDL-2.082)
skipping to change at line 91 skipping to change at line 91
sub cflags { sub cflags {
my ($this) = @_; my ($this) = @_;
map $flag2c{$_}, grep $this->{$_}, sort keys %flag2c; map $flag2c{$_}, grep $this->{$_}, sort keys %flag2c;
} }
sub name {return (shift)->{Name}} sub name {return (shift)->{Name}}
sub add_inds { sub add_inds {
my($this,$dimsobj) = @_; my($this,$dimsobj) = @_;
$this->{IndObjs} = [map {$dimsobj->get_indobj_make($_)} $this->{IndObjs} = [my @objs = map $dimsobj->get_indobj_make($_), @{$this
@{$this->{RawInds}}]; ->{RawInds}}];
my %indcount; my %indcount;
$this->{IndCounts} = [ $this->{IndCounts} = [ map 0+($indcount{$_->name}++), @objs ];
map { $this->{IndTotCounts} = [ map $indcount{$_->name}, @objs ];
0+($indcount{$_->name}++);
} @{$this->{IndObjs}}
];
$this->{IndTotCounts} = [
map {
($indcount{$_->name});
} @{$this->{IndObjs}}
];
} }
# do the dimension checking for perl level broadcasting # do the dimension checking for perl level broadcasting
# assumes that IndObjs have been created # assumes that IndObjs have been created
sub perldimcheck { sub perldimcheck {
my ($this,$pdl) = @_; my ($this,$pdl) = @_;
croak ("can't create ".$this->name) if $pdl->isnull && croak ("can't create ".$this->name) if $pdl->isnull &&
!$this->{FlagCreat}; !$this->{FlagCreat};
return 1 if $pdl->isnull; return 1 if $pdl->isnull;
my $rdims = @{$this->{RawInds}}; my $rdims = @{$this->{RawInds}};
skipping to change at line 129 skipping to change at line 120
$ind->add_value($dims[$i++]); $ind->add_value($dims[$i++]);
} }
return 0; # not creating return 0; # not creating
} }
sub finalcheck { sub finalcheck {
my ($this,$pdl) = @_; my ($this,$pdl) = @_;
return [] if $pdl->isnull; return [] if $pdl->isnull;
my @corr = (); my @corr = ();
my @dims = $pdl->dims; my @dims = $pdl->dims;
my ($i,$ind) = (0,undef); my $i = 0;
for $ind (@{$this->{IndObjs}}) { for my $ind (@{$this->{IndObjs}}) {
push @corr,[$i-1,$ind->{Value},$dims[$i-1]] if $dims[$i++] != $ind->{Value}; push @corr,[$i-1,$ind->{Value},$dims[$i-1]] if $dims[$i++] != $ind->{Value};
} }
return [@corr]; return \@corr;
} }
# get index sizes for a parameter that has to be created # get index sizes for a parameter that has to be created
sub getcreatedims { sub getcreatedims {
my $this = shift; my $this = shift;
return map return map
{ croak "can't create: index size ".$_->name." not initialised" { croak "can't create: index size ".$_->name." not initialised"
if !defined($_->{Value}) || $_->{Value} < 1; if !defined($_->{Value}) || $_->{Value} < 1;
$_->{Value} } @{$this->{IndObjs}}; $_->{Value} } @{$this->{IndObjs}};
} }
skipping to change at line 158 skipping to change at line 149
return $generic->realversion if $this->{FlagReal}; return $generic->realversion if $this->{FlagReal};
return $generic->complexversion if $this->{FlagComplex}; return $generic->complexversion if $this->{FlagComplex};
return $generic unless $this->{FlagTyped}; return $generic unless $this->{FlagTyped};
return $this->{Type}->numval > $generic->numval return $this->{Type}->numval > $generic->numval
? $this->{Type} : $generic ? $this->{Type} : $generic
if $this->{FlagTplus}; if $this->{FlagTplus};
$this->{Type}; $this->{Type};
} }
sub get_nname{ my($this) = @_; sub get_nname{ my($this) = @_;
"(\$PRIV(pdls[$this->{Number}]))"; "(\$PRIV(pdls)[$this->{Number}])";
} }
sub get_nnflag { my($this) = @_; sub get_nnflag { my($this) = @_;
"(\$PRIV(vtable->per_pdl_flags[$this->{Number}]))"; "(\$PRIV(vtable)->per_pdl_flags[$this->{Number}])";
}
sub get_substname {
my($this,$ind) = @_;
$this->{IndObjs}[$ind]->name.($this->{IndTotCounts}[$ind] > 1 ? $this->{IndCou
nts}[$ind] : '');
} }
sub get_incname { sub get_incname {
my($this,$ind,$for_local) = @_; my($this,$ind,$for_local) = @_;
return "inc_sizes[PDL_INC_ID(__privtrans->vtable,$this->{Number},$ind)]" if !$for_local; return "inc_sizes[PDL_INC_ID(__privtrans->vtable,$this->{Number},$ind)]" if !$for_local;
if($this->{IndTotCounts}[$ind] > 1) { "__inc_$this->{Name}_".$this->get_substname($ind);
"__inc_".$this->{Name}."_".($this->{IndObjs}[$ind]->name).$this->{Ind
Counts}[$ind];
} else {
"__inc_".$this->{Name}."_".($this->{IndObjs}[$ind]->name);
}
} }
sub get_incregisters { sub get_incregisters {
my($this) = @_; my($this) = @_;
if(scalar(@{$this->{IndObjs}}) == 0) {return "";} if(scalar(@{$this->{IndObjs}}) == 0) {return "";}
(join '',map { (join '',map {
my $x = $_; my $x = $_;
my ($name, $for_local) = map $this->get_incname($x, $_), 0, 1; my ($name, $for_local) = map $this->get_incname($x, $_), 0, 1;
"register PDL_Indx $for_local = __privtrans->$name; (void)$for_lo cal;\n"; "register PDL_Indx $for_local = __privtrans->$name; (void)$for_lo cal;\n";
} (0..$#{$this->{IndObjs}}) ) } (0..$#{$this->{IndObjs}}) )
skipping to change at line 194 skipping to change at line 186
# Print an access part. # Print an access part.
sub do_access { sub do_access {
my($this,$inds,$context) = @_; my($this,$inds,$context) = @_;
my $pdl = $this->{Name}; my $pdl = $this->{Name};
# Parse substitutions into hash # Parse substitutions into hash
my %subst = map my %subst = map
{/^\s*(\w+)\s*=>\s*(\S*)\s*$/ or confess "Invalid subst $_ in ($inds) (n o spaces in => value)\n"; ($1,$2)} {/^\s*(\w+)\s*=>\s*(\S*)\s*$/ or confess "Invalid subst $_ in ($inds) (n o spaces in => value)\n"; ($1,$2)}
PDL::PP::Rule::Substitute::split_cpp($inds); PDL::PP::Rule::Substitute::split_cpp($inds);
# Generate the text # Generate the text
my $text; my $text = "(${pdl}_datap)[" . join('+','0', map
$text = "(${pdl}_datap)"."["; $this->do_indterm($pdl,$_,\%subst,$context),
$text .= join '+','0',map { 0..$#{$this->{IndObjs}}) . "]";
$this->do_indterm($pdl,$_,\%subst,$context);
} (0..$#{$this->{IndObjs}});
$text .= "]";
# If not all substitutions made, the user probably made a spelling # If not all substitutions made, the user probably made a spelling
# error. Barf. # error. Barf.
if(scalar(keys %subst) != 0) { if(scalar(keys %subst) != 0) {
confess("Substitutions left: ".(join ',',sort keys %subst)."\n"); confess("Substitutions left: ".(join ',',sort keys %subst)."\n");
} }
$text; $text;
} }
sub do_pdlaccess { sub do_pdlaccess {
my($this) = @_; my($this) = @_;
PDL::PP::pp_line_numbers(__LINE__-1, '$PRIV(pdls['.$this->{Number}.'])'); PDL::PP::pp_line_numbers(__LINE__-1, '$PRIV(pdls)['.$this->{Number}.']');
} }
sub do_pointeraccess { sub do_pointeraccess {
my($this) = @_; my($this) = @_;
return $this->{Name}."_datap"; return $this->{Name}."_datap";
} }
sub do_physpointeraccess { sub do_physpointeraccess {
my($this) = @_; my($this) = @_;
return $this->{Name}."_physdatap"; return $this->{Name}."_physdatap";
} }
sub do_indterm { my($this,$pdl,$ind,$subst,$context) = @_; sub do_indterm { my($this,$pdl,$ind,$subst,$context) = @_;
# Get informed my $substname = $this->get_substname($ind);
my $indname = $this->{IndObjs}[$ind]->name;
my $indno = $this->{IndCounts}[$ind];
my $indtot = $this->{IndTotCounts}[$ind];
# See if substitutions # See if substitutions
my $substname = ($indtot>1 ? $indname.$indno : $indname); my $index = delete($subst->{$substname}) //
my $incname = $indname.($indtot>1 ? $indno : "");
my $index;
if(defined $subst->{$substname}) {$index = delete $subst->{$substname};}
else {
# No => get the one from the nearest context. # No => get the one from the nearest context.
for(reverse @$context) { (grep $_ eq $substname, map $_->[1], reverse @$context)[0];
if($_->[0] eq $indname) {$index = $_->[1]; last;} confess "Access Index not found: $pdl, $ind, @{[$this->{IndObjs}[$ind]->name]}
} On stack:".(join ' ',map {"($_->[0],$_->[1])"} @$context)."\n"
} if !defined $index;
if(!defined $index) {confess "Access Index not found: $pdl, $ind, $indnam return "(".($this->get_incname($ind,1))."*".
e "PP_INDTERM(".$this->{IndObjs}[$ind]->get_size().", $index))";
On stack:".(join ' ',map {"($_->[0],$_->[1])"} @$context)."\n" ;}
return "(".($this->get_incname($ind,1))."*".
"PP_INDTERM(".$this->{IndObjs}[$ind]->get_size().", $index))";
} }
sub get_xsdatapdecl { sub get_xsdatapdecl {
my($this,$ctype,$nulldatacheck) = @_; my($this,$ctype,$nulldatacheck) = @_;
my $pdl = $this->get_nname; my $pdl = $this->get_nname;
my $flag = $this->get_nnflag; my $flag = $this->get_nnflag;
my $name = $this->{Name}; my $name = $this->{Name};
my $macro = "PDL_DECLARE_PARAMETER".($this->{BadFlag} ? "_BADVAL" : ""); my $macro = "PDL_DECLARE_PARAMETER".($this->{BadFlag} ? "_BADVAL" : "");
"$macro($ctype, $flag, $name, $pdl, $nulldatacheck)"; "$macro($ctype, $flag, $name, $pdl, $nulldatacheck)";
} }
 End of changes. 13 change blocks. 
49 lines changed or deleted 29 lines changed or added

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