"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Slices/slices.pd" between
PDL-2.077.tar.gz and PDL-2.078.tar.gz

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

slices.pd  (PDL-2.077):slices.pd  (PDL-2.078)
skipping to change at line 153 skipping to change at line 153
puts a single column from C<$x> into C<$y>, and puts a single element puts a single column from C<$x> into C<$y>, and puts a single element
from each column of C<$x> into C<$c>. If you want to extract multiple from each column of C<$x> into C<$c>. If you want to extract multiple
columns from an array in one operation, see L</dice> or columns from an array in one operation, see L</dice> or
L</indexND>. L</indexND>.
=cut =cut
EOD EOD
my $index_init_good = my $index_init =
'register PDL_Indx foo = $ind(); 'register PDL_Indx this_ind = $ind();
if( foo<0 || foo>=$SIZE(n) ) { if( PDL_IF_BAD($ISBADVAR(this_ind,ind) ||,) this_ind<0 || this_ind>=$SIZ
$CROAK("invalid index %d (valid range 0..%d)", E(n) ) {
foo,$SIZE(n)-1); $CROAK("invalid index %"IND_FLAG" (valid range 0..%"IND_FLAG")",
this_ind,$SIZE(n)-1);
}'; }';
my $index_init_bad =
'register PDL_Indx foo = $ind();
if( $ISBADVAR(foo,ind) || foo<0 || foo>=$SIZE(n) ) {
$CROAK("invalid index %d (valid range 0..%d)",
foo,$SIZE(n)-1);
}';
pp_def( pp_def(
'index', 'index',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
HandleBad => 1, HandleBad => 1,
DefaultFlow => 1, DefaultFlow => 1,
TwoWay => 1, TwoWay => 1,
Pars => 'a(n); indx ind(); [oca] c();', Pars => 'a(n); indx ind(); [oca] c();',
Code => Code =>
$index_init_good . ' $c() = $a(n => foo);', $index_init . ' $c() = $a(n => this_ind);',
BadCode =>
$index_init_bad . ' $c() = $a(n => foo);',
BackCode => BackCode =>
$index_init_good . ' $a(n => foo) = $c();', $index_init . ' $a(n => this_ind) = $c();',
BadBackCode =>
$index_init_bad . ' $a(n => foo) = $c();',
Doc => $doc, Doc => $doc,
BadDoc => BadDoc =>
'index barfs if any of the index values are bad.', 'index barfs if any of the index values are bad.',
); );
pp_def( pp_def(
'index1d', 'index1d',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
HandleBad => 1, HandleBad => 1,
DefaultFlow => 1, DefaultFlow => 1,
TwoWay => 1, TwoWay => 1,
Pars => 'a(n); indx ind(m); [oca] c(m);', Pars => 'a(n); indx ind(m); [oca] c(m);',
Code => Code => q{
q{
PDL_Indx i;
for(i=0;i<$SIZE(m);i++) {
PDL_Indx foo = $ind(m=>i);
if( foo<0 || foo >= $SIZE(n) ) {
$CROAK("invalid index %d at pos %d (valid range 0..%d)",
foo, i, $SIZE(n)-1);
}
$c(m=>i) = $a(n=>foo);
}
},
BadCode =>
q{
PDL_Indx i; PDL_Indx i;
for(i=0;i<$SIZE(m);i++) { for(i=0;i<$SIZE(m);i++) {
PDL_Indx foo = $ind(m=>i); PDL_Indx this_ind = $ind(m=>i);
if( $ISBADVAR(foo, ind) ) { PDL_IF_BAD(if( $ISBADVAR(this_ind, ind) ) {
$SETBAD(c(m=>i)); $SETBAD(c(m=>i));
} else { } else,) {
if( foo<0 || foo >= $SIZE(n) ) { if( this_ind<0 || this_ind >= $SIZE(n) ) {
$CROAK("invalid/bad index %d at pos %d (valid range 0..%d)" $CROAK("invalid index %"IND_FLAG" at pos %"IND_FLAG" (valid
, range 0..%"IND_FLAG")",
foo, i, $SIZE(n)-1); this_ind, i, $SIZE(n)-1);
} }
$c(m=>i) = $a(n=>foo); $c(m=>i) = $a(n=>this_ind);
} }
} }
}, },
BackCode => q{ BackCode => q{
PDL_Indx i; PDL_Indx i;
for(i=0;i<$SIZE(m);i++) { for(i=0;i<$SIZE(m);i++) {
PDL_Indx foo = $ind(m=>i); PDL_Indx this_ind = $ind(m=>i);
if( foo<0 || foo >= $SIZE(n) ) { PDL_IF_BAD(if( $ISBADVAR(this_ind, ind) ) {
$CROAK("invalid index %d at pos %d (valid range 0..%d)",
foo, i, $SIZE(n)-1);
}
$a(n=>foo) = $c(m=>i);
}
},
BadBackCode => q{
PDL_Indx i;
for(i=0;i<$SIZE(m);i++) {
PDL_Indx foo = $ind(m=>i);
if( $ISBADVAR(foo, ind) ) {
/* do nothing */ /* do nothing */
} else { } else,) {
if( foo<0 || foo >= $SIZE(n) ) { if( this_ind<0 || this_ind >= $SIZE(n) ) {
$CROAK("invalid/bad index %d at pos %d (valid range 0..%d)" $CROAK("invalid index %"IND_FLAG" at pos %"IND_FLAG" (valid
, range 0..%"IND_FLAG")",
foo, i, $SIZE(n)-1); this_ind, i, $SIZE(n)-1);
} }
$a(n=>foo) = $c(m=>i); $a(n=>this_ind) = $c(m=>i);
} }
} }
}, },
Doc => $doc, Doc => $doc,
BadDoc => BadDoc =>
'index1d propagates BAD index elements to the output variable.' 'index1d propagates BAD index elements to the output variable.'
); );
my $index2d_init_good = my $index2d_init =
'register PDL_Indx fooa,foob; 'register PDL_Indx this_ind_a = $inda(),this_ind_b = $indb();
fooa = $inda(); if( PDL_IF_BAD($ISBADVAR(this_ind_a,inda) ||,) this_ind_a<0 || this_ind_
if( fooa<0 || fooa>=$SIZE(na) ) { a>=$SIZE(na) )
$CROAK("invalid x-index %d (valid range 0..%d)", $CROAK("invalid x-index %"IND_FLAG" (valid range 0..%"IND_FLAG")",
fooa,$SIZE(na)-1); this_ind_a,$SIZE(na)-1);
} if( PDL_IF_BAD($ISBADVAR(this_ind_b,indb) ||,) this_ind_b<0 || this_ind_
foob = $indb(); b>=$SIZE(nb) )
if( foob<0 || foob>=$SIZE(nb) ) { $CROAK("invalid y-index %"IND_FLAG" (valid range 0..%"IND_FLAG")",
$CROAK("invalid y-index %d (valid range 0..%d)", this_ind_b,$SIZE(nb)-1);
foob,$SIZE(nb)-1); ';
}';
my $index2d_init_bad =
'register PDL_Indx fooa,foob;
fooa = $inda();
if( $ISBADVAR(fooa,inda) || fooa<0 || fooa>=$SIZE(na) ) {
$CROAK("invalid index 1");
}
foob = $indb();
if( $ISBADVAR(foob,indb) || foob<0 || foob>=$SIZE(nb) ) {
$CROAK("invalid index 2");
}';
pp_def( pp_def(
'index2d', 'index2d',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
HandleBad => 1, HandleBad => 1,
DefaultFlow => 1, DefaultFlow => 1,
TwoWay => 1, TwoWay => 1,
Pars => 'a(na,nb); indx inda(); indx indb(); [oca] c();', Pars => 'a(na,nb); indx inda(); indx indb(); [oca] c();',
Code => Code =>
$index2d_init_good . ' $c() = $a(na => fooa, nb => foob);', $index2d_init . ' $c() = $a(na => this_ind_a, nb => this_ind_b);',
BadCode =>
$index2d_init_bad . '$c() = $a(na => fooa, nb => foob);',
BackCode => BackCode =>
$index2d_init_good . ' $a(na => fooa, nb => foob) = $c();', $index2d_init . ' $a(na => this_ind_a, nb => this_ind_b) = $c();',
BadBackCode =>
$index2d_init_bad . '$a(na => fooa, nb => foob) = $c();',
Doc => $doc, Doc => $doc,
BadDoc => BadDoc =>
'index2d barfs if either of the index values are bad.', 'index2d barfs if either of the index values are bad.',
); );
# indexND: CED 2-Aug-2002 # indexND: CED 2-Aug-2002
pp_add_exported('','indexND indexNDb'); pp_add_exported('','indexND indexNDb');
pp_addpm(<<'EOD-indexND'); pp_addpm(<<'EOD-indexND');
=head2 indexNDb =head2 indexNDb
=for ref =for ref
Backwards-compatibility alias for indexND Backwards-compatibility alias for indexND
=head2 indexND =head2 indexND
=for ref =for ref
skipping to change at line 390 skipping to change at line 336
elsif($bound !~ m/^[0123ftepx]+$/ && $bound =~ m/^([0123ftepx])/i ) { elsif($bound !~ m/^[0123ftepx]+$/ && $bound =~ m/^([0123ftepx])/i ) {
$bound = $1; $bound = $1;
} }
} }
no warnings; # shut up about passing undef into rangeb no warnings; # shut up about passing undef into rangeb
$source->rangeb($index,$size,$bound); $source->rangeb($index,$size,$bound);
} }
EOD-range EOD-range
=head2 range
=cut
pp_def( pp_def(
'rangeb', 'rangeb',
OtherPars => 'pdl *ind_pdl; SV *size; SV *boundary_sv', OtherPars => 'pdl *ind_pdl; SV *size; SV *boundary_sv',
Doc => <<'EOD', Doc => <<'EOD',
=for ref =for ref
Engine for L</range> Engine for L</range>
=for example =for example
skipping to change at line 604 skipping to change at line 546
[0 0 1 1 0] [0 0 1 1 0]
] ]
B<CAVEAT>: It's quite possible to select multiple ranges that B<CAVEAT>: It's quite possible to select multiple ranges that
intersect. In that case, modifying the ranges doesn't have a intersect. In that case, modifying the ranges doesn't have a
guaranteed result in the original PDL -- the result is an arbitrary guaranteed result in the original PDL -- the result is an arbitrary
choice among the valid values. For some things that's OK; but for choice among the valid values. For some things that's OK; but for
others it's not. In particular, this doesn't work: others it's not. In particular, this doesn't work:
pdl> $photon_list = new PDL::RandVar->sample(500)->reshape(2,250)*10 pdl> $photon_list = new PDL::RandVar->sample(500)->reshape(2,250)*10
pdl> histogram = zeroes(10,10) pdl> $histogram = zeroes(10,10)
pdl> histogram->range($photon_list,1)++; #not what you wanted pdl> $histogram->range($photon_list,1)++; #not what you wanted
The reason is that if two photons land in the same bin, then that bin The reason is that if two photons land in the same bin, then that bin
doesn't get incremented twice. (That may get fixed in a later version...) doesn't get incremented twice. (That may get fixed in a later version...)
B<PERMISSIVE RANGING>: If C<$index> has too many dimensions compared B<PERMISSIVE RANGING>: If C<$index> has too many dimensions compared
to C<$source>, then $source is treated as though it had dummy to C<$source>, then $source is treated as though it had dummy
dimensions of size 1, up to the required number of dimensions. These dimensions of size 1, up to the required number of dimensions. These
virtual dummy dimensions have the usual boundary conditions applied to virtual dummy dimensions have the usual boundary conditions applied to
them. them.
skipping to change at line 646 skipping to change at line 588
PDL with every atomic perl operation, even if you only touch a single element. PDL with every atomic perl operation, even if you only touch a single element.
One way to speed up such code is to sever your range, so that PDL One way to speed up such code is to sever your range, so that PDL
doesn't have to copy the data with each operation, then copy the doesn't have to copy the data with each operation, then copy the
elements explicitly at the end of your loop. Here's an example that elements explicitly at the end of your loop. Here's an example that
labels each region in a range sequentially, using many small labels each region in a range sequentially, using many small
operations rather than a single xvals assignment: operations rather than a single xvals assignment:
### How to make a collection of small ops run fast with range... ### How to make a collection of small ops run fast with range...
$x = $data->range($index, $sizes, $bound)->sever; $x = $data->range($index, $sizes, $bound)->sever;
$aa = $data->range($index, $sizes, $bound); $aa = $data->range($index, $sizes, $bound);
map { $x($_ - 1) .= $_; } (1..$x->nelem); # Lots of little ops $x($_ - 1) .= $_ for 1..$x->nelem; # Lots of little ops
$aa .= $x; $aa .= $x;
C<range> is a perl front-end to a PP function, C<rangeb>. Calling C<range> is a perl front-end to a PP function, C<rangeb>. Calling
C<rangeb> is marginally faster but requires that you include all arguments. C<rangeb> is marginally faster but requires that you include all arguments.
DEVEL NOTES DEVEL NOTES
* index broadcast dimensions are effectively clumped internally. This * index broadcast dimensions are effectively clumped internally. This
makes it easier to loop over the index array but a little more brain-bending makes it easier to loop over the index array but a little more brain-bending
to tease out the algorithm. to tease out the algorithm.
=cut =cut
EOD EOD
HandleBad => 1, HandleBad => 1,
TwoWay => 1, TwoWay => 1,
P2Child => 1, P2Child => 1,
#
# rdim: dimensionality of each range (0 dim of index PDL) # rdim: dimensionality of each range (0 dim of index PDL)
# #
# ntsize: number of nonzero size dimensions # ntsize: number of nonzero size dimensions
# sizes: array of range sizes, indexed (0..rdim-1). A zero element means # sizes: array of range sizes, indexed (0..rdim-1). A zero element means
# that the dimension is omitted from the child dim list. # that the dimension is omitted from the child dim list.
# corners: parent coordinates of each corner, running fastest over coord index. # corners: parent coordinates of each corner, running fastest over coord index.
# (indexed 0 .. (nitems-1)*(rdim)+rdim-1) # (indexed 0 .. (nitems-1)*(rdim)+rdim-1)
# nitems: total number of list elements (product of itdims) # nitems: total number of list elements (product of itdims)
# itdim: number of index broadcast dimensions # itdim: number of index broadcast dimensions
# itdims: Size of each index broadcast dimension, indexed (0..itdim-1) # itdims: Size of each index broadcast dimension, indexed (0..itdim-1)
skipping to change at line 902 skipping to change at line 842
PDL->destroy(size_pdl); /* finished with our copy */ PDL->destroy(size_pdl); /* finished with our copy */
EOD-MakeComp EOD-MakeComp
RedoDims => <<'EOD-RedoDims' , RedoDims => <<'EOD-RedoDims' ,
PDL_Indx stdim = $PARENT(ndims) - $COMP(rdim); PDL_Indx stdim = $PARENT(ndims) - $COMP(rdim);
PDL_Indx dim,inc; PDL_Indx dim,inc;
PDL_Indx i,rdvalid; PDL_Indx i,rdvalid;
// Speed bump for ludicrous cases // Speed bump for ludicrous cases
if( $COMP(rdim) > $PARENT(ndims)+5 && $COMP(nsizes) != $COMP(rdim)) { if( $COMP(rdim) > $PARENT(ndims)+5 && $COMP(nsizes) != $COMP(rdim)) {
$CROAK("Ludicrous number of extra dims in range index; leaving child null.\n $CROAK(
(%d implicit dims is > 5; index has %d dims; source has %d dim%s.)\n This "Ludicrous number of extra dims in range index; leaving child null.\n"
often means that your index PDL is incorrect. To avoid this message,\n allo " (%"IND_FLAG" implicit dims is > 5; index has %"IND_FLAG" dims; source h
cate dummy dims in the source or use %d dims in range's size field.\n",$COMP(rdi as %"IND_FLAG" dim%s.)\n"
m)-$PARENT(ndims),$COMP(rdim),$PARENT(ndims),($PARENT(ndims))>1?"s":"",$COMP(rdi " This often means that your index PDL is incorrect.\n"
m)); " To avoid this message, allocate dummy dims in\n"
" the source or use %"IND_FLAG" dims in range's size field.\n",
$COMP(rdim)-$PARENT(ndims),$COMP(rdim),$PARENT(ndims),
$PARENT(ndims)>1?"s":"",$COMP(rdim)
);
} }
if(stdim < 0) if(stdim < 0)
stdim = 0; stdim = 0;
/* Set dimensionality of child */ /* Set dimensionality of child */
$CHILD(ndims) = $COMP(itdim) + $COMP(ntsize) + stdim; $CHILD(ndims) = $COMP(itdim) + $COMP(ntsize) + stdim;
$SETNDIMS($COMP(itdim)+$COMP(ntsize)+stdim); $SETNDIMS($COMP(itdim)+$COMP(ntsize)+stdim);
inc = 1; inc = 1;
skipping to change at line 947 skipping to change at line 895
/* all non-barfing boundary conditions to truncation, since we have no data */ /* all non-barfing boundary conditions to truncation, since we have no data */
/* to reflect, extend, or mirror. */ /* to reflect, extend, or mirror. */
if($PARENT(dims[0]) == 0) { if($PARENT(dims[0]) == 0) {
for(dim=0; dim<$COMP(rdim); dim++) { for(dim=0; dim<$COMP(rdim); dim++) {
if($COMP(boundary[dim])) if($COMP(boundary[dim]))
$COMP(boundary[dim]) = 1; // force truncation $COMP(boundary[dim]) = 1; // force truncation
} }
} }
$CHILD(datatype) = $PARENT(datatype); $CHILD(datatype) = $PARENT(datatype);
$SETDIMS(); $SETDIMS();
EOD-RedoDims EOD-RedoDims
EquivCPOffsCode => <<'EOD-EquivCPOffsCode', EquivCPOffsCode => <<'EOD-EquivCPOffsCode',
PDL_Indx *ip; /* vector iterator */ PDL_Indx *ip; /* vector iterator */
PDL_Indx *sp; /* size vector including stdims */ PDL_Indx *sp; /* size vector including stdims */
PDL_Indx *coords; /* current coordinates */ PDL_Indx *coords; /* current coordinates */
PDL_Indx k; /* index */ PDL_Indx k; /* index */
PDL_Indx item; /* index broadcast iterator */ PDL_Indx item; /* index broadcast iterator */
PDL_Indx pdim = $PDL(PARENT)->ndims; PDL_Indx pdim = $PDL(PARENT)->ndims;
skipping to change at line 1099 skipping to change at line 1045
iter2[k] = 0; iter2[k] = 0;
} while(k < pdim); /* end of source-broadcast iteration */ } while(k < pdim); /* end of source-broadcast iteration */
/* Increment the in-range iterator */ /* Increment the in-range iterator */
for(k = 0; for(k = 0;
k < $COMP(rdim) && (++(iter2[k]) >= $COMP(sizes[k])); k < $COMP(rdim) && (++(iter2[k]) >= $COMP(sizes[k]));
k++) k++)
iter2[k] = 0; iter2[k] = 0;
} while(k < $COMP(rdim)); /* end of main iteration */ } while(k < $COMP(rdim)); /* end of main iteration */
} /* end of item do loop */ } /* end of item do loop */
EOD-EquivCPOffsCode EOD-EquivCPOffsCode
); );
=head2 rld =head2 rld
=cut =cut
pp_def( pp_def(
'rld', 'rld',
GenericTypes => [ppdefs_all], GenericTypes => [ppdefs_all],
Pars=>'indx a(n); b(n); [o]c(m);', Pars=>'indx a(n); b(n); [o]c(m);',
PMCode =><<'EOD', PMCode =><<'EOD',
skipping to change at line 1291 skipping to change at line 1235
OtherPars => 'PDL_Indx n1; PDL_Indx n2;', OtherPars => 'PDL_Indx n1; PDL_Indx n2;',
TwoWay => 1, TwoWay => 1,
P2Child => 1, P2Child => 1,
AffinePriv => 1, AffinePriv => 1,
EquivDimCheck => 'if ($COMP(n1) <0) EquivDimCheck => 'if ($COMP(n1) <0)
$COMP(n1) += $PARENT(broadcastids[0]); $COMP(n1) += $PARENT(broadcastids[0]);
if ($COMP(n2) <0) if ($COMP(n2) <0)
$COMP(n2) += $PARENT(broadcastids[0]); $COMP(n2) += $PARENT(broadcastids[0]);
if (PDLMIN($COMP(n1),$COMP(n2)) <0 || if (PDLMIN($COMP(n1),$COMP(n2)) <0 ||
PDLMAX($COMP(n1),$COMP(n2)) >= $PARENT(broadcastids[0])) PDLMAX($COMP(n1),$COMP(n2)) >= $PARENT(broadcastids[0]))
$CROAK("One of dims %d, %d out of range: should be 0<=dim<%d", $CROAK("One of dims %"IND_FLAG", %"IND_FLAG" out of range: shoul d be 0<=dim<%"IND_FLAG"",
$COMP(n1),$COMP(n2),$PARENT(broadcastids[0]));', $COMP(n1),$COMP(n2),$PARENT(broadcastids[0]));',
EquivPDimExpr => '(($CDIM == $COMP(n1)) ? $COMP(n2) : ($CDIM == $COMP(n2 )) ? $COMP(n1) : $CDIM)', EquivPDimExpr => '(($CDIM == $COMP(n1)) ? $COMP(n2) : ($CDIM == $COMP(n2 )) ? $COMP(n1) : $CDIM)',
Doc => <<'EOD', Doc => <<'EOD',
=for ref =for ref
exchange two dimensions exchange two dimensions
Negative dimension indices count from the end. Negative dimension indices count from the end.
The command The command
skipping to change at line 1460 skipping to change at line 1404
OtherPars => 'PDL_Indx n1; PDL_Indx n2;', OtherPars => 'PDL_Indx n1; PDL_Indx n2;',
TwoWay => 1, TwoWay => 1,
P2Child => 1, P2Child => 1,
AffinePriv => 1, AffinePriv => 1,
EquivDimCheck => 'if ($COMP(n1) <0) EquivDimCheck => 'if ($COMP(n1) <0)
$COMP(n1) += $PARENT(broadcastids[0]); $COMP(n1) += $PARENT(broadcastids[0]);
if ($COMP(n2) <0) if ($COMP(n2) <0)
$COMP(n2) += $PARENT(broadcastids[0]); $COMP(n2) += $PARENT(broadcastids[0]);
if (PDLMIN($COMP(n1),$COMP(n2)) <0 || if (PDLMIN($COMP(n1),$COMP(n2)) <0 ||
PDLMAX($COMP(n1),$COMP(n2)) >= $PARENT(broadcastids[0])) PDLMAX($COMP(n1),$COMP(n2)) >= $PARENT(broadcastids[0]))
$CROAK("One of dims %d, %d out of range: should be 0<=dim<%d", $CROAK("One of dims %"IND_FLAG", %"IND_FLAG" out of range: shoul d be 0<=dim<%"IND_FLAG"",
$COMP(n1),$COMP(n2),$PARENT(broadcastids[0]));', $COMP(n1),$COMP(n2),$PARENT(broadcastids[0]));',
EquivPDimExpr => '( EquivPDimExpr => '(
$COMP(n1) == $COMP(n2) ? $CDIM : $COMP(n1) == $COMP(n2) ? $CDIM :
$COMP(n1) < $COMP(n2) ? EQUIVDIM($COMP(n1),$COMP(n2),$CDIM,1) : $COMP(n1) < $COMP(n2) ? EQUIVDIM($COMP(n1),$COMP(n2),$CDIM,1) :
EQUIVDIM($COMP(n1),$COMP(n2),$CDIM,-1) EQUIVDIM($COMP(n1),$COMP(n2),$CDIM,-1)
)', )',
Doc => << 'EOD', Doc => << 'EOD',
=for ref =for ref
move a dimension to another position move a dimension to another position
skipping to change at line 1574 skipping to change at line 1518
$CHILD(dims)[cd] = $PARENT(dims)[cd]; $CHILD(dims)[cd] = $PARENT(dims)[cd];
nthc++; nthc++;
$PRIV(incs)[cd] = 0; $PRIV(incs)[cd] = 0;
} }
if (nthd && $COMP(whichdims)[nthd] == if (nthd && $COMP(whichdims)[nthd] ==
$COMP(whichdims)[nthd-1]) $COMP(whichdims)[nthd-1])
$CROAK("dims must be unique"); $CROAK("dims must be unique");
nthd++; /* advance pointer into whichdims */ nthd++; /* advance pointer into whichdims */
if($CHILD(dims)[cd] != if($CHILD(dims)[cd] !=
$PARENT(dims)[nthp]) { $PARENT(dims)[nthp]) {
$CROAK("Different dims %d and %d", $CROAK("Different dims %"IND_FLAG" and % "IND_FLAG"",
$CHILD(dims)[cd], $CHILD(dims)[cd],
$PARENT(dims)[nthp]); $PARENT(dims)[nthp]);
} }
$PRIV(incs)[cd] += $PARENT(dimincs)[nthp]; $PRIV(incs)[cd] += $PARENT(dimincs)[nthp];
} else { } else {
$PRIV(incs)[nthc] = $PARENT(dimincs)[nthp]; $PRIV(incs)[nthc] = $PARENT(dimincs)[nthp];
$CHILD(dims)[nthc] = $PARENT(dims)[nthp]; $CHILD(dims)[nthc] = $PARENT(dims)[nthp];
nthc++; nthc++;
} }
$SETDIMS(); $SETDIMS();
skipping to change at line 1838 skipping to change at line 1782
AffinePriv => 1, AffinePriv => 1,
OtherPars => "PDL_Indx id; PDL_Indx whichdims[]", OtherPars => "PDL_Indx id; PDL_Indx whichdims[]",
Comp => 'PDL_Indx nrealwhichdims', Comp => 'PDL_Indx nrealwhichdims',
MakeComp => ' MakeComp => '
PDL_Indx i,j; PDL_Indx i,j;
$COMP(nrealwhichdims) = 0; $COMP(nrealwhichdims) = 0;
for(i=0; i<$COMP(whichdims_count); i++) { for(i=0; i<$COMP(whichdims_count); i++) {
for(j=i+1; j<$COMP(whichdims_count); j++) for(j=i+1; j<$COMP(whichdims_count); j++)
if($COMP(whichdims[i]) == $COMP(whichdims[j]) && if($COMP(whichdims[i]) == $COMP(whichdims[j]) &&
$COMP(whichdims[i]) != -1) { $COMP(whichdims[i]) != -1) {
$CROAK("duplicate arg %d %d %d", $CROAK("duplicate arg %"IND_FLAG" %"IND_FLAG" %" IND_FLAG"",
i,j,$COMP(whichdims[i])); i,j,$COMP(whichdims[i]));
} }
if($COMP(whichdims)[i] != -1) { if($COMP(whichdims)[i] != -1) {
$COMP(nrealwhichdims) ++; $COMP(nrealwhichdims) ++;
} }
} }
', ',
RedoDims => ' RedoDims => '
PDL_Indx nthc,i,j,flag; PDL_Indx nthc,i,j,flag;
$SETNDIMS($PARENT(ndims)); $SETNDIMS($PARENT(ndims));
skipping to change at line 2383 skipping to change at line 2327
) { ) {
$CHILD(dims)[$COMP(odim)[i]] = 0; $CHILD(dims)[$COMP(odim)[i]] = 0;
$PRIV(incs)[$COMP(odim)[i]] = 0; $PRIV(incs)[$COMP(odim)[i]] = 0;
} else { } else {
/** Regularize and bounds-check the start location **/ /** Regularize and bounds-check the start location **/
if(start < 0) if(start < 0)
start += pdsize; start += pdsize;
if( start < 0 || start >= pdsize ) { if( start < 0 || start >= pdsize ) {
PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0); PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0);
if(i >= $PARENT( ndims )) { if(i >= $PARENT( ndims )) {
$CROAK("slice has too many dims (indexes dim %d; hi ghest is %d)",i,$PARENT( ndims )-1); $CROAK("slice has too many dims (indexes dim %"IND_ FLAG"; highest is %"IND_FLAG")",i,$PARENT( ndims )-1);
} else { } else {
$CROAK("slice starts out of bounds in pos %d (start is %d; source dim %d runs 0 to %d)",i,start,$COMP(idim[i]),pdsize-1); $CROAK("slice starts out of bounds in pos %"IND_FLAG" ( start is %"IND_FLAG"; source dim %"IND_FLAG" runs 0 to %"IND_FLAG")",i,start,$CO MP(idim[i]),pdsize-1);
} }
} }
if( $COMP(odim[i]) < 0) { if( $COMP(odim[i]) < 0) {
/* squished dim - just update the offset. */ /* squished dim - just update the offset. */
/* start is always defined and regularized if we are here here, since */ /* start is always defined and regularized if we are here here, since */
/* both idim[i] and odim[i] can't be <0 */ /* both idim[i] and odim[i] can't be <0 */
$PRIV(offs) += start * $PARENT( dimincs[ $COMP(idim[i ]) ] ); $PRIV(offs) += start * $PARENT( dimincs[ $COMP(idim[i ]) ] );
} else /* normal operation */ { } else /* normal operation */ {
/** Regularize and bounds-check the end location **/ /** Regularize and bounds-check the end location **/
if(end<0) end += pdsize; if(end<0) end += pdsize;
if( end < 0 || end >= pdsize ) { if( end < 0 || end >= pdsize ) {
PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0 ); PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0 );
$CROAK("slice ends out of bounds in pos %d (end is %d; source dim %d runs 0 to %d)",i,end,$COMP(idim[i]),pdsize-1); $CROAK("slice ends out of bounds in pos %"IND_FLAG" (end is %"IND_FLAG"; source dim %"IND_FLAG" runs 0 to %"IND_FLAG")",i,end,$COMP (idim[i]),pdsize-1);
} }
/* regularize inc */ /* regularize inc */
PDL_Indx inc = $COMP(inc)[i]; PDL_Indx inc = $COMP(inc)[i];
if(!inc) if(!inc)
inc = (start <= end) ? 1 : -1; inc = (start <= end) ? 1 : -1;
$CHILD( dims )[ $COMP(odim)[i] ] = PDLMAX(0, (end - s tart + inc) / inc); $CHILD( dims )[ $COMP(odim)[i] ] = PDLMAX(0, (end - s tart + inc) / inc);
$PRIV( incs )[ $COMP(odim)[i] ] = $PARENT(dimincs)[ $COMP(idim)[i] ] * inc; $PRIV( incs )[ $COMP(odim)[i] ] = $PARENT(dimincs)[ $COMP(idim)[i] ] * inc;
$PRIV(offs) += start * $PARENT( dimincs )[ $COMP(idim )[i] ]; $PRIV(offs) += start * $PARENT( dimincs )[ $COMP(idim )[i] ];
} /* end of normal slice case */ } /* end of normal slice case */
} /* end of trapped strange slice case */ } /* end of trapped strange slice case */
 End of changes. 32 change blocks. 
115 lines changed or deleted 58 lines changed or added

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