view release on metacpan or  search on metacpan

Basic/Core/Core.xs  view on Meta::CPAN

    int badflag;
    PDLA_Anyval result = { -1, 0 };
   CODE:
    pdl_make_physvaffine( x );

    pos = pdl_packdims( position, &npos);

    if (pos == NULL || npos < x->ndims)
       croak("Invalid position");

    /*  allow additional trailing indices
     *  which must be all zero, i.e. a
     *  [3,1,5] piddle is treated as an [3,1,5,1,1,1,....]
     *  infinite dim piddle
     */
    for (ipos=x->ndims; ipos<npos; ipos++)
      if (pos[ipos] != 0)
         croak("Invalid position");

    result=pdl_at(PDLA_REPRP(x), x->datatype, pos, x->dims,
        (PDLA_VAFFOK(x) ? x->vafftrans->incs : x->dimincs), PDLA_REPROFFS(x),
	x->ndims);
#if BADVAL
   badflag = (x->state & PDLA_BADVAL) > 0;
#  if BADVAL_USENAN
   /* do we have to bother about NaN's? */
   if ( badflag &&
        ( ( x->datatype < PDLA_F && ANYVAL_EQ_ANYVAL(result, pdl_get_badvalue(x->datatype)) ) ||
          ( x->datatype == PDLA_F && finite(result.value.F) == 0 ) ||
          ( x->datatype == PDLA_D && finite(result.value.D) == 0 )
        )
      ) {
	 RETVAL = newSVpvn( "BAD", 3 );
   } else
#  else
   if ( badflag &&
        ANYVAL_EQ_ANYVAL( result, pdl_get_badvalue( x->datatype ) )
      ) {
	 RETVAL = newSVpvn( "BAD", 3 );
   } else
#  endif
#endif

    ANYVAL_TO_SV(RETVAL, result);

    OUTPUT:
     RETVAL


void
list_c(x)
	pdl *x
      PREINIT:
	PDLA_Indx *inds;
      PDLA_Indx *incs;
      PDLA_Indx offs;
	void *data;
	int ind;
	int stop = 0;
	SV *sv;
	PPCODE:
      pdl_make_physvaffine( x );
	inds = pdl_malloc(sizeof(PDLA_Indx) * x->ndims); /* GCC -> on stack :( */

	data = PDLA_REPRP(x);
	incs = (PDLA_VAFFOK(x) ? x->vafftrans->incs : x->dimincs);
	offs = PDLA_REPROFFS(x);
	EXTEND(sp,x->nvals);
	for(ind=0; ind < x->ndims; ind++) inds[ind] = 0;
	while(!stop) {
		PDLA_Anyval pdl_val = { -1, 0 };
		pdl_val = pdl_at( data, x->datatype, inds, x->dims, incs, offs, x->ndims);
		ANYVAL_TO_SV(sv,pdl_val);
		PUSHs(sv_2mortal(sv));
		stop = 1;
		for(ind = 0; ind < x->ndims; ind++)
			if(++(inds[ind]) >= x->dims[ind])
				inds[ind] = 0;
			else
				{stop = 0; break;}
	}

# returns the string 'BAD' if an element is bad
#

SV *
listref_c(x)
   pdl *x
  PREINIT:
   PDLA_Indx * inds;
   PDLA_Indx * incs;
   PDLA_Indx offs;
   void *data;
   int ind;
   int lind;
   int stop = 0;
   AV *av;
   SV *sv;
   PDLA_Anyval pdl_val =    { -1, 0 };
   PDLA_Anyval pdl_badval = { -1, 0 };
  CODE:
#if BADVAL
    /*
    # note:
    #  the badvalue is stored in a PDLA_Anyval, but that's what pdl_at()
    #  returns
    */

   int badflag = (x->state & PDLA_BADVAL) > 0;
#  if BADVAL_USENAN
    /* do we have to bother about NaN's? */
   if ( badflag && x->datatype < PDLA_F ) {
      pdl_badval = pdl_get_pdl_badvalue( x );
   }
#  else
   if ( badflag ) {
      pdl_badval = pdl_get_pdl_badvalue( x );
   }
#  endif
#endif

Basic/Core/Core.xs  view on Meta::CPAN

int
isnull(self)
	pdl *self;
	CODE:
		RETVAL= !!(self->state & PDLA_NOMYDIMS);
	OUTPUT:
		RETVAL

pdl *
make_physical(self)
	pdl *self;
	CODE:
		pdl_make_physical(self);
		RETVAL = self;
	OUTPUT:
		RETVAL

pdl *
make_physvaffine(self)
	pdl *self;
	CODE:
		pdl_make_physvaffine(self);
		RETVAL = self;
	OUTPUT:
		RETVAL


pdl *
make_physdims(self)
	pdl *self;
	CODE:
		pdl_make_physdims(self);
		RETVAL = self;
	OUTPUT:
		RETVAL

void
pdl_dump(x)
  pdl *x;

void
pdl_add_threading_magic(it,nthdim,nthreads)
	pdl *it
	int nthdim
	int nthreads

void
pdl_remove_threading_magic(it)
	pdl *it
	CODE:
		pdl_add_threading_magic(it,-1,-1);

MODULE = PDLA::Core	PACKAGE = PDLA

SV *
initialize(class)
	SV *class
        PREINIT:
	HV *bless_stash;
        PPCODE:
        if (SvROK(class)) { /* a reference to a class */
	  bless_stash = SvSTASH(SvRV(class));
        } else {            /* a class name */
          bless_stash = gv_stashsv(class, 0);
        }
        ST(0) = sv_newmortal();
        SetSV_PDLA(ST(0),pdl_null());   /* set a null PDLA to this SV * */
        ST(0) = sv_bless(ST(0), bless_stash); /* bless appropriately  */
	XSRETURN(1);

SV *
get_dataref(self)
	pdl *self
	CODE:
	if(self->state & PDLA_DONTTOUCHDATA) {
		croak("Trying to get dataref to magical (mmaped?) pdl");
	}
	pdl_make_physical(self); /* XXX IS THIS MEMLEAK WITHOUT MORTAL? */
	RETVAL = (newRV(self->datasv));
	OUTPUT:
	RETVAL

int
get_datatype(self)
	pdl *self
	CODE:
	RETVAL = self->datatype;
	OUTPUT:
	RETVAL

int
upd_data(self)
	pdl *self
      PREINIT:
       STRLEN n_a;
	CODE:
	if(self->state & PDLA_DONTTOUCHDATA) {
		croak("Trying to touch dataref of magical (mmaped?) pdl");
	}
       self->data = SvPV((SV*)self->datasv,n_a);
	XSRETURN(0);

void
set_dataflow_f(self,value)
	pdl *self;
	int value;
	CODE:
	if(value)
		self->state |= PDLA_DATAFLOW_F;
	else
		self->state &= ~PDLA_DATAFLOW_F;

void
set_dataflow_b(self,value)
	pdl *self;
	int value;
	CODE:
	if(value)
		self->state |= PDLA_DATAFLOW_B;
	else