"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Core/pdlapi.c" 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).

pdlapi.c  (PDL-2.078):pdlapi.c  (PDL-2.079)
/* pdlapi.c - functions for manipulating pdl structs */ /* pdlapi.c - functions for manipulating pdl structs */
#include "pdl.h" /* Data structure declarations */ #include "pdl.h" /* Data structure declarations */
#include "pdlcore.h" /* Core declarations */ #include "pdlcore.h" /* Core declarations */
#define VTABLE_OR_DEFAULT(what, trans, func, default_func) \ #define VTABLE_OR_DEFAULT(what, trans, is_fwd, func, default_func) \
what(PDL_err, ((trans)->vtable->func \ do { \
? (trans)->vtable->func \ PDLDEBUG_f(printf("VTOD call " #func "(%p=%s)\n", trans, trans->vtable->name
: pdl_ ## default_func)(trans)) )); \
what(PDL_err, ((trans)->vtable->func \
? (trans)->vtable->func \
: pdl_ ## default_func)(trans)); \
pdl **pdls = trans->pdls; \
PDL_Indx i, istart = is_fwd ? trans->vtable->nparents : 0, iend = is_fwd ? t
rans->vtable->npdls : trans->vtable->nparents; \
for (i = istart; i < iend; i++) \
if (pdls[i] && (pdls[i]->state & PDL_BADVAL)) \
pdl_propagate_badflag(pdls[i], !!(pdls[i]->state & PDL_BADVAL)); \
} while (0)
#define REDODIMS(what, trans) do { \ #define REDODIMS(what, trans) do { \
if ((trans)->vtable->redodims) \ if ((trans)->vtable->redodims) \
what(PDL_err, pdl_dim_checks( \ what(PDL_err, pdl_dim_checks( \
(trans)->vtable, (trans)->pdls, \ (trans)->vtable, (trans)->pdls, \
NULL, NULL, \ NULL, NULL, \
(trans)->ind_sizes, 1)); \ (trans)->ind_sizes, 1)); \
if (trans->dims_redone) { \ if (trans->dims_redone) { \
FREETRANS(trans, 0); \ FREETRANS(trans, 0); \
if (PDL_err.error) return PDL_err; \ if (PDL_err.error) return PDL_err; \
trans->dims_redone = 0; \ trans->dims_redone = 0; \
} \ } \
what(PDL_err, ((trans)->vtable->redodims \ what(PDL_err, ((trans)->vtable->redodims \
? (trans)->vtable->redodims \ ? (trans)->vtable->redodims \
: pdl_redodims_default)(trans)); \ : pdl_redodims_default)(trans)); \
} while (0) } while (0)
#define READDATA(trans) VTABLE_OR_DEFAULT(PDL_ACCUMERROR, trans, readdata, readd #define READDATA(trans) VTABLE_OR_DEFAULT(PDL_ACCUMERROR, trans, 1, readdata, re
ata_affine) addata_affine)
#define WRITEDATA(trans) VTABLE_OR_DEFAULT(PDL_ACCUMERROR, trans, writebackdata, #define WRITEDATA(trans) VTABLE_OR_DEFAULT(PDL_ACCUMERROR, trans, 0, writebackda
writebackdata_affine) ta, writebackdata_affine)
#define FREETRANS(trans, destroy) \ #define FREETRANS(trans, destroy) \
if(trans->vtable->freetrans) { \ if(trans->vtable->freetrans) { \
PDLDEBUG_f(printf("call freetrans\n")); \ PDLDEBUG_f(printf("call freetrans\n")); \
PDL_ACCUMERROR(PDL_err, trans->vtable->freetrans(trans, destroy)); \ PDL_ACCUMERROR(PDL_err, trans->vtable->freetrans(trans, destroy)); \
/* ignore error for now as need to still free rest */ \ /* ignore error for now as need to still free rest */ \
if (destroy) PDL_CLRMAGIC(trans); \ if (destroy) PDL_CLRMAGIC(trans); \
} }
#define CHANGED(...) \ #define CHANGED(...) \
PDL_ACCUMERROR(PDL_err, pdl_changed(__VA_ARGS__)) PDL_ACCUMERROR(PDL_err, pdl_changed(__VA_ARGS__))
extern Core PDL; extern Core PDL;
pdl_error pdl__make_physvaffine_recprotect(pdl *it, int recurse_count);
/* Make sure transformation is done */ /* Make sure transformation is done */
pdl_error pdl__ensure_trans(pdl_trans *trans,int what,int *wd) pdl_error pdl__ensure_trans(pdl_trans *trans,int what,int *wd, int recurse_count )
{ {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDLDEBUG_f(printf("pdl__ensure_trans %p what=%d\n", trans, what)); PDLDEBUG_f(printf("pdl__ensure_trans %p what=%d\n", trans, what));
PDL_TR_CHKMAGIC(trans); PDL_TR_CHKMAGIC(trans);
PDL_Indx j, flag=what, par_pvaf=0; PDL_Indx j, flag=what, par_pvaf=0;
pdl_transvtable *vtable = trans->vtable; pdl_transvtable *vtable = trans->vtable;
/* Make parents physical */ /* Make parents physical */
for(j=0; j<vtable->nparents; j++) { for(j=0; j<vtable->npdls; j++) {
if(VAFFINE_FLAG_OK(vtable->per_pdl_flags,j)) if(VAFFINE_FLAG_OK(vtable->per_pdl_flags,j))
par_pvaf++; par_pvaf++;
PDL_RETERROR(PDL_err, pdl_make_physvaffine(trans->pdls[j])); PDL_RETERROR(PDL_err, pdl__make_physvaffine_recprotect(trans->pdl s[j], recurse_count+1));
} }
for(; j<vtable->npdls; j++) { for(j=vtable->nparents; j<vtable->npdls; j++)
if(VAFFINE_FLAG_OK(vtable->per_pdl_flags,j))
par_pvaf++;
PDL_RETERROR(PDL_err, pdl_make_physvaffine(trans->pdls[j]));
flag |= trans->pdls[j]->state & PDL_ANYCHANGED; flag |= trans->pdls[j]->state & PDL_ANYCHANGED;
}
if (flag & PDL_PARENTDIMSCHANGED) REDODIMS(PDL_RETERROR, trans); if (flag & PDL_PARENTDIMSCHANGED) REDODIMS(PDL_RETERROR, trans);
for(j=0; j<vtable->npdls; j++) for(j=0; j<vtable->npdls; j++)
if(trans->pdls[j]->trans_parent == trans) if(trans->pdls[j]->trans_parent == trans)
PDL_ENSURE_ALLOCATED(trans->pdls[j]); PDL_ENSURE_ALLOCATED(trans->pdls[j]);
if(flag & (PDL_PARENTDATACHANGED | PDL_PARENTDIMSCHANGED)) { if(flag & (PDL_PARENTDATACHANGED | PDL_PARENTDIMSCHANGED)) {
if(par_pvaf && (trans->flags & PDL_ITRANS_ISAFFINE)) { if(par_pvaf && (trans->flags & PDL_ITRANS_ISAFFINE)) {
/* Attention: this assumes affine = p2child */ /* Attention: this assumes affine = p2child */
/* need to signal that redodims has already been called */ /* need to signal that redodims has already been called */
trans->pdls[1]->state &= ~PDL_PARENTDIMSCHANGED; trans->pdls[1]->state &= ~PDL_PARENTDIMSCHANGED;
PDL_RETERROR(PDL_err, pdl_make_physvaffine(trans->pdls[1] )); PDL_RETERROR(PDL_err, pdl__make_physvaffine_recprotect(tr ans->pdls[1], recurse_count+1));
PDL_ACCUMERROR(PDL_err, pdl_readdata_vaffine(trans->pdls[ 1])); PDL_ACCUMERROR(PDL_err, pdl_readdata_vaffine(trans->pdls[ 1]));
} else } else
{
READDATA(trans); READDATA(trans);
}
} }
for(j=vtable->nparents; j<vtable->npdls; j++) { for(j=vtable->nparents; j<vtable->npdls; j++) {
pdl *child = trans->pdls[j]; pdl *child = trans->pdls[j];
child->state &= ~PDL_ANYCHANGED; child->state &= ~PDL_ANYCHANGED;
if (!wd) continue; if (!wd) continue;
char isvaffine = (PDL_VAFFOK(child) && char isvaffine = (PDL_VAFFOK(child) &&
VAFFINE_FLAG_OK(vtable->per_pdl_flags,j)); VAFFINE_FLAG_OK(vtable->per_pdl_flags,j));
if (!isvaffine || (wd[j] & PDL_PARENTDIMSCHANGED)) if (!isvaffine || (wd[j] & PDL_PARENTDIMSCHANGED))
CHANGED(child,wd[j],0); CHANGED(child,wd[j],0);
if (isvaffine) if (isvaffine)
CHANGED(child->vafftrans->from,PDL_PARENTDATACHANGED,0); CHANGED(child->vafftrans->from,PDL_PARENTDATACHANGED,0);
} }
return PDL_err; return PDL_err;
} }
pdl *pdl_null() { pdl *pdl_null() {
PDL_Anyval zero = { PDL_D, {.D=0.0} };
PDLDEBUG_f(printf("pdl_null\n")); PDLDEBUG_f(printf("pdl_null\n"));
pdl *it = pdl_pdlnew(); return pdl_pdlnew();
if (!it) return it;
pdl_error PDL_err = pdl_makescratchhash(it, zero);
if (PDL_err.error) { pdl_destroy(it); return NULL; }
return it;
} }
pdl *pdl_scalar(PDL_Anyval anyval) { pdl *pdl_scalar(PDL_Anyval anyval) {
PDLDEBUG_f(printf("pdl_scalar type=%d val=", anyval.type); pdl_dump_anyva l(anyval); printf("\n");); PDLDEBUG_f(printf("pdl_scalar type=%d val=", anyval.type); pdl_dump_anyva l(anyval); printf("\n"););
pdl *it = pdl_pdlnew(); pdl *it = pdl_pdlnew();
if (!it) return it; if (!it) return it;
pdl_error PDL_err = pdl_makescratchhash(it, anyval); it->datatype = anyval.type;
if (PDL_err.error) { pdl_destroy(it); return NULL; }
it->broadcastids[0] = it->ndims = 0; /* 0 dims in a scalar */ it->broadcastids[0] = it->ndims = 0; /* 0 dims in a scalar */
it->state &= ~(PDL_ALLOCATED|PDL_NOMYDIMS); /* size changed, has dims */ pdl_resize_defaultincs(it);
it->nvals = 1; /* 1 val in a scalar */ pdl_error PDL_err = pdl_allocdata(it);
if (PDL_err.error) { pdl_destroy(it); return NULL; }
it->value = anyval.value;
it->state &= ~(PDL_NOMYDIMS); /* has dims */
return it; return it;
} }
pdl *pdl_get_convertedpdl(pdl *old,int type) { pdl *pdl_get_convertedpdl(pdl *old,int type) {
PDLDEBUG_f(printf("pdl_get_convertedpdl\n")); PDLDEBUG_f(printf("pdl_get_convertedpdl\n"));
if(old->datatype == type) return old; if(old->datatype == type) return old;
pdl *it = pdl_null(); pdl *it = pdl_pdlnew();
if (!it) return it; if (!it) return it;
pdl_error PDL_err = pdl_converttypei_new(old,it,type); pdl_error PDL_err = pdl_converttypei_new(old,it,type);
if (PDL_err.error) { pdl_destroy(it); return NULL; } if (PDL_err.error) { pdl_destroy(it); return NULL; }
return it; return it;
} }
pdl_error pdl_allocdata(pdl *it) { pdl_error pdl_allocdata(pdl *it) {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDLDEBUG_f(printf("pdl_allocdata %p, %"IND_FLAG", %d\n",(void*)it, it->nvals, PDLDEBUG_f(printf("pdl_allocdata %p, %"IND_FLAG", %d\n",(void*)it, it->nvals,
it->datatype)); it->datatype));
skipping to change at line 303 skipping to change at line 303
/* Can't return; might be many times (e.g. $x+$x) */ /* Can't return; might be many times (e.g. $x+$x) */
PDL_END_CHILDLOOP(it) PDL_END_CHILDLOOP(it)
/* this might be due to a croak when performing the trans; so /* this might be due to a croak when performing the trans; so
warn only for now, otherwise we leave trans undestructed ! */ warn only for now, otherwise we leave trans undestructed ! */
if(!flag) if(!flag)
pdl_pdl_warn("Child not found for pdl %p, trans %p\n",it, trans); pdl_pdl_warn("Child not found for pdl %p, trans %p\n",it, trans);
} }
void pdl__removetrans_parent(pdl *it, pdl_trans *trans, PDL_Indx nth) void pdl__removetrans_parent(pdl *it, pdl_trans *trans, PDL_Indx nth)
{ {
PDLDEBUG_f(printf("pdl__removetrans_parent(%s=%p): %p %"IND_FLAG"\n", PDLDEBUG_f(printf("pdl__removetrans_parent from %p (%s=%p): %"IND_FLAG"\n
trans->vtable->name, (void*)trans, (void*)(it), nth)); ",
it, trans->vtable->name, trans, nth));
trans->pdls[nth] = 0; trans->pdls[nth] = 0;
if (it->trans_parent == trans) it->trans_parent = 0; if (it->trans_parent == trans) it->trans_parent = 0;
it->state &= ~PDL_MYDIMS_TRANS; it->state &= ~PDL_MYDIMS_TRANS;
} }
pdl_error pdl_trans_finaldestroy(pdl_trans *trans) pdl_error pdl_trans_finaldestroy(pdl_trans *trans)
{ {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDLDEBUG_f(printf("pdl_trans_finaldestroy %p\n", trans)); PDLDEBUG_f(printf("pdl_trans_finaldestroy %p\n", trans));
FREETRANS(trans, 1); FREETRANS(trans, 1);
skipping to change at line 326 skipping to change at line 326
pdl_freebroadcaststruct(&trans->broadcast); pdl_freebroadcaststruct(&trans->broadcast);
trans->vtable = 0; /* Make sure no-one uses this */ trans->vtable = 0; /* Make sure no-one uses this */
PDLDEBUG_f(printf("call free\n")); PDLDEBUG_f(printf("call free\n"));
if (trans->params) free(trans->params); if (trans->params) free(trans->params);
free(trans->ind_sizes); free(trans->ind_sizes);
free(trans->inc_sizes); free(trans->inc_sizes);
free(trans); free(trans);
return PDL_err; return PDL_err;
} }
pdl_error pdl_destroytransform(pdl_trans *trans,int ensure,int *wd) pdl_error pdl__destroy_recprotect(pdl *it, int recurse_count);
pdl_error pdl_destroytransform(pdl_trans *trans,int ensure,int *wd, int recurse_
count)
{ {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDL_TR_CHKMAGIC(trans); PDL_TR_CHKMAGIC(trans);
PDL_Indx j; PDL_Indx j;
int ismutual = (trans->flags & PDL_ITRANS_DO_DATAFLOW_ANY); int ismutual = (trans->flags & PDL_ITRANS_DO_DATAFLOW_ANY);
if (!trans->vtable) if (!trans->vtable)
return pdl_make_error(PDL_EFATAL, "ZERO VTABLE DESTTRAN 0x%p %d\n ",trans,ensure); return pdl_make_error(PDL_EFATAL, "ZERO VTABLE DESTTRAN 0x%p %d\n ",trans,ensure);
if (!ismutual) for(j=0; j<trans->vtable->nparents; j++) if (!ismutual) for(j=0; j<trans->vtable->nparents; j++)
if (trans->pdls[j]->state & PDL_DATAFLOW_ANY) { ismutual=1; break; } if (trans->pdls[j]->state & PDL_DATAFLOW_ANY) { ismutual=1; break; }
PDLDEBUG_f(printf("pdl_destroytransform %s=%p (ensure=%d ismutual=%d)\n", PDLDEBUG_f(printf("pdl_destroytransform %s=%p (ensure=%d ismutual=%d)\n",
trans->vtable ? trans->vtable->name : "NULL", trans->vtable ? trans->vtable->name : "NULL",
(void*)trans,ensure,ismutual)); (void*)trans,ensure,ismutual));
if(ensure) if(ensure)
PDL_ACCUMERROR(PDL_err, pdl__ensure_trans(trans,ismutual ? 0 : PD L_PARENTDIMSCHANGED,wd)); PDL_ACCUMERROR(PDL_err, pdl__ensure_trans(trans,ismutual ? 0 : PD L_PARENTDIMSCHANGED,wd, recurse_count+1));
pdl *destbuffer[trans->vtable->npdls]; pdl *destbuffer[trans->vtable->npdls];
int ndest = 0; int ndest = 0;
for(j=0; j<trans->vtable->nparents; j++) { for(j=0; j<trans->vtable->nparents; j++) {
pdl *parent = trans->pdls[j]; pdl *parent = trans->pdls[j];
if(!parent) continue; if(!parent) continue;
PDL_CHKMAGIC(parent); PDL_CHKMAGIC(parent);
pdl__removetrans_children(parent,trans); pdl__removetrans_children(parent,trans);
if (!(parent->state & PDL_DESTROYING) && !parent->sv) { if (!(parent->state & PDL_DESTROYING) && !parent->sv) {
parent->state |= PDL_DESTROYING; /* so no mark twice */ parent->state |= PDL_DESTROYING; /* so no mark twice */
destbuffer[ndest++] = parent; destbuffer[ndest++] = parent;
skipping to change at line 367 skipping to change at line 368
if (ismutual && child->vafftrans) pdl_vafftrans_remove(child); if (ismutual && child->vafftrans) pdl_vafftrans_remove(child);
if ((!(child->state & PDL_DESTROYING) && !child->sv) || if ((!(child->state & PDL_DESTROYING) && !child->sv) ||
(trans->vtable->par_flags[j] & PDL_PARAM_ISTEMP)) { (trans->vtable->par_flags[j] & PDL_PARAM_ISTEMP)) {
child->state |= PDL_DESTROYING; /* so no mark twice */ child->state |= PDL_DESTROYING; /* so no mark twice */
destbuffer[ndest++] = child; destbuffer[ndest++] = child;
} }
} }
PDL_ACCUMERROR(PDL_err, pdl_trans_finaldestroy(trans)); PDL_ACCUMERROR(PDL_err, pdl_trans_finaldestroy(trans));
for(j=0; j<ndest; j++) { for(j=0; j<ndest; j++) {
destbuffer[j]->state &= ~PDL_DESTROYING; /* safe, set by us */ destbuffer[j]->state &= ~PDL_DESTROYING; /* safe, set by us */
PDL_ACCUMERROR(PDL_err, pdl_destroy(destbuffer[j])); PDL_ACCUMERROR(PDL_err, pdl__destroy_recprotect(destbuffer[j], re curse_count+1));
} }
PDLDEBUG_f(printf("pdl_destroytransform leaving %p\n", (void*)trans)); PDLDEBUG_f(printf("pdl_destroytransform leaving %p\n", (void*)trans));
return PDL_err; return PDL_err;
} }
/* /*
A ndarray may be A ndarray may be
- a parent of something - just ensure & destroy - a parent of something - just ensure & destroy
- a child of something - just ensure & destroy - a child of something - just ensure & destroy
- parent of two pdls which both propagate backwards - mustn't destroy. - parent of two pdls which both propagate backwards - mustn't destroy.
- both parent and child at same time, to something that propagates. - both parent and child at same time, to something that propagates.
Therefore, simple rules: Therefore, simple rules:
- allowed to destroy if - allowed to destroy if
1. a parent with max. 1 backwards propagating transformation 1. a parent with max. 1 backwards propagating transformation
2. a child with no trans_children 2. a child with no trans_children
When an ndarray is destroyed, it must tell its trans_children and/or When an ndarray is destroyed, it must tell its trans_children and/or
parent. parent.
*/ */
pdl_error pdl_destroy(pdl *it) { pdl_error pdl__destroy_recprotect(pdl *it, int recurse_count) {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
int nback=0,nback2=0,nforw=0; int nback=0,nback2=0,nforw=0;
int nafn=0; int nafn=0;
PDL_DECL_CHILDLOOP(it); PDL_DECL_CHILDLOOP(it);
PDL_CHKMAGIC(it); PDL_CHKMAGIC(it);
PDLDEBUG_f(printf("pdl_destroy: ");pdl_dump(it)); PDLDEBUG_f(printf("pdl_destroy: ");pdl_dump(it));
if(it->state & PDL_DESTROYING) { if(it->state & PDL_DESTROYING) {
PDLDEBUG_f(printf(" already destroying, returning\n")); PDLDEBUG_f(printf(" already destroying, returning\n"));
return PDL_err; return PDL_err;
} }
it->state |= PDL_DESTROYING; it->state |= PDL_DESTROYING;
/* Clear the sv field so that there will be no dangling ptrs */ /* Clear the sv field so that there will be no dangling ptrs */
if(it->sv) { if(it->sv) {
mg_free((SV *)it->sv); mg_free((SV *)it->sv);
sv_setiv(it->sv,0x4242); sv_setiv(it->sv,0x4242);
it->sv = NULL; it->sv = NULL;
} }
/* 1. count the trans_children that do flow */ /* 1. count the trans_children that do flow */
PDL_START_CHILDLOOP(it) PDL_START_CHILDLOOP(it)
pdl_trans *curt = PDL_CHILDLOOP_THISCHILD(it); pdl_trans *curt = PDL_CHILDLOOP_THISCHILD(it);
if(curt->flags & PDL_ITRANS_DO_DATAFLOW_F) if(curt->flags & PDL_ITRANS_DO_DATAFLOW_F)
nforw ++; nforw ++;
if(curt->flags & PDL_ITRANS_DO_DATAFLOW_B) if(curt->flags & PDL_ITRANS_DO_DATAFLOW_B)
{ {
nback ++; nback ++;
/* Cases where more than two in relationship /* Cases where more than two in relationship
* must always be soft-destroyed */ * must always be soft-destroyed */
if(curt->vtable->npdls > 2) nback2++; if(curt->vtable->npdls > 2) nback2++;
} }
if ((curt->flags & PDL_ITRANS_ISAFFINE) && !(curt->pdls[1]->state & PDL_A LLOCATED)) if ((curt->flags & PDL_ITRANS_ISAFFINE) && !(curt->pdls[1]->state & PDL_A LLOCATED))
nafn ++; nafn ++;
PDL_END_CHILDLOOP(it) PDL_END_CHILDLOOP(it)
/* First case where we may not destroy */ /* First case where we may not destroy */
if(nback2 > 0) goto soft_destroy; if(nback2 > 0) goto soft_destroy;
if(nback > 1) goto soft_destroy; if(nback > 1) goto soft_destroy;
/* Also not here */ /* Also not here */
if(it->trans_parent && nforw) goto soft_destroy; if(it->trans_parent && nforw) goto soft_destroy;
/* Also, we do not wish to destroy if the trans_children would be larger /* Also, we do not wish to destroy if the trans_children would be larger
* than the parent and are currently not allocated (e.g. lags). * than the parent and are currently not allocated (e.g. lags).
* Because this is too much work to check, we refrain from destroying * Because this is too much work to check, we refrain from destroying
* for now if there is an affine child that is not allocated * for now if there is an affine child that is not allocated
*/ */
if(nafn) goto soft_destroy; if(nafn) goto soft_destroy;
if(pdl__magic_isundestroyable(it)) { if(pdl__magic_isundestroyable(it)) {
PDLDEBUG_f(printf("pdl_destroy not destroying as magic %p\n",(void*)it)) ; PDLDEBUG_f(printf("pdl_destroy not destroying as magic %p\n",(void*)it)) ;
goto soft_destroy; goto soft_destroy;
} }
PDL_START_CHILDLOOP(it) PDL_START_CHILDLOOP(it)
PDL_RETERROR(PDL_err, pdl_destroytransform(PDL_CHILDLOOP_THISCHILD(it),1, NULL)); PDL_RETERROR(PDL_err, pdl_destroytransform(PDL_CHILDLOOP_THISCHILD(it),1, NULL, recurse_count+1));
PDL_END_CHILDLOOP(it) PDL_END_CHILDLOOP(it)
pdl_trans *trans = it->trans_parent; pdl_trans *trans = it->trans_parent;
if (trans) if (trans)
/* Ensure only if there are other children! */ /* Ensure only if there are other children! */
PDL_RETERROR(PDL_err, pdl_destroytransform(trans,trans->vtable->npdls PDL_RETERROR(PDL_err, pdl_destroytransform(trans,trans->vtable->npdls
- trans->vtable->nparents > 1,NULL)); - trans->vtable->nparents > 1,NULL, recurse
_count+1));
/* Here, this is a child but has no children - fall through to hard_destroy */ /* Here, this is a child but has no children - fall through to hard_destroy */
PDL_RETERROR(PDL_err, pdl__free(it)); PDL_RETERROR(PDL_err, pdl__free(it));
PDLDEBUG_f(printf("pdl_destroy end %p\n",(void*)it)); PDLDEBUG_f(printf("pdl_destroy end %p\n",(void*)it));
return PDL_err; return PDL_err;
soft_destroy: soft_destroy:
PDLDEBUG_f(printf("pdl_destroy may have dependencies, not destroy %p, nba(%d PDLDEBUG_f(printf("pdl_destroy may have dependencies, not destroy %p, nba(%d
, %d), nforw(%d), tra(%p), nafn(%d)\n", , %d), nforw(%d), tra(%p=%s), nafn(%d)\n",
(void*)it, nback, nback2, nforw, (void*)(it->tran it, nback, nback2, nforw, it->trans_parent, it->trans_parent?it->trans_pa
s_parent), nafn)); rent->vtable->name:"", nafn));
it->state &= ~PDL_DESTROYING; it->state &= ~PDL_DESTROYING;
return PDL_err; return PDL_err;
} }
pdl_error pdl_destroy(pdl *it) {
return pdl__destroy_recprotect(it, 0);
}
/* Straight copy, no dataflow */ /* Straight copy, no dataflow */
pdl *pdl_hard_copy(pdl *src) { pdl *pdl_hard_copy(pdl *src) {
pdl_error PDL_err = pdl_make_physical(src); /* Wasteful XXX... should be lazier */ pdl_error PDL_err = pdl_make_physical(src); /* Wasteful XXX... should be lazier */
if (PDL_err.error) return NULL; if (PDL_err.error) return NULL;
int i; int i;
PDLDEBUG_f(printf("pdl_hard_copy\n")); PDLDEBUG_f(printf("pdl_hard_copy\n"));
pdl *it = pdl_pdlnew(); pdl *it = pdl_pdlnew();
if (!it) return it; if (!it) return it;
it->state = 0; it->state = 0;
PDLDEBUG_f(printf("pdl_hard_copy (%p): ", src);pdl_dump(it)); PDLDEBUG_f(printf("pdl_hard_copy (%p): ", src);pdl_dump(it));
skipping to change at line 593 skipping to change at line 587
} }
PDL_Anyval pdl_get_offs(pdl *it, PDL_Indx offs) { PDL_Anyval pdl_get_offs(pdl *it, PDL_Indx offs) {
PDL_Indx dummy1=offs+1; PDL_Indx dummy2=1; PDL_Indx dummy1=offs+1; PDL_Indx dummy2=1;
return pdl_at(it->data, it->datatype, &offs, &dummy1, &dummy2, 0, 1); return pdl_at(it->data, it->datatype, &offs, &dummy1, &dummy2, 0, 1);
} }
pdl_error pdl__addchildtrans(pdl *it,pdl_trans *trans) pdl_error pdl__addchildtrans(pdl *it,pdl_trans *trans)
{ {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDLDEBUG_f(printf("pdl__addchildtrans\n")); PDLDEBUG_f(printf("pdl__addchildtrans add to %p trans=%s\n", it, trans->v table?trans->vtable->name:""));
int i; pdl_trans_children *c = &it->trans_children; int i; pdl_trans_children *c = &it->trans_children;
do { do {
if (c->next) { c=c->next; continue; } else { if (c->next) { c=c->next; continue; } else {
for(i=0; i<PDL_NCHILDREN; i++) for(i=0; i<PDL_NCHILDREN; i++)
if(! c->trans[i]) { if(! c->trans[i]) {
c->trans[i] = trans; return PDL_err; c->trans[i] = trans; return PDL_err;
} }
break; break;
} }
} while(1); } while(1);
skipping to change at line 624 skipping to change at line 618
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDL_Indx i; PDL_Indx i;
int c = (it->state & PDL_PARENTDIMSCHANGED); int c = (it->state & PDL_PARENTDIMSCHANGED);
PDLDEBUG_f(printf("make_physdims %p (%X)\n",(void*)it, c)); PDLDEBUG_f(printf("make_physdims %p (%X)\n",(void*)it, c));
PDL_CHKMAGIC(it); PDL_CHKMAGIC(it);
if(!c) { if(!c) {
PDLDEBUG_f(printf("make_physdims exit (NOP) %p\n",(void*)it)); PDLDEBUG_f(printf("make_physdims exit (NOP) %p\n",(void*)it));
return PDL_err; return PDL_err;
} }
it->state &= ~PDL_PARENTDIMSCHANGED; it->state &= ~PDL_PARENTDIMSCHANGED;
PDLDEBUG_f(printf("make_physdims %p TRANS:\n",(void*)it); pdl_trans *trans = it->trans_parent;
pdl_dump_trans_fixspace(it->trans_parent,3)); PDLDEBUG_f(printf("make_physdims %p TRANS:\n",it);
for(i=0; i<it->trans_parent->vtable->nparents; i++) { pdl_dump_trans_fixspace(trans,3));
PDL_RETERROR(PDL_err, pdl_make_physdims(it->trans_parent->pdls[i] for(i=0; i<trans->vtable->nparents; i++) {
)); PDL_RETERROR(PDL_err, pdl_make_physdims(trans->pdls[i]));
} }
/* doesn't this mean that all children of this trans have /* doesn't this mean that all children of this trans have
now their dims set and accordingly all those flags should now their dims set and accordingly all those flags should
be reset? Otherwise redodims will be called for them again? */ be reset? Otherwise redodims will be called for them again? */
PDLDEBUG_f(printf("make_physdims: calling redodims %p on %p\n", PDLDEBUG_f(printf("make_physdims: calling redodims %p on %p\n",
(void*)(it->trans_parent),(void*)it)); trans,it));
REDODIMS(PDL_RETERROR, it->trans_parent); REDODIMS(PDL_RETERROR, trans);
/* why this one? will the old allocated data be freed correctly? */ /* why this one? will the old allocated data be freed correctly? */
if((c & PDL_PARENTDIMSCHANGED) && (it->state & PDL_ALLOCATED)) { if((c & PDL_PARENTDIMSCHANGED) && (it->state & PDL_ALLOCATED)) {
it->state &= ~PDL_ALLOCATED; it->state &= ~PDL_ALLOCATED;
} }
PDLDEBUG_f(printf("make_physdims exit %p\n",(void*)it)); PDLDEBUG_f(printf("make_physdims exit %p\n",(void*)it));
return PDL_err; return PDL_err;
} }
static inline pdl_error pdl_trans_flow_null_checks(pdl_trans *trans, int *ret) { static inline pdl_error pdl_trans_flow_null_checks(pdl_trans *trans, int *ret) {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
skipping to change at line 684 skipping to change at line 679
* Sets the parent and trans fields of the ndarrays correctly, * Sets the parent and trans fields of the ndarrays correctly,
* creating families and the like if necessary. * creating families and the like if necessary.
* Alternatively may just execute transformation * Alternatively may just execute transformation
* that would require families but is not dataflowed. * that would require families but is not dataflowed.
*/ */
pdl_error pdl_make_trans_mutual(pdl_trans *trans) pdl_error pdl_make_trans_mutual(pdl_trans *trans)
{ {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDLDEBUG_f(printf("make_trans_mutual %p\n",(void*)trans);pdl_dump_trans_fixspa ce(trans,3)); PDLDEBUG_f(printf("make_trans_mutual %p\n",(void*)trans);pdl_dump_trans_fixspa ce(trans,3));
pdl_transvtable *vtable = trans->vtable; pdl_transvtable *vtable = trans->vtable;
pdl **pdls = trans->pdls;
PDL_Indx i, npdls=vtable->npdls, nparents=vtable->nparents; PDL_Indx i, npdls=vtable->npdls, nparents=vtable->nparents;
PDL_Indx nchildren = npdls - nparents;
/* copy the converted outputs from the end-area to use as actual
outputs - cf type_coerce */
for (i=vtable->nparents; i<vtable->npdls; i++) pdls[i] = pdls[i+nchildren];
PDL_TR_CHKMAGIC(trans); PDL_TR_CHKMAGIC(trans);
int pfflag=0; int pfflag=0;
PDL_err = pdl_trans_flow_null_checks(trans, &pfflag); PDL_err = pdl_trans_flow_null_checks(trans, &pfflag);
if (PDL_err.error) { if (PDL_err.error) {
PDL_ACCUMERROR(PDL_err, pdl_trans_finaldestroy(trans)); PDL_ACCUMERROR(PDL_err, pdl_trans_finaldestroy(trans));
return PDL_err; return PDL_err;
} }
char dataflow = !!(pfflag || (trans->flags & PDL_ITRANS_DO_DATAFLOW_ANY)); char dataflow = !!(pfflag || (trans->flags & PDL_ITRANS_DO_DATAFLOW_ANY));
for(i=0; i<nparents; i++) { for(i=0; i<nparents; i++) {
pdl *parent = trans->pdls[i]; pdl *parent = pdls[i];
PDL_RETERROR(PDL_err, pdl__addchildtrans(parent,trans)); PDL_RETERROR(PDL_err, pdl__addchildtrans(parent,trans));
if (parent->state & PDL_DATAFLOW_F) trans->flags |= PDL_ITRANS_DO_DATAFLOW_F ; if (parent->state & PDL_DATAFLOW_F) trans->flags |= PDL_ITRANS_DO_DATAFLOW_F ;
} }
int wd[npdls]; int wd[npdls];
for(i=nparents; i<npdls; i++) { for(i=nparents; i<npdls; i++) {
pdl *child = trans->pdls[i]; pdl *child = pdls[i];
char isnull = !!(child->state & PDL_NOMYDIMS); char isnull = !!(child->state & PDL_NOMYDIMS);
wd[i]=(isnull ? PDL_PARENTDIMSCHANGED : PDL_PARENTDATACHANGED); wd[i]=(isnull ? PDL_PARENTDIMSCHANGED : PDL_PARENTDATACHANGED);
if (dataflow) { if (dataflow) {
/* This is because for "+=" (a = a + b) we must check for /* This is because for "+=" (a = a + b) we must check for
previous parent transformations and mutate if they exist previous parent transformations and mutate if they exist
if no dataflow. */ if no dataflow. */
child->state |= PDL_PARENTDIMSCHANGED | PDL_PARENTDATACHANGED; child->state |= PDL_PARENTDIMSCHANGED | PDL_PARENTDATACHANGED;
} }
if (dataflow || isnull) child->trans_parent = trans; if (dataflow || isnull) child->trans_parent = trans;
if (isnull) if (isnull)
child->state = (child->state & ~PDL_NOMYDIMS) | PDL_MYDIMS_TRANS; child->state = (child->state & ~PDL_NOMYDIMS) | PDL_MYDIMS_TRANS;
} }
if (!dataflow) if (!dataflow)
PDL_ACCUMERROR(PDL_err, pdl_destroytransform(trans,1,wd)); PDL_ACCUMERROR(PDL_err, pdl_destroytransform(trans,1,wd,0));
PDLDEBUG_f(printf("make_trans_mutual exit %p\n",(void*)trans)); PDLDEBUG_f(printf("make_trans_mutual exit %p\n",(void*)trans));
return PDL_err; return PDL_err;
} /* pdl_make_trans_mutual() */ } /* pdl_make_trans_mutual() */
pdl_error pdl_redodims_default(pdl_trans *trans) { pdl_error pdl_redodims_default(pdl_trans *trans) {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDLDEBUG_f(printf("pdl_redodims_default ");pdl_dump_trans_fixspace(trans,0)); PDLDEBUG_f(printf("pdl_redodims_default ");pdl_dump_trans_fixspace(trans,0));
pdl_transvtable *vtable = trans->vtable; pdl_transvtable *vtable = trans->vtable;
PDL_Indx creating[vtable->npdls]; PDL_Indx creating[vtable->npdls];
pdl **pdls = trans->pdls; pdl **pdls = trans->pdls;
skipping to change at line 741 skipping to change at line 741
if (vtable->flags & PDL_TRANS_DO_BROADCAST) if (vtable->flags & PDL_TRANS_DO_BROADCAST)
PDL_RETERROR(PDL_err, pdl_initbroadcaststruct(2, pdls, PDL_RETERROR(PDL_err, pdl_initbroadcaststruct(2, pdls,
vtable->par_realdims, creating, vtable->npdls, vtable, vtable->par_realdims, creating, vtable->npdls, vtable,
&trans->broadcast, trans->ind_sizes, trans->inc_sizes, &trans->broadcast, trans->ind_sizes, trans->inc_sizes,
vtable->per_pdl_flags, vtable->flags & PDL_TRANS_NO_PARALLEL)); vtable->per_pdl_flags, vtable->flags & PDL_TRANS_NO_PARALLEL));
pdl_hdr_childcopy(trans); pdl_hdr_childcopy(trans);
trans->dims_redone = 1; trans->dims_redone = 1;
return PDL_err; return PDL_err;
} }
pdl_error pdl_make_physical(pdl *it) { pdl_error pdl__make_physical_recprotect(pdl *it, int recurse_count) {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
int i, vaffinepar=0; int i, vaffinepar=0;
DECL_RECURSE_GUARD; if(recurse_count > 1000)
return pdl_make_error_simple(PDL_EUSERERROR, "PDL:Internal Error: data
structure recursion limit exceeded (max 1000 levels)\n\tThis could mean that you
have found an infinite-recursion error in PDL, or\n\tthat you are building data
structures with very long dataflow dependency\n\tchains. You may want to try u
sing sever() to break the dependency.\n");
PDLDEBUG_f(printf("make_physical %p\n",(void*)it)); PDLDEBUG_f(printf("make_physical %p\n",(void*)it));
PDL_CHKMAGIC(it); PDL_CHKMAGIC(it);
START_RECURSE_GUARD;
if(it->state & PDL_ALLOCATED && !(it->state & PDL_ANYCHANGED)) { if(it->state & PDL_ALLOCATED && !(it->state & PDL_ANYCHANGED)) {
goto mkphys_end; goto mkphys_end;
} }
if(!(it->state & PDL_ANYCHANGED)) { if(!(it->state & PDL_ANYCHANGED)) {
PDL_RETERROR(PDL_err, pdl_allocdata(it)); PDL_RETERROR(PDL_err, pdl_allocdata(it));
goto mkphys_end; goto mkphys_end;
} }
if(!it->trans_parent) { if(!it->trans_parent) {
ABORT_RECURSE_GUARD;
return pdl_make_error_simple(PDL_EFATAL, "PDL Not physical but do esn't have parent"); return pdl_make_error_simple(PDL_EFATAL, "PDL Not physical but do esn't have parent");
} }
if(it->trans_parent->flags & PDL_ITRANS_ISAFFINE) { if(it->trans_parent->flags & PDL_ITRANS_ISAFFINE) {
if(!PDL_VAFFOK(it)) if(!PDL_VAFFOK(it))
PDL_RETERROR(PDL_err, pdl_make_physvaffine(it)); PDL_RETERROR(PDL_err, pdl__make_physvaffine_recprotect(it , recurse_count+1));
} }
if(PDL_VAFFOK(it)) { if(PDL_VAFFOK(it)) {
PDLDEBUG_f(printf("make_physical: VAFFOK\n")); PDLDEBUG_f(printf("make_physical: VAFFOK\n"));
PDL_RETERROR(PDL_err, pdl_readdata_vaffine(it)); PDL_RETERROR(PDL_err, pdl_readdata_vaffine(it));
it->state &= (~PDL_ANYCHANGED); it->state &= (~PDL_ANYCHANGED);
PDLDEBUG_f(pdl_dump(it)); PDLDEBUG_f(pdl_dump(it));
goto mkphys_end; goto mkphys_end;
} }
PDL_TR_CHKMAGIC(it->trans_parent); PDL_TR_CHKMAGIC(it->trans_parent);
for(i=0; i<it->trans_parent->vtable->nparents; i++) { for(i=0; i<it->trans_parent->vtable->nparents; i++) {
if(VAFFINE_FLAG_OK(it->trans_parent->vtable->per_pdl_flags,i)) { if(VAFFINE_FLAG_OK(it->trans_parent->vtable->per_pdl_flags,i)) {
PDL_RETERROR(PDL_err, pdl_make_physvaffine(it->trans_pare nt->pdls[i])); PDL_RETERROR(PDL_err, pdl__make_physvaffine_recprotect(it ->trans_parent->pdls[i], recurse_count+1));
/* check if any of the parents is a vaffine */ /* check if any of the parents is a vaffine */
vaffinepar = vaffinepar || (it->trans_parent->pdls[i]->d ata != PDL_REPRP(it->trans_parent->pdls[i])); vaffinepar = vaffinepar || (it->trans_parent->pdls[i]->d ata != PDL_REPRP(it->trans_parent->pdls[i]));
} else } else
PDL_RETERROR(PDL_err, pdl_make_physical(it->trans_parent- >pdls[i])); PDL_RETERROR(PDL_err, pdl__make_physical_recprotect(it->t rans_parent->pdls[i], recurse_count+1));
} }
/* XXX The real question is: why do we need another call to /* XXX The real question is: why do we need another call to
* redodims if !(it->state & PDL_ALLOCATED)?????? * redodims if !(it->state & PDL_ALLOCATED)??????
*/ */
if((!(it->state & PDL_ALLOCATED) && vaffinepar) || if((!(it->state & PDL_ALLOCATED) && vaffinepar) ||
it->state & PDL_PARENTDIMSCHANGED) it->state & PDL_PARENTDIMSCHANGED)
REDODIMS(PDL_RETERROR, it->trans_parent); REDODIMS(PDL_RETERROR, it->trans_parent);
if(!(it->state & PDL_ALLOCATED)) { if(!(it->state & PDL_ALLOCATED)) {
PDL_RETERROR(PDL_err, pdl_allocdata(it)); PDL_RETERROR(PDL_err, pdl_allocdata(it));
} }
READDATA(it->trans_parent); READDATA(it->trans_parent);
it->state &= ~(PDL_ANYCHANGED | PDL_OPT_ANY_OK); it->state &= ~(PDL_ANYCHANGED | PDL_OPT_ANY_OK);
mkphys_end: mkphys_end:
PDLDEBUG_f(printf("make_physical exit %p\n",(void*)it)); PDLDEBUG_f(printf("make_physical exit %p\n",(void*)it));
END_RECURSE_GUARD;
return PDL_err; return PDL_err;
} }
pdl_error pdl_make_physical(pdl *it) {
return pdl__make_physical_recprotect(it, 0);
}
pdl_error pdl_changed(pdl *it, int what, int recursing) pdl_error pdl_changed(pdl *it, int what, int recursing)
{ {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
int i; int j; int i; int j;
PDLDEBUG_f( PDLDEBUG_f(
printf("pdl_changed: entry for pdl %p recursing: %d, what ", printf("pdl_changed: entry for pdl %p recursing: %d, what ",
(void*)it,recursing); (void*)it,recursing);
pdl_dump_flags_fixspace(what,0,PDL_FLAGS_PDL); pdl_dump_flags_fixspace(what,0,PDL_FLAGS_PDL);
if (it->state & PDL_TRACEDEBUG) pdl_dump(it); if (it->state & PDL_TRACEDEBUG) pdl_dump(it);
); );
skipping to change at line 858 skipping to change at line 857
* "slice" and "diagonal"-type things supported. * "slice" and "diagonal"-type things supported.
* *
* We need to do careful testing for clump-type things. * We need to do careful testing for clump-type things.
*/ */
/* pdl_make_physvaffine can be called on *any* pdl -- vaffine or not -- /* pdl_make_physvaffine can be called on *any* pdl -- vaffine or not --
it will call make_physical as needed on those it will call make_physical as needed on those
this function is the right one to call in any case if you want to this function is the right one to call in any case if you want to
make only those physical (i.e. allocating their own data, etc) which make only those physical (i.e. allocating their own data, etc) which
have to be and leave those vaffine with updated dims, etc, that do have to be and leave those vaffine with updated dims, etc, that do
have an appropriate transformation of which they are a child have an appropriate transformation of which they are a child.
should probably have been called make_physcareful to point out what should probably have been called make_physcareful to point out what
it really does it really does
*/ */
pdl_error pdl_make_physvaffine(pdl *it) pdl_error pdl__make_physvaffine_recprotect(pdl *it, int recurse_count)
{ {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
pdl_trans *t; pdl_trans *t;
pdl *parent; pdl *parent;
pdl *current; pdl *current;
PDL_Indx i,j; PDL_Indx i,j;
PDL_Indx inc; PDL_Indx inc;
PDL_Indx newinc; PDL_Indx newinc;
PDL_Indx ninced; PDL_Indx ninced;
int flag; int flag;
int incsign; int incsign;
PDLDEBUG_f(printf("make_physvaffine %p\n",(void*)it)); PDLDEBUG_f(printf("make_physvaffine %p\n",(void*)it));
PDL_RETERROR(PDL_err, pdl_make_physdims(it)); PDL_RETERROR(PDL_err, pdl_make_physdims(it));
PDL_Indx incsleft[it->ndims]; PDL_Indx incsleft[it->ndims];
if(!it->trans_parent) { if(!it->trans_parent) {
PDL_RETERROR(PDL_err, pdl_make_physical(it)); PDL_RETERROR(PDL_err, pdl__make_physical_recprotect(it, recurse_c ount+1));
goto mkphys_vaff_end; goto mkphys_vaff_end;
} }
if(!(it->trans_parent->flags & PDL_ITRANS_ISAFFINE)) { if(!(it->trans_parent->flags & PDL_ITRANS_ISAFFINE)) {
PDL_RETERROR(PDL_err, pdl_make_physical(it)); PDL_RETERROR(PDL_err, pdl__make_physical_recprotect(it, recurse_c ount+1));
goto mkphys_vaff_end; goto mkphys_vaff_end;
} }
if (!it->vafftrans || it->vafftrans->ndims < it->ndims) if (!it->vafftrans || it->vafftrans->ndims < it->ndims)
PDL_RETERROR(PDL_err, pdl_vafftrans_alloc(it)); PDL_RETERROR(PDL_err, pdl_vafftrans_alloc(it));
for(i=0; i<it->ndims; i++) { for(i=0; i<it->ndims; i++) {
it->vafftrans->incs[i] = it->dimincs[i]; it->vafftrans->incs[i] = it->dimincs[i];
} }
flag=0; flag=0;
it->vafftrans->offs = 0; it->vafftrans->offs = 0;
t=it->trans_parent; t=it->trans_parent;
current = it; current = it;
while(t && (t->flags & PDL_ITRANS_ISAFFINE)) { while(t && (t->flags & PDL_ITRANS_ISAFFINE)) {
PDL_Indx cur_offset = 0; PDL_Indx cur_offset = 0;
if (!t->incs) if (!t->incs)
return pdl_make_error_simple(PDL_EUSERERROR, "pdl_make_physvaff ine: affine trans has NULL incs\n"); return pdl_make_error_simple(PDL_EUSERERROR, "pdl_make_physvaff ine: affine trans has NULL incs\n");
parent = t->pdls[0]; parent = t->pdls[0];
/* For all dimensions of the childest ndarray */ /* For all dimensions of the childest ndarray */
for(i=0; i<it->ndims; i++) { for(i=0; i<it->ndims; i++) {
PDL_Indx offset_left = it->vafftrans->offs; PDL_Indx offset_left = it->vafftrans->offs;
/* inc = the increment at the current stage */ /* inc = the increment at the current stage */
inc = it->vafftrans->incs[i]; inc = it->vafftrans->incs[i];
incsign = (inc >= 0 ? 1:-1); incsign = (inc >= 0 ? 1:-1);
inc *= incsign; inc *= incsign;
newinc = 0; newinc = 0;
/* For all dimensions of the current ndarray */ /* For all dimensions of the current ndarray */
for(j=current->ndims-1; j>=0 && current->dimincs[j] != 0; j--) { for(j=current->ndims-1; j>=0 && current->dimincs[j] != 0; j--) {
cur_offset = offset_left / current->dimincs[j]; cur_offset = offset_left / current->dimincs[j];
offset_left -= cur_offset * current->dimincs[j]; offset_left -= cur_offset * current->dimincs[j];
if(incsign < 0) { if(incsign < 0) {
skipping to change at line 956 skipping to change at line 947
*/ */
} }
} }
} }
newinc += t->incs[j]*ninced; newinc += t->incs[j]*ninced;
inc %= current->dimincs[j]; inc %= current->dimincs[j];
} }
} }
incsleft[i] = incsign*newinc; incsleft[i] = incsign*newinc;
} }
if(flag) break; if(flag) break;
for(i=0; i<it->ndims; i++) { for(i=0; i<it->ndims; i++) {
it->vafftrans->incs[i] = incsleft[i]; it->vafftrans->incs[i] = incsleft[i];
} }
{ {
PDL_Indx offset_left = it->vafftrans->offs; PDL_Indx offset_left = it->vafftrans->offs;
inc = it->vafftrans->offs; inc = it->vafftrans->offs;
newinc = 0; newinc = 0;
for(j=current->ndims-1; j>=0 && current->dimincs[j] != 0; j--) { for(j=current->ndims-1; j>=0 && current->dimincs[j] != 0; j--) {
cur_offset = offset_left / current->dimincs[j]; cur_offset = offset_left / current->dimincs[j];
skipping to change at line 978 skipping to change at line 968
newinc += t->incs[j]*cur_offset; newinc += t->incs[j]*cur_offset;
} }
it->vafftrans->offs = newinc; it->vafftrans->offs = newinc;
it->vafftrans->offs += t->offs; it->vafftrans->offs += t->offs;
} }
t = parent->trans_parent; t = parent->trans_parent;
current = parent; current = parent;
} }
it->vafftrans->from = current; it->vafftrans->from = current;
it->state |= PDL_OPT_VAFFTRANSOK; it->state |= PDL_OPT_VAFFTRANSOK;
PDL_RETERROR(PDL_err, pdl_make_physical(current)); PDL_RETERROR(PDL_err, pdl__make_physical_recprotect(current, recurse_coun
t+1));
mkphys_vaff_end: mkphys_vaff_end:
PDLDEBUG_f(printf("make_physvaffine exit %p\n",(void*)it)); PDLDEBUG_f(printf("make_physvaffine exit %p\n",(void*)it));
return PDL_err; return PDL_err;
} }
pdl_error pdl_make_physvaffine(pdl *it)
{
return pdl__make_physvaffine_recprotect(it, 0);
}
pdl_error pdl_set_datatype(pdl *a, int datatype) pdl_error pdl_set_datatype(pdl *a, int datatype)
{ {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDL_RETERROR(PDL_err, pdl_make_physical(a)); PDL_RETERROR(PDL_err, pdl_make_physical(a));
if(a->trans_parent) if(a->trans_parent)
PDL_RETERROR(PDL_err, pdl_destroytransform(a->trans_parent,1,NULL)); PDL_RETERROR(PDL_err, pdl_destroytransform(a->trans_parent,1,NULL,0));
if (a->state & PDL_NOMYDIMS) if (a->state & PDL_NOMYDIMS)
a->datatype = datatype; a->datatype = datatype;
else else
PDL_RETERROR(PDL_err, pdl_converttype( a, datatype )); PDL_RETERROR(PDL_err, pdl_converttype( a, datatype ));
return PDL_err; return PDL_err;
} }
pdl_error pdl_sever(pdl *src) pdl_error pdl_sever(pdl *src)
{ {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
if (!src->trans_parent) return PDL_err; if (!src->trans_parent) return PDL_err;
PDL_RETERROR(PDL_err, pdl_make_physvaffine(src)); PDL_RETERROR(PDL_err, pdl_make_physvaffine(src));
PDL_RETERROR(PDL_err, pdl_destroytransform(src->trans_parent,1,NULL)); PDL_RETERROR(PDL_err, pdl_destroytransform(src->trans_parent,1,NULL,0));
return PDL_err; return PDL_err;
} }
#define PDL_MAYBE_PROPAGATE_BADFLAG(t, newval) \
for( i = 0; i < (t)->vtable->npdls; i++ ) { \
pdl *tpdl = (t)->pdls[i]; \
/* make sure we propagate if changed */ \
if (!!newval != !!(tpdl->state & PDL_BADVAL)) \
pdl_propagate_badflag( tpdl, newval ); \
}
/* newval = 1 means set flag, 0 means clear it */ /* newval = 1 means set flag, 0 means clear it */
void pdl_propagate_badflag( pdl *it, int newval ) { void pdl_propagate_badflag( pdl *it, int newval ) {
PDLDEBUG_f(printf("pdl_propagate_badflag pdl=%p newval=%d\n", it, newval));
PDL_Indx i;
if (newval)
it->state |= PDL_BADVAL;
else
it->state &= ~PDL_BADVAL;
if (it->trans_parent)
PDL_MAYBE_PROPAGATE_BADFLAG(it->trans_parent, newval)
PDL_DECL_CHILDLOOP(it) PDL_DECL_CHILDLOOP(it)
PDL_START_CHILDLOOP(it) PDL_START_CHILDLOOP(it)
pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it); pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it);
PDL_Indx i; trans->bvalflag = !!newval;
for( i = trans->vtable->nparents; i < trans->vtable->npdls; i++ ) { PDL_MAYBE_PROPAGATE_BADFLAG(trans, newval)
pdl *child = trans->pdls[i];
char need_recurse = (!!newval != !!(child->state & PDL_BADVAL));
if ( newval ) {
child->state |= PDL_BADVAL;
} else {
child->state &= ~PDL_BADVAL;
}
/* make sure we propagate to grandchildren, etc if changed */
if (need_recurse)
pdl_propagate_badflag( child, newval );
} /* for: i */
PDL_END_CHILDLOOP(it) PDL_END_CHILDLOOP(it)
} /* pdl_propagate_badflag */ }
void pdl_propagate_badvalue( pdl *it ) { void pdl_propagate_badvalue( pdl *it ) {
PDL_DECL_CHILDLOOP(it) PDL_DECL_CHILDLOOP(it)
PDL_START_CHILDLOOP(it) PDL_START_CHILDLOOP(it)
pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it); pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it);
PDL_Indx i; PDL_Indx i;
for( i = trans->vtable->nparents; i < trans->vtable->npdls; i++ ) { for( i = trans->vtable->nparents; i < trans->vtable->npdls; i++ ) {
pdl *child = trans->pdls[i]; pdl *child = trans->pdls[i];
child->has_badvalue = 1; child->has_badvalue = 1;
child->badvalue = it->badvalue; child->badvalue = it->badvalue;
skipping to change at line 1057 skipping to change at line 1056
PDL_GENERICSWITCH(PDL_TYPELIST2_ALL, datatype, X, return retval) PDL_GENERICSWITCH(PDL_TYPELIST2_ALL, datatype, X, return retval)
#undef X #undef X
return retval; return retval;
} }
PDL_Anyval pdl_get_pdl_badvalue( pdl *it ) { PDL_Anyval pdl_get_pdl_badvalue( pdl *it ) {
return it->has_badvalue ? it->badvalue : pdl_get_badvalue( it->datatype ); return it->has_badvalue ? it->badvalue : pdl_get_badvalue( it->datatype );
} }
pdl_trans *pdl_create_trans(pdl_transvtable *vtable) { pdl_trans *pdl_create_trans(pdl_transvtable *vtable) {
size_t it_sz = sizeof(pdl_trans)+sizeof(pdl *)*vtable->npdls; size_t it_sz = sizeof(pdl_trans)+sizeof(pdl *)*(
vtable->npdls + (vtable->npdls - vtable->nparents) /* outputs twice */
);
pdl_trans *it = malloc(it_sz); pdl_trans *it = malloc(it_sz);
if (!it) return it; if (!it) return it;
memset(it, 0, it_sz); memset(it, 0, it_sz);
PDL_TR_SETMAGIC(it); PDL_TR_SETMAGIC(it);
if (vtable->structsize) { if (vtable->structsize) {
it->params = malloc(vtable->structsize); it->params = malloc(vtable->structsize);
if (!it->params) return NULL; if (!it->params) return NULL;
memset(it->params, 0, vtable->structsize); memset(it->params, 0, vtable->structsize);
} }
it->flags = vtable->iflags; it->flags = vtable->iflags;
skipping to change at line 1092 skipping to change at line 1093
it->__datatype = PDL_INVALID; it->__datatype = PDL_INVALID;
return it; return it;
} }
pdl_error pdl_type_coerce(pdl_trans *trans) { pdl_error pdl_type_coerce(pdl_trans *trans) {
pdl_error PDL_err = {0, NULL, 0}; pdl_error PDL_err = {0, NULL, 0};
PDL_Indx i; PDL_Indx i;
pdl_transvtable *vtable = trans->vtable; pdl_transvtable *vtable = trans->vtable;
pdl **pdls = trans->pdls; pdl **pdls = trans->pdls;
trans->__datatype = -1; trans->__datatype = -1;
char parent_has_badvalue = 0; char p2child_has_badvalue = (vtable->npdls == 2 && pdls[0]->has_badvalue
PDL_Anyval parent_badvalue = {PDL_INVALID, {0}}; && (vtable->par_flags[1] & PDL_PARAM_ISCREATEALWAYS));
if (vtable->npdls == 2 && pdls[0]->has_badvalue PDL_Anyval parent_badvalue = p2child_has_badvalue ? pdls[0]->badvalue : (PDL_A
&& (vtable->par_flags[1] & PDL_PARAM_ISCREATEALWAYS)) { nyval){PDL_INVALID, {0}};
/* P2Child case */ PDL_Indx nchildren = vtable->npdls - vtable->nparents;
parent_has_badvalue = 1; /* copy the "real" (passed-in) outputs to the end-area to use as actual
parent_badvalue = pdls[0]->badvalue; outputs, possibly after being converted, leaving the passed-in ones
} alone to be picked up for use in CopyBadStatusCode */
for (i=vtable->nparents; i<vtable->npdls; i++) pdls[i+nchildren] = pdls[i];
for (i=0; i<vtable->npdls; i++) { for (i=0; i<vtable->npdls; i++) {
pdl *pdl = pdls[i]; pdl *pdl = pdls[i];
short flags = vtable->par_flags[i]; short flags = vtable->par_flags[i];
if (flags & (PDL_PARAM_ISIGNORE|PDL_PARAM_ISTYPED|PDL_PARAM_ISCREATEALWAYS)) if (flags & (PDL_PARAM_ISIGNORE|PDL_PARAM_ISTYPED|PDL_PARAM_ISCREATEALWAYS))
continue; continue;
if (trans->__datatype < pdl->datatype && ( if (trans->__datatype < pdl->datatype && (
!(flags & PDL_PARAM_ISCREAT) || !(flags & PDL_PARAM_ISCREAT) ||
((flags & PDL_PARAM_ISCREAT) && !((pdl->state & PDL_NOMYDIMS) && pdl->tran s_parent == NULL)) ((flags & PDL_PARAM_ISCREAT) && !((pdl->state & PDL_NOMYDIMS) && pdl->tran s_parent == NULL))
)) ))
trans->__datatype = pdl->datatype; trans->__datatype = pdl->datatype;
skipping to change at line 1135 skipping to change at line 1136
if (flags & PDL_PARAM_ISTYPED) { if (flags & PDL_PARAM_ISTYPED) {
new_dtype = vtable->par_types[i]; new_dtype = vtable->par_types[i];
if (flags & PDL_PARAM_ISTPLUS) new_dtype = PDLMAX(new_dtype, trans_dtype); if (flags & PDL_PARAM_ISTPLUS) new_dtype = PDLMAX(new_dtype, trans_dtype);
} else if (flags & PDL_PARAM_ISREAL) { } else if (flags & PDL_PARAM_ISREAL) {
if (trans_dtype >= PDL_CF) new_dtype = trans_dtype - (PDL_CF - PDL_F); if (trans_dtype >= PDL_CF) new_dtype = trans_dtype - (PDL_CF - PDL_F);
} else if (flags & PDL_PARAM_ISCOMPLEX) { } else if (flags & PDL_PARAM_ISCOMPLEX) {
if (trans_dtype < PDL_CF) new_dtype = PDLMAX(PDL_CF, trans_dtype + (PDL_CF - PDL_F)); if (trans_dtype < PDL_CF) new_dtype = PDLMAX(PDL_CF, trans_dtype + (PDL_CF - PDL_F));
} }
if ((pdl->state & PDL_NOMYDIMS) && (!pdl->trans_parent || pdl->trans_parent == trans)) { if ((pdl->state & PDL_NOMYDIMS) && (!pdl->trans_parent || pdl->trans_parent == trans)) {
pdl->badvalue = parent_badvalue; pdl->badvalue = parent_badvalue;
pdl->has_badvalue = parent_has_badvalue; pdl->has_badvalue = p2child_has_badvalue;
pdl->datatype = new_dtype; pdl->datatype = new_dtype;
} else if (new_dtype != pdl->datatype) { } else if (new_dtype != pdl->datatype) {
PDLDEBUG_f(printf("pdl_type_coerce (%s) pdl=%"IND_FLAG" from %d to %d\n", vtable->name, i, pdl->datatype, new_dtype)); PDLDEBUG_f(printf("pdl_type_coerce (%s) pdl=%"IND_FLAG" from %d to %d\n", vtable->name, i, pdl->datatype, new_dtype));
pdl = pdl_get_convertedpdl(pdl, new_dtype); pdl = pdl_get_convertedpdl(pdl, new_dtype);
if (!pdl) if (!pdl)
return pdl_make_error(PDL_EFATAL, "%s got NULL pointer from get_converte dpdl on param %s", vtable->name, vtable->par_names[i]); return pdl_make_error(PDL_EFATAL, "%s got NULL pointer from get_converte dpdl on param %s", vtable->name, vtable->par_names[i]);
if (pdl->datatype != new_dtype) if (pdl->datatype != new_dtype)
return pdl_make_error_simple(PDL_EFATAL, "type not expected value after get_convertedpdl\n"); return pdl_make_error_simple(PDL_EFATAL, "type not expected value after get_convertedpdl\n");
pdls[i] = pdl; /* if type-convert output, put in end-area */
pdls[i + (i >= vtable->nparents ? nchildren : 0)] = pdl;
} }
} }
return PDL_err; return PDL_err;
} }
char pdl_trans_badflag_from_inputs(pdl_trans *trans) { char pdl_trans_badflag_from_inputs(pdl_trans *trans) {
PDL_Indx i; PDL_Indx i;
pdl_transvtable *vtable = trans->vtable; pdl_transvtable *vtable = trans->vtable;
pdl **pdls = trans->pdls; pdl **pdls = trans->pdls;
char retval = 0; char retval = 0;
 End of changes. 77 change blocks. 
117 lines changed or deleted 129 lines changed or added

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