"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Ops/ops.pd" between
PDL-2.078.tar.gz and PDL-2.079.tar.gz

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

ops.pd  (PDL-2.078):ops.pd  (PDL-2.079)
skipping to change at line 79 skipping to change at line 79
/* Q_MOD is the same as MOD except the internal casts are to longlong. -DAL 18- Feb-2015 */ /* Q_MOD is the same as MOD except the internal casts are to longlong. -DAL 18- Feb-2015 */
/* Also changed the typecast in MOD to (long), and added a N==0 conditional to B U_MOD. -DAL 06-Mar-2015 */ /* Also changed the typecast in MOD to (long), and added a N==0 conditional to B U_MOD. -DAL 06-Mar-2015 */
#define MOD(X,N) ( ((N) == 0) ? 0 : ( (X) - (ABS(N)) * ((long )((X)/(ABS(N))) + ( ( ((N) * ((long )((X)/(N)))) != (X) ) ? ( ( ((N)<0 ) ? 1 : 0 ) + ( (((X)<0) ? -1 : 0))) : 0 )))) #define MOD(X,N) ( ((N) == 0) ? 0 : ( (X) - (ABS(N)) * ((long )((X)/(ABS(N))) + ( ( ((N) * ((long )((X)/(N)))) != (X) ) ? ( ( ((N)<0 ) ? 1 : 0 ) + ( (((X)<0) ? -1 : 0))) : 0 ))))
#define Q_MOD(X,N) (((N) == 0) ? 0 : ( (X) - (ABS(N)) * ((long long )((X)/(ABS(N))) + ( ( ((N) * ((long long)((X)/(N)))) != (X) ) ? ( ( ((N)<0 ) ? 1 : 0 ) + ( (((X)<0) ? -1 : 0))) : 0 )))) #define Q_MOD(X,N) (((N) == 0) ? 0 : ( (X) - (ABS(N)) * ((long long )((X)/(ABS(N))) + ( ( ((N) * ((long long)((X)/(N)))) != (X) ) ? ( ( ((N)<0 ) ? 1 : 0 ) + ( (((X)<0) ? -1 : 0))) : 0 ))))
#define BU_MOD(X,N)(((N) == 0) ? 0 : ( (X)-(N)*((int)((X)/(N))) )) #define BU_MOD(X,N)(((N) == 0) ? 0 : ( (X)-(N)*((int)((X)/(N))) ))
#define SPACE(A,B) ( ((A)<(B)) ? -1 : ((A)!=(B)) ) #define SPACE(A,B) ( ((A)<(B)) ? -1 : ((A)!=(B)) )
#define ABS(A) ( (A)>=0 ? (A) : -(A) ) #define ABS(A) ( (A)>=0 ? (A) : -(A) )
'); ');
my %char2escape = ('>'=>'E<gt>','<'=>'E<lt>');
my $chars = '(['.join('', map quotemeta, sort keys %char2escape).'])';
sub protect_chars { sub protect_chars {
my ($txt) = @_; my ($txt) = @_;
$txt =~ s/>/E;gt#/g; $txt =~ s/$chars/$char2escape{$1}/g;
$txt =~ s/</E;lt#/g;
$txt =~ s/;/</g;
$txt =~ s/#/>/g;
return $txt; return $txt;
} }
# simple binary operators # simple binary operators
sub biop { sub biop {
my ($name,$op,$mutator,$doc,%extra) = @_; my ($name,$op,$mutator,$doc,%extra) = @_;
my $optxt = protect_chars ref $op eq 'ARRAY' ? $op->[1] : $op; my $optxt = protect_chars ref $op eq 'ARRAY' ? $op->[1] : $op;
$op = $op->[0] if ref $op eq 'ARRAY'; $op = $op->[0] if ref $op eq 'ARRAY';
$extra{HdrCode} = << 'EOH'; $extra{HdrCode} = << 'EOH';
skipping to change at line 142 skipping to change at line 141
pp_addpm(make_overload($op, $name, $mutator, delete $extra{Bitwise})); pp_addpm(make_overload($op, $name, $mutator, delete $extra{Bitwise}));
pp_def($name, pp_def($name,
Pars => 'a(); b(); [o]c();', Pars => 'a(); b(); [o]c();',
OtherPars => 'int swap', OtherPars => 'int swap',
OtherParsDefaults => { swap => 0 }, OtherParsDefaults => { swap => 0 },
HandleBad => 1, HandleBad => 1,
NoBadifNaN => 1, NoBadifNaN => 1,
Inplace => [ 'a' ], # quick and dirty solution to get ->inplace do its job Inplace => [ 'a' ], # quick and dirty solution to get ->inplace do its job
Code => pp_line_numbers(__LINE__-1, qq{ Code => pp_line_numbers(__LINE__-1, qq{
PDL_IF_BAD(if ( $badcode ) \$SETBAD(c()); else,) char anybad = 0;
broadcastloop %{
PDL_IF_BAD(if ( $badcode ) { \$SETBAD(c()); anybad = 1; } else,)
\$c() = \$a() $op \$b(); \$c() = \$a() $op \$b();
%}
if (anybad) \$PDLSTATESETBAD(c);
}), }),
CopyBadStatusCode => pp_line_numbers(__LINE__,
'if ( $BADFLAGCACHE() ) {
if ( a == c && $ISPDLSTATEGOOD(a) ) {
PDL->propagate_badflag( c, 1 ); /* have inplace op AND badflag
has changed */
}
$SETPDLSTATEBAD(c);
}'),
%extra, %extra,
Doc => << "EOD"); Doc => << "EOD");
=for ref =for ref
$doc $doc
=for example =for example
\$c = \$x $op \$y; # overloaded call \$c = \$x $op \$y; # overloaded call
\$c = $name \$x, \$y; # explicit call with default swap of 0 \$c = $name \$x, \$y; # explicit call with default swap of 0
skipping to change at line 254 skipping to change at line 250
pp_addpm(make_overload($funcov, $name, $mutator)); pp_addpm(make_overload($funcov, $name, $mutator));
pp_def($name, pp_def($name,
HandleBad => 1, HandleBad => 1,
NoBadifNaN => 1, NoBadifNaN => 1,
Pars => 'a(); b(); [o]c();', Pars => 'a(); b(); [o]c();',
OtherPars => 'int swap', OtherPars => 'int swap',
OtherParsDefaults => { swap => 0 }, OtherParsDefaults => { swap => 0 },
Inplace => [ 'a' ], # quick and dirty solution to get ->inplace do its job Inplace => [ 'a' ], # quick and dirty solution to get ->inplace do its job
Code => pp_line_numbers(__LINE__, qq{ Code => pp_line_numbers(__LINE__, qq{
PDL_IF_BAD(if ( \$ISBAD(a()) || \$ISBAD(b()) ) \$SETBAD(c()); els char anybad = 0;
e {,) broadcastloop %{
$codestr PDL_IF_BAD(if ( \$ISBAD(a()) || \$ISBAD(b()) ) { anybad = 1; \$SETBAD(c()); }
PDL_IF_BAD(},) else ,){
$codestr
}
%}
if (anybad) \$PDLSTATESETBAD(c);
}), }),
CopyBadStatusCode =>
pp_line_numbers(__LINE__, 'if ( $BADFLAGCACHE() ) {
if ( a == c && $ISPDLSTATEGOOD(a) ) {
PDL->propagate_badflag( c, 1 ); /* have inplace op AND badflag
has changed */
}
$SETPDLSTATEBAD(c);
}'),
%extra, %extra,
Doc => << "EOD"); Doc => << "EOD");
=for ref =for ref
$doc $doc
=for example =for example
\$c = \$x->$name(\$y,0); # explicit function call \$c = \$x->$name(\$y,0); # explicit function call
$ovcall $ovcall
skipping to change at line 475 skipping to change at line 468
}; };
' '
); );
pp_def( pp_def(
'assgn', 'assgn',
HandleBad => 1, HandleBad => 1,
GenericTypes => $A, GenericTypes => $A,
Pars => 'a(); [o]b();', Pars => 'a(); [o]b();',
Code => pp_line_numbers(__LINE__-1, q{ Code => pp_line_numbers(__LINE__-1, q{
PDL_IF_BAD(if ( $ISBAD(a()) ) $SETBAD(b()); else,) char anybad = 0;
broadcastloop %{
PDL_IF_BAD(if ( $ISBAD(a()) ) { anybad = 1; $SETBAD(b()); } else,)
$b() = $a(); $b() = $a();
%}
PDL_IF_BAD(if (anybad) $PDLSTATESETBAD(b);,)
}), }),
Doc => Doc =>
'Plain numerical assignment. This is used to implement the ".=" operator', 'Plain numerical assignment. This is used to implement the ".=" operator',
BadDoc => );
'If C<a> is a child ndarray (e.g., the result of a slice) and bad values are gen
erated in C<b>,
the bad value flag is set in C<b>, but it is B<NOT> automatically propagated bac
k to the parent of C<a>.
The following idiom ensures that the badflag is propagated back to the parent of
C<a>:
$pdl->slice(":,(1)") .= PDL::Bad_aware_func();
$pdl->badflag(1);
$pdl->check_badflag();
This is unnecessary if $pdl->badflag is known to be 1 before the slice is perfor
med.
See http://pdl.perl.org/PDLdocs/BadValues.html#dataflow_of_the_badflag for detai
ls.'
); # pp_def assgn
# special functions for complex data types that don't work well with # special functions for complex data types that don't work well with
# the ufunc/bifunc logic # the ufunc/bifunc logic
sub cfunc { sub cfunc {
my ($name, $func, $make_real, $doc, $backcode, %extra) = @_; my ($name, $func, $make_real, $doc, $backcode, %extra) = @_;
my $codestr = pp_line_numbers(__LINE__-1,"\$b() = $func(\$complexv());"); my $codestr = pp_line_numbers(__LINE__-1,"\$b() = $func(\$complexv());");
pp_def($name, pp_def($name,
GenericTypes=>$C, GenericTypes=>$C,
Pars => 'complexv(); '.($make_real ? 'real' : '').' [o]b()', Pars => 'complexv(); '.($make_real ? 'real' : '').' [o]b()',
HandleBad => 1, HandleBad => 1,
 End of changes. 10 change blocks. 
44 lines changed or deleted 22 lines changed or added

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