view release on metacpan or  search on metacpan

LL_Array.xs  view on Meta::CPAN

  }
  return 0;
}

XS(XS_Numeric__LL_Array___a_accessor__INTERFACE); /* prototype to pass -Wmissing-prototypes */
XS(XS_Numeric__LL_Array__0arg__INTERFACE); /* prototype to pass -Wmissing-prototypes */
XS(XS_Numeric__LL_Array__1arg__INTERFACE); /* prototype to pass -Wmissing-prototypes */
XS(XS_Numeric__LL_Array__2arg__INTERFACE); /* prototype to pass -Wmissing-prototypes */
XS(XS_Numeric__LL_Array__2arg__INTERFACE_inverted); /* prototype to pass -Wmissing-prototypes */

static void
init_interface(char *perl_name, int arity, char *code, char *perl_file)
{
  CV *mycv;
  int n = find_in_ftables(code, arity);

  if (!n)
    croak("C function with load code `%s', arity=%d not found", code, arity);
  switch (arity) {
    case -1:	/* Accessor */
	mycv = newXS(perl_name, XS_Numeric__LL_Array___a_accessor__INTERFACE, perl_file);
	break;
    case 0:
	mycv = newXS(perl_name, XS_Numeric__LL_Array__0arg__INTERFACE, perl_file);
	break;
    case 1:
	mycv = newXS(perl_name, XS_Numeric__LL_Array__1arg__INTERFACE, perl_file);
	break;
    case 2:
	mycv = newXS(perl_name, XS_Numeric__LL_Array__2arg__INTERFACE, perl_file);
	break;
    case -2:
	mycv = newXS(perl_name, XS_Numeric__LL_Array__2arg__INTERFACE_inverted, perl_file);
	break;
    default:
	croak("Unknown table arity for create: %d; expect -1,0,1,2,-2", arity);
  }
  CvXSUBANY(mycv).any_i32 = n;
}

#define typeNames()		name_by_t
#define typeSizes()		((char*)size_by_t)	/* unsigned char* */
#define duplicateTypes()	duplicate_types_s
#define ptrdiff_t_size()	sizeof(ptrdiff_t)

#define elementary_D_missing()	(!has_sinl)

MODULE = Numeric::LL_Array		PACKAGE = Numeric::LL_Array

double
d_extract_1(s, off)
    char *s
    int off

void
d_extract(s, start, count, stride = 1)
    char *s
    int start
    int count
    int stride
  PPCODE:
  {
    double *arr = (double *)s;

    EXTEND(SP, count);
    arr += start;

    while (count--) {
	PUSHs(sv_2mortal(newSVnv(*arr)));
	arr += stride;
    }
  }

SV *
d_extract_as_ref(s, start, count, stride = 1)
    char *s
    int start
    int count
    int stride

int
find_in_ftables(s, arity)
    char *s
    int arity

void
init_interface(perl_name, arity, code, perl_file)
    char *perl_name
    int arity
    char *code
    char *perl_file

void
__a_accessor__INTERFACE(p, offset = 0, dim = 0, format = Nullsv, sv = Nullsv, keep = FALSE)
	SV *p
	I32 offset
	int dim
	SV* format
	SV *sv
	bool keep
    PPCODE:
   {
       AV *av;
       const char *p_s;
       STRLEN sz;
       dXSI32;		/* ix */
       const f_ass_descr *desc = Fa_get(ix);
       int sizeof_elt = desc->codes_name[0];

       if (!sv || !SvOK(sv))
	   av = 0;
       else if (!SvROK(sv) && SvTRUE(sv)) {
	   if (dim) {
	       av = newAV();
	       PUSHs(sv_2mortal(newRV_noinc((SV*)av)));
	   } else
	       av = 0;
       } else if (SvROK(sv) && SvTYPE(SvRV(sv))==SVt_PVAV) {
	   av = (AV*)SvRV(sv);
	   if (!keep)
	       av_clear(av);
	   PUSHs(sv);
       } else
	   croak("av is not an array reference");
       if (dim && !format)
	   croak("format should be present if dim > 0");
       p_s = SvPV(p, sz);
       PUTBACK;
       {
         carray_form f = sv_2_carray_form(dim, format);

         if (!checkfit(sz, sizeof_elt, dim, offset, f, f))
             croak("Array of negative size, or not fitting into a playground: "
		   "sz=%ld, sizeof(elt)=%ld, arity=%ld, offset=%ld",
		   (long)sz, (long)sizeof_elt, (long)dim, (long)offset);
         (desc->fp)(aTHX_ av, p_s + sizeof_elt*offset, dim, f);
       }
       SPAGAIN;    
   }

void
_0arg__INTERFACE(p, offset = 0, dim = 0, format = Nullsv)
	SV *p
	I32 offset
	int dim
	SV* format
    PPCODE:
   {
       char *p_s;
       STRLEN sz;
       dXSI32;		/* ix */
       const f_0arg_descr *desc = F0_get(ix);
       int sizeof_elt = desc->codes_name[0];

       if (dim && !format)
	   croak("format should be present if dim > 0");
       p_s = SvPV(p, sz);
       {
         carray_form f = sv_2_carray_form(dim, format);

         if (!checkfit(sz, sizeof_elt, dim, offset, f, f))
             croak("Array of negative size, or not fitting into a playground");
         (desc->fp)(p_s + sizeof_elt*offset, dim, f);
       }
       XSRETURN_YES;
   }

void
_1arg__INTERFACE(s_p, p, s_offset, offset, dim, sformat, format)
	SV *s_p
	SV *p
	I32 s_offset
	I32 offset
	int dim
	SV* sformat
	SV* format
    PPCODE:
   {
       char *p_s;
       const char *sp_s;
       STRLEN sz, ssz;
       dXSI32;		/* ix */
       const f_1arg_descr *desc = F1_get(ix);
       int sizeof_elt   = desc->codes_name[0];
       int s_sizeof_elt = desc->codes_name[1];

       if (dim && !(format && sformat))
	   croak("format should be present if dim > 0");
       p_s = SvPV(p, sz);
       sp_s = SvPV(s_p, ssz);
       {
         carray_form f = sv_2_carray_form(dim, format);
         carray_form s_f = sv_2_carray_form(dim, sformat);

         if (!checkfit(sz, sizeof_elt, dim, offset, f, f))
             croak("Target array of negative size, or not fitting into a playground");
         if (!checkfit(ssz, s_sizeof_elt, dim, s_offset, s_f, f))
             croak("Source array not fitting into a playground");
         (desc->fp)(sp_s + s_sizeof_elt * s_offset, p_s + sizeof_elt*offset, dim, s_f, f);
       }
       XSRETURN_YES;
   }

void
_2arg__INTERFACE(s1_p, s2_p, p, s1_offset, s2_offset, offset, dim, s1format, s2format, format)
	SV *s1_p
	SV *s2_p
	SV *p
	I32 s1_offset
	I32 s2_offset
	I32 offset
	int dim
	SV* s1format
	SV* s2format
	SV* format
    PPCODE:
   {			/* Not implemented yet */
       char *p_s;
       const char *s1p_s, *s2p_s;
       STRLEN sz, s1sz, s2sz;
       dXSI32;		/* ix */
       const f_2arg_descr *desc = F2_get(ix);
       int sizeof_elt    = desc->codes_name[0];
       int s1_sizeof_elt = desc->codes_name[1];
       int s2_sizeof_elt = desc->codes_name[2];

       if (dim && !(format && s1format && s2format))
	   croak("format should be present if dim > 0");
       p_s = SvPV(p, sz);
       s1p_s = SvPV(s1_p, s1sz);
       s2p_s = SvPV(s2_p, s2sz);
       {
         carray_form f = sv_2_carray_form(dim, format);
         carray_form s1_f = sv_2_carray_form(dim, s1format);
         carray_form s2_f = sv_2_carray_form(dim, s2format);

         if (!checkfit(sz, sizeof_elt, dim, offset, f, f))
             croak("Target array of negative size, or not fitting into a playground");
         if (!checkfit(s1sz, s1_sizeof_elt, dim, s1_offset, s1_f, f))
             croak("Source1 array not fitting into a playground");
         if (!checkfit(s2sz, s2_sizeof_elt, dim, s2_offset, s2_f, f))
             croak("Source2 array not fitting into a playground");
         (desc->fp)(s1p_s + s1_sizeof_elt * s1_offset,
				 s2p_s + s2_sizeof_elt * s2_offset,
				 p_s + sizeof_elt*offset, dim, s1_f, s2_f, f);
       }
       XSRETURN_YES;
   }

void
_2arg__INTERFACE_inverted(s2_p, s1_p, p, s2_offset, s1_offset, offset, dim, s2format, s1format, format)
	SV *s2_p
	SV *s1_p
	SV *p
	I32 s2_offset
	I32 s1_offset
	I32 offset
	int dim
	SV* s2format
	SV* s1format
	SV* format
    PPCODE:
   {			/* Not implemented yet */
       char *p_s;
       const char *s1p_s, *s2p_s;
       STRLEN sz, s1sz, s2sz;
       dXSI32;		/* ix */
       const f_2arg_descr *desc = F2_get(ix);
       int sizeof_elt    = desc->codes_name[0];
       int s1_sizeof_elt = desc->codes_name[1];
       int s2_sizeof_elt = desc->codes_name[2];

       if (dim && !(format && s1format && s2format))
	   croak("format should be present if dim > 0");
       p_s = SvPV(p, sz);
       s1p_s = SvPV(s1_p, s1sz);
       s2p_s = SvPV(s2_p, s2sz);
       {
         carray_form f = sv_2_carray_form(dim, format);
         carray_form s1_f = sv_2_carray_form(dim, s1format);
         carray_form s2_f = sv_2_carray_form(dim, s2format);

         if (!checkfit(sz, sizeof_elt, dim, offset, f, f))
             croak("Target array of negative size, or not fitting into a playground");
         if (!checkfit(s1sz, s1_sizeof_elt, dim, s1_offset, s1_f, f))
             croak("Source1 array not fitting into a playground");
         if (!checkfit(s2sz, s2_sizeof_elt, dim, s2_offset, s2_f, f))
             croak("Source2 array not fitting into a playground");
         (desc->fp)(s1p_s + s1_sizeof_elt * s1_offset,
				 s2p_s + s2_sizeof_elt * s2_offset,
				 p_s + sizeof_elt*offset, dim, s1_f, s2_f, f);
       }
       XSRETURN_YES;
   }

const char*
typeNames()

const char*
typeSizes()

const char*
duplicateTypes()

int
ptrdiff_t_size()

int
elementary_D_missing()

int
have_uquad2double()