@@ -4,12 +4,12 @@
#
-
+
use strict;
use Config;
use File::Basename qw(&basename &dirname);
-
+
require 'Dev.pm'; PDL::Core::Dev->import;
use vars qw( %PDL_DATATYPES );
@@ -24,10 +24,10 @@ PDL::Types->import(':All');
chdir(dirname($0));
my $file;
($file = basename($0)) =~ s/\.PL$//;
-$file =~ s/\.pl$//
+$file =~ s/\.pl$//
if ($Config{'osname'} eq 'VMS' or
$Config{'osname'} eq 'OS2'); # "case-forgiving"
-
+
if ( $bvalflag ) {
print "Extracting $file (WITH bad value support)\n";
} else {
@@ -35,9 +35,9 @@ if ( $bvalflag ) {
}
open OUT,">$file" or die "Can't create $file: $!";
chmod 0644, $file;
-
+
print OUT <<"!WITH!SUBS!";
-
+
/* pdlcore.c - generated automatically by pdlcore.c.PL */
/* - bad value support = $bvalflag */
@@ -53,7 +53,7 @@ print OUT <<'!HEADER!'
#include "pdlcore.h" /* Core declarations */
/*** Turn on definitions to print lots of fencepost information in the constructor ***/
-//#define DEBUG_SETAV_TYPE 1
+//#define DEBUG_SETAV_TYPE 1
//#define DEBUG_KLUDGE_COPY 1
@@ -82,7 +82,7 @@ foreach my $inc ( qw/ math.h ieeefp.h / )
if ( trylink ("finite: $inc", "#include <$inc>", 'finite(3.2);', '' ) ) {
$finite_inc = $inc;
last;
- }
+ }
}
if ( defined $finite_inc )
@@ -152,7 +152,7 @@ print OUT <<'!NO!SUBS!';
}
/* Check minimum datatype required to represent number */
-/* Microsoft compilers do some unbelievable things - hence
+/* Microsoft compilers do some unbelievable things - hence
some #ifdef's inserted by Sisyphus */
#if defined _MSC_VER && _MSC_VER < 1400
#define TESTTYPE(b,a) {a foo = nv; a bar = foo; foo += 0; if(nv == bar) return b;}
@@ -254,7 +254,7 @@ pdl* SvPDLV ( SV* sv ) {
/* Scratch hash for the pdl :( - slow but safest. */
- /* handle undefined values */
+ /* handle undefined values */
if( sv_undef(sv) ) {
sv = get_sv("PDL::undefval",1);
if(SvIV(get_sv("PDL::debug",1))){
@@ -296,7 +296,7 @@ print OUT <<'!NO!SUBS!';
}
else { /* Perl Int (e.g. 2) */
- data = SvNV(sv);
+ data = SvNV(sv);
datatype = pdl_whichdatatype(data);
}
pdl_makescratchhash(ret,data,datatype);
@@ -375,7 +375,7 @@ print OUT <<'!NO!SUBS!';
#endif
}
- if (SvTYPE(SvRV(sv)) != SVt_PVMG)
+ if (SvTYPE(SvRV(sv)) != SVt_PVMG)
croak("Error - tried to use an unknown data structure as a PDL");
else if( !( sv_derived_from( sv, "PDL") ) )
croak("Error - tried to use an unknown Perl object type as a PDL");
@@ -411,7 +411,7 @@ print OUT <<'!NO!SUBS!';
#else
ret = INT2PTR(pdl *, SvIV(sv2));
#endif
-
+
if(ret->magicno != PDL_MAGICNO) {
croak("Fatal error: argument is probably not a piddle, or\
magic no overwritten. You're in trouble, guv: %p %p %lu\n",sv2,ret,ret->magicno);
@@ -550,6 +550,9 @@ void* pdl_malloc ( STRLEN nbytes ) {
static void pdl_barf_or_warn(const char* pat, int iswarn, va_list* args)
{
+ dSP;
+ SV * sv;
+
// If we're in a worker thread, we queue the barf/warn for later,
// and exit the thread ...
if( pdl_pthread_barf_or_warn(pat, iswarn, args) )
@@ -558,12 +561,11 @@ static void pdl_barf_or_warn(const char* pat, int iswarn, va_list* args)
// ... otherwise we fall through and barf by calling the perl-level
// PDL::barf() or PDL::cluck()
- dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
- SV* sv = sv_2mortal(newSV(0));
+ sv = sv_2mortal(newSV(0));
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
va_end(*args);
@@ -606,35 +608,35 @@ GEN_PDL_BARF_OR_WARN_LEGACY(warn, 1)
/**********************************************************************
- *
+ *
* CONSTRUCTOR/INGESTION HELPERS
- *
+ *
* The following routines assist with the permissive constructor,
* which is designed to build a PDL out of basically anything thrown at it.
- *
+ *
* They are all called by pdl_avref in Core.xs, which in turn is called by the constructors
* in Core.pm.PL.
- *
- *
+ *
+ *
/******************************
- * av_ndcheck -
+ * av_ndcheck -
* traverse a Perl array ref recursively, following down any number of
* levels of references, and generate a minimal PDL dim list that can
* encompass them all according to permissive-constructor rules.
- *
+ *
* Scalars, array refs, and PDLs may be mixed in the incoming AV.
*
* The routine works out the dimensions of a corresponding
* piddle (in the AV dims) in reverse notation (vs PDL conventions).
- *
+ *
* It does not enforce a rectangular array, the idea being that
* omitted values will be set to zero in the resulting piddle,
* i.e. we can make piddles from 'sparse' array refs.
*
* As a special case, empty PDLs are treated as empty but not missing --
* i.e. they are treated as scalars for the purposes of dimensioning.
- *
+ *
*/
int av_ndcheck(AV* av, AV* dims, int level, int *datalevel)
@@ -658,14 +660,14 @@ int av_ndcheck(AV* av, AV* dims, int level, int *datalevel)
if (el && SvROK(el)) { /* It is a reference */
if (SvTYPE(SvRV(el)) == SVt_PVAV) { /* It is an array reference */
- hasref = 1;
+ hasref = 1;
/* Recurse to find depth inside the array reference */
newdepth = 1 + av_ndcheck((AV *) SvRV(el), dims, level+1, datalevel);
-
+
} else if ( pdl = SvPDLV(el) ) {
/* It is a PDL - walk down its dimension list, exactly as if it
- * were a bunch of nested array refs. We pull the ndims and dims
+ * were a bunch of nested array refs. We pull the ndims and dims
* fields out to local variables so that nulls can be treated specially.
*/
int j;
@@ -676,9 +678,9 @@ int av_ndcheck(AV* av, AV* dims, int level, int *datalevel)
#ifdef DEBUG_SETAV_TYPE
printf("av_ndcheck - found a PDL....\n");
#endif
-
+
pdl_make_physdims(pdl);
-
+
if(pdl->nvals==0) {
pndims = 0;
pnvals = 1;
@@ -697,15 +699,15 @@ int av_ndcheck(AV* av, AV* dims, int level, int *datalevel)
printf(")\n");
}
#endif
-
+
for(j=0;j<pndims;j++) {
int jl = pndims-j+level;
- if( av_len(dims) >= jl &&
+ if( av_len(dims) >= jl &&
av_fetch(dims,jl,0) != NULL &&
SvIOK(*(av_fetch(dims,jl,0)))) {
-
+
oldlen=(int)SvIV(*(av_fetch(dims,jl,0)));
-
+
if(pdims[j] > oldlen) {
sv_setiv(*(av_fetch(dims,jl,0)),(IV)(pdims[j]));
}
@@ -734,7 +736,7 @@ int av_ndcheck(AV* av, AV* dims, int level, int *datalevel)
if (len > oldlen)
sv_setiv(*(av_fetch(dims, level, 0)), (IV) len);
}
- else
+ else
av_store(dims,level,newSViv((IV) len));
}
@@ -758,7 +760,7 @@ int av_ndcheck(AV* av, AV* dims, int level, int *datalevel)
} else {
k = -1;
}
-
+
printf(" %d",k);
}
printf(" ]\n");
@@ -772,7 +774,7 @@ pdl* pdl_from_array(AV* av, AV* dims, int type, pdl* p)
{
int ndims, i, level=0;
PDL_Long *pdims;
- double undefval;
+ double undefval;
ndims = av_len(dims)+1;
pdims = (PDL_Long *) pdl_malloc( (ndims) * sizeof(*pdims) );
@@ -803,7 +805,7 @@ pdl* pdl_from_array(AV* av, AV* dims, int type, pdl* p)
/* this one assigns the data */
{
- /******
+ /******
* Copy the undefval to fill empty spots in the piddle...
*/
SV *sv = get_sv("PDL::undefval",0);
@@ -814,7 +816,7 @@ pdl* pdl_from_array(AV* av, AV* dims, int type, pdl* p)
!NO!SUBS!
##########
-# Perl snippet autogenerates switch statement to distribute
+# Perl snippet autogenerates switch statement to distribute
# pdl_setav calls...
#
for my $type(sort keys %PDL_DATATYPES){
@@ -854,11 +856,11 @@ for my $in ( keys %PDL_DATATYPES ) {
print OUT <<"!WITH!SUBS!";
-/*
+/*
* pdl_kludge_copy - copy a PDL into a part of a being-formed PDL.
* It is only used by pdl_setav, to handle the case where a PDL is part
- * of the argument list. Ideally this would use the existing threadloop
- * code but that seems too hard.
+ * of the argument list. Ideally this would use the existing threadloop
+ * code but that seems too hard.
*
* kludge_copy recursively walks down the dim list of both the source and dest
* pdls, copying values in as we go. It differs from PP copy in that it operates
@@ -881,7 +883,7 @@ print OUT <<"!WITH!SUBS!";
* pdl is the input PDL.
* plevel is the dim number for the input PDL, which works in the same sense as level.
* It is offset to account for the difference in dimensionality between the input and
- * output PDLs. It is allowed to be negative (which is equivalent to the "permissive
+ * output PDLs. It is allowed to be negative (which is equivalent to the "permissive
* slicing" that treats missing dimensions as present and having size 1), but should
* not match or exceed pdl->ndims.
* pptr is the current offset data pointer into pdl->data.
@@ -892,20 +894,20 @@ print OUT <<"!WITH!SUBS!";
*/
long pdl_kludge_copy_$type(long poff,
- PDL_$type* pdata,
- PDL_Long* pdims,
- PDL_Long ndims,
- int level,
- long stride,
- pdl* pdl,
- int plevel,
+ PDL_$type* pdata,
+ PDL_Long* pdims,
+ PDL_Long ndims,
+ int level,
+ long stride,
+ pdl* pdl,
+ int plevel,
void* pptr,
double undefval
) {
int i;
long undef_count = 0;
-#ifdef DEBUG_KLUDGE_COPY
+#ifdef DEBUG_KLUDGE_COPY
printf("entering pdl_kludge_copy: level=%d, ndims=%d, plevel=%d; pdl->ndims=%d\\n",level,ndims,plevel,pdl->ndims);
#endif
@@ -925,13 +927,13 @@ long pdl_kludge_copy_$type(long poff,
// are doing dimensional padding. In either case, we just iterate once.
if(pdldim < 0 || pdldim >= pdl->ndims) {
pdldim = (pdldim < 0) ? (0) : (pdl->ndims - 1);
- pdlsiz = 1;
+ pdlsiz = 1;
} else {
pdlsiz = pdl->dims[pdldim];
if(pdlsiz==0 && (pptr != 0)) { // size of zero but a non-null data pointer -- probably an error.
int ii;
fprintf(stderr,"pdl_kludge_copy level=%d; ndims=%d; dims=(");
- for(ii=0;ii<pdl->ndims;ii++)
+ for(ii=0;ii<pdl->ndims;ii++)
fprintf(stderr,"%s%d", (ii?", ":""), pdl->dims[ii]);
fprintf(stderr,") - dim %d has size 0. This is probably an error. Continuing anyway (treating as an Empty).\\n",pdldim);
}
@@ -949,9 +951,9 @@ long pdl_kludge_copy_$type(long poff,
# perl loop to emit code for all the PDL types
#
foreach my $switch_type (keys %PDL::Types::typehash) {
-
+
my $ctype = $PDL::Types::typehash{$switch_type}{ctype};
-
+
print OUT <<"!WITH!SUBS!";
@@ -966,7 +968,7 @@ long pdl_kludge_copy_$type(long poff,
// copy data (unless the source pointer is null)
i=0;
if(pptr && pdlsiz) {
- for(; i<pdlsiz; i++)
+ for(; i<pdlsiz; i++)
pdata[i] = (PDL_$type) ((${ctype} *)pptr)[i];
} else {
// special case for NULL input piddles -- set the current value to the padding
@@ -984,7 +986,7 @@ long pdl_kludge_copy_$type(long poff,
}
#ifdef DEBUG_KLUDGE_COPY
printf(" filled in row: ");
- for(i=0;i<pdims[0] - poff; i++)
+ for(i=0;i<pdims[0] - poff; i++)
printf("%g ",pdata[i]);
printf("\\n");
#endif
@@ -996,11 +998,11 @@ long pdl_kludge_copy_$type(long poff,
} # end of foreach in the perl generator code
print OUT <<"!WITH!SUBS!";
- default:
+ default:
croak("Internal error - please submit a bug report at http://sourceforge.net/projects/pdl/:\\n pdl_kludge_copy: unknown type of %d.",pdl->datatype);
break;
}
-
+
return undef_count;
}
@@ -1013,11 +1015,11 @@ long pdl_kludge_copy_$type(long poff,
plevel,
pdl->dims[pdl->ndims-1-plevel]
);
-#endif
+#endif
for(i=0;
- i < ( (plevel >= 0 && (pdl->ndims - 1 - plevel >= 0) && (pdl->ndims - 1 - plevel < pdl->ndims)) ? (pdl->dims[ pdl->ndims-1-plevel ]) : 1 );
+ i < ( (plevel >= 0 && (pdl->ndims - 1 - plevel >= 0) && (pdl->ndims - 1 - plevel < pdl->ndims)) ? (pdl->dims[ pdl->ndims-1-plevel ]) : 1 );
i++) {
-
+
#ifdef DEBUG_KLUDGE_COPY
{
char buf[10240];
@@ -1031,7 +1033,7 @@ long pdl_kludge_copy_$type(long poff,
}
printf("pdl_kludge_copy: level=%d, i=%d, pdata=%d, pdims=(%s), ndims=%d, stride=%d, plevel=%d, pptr=%d\\n",
level, i, pdata, buf, ndims, stride, plevel, pptr);
-
+
}
#endif
@@ -1077,7 +1079,7 @@ long pdl_kludge_copy_$type(long poff,
for(;
- cursor < target;
+ cursor < target;
cursor++) {
pdata[cursor] = undefval;
}
@@ -1088,10 +1090,10 @@ long pdl_kludge_copy_$type(long poff,
}
/*
- * pdl_setav_type loads a new PDL with values from a Perl AV, another PDL, or
+ * pdl_setav_type loads a new PDL with values from a Perl AV, another PDL, or
* a mix of both. Heterogeneous sizes are handled by padding the new PDL's
* values out to size with the undefval. It is called by pdl_setav only.
- *
+ *
*
* Recent changes to setav_$type:
* - Look for PDLs and deep copy them with pdl_kludge_copy just as if they were
@@ -1099,7 +1101,7 @@ long pdl_kludge_copy_$type(long poff,
* - Allow multiple depths in different elements. The max depth should have been
* determined by pdl_av_ndcheck (it comes in as the ndims parameter), so other
* depths are descended to and extra elements are filled in with zeroes.
- * In the Best of All Possible Worlds this would be badval compliant and
+ * In the Best of All Possible Worlds this would be badval compliant and
* the extra elements would get filled in with BAD. Soon, soon.
* --CED, 17-Jun-2004
*
@@ -1115,9 +1117,9 @@ long pdl_kludge_copy_$type(long poff,
* - av is the array ref (or PDL) to use to fill the data with,
* - pdims is the dimlist
* - ndims is the size of the dimlist
- * - level is the recursion level, which is also the dimension that we are filling
+ * - level is the recursion level, which is also the dimension that we are filling
*/
-
+
long pdl_setav_$type(PDL_$type* pdata, AV* av,
PDL_Long* pdims, PDL_Long ndims, int level, double undefval)
{
@@ -1137,7 +1139,7 @@ long pdl_setav_$type(PDL_$type* pdata, AV* av,
#ifdef DEBUG_SETAV_TYPE
printf("entering pdl_setav_$type: pdata=%d\\n",pdata);
- {
+ {
int i;
printf("ndims=%d; level=%d; ndims-1-level is %d; pdims factor is (",ndims,level,ndims-1-level);
for(i=0;i<ndims-1-level; i++) {
@@ -1148,7 +1150,7 @@ long pdl_setav_$type(PDL_$type* pdata, AV* av,
#endif
for (i=0;i<=len;i++,pdata += stride) { // note len is actually the highest index in the array
-
+
int foo;
#ifdef DEBUG_SETAV_TYPE
@@ -1171,7 +1173,7 @@ long pdl_setav_$type(PDL_$type* pdata, AV* av,
elp = av_fetch(av,i,0);
el = (elp ? *elp : 0);
foo = el ? SVavref(el) : 0;
-
+
if (foo) {
#ifdef DEBUG_SETAV_TYPE
@@ -1183,9 +1185,9 @@ long pdl_setav_$type(PDL_$type* pdata, AV* av,
} else if( el && SvROK(el) ) {
pdl *pdl;
if( pdl = SvPDLV(el) ) {
-
+
pdl_make_physical(pdl);
-
+
#ifdef DEBUG_SETAV_TYPE
printf("source pdl has %d vals...\\n",pdl->nvals);
@@ -1197,12 +1199,12 @@ long pdl_setav_$type(PDL_$type* pdata, AV* av,
// printf("Found a null PDL - ignoring\\n");
//#endif
//
- // pdata -= stride;
- //
- // } else
- { /* PDLs must be recursively copied/padded */
+ // pdata -= stride;
+ //
+ // } else
+ { /* PDLs must be recursively copied/padded */
-#ifdef DEBUG_SETAV_TYPE
+#ifdef DEBUG_SETAV_TYPE
{
/* Generate some debugging info */
char buf[10240];
@@ -1260,15 +1262,15 @@ long pdl_setav_$type(PDL_$type* pdata, AV* av,
}
}
}
-
+
} /* end of i loop */
-
+
/* in case this dim is incomplete set remaining elements to the undefval */
#ifdef DEBUG_SETAV_TYPE
printf("\\tloop is complete. len is %d, cursz-1 is %d, stride is %d\\n",len,cursz-1, stride);
#endif
-
+
if(len < cursz-1 ) {
PDL_$type *target = pdata + stride * (cursz - 1 - len);
#ifdef DEBUG_SETAV_TYPE
@@ -1290,7 +1292,7 @@ long pdl_setav_$type(PDL_$type* pdata, AV* av,
SV *sv;
sv = get_sv("PDL::debug",0);
debug_flag = (sv_undef(sv)) ? 0 : (char)SvIV(sv);
-
+
if(debug_flag) {
fprintf(stderr,"Warning: pdl_setav_$type converted undef to $PDL::undefval (%g) %ld time%s\\n",undefval,undef_count,undef_count==1?"":"s");
}
@@ -69,7 +69,7 @@ void dump_thread(pdl_thread *thread) {
}
-/* Function to get the pthread-specific offset
+/* Function to get the pthread-specific offset
Input: thread structure
Outputs: Pointer to pthread-specific offset array (returned by function)
*/
@@ -85,12 +85,12 @@ int *pdl_get_threadoffsp(pdl_thread *thread )
-/* Function to get the pthread-specific offset, indexes and pthread number for the supplied thread structure
+/* Function to get the pthread-specific offset, indexes and pthread number for the supplied thread structure
Input: thread structure
Outputs: Pointer to pthread-specific offset array (returned by function)
Pointer to pthread-specific index array (ind Pointer supplied and modified by function)
Pthread index for the current pthread ( nthr supplied and modified by function)
-
+
*/
int *pdl_get_threadoffsp_int(pdl_thread *thread, int *nthr, int **inds)
{
@@ -164,25 +164,34 @@ void pdl_clearthreadstruct(pdl_thread *it) {
However if thread dim is size 9 and target number of pthreads is 2, 9 can't be divided
by 2, so no extra pthreads will be created.
)
- noPthreadFlag is a flag indicating that the pdl thread that called this function is not multiple
+ noPthreadFlag is a flag indicating that the pdl thread that called this function is not multiple
processor threading safe, so no pthreading magic will be added
*/
void pdl_autopthreadmagic( pdl **pdls, int npdls, int * realdims, int* creating, int noPthreadFlag ){
+ int j, nthrd, totalDims, *nthreadedDims, **threadedDims, **threadedDimSizes;
int largest_nvals = 0; /* The largest PDL size for all the pdls involvled */
-
+
+ int t; /* Thread index for each pdl */
+ int tdimStart; /* Start of the threaded dims for each pdl */
+ int k; /* threadedDims array index for each pdl */
+ int nthreadDim; /* Number of thread dims for the current pdl */
+
+ int maxPthreadPDL; /* PDL that has the max (or right at the target) num pthreads */
+ int maxPthreadDim; /* Threaded dim number that has the max num pthreads */
+ int maxPthread = 0; /* Maximum achievable pthread */
+
int target_pthread = pdl_autopthread_targ;
pdl_autopthread_actual = 0; /* Initialize the global variable indicating actual number of pthreads */
-
+
/* Don't do anything if auto_pthreading is turned off (i.e. equal zero) */
if( !target_pthread ) return;
/* Remove any existing threading magic */
- int j;
for(j=0; j<npdls; j++) {
if(creating[j]) continue;
- int nthrd;
-
+ nthrd;
+
/* Remove thread magic, if there is some set for this pdl */
if( pdls[j]->magic &&
(pdl_magic_thread_nthreads(pdls[j],&nthrd))) {
@@ -200,35 +209,31 @@ void pdl_autopthreadmagic( pdl **pdls, int npdls, int * realdims, int* creating
largest_nvals = pdls[j]->nvals;
}
}
-
+
/* See if the largest nvals is above the auto_pthread threadshold */
largest_nvals = largest_nvals>>20; /* Convert to MBytes */
-
+
/* Don't do anything if we are lower than the threshold */
if( largest_nvals < pdl_autopthread_size )
return;
-
+
/* Build int arrays of threaded dim numbers and sizes for each pdl */
- int *nthreadedDims = (int*) malloc(sizeof(int) * (npdls));
- int **threadedDims = (int**) malloc(sizeof(int *) * (npdls));
- int **threadedDimSizes = (int**) malloc(sizeof(int *) * (npdls));
+ nthreadedDims = (int*) malloc(sizeof(int) * (npdls));
+ threadedDims = (int**) malloc(sizeof(int *) * (npdls));
+ threadedDimSizes = (int**) malloc(sizeof(int *) * (npdls));
/* Find total number of dims and allocate */
- int totalDims = 0;
+ totalDims = 0;
for(j=0; j<npdls; j++) {
if(creating[j]) continue;
threadedDims[j] = (int*) malloc(sizeof(int) * pdls[j]->ndims);
threadedDimSizes[j] = (int*) malloc(sizeof(int) * pdls[j]->ndims);
}
-
-
-
- int t; /* Thread index for each pdl */
- int tdimStart; /* Start of the threaded dims for each pdl */
- int k; /* threadedDims array index for each pdl */
- int nthreadDim; /* Number of thread dims for the current pdl */
+
+
+
for(j=0; j<npdls; j++) {
if(creating[j]) continue;
tdimStart = realdims[j];
@@ -239,15 +244,12 @@ void pdl_autopthreadmagic( pdl **pdls, int npdls, int * realdims, int* creating
nthreadDim++;
}
nthreadedDims[j] = nthreadDim;
-
-
+
+
}
-
+
/* Go thru each theaded dim and see how many pthreads we can create closest
to the maximum target pthreads */
- int maxPthreadPDL; /* PDL that has the max (or right at the target) num pthreads */
- int maxPthreadDim; /* Threaded dim number that has the max num pthreads */
- int maxPthread = 0; /* Maximum achievable pthread */
for(j=0; j<npdls; j++) {
if(creating[j]) continue;
for( k=0; k < nthreadedDims[j]; k++){
@@ -258,24 +260,24 @@ void pdl_autopthreadmagic( pdl **pdls, int npdls, int * realdims, int* creating
pthreadActual--;
remainder = threadedDimSizes[j][k] % pthreadActual;
}
-
+
if( pthreadActual > maxPthread ){ /* Record this dim if it is the max */
maxPthread = pthreadActual;
maxPthreadPDL = j;
maxPthreadDim = threadedDims[j][k];
}
-
+
/* Don't go any further if target pthread achieved */
if( pthreadActual == target_pthread ) break;
}
/* Don't go any further if target pthread achieved */
if( maxPthread == target_pthread ) break;
}
-
-
-
-
-
+
+
+
+
+
/*
for(j=0; j<npdls; j++) {
if(creating[j]) continue;
@@ -286,12 +288,12 @@ void pdl_autopthreadmagic( pdl **pdls, int npdls, int * realdims, int* creating
}
}
printf("\n");
-
+
printf("Target Pthread = %d\n", target_pthread);
printf("maxPthread = %d, maxPthreadPDL = %d, maxPthreadDim = %d\n", maxPthread, maxPthreadPDL, maxPthreadDim);
*/
-
-
+
+
/* Add threading magic */
if( maxPthread > 1 ){
pdl_add_threading_magic(pdls[maxPthreadPDL], maxPthreadDim, maxPthread);
@@ -308,7 +310,7 @@ void pdl_autopthreadmagic( pdl **pdls, int npdls, int * realdims, int* creating
free(nthreadedDims);
free(threadedDims);
free(threadedDimSizes);
-
+
}
@@ -349,10 +351,10 @@ void pdl_initthreadstruct(int nobl,
* just returning is not! good enough (I tried it)
* CS
*/
- if (thread->magicno == PDL_THR_MAGICNO &&
+ if (thread->magicno == PDL_THR_MAGICNO &&
thread->gflags & PDL_THREAD_INITIALIZED) {
- PDLDEBUG_f(printf("REINITIALIZING already initialized thread\n");)
- PDLDEBUG_f(dump_thread(thread);)
+ PDLDEBUG_f(printf("REINITIALIZING already initialized thread\n");)
+ PDLDEBUG_f(dump_thread(thread);)
/* return; */ /* try again, should (!?) work */
if (thread->inds) Safefree(thread->inds);
@@ -388,11 +390,11 @@ void pdl_initthreadstruct(int nobl,
}
nthreadids = pdl_malloc(sizeof(int)*nids);
ndims += mx; nimpl = mx; thread->nimpl = nimpl;
-
-
+
+
//printf("In pdl_initthreadstruct for func %s\n", info->funcname);
pdl_autopthreadmagic(pdls, npdls, realdims, creating, noPthreadFlag);
-
+
for(j=0; j<npdls; j++) {
if(creating[j]) continue;
@@ -434,19 +436,19 @@ void pdl_initthreadstruct(int nobl,
thread->nimpl = nimpl;
Newx(thread->inds, thread->ndims * (nthr>0 ? nthr : 1), int); /* Create space for pthread-specific inds (i.e. copy for each pthread)*/
- if(thread->inds == NULL) croak("Failed to allocate memory for thread->inds in pdlthread.c");
+ if(thread->inds == NULL) croak("Failed to allocate memory for thread->inds in pdlthread.c");
Newx(thread->dims, thread->ndims, int);
- if(thread->dims == NULL) croak("Failed to allocate memory for thread->dims in pdlthread.c");
+ if(thread->dims == NULL) croak("Failed to allocate memory for thread->dims in pdlthread.c");
Newx(thread->offs, thread->npdls * (nthr>0 ? nthr : 1), int); /* Create space for pthread-specific offs */
- if(thread->offs == NULL) croak("Failed to allocate memory for thread->offs in pdlthread.c");
+ if(thread->offs == NULL) croak("Failed to allocate memory for thread->offs in pdlthread.c");
Newx(thread->incs, thread->ndims * npdls, int);
- if(thread->incs == NULL) croak("Failed to allocate memory for thread->incs in pdlthread.c");
+ if(thread->incs == NULL) croak("Failed to allocate memory for thread->incs in pdlthread.c");
Newx(thread->flags, npdls, char);
- if(thread->flags == NULL) croak("Failed to allocate memory for thread->flags in pdlthread.c");
+ if(thread->flags == NULL) croak("Failed to allocate memory for thread->flags in pdlthread.c");
nth=0; /* Index to dimensions */
@@ -545,7 +547,7 @@ void pdl_initthreadstruct(int nobl,
thread->dims[thread->mag_nth] = n1;
}
thread->gflags |= PDL_THREAD_INITIALIZED;
- PDLDEBUG_f(dump_thread(thread);)
+ PDLDEBUG_f(dump_thread(thread);)
}
void pdl_thread_create_parameter(pdl_thread *thread,int j,int *dims,
@@ -631,7 +633,7 @@ int pdl_iterthreadloop(pdl_thread *thread,int nth) {
if(stop) goto calc_offs;
return 0;
calc_offs:
-
+
for(j=0; j<thread->npdls; j++) {
offsp[j] = PDL_TREPROFFS(thread->pdls[j],thread->flags[j]) +
(!nthr?0:
@@ -651,6 +653,8 @@ void pdl_croak_param(pdl_errorinfo *info,int paramIndex, char *pat, ...)
// I barf a string such as "PDL: function(a,b,c): Parameter 'b' errormessage"
char message [4096] = {'\0'};
+ int i;
+ va_list args;
#define msgptr_advance() \
do { \
@@ -675,10 +679,9 @@ do { \
snprintf(msgptr, remaining, "PDL: %s(", info->funcname);
msgptr_advance();
- int i;
for(i=0; i<info->nparamnames; i++)
{
- snprintf(msgptr, remaining, "%s", info->paramnames[i]);
+ snprintf(msgptr, remaining, "%s", info->paramnames[i]);
msgptr_advance();
if(i < info->nparamnames-1)
@@ -694,7 +697,6 @@ do { \
}
}
- va_list args;
va_start(args,pat);
vsnprintf(msgptr, remaining, pat, args);
@@ -1,6 +1,7 @@
TYPEMAP
pdl* T_PDL
pdl * T_PDL
+PDL_Long * T_PTR
pdl_trans * T_PDLTRANS
pdl_trans* T_PDLTRANS
Logical T_IV
@@ -139,7 +139,7 @@ start-up modules.
# set the version:
-$PDL::VERSION = '2.4.9_004'; # Go to sub numbering per git push
+$PDL::VERSION = '2.4.9_005'; # Go to sub numbering per git push
# Main loader of standard PDL package
@@ -2924,7 +2924,7 @@ pp_addpm(<<'EOD'
=for ref
- where with support for ND masks and threading
+C<where> with support for ND masks and threading
C<whereND> accepts one or more data piddles and a
mask piddle. It returns a list of output piddles,
@@ -2936,17 +2936,19 @@ dimensionality is preserved which allows for
proper threading of the selection operation over
higher dimensions.
+As with C<where> the output PDLs are still connected
+to the original data PDLs, for the purpose of dataflow.
=for usage
$sdata = whereND $data, $mask
- @sdata = whereND $data1, $data2, ..., $mask
+ ($s1, $s2, ..., $sn) = whereND $d1, $d2, ..., $dn, $mask
where
$data is M dimensional
$mask is N < M dimensional
- dims($data) 1..N == dims($maks) 1..N
+ dims($data) 1..N == dims($mask) 1..N
with threading over N+1 to M dimensions
=for example
@@ -1198,7 +1198,8 @@ Vectors with bad components should be moved to the end of the array:
#
# I have kept in the check for when Bad value support is not being compiled
#
-my $nan_check = $bvalflag ? '' : '|| IsNaN(cur)';
+# my $nan_check = $bvalflag ? '' : '|| IsNaN(cur)';
+my $nan_check = 0 ? '' : '|| IsNaN(cur)';
for my $which (
['minimum','<'],
@@ -1,3 +1,97 @@
+commit d410920521eddd0645cc4e0e89ce791fb022b1ef
+Author: Chris Marshall <devel.chm.01@gmail.com>
+Date: Tue Aug 16 20:08:26 2011 -0400
+
+ Add PDL_Long * typemap for sf.net bug #3377113
+
+ Basic/Core/typemap | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 9e635d72317647320897a8fd62bf1e7ed1601aea
+Author: sisyphus_ <sisyphus1@optusnet.com.au>
+Date: Tue Aug 16 13:37:43 2011 +1000
+
+ Rearrange code in Basic/Core/pdlthread.c
+
+ Rearrange the code so that older Microsoft
+ compilers can parse it.
+
+ Basic/Core/pdlthread.c | 114 ++++++++++++++++++++++++-----------------------
+ 1 files changed, 58 insertions(+), 56 deletions(-)
+
+commit cab63972505d5242b2b33d863ed04c74edf0ac91
+Author: sisyphus_ <sisyphus1@optusnet.com.au>
+Date: Tue Aug 16 13:37:42 2011 +1000
+
+ Rearrange C code in Basic/Core/pdlcore.c.PL
+
+ Rearrange the code so that older Microsoft
+ compilers can parse it.
+
+ Basic/Core/pdlcore.c.PL | 166 ++++++++++++++++++++++++-----------------------
+ 1 files changed, 84 insertions(+), 82 deletions(-)
+
+commit 7634dc3d0987b15f6b2e99c74f72cd3665ce05b1
+Author: Chris Marshall <devel.chm.01@gmail.com>
+Date: Mon Aug 15 14:45:53 2011 -0400
+
+ Docs fix for whereND in primitive.pd
+
+ Basic/Primitive/primitive.pd | 8 +++++---
+ 1 files changed, 5 insertions(+), 3 deletions(-)
+
+commit 1bbd43cc64a2df3ea749f9b5a3ccf2b000efd90b
+Author: Chris Marshall <devel.chm.01@gmail.com>
+Date: Sun Aug 14 15:16:16 2011 -0400
+
+ Add MARK BAKER m4ls to demo 3dgal
+
+ Demos/TriDGallery.pm | 9 ++++++++-
+ 1 files changed, 8 insertions(+), 1 deletions(-)
+
+commit b716dbf0b4f0d5c5d7d5d25abd6322a9c2846e8b
+Author: Chris Marshall <devel.chm.01@gmail.com>
+Date: Sun Aug 14 14:24:35 2011 -0400
+
+ Add TODO tests for sf.net bug # 3234141
+
+ The problem is an inconsistent treatment of NaN values
+ depending on whether or not it is the first one along
+ the dimension. The results should be the same no matter
+ what order the elements are in.
+
+ t/ufunc.t | 36 ++++++++++++++++++++++--------------
+ 1 files changed, 22 insertions(+), 14 deletions(-)
+
+commit ba94371d501e6f8424b050fe0b1032258d0abc88
+Author: Chris Marshall <devel.chm.01@gmail.com>
+Date: Sun Aug 14 13:07:28 2011 -0400
+
+ Update bugs list in Known_problems
+
+ Known_problems | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 5b1770756a601a1dcefe8fca573e6f7ef690f68a
+Author: Chris Marshall <devel.chm.01@gmail.com>
+Date: Sun Aug 14 12:52:07 2011 -0400
+
+ Update VERSION and pod for pdldoc
+
+ pdldoc.PL | 16 ++++++++++++----
+ 1 files changed, 12 insertions(+), 4 deletions(-)
+
+commit 5a86c06d4d4112067a88aa5b2f9fdaece1de6126
+Author: Chris Marshall <devel.chm.01@gmail.com>
+Date: Sat Aug 13 13:57:09 2011 -0400
+
+ Update VERSION to 2.4.9_005 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
commit e538a2f8b14ab00d0151486b67c0d1d0209e97ad
Author: Chris Marshall <devel.chm.01@gmail.com>
Date: Sat Aug 13 13:17:57 2011 -0400
@@ -14701,26 +14795,3 @@ Date: Tue May 5 22:20:49 2009 -0400
Basic/Core/Basic.pm | 1 +
1 files changed, 1 insertions(+), 0 deletions(-)
-
-commit 4a4059f3813c5e2128dd57e3a7e23f5faf33c280
-Author: Chris Marshall <marshallch@users.sourceforge.net>
-Date: Wed Apr 29 18:51:04 2009 -0400
-
- Added the Changes for the t/pic_16bit.t commit.
-
- Changes | 4 ++++
- 1 files changed, 4 insertions(+), 0 deletions(-)
-
-commit 9e239ffb1eb0e52cc67ab2a1c6aff677b3dcb17d
-Author: Chris Marshall <marshallch@users.sourceforge.net>
-Date: Wed Apr 29 18:44:35 2009 -0400
-
- Fix sf.net bug 2784016
-
- This fixes sourceforge.net bug number 2784016 originally reported
- via rt.cpan.org where the t/pic_16bit.t test checked for pnmtopng
- with a very english specific test. The test has been modified to
- be less english specific. This is still far from full i8n of PDL.
-
- t/pic_16bit.t | 4 ++--
- 1 files changed, 2 insertions(+), 2 deletions(-)
@@ -157,6 +157,14 @@ while(max $c>1.1) {$c=smth($a/smth($d));$d*=$c;imagrgb[$d/850];}
# imagrgb[$d]if($k++%2); $s=conv2d($d,$k)/8;$i=90*90*random(50);$t=$d->
# clump(2)-> index($i);$t.=($s->clump(2)->index($i)>.5);}while(!twiddle3d)
+actnw q|
+# spherical dynamics [Mark R Baker]
+use PDL;use PDL::Graphics::TriD;for $c(1..99){$n=6.28*$c; $g=$c*rvals(
+sin(zeros(5000))*$c);$cz=-1**$g*$c;$cy=$g*cos$g*$c;$cx=$c*rvals($g)*$c;
+$g=cos($w=$cz+$cy+$cx);$r=sin$cy+$c+$cz;$b=sin$w;nokeeptwiddling3d();
+$i=$cz-$cx-$cy;$q=$i*$n;points3d[$b*sin$q,$r*cos$q,$g*sin$q],[$r,$g,$b]}
+|;
+
actnw q~
# Fractal mountain range [Tuomas Lukka]
use PDL;use PDL::Image2D;use PDL::Graphics::TriD; keeptwiddling3d(); $k=ones(5,5) / 25;
@@ -196,5 +204,4 @@ $a=zeroes 300,300;$r=$a->xlinvals(-1.5,
->clip(-5,5)}$q,$h;imagrgb[f(($a==0)*($r/2+0.75)),f(($a==0)*($i+1)/2),$a/30]}
}
-
1;
@@ -84,8 +84,9 @@ The following issues have been reported with this version of PDL:
- The following SourceForge bugs are outstanding at time of the
- PDL-2.4.9_004 release:
+ PDL-2.4.9_005 release:
+ 3391507 pdl2 docs not found by pdldoc
3377113 failure to find PDL typemap
3363406 PDL::Minuit build can't make libminuit.a
3316394 'help funname' fails to show multiple function names
@@ -103,7 +104,6 @@ The following issues have been reported with this version of PDL:
2995500 perl -d chokes on lvalue functions
2153898 default PDL build output too long
1994584 PDL Has no signed 8-bit integer data type
- 1850913 wpic/rpic don't support 16bit png
1507054 closing TriD window kills perldl shell
1435189 Installation with cpan2rpm
1205359 PGPLOT Window does not store full state info
@@ -57,5 +57,5 @@
"url" : "http://pdl.git.sourceforge.net/git/gitweb.cgi?p=pdl/pdl"
}
},
- "version" : "v2.4.9_004"
+ "version" : "v2.4.9_005"
}
@@ -34,4 +34,4 @@ resources:
bugtracker: http://sourceforge.net/tracker/?func=browse&group_id=612&atid=100612
homepage: http://pdl.perl.org/
repository: http://pdl.git.sourceforge.net/git/gitweb.cgi?p=pdl/pdl
-version: v2.4.9_004
+version: v2.4.9_005
@@ -1,3 +1,35 @@
+Release Notes for PDL 2.4.9_005 --------------------------
+
+General Notes:
+
+ * Another quick CPAN developers release
+
+ - It is a snapshot of the current git development tree
+ and everything may not work correctly or have complete
+ documentation.
+
+ - These release notes may not be fully complete. Please
+ see Changes (from the git log) for full details.
+
+ - All tests may not pass, especially ones corresponding
+ to issues in Known_problems.
+
+ - Manual build/install is recommended although the
+ cpan shell may be used by specifying the distribution
+ path rather than just the module name, e.g.:
+
+ cpan> get CHM/PDL-2.4.9_005.tar.gz
+ cpan> make CHM/PDL-2.4.9_005.tar.gz
+ cpan> test CHM/PDL-2.4.9_005.tar.gz
+ cpan> look CHM/PDL-2.4.9_005.tar.gz
+
+
+Highlights:
+
+ * TBD
+
+
+
Release Notes for PDL 2.4.9_004 --------------------------
General Notes:
@@ -65,7 +65,7 @@ use PDL::Doc::Perldl;
use File::Basename;
use vars qw( $VERSION );
-$VERSION = '0.2';
+$VERSION = '0.3';
my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
@@ -149,7 +149,8 @@ as the C<apropos>, C<help>, C<sig>,
print $fh "C<badinfo>, \n" if $bvalflag;
print $fh <<'!NO!SUBS!';
-and C<usage> commands available in the L<perldl|PDL::perldl> shell.
+and C<usage> commands available in the L<perldl|PDL::perldl>
+and L<pdl2|pdl2> shells.
Think of it as the PDL equivalent of C<perldoc -f>.
@@ -184,15 +185,22 @@ prints signature of PDL function.
Prints usage information for a PDL function.
+=item C<$PDL::Config{PDLDOC_IGNORE_AUTOLOADER}>
+
+This PDL configuration variable may be set in the perldl.conf
+file to disable runtime search for documentation in
+L<PDL::AutoLoader|PDL::AutoLoader> files.
+
=back
=head1 VERSION
-This is pdldoc v0.2.
+This is pdldoc version 0.3.
=head1 AUTHOR
-Doug Burke <burke@ifa.hawaii.edu>.
+Doug Burke <burke at ifa dot hawaii dot edu>.
+Chris Marshall <chm at cpan dot org>.
=cut
@@ -3,7 +3,7 @@
# Test some Basic/Ufunc routines
use strict;
-use Test::More tests => 13;
+use Test::More tests => 15;
BEGIN {
# if we've got this far in the tests then
@@ -51,21 +51,29 @@ ok( ( eval { pdl([])->qsorti }, $@ eq '' ), "qsorti coredump,[SF bug 2110074]");
SKIP: {
skip "Bad value support not compiled", 4 unless $PDL::Bad::Status;
- TODO: {
- local $TODO = "odd/pctover does not handle bad values";
+ my $abad = $a;
+ $abad->badflag(1);
+ $abad->inplace->setvaltobad(7);
+ my $agood = $abad->where($abad->isgood);
+ my $allbad = $abad->where($abad->isbad);
- my $abad = $a;
- $abad->badflag(1);
- $abad->inplace->setvaltobad(7);
- my $agood = $abad->where($abad->isgood);
- my $allbad = $abad->where($abad->isbad);
-
- ok( $abad->pctover(0.1) == $agood->pctover(0.1), "pctover(0.1) badvals" );
- ok( $abad->pctover(0.9) == $agood->pctover(0.9), "pctover(0.9) badvals" );
- ok( $allbad->pctover(0.1)->isbad, "pctover(0.1) all badvals" );
- ok( $allbad->pctover(0.9)->isbad, "pctover(0.9) all badvals" );
- };
+ ok( $abad->pctover(0.1) == $agood->pctover(0.1), "pctover(0.1) badvals" );
+ ok( $abad->pctover(0.9) == $agood->pctover(0.9), "pctover(0.9) badvals" );
+ ok( $allbad->pctover(0.1)->isbad, "pctover(0.1) all badvals" );
+ ok( $allbad->pctover(0.9)->isbad, "pctover(0.9) all badvals" );
};
+# test for sf.net but report 3234141 "max() fails on nan"
+# NaN values are handled inconsistently by min, minimum, max, maximum...
+#
+TODO: {
+ local $TODO = "fixing max/min NaN handling";
+ my $inf = exp(~0>>1);
+ my $nan = $inf/$inf;
+ my $a = pdl($nan, 0, 1, 2);
+ my $b = pdl(0, 1, 2, $nan);
+ ok($a->min == $b->min, "min with NaNs");
+ ok($a->max == $b->max, "max with NaNs");
+}