view release on metacpan or  search on metacpan

util.c  view on Meta::CPAN

    unpack1D(*av_fetch(avs[ndims-2],places[ndims-2],0),tmp_var,dims[ndims-1],datatype,perlyunpack);
    tmp_var += skip;
    written += skip;

    places[ndims-2]++;
    for (i=ndims-2;i>=0; i--) {
      if (places[i] >= dims[i]) {
	places[i] = 0;
	if (i>0)
	  places[i-1]++;
      }
      else
	break;
    }
  }
  free(places);
  free(avs);
}

void unpackND (SV* arg, void* var, int ndims, long *dims,
	       int datatype, int perlyunpack)
{
  LONGLONG* dimsll;
  int i;

  if (1==ndims) {
    unpack1D(arg, var, dims[0], datatype, perlyunpack);
    return;
  }

  dimsll = malloc(ndims*sizeof(LONGLONG));

  for (i=0; i<ndims; ++i)
    dimsll[i] = dims[i];
  unpackNDll(arg, var, ndims, dimsll, datatype, perlyunpack);
  free(dimsll);
  return;
}

/*
 * Set argument's value to (copied) data.
 */
void unpack2scalar ( SV * arg, void * var, long n, int datatype ) {
  long data_length;

  if (datatype == TSTRING)
    croak("unpack2scalar() - how did you manage to call me with a TSTRING datatype?!");

  data_length = n * sizeof_datatype(datatype);

  SvGROW(arg, data_length);
  memcpy(SvPV(arg,PL_na), var, data_length);

  return;
}

/*
 * Takes a pointer to a single value of any given type, puts
 * that value into the passed Perl scalar
 *
 * Note that type TSTRING does _not_ imply a (char **) was passed,
 * but rather a (char *).
 */
void unpackScalar(SV * arg, void * var, int datatype) {
  SV* tmp_sv[2];

  if (var == NULL) {
    sv_setpvn(arg,"",0);
    return;
  }
  switch (datatype) {
  case TSTRING:
    sv_setpv(arg,(char *)var); break;
  case TLOGICAL:
    sv_setiv(arg,(IV)(*(logical *)var)); break;
  case TSBYTE:
    sv_setiv(arg,(IV)(*(sbyte *)var)); break;
  case TBYTE:
    sv_setuv(arg,(UV)(*(byte *)var)); break;
  case TUSHORT:
    sv_setuv(arg,(UV)(*(unsigned short *)var)); break;
  case TSHORT:
    sv_setiv(arg,(IV)(*(short *)var)); break;
  case TUINT:
    sv_setuv(arg,(UV)(*(unsigned int *)var)); break;
  case TINT:
    sv_setiv(arg,(IV)(*(int *)var)); break;
  case TULONG:
    sv_setuv(arg,(UV)(*(unsigned long *)var)); break;
  case TLONG:
    sv_setiv(arg,(IV)(*(long *)var)); break;
  case TLONGLONG:
    sv_setiv(arg,(IV)(*(LONGLONG *)var)); break;
#ifdef TULONGLONG
  case TULONGLONG:
    sv_setiv(arg,(IV)(*(ULONGLONG *)var)); break;
#endif
  case TFLOAT:
    sv_setnv(arg,(double)(*(float *)var)); break;
  case TDOUBLE:
    sv_setnv(arg,(double)(*(double *)var)); break;
  case TCOMPLEX:
    tmp_sv[0] = newSVnv(*((float *)var));
    tmp_sv[1] = newSVnv(*((float *)var+1));
    sv_setsv(arg,newRV_noinc((SV*)av_make(2,tmp_sv)));
    SvREFCNT_dec(tmp_sv[0]);
    SvREFCNT_dec(tmp_sv[1]);
    break;
  case TDBLCOMPLEX:
    tmp_sv[0] = newSVnv(*((double *)var));
    tmp_sv[1] = newSVnv(*((double *)var+1));
    sv_setsv(arg,newRV_noinc((SV*)av_make(2,tmp_sv)));
    SvREFCNT_dec(tmp_sv[0]);
    SvREFCNT_dec(tmp_sv[1]);
    break;
  default:
    croak("unpackScalar() - invalid type (%d) given",datatype);
  }
  return;
}