view release on metacpan or  search on metacpan

util.c  view on Meta::CPAN

		unpack2scalar(arg,var,ndata,datatype);
		return;
	}

	places = malloc((ndims-1) * sizeof(long));
	for (i=0;i<ndims-1;i++)
		places[i] = 0;
	avs = malloc((ndims-1) * sizeof(AV*));

	coerceND(arg,ndims,dims);

	avs[0] = (AV*)SvRV(arg);
	skip = dims[ndims-1] * sizeof_datatype(datatype);

	written = 0;
	while (written < nbytes) {
		for (i=1;i<ndims-1;i++)
			avs[i] = (AV*)SvRV(*av_fetch(avs[i-1],places[i-1],0));

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

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

/*
 * Set argument's value to (copied) data.
 */
void unpack2scalar ( SV * arg, void * var, long n, int datatype ) {
	unsigned 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);

	/*sv_setpvn(arg, (char *)var, data_length);*/  /* TBYTEs were screwy */

	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 TBYTE:
			sv_setiv(arg,(IV)(*(byte *)var)); break;
		case TUSHORT:
			sv_setiv(arg,(IV)(*(unsigned short *)var)); break;
		case TSHORT:
			sv_setiv(arg,(IV)(*(short *)var)); break;
		case TUINT:
			sv_setiv(arg,(IV)(*(unsigned int *)var)); break;
		case TINT:
			sv_setiv(arg,(IV)(*(int *)var)); break;
		case TULONG:
			sv_setiv(arg,(IV)(*(unsigned long *)var)); break;
		case TLONG:
			sv_setiv(arg,(IV)(*(long *)var)); break;
		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;
}

void unpack1D ( SV * arg, void * var, long n, int datatype ) {

	char ** stringvar;
	logical * logvar;
	byte * bvar;
	unsigned short * usvar;
	short * svar;
	unsigned int * uivar;