void rdhdl_c(int thandle,Const char *keyword,int8 *value,int8 defval)
/** rdhdl -- Read an integer*8-valued header variable. */
/*& mjs */
/*: header-i/o */
/*+ FORTRAN call sequence:
subroutine rdhdl(tno,keyword,value,default)
integer tno
character keyword*(*)
integer*8 value,default
Read an integer*8 valued header variable. Only supported on some
compilers. See comments in wrhdl
Input:
tno The file handle of the data set.
keyword The name of the header variable.
default The default value to return, if the header variable
is not found.
Output:
value The value of the header variable. This will be the default
value, if the variable is missing from the header. */
/*-- */
/*----------------------------------------------------------------------*/
{
int item;
char s[ITEM_HDR_SIZE];
int iostat,length,offset,itemp;
/* Firstly assume the variable is missing. Try to get it. If successful
read it. */
*value = defval;
haccess_c(thandle,&item,keyword,"read",&iostat); if(iostat)return;
length = hsize_c(item);
if(length >= 0){
/* Determine the type of the value, and convert it to double precision. */
hreadb_c(item,s,0,ITEM_HDR_SIZE,&iostat); check(iostat);
iostat = 0;
if( !memcmp(s,int8_item, ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE, H_INT8_SIZE);
if(offset + H_INT8_SIZE == length)
hreadl_c(item,value,offset,H_INT8_SIZE,&iostat);
} else if ( !memcmp(s,int_item, ITEM_HDR_SIZE)){
/* this is to cover old style MIR3 files that were using int4's */
offset = mroundup(ITEM_HDR_SIZE, H_INT_SIZE);
if(offset + H_INT_SIZE == length) {
hreadi_c(item,&itemp,offset,H_INT_SIZE,&iostat);
*value = itemp;
}
} else
bugv_c('f',"rdhdl_c: item %s not an int8 or small enough int4",keyword);
check(iostat);
}
hdaccess_c(item,&iostat); check(iostat);
}
void dread_c(int fd, char *buffer,off_t offset,size_t length,int *iostat)
/*
Read from a file.
------------------------------------------------------------------------*/
{
ssize_t nread;
#ifdef debug
if (length >= SSIZE_MAX) bugv_c('f',"dread_c: possible incomplete read");
#endif
if(Lseek(fd,offset,SEEK_SET) < 0) { *iostat = errno; return; }
while (length) {
nread = read(fd,buffer,length);
if(nread < 0) {
if(errno == EINTR)
nread = 0; /* should reattempt the system call identically */
else {
*iostat = errno;
return;
}
} else if(nread == 0) {
/* unexpected EOF -- no good errno code for this */
*iostat = EIO;
return;
}
length -= nread;
}
}
void rdhdi_c(int thandle,Const char *keyword,int *value,int defval)
/** rdhdi -- Read an integer-valued header variable. */
/*& mjs */
/*: header-i/o */
/*+ FORTRAN call sequence:
subroutine rdhdi(tno,keyword,value,default)
integer tno
character keyword*(*)
integer value,default
Read an integer valued header variable.
Input:
tno The file handle of the data set.
keyword The name of the header variable.
default The default value to return, if the header variable
is not found.
Output:
value The value of the header variable. This will be the default
value, if the variable is missing from the header. */
/*-- */
/*----------------------------------------------------------------------*/
{
int8 lvalue,ldefval;
ldefval = defval;
rdhdl_c(thandle,keyword,&lvalue,ldefval);
if(lvalue > 0x7FFFFFFF)
bugv_c('f',"Item %s too large for rdhdi: %ld",keyword,lvalue);
*value = lvalue;
}
void dwrite_c(int fd, char *buffer,off_t offset,size_t length,int *iostat)
/*
Write to a file.
------------------------------------------------------------------------*/
{
ssize_t nwrite;
#ifdef debug
if (length >= SSIZE_MAX) bugv_c('f',"dwrite_c: possible incomplete write");
#endif
if(Lseek(fd,offset,SEEK_SET) < 0) { *iostat = errno; return; }
nwrite = write(fd,buffer,length);
if(nwrite < 0) *iostat = errno;
else if(nwrite != (ssize_t) length) *iostat = EIO;
}
void dread_c(int fd, char *buffer,off_t offset,size_t length,int *iostat)
/*
Read from a file.
------------------------------------------------------------------------*/
{
ssize_t nread;
#ifdef debug
if (length >= SSIZE_MAX) bugv_c('f',"dread_c: possible incomplete read");
#endif
if(Lseek(fd,offset,SEEK_SET) < 0) { *iostat = errno; return; }
nread = read(fd,buffer,length);
if(nread < 0) *iostat = errno;
else if(nread != (ssize_t) length) *iostat = EIO;
}
void dwrite_c(int fd, char *buffer,off_t offset,size_t length,int *iostat)
/*
Write to a file.
------------------------------------------------------------------------*/
{
ssize_t nwrite;
#ifdef debug
if (length >= SSIZE_MAX) bugv_c('f',"dwrite_c: possible incomplete write");
#endif
if(Lseek(fd,offset,SEEK_SET) < 0) { *iostat = errno; return; }
while (length) {
nwrite = write(fd,buffer,length);
if(nwrite < 0) {
if(errno == EINTR)
nwrite = 0; /* should reattempt the system call identically */
else {
*iostat = errno;
return;
}
}
length -= nwrite;
}
}
void hdprobe_c(int tno,Const char *keyword,char *descr,size_t length,char *type,int *n)
/** hdprobe -- Determine characteristics of a header variable. */
/*& mjs */
/*: header-i/o */
/*+ FORTRAN call sequence:
subroutine hdprobe(tno,keyword,descr,type,n)
integer tno
character keyword*(*),descr*(*),type*(*)
integer n
Determine characteristics of a particular header variable.
Inputs:
tno Handle of the data set.
keyword Name of the header variable to probe.
Outputs:
descr A formatted version of the item. For single numerics or
short strings, this is the ascii encoding of the value. For
large items, this is some message describing the item.
type One of:
'nonexistent'
'integer*2'
'integer*8'
'integer'
'real'
'double'
'complex'
'character'
'text'
'binary'
n Number of elements in the item. Zero implies an error. One
implies that "descr" is the ascii encoding of the value. */
/*-- */
/*----------------------------------------------------------------------*/
{
int item;
char s[ITEM_HDR_SIZE],buf[MAXSIZE];
float rtemp,ctemp[2];
int iostat,unknown,size,i,itemp,offset,bufit;
double dtemp;
int2 jtemp;
int8 ltemp;
haccess_c(tno,&item,keyword,"read",&iostat);
*n = 0;
bufit = 0;
Strcpy(type,"nonexistent"); if(iostat)return;
size = hsize_c(item);
unknown = FALSE;
if(size <= ITEM_HDR_SIZE){
unknown = TRUE;
size -= ITEM_HDR_SIZE;
} else {
hreadb_c(item,s,0,ITEM_HDR_SIZE,&iostat); check(iostat);
if(!memcmp(s,real_item,ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE,H_REAL_SIZE);
size -= offset;
Strcpy(type,"real");
*n = size / H_REAL_SIZE;
if(size % H_REAL_SIZE) unknown = TRUE;
else if(size == H_REAL_SIZE){
hreadr_c(item,&rtemp,offset,H_REAL_SIZE,&iostat); check(iostat);
Sprintf(buf,"%-14.7g",rtemp);
bufit = 1;
}
} else if(!memcmp(s,int_item,ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE,H_INT_SIZE);
size -= offset;
Strcpy(type,"integer");
*n = size / H_INT_SIZE;
if(size % H_INT_SIZE) unknown = TRUE;
else if(size == H_INT_SIZE){
hreadi_c(item,&itemp,offset,H_INT_SIZE,&iostat); check(iostat);
Sprintf(buf,"%d",itemp);
bufit = 1;
}
} else if(!memcmp(s,int2_item,ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE,H_INT2_SIZE);
size -= offset;
Strcpy(type,"integer*2");
*n = size / H_INT2_SIZE;
if(size % H_INT2_SIZE) unknown = TRUE;
else if(size == H_INT2_SIZE){
hreadj_c(item,&jtemp,offset,H_INT2_SIZE,&iostat); check(iostat);
Sprintf(buf,"%d",jtemp);
bufit = 1;
}
} else if(!memcmp(s,int8_item,ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE,H_INT8_SIZE);
size -= offset;
Strcpy(type,"integer*8");
*n = size / H_INT8_SIZE;
if(size % H_INT8_SIZE) unknown = TRUE;
else if(size == H_INT8_SIZE){
hreadl_c(item,<emp,offset,H_INT8_SIZE,&iostat); check(iostat);
Sprintf(buf,"%lld",ltemp);
bufit = 1;
}
} else if(!memcmp(s,dble_item,ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE,H_DBLE_SIZE);
size -= offset;
Strcpy(type,"double");
*n = size / H_DBLE_SIZE;
if(size % H_DBLE_SIZE) unknown = TRUE;
else if(size == H_DBLE_SIZE){
hreadd_c(item,&dtemp,offset,H_DBLE_SIZE,&iostat); check(iostat);
Sprintf(buf,"%-20.10g",dtemp);
bufit = 1;
}
} else if(!memcmp(s,cmplx_item,ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE,H_CMPLX_SIZE);
size -= offset;
Strcpy(type,"complex");
*n = size / H_CMPLX_SIZE;
if(size % H_CMPLX_SIZE) unknown = TRUE;
else if(size == H_CMPLX_SIZE){
hreadr_c(item,ctemp,offset,H_CMPLX_SIZE,&iostat); check(iostat);
Sprintf(buf,"(%-14.7g,%-14.7g)",ctemp[0],ctemp[1]);
bufit = 1;
}
} else if(!memcmp(s,char_item,ITEM_HDR_SIZE)){
offset = ITEM_HDR_SIZE;
size -= offset;
size = min(size,MAXSIZE-1);
*n = 1;
Strcpy(type,"character");
hreadb_c(item,buf,ITEM_HDR_SIZE,size,&iostat); check(iostat);
*(buf+size) = 0;
bufit = 1;
} else if(!memcmp(s,binary_item,ITEM_HDR_SIZE)){
*n = size;
Strcpy(type,"binary");
} else{
Strcpy(type,"text");
*n = size + ITEM_HDR_SIZE;
for(i=0; i < ITEM_HDR_SIZE; i++)
if(!isspace(*(s+i)) && !isprint(*(s+i)))unknown = TRUE;
}
}
hdaccess_c(item,&iostat); check(iostat);
if(unknown){
Strcpy(type,"unknown");
*n = size + ITEM_HDR_SIZE;
} else if(bufit){
if(strlen(buf) > length - 1)
bugv_c('f',"Descr buffer overflow in hdprobe for %s",keyword);
strcpy(descr,buf);
}
}
void rdhdd_c(int thandle,Const char *keyword,double *value,double defval)
/** rdhdd -- Read a double precision-valued header variable. */
/*& mjs */
/*: header-i/o */
/*+ FORTRAN call sequence:
subroutine rdhdd(tno,keyword,value,default)
integer tno
character keyword*(*)
double precision value,default
Read a double precision valued header variable.
Input:
tno The file handle of the data set.
keyword The name of the header variable.
default The default value to return, if the header variable
is not found.
Output:
value The value of the header variable. This will be the default
value, if the variable is missing from the header. */
/*-- */
/*----------------------------------------------------------------------*/
{
int item;
char s[ITEM_HDR_SIZE];
int iostat,length,itemp,offset;
float rtemp;
/* Firstly assume the variable is missing. Try to get it. If successful
read it. */
*value = defval;
haccess_c(thandle,&item,keyword,"read",&iostat); if(iostat)return;
length = hsize_c(item);
if(length >= 0){
/* Determine the type of the value, and convert it to double precision. */
hreadb_c(item,s,0,ITEM_HDR_SIZE,&iostat); check(iostat);
iostat = 0;
if( !memcmp(s,int_item, ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE,H_INT_SIZE);
if(offset + H_INT_SIZE == length){
hreadi_c(item,&itemp,offset,H_INT_SIZE,&iostat);
*value = itemp;
}
} else if(!memcmp(s,real_item,ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE,H_REAL_SIZE);
if(offset + H_REAL_SIZE == length){
hreadr_c(item,&rtemp,offset,H_REAL_SIZE,&iostat);
*value = rtemp;
}
} else if(!memcmp(s,dble_item,ITEM_HDR_SIZE)){
offset = mroundup(ITEM_HDR_SIZE,H_DBLE_SIZE);
if(offset + H_DBLE_SIZE == length){
hreadd_c(item,value, offset,H_DBLE_SIZE,&iostat);
}
}
#if 0
/* can't do this: some routines, e.g. imhead, actually depend
* on it falling through. Sick, but true
*/
else
bugv_c('f',"rdhdd_c: keyword %s not covered here",keyword);
#endif
check(iostat);
}
hdaccess_c(item,&iostat); check(iostat);
}