/* Fortran-callable routines to read and write characther (bacio) and */
/* numeric (banio) data byte addressably */
/* Robert Grumbine 16 March 1998 */
/* v1.1: Put diagnostic output under control of define VERBOSE or QUIET */
/* Add option of non-seeking read/write */
/* Return code for fewer data read/written than requested */
/* v1.2: Add cray compatibility 20 April 1998 Robert Grumbine */
/* v1.3: Add IBMSP compatibility (IBM4, IBM8)
Add modes BAOPEN_WONLY_TRUNC, BAOPEN_WONLY_APPEND
Use isgraph instead of isalnum + a short list of accepted characters
for filename check
12 Dec 2000 Stephen Gilbert */
/* negative return codes are wrapped to positive, revise return codes
verify that banio and bacio have same contents
update comments
29 Oct 2008 Robert Grumbine */
/* v1.4: 21 Nov 2008
Add baciol and baniol functions, versions to work with files
over 2 Gb
Robert Grumbine */
/* Aug 2012 Jun Wang: fix c filename length because the c string
needs to end with "null" terminator , and free allocated cfile
name realname to avoid memory leak */
/* Sep 2012 Jun Wang: remove execute permission on the data file
generated by bacio */
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <unistd.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>
/* Include the C library file for definition/control */
/* Things that might be changed for new systems are there. */
/* This source file should not (need to) be edited, merely recompiled */
#include "clib.h"
/* Return Codes: */
/* 0 All was well */
/* 255 Tried to open read only _and_ write only */
/* 254 Tried to read and write in the same call */
/* 253 Internal failure in name processing */
/* 252 Failure in opening file */
/* 251 Tried to read on a write-only file */
/* 250 Failed in read to find the 'start' location */
/* 249 Tried to write to a read only file */
/* 248 Failed in write to find the 'start' location */
/* 247 Error in close */
/* 246 Read or wrote fewer data than requested */
/* 102 Massive catastrophe -- datary pointer is NULL */
/* Note: In your Fortran code, call bacio, not bacio_. */
/*int bacio_(int * mode, int * start, int * size, int * no, int * nactual, */
/* int * fdes, const char *fname, char *data, int namelen, */
/* int datanamelen) */
/* Arguments: */
/* Mode is the integer specifying operations to be performed */
/* see the clib.inc file for the values. Mode is obtained */
/* by adding together the values corresponding to the operations */
/* The best method is to include the clib.inc file and refer to the */
/* names for the operations rather than rely on hard-coded values */
/* Start is the byte number to start your operation from. 0 is the first */
/* byte in the file, not 1. */
/* Newpos is the position in the file after a read or write has been */
/* performed. You'll need this if you're doing 'seeking' read/write */
/* Size is the size of the objects you are trying to read. Rely on the */
/* values in the locale.inc file. Types are CHARACTER, INTEGER, REAL, */
/* COMPLEX. Specify the correct value by using SIZEOF_type, where type */
/* is one of these. (After having included the locale.inc file) */
/* no is the number of things to read or write (characters, integers, */
/* whatever) */
/* nactual is the number of things actually read or written. Check that */
/* you got what you wanted. */
/* fdes is an integer 'file descriptor'. This is not a Fortran Unit Number */
/* You can use it, however, to refer to files you've previously opened. */
/* fname is the name of the file. This only needs to be defined when you */
/* are opening a file. It must be (on the Fortran side) declared as */
/* CHARACTER*N, where N is a length greater than or equal to the length */
/* of the file name. CHARACTER*1 fname[80] (for example) will fail. */
/* data is the name of the entity (variable, vector, array) that you want */
/* to write data out from or read it in to. The fact that C is declaring */
/* it to be a char * does not affect your fortran. */
/* namelen - Do NOT specify this. It is created automagically by the */
/* Fortran compiler */
/* datanamelen - Ditto */
/* What is going on here is that although the Fortran caller will always */
/* be calling bacio, the called C routine name will change from system */
/* to system. */
#if defined CRAY90
#include <fortran.h>
int BACIO
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes,
_fcd fcd_fname, _fcd fcd_datary) {
char *fname, *datary;
int namelen;
#elif defined HP
int bacio
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined SGI
int bacio_
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined LINUXF90
int BACIO
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined VPP5000
int bacio_
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined IBM4
int bacio
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined IBM8
long long int bacio
(long long int * mode, long long int * start, long long int *newpos,
long long int * size, long long int * no,
long long int * nactual, long long int * fdes, const char *fname,
char *datary,
long long int namelen, long long int datanamelen) {
#else /* Default is LINUX */
int bacio_
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#endif
int i, jret, seekret;
char *realname;
size_t count;
/* Initialization(s) */
*nactual = 0;
/* Check for illegal combinations of options */
if (( BAOPEN_RONLY & *mode) &&
( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
#ifdef VERBOSE
printf("illegal -- trying to open both read only and write only\n");
#endif
return 255;
}
if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
#ifdef VERBOSE
printf("illegal -- trying to both read and write in the same call\n");
#endif
return 254;
}
/* This section handles Fortran to C translation of strings so as to */
/* be able to open the files Fortran is expecting to be opened. */
#ifdef CRAY90
namelen = _fcdlen(fcd_fname);
fname = _fcdtocp(fcd_fname);
#endif
if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
(BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
(BAOPEN_RW & *mode) ) {
#ifdef VERBOSE
printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
#endif
realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
if (realname == NULL) {
#ifdef VERBOSE
printf("failed to mallocate realname %d = namelen\n", namelen);
fflush(stdout);
#endif
return 253;
}
i=0;
while (i < namelen && isgraph(fname[i])) {
realname[i]=fname[i];
i++;
}
realname[i] = '\0';
}
/* Open files with correct read/write and file permission. */
if (BAOPEN_RONLY & *mode) {
#ifdef VERBOSE
printf("open read only %s\n", realname);
#endif
*fdes = open(realname, O_RDONLY , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY & *mode ) {
#ifdef VERBOSE
printf("open write only %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY_TRUNC & *mode ) {
#ifdef VERBOSE
printf("open write only with truncation %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY_APPEND & *mode ) {
#ifdef VERBOSE
printf("open write only with append %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_RW & *mode) {
#ifdef VERBOSE
printf("open read-write %s\n", realname);
#endif
*fdes = open(realname, O_RDWR | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else {
#ifdef VERBOSE
printf("no openings\n");
#endif
}
if (*fdes < 0) {
#ifdef VERBOSE
printf("error in file descriptor! *fdes %d\n", *fdes);
#endif
return 252;
}
else {
#ifdef VERBOSE
printf("file descriptor = %d\n",*fdes );
#endif
}
/* Read data as requested */
if (BAREAD & *mode &&
( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
#ifdef VERBOSE
printf("Error, trying to read while in write only mode!\n");
#endif
return 251;
}
else if (BAREAD & *mode ) {
/* Read in some data */
if (! (*mode & NOSEEK) ) {
seekret = lseek(*fdes, *start, SEEK_SET);
if (seekret == -1) {
#ifdef VERBOSE
printf("error in seeking to %d\n",*start);
#endif
return 250;
}
#ifdef VERBOSE
else {
printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
}
#endif
}
#ifdef CRAY90
datary = _fcdtocp(fcd_datary);
#endif
if (datary == NULL) {
printf("Massive catastrophe -- datary pointer is NULL\n");
return 102;
}
#ifdef VERBOSE
printf("file descriptor, datary = %d %d\n", *fdes, (int) datary);
#endif
count = (size_t) *no;
jret = read(*fdes, (void *) datary, count);
if (jret != *no) {
#ifdef VERBOSE
printf("did not read in the requested number of bytes\n");
printf("read in %d bytes instead of %d \n",jret, *no);
#endif
}
else {
#ifdef VERBOSE
printf("read in %d bytes requested \n", *no);
#endif
}
*nactual = jret;
*newpos = *start + jret;
}
/* Done with reading */
/* See if we should be writing */
if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
#ifdef VERBOSE
printf("Trying to write on a read only file \n");
#endif
return 249;
}
else if ( BAWRITE & *mode ) {
if (! (*mode & NOSEEK) ) {
seekret = lseek(*fdes, *start, SEEK_SET);
if (seekret == -1) {
#ifdef VERBOSE
printf("error in seeking to %d\n",*start);
#endif
return 248;
}
#ifdef VERBOSE
else {
printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
}
#endif
}
#ifdef CRAY90
datary = _fcdtocp(fcd_datary);
#endif
if (datary == NULL) {
printf("Massive catastrophe -- datary pointer is NULL\n");
return 102;
}
#ifdef VERBOSE
printf("write file descriptor, datary = %d %d\n", *fdes, (int) datary);
#endif
count = (size_t) *no;
jret = write(*fdes, (void *) datary, count);
if (jret != *no) {
#ifdef VERBOSE
printf("did not write out the requested number of bytes\n");
printf("wrote %d bytes instead\n", jret);
#endif
*nactual = jret;
*newpos = *start + jret;
}
else {
#ifdef VERBOSE
printf("wrote %d bytes \n", jret);
#endif
*nactual = jret;
*newpos = *start + jret;
}
}
/* Done with writing */
/* Close file if requested */
if (BACLOSE & *mode ) {
jret = close(*fdes);
if (jret != 0) {
#ifdef VERBOSE
printf("close failed! jret = %d\n",jret);
#endif
return 247;
}
}
/* Done closing */
/* Free the realname pointer to prevent memory leak */
if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
(BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
(BAOPEN_RW & *mode) ) {
free(realname);
}
/* Check that if we were reading or writing, that we actually got what */
/* we expected, else return a -10. Return 0 (success) if we're here */
/* and weren't reading or writing */
if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
return 246;
}
else {
return 0;
}
}
#if defined CRAY90
#include <fortran.h>
int BANIO
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes,
_fcd fcd_fname, void *datary) {
char *fname;
int namelen;
#elif defined HP
int banio
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined SGI
int banio_
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined LINUXF90
int BANIO
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined VPP5000
int banio_
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined IBM4
int banio
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined IBM8
long long int banio
(long long int * mode, long long int * start, long long int *newpos,
long long int * size, long long int * no,
long long int * nactual, long long int * fdes, const char *fname,
char *datary,
long long int namelen ) {
#else /* Default is LINUX */
int banio_
(int * mode, int * start, int *newpos, int * size, int * no,
int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#endif
int i, jret, seekret;
char *realname;
/* Initialization(s) */
*nactual = 0;
/* Check for illegal combinations of options */
if (( BAOPEN_RONLY & *mode) &&
( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
#ifdef VERBOSE
printf("illegal -- trying to open both read only and write only\n");
#endif
return 255;
}
if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
#ifdef VERBOSE
printf("illegal -- trying to both read and write in the same call\n");
#endif
return 254;
}
/* This section handles Fortran to C translation of strings so as to */
/* be able to open the files Fortran is expecting to be opened. */
#ifdef CRAY90
namelen = _fcdlen(fcd_fname);
fname = _fcdtocp(fcd_fname);
#endif
if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
(BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
(BAOPEN_RW & *mode) ) {
#ifdef VERBOSE
printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
#endif
realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
if (realname == NULL) {
#ifdef VERBOSE
printf("failed to mallocate realname %d = namelen\n", namelen);
fflush(stdout);
#endif
return 253;
}
i=0;
while (i < namelen && isgraph(fname[i])) {
realname[i]=fname[i];
i++;
}
realname[i] = '\0';
}
/* Open files with correct read/write and file permission. */
if (BAOPEN_RONLY & *mode) {
#ifdef VERBOSE
printf("open read only %s\n", realname);
#endif
*fdes = open(realname, O_RDONLY , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY & *mode ) {
#ifdef VERBOSE
printf("open write only %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY_TRUNC & *mode ) {
#ifdef VERBOSE
printf("open write only with truncation %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY_APPEND & *mode ) {
#ifdef VERBOSE
printf("open write only with append %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_RW & *mode) {
#ifdef VERBOSE
printf("open read-write %s\n", realname);
#endif
*fdes = open(realname, O_RDWR | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else {
#ifdef VERBOSE
printf("no openings\n");
#endif
}
if (*fdes < 0) {
#ifdef VERBOSE
printf("error in file descriptor! *fdes %d\n", *fdes);
#endif
return 252;
}
else {
#ifdef VERBOSE
printf("file descriptor = %d\n",*fdes );
#endif
}
/* Read data as requested */
if (BAREAD & *mode &&
( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
#ifdef VERBOSE
printf("Error, trying to read while in write only mode!\n");
#endif
return 251;
}
else if (BAREAD & *mode ) {
/* Read in some data */
if (! (*mode & NOSEEK) ) {
seekret = lseek(*fdes, *start, SEEK_SET);
if (seekret == -1) {
#ifdef VERBOSE
printf("error in seeking to %d\n",*start);
#endif
return 250;
}
#ifdef VERBOSE
else {
printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
}
#endif
}
jret = read(*fdes, datary, *no*(*size) );
if (jret != *no*(*size) ) {
#ifdef VERBOSE
printf("did not read in the requested number of items\n");
printf("read in %d items of %d \n",jret/(*size), *no);
#endif
*nactual = jret/(*size);
*newpos = *start + jret;
}
#ifdef VERBOSE
printf("read in %d items \n", jret/(*size));
#endif
*nactual = jret/(*size);
*newpos = *start + jret;
}
/* Done with reading */
/* See if we should be writing */
if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
#ifdef VERBOSE
printf("Trying to write on a read only file \n");
#endif
return 249;
}
else if ( BAWRITE & *mode ) {
if (! (*mode & NOSEEK) ) {
seekret = lseek(*fdes, *start, SEEK_SET);
if (seekret == -1) {
#ifdef VERBOSE
printf("error in seeking to %d\n",*start);
#endif
return 248;
}
#ifdef VERBOSE
else {
printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
}
#endif
}
jret = write(*fdes, datary, *no*(*size));
if (jret != *no*(*size)) {
#ifdef VERBOSE
printf("did not write out the requested number of items\n");
printf("wrote %d items instead\n", jret/(*size) );
#endif
*nactual = jret/(*size) ;
*newpos = *start + jret;
}
else {
#ifdef VERBOSE
printf("wrote %d items \n", jret/(*size) );
#endif
*nactual = jret/(*size) ;
*newpos = *start + jret;
}
}
/* Done with writing */
/* Close file if requested */
if (BACLOSE & *mode ) {
jret = close(*fdes);
if (jret != 0) {
#ifdef VERBOSE
printf("close failed! jret = %d\n",jret);
#endif
return 247;
}
}
/* Done closing */
/* Free the realname pointer to prevent memory leak */
if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
(BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
(BAOPEN_RW & *mode) ) {
free(realname);
}
/* Check that if we were reading or writing, that we actually got what */
/* we expected, else return a -10. Return 0 (success) if we're here */
/* and weren't reading or writing */
if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
return 246;
}
else {
return 0;
}
}
/* Now repeat with new names for long int arguments, needed for */
/* files > 2 Gb */
/* Robert Grumbine 21 November 2008 */
/* Note: In your Fortran code, call bacio, not bacio_. */
/*int baciol_(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, */
/* int * fdes, const char *fname, char *data, int namelen, */
/* int datanamelen) */
#if defined CRAY90
#include <fortran.h>
int BACIOL
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes,
_fcd fcd_fname, _fcd fcd_datary) {
char *fname, *datary;
int namelen;
#elif defined HP
int baciol
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined SGI
int baciol_
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined LINUXF90
int BACIOL
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined VPP5000
int baciol_
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined IBM4
int baciol
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#elif defined IBM8
long long int baciol
(long long int * mode, long long int * start, long long int *newpos,
long long int * size, long long int * no,
long long int * nactual, long long int * fdes, const char *fname,
char *datary,
long long int namelen, long long int datanamelen) {
#else /* Default is LINUX */
int baciol_
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen, int datanamelen) {
#endif
int i, jret, seekret;
char *realname;
size_t count;
/* Initialization(s) */
*nactual = 0;
/* Check for illegal combinations of options */
if (( BAOPEN_RONLY & *mode) &&
( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
#ifdef VERBOSE
printf("illegal -- trying to open both read only and write only\n");
#endif
return 255;
}
if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
#ifdef VERBOSE
printf("illegal -- trying to both read and write in the same call\n");
#endif
return 254;
}
/* This section handles Fortran to C translation of strings so as to */
/* be able to open the files Fortran is expecting to be opened. */
#ifdef CRAY90
namelen = _fcdlen(fcd_fname);
fname = _fcdtocp(fcd_fname);
#endif
if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
(BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
(BAOPEN_RW & *mode) ) {
#ifdef VERBOSE
printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
#endif
realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
if (realname == NULL) {
#ifdef VERBOSE
printf("failed to mallocate realname %d = namelen\n", namelen);
fflush(stdout);
#endif
return 253;
}
i=0;
while (i < namelen && isgraph(fname[i])) {
realname[i]=fname[i];
i++;
}
realname[i] = '\0';
}
/* Open files with correct read/write and file permission. */
if (BAOPEN_RONLY & *mode) {
#ifdef VERBOSE
printf("open read only %s\n", realname);
#endif
*fdes = open(realname, O_RDONLY , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY & *mode ) {
#ifdef VERBOSE
printf("open write only %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY_TRUNC & *mode ) {
#ifdef VERBOSE
printf("open write only with truncation %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY_APPEND & *mode ) {
#ifdef VERBOSE
printf("open write only with append %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_RW & *mode) {
#ifdef VERBOSE
printf("open read-write %s\n", realname);
#endif
*fdes = open(realname, O_RDWR | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else {
#ifdef VERBOSE
printf("no openings\n");
#endif
}
if (*fdes < 0) {
#ifdef VERBOSE
printf("error in file descriptor! *fdes %d\n", *fdes);
#endif
return 252;
}
else {
#ifdef VERBOSE
printf("file descriptor = %d\n",*fdes );
#endif
}
/* Read data as requested */
if (BAREAD & *mode &&
( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
#ifdef VERBOSE
printf("Error, trying to read while in write only mode!\n");
#endif
return 251;
}
else if (BAREAD & *mode ) {
/* Read in some data */
if (! (*mode & NOSEEK) ) {
seekret = lseek(*fdes, *start, SEEK_SET);
if (seekret == -1) {
#ifdef VERBOSE
printf("error in seeking to %d\n",*start);
#endif
return 250;
}
#ifdef VERBOSE
else {
printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
}
#endif
}
#ifdef CRAY90
datary = _fcdtocp(fcd_datary);
#endif
if (datary == NULL) {
printf("Massive catastrophe -- datary pointer is NULL\n");
return 102;
}
#ifdef VERBOSE
printf("file descriptor, datary = %d %d\n", *fdes, (int) datary);
#endif
count = (size_t) *no;
jret = read(*fdes, (void *) datary, count);
if (jret != *no) {
#ifdef VERBOSE
printf("did not read in the requested number of bytes\n");
printf("read in %d bytes instead of %d \n",jret, *no);
#endif
}
else {
#ifdef VERBOSE
printf("read in %d bytes requested \n", *no);
#endif
}
*nactual = jret;
*newpos = *start + jret;
}
/* Done with reading */
/* See if we should be writing */
if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
#ifdef VERBOSE
printf("Trying to write on a read only file \n");
#endif
return 249;
}
else if ( BAWRITE & *mode ) {
if (! (*mode & NOSEEK) ) {
seekret = lseek(*fdes, *start, SEEK_SET);
if (seekret == -1) {
#ifdef VERBOSE
printf("error in seeking to %d\n",*start);
#endif
return 248;
}
#ifdef VERBOSE
else {
printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
}
#endif
}
#ifdef CRAY90
datary = _fcdtocp(fcd_datary);
#endif
if (datary == NULL) {
printf("Massive catastrophe -- datary pointer is NULL\n");
return 102;
}
#ifdef VERBOSE
printf("write file descriptor, datary = %d %d\n", *fdes, (int) datary);
#endif
count = (size_t) *no;
jret = write(*fdes, (void *) datary, count);
if (jret != *no) {
#ifdef VERBOSE
printf("did not write out the requested number of bytes\n");
printf("wrote %d bytes instead\n", jret);
#endif
*nactual = jret;
*newpos = *start + jret;
}
else {
#ifdef VERBOSE
printf("wrote %d bytes \n", jret);
#endif
*nactual = jret;
*newpos = *start + jret;
}
}
/* Done with writing */
/* Close file if requested */
if (BACLOSE & *mode ) {
jret = close(*fdes);
if (jret != 0) {
#ifdef VERBOSE
printf("close failed! jret = %d\n",jret);
#endif
return 247;
}
}
/* Done closing */
/* Free the realname pointer to prevent memory leak */
if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
(BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
(BAOPEN_RW & *mode) ) {
free(realname);
}
/* Check that if we were reading or writing, that we actually got what */
/* we expected, else return a -10. Return 0 (success) if we're here */
/* and weren't reading or writing */
if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
return 246;
}
else {
return 0;
}
}
#if defined CRAY90
#include <fortran.h>
int BANI0L
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes,
_fcd fcd_fname, void *datary) {
char *fname;
int namelen;
#elif defined HP
int baniol
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined SGI
int baniol_
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined LINUXF90
int BANIO
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined VPP5000
int baniol_
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined IBM4
int baniol
(int * mode, long int * start, long int *newpos, long int * size, int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#elif defined IBM8
long long int baniol
(long long int * mode, long long int * start, long long int *newpos,
long long int * size, long long int * no,
long long int * nactual, long long int * fdes, const char *fname,
char *datary,
long long int namelen ) {
#else /* Default is LINUX */
int baniol_
(int * mode, long int * start, long int *newpos, int * size, long int * no,
long int * nactual, int * fdes, const char *fname, char *datary,
int namelen ) {
#endif
int i, jret, seekret;
char *realname;
/* Initialization(s) */
*nactual = 0;
/* Check for illegal combinations of options */
if (( BAOPEN_RONLY & *mode) &&
( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
#ifdef VERBOSE
printf("illegal -- trying to open both read only and write only\n");
#endif
return 255;
}
if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
#ifdef VERBOSE
printf("illegal -- trying to both read and write in the same call\n");
#endif
return 254;
}
/* This section handles Fortran to C translation of strings so as to */
/* be able to open the files Fortran is expecting to be opened. */
#ifdef CRAY90
namelen = _fcdlen(fcd_fname);
fname = _fcdtocp(fcd_fname);
#endif
if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
(BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
(BAOPEN_RW & *mode) ) {
#ifdef VERBOSE
printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
#endif
realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
if (realname == NULL) {
#ifdef VERBOSE
printf("failed to mallocate realname %d = namelen\n", namelen);
fflush(stdout);
#endif
return 253;
}
i=0;
while (i < namelen && isgraph(fname[i])) {
realname[i]=fname[i];
i++;
}
realname[i] = '\0';
}
/* Open files with correct read/write and file permission. */
if (BAOPEN_RONLY & *mode) {
#ifdef VERBOSE
printf("open read only %s\n", realname);
#endif
*fdes = open(realname, O_RDONLY , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY & *mode ) {
#ifdef VERBOSE
printf("open write only %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY_TRUNC & *mode ) {
#ifdef VERBOSE
printf("open write only with truncation %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_WONLY_APPEND & *mode ) {
#ifdef VERBOSE
printf("open write only with append %s\n", realname);
#endif
*fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else if (BAOPEN_RW & *mode) {
#ifdef VERBOSE
printf("open read-write %s\n", realname);
#endif
*fdes = open(realname, O_RDWR | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
}
else {
#ifdef VERBOSE
printf("no openings\n");
#endif
}
if (*fdes < 0) {
#ifdef VERBOSE
printf("error in file descriptor! *fdes %d\n", *fdes);
#endif
return 252;
}
else {
#ifdef VERBOSE
printf("file descriptor = %d\n",*fdes );
#endif
}
/* Read data as requested */
if (BAREAD & *mode &&
( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
#ifdef VERBOSE
printf("Error, trying to read while in write only mode!\n");
#endif
return 251;
}
else if (BAREAD & *mode ) {
/* Read in some data */
if (! (*mode & NOSEEK) ) {
seekret = lseek(*fdes, *start, SEEK_SET);
if (seekret == -1) {
#ifdef VERBOSE
printf("error in seeking to %d\n",*start);
#endif
return 250;
}
#ifdef VERBOSE
else {
printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
}
#endif
}
jret = read(*fdes, datary, *no*(*size) );
if (jret != *no*(*size) ) {
#ifdef VERBOSE
printf("did not read in the requested number of items\n");
printf("read in %d items of %d \n",jret/(*size), *no);
#endif
*nactual = jret/(*size);
*newpos = *start + jret;
}
#ifdef VERBOSE
printf("read in %d items \n", jret/(*size));
#endif
*nactual = jret/(*size);
*newpos = *start + jret;
}
/* Done with reading */
/* See if we should be writing */
if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
#ifdef VERBOSE
printf("Trying to write on a read only file \n");
#endif
return 249;
}
else if ( BAWRITE & *mode ) {
if (! (*mode & NOSEEK) ) {
seekret = lseek(*fdes, *start, SEEK_SET);
if (seekret == -1) {
#ifdef VERBOSE
printf("error in seeking to %d\n",*start);
#endif
return 248;
}
#ifdef VERBOSE
else {
printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
}
#endif
}
jret = write(*fdes, datary, *no*(*size));
if (jret != *no*(*size)) {
#ifdef VERBOSE
printf("did not write out the requested number of items\n");
printf("wrote %d items instead\n", jret/(*size) );
#endif
*nactual = jret/(*size) ;
*newpos = *start + jret;
}
else {
#ifdef VERBOSE
printf("wrote %d items \n", jret/(*size) );
#endif
*nactual = jret/(*size) ;
*newpos = *start + jret;
}
}
/* Done with writing */
/* Close file if requested */
if (BACLOSE & *mode ) {
jret = close(*fdes);
if (jret != 0) {
#ifdef VERBOSE
printf("close failed! jret = %d\n",jret);
#endif
return 247;
}
}
/* Done closing */
/* Free the realname pointer to prevent memory leak */
if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
(BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
(BAOPEN_RW & *mode) ) {
free(realname);
}
/* Check that if we were reading or writing, that we actually got what */
/* we expected, else return a -10. Return 0 (success) if we're here */
/* and weren't reading or writing */
if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
return 246;
}
else {
return 0;
}
}