diff --git a/Changes b/Changes index 0c9b0b3ca..f96702405 100644 --- a/Changes +++ b/Changes @@ -15,6 +15,7 @@ - Overload key added to PP (#519) - "usage" section of xform docs now automatically generated (#519) - overloaded operators now throw exception if given undef argument (#519) - thanks @cgtinney for report +- Core::dog now scales linearly with length of top dim, not O(n^2) (#421) - thank @djerius for report 2.098 2025-01-03 - fix Windows build problems diff --git a/lib/PDL/Core.xs b/lib/PDL/Core.xs index b2b58ea71..3535ac03b 100644 --- a/lib/PDL/Core.xs +++ b/lib/PDL/Core.xs @@ -374,14 +374,14 @@ trans_children(self) mXPUSHu(self->ntrans_children); else if (gimme == G_ARRAY) { EXTEND(SP, self->ntrans_children); - PDL_DECL_CHILDLOOP(self); - PDL_START_CHILDLOOP(self) - pdl_trans *t = PDL_CHILDLOOP_THISCHILD(self); + PDL_Indx i; + for (i = 0; i < self->ntrans_children_allocated; i++) { + pdl_trans *t = self->trans_children[i]; if (!t) continue; SV *sv = sv_newmortal(); sv_setref_pv(sv, "PDL::Trans", (void*)t); PUSHs(sv); - PDL_END_CHILDLOOP(self) + } } INCLUDE_COMMAND: $^X -e "require q{./Core/Dev.pm}; PDL::Core::Dev::generate_core_flags()" @@ -1339,6 +1339,7 @@ PPCODE: PDL_Indx *thesedims = x->dims, *theseincs = PDL_REPRINCS(x), ndimsm1 = x->ndims-1; PDL_Indx i, howmany = x->dims[ndimsm1], thisoffs = 0, topinc = x->dimincs[ndimsm1]; EXTEND(SP, howmany); + pdl_barf_if_error(pdl_prealloc_trans_children(x, x->ntrans_children_allocated + howmany)); for (i = 0; i < howmany; i++, thisoffs += topinc) { pdl *childpdl = pdl_pdlnew(); if (!childpdl) pdl_pdl_barf("Error making null pdl"); diff --git a/lib/PDL/Core/pdl.h.PL b/lib/PDL/Core/pdl.h.PL index 247a625b6..723f26cea 100644 --- a/lib/PDL/Core/pdl.h.PL +++ b/lib/PDL/Core/pdl.h.PL @@ -281,7 +281,7 @@ PDL_TYPELIST_ALL(X) */ #define PDL_NDIMS 6 /* Number of dims[] to preallocate */ -#define PDL_NCHILDREN 8 /* Number of trans_children ptrs to preallocate */ +#define PDL_NCHILDREN 6 /* Number of trans_children ptrs to preallocate */ #define PDL_NBROADCASTIDS 4 /* Number of different broadcastids/pdl to preallocate */ /* Constants for pdl.state - not all combinations make sense */ @@ -520,11 +520,6 @@ typedef struct pdl_vaffine { #define PDL_REPRP(pdl) (PDL_VAFFOK(pdl) ? pdl->vafftrans->from->data : pdl->data) -typedef struct pdl_trans_children { - pdl_trans *trans[PDL_NCHILDREN]; - struct pdl_trans_children *next; -} pdl_trans_children; - struct pdl_magic; /**************************************** @@ -578,7 +573,10 @@ struct pdl { PDL_Indx *broadcastids; /* Starting index of the broadcast index set n */ PDL_Indx nbroadcastids; - pdl_trans_children trans_children; + pdl_trans *def_trans_children[PDL_NCHILDREN]; + PDL_Indx ntrans_children_allocated; + PDL_Indx first_trans_child_available; + pdl_trans **trans_children; PDL_Indx def_dims[PDL_NDIMS]; /* Preallocated space for efficiency */ PDL_Indx def_dimincs[PDL_NDIMS]; /* Preallocated space for efficiency */ @@ -599,27 +597,6 @@ typedef struct pdl_slice_args { struct pdl_slice_args *next; /* NULL is last */ } pdl_slice_args; -/************* - * Some macros for looping over the trans_children of a given PDL - */ -#define PDL_DECL_CHILDLOOP(p) \ - int p##__i; pdl_trans_children *p##__c; PDL_Indx p##__unfound; -#define PDL_START_CHILDLOOP(p) \ - p##__c = &p->trans_children; p##__unfound = p->ntrans_children; \ - do { \ - if (p##__unfound <= 0) break; \ - for (p##__i=0; p##__itrans[p##__i]) { \ - p##__unfound--; -#define PDL_CHILDLOOP_THISCHILD(p) p##__c->trans[p##__i] -#define PDL_END_CHILDLOOP(p) \ - } \ - } \ - if (!p##__c) break; \ - if (!p##__c->next) break; \ - p##__c=p##__c->next; \ - } while (1); - #define PDL_USESTRUCTVALUE(it) \ (it->nbytes <= sizeof(it->value)) diff --git a/lib/PDL/Core/pdlapi.c b/lib/PDL/Core/pdlapi.c index ffca4ad26..a9b288941 100644 --- a/lib/PDL/Core/pdlapi.c +++ b/lib/PDL/Core/pdlapi.c @@ -218,9 +218,8 @@ pdl* pdl_pdlnew(void) { it->nbroadcastids = 1; it->broadcastids = it->def_broadcastids; it->broadcastids[0] = it->ndims = 1; - PDL_Indx i; - for (i=0; itrans_children.trans[i]=NULL;} - it->trans_children.next = NULL; + it->trans_children = it->def_trans_children; + it->ntrans_children_allocated = PDL_NCHILDREN; it->ntrans_children = 0; it->magic = 0; it->hdrsv = 0; @@ -260,16 +259,15 @@ pdl_error pdl_vafftrans_alloc(pdl *it) /* Recursive! */ void pdl_vafftrans_remove(pdl * it, char this_one) { - PDLDEBUG_f(printf("pdl_vafftrans_remove: %p, this_one=%d\n", it, (int)this_one)); - PDL_DECL_CHILDLOOP(it); - PDL_START_CHILDLOOP(it) - pdl_trans *t = PDL_CHILDLOOP_THISCHILD(it); - if (!(t->flags & PDL_ITRANS_ISAFFINE)) continue; - int i; - for (i=t->vtable->nparents; ivtable->npdls; i++) - pdl_vafftrans_remove(t->pdls[i], 1); - PDL_END_CHILDLOOP(it) - if (this_one) pdl_vafftrans_free(it); + PDLDEBUG_f(printf("pdl_vafftrans_remove: %p, this_one=%d\n", it, (int)this_one)); + PDL_Indx i, j; + for (i = 0; i < it->ntrans_children_allocated; i++) { + pdl_trans *t = it->trans_children[i]; + if (!t || !(t->flags & PDL_ITRANS_ISAFFINE)) continue; + for (j=t->vtable->nparents; jvtable->npdls; j++) + pdl_vafftrans_remove(t->pdls[j], 1); + } + if (this_one) pdl_vafftrans_free(it); } /* Explicit free. Do not use, use destroy instead, which causes this @@ -285,15 +283,10 @@ pdl_error pdl__free(pdl *it) { if (it->dims != it->def_dims) free(it->dims); if (it->dimincs != it->def_dimincs) free(it->dimincs); if (it->broadcastids != it->def_broadcastids) free(it->broadcastids); + if (it->trans_children != it->def_trans_children) free(it->trans_children); if (it->vafftrans) { pdl_vafftrans_free(it); } - pdl_trans_children *p1 = it->trans_children.next; - while (p1) { - pdl_trans_children *p2 = p1->next; - free(p1); - p1 = p2; - } /* Call special freeing magic, if exists */ if (PDL_ISMAGIC(it)) { pdl__call_magic(it, PDL_MAGIC_DELETEDATA); @@ -324,19 +317,16 @@ void pdl__remove_pdl_as_trans_input(pdl *it,pdl_trans *trans, PDL_Indx param_ind PDLDEBUG_f(printf("pdl__remove_pdl_as_trans_input(%s=%p, pdl=%p, param_ind=%td): \n", vtable->name, trans, it, param_ind)); PDL_Indx trans_children_index = trans->ind_sizes[vtable->ninds + param_ind]; - pdl_trans_children *c = &it->trans_children; - while (trans_children_index >= PDL_NCHILDREN) { - trans_children_index -= PDL_NCHILDREN; - c = c->next; - } - if (c->trans[trans_children_index] != trans) { + if (it->trans_children[trans_children_index] != trans) { /* this might be due to a croak when performing the trans; so warn only for now, otherwise we leave trans undestructed ! */ pdl_pdl_warn("Child not found for pdl %p, trans %p=%s\n",it, trans, vtable->name); return; } - c->trans[trans_children_index] = NULL; + it->trans_children[trans_children_index] = NULL; it->ntrans_children--; + if (trans_children_index < it->first_trans_child_available) + it->first_trans_child_available = trans_children_index; } /* NULL out the trans's nth pdl in/output, and this trans as pdl's @@ -431,7 +421,6 @@ pdl_error pdl__destroy_recprotect(pdl *it, int recurse_count) { pdl_error PDL_err = {0, NULL, 0}; int nback=0,nback2=0,nforw=0,nforw2=0; int nafn=0; - PDL_DECL_CHILDLOOP(it); PDL_CHKMAGIC(it); PDLDEBUG_f(printf("pdl_destroy: ");pdl_dump(it)); if (it->state & PDL_DESTROYING) { @@ -446,8 +435,11 @@ pdl_error pdl__destroy_recprotect(pdl *it, int recurse_count) { it->sv = NULL; } /* 1. count the trans_children that do flow */ - PDL_START_CHILDLOOP(it) - pdl_trans *curt = PDL_CHILDLOOP_THISCHILD(it); + PDL_Indx i; + for (i = 0; i < it->ntrans_children_allocated; i++) { + pdl_trans *curt = it->trans_children[i]; + if (!curt) continue; + PDL_TR_CHKMAGIC(curt); if (curt->flags & PDL_ITRANS_DO_DATAFLOW_F) { nforw++; /* where more than two inputs must always be soft-destroyed */ @@ -460,7 +452,7 @@ pdl_error pdl__destroy_recprotect(pdl *it, int recurse_count) { } if ((curt->flags & PDL_ITRANS_ISAFFINE) && !(curt->pdls[1]->state & PDL_ALLOCATED)) nafn++; - PDL_END_CHILDLOOP(it) + } char soft_destroy = 0; PDLDEBUG_f(printf(" nba(%d, %d), nforw(%d, %d), tra(%p=%s), nafn(%d)\n", nback, nback2, nforw, nforw2, it->trans_parent, it->trans_parent?it->trans_parent->vtable->name:"", nafn)); @@ -482,9 +474,11 @@ pdl_error pdl__destroy_recprotect(pdl *it, int recurse_count) { it->state &= ~PDL_DESTROYING; return PDL_err; } - PDL_START_CHILDLOOP(it) - PDL_RETERROR(PDL_err, pdl_destroytransform(PDL_CHILDLOOP_THISCHILD(it), 1, recurse_count+1)); - PDL_END_CHILDLOOP(it) + for (i = 0; i < it->ntrans_children_allocated; i++) { + pdl_trans *t = it->trans_children[i]; + if (!t) continue; + PDL_RETERROR(PDL_err, pdl_destroytransform(t, 1, recurse_count+1)); + } pdl_trans *trans = it->trans_parent; if (trans) /* Ensure only if there are other children! */ @@ -626,26 +620,56 @@ pdl_error pdl__add_pdl_as_trans_input(pdl *it,pdl_trans *trans, PDL_Indx param_i pdl_error PDL_err = {0, NULL, 0}; pdl_transvtable *vtable = trans->vtable; PDLDEBUG_f(printf("pdl__add_pdl_as_trans_input add to %p trans=%s param_ind=%td\n", it, vtable->name, param_ind)); - int i; pdl_trans_children *c = &it->trans_children; - PDL_Indx trans_children_index = 0; - do { - if (c->next) { trans_children_index += PDL_NCHILDREN; c=c->next; continue; } - for (i=0; itrans[i]) { trans_children_index++; continue; } - it->ntrans_children++; - trans->ind_sizes[vtable->ninds + param_ind] = trans_children_index; - c->trans[i] = trans; return PDL_err; + PDL_Indx i, trans_children_index = 0; + for (trans_children_index = it->first_trans_child_available; trans_children_index < it->ntrans_children_allocated; trans_children_index++) + if (!it->trans_children[trans_children_index]) break; + if (trans_children_index >= it->ntrans_children_allocated) { + if (it->trans_children == it->def_trans_children) { + it->trans_children = malloc( + sizeof(pdl_trans*) * (it->ntrans_children_allocated += PDL_NCHILDREN) + ); + if (!it->trans_children) return pdl_make_error_simple(PDL_EFATAL, "Out of Memory\n"); + for (i = 0; i < PDL_NCHILDREN; i++) + it->trans_children[i] = it->def_trans_children[i]; + for (; i < it->ntrans_children_allocated; i++) + it->trans_children[i] = NULL; + } else { + it->trans_children = realloc(it->trans_children, + sizeof(pdl_trans*) * (it->ntrans_children_allocated += PDL_NCHILDREN) + ); + if (!it->trans_children) return pdl_make_error_simple(PDL_EFATAL, "Out of Memory\n"); + for (i = trans_children_index+1; i < it->ntrans_children_allocated; i++) + it->trans_children[i] = NULL; } - break; - } while (1); - c = c->next = malloc(sizeof(pdl_trans_children)); - if (!c) return pdl_make_error_simple(PDL_EFATAL, "Out of Memory\n"); - c->trans[0] = trans; + } + if (trans_children_index > it->first_trans_child_available) + it->first_trans_child_available = trans_children_index; it->ntrans_children++; trans->ind_sizes[vtable->ninds + param_ind] = trans_children_index; - for (i=1; itrans[i] = 0; - c->next = 0; + it->trans_children[trans_children_index] = trans; + return PDL_err; +} + +pdl_error pdl_prealloc_trans_children(pdl *it, PDL_Indx howmany) { + pdl_error PDL_err = {0, NULL, 0}; + PDL_Indx i, oldval = it->ntrans_children_allocated; + if (howmany > oldval) { + if (it->trans_children == it->def_trans_children) { + it->trans_children = malloc( + sizeof(pdl_trans*) * (it->ntrans_children_allocated = howmany) + ); + if (!it->trans_children) return pdl_make_error_simple(PDL_EFATAL, "Out of Memory\n"); + for (i = 0; i < PDL_NCHILDREN; i++) + it->trans_children[i] = it->def_trans_children[i]; + } else { + it->trans_children = realloc(it->trans_children, + sizeof(pdl_trans*) * (it->ntrans_children_allocated = howmany) + ); + if (!it->trans_children) return pdl_make_error_simple(PDL_EFATAL, "Out of Memory\n"); + } + for (i = oldval; i < howmany; i++) + it->trans_children[i] = NULL; + } return PDL_err; } @@ -887,14 +911,14 @@ pdl_error pdl_changed(pdl *it, int what, int recursing) { } } } else { - PDL_DECL_CHILDLOOP(it); - PDL_START_CHILDLOOP(it) - pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it); - if (!(trans->flags & PDL_ITRANS_DO_DATAFLOW_F)) continue; + PDL_Indx i; + for (i = 0; i < it->ntrans_children_allocated; i++) { + pdl_trans *trans = it->trans_children[i]; + if (!trans || !(trans->flags & PDL_ITRANS_DO_DATAFLOW_F)) continue; for (j=trans->vtable->nparents; jvtable->npdls; j++) if (trans->pdls[j] != it && (trans->pdls[j]->state & what) != what) CHANGED(trans->pdls[j],what,1); - PDL_END_CHILDLOOP(it) + } } PDLDEBUG_f(printf("pdl_changed: exiting for pdl %p\n", it)); return PDL_err; @@ -982,11 +1006,11 @@ pdl_error pdl_make_physvaffine(pdl *it) pdl_error pdl_set_datatype(pdl *a, pdl_datatypes datatype) { pdl_error PDL_err = {0, NULL, 0}; - PDL_DECL_CHILDLOOP(a) - PDL_START_CHILDLOOP(a) - if (PDL_CHILDLOOP_THISCHILD(a)) + PDL_Indx i; + for (i = 0; i < a->ntrans_children_allocated; i++) { + if (a->trans_children[i]) return pdl_make_error_simple(PDL_EUSERERROR, "set_datatype: ndarray has child transform"); - PDL_END_CHILDLOOP(a) + } if (a->trans_parent) PDL_RETERROR(PDL_err, pdl_destroytransform(a->trans_parent,1,0)); if (a->state & PDL_NOMYDIMS) @@ -1016,41 +1040,42 @@ pdl_error pdl_sever(pdl *src) /* newval = 1 means set flag, 0 means clear it */ void pdl_propagate_badflag( pdl *it, int newval ) { PDLDEBUG_f(printf("pdl_propagate_badflag pdl=%p newval=%d\n", it, newval)); - PDL_Indx i; + PDL_Indx i, j; 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_START_CHILDLOOP(it) - pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it); - trans->bvalflag = !!newval; - PDL_MAYBE_PROPAGATE_BADFLAG(trans, newval) - PDL_END_CHILDLOOP(it) + for (j = 0; j < it->ntrans_children_allocated; j++) { + pdl_trans *trans = it->trans_children[j]; + if (!trans) continue; + trans->bvalflag = !!newval; + PDL_MAYBE_PROPAGATE_BADFLAG(trans, newval) + } } /*CORE21 use pdl_error, replace fprintf*/ void pdl_propagate_badvalue( pdl *it ) { - PDL_DECL_CHILDLOOP(it) - PDL_START_CHILDLOOP(it) - pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it); - PDL_Indx i; - for ( i = trans->vtable->nparents; i < trans->vtable->npdls; i++ ) { - pdl *child = trans->pdls[i]; - PDL_Anyval typedval; - ANYVAL_TO_ANYVAL_NEWTYPE(it->badvalue, typedval, child->datatype); - if (typedval.type < 0) { - fprintf(stderr, "propagate_badvalue: error making typedval\n"); - return; - } - child->has_badvalue = 1; - child->badvalue = typedval; - /* make sure we propagate to grandchildren, etc */ - pdl_propagate_badvalue( child ); - } /* for: i */ - PDL_END_CHILDLOOP(it) + PDL_Indx j; + for (j = 0; j < it->ntrans_children_allocated; j++) { + pdl_trans *trans = it->trans_children[j]; + if (!trans) continue; + PDL_Indx i; + for ( i = trans->vtable->nparents; i < trans->vtable->npdls; i++ ) { + pdl *child = trans->pdls[i]; + PDL_Anyval typedval; + ANYVAL_TO_ANYVAL_NEWTYPE(it->badvalue, typedval, child->datatype); + if (typedval.type < 0) { + fprintf(stderr, "propagate_badvalue: error making typedval\n"); + return; + } + child->has_badvalue = 1; + child->badvalue = typedval; + /* make sure we propagate to grandchildren, etc */ + pdl_propagate_badvalue( child ); + } /* for: i */ + } } /* pdl_propagate_badvalue */ /*CORE21 unused*/ diff --git a/lib/PDL/Core/pdlcore.h b/lib/PDL/Core/pdlcore.h index 252e11518..4cab22678 100644 --- a/lib/PDL/Core/pdlcore.h +++ b/lib/PDL/Core/pdlcore.h @@ -158,6 +158,7 @@ void pdl_dump_anyval(PDL_Anyval v); X(packpdls, pdl **, ( SV* sv, PDL_Indx *npdls )) \ X(unpackpdls, SV*, ( pdl **, PDL_Indx npdls )) \ X(packstrings, char **, ( SV* sv, PDL_Indx *nstrings )) \ + X(prealloc_trans_children, pdl_error, (pdl *it, PDL_Indx howmany)) \ /*************** Function prototypes *********************/ #define X(sym, rettype, args) \ diff --git a/lib/PDL/Core/pdlutil.c b/lib/PDL/Core/pdlutil.c index 973e03956..b6007018a 100644 --- a/lib/PDL/Core/pdlutil.c +++ b/lib/PDL/Core/pdlutil.c @@ -415,7 +415,6 @@ void pdl_dump_trans_fixspace (pdl_trans *it, int nspac) { } void pdl_dump_fixspace(pdl *it,int nspac) { - PDL_DECL_CHILDLOOP(it) PDL_Indx i; SET_SPACE(spaces, nspac); printf("%sDUMPING %p datatype: %d\n%s State: ",spaces,it,it->datatype,spaces); @@ -475,9 +474,11 @@ void pdl_dump_fixspace(pdl *it,int nspac) { } if (it->ntrans_children) { printf("%s CHILDREN:\n",spaces); - PDL_START_CHILDLOOP(it) - pdl_dump_trans_fixspace(PDL_CHILDLOOP_THISCHILD(it),nspac+4); - PDL_END_CHILDLOOP(it) + for (i = 0; i < it->ntrans_children_allocated; i++) { + pdl_trans *t = it->trans_children[i]; + if (!t) continue; + pdl_dump_trans_fixspace(t, nspac+4); + } } } diff --git a/lib/PDL/Internals.pod b/lib/PDL/Internals.pod index 25e292329..0161fdb84 100644 --- a/lib/PDL/Internals.pod +++ b/lib/PDL/Internals.pod @@ -89,7 +89,10 @@ of the file F. So what does the structure look like: unsigned char *broadcastids; /* Starting index of the broadcast index set n */ unsigned char nbroadcastids; - pdl_trans_children trans_children; + pdl_trans *def_trans_children[PDL_NCHILDREN]; + PDL_Indx ntrans_children_allocated; + PDL_Indx first_trans_child_available; + struct pdl_trans *trans_children; PDL_Indx def_dims[PDL_NDIMS]; /* Preallocated space for efficiency */ PDL_Indx def_dimincs[PDL_NDIMS]; /* Preallocated space for efficiency */ diff --git a/t/core.t b/t/core.t index 221ad4abf..aab2083a4 100644 --- a/t/core.t +++ b/t/core.t @@ -474,6 +474,8 @@ for ([[], qr/at least/], [[5]], [[4,5]]) { is 0+@list, 1, "dog on pure-vaff works"; } +zeroes(1,1000)->dog; # no segfault please + { my $x = sequence(byte,5); $x->inplace;