"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/Core/Core.xs" between
PDL-2.082.tar.gz and PDL-2.083.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

Core.xs  (PDL-2.082):Core.xs  (PDL-2.083)
skipping to change at line 270 skipping to change at line 270
int int
set_debugging(i) set_debugging(i)
int i; int i;
CODE: CODE:
RETVAL = pdl_debugging; RETVAL = pdl_debugging;
pdl_debugging = i; pdl_debugging = i;
OUTPUT: OUTPUT:
RETVAL RETVAL
PDL_Anyval
sclr_c(it)
pdl* it
CODE:
/* get the first element of an ndarray and return as
* Perl scalar (autodetect suitable type IV or NV)
*/
RETVAL = pdl_at0(it);
if (RETVAL.type < 0) croak("Position out of range");
OUTPUT:
RETVAL
SV * SV *
at_bad_c(x,pos) at_bad_c(x,pos)
pdl* x pdl* x
PDL_Indx pos_count=0;
PDL_Indx *pos PDL_Indx *pos
PREINIT: PREINIT:
PDL_Indx ipos; PDL_Indx ipos;
int badflag; int badflag;
volatile PDL_Anyval result = { PDL_INVALID, {0} }; volatile PDL_Anyval result = { PDL_INVALID, {0} };
CODE: CODE:
pdl_barf_if_error(pdl_make_physvaffine( x )); pdl_barf_if_error(pdl_make_physvaffine( x ));
if (pos == NULL || pos_count < x->ndims) if (pos == NULL || pos_count < x->ndims)
barf("Invalid position with pos=%p, count=%"IND_FLAG" for ndarray with %" IND_FLAG" dims", pos, pos_count, x->ndims); barf("Invalid position with pos=%p, count=%"IND_FLAG" for ndarray with %" IND_FLAG" dims", pos, pos_count, x->ndims);
/* allow additional trailing indices /* allow additional trailing indices
* which must be all zero, i.e. a * which must be all zero, i.e. a
* [3,1,5] ndarray is treated as an [3,1,5,1,1,1,....] * [3,1,5] ndarray is treated as an [3,1,5,1,1,1,....]
* infinite dim ndarray * infinite dim ndarray
*/ */
for (ipos=x->ndims; ipos<pos_count; ipos++) for (ipos=x->ndims; ipos<pos_count; ipos++)
if (pos[ipos] != 0) if (pos[ipos] != 0)
barf("Invalid position %"IND_FLAG" at dimension %"IND_FLAG, pos[ipos], ipos); barf("Invalid position %"IND_FLAG" at dimension %"IND_FLAG, pos[ipos], ipos);
result=pdl_at(PDL_REPRP(x), x->datatype, pos, x->dims, result=pdl_at(PDL_REPRP(x), x->datatype, pos, x->dims,
PDL_REPRINCS(x), PDL_REPROFFS(x), PDL_REPRINCS(x), PDL_REPROFFS(x),
x->ndims); x->ndims);
if (result.type < 0) barf("Position %"IND_FLAG" out of range", pos); if (result.type < 0) barf("Position %"IND_FLAG" out of range", pos);
badflag = (x->state & PDL_BADVAL) > 0; badflag = (x->state & PDL_BADVAL) > 0;
if (badflag) { if (badflag) {
volatile PDL_Anyval badval = pdl_get_pdl_badvalue(x); volatile PDL_Anyval badval = pdl_get_pdl_badvalue(x);
if (badval.type < 0) barf("Error getting badvalue, type=%d", badval.type); if (badval.type < 0) barf("Error getting badvalue, type=%d", badval.type);
int isbad = ANYVAL_ISBAD(result, badval); int isbad = ANYVAL_ISBAD(result, badval);
if (isbad == -1) barf("ANYVAL_ISBAD error on types %d, %d", result.type, ba dval.type); if (isbad == -1) barf("ANYVAL_ISBAD error on types %d, %d", result.type, ba dval.type);
if (isbad) if (isbad)
RETVAL = newSVpvn( "BAD", 3 ); RETVAL = newSVpvn( "BAD", 3 );
else else {
RETVAL = newSV(0);
ANYVAL_TO_SV(RETVAL, result); ANYVAL_TO_SV(RETVAL, result);
} else }
} else {
RETVAL = newSV(0);
ANYVAL_TO_SV(RETVAL, result); ANYVAL_TO_SV(RETVAL, result);
}
OUTPUT: OUTPUT:
RETVAL RETVAL
# returns the string 'BAD' if an element is bad # returns the string 'BAD' if an element is bad
# #
SV * SV *
listref_c(x) listref_c(x)
pdl *x pdl *x
PREINIT: PREINIT:
skipping to change at line 373 skipping to change at line 362
for(ind=0; ind < x->ndims; ind++) inds[ind] = 0; for(ind=0; ind < x->ndims; ind++) inds[ind] = 0;
while(!stop) { while(!stop) {
pdl_val = pdl_at( data, x->datatype, inds, x->dims, incs, offs, x->ndims ) ; pdl_val = pdl_at( data, x->datatype, inds, x->dims, incs, offs, x->ndims ) ;
if (pdl_val.type < 0) croak("Position out of range"); if (pdl_val.type < 0) croak("Position out of range");
if (badflag) { if (badflag) {
/* volatile because gcc optimiser otherwise won't recalc for complex dou ble when long-double code added */ /* volatile because gcc optimiser otherwise won't recalc for complex dou ble when long-double code added */
volatile int isbad = ANYVAL_ISBAD(pdl_val, pdl_badval); volatile int isbad = ANYVAL_ISBAD(pdl_val, pdl_badval);
if (isbad == -1) croak("ANYVAL_ISBAD error on types %d, %d", pdl_val.typ e, pdl_badval.type); if (isbad == -1) croak("ANYVAL_ISBAD error on types %d, %d", pdl_val.typ e, pdl_badval.type);
if (isbad) if (isbad)
sv = newSVpvn( "BAD", 3 ); sv = newSVpvn( "BAD", 3 );
else else {
sv = newSV(0);
ANYVAL_TO_SV(sv, pdl_val); ANYVAL_TO_SV(sv, pdl_val);
}
} else { } else {
sv = newSV(0);
ANYVAL_TO_SV(sv, pdl_val); ANYVAL_TO_SV(sv, pdl_val);
} }
av_store( av, lind, sv ); av_store( av, lind, sv );
lind++; lind++;
stop = 1; stop = 1;
for(ind = 0; ind < x->ndims; ind++) { for(ind = 0; ind < x->ndims; ind++) {
if(++(inds[ind]) >= x->dims[ind]) { if(++(inds[ind]) >= x->dims[ind]) {
inds[ind] = 0; inds[ind] = 0;
} else { } else {
skipping to change at line 397 skipping to change at line 389
} }
} }
} }
RETVAL = newRV_noinc((SV *)av); RETVAL = newRV_noinc((SV *)av);
OUTPUT: OUTPUT:
RETVAL RETVAL
void void
set_c(x,pos,value) set_c(x,pos,value)
pdl* x pdl* x
PDL_Indx pos_count=0;
PDL_Indx *pos PDL_Indx *pos
PDL_Anyval value PDL_Anyval value
PREINIT: PREINIT:
PDL_Indx ipos; PDL_Indx ipos;
CODE: CODE:
pdl_barf_if_error(pdl_make_physvaffine( x )); pdl_barf_if_error(pdl_make_physvaffine( x ));
if (pos == NULL || pos_count < x->ndims) if (pos == NULL || pos_count < x->ndims)
croak("Invalid position"); croak("Invalid position");
skipping to change at line 476 skipping to change at line 469
av_store(dims,0,newSViv((IV) av_len(av)+1)); av_store(dims,0,newSViv((IV) av_len(av)+1));
av_ndcheck(av,dims,0,&datalevel); av_ndcheck(av,dims,0,&datalevel);
/* printf("will make type %s\n",class); */ /* printf("will make type %s\n",class); */
/* /*
at this stage start making an ndarray and populate it with at this stage start making an ndarray and populate it with
values from the array (which has already been checked in av_check) values from the array (which has already been checked in av_check)
*/ */
ENTER; SAVETMPS;
if (strcmp(class,"PDL") == 0) { if (strcmp(class,"PDL") == 0) {
p = pdl_from_array(av,dims,type,NULL); /* populate with data */ p = pdl_from_array(av,dims,type,NULL); /* populate with data */
RETVAL = newSV(0); RETVAL = newSV(0);
pdl_SetSV_PDL(RETVAL,p); pdl_SetSV_PDL(RETVAL,p);
} else { } else {
/* call class->initialize method */ /* call class->initialize method */
PUSHMARK(SP); PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(class, 0))); XPUSHs(sv_2mortal(newSVpv(class, 0)));
PUTBACK; PUTBACK;
perl_call_method("initialize", G_SCALAR); perl_call_method("initialize", G_SCALAR);
SPAGAIN; SPAGAIN;
psv = POPs; psv = POPs;
PUTBACK; PUTBACK;
p = pdl_SvPDLV(psv); /* and get ndarray from returned object */ p = pdl_SvPDLV(psv); /* and get ndarray from returned object */
RETVAL = psv; RETVAL = psv;
SvREFCNT_inc(psv); SvREFCNT_inc(psv);
pdl_from_array(av,dims,type,p); /* populate ;) */ pdl_from_array(av,dims,type,p); /* populate ;) */
} }
FREETMPS; LEAVE;
OUTPUT: OUTPUT:
RETVAL RETVAL
MODULE = PDL::Core PACKAGE = PDL::Core PREFIX = pdl_ MODULE = PDL::Core PACKAGE = PDL::Core PREFIX = pdl_
int int
pdl_pthreads_enabled() pdl_pthreads_enabled()
MODULE = PDL::Core PACKAGE = PDL PREFIX = pdl_ MODULE = PDL::Core PACKAGE = PDL PREFIX = pdl_
skipping to change at line 593 skipping to change at line 588
pdl_barf_if_error(pdl_add_threading_magic(it,nthdim,nthreads)); pdl_barf_if_error(pdl_add_threading_magic(it,nthdim,nthreads));
void void
pdl_remove_threading_magic(it) pdl_remove_threading_magic(it)
pdl *it pdl *it
CODE: CODE:
pdl_barf_if_error(pdl_add_threading_magic(it,-1,-1)); pdl_barf_if_error(pdl_add_threading_magic(it,-1,-1));
MODULE = PDL::Core PACKAGE = PDL MODULE = PDL::Core PACKAGE = PDL
PDL_Anyval
sclr(it)
pdl* it
CODE:
/* get the first element of an ndarray and return as
* Perl scalar (autodetect suitable type IV or NV)
*/
pdl_barf_if_error(pdl_make_physdims(it));
if (it->nvals > 1) barf("multielement ndarray in 'sclr' call");
RETVAL = pdl_at0(it);
if (RETVAL.type < 0) croak("Position out of range");
OUTPUT:
RETVAL
SV * SV *
initialize(class) initialize(class)
SV *class SV *class
PREINIT:
CODE: CODE:
HV *bless_stash = SvROK(class) HV *bless_stash = SvROK(class)
? SvSTASH(SvRV(class)) /* a reference to a class */ ? SvSTASH(SvRV(class)) /* a reference to a class */
: gv_stashsv(class, 0); /* a class name */ : gv_stashsv(class, 0); /* a class name */
RETVAL = newSV(0); RETVAL = newSV(0);
pdl *n = pdl_pdlnew(); pdl *n = pdl_pdlnew();
if (!n) pdl_pdl_barf("Error making null pdl"); if (!n) pdl_pdl_barf("Error making null pdl");
pdl_SetSV_PDL(RETVAL,n); /* set a null PDL to this SV * */ pdl_SetSV_PDL(RETVAL,n); /* set a null PDL to this SV * */
RETVAL = sv_bless(RETVAL, bless_stash); /* bless appropriately */ RETVAL = sv_bless(RETVAL, bless_stash); /* bless appropriately */
OUTPUT: OUTPUT:
skipping to change at line 660 skipping to change at line 668
set_dataflow_f(self,value) set_dataflow_f(self,value)
pdl *self; pdl *self;
int value; int value;
CODE: CODE:
if(value) if(value)
self->state |= PDL_DATAFLOW_F; self->state |= PDL_DATAFLOW_F;
else else
self->state &= ~PDL_DATAFLOW_F; self->state &= ~PDL_DATAFLOW_F;
int int
badflag(x,newval=0)
pdl *x
int newval
CODE:
if (items>1)
pdl_propagate_badflag( x, newval );
RETVAL = ((x->state & PDL_BADVAL) > 0);
OUTPUT:
RETVAL
int
getndims(x) getndims(x)
pdl *x pdl *x
ALIAS: ALIAS:
PDL::ndims = 1 PDL::ndims = 1
CODE: CODE:
(void)ix; (void)ix;
pdl_barf_if_error(pdl_make_physdims(x)); pdl_barf_if_error(pdl_make_physdims(x));
RETVAL = x->ndims; RETVAL = x->ndims;
OUTPUT: OUTPUT:
RETVAL RETVAL
void void
dims_c(x) dims(x)
pdl *x pdl *x
PREINIT: PREINIT:
PDL_Indx i; PDL_Indx i;
U8 gimme = GIMME_V; U8 gimme = GIMME_V;
PPCODE: PPCODE:
pdl_barf_if_error(pdl_make_physdims(x)); pdl_barf_if_error(pdl_make_physdims(x));
if (gimme == G_ARRAY) { if (gimme == G_ARRAY) {
EXTEND(sp, x->ndims); EXTEND(sp, x->ndims);
for(i=0; i<x->ndims; i++) mPUSHi(x->dims[i]); for(i=0; i<x->ndims; i++) mPUSHi(x->dims[i]);
} }
skipping to change at line 712 skipping to change at line 731
int int
getnbroadcastids(x) getnbroadcastids(x)
pdl *x pdl *x
CODE: CODE:
pdl_barf_if_error(pdl_make_physdims(x)); pdl_barf_if_error(pdl_make_physdims(x));
RETVAL = x->nbroadcastids; RETVAL = x->nbroadcastids;
OUTPUT: OUTPUT:
RETVAL RETVAL
void void
broadcastids_c(x) broadcastids(x)
pdl *x pdl *x
PREINIT: PREINIT:
PDL_Indx i; PDL_Indx i;
U8 gimme = GIMME_V; U8 gimme = GIMME_V;
PPCODE: PPCODE:
pdl_barf_if_error(pdl_make_physdims(x)); pdl_barf_if_error(pdl_make_physdims(x));
if (gimme == G_ARRAY) { if (gimme == G_ARRAY) {
EXTEND(sp, x->nbroadcastids); EXTEND(sp, x->nbroadcastids);
for(i=0; i<x->nbroadcastids; i++) mPUSHi(x->broadcastids[ i]); for(i=0; i<x->nbroadcastids; i++) mPUSHi(x->broadcastids[ i]);
} }
skipping to change at line 739 skipping to change at line 758
pdl *x pdl *x
int y int y
CODE: CODE:
RETVAL = x->broadcastids[y]; RETVAL = x->broadcastids[y];
OUTPUT: OUTPUT:
RETVAL RETVAL
void void
setdims(x,dims) setdims(x,dims)
pdl *x pdl *x
PDL_Indx dims_count=0;
PDL_Indx *dims PDL_Indx *dims
CODE: CODE:
pdl_barf_if_error(pdl_setdims(x,dims,dims_count)); pdl_barf_if_error(pdl_setdims(x,dims,dims_count));
void void
dowhenidle() dowhenidle()
CODE: CODE:
pdl_run_delayed_magic(); pdl_run_delayed_magic();
XSRETURN(0); XSRETURN(0);
skipping to change at line 843 skipping to change at line 863
pdl_barf_if_error(pdl_make_physical(pdls[i])); pdl_barf_if_error(pdl_make_physical(pdls[i]));
realdims[i] = 0; realdims[i] = 0;
} }
PDL_CLRMAGIC(&pdl_brc); PDL_CLRMAGIC(&pdl_brc);
pdl_brc.gflags = 0; /* avoid uninitialised value use below */ pdl_brc.gflags = 0; /* avoid uninitialised value use below */
pdl_barf_if_error(pdl_initbroadcaststruct(0,pdls,realdims,realdims,npdls,NUL L,&pdl_brc,NULL,NULL,NULL, 1)); pdl_barf_if_error(pdl_initbroadcaststruct(0,pdls,realdims,realdims,npdls,NUL L,&pdl_brc,NULL,NULL,NULL, 1));
pdl_error error_ret = {0, NULL, 0}; pdl_error error_ret = {0, NULL, 0};
if (pdl_startbroadcastloop(&pdl_brc,NULL,NULL,&error_ret) < 0) croak("Error starting broadcastloop"); if (pdl_startbroadcastloop(&pdl_brc,NULL,NULL,&error_ret) < 0) croak("Error starting broadcastloop");
pdl_barf_if_error(error_ret); pdl_barf_if_error(error_ret);
sd = pdl_brc.ndims; sd = pdl_brc.ndims;
ENTER; SAVETMPS;
do { do {
dSP; dSP;
PUSHMARK(sp); PUSHMARK(sp);
EXTEND(sp,items); EXTEND(sp,items);
PUSHs(sv_2mortal(newSViv((sd-1)))); PUSHs(sv_2mortal(newSViv((sd-1))));
for(i=0; i<npdls; i++) { for(i=0; i<npdls; i++) {
PDL_Anyval pdl_val = { PDL_INVALID, {0} }; PDL_Anyval pdl_val = { PDL_INVALID, {0} };
pdl_val = pdl_get_offs(pdls[i],pdl_brc.offs[i]); pdl_val = pdl_get_offs(pdls[i],pdl_brc.offs[i]);
sv = sv_newmortal();
ANYVAL_TO_SV(sv, pdl_val); ANYVAL_TO_SV(sv, pdl_val);
PUSHs(sv_2mortal(sv)); PUSHs(sv);
} }
PUTBACK; PUTBACK;
perl_call_sv(code,G_DISCARD); perl_call_sv(code,G_DISCARD);
sd = pdl_iterbroadcastloop(&pdl_brc,0); sd = pdl_iterbroadcastloop(&pdl_brc,0);
if ( sd < 0 ) die("Error in iterbroadcastloop"); if ( sd < 0 ) die("Error in iterbroadcastloop");
} while( sd ); } while( sd );
FREETMPS; LEAVE;
pdl_freebroadcaststruct(&pdl_brc); pdl_freebroadcaststruct(&pdl_brc);
void void
broadcastover(...) broadcastover(...)
PREINIT: PREINIT:
int npdls; int npdls;
int targs; int targs;
int nothers = -1; int nothers = -1;
CODE: CODE:
targs = items - 4; targs = items - 4;
skipping to change at line 936 skipping to change at line 959
/* instead of pdls[i] its vaffine parent !!!XXX */ /* instead of pdls[i] its vaffine parent !!!XXX */
pdl_barf_if_error(pdl_affine_new(pdls[i],child[i],pdl_brc.offs[i], pdl_barf_if_error(pdl_affine_new(pdls[i],child[i],pdl_brc.offs[i],
thesedims,realdims[i], thesedims,realdims[i],
theseincs,realdims[i])); theseincs,realdims[i]));
pdl_barf_if_error(pdl_make_physical(child[i])); /* make sure we can get a t pdl_barf_if_error(pdl_make_physical(child[i])); /* make sure we can get a t
the vafftrans */ the vafftrans */
csv[i] = sv_newmortal(); csv[i] = sv_newmortal();
pdl_SetSV_PDL(csv[i], child[i]); /* pdl* into SV* */ pdl_SetSV_PDL(csv[i], child[i]); /* pdl* into SV* */
} }
int brcloopval; int brcloopval;
ENTER; SAVETMPS;
do { /* the actual broadcastloop */ do { /* the actual broadcastloop */
pdl_trans *traff; pdl_trans *traff;
dSP; dSP;
PUSHMARK(sp); PUSHMARK(sp);
EXTEND(sp,npdls); EXTEND(sp,npdls);
for(i=0; i<npdls; i++) { for(i=0; i<npdls; i++) {
/* just twiddle the offset - quick and dirty */ /* just twiddle the offset - quick and dirty */
/* we must twiddle both !! */ /* we must twiddle both !! */
traff = child[i]->trans_parent; traff = child[i]->trans_parent;
traff->offs = pdl_brc.offs[i]; traff->offs = pdl_brc.offs[i];
skipping to change at line 957 skipping to change at line 981
child[i]->state |= PDL_PARENTDATACHANGED; child[i]->state |= PDL_PARENTDATACHANGED;
PUSHs(csv[i]); PUSHs(csv[i]);
} }
for (i=0; i<nothers; i++) for (i=0; i<nothers; i++)
PUSHs(others[i]); /* pass the OtherArgs onto the stack */ PUSHs(others[i]); /* pass the OtherArgs onto the stack */
PUTBACK; PUTBACK;
perl_call_sv(code,G_DISCARD); perl_call_sv(code,G_DISCARD);
brcloopval = pdl_iterbroadcastloop(&pdl_brc,0); brcloopval = pdl_iterbroadcastloop(&pdl_brc,0);
if ( brcloopval < 0 ) die("Error in iterbroadcastloop"); if ( brcloopval < 0 ) die("Error in iterbroadcastloop");
} while( brcloopval ); } while( brcloopval );
FREETMPS; LEAVE;
pdl_freebroadcaststruct(&pdl_brc); pdl_freebroadcaststruct(&pdl_brc);
 End of changes. 26 change blocks. 
24 lines changed or deleted 49 lines changed or added

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