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 |