PDL/Core/Core.c - metacpan.org

/*
 * This file was generated automatically by xsubpp version 1.937 from the 
 * contents of Core.xs. Do not edit this file, edit Core.xs instead.
 *
 *	ANY CHANGES MADE HERE WILL BE LOST! 
 *
 */


/* 
   Core.xs

*/

#include "EXTERN.h"   /* std perl include */
#include "perl.h"     /* std perl include */
#include "XSUB.h"     /* XSUB include */

#include "pdl.h"      /* Data structure declarations */
#include "pdlcore.h"  /* Core declarations */

/* Return a integer or numeric scalar as approroate */

#define SET_RETVAL_NV x->datatype<PDL_F ? (RETVAL=newSViv( (IV)result )) : (RETVAL=newSVnv( result ))

static Core PDL; /* Struct holding pointers to shared C routines */

XS(XS_PDL_DESTROY)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: PDL::DESTROY(self)");
    {
	SV *	self = ST(0);
    pdl* thepdl = pdl_getcache( (HV*) SvRV(self) );
    if (thepdl != NULL) 
       pdl_destroy(thepdl);
    }
    XSRETURN(1);
}

XS(XS_PDL_flush)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: PDL::flush(self)");
    {
	SV *	self = ST(0);
    pdl_fillcache( (HV*) SvRV(self) ); /* Recache value */ 
    }
    XSRETURN(1);
}

XS(XS_PDL_dump)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: PDL::dump(pdlsv)");
    {
	SV*	pdlsv = ST(0);
    pdl* x;
    int i,j;
    for (i=1; i<=2; i++) {
       if (i==1)
          printf("=============================================\n");
       else {
          printf("\n.............Flushing.............\n\n");
          x=pdl_fillcache((HV*) SvRV(pdlsv));
       }

       x = pdl_getcache((HV*)SvRV(pdlsv));
       if (x == NULL)
          printf("[Cache empty]\n");
       else{
          printf("Cache found at address %d\n", x); 
          printf("x.data = %d\n",  x->data);
          printf("x.datatype = %d\n",  x->datatype);
          printf("x.nvals = %d\n", x->nvals);
          printf("x.dims = %d\n", x->dims);
          printf("x.ndims = %d\n", x->ndims);
          printf("Dims = ");
          for(j=0; j<x->ndims; j++)
             printf("%d ", *(x->dims+j));
          printf("\n");
       }
    }
    printf("=============================================\n\n");
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_biop)
{
    dXSARGS;
    if (items != 4)
	croak("Usage: PDL::Core::biop(a,b,reverse,op)");
    {
	pdl*	a = SvPDLV(ST(0));
	pdl*	b = SvPDLV(ST(1));
	Logical	reverse = (Logical)SvIV(ST(2));
	char *	op = (char *)SvPV(ST(3),na);
	SV *	RETVAL;
    pdl* c; 
    RETVAL = pdl_copy(a,""); /* Init value to return */
    c = SvPDLV(RETVAL);         /* Map */

    pdl_coercetypes(&a, &b, PDL_TMP);  /* Ensure data types equal */
    pdl_retype(c, a->datatype); pdl_grow(c, BIGGESTOF(a,b)); 

    if (reverse)
       pdl_swap(&a,&b);

    pdl_biop(op, c->data, a->data, b->data, a->nvals, b->nvals, a->datatype); 

	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_biop2)
{
    dXSARGS;
    if (items != 4)
	croak("Usage: PDL::Core::biop2(a,b,reverse,op)");
    {
	pdl*	a = SvPDLV(ST(0));
	pdl*	b = SvPDLV(ST(1));
	Logical	reverse = (Logical)SvIV(ST(2));
	char *	op = (char *)SvPV(ST(3),na);
	SV *	RETVAL;
    pdl_converttype(&b, a->datatype, PDL_TMP);   /* Ensure data types equal */
    pdl_biop(op, a->data, a->data, b->data, a->nvals, b->nvals, a->datatype); 
    /* Note OUTPUT is automatically OK as return value is ST(0) (immortal) */
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_ufunc)
{
    dXSARGS;
    if (items != 2)
	croak("Usage: PDL::Core::ufunc(x,func)");
    {
	pdl*	x = SvPDLV(ST(0));
	char *	func = (char *)SvPV(ST(1),na);
	SV *	RETVAL;
     pdl* y;
     RETVAL = pdl_copy(x,""); /* Init value to return */
     y = SvPDLV(RETVAL);      /* Map */

     pdl_ufunc( func, y->data, y->nvals, y->datatype );

	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_bifunc)
{
    dXSARGS;
    if (items != 4)
	croak("Usage: PDL::Core::bifunc(a,b,reverse,func)");
    {
	pdl*	a = SvPDLV(ST(0));
	pdl*	b = SvPDLV(ST(1));
	Logical	reverse = (Logical)SvIV(ST(2));
	char *	func = (char *)SvPV(ST(3),na);
	SV *	RETVAL;
    pdl* c;
    RETVAL = pdl_copy(a,""); /* Init value to return */
    c = SvPDLV(RETVAL);               /* Map */

    pdl_coercetypes(&a, &b, PDL_TMP);  /* Ensure data types equal */
    pdl_retype(c, a->datatype); pdl_grow(c, BIGGESTOF(a,b));

    if (reverse)
       pdl_swap(&a,&b);

    pdl_bifunc(func, c->data, a->data, b->data, a->nvals, b->nvals, a->datatype); 

	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_convert)
{
    dXSARGS;
    if (items != 2)
	croak("Usage: PDL::Core::convert(a,datatype)");
    {
	pdl*	a = SvPDLV(ST(0));
	int	datatype = (int)SvIV(ST(1));
	SV *	RETVAL;
    pdl* b;
    RETVAL = pdl_copy(a,""); /* Init value to return */
    b = SvPDLV(RETVAL);      /* Map */
    pdl_converttype( &b, datatype, PDL_PERM );

	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_howbig)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: PDL::Core::howbig(datatype)");
    {
	int	datatype = (int)SvIV(ST(0));
	int	RETVAL;
     RETVAL = pdl_howbig(datatype);
	ST(0) = sv_newmortal();
	sv_setiv(ST(0), (IV)RETVAL);
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_min)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: PDL::Core::min(x)");
    {
	pdl*	x = SvPDLV(ST(0));
	SV *	RETVAL;
     double result;
     result = pdl_min( x->data, x->nvals, x->datatype );
     SET_RETVAL_NV ;    
	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_max)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: PDL::Core::max(x)");
    {
	pdl*	x = SvPDLV(ST(0));
	SV *	RETVAL;
     double result;
     result = pdl_max( x->data, x->nvals, x->datatype );
     SET_RETVAL_NV ;    
	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_sum)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: PDL::Core::sum(x)");
    {
	pdl*	x = SvPDLV(ST(0));
	SV *	RETVAL;
     double result;
     result = pdl_sum( x->data, x->nvals, x->datatype );
     SET_RETVAL_NV ;    
	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_sec_c)
{
    dXSARGS;
    if (items != 2)
	croak("Usage: PDL::Core::sec_c(x,section)");
    {
	pdl*	x = SvPDLV(ST(0));
	int *	section;
	SV *	RETVAL;
     pdl* y;
     int nsecs;
     int size;

     RETVAL = pdl_copy(x,"NoData"); /* Init value to return */ 
     y = SvPDLV(RETVAL);      /* Map */

     section = pdl_packdims( ST(1), &nsecs);
     if (section == NULL || nsecs != 2*(x->ndims))
        croak("Invalid subsection specified");

     size = pdl_validate_section( section, x->dims, x->ndims );
     pdl_grow ( y, size );   /* To new size */

     /* Note - cast to char ptr to make byte ptr */

     pdl_subsection( (char*) y->data, (char*) x->data, 
                        y->datatype, section, y->dims,  &(y->ndims) );

     pdl_unpackdims( RETVAL, y->dims, y->ndims ); /* Update Dims */

	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_insertin_c)
{
    dXSARGS;
    if (items != 3)
	croak("Usage: PDL::Core::insertin_c(y,x,postion)");
    {
	pdl*	y = SvPDLV(ST(0));
	pdl*	x = SvPDLV(ST(1));
	int *	pos;
     int npos;

     if (y->ndims < x->ndims)
        croak("Cannot insert higher into lower dimension");    

     pos = pdl_packdims( ST(2), &npos);
     if (pos == NULL || npos != y->ndims) 
        croak("Invalid insertion position specified");

     pdl_converttype(&x, y->datatype, PDL_TMP); /* Ensure same type */

     /* Note - cast to char ptr to make byte ptr */

     pdl_insertin( (char*) y->data, y->dims, y->ndims, 
                   (char*) x->data, x->dims, x->ndims,  
                   x->datatype, pos );
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_at_c)
{
    dXSARGS;
    if (items != 2)
	croak("Usage: PDL::Core::at_c(x,position)");
    {
	pdl*	x = SvPDLV(ST(0));
	int *	pos;
	SV *	RETVAL;
    int npos;
    double result;

    pos = pdl_packdims( ST(1), &npos);
    if (pos == NULL || npos != x->ndims) 
       croak("Invalid position");

    result = pdl_at( x->data, x->datatype, pos, x->dims, x->ndims);

    SET_RETVAL_NV ;    

	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_set_c)
{
    dXSARGS;
    if (items != 3)
	croak("Usage: PDL::Core::set_c(x,position,value)");
    {
	pdl*	x = SvPDLV(ST(0));
	int *	pos;
	double	value = (double)SvNV(ST(2));
	SV *	RETVAL;
    int npos;
    double result;

    pos = pdl_packdims( ST(1), &npos);
    if (pos == NULL || npos != x->ndims) 
       croak("Invalid position");

    pdl_set( x->data, x->datatype, pos, x->dims, x->ndims, value);
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_axisvals)
{
    dXSARGS;
    if (items != 2)
	croak("Usage: PDL::Core::axisvals(x,axis)");
    {
	pdl*	x = SvPDLV(ST(0));
	int	axis = (int)SvIV(ST(1));
	SV *	RETVAL;
     pdl* y;
     RETVAL = pdl_copy(x,""); /* Init value to return */ 
     y = SvPDLV(RETVAL);      /* Map */
     if (axis>=y->ndims) 
        croak("Data has not enough dimensions for axis=%d",axis);
     pdl_axisvals(y, axis);
	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_convolve)
{
    dXSARGS;
    if (items != 2)
	croak("Usage: PDL::Core::convolve(a,b)");
    {
	pdl*	a = SvPDLV(ST(0));
	pdl*	b = SvPDLV(ST(1));
	SV *	RETVAL;
     pdl* c;
     RETVAL = pdl_copy(a,""); /* Init value to return */ 
     c = SvPDLV(RETVAL);      /* Map */

     pdl_coercetypes(&a, &b, PDL_TMP);  /* Ensure data types equal */
     pdl_retype(c, a->datatype); pdl_grow(c, a->nvals); 

     pdl_convolve( c, a, b );
	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_hist_c)
{
    dXSARGS;
    if (items != 4)
	croak("Usage: PDL::Core::hist_c(a,min,max,step)");
    {
	pdl*	a = SvPDLV(ST(0));
	double	min = (double)SvNV(ST(1));
	double	max = (double)SvNV(ST(2));
	double	step = (double)SvNV(ST(3));
	SV *	RETVAL;
     int nbins;
     pdl* c;
     RETVAL = pdl_copy(a,"NoData"); /* Init value to return */ 
     c = SvPDLV(RETVAL);      /* Map */

     nbins = (max-min)/step;
     if (nbins<=0)
        croak("Error max<=min");
     pdl_grow(c, nbins);               /* New size */ 
     pdl_unpackdims( (SV*) c->sv, &nbins, 1 ); /* Change dimensions */

     pdl_hist( c, a, min, step );

	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_matrix_mult)
{
    dXSARGS;
    if (items != 3)
	croak("Usage: PDL::Core::matrix_mult(a,b,reverse)");
    {
	pdl*	a = SvPDLV(ST(0));
	pdl*	b = SvPDLV(ST(1));
	Logical	reverse = (Logical)SvIV(ST(2));
	SV *	RETVAL;
     pdl* c;
     RETVAL = pdl_copy(a,"NoData"); /* Init value to return */ 
     c = SvPDLV(RETVAL);            /* Map */

     pdl_coercetypes(&a, &b, PDL_TMP);  /* Ensure data types equal */
     pdl_retype(c, a->datatype);
     if (reverse)
        pdl_swap(&a,&b);

     pdl_matrixmult(c,a,b);   /* This fills in the dims of c */
     pdl_unpackdims( (SV*) c->sv, c->dims, c->ndims );  /* Change SV* dims */

	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_transpose)
{
    dXSARGS;
    if (items < 1)
	croak("Usage: PDL::Core::transpose(x,...)");
    {
	pdl*	x = SvPDLV(ST(0));
	SV *	RETVAL;
     pdl* y;
     pdl* thepdl;
     RETVAL = pdl_copy(x,""); /* Init value to return */
     y = SvPDLV(RETVAL);      /* Map */

     pdl_transpose(y, x);
     pdl_unpackdims( (SV*) y->sv, y->dims, y->ndims ); /* Change SV* dims */

	ST(0) = RETVAL;
	if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
    }
    XSRETURN(1);
}

XS(XS_PDL__Core_callext_c)
{
    dXSARGS;
    SP -= items;
    {
        int (*symref)(int npdl, pdl **x);
        int npdl = items-1;
        pdl **x;
        int i;

        symref = (int(*)(int, pdl**)) SvIV(ST(0));

        x = (pdl**) pdl_malloc( npdl * sizeof(pdl*) );
        for(i=0; i<npdl; i++) 
           x[i] = SvPDLV(ST(i+1));

        i = (*symref)(npdl, x);
        if (i==0)
           croak("Error calling external routine");
	PUTBACK;
	return;
    }
}

XS(XS_PDL__Core_myeval)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: PDL::Core::myeval(code)");
    {
	SV *	code = ST(0);
   PUSHMARK(sp) ;
   perl_call_sv(code, G_EVAL|G_KEEPERR|GIMME);
    }
    XSRETURN(1);
}

#ifdef __cplusplus
extern "C"
#endif
XS(boot_PDL__Core)
{
    dXSARGS;
    char* file = __FILE__;

    XS_VERSION_BOOTCHECK ;

        newXS("PDL::DESTROY", XS_PDL_DESTROY, file);
        newXS("PDL::flush", XS_PDL_flush, file);
        newXS("PDL::dump", XS_PDL_dump, file);
        newXS("PDL::Core::biop", XS_PDL__Core_biop, file);
        newXS("PDL::Core::biop2", XS_PDL__Core_biop2, file);
        newXS("PDL::Core::ufunc", XS_PDL__Core_ufunc, file);
        newXS("PDL::Core::bifunc", XS_PDL__Core_bifunc, file);
        newXS("PDL::Core::convert", XS_PDL__Core_convert, file);
        newXS("PDL::Core::howbig", XS_PDL__Core_howbig, file);
        newXS("PDL::Core::min", XS_PDL__Core_min, file);
        newXS("PDL::Core::max", XS_PDL__Core_max, file);
        newXS("PDL::Core::sum", XS_PDL__Core_sum, file);
        newXS("PDL::Core::sec_c", XS_PDL__Core_sec_c, file);
        newXS("PDL::Core::insertin_c", XS_PDL__Core_insertin_c, file);
        newXS("PDL::Core::at_c", XS_PDL__Core_at_c, file);
        newXS("PDL::Core::set_c", XS_PDL__Core_set_c, file);
        newXS("PDL::Core::axisvals", XS_PDL__Core_axisvals, file);
        newXS("PDL::Core::convolve", XS_PDL__Core_convolve, file);
        newXS("PDL::Core::hist_c", XS_PDL__Core_hist_c, file);
        newXS("PDL::Core::matrix_mult", XS_PDL__Core_matrix_mult, file);
        newXS("PDL::Core::transpose", XS_PDL__Core_transpose, file);
        newXS("PDL::Core::callext_c", XS_PDL__Core_callext_c, file);
        newXSproto("PDL::Core::myeval", XS_PDL__Core_myeval, file, "$");

    /* Initialisation Section */


   /* Initialise structure of pointers to core C routines */

   PDL.SvPDLV      = SvPDLV;
   PDL.copy        = pdl_copy;
   PDL.converttype = pdl_converttype;
   PDL.twod        = pdl_twod;
   PDL.malloc      = pdl_malloc;
   PDL.howbig      = pdl_howbig;
   PDL.packdims    = pdl_packdims;
   PDL.unpackdims  = pdl_unpackdims;
   PDL.grow        = pdl_grow;
   PDL.flushcache  = pdl_flushcache;
   PDL.reallocdims = pdl_reallocdims;
   PDL.resize_defaultincs = pdl_resize_defaultincs;

   /* 
      "Publish" pointer to this structure in perl variable for use
       by other modules
   */

   sv_setiv(perl_get_sv("PDL::SHARE",TRUE), (IV) (void*) &PDL);


    /* End of Initialisation Section */

    ST(0) = &sv_yes;
    XSRETURN(1);
}
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	Go to GitHub issues (only if GitHub is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)