void msg1Prtln( const char * text, int * status ) {
int err; /* return value from printf */
size_t len = 0; /* Length of input text */
if (*status != SAI__OK) return;
/* how many characters do we expect to deliver (including newline) */
len = strlen( text ) + 1;
/* Note that we must add the newline */
err = printf( "%s\n", text );
/* only call fflush if printf succeeded so as not to reset errno */
if (err > 0) fflush(stdout);
if (err < 0) {
*status = MSG__OPTER;
emsMark();
emsSyser( "ERR", errno );
emsRep( "MSG_PRINT_MESS",
"msg1Prtln: Error printing message to stdout: ^ERR", status );
emsRlse();
} else if ((size_t)err != len) {
emsMark();
*status = MSG__OPTER;
emsSeti( "NEX", len );
emsSeti( "NGOT", err );
emsRep("MSG_PRINT_MESS",
"msg1Prtln: Error printing message to stdout. Printed ^NGOT"
" characters but expected to print ^NEX", status );
emsRlse();
}
}
int rec1_unmap_frame( int slot, INT_BIG bloc, INT_BIG length,
INT_BIG offset, char mode,
unsigned char **pntr )
{
/*+ */
/* Name: */
/* rec1_unmap_frame */
/* Purpose: */
/* Unmap a frame of blocks from a container file. */
/* Invocation: */
/* rec1_unmap_frame( slot, bloc, length, offset, mode, pntr ) */
/* Description: */
/* This function unmaps all or part of a sequence of blocks from a */
/* container file which have previously been mapped for access using */
/* rec1_map_frame. */
/* Parameters: */
/* int slot */
/* Slot number of the container file in the File Control Vector. */
/* int bloc */
/* Number of the first container file block in the mapped frame (the */
/* first block in the file is no.1). */
/* int length */
/* Length of the mapped frame in unsigned chars. */
/* int offset */
/* Offset into the first block at which the mapped access starts */
/* (zero based, in unsigned chars). */
/* char mode */
/* Symbol giving the access mode with which the frame was originally */
/* accessed: 'R' for read access, 'U' for update access, 'W' for */
/* write access and 'Z' for demand zero access. */
/* unsigned char **pntr */
/* Pointer to a pointer to the first mapped unsigned char in memory. */
/* A null pointer value is returned. */
/* Returned Value: */
/* int rec1_unmap_frame */
/* The global status value current on exit. */
/* Notes: */
/* - This routine attempts to execute even if the HDS global status is */
/* set on entry, although no further error report will be made if it */
/* subsequently fails under these circumstances. */
/* - Care should be taken that the pointer supplied is valid, since an */
/* invalid pointer value may not be detected by this routine. The */
/* routine returns without action if *pntr is null. */
/* - The value of the global switch hds_gl_map when this routine is */
/* called should be the same as its value when the corresponding call to */
/* rec1_map_frame was made. This is to ensure that the same method of */
/* frame access (I/O or file mapping) is used in both cases. */
/* Copyright: */
/* Copyright (C) 1991 Science and Engineering Research Council. */
/* Copyright (C) 2005 Particle Physics and Astronomy Research Council */
/* Licence: */
/* This program is free software; you can redistribute it and/or */
/* modify it under the terms of the GNU General Public License as */
/* published by the Free Software Foundation; either version 2 of */
/* the License, or (at your option) any later version. */
/* This program is distributed in the hope that it will be */
/* useful, but WITHOUT ANY WARRANTY; without even the implied */
/* warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR */
/* PURPOSE. See the GNU General Public License for more details. */
/* You should have received a copy of the GNU General Public */
/* License along with this program; if not, write to the Free */
/* Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, */
/* MA 02110-1301, USA */
/* Authors: */
/* RFWS: R.F. Warren-Smith (STARLINK) */
/* PWD: Peter W. Draper (STARLINK, Durham University) */
/* TIMJ: Tim Jenness (JAC, Hawaii) */
/* {@enter_new_authors_here@} */
/* History: */
/* 25-MAR-1991 (RFWS): */
/* Original version, re-write of earlier routine. */
/* 3-MAY-1991 (RFWS): */
/* Removed the assumption of page-aligned data by adding the bloc and */
/* offset arguments and passing the length argument in unsigned chars */
/* instead of blocks. */
/* 3-MAY-1991 (RFWS): */
/* Added the mode argument. */
/* 8-MAY-1991 (RFWS): */
/* Added a portable implementation based on file I/O. */
/* 10-MAY-1991 (RFWS): */
/* Changed to cope with "demand zero" access mode. */
/* 28-JUN-1991 (RFWS): */
/* Added function prototype for VMS system call. */
/* 3-JUL-1991 (RFWS): */
/* Added VMS I/O based version. */
/* 4-JUL-1991 (RFWS): */
/* Added no action if a null pointer value is supplied. */
/* 19-DEC-1991 (RFWS): */
/* Changed VMS implementation to save freed virtual addresses for */
/* later re-use. */
/* 24-AUG-1992 (RFWS): */
/* Added sun4 version using file mapping. */
/* 7-JUL-1993 (RFWS): */
/* Extended memory mapping for use on all suitable machines. */
/* 16-FEB-1999 (RFWS): */
/* Deallocate exportable memory. */
/* 08-MAR-2005 (PWD): */
/* Call msync(MS_ASYNC) before unmapping memory. This should ensure */
/* that it is marked as dirty and requires commit to disk. To be sure */
/* that data is returned to disk we also need to fsync() when closing */
/* the file. These changes seem to be needed by the clarifications of */
/* the single UNIX standard (version 3). */
/* {@enter_further_changes_here@} */
/* Bugs: */
/* {@note_any_bugs_here@} */
/*- */
/* Local Variables: */
#if defined( vms ) /* VMS version local variables: */
int bloc1; /* First complete block */
int bloc2; /* Last complete block */
int brf; /* First block broken? */
int brl; /* Last block broken? */
int nbloc; /* Number of file blocks mapped */
int tail; /* Data mapped after last complete block? */
unsigned char *sect; /* Pointer to section of allocated memory */
unsigned char buffer[ REC__SZBLK ]; /* Block I/O buffer */
unsigned int actrng[ 2 ]; /* Actual address range deleted */
unsigned int range[ 2 ]; /* Virtual address range to delete */
unsigned int systat; /* System status code */
#else
#if defined( _mmap) || HAVE_MMAP
/* Local variables for version using mmap: */
size_t len; /* Length of data to unmap */
unsigned long int ipntr; /* Pointer value cast to an integer */
unsigned long int pagesize; /* System page size */
void *addr; /* Address of start of mapped section */
#endif
/* Portable version local variables: */
FILE *iochan; /* File I/O stream */
INT_BIG offs; /* File offset to start of data */
int writeok; /* Write operation completed successfully? */
#endif
/* External References: */
#if defined( vms ) /* VMS version system calls: */
unsigned int SYS$DELTVA /* Delete a range of virtual addresses */
( unsigned int *inadr,
unsigned int *retadr,
int acmode ); /* Not used */
/* System calls for version using mmap: */
#elif ( defined( _mmap) || HAVE_MMAP ) && \
!defined( _POSIX_MAPPED_FILES ) /* Use POSIX.4 mapped files */
int munmap /* Unmap pages of memory */
( void *addr,
size_t len );
#endif
/*. */
/* Check that the pointer supplied is not null. There is nothing to do if */
/* it is. */
if ( *pntr != NULL )
{
/* Start a new error reporting environment. */
emsBegin( &hds_gl_status );
/* VMS version: */
/* =========== */
#if defined( vms )
/* Use file mapping if required. */
/* ============================ */
if ( hds_gl_map )
{
/* Calculate where the start and end of the frame lie and delete this range */
/* of address spsce. */
range[ 0 ] = (unsigned int) *pntr;
range[ 1 ] = (unsigned int) ( *pntr + length - 1 );
systat = SYS$DELTVA( range, actrng, 0 );
/* If an error occurred, then set the global status and report a message. */
if ( !( systat & STS$M_SUCCESS ) )
{
hds_gl_status = DAT__FILMP;
rec1_fmsg( "FILE", slot );
emsSyser( "MESSAGE", systat );
emsRep( "REC1_UNMAP_FRAME_1",
"Error unmapping blocks in the file ^FILE - \
^MESSAGE.",
&hds_gl_status );
}
/* Note the range of virtual addresses used for the mapping is now free for */
/* re-use. */
else
{
static void *
dat1Mmap( size_t nbytes, int prot, int flags, int fd, off_t offset, int *isreg, void **pntr, size_t *actbytes, int * status ) {
void * mapped = NULL;
int tries = 0;
size_t pagesize = 0;
void * where = NULL;
off_t off = 0;
*pntr = NULL;
*isreg = 0;
if (*status != SAI__OK) return NULL;
/* We need to know the pagesize */
pagesize = sysconf( _SC_PAGESIZE );
*actbytes = nbytes;
if (offset > 0) {
/* Calculate the starting offset into the file and round this down to a */
/* multiple of the system page size. Calculate the number of bytes to map, */
/* allowing for this rounding. */
off = offset - ( offset % pagesize );
*actbytes += ( offset - off );
}
while (!mapped) {
*isreg = 0;
tries++;
if (*status != SAI__OK) goto CLEANUP;
/* Get some anonymous memory - we always have to map read/write
because we always have to copy data into this space. */
//printf("mmap(%p, %zu, %d, %d, %d, %zu -> %zu [%d])\n", where, *actbytes, prot, flags, fd, offset, off, pagesize);
mapped = mmap( where, *actbytes, prot, flags, fd, off );
if (mapped == MAP_FAILED) {
emsSyser( "MESSAGE", errno );
*status = DAT__FILMP;
emsRep("datMap_2", "Error mapping some memory: ^MESSAGE", status );
mapped = NULL;
*pntr = NULL;
goto CLEANUP;
}
/* The pointer we register is the one that has been corrected
for the shift we applied in the original request */
*pntr = mapped + (offset - off );
/* Must register with CNF so the pointer can be used by Fortran */
*isreg = cnfRegp( *pntr );
if (*isreg == -1) {
/* Serious internal error */
*status = DAT__FILMP;
emsRep("datMap_3", "Error registering a pointer for mapped data "
" - internal CNF error", status );
goto CLEANUP;
} else if (*isreg == 0) {
/* Free the memory and try again */
if ( munmap( mapped, *actbytes ) != 0 ) {
*status = DAT__FILMP;
emsSyser( "MESSAGE", errno );
emsRep("datMap_4", "Error unmapping mapped memory following"
" failed registration: ^MESSAGE", status);
goto CLEANUP;
}
if (!where) where = mapped;
where += pagesize;
mapped = NULL;
*pntr = NULL;
}
if (!mapped && tries > 100) {
*status = DAT__FILMP;
emsRepf("datMap_4b", "Failed to register mapped memory with CNF"
" after %d attempts", status, tries );
goto CLEANUP;
}
}
CLEANUP:
return mapped;
}
int
datMap(HDSLoc *locator, const char *type_str, const char *mode_str, int ndim,
const hdsdim dims[], void **pntr, int *status) {
int isprim = 0;
char normtypestr[DAT__SZTYP+1];
size_t nbytes = 0;
hid_t h5type = 0;
int isreg = 0;
void *regpntr = NULL;
void *mapped = NULL;
hdsmode_t accmode = HDSMODE_UNKNOWN;
haddr_t offset;
hdsbool_t try_mmap = HDS_FALSE;
unsigned intent = 0;
size_t actbytes = 0;
if (*status != SAI__OK) return *status;
/* First have to validate the access mode */
switch (mode_str[0]) {
case 'R':
case 'r':
accmode = HDSMODE_READ;
break;
case 'U':
case 'u':
accmode = HDSMODE_UPDATE;
break;
case 'W':
case 'w':
accmode = HDSMODE_WRITE;
break;
default:
*status = DAT__MODIN;
emsRepf("datMap_6", "Unrecognized mode string '%s' for datMap",
status, mode_str);
goto CLEANUP;
}
/* Validate input locator. */
dat1ValidateLocator( "datMap", 1, locator, (accmode & HDSMODE_READ), status );
/* Get the HDF5 type code and confirm this is a primitive type */
isprim = dau1CheckType( 1, type_str, &h5type, normtypestr,
sizeof(normtypestr), status );
if (!isprim) {
if (*status == SAI__OK) {
*status = DAT__TYPIN;
emsRepf("datMap_1", "datGet: Data type must be a primitive type and not '%s'",
status, normtypestr);
}
goto CLEANUP;
}
/* Not allowed to map undefined data in READ or UPDATE mode */
if (accmode == HDSMODE_UPDATE || accmode == HDSMODE_READ) {
hdsbool_t defined;
if (*status == SAI__OK) {
datState( locator, &defined, status );
if (!defined) {
*status = DAT__UNSET;
emsRepf("datMap_6bb", "Can not map an undefined primitive in mode '%s'",
status, mode_str);
goto CLEANUP;
}
}
}
/* How did we open this file? */
CALLHDFQ( H5Fget_intent( locator->file_id, &intent ));
if (accmode == HDSMODE_UPDATE || accmode == HDSMODE_WRITE) {
/* Must check whether the file was opened for write */
if ( intent == H5F_ACC_RDONLY ) {
*status = DAT__ACCON;
emsRepf("datMap_6b", "datMap: Can not map readonly locator in mode '%s'",
status, mode_str);
goto CLEANUP;
}
}
/* Verify that the specified dimensions match the locator dimensions */
if (*status == SAI__OK) {
hdsdim locdims[DAT__MXDIM];
int locndims;
int i;
datShape(locator, DAT__MXDIM, locdims, &locndims, status );
/* Note that if we are mapping as a scalar the locator should
refer to a single element */
if (ndim == 0) {
size_t nelem = 1;
for (i=0; i<locndims; i++) {
nelem *= locdims[i];
}
if (nelem != 1) {
*status = DAT__DIMIN;
emsRepf("datMap_6e", "datMap: Attempt to map as a scalar but locator"
" refers to a primitive with %zu elements",
status, nelem);
goto CLEANUP;
}
} else {
if (ndim != locndims) {
*status = DAT__DIMIN;
emsRepf("datMap_6c", "datMap: Dimensionality mismatch --"
" requested number: %d locator number: %d", status,
ndim, locndims );
goto CLEANUP;
}
for (i=0; i<ndim; i++) {
if ( locdims[i] != dims[i] ) {
*status = DAT__DIMIN;
emsRepf("datMap_6d", "datMap: Dimension %d has size %zu but requested size %zu",
status, i, (size_t)locdims[i], (size_t)dims[i]);
goto CLEANUP;
}
}
}
}
/* There is a super-special case for datMap when called with a map
type of "_CHAR". In that case we need to work out the size ourselves
and adjust the type size */
if (strcmp( "_CHAR", normtypestr ) == 0 ) {
size_t clen = 0;
char tmpbuff[DAT__SZTYP+1];
datClen( locator, &clen, status );
CALLHDFQ( H5Tset_size( h5type, clen ) );
one_snprintf( tmpbuff, sizeof(tmpbuff), "*%zu",
status, clen );
one_strlcat( normtypestr, tmpbuff, DAT__SZTYP+1, status );
}
/* Now we want the HDSTYPE of the requested type so that we can work out how much
memory we will need to allocate. */
CALLHDFE( size_t, nbytes,
H5Tget_size( h5type ),
DAT__HDF5E,
emsRep("datLen_size", "datMap: Error obtaining size of requested data type",
status)
);
{
int i;
if (ndim > 0) {
for (i = 0; i < ndim; i++) {
nbytes *= dims[i];
}
}
}
/* Work out whether memory mapping is possible -- at the moment
I'm pretty sure the only safe use of mmap is when we are reading
the data and the file itself was opened readonly. I'm not sure what happens
if other components are removed or added -- will the offset change? Maybe we just try */
offset = H5Dget_offset( locator->dataset_id );
if (offset != HADDR_UNDEF) {
hid_t dataset_h5type = 0;
/* In theory we can do a memory map so now compare
the data types of the request and the low-level dataset. */
CALLHDFE( hid_t, dataset_h5type,
H5Dget_type( locator->dataset_id ),
DAT__HDF5E,
emsRep("datMap_type", "datType: Error obtaining data type of dataset", status)
);
if (H5Tequal( dataset_h5type, h5type )) {
try_mmap = HDS_TRUE;
}
H5Tclose(dataset_h5type);
}
/* If this is a locator to a slice then for now we can't memory map. In theory
if we knew the slice was contiguous (e.g a vectorized slice, or a single
plane of a cube then we could mmap it anyhow. We do not want to have to
emulate HDF5 dataspaces here */
if (locator->isslice) try_mmap = 0;
/* There seem to be issues doing this on files opened for update/write.
For now only allow mmap for files opened read only */
if (intent != H5F_ACC_RDONLY) try_mmap = 0;
/* If mmap has been disabled by tuning the environment we just force it off here. */
if (!hds1GetUseMmap()) try_mmap = 0;
#if DEBUG_HDS
{
char *name_str;
char * file_str;
const char * reason;
name_str = dat1GetFullName( locator->dataset_id, 0, NULL, status );
file_str = dat1GetFullName( locator->dataset_id, 1, NULL, status );
if (offset != HADDR_UNDEF) {
reason = "[HAD offset]";
} else {
reason = "[no offset]";
}
if (!try_mmap) {
printf("Will NOT attempt %s to mmap %s:%s\n",reason,file_str,name_str);
} else {
printf("WILL TRY %s to mmap OFFSET=%zu %s:%s\n", reason, (size_t)offset, file_str, name_str);
}
MEM_FREE(name_str);
}
#endif
if (try_mmap) {
int fd = 0;
int flags = 0;
int prot = 0;
hdsbool_t opened_fd = 0;
if ( intent == H5F_ACC_RDONLY || accmode == HDSMODE_READ ) {
flags |= O_RDONLY;
prot = PROT_READ;
} else {
flags |= O_RDWR;
prot = PROT_READ | PROT_WRITE;
}
if (*status == SAI__OK) {
/* see what file driver we have */
hid_t fapl_id = -1;
hid_t fdriv_id = -1;
void * file_handle = NULL;
herr_t herr = -1;
fapl_id = H5Fget_access_plist(locator->file_id);
fdriv_id = H5Pget_driver(fapl_id);
if (fdriv_id == H5FD_SEC2 || fdriv_id == H5FD_STDIO) {
/* If this is a POSIX or STDIO driver we get the handle */
herr = H5Fget_vfd_handle( locator->file_id, fapl_id, (void**)&file_handle);
if (herr >= 0) {
if (fdriv_id == H5FD_SEC2) {
fd = *((int *)file_handle);
} else if (fdriv_id == H5FD_STDIO) {
FILE * fh = (FILE *)file_handle;
fd = fileno(fh);
}
}
}
if (fapl_id > 0) H5Pclose( fapl_id );
if (fd == 0) {
/* We have to open the file ourselves! */
char * fname = NULL;
fname = dat1GetFullName( locator->dataset_id, 1, NULL, status );
fd = open(fname, flags);
opened_fd = 1;
if (fname) MEM_FREE(fname);
}
if (fd > 0) {
/* Set up for memory mapping */
int mflags = 0;
mflags = MAP_SHARED | MAP_FILE;
if (*status == SAI__OK) {
mapped = dat1Mmap( nbytes, prot, mflags, fd, offset, &isreg, ®pntr, &actbytes, status );
if (*status == SAI__OK) {
/* Store the file descriptor in the locator to allow us to close */
if (mapped) {
if (opened_fd) locator->fdmap = fd;
locator->uses_true_mmap = 1;
}
} else {
/* Not currently fatal -- we can try without the file */
if (opened_fd) close(fd);
emsAnnul(status);
}
}
}
}
}
/* If we have not been able to map anything yet, just get some memory. It is
zeroed (for WRITE) to match mmap behavior. We rely on the OS to decide when it is reasonable
to do an anonymous mmap. */
if (!regpntr) {
hdsbool_t mustget;
mustget = (accmode == HDSMODE_READ || accmode == HDSMODE_UPDATE);
if (mustget) {
regpntr = cnfMalloc( nbytes );
} else {
regpntr = cnfCalloc( 1, nbytes );
}
if (!regpntr) {
*status = DAT__NOMEM;
emsRepf("datMap_cnf","datMap: Unable to allocate %zu bytes of memory",
status, nbytes);
goto CLEANUP;
}
/* Populate the memory - check with datState occurred earlier */
if (mustget) {
datGet( locator, normtypestr, ndim, dims, regpntr, status );
}
}
CLEANUP:
/* Cleanups that must happen always */
if (h5type) H5Tclose(h5type);
/* cleanups that only happen if status is bad */
if (*status != SAI__OK) {
if (mapped) {
if (isreg == 1) cnfUregp( regpntr );
if ( munmap( mapped, actbytes ) != 0 ) {
emsSyser( "MESSAGE", errno );
emsRep("datMap_4", "Error unmapping mapped memory: ^MESSAGE", status);
}
mapped = NULL;
} else if (regpntr) {
cnfFree( regpntr );
}
regpntr = NULL;
}
/* Update the locator to reflect the mapped status */
if (*status == SAI__OK) {
int i;
locator->pntr = mapped;
locator->regpntr = regpntr;
locator->bytesmapped = actbytes;
locator->accmode = accmode;
/* In order to copy the data back into the underlying HDF5 dataset
we need to store additional information about how this was mapped
to allow us to either call datPut later on or at least a new
dataspace. For now store the arguments so we can pass them straight
to datPut */
locator->ndims = ndim;
for (i=0; i<ndim; i++) {
(locator->mapdims)[i] = dims[i];
}
star_strlcpy( locator->maptype, normtypestr, sizeof(locator->maptype) );
}
/* Note that the returned pointer is not necessarily the same as the
mapped pointer because of pagesize corrections */
*pntr = regpntr;
return *status;
}
int
datErmsg(int status, size_t *len, char *msg_str)
{
/* Local Variables: */
const char *trans = NULL; /* Pointer to translation text */
int lstat; /* Local status variable */
int emslen; /* Length from EMS */
/*. */
/* Test for each DAT__ error code, obtaining a pointer to the textual */
/* translation. */
switch ( status )
{
default:
trans = NULL;
break;
case SAI__OK:
trans = "OK, no error (SAI__OK)";
break;
case DAT__LOCIN:
trans = "Locator invalid (DAT__LOCIN)";
break;
case DAT__TYPIN:
trans = "Type invalid (DAT__TYPIN)";
break;
case DAT__NAMIN:
trans = "Name invalid (DAT__NAMIN)";
break;
case DAT__MODIN:
trans = "Mode invalid (DAT__MODIN)";
break;
case DAT__DELIN:
trans = "Deletion invalid (DAT__DELIN)";
break;
case DAT__DIMIN:
trans = "Dimensions invalid (DAT__DIMIN)";
break;
case DAT__FILIN:
trans = "File invalid (DAT__FILIN)";
break;
case DAT__OBJIN:
trans = "Object invalid (DAT__OBJIN)";
break;
case DAT__GRPIN:
trans = "Group invalid (DAT__GRPIN)";
break;
case DAT__SUBIN:
trans = "Subscripts invalid (DAT__SUBIN)";
break;
case DAT__COMEX:
trans = "Component already exists (DAT__COMEX)";
break;
case DAT__OBJNF:
trans = "Object not found (DAT__OBJNF)";
break;
case DAT__TRUNC:
trans = "Text truncated (DAT__TRUNC)";
break;
case DAT__ACCON:
trans = "Access conflict (DAT__ACCON)";
break;
case DAT__CONER:
trans = "Conversion error (DAT__CONER)";
break;
case DAT__UNSET:
trans = "Primitive data undefined (DAT__UNSET)";
break;
case DAT__VERMM:
trans = "Version mismatch (DAT__VERMM)";
break;
case DAT__PRMAP:
trans = "Primitive data mapped (DAT__PRMAP)";
break;
case DAT__FILCK:
trans = "File lock error (DAT__FILCK)";
break;
case DAT__FILNF:
trans = "File not found (DAT__FILNF)";
break;
case DAT__FILPR:
trans = "File protected (DAT__FILPR)";
break;
case DAT__INCHK:
trans = "Integrity check (DAT__INCHK)";
break;
case DAT__FATAL:
trans = "Fatal internal error (DAT__FATAL)";
break;
case DAT__ISMAP:
trans = "Data currently mapped (DAT__ISMAP)";
break;
case DAT__BOUND:
trans = "Outside bounds of object (DAT__BOUND)";
break;
case DAT__FILCL:
trans = "File close error (DAT__FILCL)";
break;
case DAT__FILCR:
trans = "File create error (DAT__FILCR)";
break;
case DAT__FILMP:
trans = "File mapping error (DAT__FILMP)";
break;
case DAT__FILND:
trans = "File not deleted (DAT__FILND)";
break;
case DAT__FILNX:
trans = "File not extended (DAT__FILNX)";
break;
case DAT__FILRD:
trans = "File read error (DAT__FILRD)";
break;
case DAT__FILWR:
trans = "File write error (DAT__FILWR)";
break;
case DAT__NOMEM:
trans = "Memory allocation error (DAT__NOMEM)";
break;
case DAT__WLDIN:
trans = "Wild card search context invalid (DAT__WLDIN)";
break;
}
/* If translation text was found, then determine the number of significant */
/* characters to be returned and copy them to the output string. */
if ( trans != NULL )
{
strcpy( msg_str, trans );
*len = strlen( msg_str );
}
/* If the error code is not a DAT__ error code, then use ems_ to translate */
/* it as a system error code, and copy the resulting text to the output */
/* string. */
else
{
lstat = SAI__OK;
emsMark( );
emsSyser( "MESSAGE", status );
emsMload( " ", "^MESSAGE", msg_str, &emslen, &lstat );
*len = emslen;
emsRlse( );
}
/* Exit the routine. */
return SAI__OK;
}
void rec1_open_file( int expand, const char *file, INT file_len, char mode,
INT *slot, int *newslot )
{
/*+ */
/* Name: */
/* rec1_open_file */
/* Purpose: */
/* Open an existing file. */
/* Invocation: */
/* rec1_open_file( expand, file, file_len, mode, slot, newslot ) */
/* Description: */
/* This function opens an existing container file for reading or writing */
/* and allocates a new File Control Vector slot (if necessary) to refer */
/* to the file. Any new FCV slot is initialised and its number is */
/* returned. The file's reference count is left unchanged if it is */
/* already in use, or is set to zero if it is being opened for the first */
/* time. */
/* Parameters: */
/* int expand */
/* If expand is non-zero, then the file name supplied will be */
/* regarded as an abbreviated form of the full name of the file and */
/* will be expanded (according to the underlying operating system's */
/* rules) before use. Otherwise, the file name supplied is regarded */
/* as already fully expanded and will be used literally. This */
/* mechanism is provided to allow previously-expanded file names to */
/* be given, while allowing for the fact that expanding a file name */
/* twice may cause the wrong file to be identified (if the underlying */
/* file system has changed and/or the expanded file name contains */
/* special characters, for instance). */
/* const char *file */
/* Pointer to a char array containing the host file-system name of */
/* the container file to be opened. It should not be null terminated. */
/* If expand is non-zero, then leading and trailing white space will */
/* be ignored. If expand is zero, then the file name must be */
/* fully-expanded and white space may be significant. */
/* INT file_len */
/* Number of characters in the file name (excluding any terminating */
/* null, if present). */
/* char mode */
/* A character specifying the required file access mode: 'R' for */
/* read-only access or 'W' for write (or update) access. */
/* INT *slot */
/* Pointer to an integer in which the File Control Vector slot number */
/* allocated to the file will be returned. */
/* int *newslot */
/* Returns 1 if the FCV slot is a new one, otherwise 0 if the slot */
/* was already in use (i.e. the file was already open). */
/* Returned Value: */
/* void */
/* Copyright: */
/* Copyright (C) 1992 Science & Engineering Research Council */
/* Copyright (C) 2005 Particle Physics and Astronomy Research Council */
/* Licence: */
/* This program is free software; you can redistribute it and/or */
/* modify it under the terms of the GNU General Public License as */
/* published by the Free Software Foundation; either version 2 of */
/* the License, or (at your option) any later version. */
/* This program is distributed in the hope that it will be */
/* useful, but WITHOUT ANY WARRANTY; without even the implied */
/* warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR */
/* PURPOSE. See the GNU General Public License for more details. */
/* You should have received a copy of the GNU General Public */
/* License along with this program; if not, write to the Free */
/* Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, */
/* MA 02110-1301, USA */
/* Authors: */
/* RFWS: R.F. Warren-Smith (STARLINK) */
/* TIMJ: Tim Jenness (JAC, Hawaii) */
/* {@enter_new_authors_here@} */
/* History: */
/* 28-MAR-1991 (RFWS): */
/* Added prologue. */
/* 3-APR-1991 (RFWS): */
/* Fixed bug in passing of file name for error message. */
/* 3-MAY-1991 (RFWS): */
/* Re-structured to return an FCV slot number and to initialise the */
/* slot if necessary. */
/* 7-MAY-1991 (RFWS): */
/* Added a portable implementation. */
/* 21-MAY-1991 (RFWS): */
/* Remove trailing blanks from file names (portable version). */
/* 22-MAY-1991 (RFWS): */
/* Added defaulting of ".sdf" file extension in portable version. */
/* 12-JUN-1991 (RFWS): */
/* Fixed bug in testing of access mode. */
/* 28-JUN-1991 (RFWS): */
/* Removed initialisation of the VMS-specific FCV lid field (not */
/* necessary). Added function prototypes for VMS system calls. */
/* 11-SEP-1992 (RFWS): */
/* Do not increment the file reference count. This is now the */
/* caller's responsibility. */
/* 14-OCT-1992 (RFWS): */
/* Changed to a void function and to use separate string pointer and */
/* length arguments. */
/* 24-NOV-1992 (RFWS): */
/* Fixed error in assigning access mode for error message. */
/* 25-NOV-1992 (RFWS): */
/* Changed to extend the File Control Vector when necessary. */
/* 26-NOV-1992 (RFWS): */
/* Enhanced file name handling by using rec1_get_path. */
/* 1-DEC-1992 (RFWS): */
/* Added the expand parameter. */
/* 28-DEC-2005 (TIMJ): */
/* Use DAT__FLEXT rather than hard-coded ".SDF" */
/* 02-FEB-2006 (TIMJ): */
/* Free malloced memory if the slot is reused. */
/* {@enter_further_changes_here@} */
/* Bugs: */
/* {@note_any_bugs_here@} */
/*- */
/* Local Variables: */
#if defined (vms ) /* VMS version local variables: */
char esabuf[ NAM$C_MAXRSS ]; /* Expanded file name string buffer */
char rsabuf[ NAM$C_MAXRSS ]; /* Resultant file name string buffer */
struct FAB fab; /* RMS file access block */
struct NAM nam; /* RMS NAM block */
unsigned int systat; /* System status code */
unsigned short int iochan; /* File I/O channel */
#else /* Portable version local variables: */
FILE *iochan=NULL; /* File I/O stream */
#endif
INT i; /* Loop counter for FCV slots */
INT lfns; /* Length of File Name String */
INT start; /* Array offset of first non-blank char */
char *fns; /* Pointer to file name string */
int mustopen=0; /* File must be opened? */
struct FCV *fcv; /* Pointer to File Control Vector element */
struct FID *fid; /* Pointer to File ID */
/* External References: */
#if defined( vms ) /* VMS version system calls: */
unsigned int SYS$OPEN( struct FAB *fab );
unsigned int SYS$PARSE( struct FAB *fab );
unsigned int SYS$SEARCH( struct FAB *fab );
#endif
/*. */
/* Check the inherited global status. */
if ( !_ok( hds_gl_status ) ) return;
/* Initialise. */
fns = NULL;
fid = NULL;
/* If necessary, modify the file name length to omit any trailing white */
/* space. */
start = 0;
if ( expand )
{
for ( ; file_len > 0; file_len-- )
{
if ( !isspace( file[ file_len - 1 ] ) ) break;
}
/* Also strip white space from the start of the file name (but leave at */
/* least one character, even if the string is completely blank). */
for ( start = 0; start < ( file_len - 1 ); start++ )
{
if ( !isspace( file[ start ] ) ) break;
}
}
/* VMS version: */
/* =========== */
#if defined( vms )
/* Initialise the file FAB and NAM blocks. */
fab = cc$rms_fab;
fab.fab$l_dna = DAT__FLEXT;
fab.fab$b_dns = DAT__SZFLX;
fab.fab$l_fna = file + start;
fab.fab$b_fns = file_len - start;
fab.fab$l_nam = &nam;
nam = cc$rms_nam;
nam.nam$l_esa = esabuf;
nam.nam$b_ess = NAM$C_MAXRSS;
nam.nam$l_rsa = rsabuf;
nam.nam$b_rss = NAM$C_MAXRSS;
/* Parse the file name, reporting any errors. */
systat = SYS$PARSE( &fab );
if ( !( systat & STS$M_SUCCESS ) )
{
hds_gl_status = ( systat == RMS$_PRV ) ? DAT__FILPR : DAT__FILNF;
emsSetnc( "FILE", file + start, file_len - start );
emsSyser( "MESSAGE", systat );
emsRep( "REC1_OPEN_FILE_1",
"Error in file name \'^FILE\' - ^MESSAGE.",
&hds_gl_status );
}
/* Search for the file, again reporting errors. */
if ( _ok( hds_gl_status ) )
{
systat = SYS$SEARCH( &fab );
if ( !( systat & STS$M_SUCCESS ) )
{
hds_gl_status = ( systat == RMS$_PRV ) ? DAT__FILPR : DAT__FILNF;
emsSetnc( "FILE", esabuf, nam.nam$b_esl );
emsSyser( "MESSAGE", systat );
emsRep( "REC1_OPEN_FILE_2",
"Error searching for file ^FILE - ^MESSAGE.",
&hds_gl_status );
}
/* If the file was found successfully, then allocate memory to hold the */
/* File Name String and the File ID and copy the relevant information from */
/* the NAM block into this memory (adding a terminating null to the file */
/* name). */
else
{
lfns = nam.nam$b_rsl;
rec_alloc_mem( lfns + 1, (void **) &fns );
rec_alloc_mem( sizeof( struct FID ), (void **) &fid );
if ( _ok( hds_gl_status ) )
{
(void) memcpy( (void *) fns, (const void *) nam.nam$l_rsa,
(size_t) lfns );
fns[ lfns ] = '\0';
(void) memcpy( (void *) fid, (const void *) nam.nam$t_dvi,
sizeof( struct FID ) );
}
}
}
/* Portable version: */
/* ================ */
#else
/* If required, obtain the full path name of the file. */
if ( expand )
{
rec1_get_path( file + start, file_len - start, &fns, &lfns );
}
/* Otherwise, allocate space and copy the file name for use directly. */
else
{
lfns = file_len - start;
rec_alloc_mem( lfns + 1, (void **) &fns );
if ( _ok( hds_gl_status ) )
{
(void) memcpy( (void *) fns, (const void *) ( file + start ),
(size_t) lfns );
fns[ lfns ] = '\0';
}
}
/* Allocate memory to hold the File ID and store file identification */
/* information in it. */
rec_alloc_mem( sizeof( struct FID ), (void **) &fid );
rec1_get_fid( fns, fid );
#endif
/* Loop to search the File Control Vector for any slot which is currently */
/* open and associated with the same file. */
if ( _ok( hds_gl_status ) )
{
*slot = rec_gl_endslot;
*newslot = 1;
for ( i = 0; i < rec_gl_endslot; i++ )
{
/* Remember the number of the last slot which is not being used. */
if ( !rec_ga_fcv[ i ].open )
{
*slot = i;
}
/* If a slot is open and the identification matches, then note that a new */
/* slot is not needed and quit searching */
else if ( !memcmp( (const void *) rec_ga_fcv[ i ].fid,
(const void *) fid, sizeof( struct FID ) ) )
{
*slot = i;
*newslot = 0;
break;
}
}
/* If no File ID match or unused FCV slot was found, then a new slot must */
/* be used. */
if ( *slot == rec_gl_endslot )
{
/* If there is insufficient space for another slot in the File Control */
/* Vector, then extend the FCV by doubling its size. If successful, */
/* initialise the new region to zero and record the new size. */
if ( *slot >= rec_gl_mxslot )
{
rec_reall_mem( rec_gl_mxslot * 2 * sizeof( struct FCV ),
(void **) &rec_ga_fcv );
if ( _ok( hds_gl_status ) )
{
(void) memset( (void *) ( rec_ga_fcv + rec_gl_mxslot ), 0,
sizeof( struct FCV ) *
(size_t) rec_gl_mxslot );
rec_gl_mxslot *= 2;
}
}
/* If OK, increment the count of FCV slots used. */
if ( _ok( hds_gl_status ) )
{
rec_gl_endslot++;
}
}
}
/* See if the file needs opening. This will be necessary if a new FCV slot */
/* is being used or if the file is currently open for read-only access and */
/* write access is now required. */
if ( _ok( hds_gl_status ) )
{
mustopen = *newslot ||
( ( mode != 'R' ) &&
( rec_ga_fcv[ *slot ].write == REC__NOIOCHAN ) );
/* If the file is to be opened... */
if ( mustopen )
{
/* VMS version: */
/* =========== */
#if defined( vms )
/* Initialise the FAB block. */
fab.fab$l_fop = FAB$M_UFO | FAB$M_NAM;
fab.fab$b_shr = FAB$M_SHRPUT | FAB$M_SHRGET | FAB$M_UPI;
fab.fab$b_fac = ( mode == 'R' ) ?
FAB$M_GET : ( FAB$M_GET | FAB$M_PUT );
/* Open the file, reporting any errors. */
systat = SYS$OPEN( &fab );
if ( !( systat & STS$M_SUCCESS ) )
{
hds_gl_status = ( systat == RMS$_PRV ) ?
DAT__FILPR : DAT__FILNF;
emsSetnc( "FILE", rsabuf, nam.nam$b_rsl );
emsSetnc( "ACCESS", ( mode == 'R' ) ?
"reading" : "writing", EMS__SZTOK );
emsSyser( "MESSAGE", systat );
emsRep( "REC1_OPEN_FILE_3",
"Unable to open file ^FILE for ^ACCESS - ^MESSAGE.",
&hds_gl_status );
}
/* If the file was opened successfully, extract its I/O channel from the */
/* FAB block. */
else
{
iochan = (int) fab.fab$l_stv;
}
/* Portable version: */
/* ================ */
#else
/* Open the file, checking for errors. */
iochan = fopen( (const char *) fns,
( mode == 'R' ) ? "rb" : "r+b");
if ( iochan == NULL )
{
/* Categorise the possible error conditions, setting the appropriate status */
/* value. */
switch ( errno )
{
case EACCES:
hds_gl_status = DAT__FILPR; /* Access denied */
break;
case EISDIR:
hds_gl_status = DAT__FILIN; /* File is a directory */
break;
case EROFS:
hds_gl_status = DAT__FILPR; /* Read-only file system */
break;
default: /* All other errors ==> */
hds_gl_status = DAT__FILNF; /* File not found */
break;
}
/* Report the error. */
emsSyser( "MESSAGE", errno );
emsSetnc( "FILE", fns, EMS__SZTOK );
emsSetnc( "ACCESS", ( mode == 'R' ) ? "read" : "read/write",
EMS__SZTOK );
emsRep( "REC1_OPEN_FILE_4",
"Error opening file ^FILE for ^ACCESS access - \
^MESSAGE",
&hds_gl_status );
}
#endif
}
}
/* If the file has been opened successfully but an old slot has been used, */
/* then simply store the new I/O channel in the slot. */
if ( _ok( hds_gl_status ) )
{
if ( mustopen )
{
if ( !*newslot )
{
rec_ga_fcv[ *slot ].write = iochan;
}
/* If a new slot is being used, fill in the File Control Vector fields, */
/* marking the slot as open. */
else
{
fcv = &rec_ga_fcv[ *slot ];
fcv->name = fns;
fcv->fid = fid;
fcv->read = ( mode == 'R' ) ? iochan : REC__NOIOCHAN;
fcv->write = ( mode == 'R' ) ? REC__NOIOCHAN : iochan;
fcv->count = 0;
fcv->dele = 0;
fcv->open = 1;
fcv->locked = 0;
fcv->hcb = NULL;
fcv->hcbmodify = 0;
}
}
}
/* If an error occurred, then deallocate any memory allocated for the File */
/* Name String and File ID. */
/* Also free the memory if we are reusing a slot (since the name is already */
/* stored and the copy is not used. */
if ( !_ok( hds_gl_status ) || !*newslot )
{
rec_deall_mem( lfns + 1, (void **) &fns );
rec_deall_mem( sizeof( struct FID ), (void **) &fid );
}
/* Exit the routine. */
return;
}
void rec1_get_path( const char *fname, INT fname_len, char **path,
INT *path_len )
{
/*+ */
/* Name: */
/* rec1_get_path */
/* Purpose: */
/* Obtain a full path name for a file (UNIX & POSIX only). */
/* Invocation: */
/* rec1_get_path( fname, fname_len, path, path_len ) */
/* Description: */
/* The routine translates a file name, which may be absolute or relative */
/* and which may contain shell meta-characters, into a full path name. A */
/* default file type extension of ".sdf" is added if appropriate. */
/* Leading and trailing white space is ignored. */
/* Parameters: */
/* const char *fname */
/* Pointer to a char array containing the original file name (not */
/* null terminated). The file need not necessarily exist, although */
/* the file system will be searched to identify it if shell */
/* pattern-matching characters are included. */
/* INT fname_len */
/* Number of characters in the original file name. */
/* char **path */
/* The value of *path will be set by this routine to point at a */
/* null-terminated character string containing the fully-expanded */
/* path name for the file. This path name occupies space dynamically */
/* allocated by rec_alloc_mem. It should be deallocated by the caller */
/* (using rec_deall_mem) when no longer required. The amount of space */
/* allocated is equal to (*path_len + 1) bytes. */
/* INT *path_len */
/* Pointer to an integer which will be set to the number of */
/* characters in the expanded path name, excluding the terminating */
/* null. */
/* Returned Value: */
/* void */
/* Notes: */
/* - If the file specification contains pattern matching characters and */
/* matches more than one file, then the first match will be used. */
/* - A value of NULL will be returned in *path and a value of zero in */
/* *path_len if this routine is called with the global status set, or if */
/* it should fail for any reason. */
/* - This routine is only implemented for UNIX & POSIX systems. */
/* Copyright: */
/* Copyright (C) 1992 Science & Engineering Research Council */
/* Copyright (C) 2005 Particle Physics and Astronomy Research Council */
/* Licence: */
/* This program is free software; you can redistribute it and/or */
/* modify it under the terms of the GNU General Public License as */
/* published by the Free Software Foundation; either version 2 of */
/* the License, or (at your option) any later version. */
/* This program is distributed in the hope that it will be */
/* useful, but WITHOUT ANY WARRANTY; without even the implied */
/* warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR */
/* PURPOSE. See the GNU General Public License for more details. */
/* You should have received a copy of the GNU General Public */
/* License along with this program; if not, write to the Free */
/* Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, */
/* MA 02110-1301, USA */
/* Authors: */
/* RFWS: R.F. Warren-Smith (STARLINK, RAL) */
/* PWD: Peter W. Draper (STARLINK, Durham University) */
/* TIMJ: Tim Jenness (JAC, Hawaii) */
/* {@enter_new_authors_here@} */
/* History: */
/* 25-NOV-1992 (RFWS): */
/* Original version. */
/* 9-DEC-1992 (RFWS): */
/* Report an error if the file name is completely blank. */
/* 21-JUL-2004 (PWD): */
/* Add changes to support MinGW under Windows (no process control, */
/* plus Windows filename conventions), so that we can build */
/* shareable libraries for JNIHDS. */
/* 28-DEC-2005 (TIMJ): */
/* Use DAT__FLEXT rather than hard-coded ".sdf" */
/* {@enter_further_changes_here@} */
/* Bugs: */
/* {@note_any_bugs_here@} */
/*- */
/* Local Constants: */
#if defined( PATH_MAX )
const INT mxbuf0 = PATH_MAX; /* Initial size of file name buffer */
#else
const INT mxbuf0 = _POSIX_PATH_MAX;
#endif
/* Local Variables: */
FILE *stream; /* Stream for reading file name */
INT i; /* Loop counter for file name characters */
INT idot=0; /* Character position of last dot */
INT islash=0; /* Character position of last slash */
INT lcwd; /* Length of working directory string */
INT mxbuf=0; /* Allocated size of buffer */
INT start; /* Array index of first non-blank char */
char *buffer; /* Pointer to buffer for reading file name */
char *cwd; /* Pointer to working directory string */
char c; /* File name character read from stream */
const char *basename=NULL; /* Pointer to base file name */
int absolute; /* Absolute path name? */
int extn; /* File type extension present? */
int lbase=0; /* Number of characters in basename string */
int special=0; /* Special characters in file name? */
int stat_val; /* Shell process status information */
pid_t pid; /* ID of shell process */
#if __MINGW32__
/* Use Windows separator */
#define SLASH '\\'
#else
#define SLASH '/'
#endif
/*. */
/* Set initial null values for the returned results. */
*path = NULL;
*path_len = 0;
/* Check the inherited global status. */
if ( !_ok( hds_gl_status ) ) return;
/* Initialise. */
buffer = NULL;
pid = (pid_t) -1;
/* Modify the file name length to omit any trailing white space. */
for ( ; fname_len > 0; fname_len-- )
{
if ( !isspace( fname[ fname_len - 1 ] ) ) break;
}
/* Also strip white space from the start of the file specification. */
for ( start = 0; start < fname_len; start++ )
{
if ( !isspace( fname[ start ] ) ) break;
}
/* If the file name is completely blank, then report an error. */
if ( start == fname_len )
{
hds_gl_status = DAT__FILNF;
emsRep( "REC_GET_PATH_1",
"Invalid blank file name given.",
&hds_gl_status );
}
/* Scan the file name, classifying the characters that appear in it. */
else
{
idot = islash = special = 0;
for ( i = start; i < fname_len; i++ )
{
switch ( fname[ i ] )
{
/* Note where the last dot '.' occurs. */
case '.':
idot = i + 1;
break;
/* Note where the last slash '/' occurs. */
case SLASH:
islash = i + 1;
break;
/* Underscore '_' and hyphen '-' are portable file name characters, so take */
/* no action on these. */
case '_':
case '-':
break;
/* If any other characters which are not in the POSIX.1 portable filename */
/* character set are encountered, then note that the file name contains */
/* special characters. */
default:
if ( !isalnum( fname[ i ] ) )
{
special = 1;
}
break;
}
}
}
/* Ignore the possible presence of special characters if the HDS__SHELL */
/* tuning parameter specifies that shell expansion of such characters is */
/* not to occur. */
#if __MINGW32__
/* MinGW doesn't offer a shell facility so make sure it is disabled */
hds_gl_shell = HDS__NOSHELL;
special = 0;
#else
if ( hds_gl_shell == HDS__NOSHELL ) special = 0;
#endif
/* If there are no speciaal characters present, then the file name can be */
/* used as the basis of the full path name, without further translation. */
if ( !special )
{
basename = fname + start;
/* Note if a file type extension is present, as indicated by a dot '.' in */
/* the final field of the file name (i.e. after the last slash '/'). Find */
/* how much of the file name must be used after omitting exactly one final */
/* dot '.', if present (it is a general rule in HDS that this operation is */
/* performed on file names before use). */
extn = ( idot > islash );
lbase = fname_len - start - ( idot == fname_len );
}
/* If special characters are present in the file name, then we must use a */
/* shell process to interpret them. We only do this if it is really */
/* necessary, since it is slower. Note that file extension information will */
/* be handled and start a shell process for finding files. */
else
{
extn = 1;
rec1_find_file( fname + start, fname_len - start, &pid, &stream );
if ( _ok( hds_gl_status ) )
{
/* Allocate initial space for a buffer to hold the expanded file name. */
rec_alloc_mem( mxbuf0, (void **) &buffer );
if ( _ok( hds_gl_status ) ) mxbuf = mxbuf0;
/* Read the name of the first file found. Loop to read characters one at a */
/* time and append them to the file name until an error or end of file */
/* occurs, or a blank character is read. */
lbase = 0;
while ( _ok( hds_gl_status ) )
{
(void) fread( (void *) &c, sizeof( char ), (size_t) 1,
stream );
/* If an error occurs, then report it and quit reading. */
if ( ferror( stream ) )
{
hds_gl_status = DAT__FATAL;
emsSyser( "MESSAGE", errno );
emsRep( "REC_GET_PATH_2",
"Error reading file names from stream attached \
to shell process - ^MESSAGE",
&hds_gl_status );
break;
}
/* If an end of file occurs, or a blank character is read, then we have */
/* reached the end of the file name, so quit reading. */
else if ( feof( stream ) || isspace( c ) )
{
break;
}
/* The character just read must now be appended to the file name. Check */
/* that the file name buffer is large enough to hold it. If not, then */
/* extend the buffer by doubling its length and record its new size. */
if ( lbase >= mxbuf )
{
rec_reall_mem( mxbuf * 2, (void **) &buffer );
if ( _ok( hds_gl_status ) )
{
mxbuf *= 2;
}
}
/* If OK, append the character to the file name. */
if ( _ok( hds_gl_status ) )
{
buffer[ lbase++ ] = c;
}
}
/* If no file name characters were read, then there was no file name match, */
/* so report an error. */
if ( lbase == 0 )
{
hds_gl_status = DAT__FILNF;
emsSetnc( "FILE", fname + start, fname_len - start );
emsRep( "REC_GET_PATH_3",
"No files found matching the file specification \
\'^FILE\'.",
&hds_gl_status );
}
/* Close the stream and check for errors. Do this inside a new error */
/* reporting environment, since we may be cleaning up after a previous */
/* error. */
emsBegin( &hds_gl_status );
if ( fclose ( stream ) != 0 )
{
hds_gl_status = DAT__FATAL;
emsSyser( "MESSAGE", errno );
emsRep( "REC_GET_PATH_4",
"Error closing stream used to read file names from \
a shell process - ^MESSAGE",
&hds_gl_status );
}
int rec1_unlock_slot( int slot )
{
/*+ */
/* Name: */
/* rec1_unlock_slot */
/* Purpose: */
/* Unlock a slot in the File Control Vector. */
/* Invocation: */
/* rec1_unlock_slot( slot ) */
/* Description: */
/* This function unlocks a slot in the File Control Vector, thereby */
/* allowing other users to write to the associated file. Before the file */
/* is actually unlocked, any modified Header Control Block information */
/* is written back to it, and associated blocks are removed from the */
/* Working Page List, with modified blocks being written back to the */
/* file. This flushing of cached data occurs even if the slot is not */
/* initially locked. */
/* Parameters: */
/* int slot */
/* Container file slot number in the File Control Vector. */
/* Returned Value: */
/* int rec1_unlock_slot */
/* The global status value current on exit. */
/* Notes: */
/* - This routine attempts to execute even if the HDS global status is */
/* set on entry, although no further error report will be made if it */
/* subsequently fails under these circumstances. */
/* Authors: */
/* RFWS: R.F. Warren-Smith (STARLINK) */
/* {@enter_new_authors_here@} */
/* History: */
/* 26-MAR-1991 (RFWS): */
/* Made into a separate module and added prologue. */
/* 3-APR-1991 (RFWS): */
/* Converted to attempt to execute under error conditions. */
/* 4-APR-1991 (RFWS): */
/* Changed sys_write to rec1_write_file. */
/* 16-APR-1991 (RFWS): */
/* Changed to deallocate the memory used for holding HCB information. */
/* 17-APR-1991 (RFWS): */
/* Only release the lock if all associated data were flushed */
/* successfully. */
/* 22-APR-1991 (RFWS): */
/* Report an error if the unlocking operation fails. */
/* 23-MAY-1991 (RFWS): */
/* Installed a POSIX implementation. */
/* 5-JUN-1991 (RFWS): */
/* Changed to take no action if the slot is not initially locked. */
/* 19-JUN-1991 (RFWS): */
/* Further changed to allow flushing of cached information even if */
/* the file is not locked. */
/* 28-JUN-1991 (RFWS): */
/* Added function prototype for VMS system call. */
/* 24-SEP-1991 (RFWS): */
/* Fixed bug. Modified blocks were deliberately not being written to */
/* their files if the file was marked for deletion. This was unsafe */
/* because the block might subsequently need to be re-read before the */
/* file was actually deleted. All modified blocks are now written */
/* back. */
/* 24-AUG-1992 (RFWS): */
/* Removed illegal casts, replaced with (void **) cast. */
/* 8-NOV-1993 (RFWS): */
/* Added flushing of output I/O streams in POSIX version. */
/* {@enter_further_changes_here@} */
/* Bugs: */
/* {@note_any_bugs_here@} */
/*- */
/* Local Variables: */
#if defined( vms ) /* VMS version local variables: */
unsigned int systat; /* System error code */
#elif HAVE_FCNTL /* POSIX version local variables: */
int fd; /* File descriptor */
struct flock lockbuf; /* Lock structure for fcntl */
#endif
int i; /* Loop counter for cached blocks */
int wplsize; /* Size of working page list */
struct BCP *bcp; /* Pointer to Block Control Packet */
struct BCP *flink; /* Pointer to next Block Control Packet */
struct BID bid; /* Block ID */
unsigned char buf[ REC__SZBLK ]; /* Buffer for packed HCB information */
/* External References: */
#if defined( vms ) /* VMS version system calls: */
unsigned int SYS$DEQ
( unsigned int lkid,
int valblk, /* Not used */
int acmode, /* Not used */
int flags ); /* Not used */
#endif
/*. */
/* Begin a new error reporting context. */
emsBegin( &hds_gl_status );
/* See if the file's Header Control Block information is cached. */
if ( rec_ga_fcv[ slot ].hcb != NULL )
{
/* If so, and it has been modified, then pack the HCB information into a */
/* buffer and write it back to the first block in the file. */
if ( rec_ga_fcv[ slot ].hcbmodify )
{
rec1_pack_hcb( rec_ga_fcv[ slot ].hcb, buf );
rec1_write_file( slot, 1, buf, 1 );
}
/* Reset the HCB modified flag and deallocate the memory used to hold the */
/* HCB information. */
if ( _ok( hds_gl_status ) )
{
rec_ga_fcv[ slot ].hcbmodify = 0;
rec_deall_mem( sizeof( struct HCB ),
(void **) &rec_ga_fcv[ slot ].hcb );
}
}
/* Scan through the Working Page List. */
wplsize = rec_gl_wplsize;
bcp = rec_ga_wpl;
for ( i = 0; i < wplsize; i++ )
{
flink = bcp->flink;
/* Write any modified blocks back to the container file. */
bid = bcp->bid;
if ( bid.slot == slot )
{
rec1_flush_block( bcp );
/* Deallocate the memory used to hold each block and return its Block */
/* Control Packet to the Free Page List. */
rec_deall_mem( REC__SZBLK, (void **) &bcp->bloc );
(bcp->bid).slot = 0;
(bcp->bid).bloc = 0;
bcp->count = 0;
_remque( bcp, rec_ga_wpl );
_insque( bcp, rec_ga_fpl );
rec_gl_wplsize--;
}
bcp = flink;
}
/* POSIX version: */
/* ============= */
#if !defined( vms ) /* Not required on VMS */
/* If the slot is open for writing, then we must flush the I/O stream to */
/* hand off the file handle (POSIX terminology), since the file might next */
/* be accessed by another process. */
if ( _ok( hds_gl_status ) &&
( rec_ga_fcv[ slot ].write != REC__NOIOCHAN ) )
{
/* Flush the stream, checking for errors. */
if ( fflush( rec_ga_fcv[ slot ].write ) )
{
hds_gl_status = DAT__FILWR;
rec1_fmsg( "FILE", slot );
emsSyser( "MESSAGE", errno );
emsRep( "REC1_UNLOCK_SLOT_1",
"Unable to flush written data to the file ^FILE - \
^MESSAGE",
&hds_gl_status );
}
}
