"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "IO/HDF/VS/VS.pd" between
PDL-2.081.tar.gz and PDL-2.082.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

[ To the main PDL source changes report ]

VS.pd  (PDL-2.081):VS.pd  (PDL-2.082)
skipping to change at line 128 skipping to change at line 128
int SDselect(int sd_id, int index); int SDselect(int sd_id, int index);
int SDgetinfo(int sds_id, char *sds_name, int *rank, int *dimsizes, int *number_ type, int *nattrs); int SDgetinfo(int sds_id, char *sds_name, int *rank, int *dimsizes, int *number_ type, int *nattrs);
int SDendaccess(int sds_id); int SDendaccess(int sds_id);
int SDend(int sd_id); int SDend(int sd_id);
EODEF EODEF
pp_addxs('',<<'ENDOFXS'); pp_addxs('',<<'ENDOFXS');
int int
_WriteMultPDL(VID, nb_records, nb_fields, interlace_mode, ...); _WriteMultPDL(VID, nb_records, nb_fields, interlace_mode, sizeofPDL, sdimofPDL, listofPDL);
int VID int VID
int nb_records int nb_records
int nb_fields int nb_fields
int interlace_mode int interlace_mode
AV *sizeofPDL
AV *sdimofPDL
AV *listofPDL
PROTOTYPE: @ PROTOTYPE: @
CODE: CODE:
unsigned char *databuff, *ptrbuff; unsigned long int total_size = 0;
unsigned long int total_size; int i, j, k;
int i, j, k, curvalue, cursdim;
SV * sizeofPDL;
SV * listofPDL;
SV * sdimofPDL;
SV * * SvTmp1, * * SvTmp2, * * SvTmp3;
pdl *curPDL;
sizeofPDL = SvRV( ST(4) );
sdimofPDL = SvRV( ST(5) );
listofPDL = SvRV( ST(6) );
total_size = 0;
for(i=0; i<nb_fields; i++) for(i=0; i<nb_fields; i++)
{ {
SvTmp1 = av_fetch((AV*)sizeofPDL, i, 0); SV **SvTmp1 = av_fetch(sizeofPDL, i, 0);
curvalue = SvIV( *SvTmp1 ); int curvalue = SvIV( *SvTmp1 );
SvTmp3 = av_fetch((AV*)sdimofPDL, i, 0); SV **SvTmp3 = av_fetch(sdimofPDL, i, 0);
cursdim = SvIV( *SvTmp3 ); int cursdim = SvIV( *SvTmp3 );
total_size += curvalue * cursdim; total_size += curvalue * cursdim;
} }
total_size *= nb_records; total_size *= nb_records;
databuff = (unsigned char *)malloc( total_size ); unsigned char *databuff = (unsigned char *)malloc( total_size );
if(databuff==NULL) if(databuff==NULL)
croak("memory allocation error"); croak("memory allocation error");
ptrbuff = databuff; unsigned char *ptrbuff = databuff;
if(interlace_mode == 0) if(interlace_mode == 0)
{ {
for(i=0; i<nb_records; i++) for(i=0; i<nb_records; i++)
{ {
for(j=0; j<nb_fields; j++) for(j=0; j<nb_fields; j++)
{ {
SvTmp2 = av_fetch((AV*)listofPDL, j, 0); SV **SvTmp2 = av_fetch(listofPDL, j, 0);
curPDL = PDL->SvPDLV( *SvTmp2 ); pdl *curPDL = PDL->SvPDLV( *SvTmp2 );
SvTmp3 = av_fetch((AV*)sdimofPDL, j, 0); SV **SvTmp3 = av_fetch(sdimofPDL, j, 0);
cursdim = SvIV( *SvTmp3 ); int cursdim = SvIV( *SvTmp3 );
SvTmp1 = av_fetch((AV*)sizeofPDL, j, 0); SV **SvTmp1 = av_fetch(sizeofPDL, j, 0);
curvalue = SvIV( *SvTmp1 ); int curvalue = SvIV( *SvTmp1 );
for(k=0; k<cursdim; k++) for(k=0; k<cursdim; k++)
{ {
#printf("Value %d= %d\n", k, *(int *)(curPDL->data + curvalue*i + curvalue*k*nb_records)); #printf("Value %d= %d\n", k, *(int *)(curPDL->data + curvalue*i + curvalue*k*nb_records));
memcpy( ptrbuff, (unsigned char *)(curPDL->data + cu rvalue*i + curvalue*k*nb_records), curvalue ); memcpy( ptrbuff, (unsigned char *)(curPDL->data + cu rvalue*i + curvalue*k*nb_records), curvalue );
#printf("Value %d=%d\n", k, *(int *)(curPDL->data + curvalue*i*cursdim + curvalue*k)); #printf("Value %d=%d\n", k, *(int *)(curPDL->data + curvalue*i*cursdim + curvalue*k));
#memcpy( ptrbuff, (unsigned char *)(curPDL->data + c urvalue*i*cursdim + curvalue*k), curvalue ); #memcpy( ptrbuff, (unsigned char *)(curPDL->data + c urvalue*i*cursdim + curvalue*k), curvalue );
#printf("buffer %d= %d\n", k, *(int *)ptrbuff); #printf("buffer %d= %d\n", k, *(int *)ptrbuff);
ptrbuff += curvalue; ptrbuff += curvalue;
} }
} }
} }
} }
else else
{ {
for(j=0; j<nb_fields; j++) for(j=0; j<nb_fields; j++)
{ {
SvTmp2 = av_fetch((AV*)listofPDL, j, 0); SV **SvTmp2 = av_fetch(listofPDL, j, 0);
curPDL = PDL->SvPDLV( *SvTmp2 ); pdl *curPDL = PDL->SvPDLV( *SvTmp2 );
SvTmp1 = av_fetch((AV*)sizeofPDL, j, 0); SV **SvTmp3 = av_fetch(sdimofPDL, j, 0);
curvalue = SvIV( *SvTmp1 ); int cursdim = SvIV( *SvTmp3 );
SvTmp3 = av_fetch((AV*)sdimofPDL, j, 0); SV **SvTmp1 = av_fetch(sizeofPDL, j, 0);
cursdim = SvIV( *SvTmp3 ); int curvalue = SvIV( *SvTmp1 );
memcpy( ptrbuff, (unsigned char *)(curPDL->data), curvalue*n b_records*cursdim ); memcpy( ptrbuff, (unsigned char *)(curPDL->data), curvalue*n b_records*cursdim );
ptrbuff += curvalue*nb_records*cursdim; ptrbuff += curvalue*nb_records*cursdim;
#printf("buffer %d= %d\n", k, curvalue*nb_records*cursdim); #printf("buffer %d= %d\n", k, curvalue*nb_records*cursdim);
} }
interlace_mode = 1; interlace_mode = 1;
} }
fprintf(stderr, "Calling VSwrite(VID=%d, databuff=%p, nb_records=%d, interlace_mode=%d)...\n", fprintf(stderr, "Calling VSwrite(VID=%d, databuff=%p, nb_records=%d, interlace_mode=%d)...\n",
VID, databuff, nb_records, interlace_mode); VID, databuff, nb_records, interlace_mode);
RETVAL = VSwrite(VID, databuff, nb_records, interlace_mode); RETVAL = VSwrite(VID, databuff, nb_records, interlace_mode);
free(databuff);
OUTPUT: OUTPUT:
RETVAL RETVAL
void SV *
_Vgetname(vgroup_id, vgroup_name); _Vgetname(vgroup_id);
int vgroup_id int vgroup_id
char *vgroup_name
CODE: CODE:
vgroup_name=(char *)malloc(VGNAMELENMAX); uint16 len;
if (Vgetnamelen(vgroup_id, &len)) croak("Failed to get Vgetnamel
en for ID=%d", vgroup_id);
char vgroup_name[len+1];
Vgetname(vgroup_id,vgroup_name); Vgetname(vgroup_id,vgroup_name);
RETVAL = newSVpvn(vgroup_name,len);
OUTPUT: OUTPUT:
vgroup_name RETVAL
void SV *
_VSgetname(vdata_id, vdata_name); _VSgetname(vdata_id);
int vdata_id int vdata_id
char *vdata_name
CODE: CODE:
vdata_name=(char *)malloc(VGNAMELENMAX*sizeof(char)); char vdata_name[VGNAMELENMAX];
VSgetname(vdata_id,vdata_name); VSgetname(vdata_id,vdata_name);
RETVAL = newSVpv(vdata_name,0);
OUTPUT: OUTPUT:
vdata_name RETVAL
void SV *
_Vgetclass(vgroup_id, vgroup_class); _Vgetclass(vgroup_id);
int vgroup_id int vgroup_id
char *vgroup_class
CODE: CODE:
vgroup_class=(char *)malloc(VGNAMELENMAX*sizeof(char)); uint16 len;
if (Vgetclassnamelen(vgroup_id, &len)) croak("Failed to get Vget
classnamelen for ID=%d", vgroup_id);
char vgroup_class[len+1];
Vgetclass(vgroup_id,vgroup_class); Vgetclass(vgroup_id,vgroup_class);
RETVAL = newSVpvn(vgroup_class,len);
OUTPUT: OUTPUT:
vgroup_class RETVAL
void SV *
_VSgetclass(vdata_id, vdata_class); _VSgetclass(vdata_id);
int vdata_id int vdata_id
char *vdata_class
CODE: CODE:
vdata_class=(char *)malloc(VGNAMELENMAX*sizeof(char)); char vdata_class[VGNAMELENMAX];
VSgetclass(vdata_id,vdata_class); VSgetclass(vdata_id,vdata_class);
RETVAL = newSVpv(vdata_class,0);
OUTPUT: OUTPUT:
vdata_class RETVAL
int int
_VSgetfields(vdata_id, fields); _VSgetfields(vdata_id, fields);
int vdata_id int vdata_id
char *fields char *fields
CODE: CODE:
char *tmpfields; char tmpfields[10000];
int len;
tmpfields=(char *)malloc(10000*sizeof(char));
RETVAL=VSgetfields(vdata_id, tmpfields); RETVAL=VSgetfields(vdata_id, tmpfields);
len=strlen(tmpfields); fields = tmpfields;
fields=(char *)malloc(len*sizeof(char)+1);
strcpy(fields,tmpfields);
OUTPUT: OUTPUT:
RETVAL RETVAL
fields fields
AV * AV *
_VSlone(file_id); _VSlone(file_id);
int file_id; int file_id;
CODE: CODE:
AV *ref_vdata_list; AV *ref_vdata_list=newAV();
int *ref_array; int ref_array[MAX_FIELD_SIZE];
SV *ref_vdata; int32 nlone = VSlone(file_id, ref_array, MAX_FIELD_SIZE);
int32 nlone;
ref_vdata_list=newAV();
ref_array=(int *)malloc(MAX_FIELD_SIZE*sizeof(int));
nlone = VSlone(file_id, ref_array, MAX_FIELD_SIZE);
int32 i; int32 i;
for(i=0;i<nlone;i++){ for(i=0;i<nlone;i++){
ref_vdata=newSViv((IV)ref_array[i]); av_push(ref_vdata_list, newSViv((IV)ref_array[i]));
av_push(ref_vdata_list, ref_vdata);
} }
RETVAL=ref_vdata_list; RETVAL=ref_vdata_list;
OUTPUT: OUTPUT:
RETVAL RETVAL
int void
_VSinquire(vdata_id, n_records, interlace, fields, vdata_size, vdata_name); _VSinquire(vdata_id, n_records, interlace, fields, vdata_size, vdata_name);
int vdata_id int vdata_id
int *n_records int *n_records
int *interlace int *interlace
char *fields char *fields
int *vdata_size int *vdata_size
char *vdata_name char *vdata_name
CODE: CODE:
char *tmpfields; char tmpfields[10000];
int len; char tmpname[VGNAMELENMAX];
vdata_name=(char *)malloc(VGNAMELENMAX*sizeof(char)); if (VSinquire(vdata_id, n_records, interlace, tmpfields, vdata_size, tmp
tmpfields=(char *)malloc(10000*sizeof(char)); name))
RETVAL=VSinquire(vdata_id, n_records, interlace, tmpfields, vdata_size, croak("PDL::IO::HDF::VS::_VSinquire (vdata_id=%d)",vdata_id);
vdata_name)+1; vdata_name=tmpname;
len=strlen(tmpfields); fields = tmpfields;
fields=(char *)malloc(len*sizeof(char)+1);
strcpy(fields,tmpfields);
OUTPUT: OUTPUT:
RETVAL
n_records n_records
interlace interlace
fields fields
vdata_size vdata_size
vdata_name vdata_name
ENDOFXS ENDOFXS
pp_addpm(<<'EOPM'); pp_addpm(<<'EOPM');
skipping to change at line 410 skipping to change at line 394
my $vg_ref = -1; my $vg_ref = -1;
while( ($vg_ref = PDL::IO::HDF::VS::_Vgetid( $self->{HID}, $vg_ref )) != PDL::IO::HDF->FAIL) while( ($vg_ref = PDL::IO::HDF::VS::_Vgetid( $self->{HID}, $vg_ref )) != PDL::IO::HDF->FAIL)
{ {
my $vg_id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $vg_ref, 'r' ) ; my $vg_id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $vg_ref, 'r' ) ;
my $n_entries = 0; my $n_entries = 0;
my $vg_name = " "x(PDL::IO::HDF->VNAMELENMAX+1); my $vg_name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
my $res = PDL::IO::HDF::VS::_Vinquire( $vg_id, $n_entries, $vg_name ); my $res = PDL::IO::HDF::VS::_Vinquire( $vg_id, $n_entries, $vg_name );
my $vg_class = "";
PDL::IO::HDF::VS::_Vgetclass( $vg_id, $vg_class );
$vgroup->{$vg_name}->{ref} = $vg_ref; $vgroup->{$vg_name}->{ref} = $vg_ref;
$vgroup->{$vg_name}->{class} = $vg_class; $vgroup->{$vg_name}->{class} = PDL::IO::HDF::VS::_Vgetclass( $vg_id );
my $n_pairs = PDL::IO::HDF::VS::_Vntagrefs( $vg_id ); my $n_pairs = PDL::IO::HDF::VS::_Vntagrefs( $vg_id );
for ( 0 .. $n_pairs-1 ) for ( 0 .. $n_pairs-1 )
{ {
my ($tag, $ref); my ($tag, $ref);
$res = PDL::IO::HDF::VS::_Vgettagref( $vg_id, $_, $tag = 0, $ref = 0 ); $res = PDL::IO::HDF::VS::_Vgettagref( $vg_id, $_, $tag = 0, $ref = 0 );
if($tag == 1965) if($tag == 1965)
{ # Vgroup { # Vgroup
my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'r' ); my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'r' );
my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1); my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
my $res = PDL::IO::HDF::VS::_Vgetname( $id, $name ); my $res = PDL::IO::HDF::VS::_Vgetname( $id, $name );
PDL::IO::HDF::VS::_Vdetach( $id ); PDL::IO::HDF::VS::_Vdetach( $id );
$vgroup->{$vg_name}->{children}->{$name} = $ref; $vgroup->{$vg_name}->{children}->{$name} = $ref;
$vgroup->{$name}->{parents}->{$vg_name} = $vg_ref; $vgroup->{$name}->{parents}->{$vg_name} = $vg_ref;
} }
elsif($tag == 1962) elsif($tag == 1962)
{ # Vdata { # Vdata
my $id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $ref, 'r ' ); my $id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $ref, 'r ' );
my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1); my $name = PDL::IO::HDF::VS::_VSgetname( $id );
my $res = PDL::IO::HDF::VS::_VSgetname( $id, $name ); my $class = PDL::IO::HDF::VS::_VSgetclass( $id );
my $class = "";
PDL::IO::HDF::VS::_VSgetclass( $id, $class );
PDL::IO::HDF::VS::_VSdetach( $id ); PDL::IO::HDF::VS::_VSdetach( $id );
$vgroup->{$vg_name}->{attach}->{$name}->{type} = 'VData'; $vgroup->{$vg_name}->{attach}->{$name}->{type} = 'VData';
$vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref; $vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref;
$vgroup->{$vg_name}->{attach}->{$name}->{class} = $class $vgroup->{$vg_name}->{attach}->{$name}->{class} = $class
if( $class ne '' ); if( $class ne '' );
} }
if( ($SDID != PDL::IO::HDF->FAIL) && ($tag == 720)) #tag for SDS tag/ref (see 702) if( ($SDID != PDL::IO::HDF->FAIL) && ($tag == 720)) #tag for SDS tag/ref (see 702)
{ {
my $i = _SDreftoindex( $SDID, $ref ); my $i = _SDreftoindex( $SDID, $ref );
my $sds_ID = _SDselect( $SDID, $i ); my $sds_ID = _SDselect( $SDID, $i );
skipping to change at line 485 skipping to change at line 464
my $MAX_REF = 0; my $MAX_REF = 0;
while ( $vdata_ref = shift @$lone ) while ( $vdata_ref = shift @$lone )
{ {
my $mode="r"; my $mode="r";
if ( $self->{ACCESS_MODE} != PDL::IO::HDF->DFACC_READ ) if ( $self->{ACCESS_MODE} != PDL::IO::HDF->DFACC_READ )
{ {
$mode="w"; $mode="w";
} }
$vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, $ mode ); $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, $ mode );
my $vdata_size = 0;
my $n_records = 0; my $n_records = 0;
my $interlace = 0; my $interlace = 0;
my $fields = ""; my $fields = "";
my $vdata_size = 0;
my $vdata_name = ""; my $vdata_name = "";
my $status = PDL::IO::HDF::VS::_VSinquire( PDL::IO::HDF::VS::_VSinquire(
$vdata_id, $n_records, $interlace, $fields, $vdata_s ize, $vdata_name ); $vdata_id, $n_records, $interlace, $fields, $vdata_s ize, $vdata_name );
die "PDL::IO::HDF::VS::_VSinquire (vdata_id=$vdata_id)"
unless $status;
$vdata->{$vdata_name}->{REF} = $vdata_ref; $vdata->{$vdata_name}->{REF} = $vdata_ref;
$vdata->{$vdata_name}->{NREC} = $n_records; $vdata->{$vdata_name}->{NREC} = $n_records;
$vdata->{$vdata_name}->{INTERLACE} = $interlace; $vdata->{$vdata_name}->{INTERLACE} = $interlace;
$vdata->{$vdata_name}->{ISATTR} = PDL::IO::HDF::VS::_VSisattr( $vdat a_id ); $vdata->{$vdata_name}->{ISATTR} = PDL::IO::HDF::VS::_VSisattr( $vdat a_id );
my $field_index = 0; my $field_index = 0;
foreach my $onefield ( split( ",", $fields ) ) foreach my $onefield ( split( ",", $fields ) )
{ {
$vdata->{$vdata_name}->{FIELDS}->{$onefield}->{TYPE} = $vdata->{$vdata_name}->{FIELDS}->{$onefield}->{TYPE} =
skipping to change at line 676 skipping to change at line 653
die "$sub: vdata name $name doesn't exist!\n" die "$sub: vdata name $name doesn't exist!\n"
unless $vdata_ref; unless $vdata_ref;
my $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, 'r' ); my $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, 'r' );
my $vdata_size = 0; my $vdata_size = 0;
my $n_records = 0; my $n_records = 0;
my $interlace = 0; my $interlace = 0;
my $fields = ""; my $fields = "";
my $vdata_name = ""; my $vdata_name = "";
my $status = PDL::IO::HDF::VS::_VSinquire( PDL::IO::HDF::VS::_VSinquire(
$vdata_id, $n_records, $interlace, $fields, $vdata_size, $vd ata_name ); $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vd ata_name );
my $data_type = PDL::IO::HDF::VS::_VFfieldtype( my $data_type = PDL::IO::HDF::VS::_VFfieldtype(
$vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{IND EX} ); $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{IND EX} );
die "$sub: data_type $data_type not implemented!\n" die "$sub: data_type $data_type not implemented!\n"
unless defined( $PDL::IO::HDF::SDinvtypeTMAP->{$data_type} ); unless defined( $PDL::IO::HDF::SDinvtypeTMAP->{$data_type} );
my $order = PDL::IO::HDF::VS::_VFfieldorder( my $order = PDL::IO::HDF::VS::_VFfieldorder(
$vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{IND EX} ); $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{IND EX} );
if($order == 1) if($order == 1)
{ {
$data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records ); $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records );
} }
else else
{ {
$data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records, $ order ); $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records, $ order );
} }
$status = PDL::IO::HDF::VS::_VSsetfields( $vdata_id, $field ); my $status = PDL::IO::HDF::VS::_VSsetfields( $vdata_id, $field );
die "$sub: _VSsetfields\n" die "$sub: _VSsetfields\n"
unless $status; unless $status;
$status = PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlac e); $status = PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlac e);
PDL::IO::HDF::VS::_VSdetach( $vdata_id ); PDL::IO::HDF::VS::_VSdetach( $vdata_id );
return $data; return $data;
} # End of VSread()... } # End of VSread()...
 End of changes. 50 change blocks. 
93 lines changed or deleted 72 lines changed or added
To the C Programs section of the PDL source changes report or the top of this page
Mainly generated by pkgdiff using rfcdiff
Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)