PDLA
view release on metacpan or search on metacpan
Basic/Core/pdlapi.c view on Meta::CPAN
*/
/* This define causes the affine transformations not to be
* optimized away so $a->slice(...) will always made physical.
* Uncommenting this define is not recommended at the moment
*/
/* #define DONT_OPTIMIZE
* #define DONT_VAFFINE
*/
extern Core PDLA;
void pdl__ensure_trans(pdl_trans *trans,int what) ;
static int has_children(pdl *it) {
PDLA_DECL_CHILDLOOP(it)
PDLA_START_CHILDLOOP(it)
return 1;
PDLA_END_CHILDLOOP(it)
return 0;
}
static int is_child_of(pdl *it,pdl_trans *trans) {
int i;
for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
if(trans->pdls[i] == it) return 1;
}
return 0;
}
static int is_parent_of(pdl *it,pdl_trans *trans) {
int i;
for(i=0; i<trans->vtable->nparents; i++) {
if(trans->pdls[i] == it) return 1;
}
return 0;
}
pdl *pdl_null() {
PDLA_Indx d[1] = {0};
pdl *it = pdl_new();
pdl_makescratchhash(it,0.0,PDLA_B);
pdl_setdims(it,d,1);
it->state |= PDLA_NOMYDIMS;
return it;
}
pdl *pdl_get_convertedpdl(pdl *old,int type) {
if(old->datatype != type) {
pdl *it;
it = pdl_null();
PDLA.converttypei_new(old,it,type);
if(it->datatype != type) { croak("FOOBAR! HELP!\n"); }
return it;
} else {
return old;
}
}
void pdl_allocdata(pdl *it) {
int i;
PDLA_Indx nvals=1;
SV *bar;
for(i=0; i<it->ndims; i++) {
nvals *= it->dims[i];
}
it->nvals = nvals;
PDLADEBUG_f(printf("pdl_allocdata %p, %"IND_FLAG", %d\n",(void*)it, it->nvals,
it->datatype));
pdl_grow(it,nvals);
PDLADEBUG_f(pdl_dump(it));
it->state |= PDLA_ALLOCATED;
}
/* Wrapper to pdl_create so that the pdl_new and pdl_tmp functions
can be stored in the Core struct and exported to external
PDLA XS modules */
pdl* pdl_external_new() {
return pdl_new();
}
pdl* pdl_external_tmp() {
return pdl_tmp();
}
/* Return a new pdl - type is PDLA_PERM or PDLA_TMP - the latter is auto-freed
* when current perl context is left
*
* pdl_new() and pdl_tmp() are macroes defined in pdlcore.h
* which just call this routine.
*/
pdl* pdl_create(int type) {
int i;
pdl* it;
if(type == PDLA_TMP) {croak("PDLA internal error. FIX!\n");}
it = (pdl*) malloc(sizeof(pdl));
if (it==NULL)
croak("Out of Memory\n");
it->magicno = PDLA_MAGICNO;
it->state = 0;
it->datatype = 0;
it->trans = NULL;
it->vafftrans = NULL;
it->sv = NULL;
it->datasv = 0;
it->data = 0;
it->has_badvalue = 0;
it->dims = it->def_dims;
it->dimincs = it->def_dimincs;
it->ndims = 0;
it->nthreadids = 0;
it->threadids = it->def_threadids;
it->threadids[0] = 0;
for(i=0; i<PDLA_NCHILDREN; i++) {it->children.trans[i]=NULL;}
it->children.next = NULL;
it->magic = 0;
it->hdrsv = 0;
PDLADEBUG_f(printf("CREATE %p\n",(void*)it));
Basic/Core/pdlapi.c view on Meta::CPAN
if(nback2 > 0) goto soft_destroy;
if(nback > 1) goto soft_destroy;
/* Also not here */
if(it->trans && nforw) goto soft_destroy;
/* Also, we do not wish to destroy if the children would be larger
* than the parent and are currently not allocated (e.g. lags).
* Because this is too much work to check, we refrain from destroying
* for now if there is an affine child that is not allocated
*/
if(nafn) goto soft_destroy;
if(pdl__magic_isundestroyable(it)) {
PDLADEBUG_f(printf("Magic, not Destr. %p\n",(void*)it);)
goto soft_destroy;
}
pdl__destroy_childtranses(it,1);
if(it->trans) {
PDLADEBUG_f(printf("Destr_trans. %p %d\n",(void*)(it->trans), it->trans->flags);)
/* Ensure only if there are other children! */
/* XXX Bad: tmp! */
if (it->trans->flags & PDLA_ITRANS_NONMUTUAL)
pdl_destroytransform_nonmutual(it->trans,(it->trans->vtable->npdls
- it->trans->vtable->nparents > 1));
else
pdl_destroytransform(it->trans,(it->trans->vtable->npdls
- it->trans->vtable->nparents > 1));
}
/* Here, this is a child but has no children */
goto hard_destroy;
hard_destroy:
pdl__free(it);
PDLADEBUG_f(printf("End destroy %p\n",(void*)it);)
return;
soft_destroy:
PDLADEBUG_f(printf("May have dependencies, not destr. %p, nu(%d, %d), nba(%d, %d), nforw(%d), tra(%p), nafn(%d)\n",
(void*)it, nundest, nundestp, nback, nback2, nforw, (void*)(it->trans), nafn);)
it->state &= ~PDLA_DESTROYING;
}
/* Straight copy, no dataflow */
pdl *pdl_hard_copy(pdl *src) {
int i;
pdl *it = pdl_null();
it->state = 0;
pdl_make_physical(src); /* Wasteful XXX... should be lazier */
it->datatype = src->datatype;
pdl_setdims(it,src->dims,src->ndims);
pdl_allocdata(it);
/* null != [0] */
#ifdef ELIFSLEFJSEFSE
if(src->ndims == 1 && src->dims[0] == 0)
#else
if(src->state & PDLA_NOMYDIMS)
#endif
it->state |= PDLA_NOMYDIMS;
pdl_reallocthreadids(it,src->nthreadids);
for(i=0; i<src->nthreadids; i++) {
it->threadids[i] = src->threadids[i];
}
memcpy(it->data,src->data, pdl_howbig(it->datatype) * it->nvals);
return it;
}
/* some constants for the dump_XXX routines */
#define PDLA_FLAGS_TRANS 0
#define PDLA_FLAGS_PDLA 1
#define PDLA_MAXSPACE 256 /* maximal number of prefix spaces in dump routines */
#define PDLA_MAXLIN 60
void pdl_dump_flags_fixspace(int flags, int nspac, int type)
{
int i;
int len, found, sz;
int pdlflagval[] = {
PDLA_ALLOCATED,PDLA_PARENTDATACHANGED,
PDLA_PARENTDIMSCHANGED,PDLA_PARENTREPRCHANGED,
PDLA_DATAFLOW_F,PDLA_DATAFLOW_B,PDLA_NOMYDIMS,
PDLA_OPT_VAFFTRANSOK,PDLA_INPLACE,PDLA_DESTROYING,
PDLA_DONTTOUCHDATA, PDLA_MYDIMS_TRANS, PDLA_HDRCPY,
PDLA_BADVAL, PDLA_TRACEDEBUG, 0
};
char *pdlflagchar[] = {
"ALLOCATED","PARENTDATACHANGED",
"PARENTDIMSCHANGED","PARENTREPRCHANGED",
"DATAFLOW_F","DATAFLOW_B","NOMYDIMS",
"OPT_VAFFTRANSOK","INPLACE","DESTROYING",
"DONTTOUCHDATA","MYDIMS_TRANS", "HDRCPY",
"BADVAL", "TRACEDEBUG"
};
int transflagval[] = {
PDLA_ITRANS_REVERSIBLE, PDLA_ITRANS_DO_DATAFLOW_F,
PDLA_ITRANS_DO_DATAFLOW_B,
PDLA_ITRANS_ISAFFINE, PDLA_ITRANS_VAFFINEVALID,
PDLA_ITRANS_NONMUTUAL, 0
};
char *transflagchar[] = {
"REVERSIBLE", "DO_DATAFLOW_F",
"DO_DATAFLOW_B",
"ISAFFINE", "VAFFINEVALID",
"NONMUTUAL"
Basic/Core/pdlapi.c view on Meta::CPAN
/* Reallocate this PDLA to have ndims dimensions. The previous dims
are copied. */
void pdl_reallocdims(pdl *it,int ndims) {
int i;
if (it->ndims < ndims) { /* Need to realloc for more */
if(it->dims != it->def_dims) free(it->dims);
if(it->dimincs != it->def_dimincs) free(it->dimincs);
if (ndims>PDLA_NDIMS) { /* Need to malloc */
it->dims = malloc(ndims*sizeof(*(it->dims)));
it->dimincs = malloc(ndims*sizeof(*(it->dimincs)));
if (it->dims==NULL || it->dimincs==NULL)
croak("Out of Memory\n");
}
else {
it->dims = it->def_dims;
it->dimincs = it->def_dimincs;
}
}
it->ndims = ndims;
}
/* Reallocate n threadids. Set the new extra ones to the end */
/* XXX Check logic */
void pdl_reallocthreadids(pdl *it,int n) {
int i;
unsigned char *olds; int nold;
if(n <= it->nthreadids) {
it->nthreadids = n; it->threadids[n] = it->ndims; return;
}
nold = it->nthreadids; olds = it->threadids;
if(n >= PDLA_NTHREADIDS-1) {
it->threadids = malloc(sizeof(*(it->threadids))*(n+1));
} else {
/* already is default */
}
it->nthreadids = n;
if(it->threadids != olds) {
for(i=0; i<nold && i<n; i++)
it->threadids[i] = olds[i];
}
if(olds != it->def_threadids) { free(olds); }
for(i=nold; i<it->nthreadids; i++) {
it->threadids[i] = it->ndims;
}
}
/* Calculate default increments and grow the PDLA data */
void pdl_resize_defaultincs(pdl *it) {
PDLA_Indx inc = 1;
int i=0;
for(i=0; i<it->ndims; i++) {
it->dimincs[i] = inc; inc *= it->dims[i];
}
it->nvals = inc;
it->state &= ~PDLA_ALLOCATED; /* Need to realloc when phys */
#ifdef DONT_OPTIMIZE
pdl_allocdata(it);
#endif
}
/* Init dims & incs - if *incs is NULL ignored (but space is always same for both) */
void pdl_setdims(pdl* it, PDLA_Indx * dims, int ndims) {
int i;
pdl_reallocdims(it,ndims);
for(i=0; i<ndims; i++)
it->dims[i] = dims[i];
pdl_resize_defaultincs(it);
pdl_reallocthreadids(it,0); /* XXX Maybe trouble */
}
/* This is *not* careful! */
void pdl_setdims_careful(pdl *it)
{
pdl_resize_defaultincs(it);
#ifdef DONT_OPTIMIZE
pdl_allocdata(it);
#endif
pdl_reallocthreadids(it,0); /* XXX For now */
}
void pdl_print(pdl *it) {
#ifdef FOO
int i;
printf("PDLA %d: sv = %d, data = %d, datatype = %d, nvals = %d, ndims = %d\n",
(int)it, (int)(it->hash), (int)(it->data), it->datatype, it->nvals, it->ndims);
printf("Dims: ");
for(i=0; i<it->ndims; i++) {
printf("%d(%d) ",it->dims[i],it->dimincs[i]);
}
printf("\n");
#endif
}
/* pdl_get is now vaffine aware */
PDLA_Anyval pdl_get(pdl *it,PDLA_Indx *inds) {
int i;
PDLA_Indx *incs;
PDLA_Indx offs=PDLA_REPROFFS(it);
incs = PDLA_VAFFOK(it) ? it->vafftrans->incs : it->dimincs;
for(i=0; i<it->ndims; i++)
offs += incs[i] * inds[i];
return pdl_get_offs(PDLA_REPRP(it),offs);
}
PDLA_Anyval pdl_get_offs(pdl *it, PDLA_Indx offs) {
PDLA_Indx dummy1=offs+1; PDLA_Indx dummy2=1;
return pdl_at(it->data, it->datatype, &offs, &dummy1, &dummy2, 0, 1);
}
void pdl_put_offs(pdl *it, PDLA_Indx offs, PDLA_Anyval value) {
PDLA_Indx dummy1=offs+1; PDLA_Indx dummy2=1;
pdl_set(it->data, it->datatype, &offs, &dummy1, &dummy2, 0, 1, value);
}
void pdl__addchildtrans(pdl *it,pdl_trans *trans,int nth)
{
int i; pdl_children *c;
trans->pdls[nth] = it;
c = &it->children;
do {
for(i=0; i<PDLA_NCHILDREN; i++) {
if(! c->trans[i]) {
c->trans[i] = trans; return;
}
}
if(!c->next) break;
c=c->next;
} while(1) ;
c->next = malloc(sizeof(pdl_children));
c->next->trans[0] = trans;
for(i=1; i<PDLA_NCHILDREN; i++)
c->next->trans[i] = 0;
c->next->next = 0;
}
Basic/Core/pdlapi.c view on Meta::CPAN
*/
pdl__ensure_trans(trans,PDLA_PARENTDIMSCHANGED); /* XXX Why? */
/* Es ist vollbracht */
for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
#ifndef DONT_VAFFINE
if( PDLA_VAFFOK(trans->pdls[i]) &&
(trans->vtable->per_pdl_flags[i] & PDLA_TPDLA_VAFFINE_OK) ) {
if(wd[i] & PDLA_PARENTDIMSCHANGED)
pdl_changed(trans->pdls[i],
PDLA_PARENTDIMSCHANGED,0);
pdl_vaffinechanged(
trans->pdls[i],PDLA_PARENTDATACHANGED);
} else
#endif
pdl_changed(trans->pdls[i],wd[i],0);
}
pdl_destroytransform_nonmutual(trans,0);
free(wd);
} else { /* do the full flowing transform */
PDLADEBUG_f(printf("make_trans_mutual flowing!\n"));
for(i=0; i<trans->vtable->nparents; i++)
pdl_set_trans_childtrans(trans->pdls[i],trans,i);
for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++)
pdl_set_trans_parenttrans(trans->pdls[i],trans,i);
if(!(trans->flags & PDLA_ITRANS_REVERSIBLE))
trans->flags &= ~PDLA_ITRANS_DO_DATAFLOW_B;
for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
if(trans->pdls[i]->state & PDLA_NOMYDIMS) {
trans->pdls[i]->state &= ~PDLA_NOMYDIMS;
trans->pdls[i]->state |= PDLA_MYDIMS_TRANS;
}
}
}
#ifdef FOO
/* If we are not flowing, we must disappear */
if(!(trans->flags & PDLA_ITRANS_DO_DATAFLOW_ANY)) {
pdl_destroytransform(trans,1);
}
#endif
PDLADEBUG_f(printf("make_trans_mutual_exit %p\n",(void*)trans));
} /* pdl_make_trans_mutual() */
void pdl_make_physical(pdl *it) {
int i, vaffinepar=0;
DECL_RECURSE_GUARD;
PDLADEBUG_f(printf("Make_physical %p\n",(void*)it));
PDLA_CHKMAGIC(it);
START_RECURSE_GUARD;
if(it->state & PDLA_ALLOCATED && !(it->state & PDLA_ANYCHANGED)) {
goto mkphys_end;
}
if(!(it->state & PDLA_ANYCHANGED)) {
pdl_allocdata(it);
goto mkphys_end;
}
if(!it->trans) {
ABORT_RECURSE_GUARD;
die("PDLA Not physical but doesn't have parent");
}
#ifndef DONT_OPTIMIZE
#ifndef DONT_VAFFINE
if(it->trans->flags & PDLA_ITRANS_ISAFFINE) {
if(!PDLA_VAFFOK(it))
pdl_make_physvaffine(it);
}
if(PDLA_VAFFOK(it)) {
PDLADEBUG_f(printf("Make_phys: VAFFOK\n"));
pdl_readdata_vaffine(it);
it->state &= (~PDLA_ANYCHANGED);
PDLADEBUG_f(pdl_dump(it));
goto mkphys_end;
}
#endif
#endif
PDLA_TR_CHKMAGIC(it->trans);
for(i=0; i<it->trans->vtable->nparents; i++) {
#ifndef DONT_OPTIMIZE
#ifndef DONT_VAFFINE
if(it->trans->vtable->per_pdl_flags[i] &
PDLA_TPDLA_VAFFINE_OK) {
pdl_make_physvaffine(it->trans->pdls[i]);
/* check if any of the parents is a vaffine */
vaffinepar = vaffinepar || (it->trans->pdls[i]->data != PDLA_REPRP(it->trans->pdls[i]));
}
else
#endif
#endif
pdl_make_physical(it->trans->pdls[i]);
}
/* the next one is really strange:
*
* why do we need to call redodims if !(it->state & PDLA_ALLOCATED) ???
* this results in a) redodims called twice if make_physdims had already been
* called for this piddle and results in associated memory leaks!
* On the other hand, if I comment out !(it->state & PDLA_ALLOCATED)
* then we get errors for cases like
* $in = $lut->xchg(0,1)->index($im->dummy(0));
* $in .= pdl -5;
* Currently ugly fix: detect in initthreadstruct that it has been called before
* and free all pdl_thread related memory before reallocating
* NOTE: this does not catch leaks when additional memory was allocated from with
* redodims!!!!!
*
* The real question is: why do we need another call to
* redodims if !(it->state & PDLA_ALLOCATED)??????
* changed it so that redodims only called if
* (!(it->state & PDLA_ALLOCATED) && vaffinepar)
* i.e. at least one of the parent piddles is a real vaffine
* CS
*/
if((!(it->state & PDLA_ALLOCATED) && vaffinepar) ||
it->state & PDLA_PARENTDIMSCHANGED ||
it->state & PDLA_PARENTREPRCHANGED) {
it->trans->vtable->redodims(it->trans);
}
if(!(it->state & PDLA_ALLOCATED)) {
pdl_allocdata(it);
}
/* Make parents physical first. XXX Needs more reasonable way */
/* Already done
* for(i=0; i<it->trans->vtable->nparents; i++) {
* pdl_make_physical(it->trans->pdls[i]);
* }
*/
/*
* We think we made them physical or physvaffine already...
* for(i=0; i<it->trans->vtable->npdls; i++) {
* if(!(it->trans->pdls[i]->state & PDLA_ALLOCATED)) {
* croak("Trying to readdata without physicality");
* }
*}
*/
it->trans->vtable->readdata(it->trans);
it->state &= (~PDLA_ANYCHANGED) & (~PDLA_OPT_ANY_OK);
mkphys_end:
PDLADEBUG_f(printf("Make_physical_exit %p\n",(void*)it));
END_RECURSE_GUARD;
}
void pdl_children_changesoon_c(pdl *it,int what)
{
pdl_trans *t;
int i;
PDLA_DECL_CHILDLOOP(it);
PDLA_START_CHILDLOOP(it)
t = PDLA_CHILDLOOP_THISCHILD(it);
if(!(t->flags & PDLA_ITRANS_DO_DATAFLOW_F)) {
pdl_destroytransform(t,1);
} else {
for(i=t->vtable->nparents; i<t->vtable->npdls; i++) {
pdl_children_changesoon_c(t->pdls[i],what);
}
}
PDLA_END_CHILDLOOP(it)
}
/* Change soon: if this is not writeback, separate from
parent.
If the children of this are not writeback, separate them.
*/
void pdl_children_changesoon(pdl *it, int what)
{
pdl_children *c; int i;
if(it->trans &&
!(it->trans->flags & PDLA_ITRANS_DO_DATAFLOW_B)) {
pdl_destroytransform(it->trans,1);
} else if(it->trans) {
if(!(it->trans->flags & PDLA_ITRANS_REVERSIBLE)) {
die("PDLA: Internal error: Trying to reverse irreversible trans");
}
for(i=0; i<it->trans->vtable->nparents; i++)
pdl_children_changesoon(it->trans->pdls[i],what);
return;
}
pdl_children_changesoon_c(it,what);
( run in 0.625 second using v1.01-cache-2.11-cpan-39bf76dae61 )