/* fcio.h - FORTRAN-77 I/O header to support FOR_C translations */
/* copyright Cobalt Blue, Inc. 1987 - 1992
ALL RIGHTS RESERVED */
#ifndef FCIO_DEFINED
#define FCIO_DEFINED
#ifndef EOF /* insure stdio.h is included */
#include <stdio.h>
#endif
/* #include <io.h> -- if available, incl for decl of access() */
/* This macro switch causes an UNopened unit to automatically be opened
* when making a writef() call, (from the default translation of a
* formatted WRITE).
*/
#define AUTO_OPEN_UNIT
/* When defined, STATUS_WARNINGS causes basic warning messages to be
* issued at runtime with certain I/O status check errors. These
* messages merely further reflect the unit status. Since most FORTRAN
* programmers fail to check the I/O status, it is recommended that
* this macro be defined and the messages generated.
*/
#define STATUS_WARNINGS
/* When defined, STD_PRN initializes STDPRN_UNIT with stdprn, a typical
* MSDOS extension that is preopened to the default system printer.
*/
/*#define STD_PRN*/
/* Bit field support by target C compiler */
#ifdef NO_BIT_FIELDS
# define BIT1
#else /* bit fields supported */
# define BIT1 :1
#endif
#define INSUFFICIENT_RECORD_OK /* short records are filled w/SHORT_FILLCHR */
/* Not std F77, but practical F77 */
#define NEED_COMPLEX
#define SHORT_FILLCHR ' '
/* if using ' ', beware of large numbers if BZ editing
* alternatively, use '\0', but watchout for short strings
*/
/* * * * */
/* F77 FORMAT Translation Support */
typedef struct{
long stmtn; /* format stmt no. */
char *fmt; /* the format str */
} F77FMT;
#define FMTR(stmt) _fmt((long)stmt,_fmts)
#ifdef PROTOTYPES
char *_fmt( long, F77FMT* ); /* retn ptr to fmt str corres to stmt no. */
#else
char *_fmt();
#endif
/* * * * */
#define MAXLINE SEQ_BUFSIZ
#define MAX_UNITS 50
#define MAX_UNITSIZ (MAX_UNITS + 1 + 3) /* max. no. units */
#define MAX_PAREN 7 /* maximum nested ()'s in format */
/* maximum limit is 15 (due to F_FORMAT struct) */
#define MAX_SCALEF 255
#define SEQ_BUFSIZ 256
/* std pre-attached units */
#define INTERNAL_UNIT MAX_UNITS /* internal file unit */
#define STDIN_UNIT (MAX_UNITS+1) /* stdin */
#define STDOUT_UNIT (MAX_UNITS+2) /* stdout */
#ifdef STD_PRN /*typically MSDOS only*/
#define STDPRN_UNIT (MAX_UNITS+3) /* stdprn */
#endif
/* NOTE: Units 5 and 6 are also pre-opened to stdin & stdout respectively
* for additional compatibility w/older FORTRAN. See IN_UNIT and
* OUT_UNIT in "opncls.c".
*/
/* positive return value from inquire functs that set a char value */
#define OK 1
#define YES 1
#define NO 0
/* F77 file types */
#define OLD 0
#define NEW 1
#define SCRATCH 2
#define UNKNOWN 3
/* access method */
#define SEQUENTIAL 0
#define DIRECT 1
#define APPEND 2
/* io type */
#define FORMATTED FMT
#define UNFORMATTED UNF
#define FMT 0
#define UNF 1
/* blank treatment */
#define BLANK_NULL 0
#define BLANK_ZERO 1
/* sign treatment */
#define NORMSIGN 0
#define PLUSSIGN 1
/* unit error status (& ios values) */
/* open errors */
#define UNABLE_TO_OPEN_OLD 1
#define UNABLE_TO_CREATE_NEW 2
#define UNABLE_TO_CREATE_SCRATCH 3
#define UNABLE_TO_OPEN_UNKNOWN 4
#define BAD_OPEN_STATUS 5
#define BAD_FORM 6
#define BAD_RECLEN 7
#define BAD_ACCESS 8
#define BAD_BLANK 9
#define UNABLE_TO_SEEK_TO_EOF 10 /*ACCESS=APPEND extension*/
#define MEMERR_FILENAME 11
#define MEMERR_UNITBUF 12
#define MEMERR_FORMAT 13
/* close errors */
#define UNABLE_TO_CLOSE 21
#define UNABLE_TO_DELETE 22
#define BAD_CLOSE_STATUS 23
/* read/write stmt transl. beginnings */
#define NOT_OPEN 31
#define NOT_OPEN_FOR_SEQUENTIAL 34
#define NOT_OPEN_FOR_DIRECT 35
#define NOT_OPEN_FOR_FORMAT 36
#define MISSING_FORMAT 41
#define NO_DIRECT_LSTDIR_IO 42
#define BAD_RECORD_NO 43
/* write errors */
#define WRITE_ERR 51
#define WRTDIR_EXCEED_RECLEN 52
#define BUF_EXCEEDED 53
/* read errors */
#define READ_ERR 61
#define SHORT_RECORD 62 /* insufficient record */
#define ILLEGAL_LOGICAL_INPUT 63
#define ILLEGAL_INT_INPUT 64
#define ILLEGAL_FP_INPUT 65
#define ILLEGAL_HEX_INPUT 66
#define ILLEGAL_OCT_INPUT 67
/* file position errors */
#define CANT_REPOSITION 71 /* basic file position error */
#define UNABLE_TO_BACKSPACE 72
#define BAD_UNIT 99
/* end of unit status errors */
#define IS_INTERNAL(u) ((u) == INTERNAL_UNIT)
#define VALID_UNIT(u) ((u)>=0 && (u)<MAX_UNITSIZ)
#define LIST_DIRECT_IO(us) (*(us->ff->fmt)=='*')
typedef struct { /* F77 field edit structure */
int fd, /* field descriptor */
w, /* field width, >0 */
d, /* field decimal precision, >= 0 */
x; /* field exponent width, (fp only), >0 */
char *s; /*ptr to (static) edit string, (originally for B edit) */
} FEDIT;
#define MAX_FMTLEN 127 /*max working space for formatted str*/
typedef struct { /* FORMAT info */
char *fmt; /* ptr to current format string */
char *cf; /* ptr to next position in current format string */
char *lp; /* ptr to last left paren. in format string */
int lprept; /* last left paren. repeat factor */
int lpdep; /* last left paren. depth */
unsigned cblank BIT1; /* blank treatment: BLANK_NULL or BLANK_ZERO */
unsigned signc BIT1; /* NORMSIGN, PLUSSIGN */
int scalef; /* current scale factor */
int pdep; /* paren depth (index to reptcnt[] & paren[]) */
int prept[MAX_PAREN]; /* no. of times to repeat a ()'s format group */
char* paren[MAX_PAREN]; /* ptr to the '(' in the format */
} F_FORMAT;
typedef struct { /* F77 UNIT STRUCTURE */
FILE *fp; /* corres. C file ptr (NULL if unit isn't opened) */
char *fname; /* ptr to strsav'd filename */
char f77typ; /* OLD, NEW, SCRATCH, or UNKNOWN */
short int status; /* error status; >0 if error, <0 if at EOF */
unsigned reclen; /* SEQ_BUFSIZ or specified direct rec len */
unsigned ateof BIT1; /* TRUE if at EOF (set by ENDFILE) */
char access; /* SEQUENTIAL (or APPEND), DIRECT */
unsigned form BIT1; /* FORMATTED or UNFORMATTED */
unsigned blank BIT1; /* BLANK_NULL or BLANK_ZERO */
unsigned intu BIT1; /* TRUE if internal unit */
unsigned carrgc BIT1; /* TRUE if carriage control char is used */
/* FORMAT info */
F_FORMAT *ff; /* ptr to F77 formatted I/O info */
/* unit buffer */
char *ubuf; /* ptr to unit buffer associated w/this unit */
char *nxtu; /* ptr to next position in unit buffer */
char *ubufend; /* ptr to end of unit buffer */
int setbuf; /* if true, init. ubuf to ' 's */
} UNITSTRU;
/* UBUF(u) represents the buffer ptr assoc. w/a unit */
#define UBUF(u) unit_s[u].ubuf
/* UEOF(u) returns -1 if the unit status indicates EOF, else 0 */
#define UEOF(u) (unit_s[u].status<0 ? -1 : 0)
/* NOTE: UEOF() references generated from END= translations */
/* UERR(u) returns the unit error status: EOF <0, ERROR >0, no errors 0 */
#define UERR(u) (unit_s[u].status)
/* NOTE: UERR() references generated from ERR= and IOSTAT= translations */
/* UFMT(u) returns the unit format status, either FMT or UNF */
#define UFMT(u) unit_s[u].form
/* UFP(u) represents the fp associated w/a unit */
#define _ERR_ "ERR=" /* Added by Krogh to eliminate diagnostic -- what
should be here is a mystery. */
# define UFP(u) (VALID_UNIT(u) ? unit_s[u].fp: \
(u==_ERR_ ? (FILE*)NULL : (FILE*)badunitp(u)))
/* UOS(u,r) returns the file offset for a given unit & record */
#define UOS(u,r) (long)(r-1)*unit_s[u].reclen
/* URECL(u) represents the record length assoc. w/a unit */
#define URECLW(u) (unit_s[u].form==UNFORMATTED? \
URECL(u)/reclen_wordsiz : URECL(u)) /* in words */
#define URECL(u) unit_s[u].reclen /* in bytes */
/* URESETF(u) reset the unit error status & eof flags */
#define URESETF(u) {unit_s[u].status=unit_s[u].ateof=0;}
/* TorF(l) returns a 'T' or 'F' depending on the 'logical' expr 'l' */
/* #define TorF(l) ( l ? 'T' : 'F' ) */
/* * * * */
/* I/O EXTERNALS */
#ifndef EXTERNL
#define EXTERNL extern
/* NOTE: EXTERNL is defined as nothing in f77_ini.c to define the
the EXTERNLs in that file. This K&R approach avoids problems
with certain older Librarians in use. */
#endif
EXTERNL int milspec; /* flag for milspec extensions */
/* set to zero to disable any MILSPEC runtime extensions */
EXTERNL int reclen_wordsiz; /* (in bytes) used w/direct unformated I/O */
/* F77 std defines direct unformatted I/O in terms of the word size,
* VAX F77 defines the word size as a float, (our default)
* MS FORTRAN however defines the word size as a byte,
* This external should be set as appropriate for your code.
* SEE f77ini.c FOR DETAILS!
*/
EXTERNL UNITSTRU unit_s[MAX_UNITSIZ];
/* NOTE: unit_s[] is defined once in f77_ini.c */
/* * * * */
#define close_units cls_units /*rename to distinguish for strict ANSI C*/
#ifdef PROTOTYPES
/* * * I/O function prototypes * * */
/* OPEN/CLOSE functs */
int close_unit(int, char*); /* returns 1 if successfully closed, else ERR*/
void close_units(void); /* close all units left open at termination */
int open_unit(int,char*,char*,char*,char*,int); /*open file on a F77 unit*/
int unit_blank(int,char*); /* set the unit blank handling attribute */
char *prep_fn(char*); /* trim blanks (& lowercase) filename */
/* READ functions */
int dreadf(int,long,char*,char*,...); /*F77 style direct fmt'd read*/
void rd_dirbeg( int, long, char* ); /*init. unit for direct reading*/
void rd_seqbeg( int, char* ); /*init. format struct for sequential I/O*/
int readf(int,char*,char*,...); /* F77 style formatted read */
int readfmt( int, char*, ... ); /* F77 style formatted read */
int fscanld( FILE*, char*, ... ); /*list directed fmt'd INput*/
int sscanld( char*, char*, ... ); /*list directed fmt'd INput*/
int scanlderr( void ); /* list directed read error ck */
void ird_seqbeg(char*,unsigned,char*); /* internal read */
void irdsubs_seqbeg(char*,unsigned,unsigned,char*); /*int read from substr*/
/* WRITE functions */
int dwritef(int,long,char*,char*,...); /*F77 style direct fmt'd write*/
void wrt_dirbeg(int, long, char*); /*init. unit for direct writing*/
void wrt_seqbeg(int,char*); /*init. format struct for sequential I/O*/
int writef(int,char*,char*,...); /*F77 style formatted write */
int wrtfmt(int, char*, ... ); /* F77 style formatted write */
int wrtubuf( UNITSTRU* ); /* write out the unit buffer contents*/
void iwrt_seqbeg(char*,unsigned,char*); /* internal write */
void iwrtsubs_seqbeg(char*,unsigned,unsigned,char*); /*int write to substr*/
/* FORMAT functions - internal */
void getunitfd(UNITSTRU*,FEDIT*); /*get & retn field edit descr*/
void io_fmtini(int,char*); /*init. F77 format struct*/
void io_fmtuntl(UNITSTRU*,int,int); /*process until field descr found*/
void setubuf(UNITSTRU*); /* init. ubuf to ' 's */
/* INQUIRE functs */
void inqu_acc( int, char* ); /* get the access assoc. w/a unit */
void inqu_blank(int, char*); /* get the blank treatment setting */
void inqu_dir( int, char* ); /* store "YES" in dir if DIRECT access */
int inqu_existu( int ); /* return 1 if unit exists */
void inqu_fmt( int, char* ); /* store "YES" in fmt if FORMATTED io */
void inqu_form( int, char* ); /* return the form mode assoc. w/a unit */
void inqu_name(int, char*); /* get the filename assoc. w/a unit */
int inqu_named( int ); /* return TRUE if filename assoc. w/unit */
int inqu_opened( int ); /* retn TRUE if unit is opened */
void inqu_seq( int, char* ); /* store "YES" in seq if SEQUENTIAL access*/
void inqu_unf( int, char* ); /* store "YES" in unf if UNFORMATTED io */
int inqu_unit( char* ); /* retn the unit assoc. w/a filename */
/* file position functs (sequential access only) */
void endfil( int ); /* turn on the 'ateof' flag */
void bkspunit( int ); /* backspace file 1 record */
void bkspace( FILE*, int ); /* backspace file 1 line (or rec) */
int bkspf( FILE* ); /* backspace 1 line in a formatted file */
int bkspunf( FILE* ); /* backspace an unformatted file 1 record */
/* misc internal I/O functions */
void auto_openunit(int,int); /* auto. open unit */
void baderr( int ); /* invalid unit number used */
void badunit( int ); /* report a bad unit error & quit */
void *badunitp(int);
void set_crrgcntl(int,int); /* set the carriage control flag on the unit*/
void fmterr(char*,char*);/*output format error & quit */
void ioerr( char* ); /* output io error msg & quit */
void iowarn( char* ); /* output io warning msg & return */
char *iostrsav( char* ); /* save str in memory */
#else /* DON'T USE PROTOTYPE DEFINITIONS */
/* * * I/O function declarations * * */
/* OPEN/CLOSE functs */
int close_unit(), open_unit(), unit_blank();
void close_units();
char *prep_fn();
/* READ functions */
void rd_dirbeg(), rd_seqbeg();
int readf(), readfmt(), fscanld(), sscanld(), scanlderr();
void ird_seqbeg(), irdsubs_seqbeg();
/* WRITE functions */
void wrt_dirbeg(), wrt_seqbeg();
int writef(), wrtfmt(), wrtubuf();
void iwrt_seqbeg(), iwrtsubs_seqbeg();
/* FORMAT functions - internal */
void getunitfd();
void io_fmtini();
void io_fmtuntl();
void setubuf();
/* INQUIRE functs */
void inqu_acc(), inqu_blank(), inqu_dir(), inqu_fmt(), inqu_form();
void inqu_name(), inqu_seq(), inqu_unf();
int inqu_existu(), inqu_named(), inqu_opened(), inqu_unit();
/* file position functs (sequential access only) */
void endfil();
void bkspunit(), bkspace();
int bkspf(), bkspunf();
/* misc internal I/O functions */
void auto_openunit();
void baderr();
void badunit(), *badunitp();
void set_crrgcntl();
void fmterr();
void ioerr(), iowarn();
char *iostrsav();
#endif
/* * * * */
/* read char from unit (us) for FORMATTED I/O
(retns 0 if error detected, 'us' should NOT be an expr, but a sgl obj!) */
#ifdef INSUFFICIENT_RECORD_OK
#define rdcunit(us) ( (*us->nxtu=='\0'||*us->nxtu=='\n') ? \
SHORT_FILLCHR : *us->nxtu++ )
#else /* std F77 behavior, error if insufficient record */
#define rdcunit(us) (us->status? 0 : \
(*us->nxtu=='\0'||*us->nxtu=='\n'?(us->status=SHORT_RECORD,0):*us->nxtu++))
/* The status is set to indicate insufficient record if at the eol
and the input field isn't satisfied */
#endif
/* put char 'c' into the unit output buffer */
#define WRTCH(c,us) { if( us->nxtu < us->ubufend ) \
{*us->nxtu++ = (c);} \
else us->status = BUF_EXCEEDED; }
/* * * * */
#include "unfio.h" /* include the unformatted I/O decls */
/* * * * */
#if unix || M_XENIX || sun || _IBMR2
# ifdef __STDC__ /* ANSI C on UNIX */
/* no changes needed */
# else /* UNIX System V C */
/* supply necessary ANSI C definitions */
# define SEEK_SET 0
# define SEEK_CUR 1
# define SEEK_END 2
# ifdef PROTOTYPES
int fscanf(FILE*, const char*, ...);
int scanf(const char*, ...);
int sprintf(char*, const char*, ...);
int sscanf(const char*, const char*, ...);
int vfprintf(FILE*, const char*, ...);
int vprintf(const char*, ...);
int vsprintf(char*, const char*, ...);
int fgetc(FILE*);
int fputc(int, FILE*);
int fputs(const char*, FILE*);
int puts(const char*);
int ungetc(int, FILE*);
size_t fread(void*, size_t, size_t, FILE*);
size_t fwrite(const void*, size_t, size_t, FILE*);
int fseek(FILE*, long int, int);
long int ftell(FILE*);
void perror(const char*);
# else /* DON'T USE PROTOTYPE DEFINITIONS */
int fscanf();
int scanf();
# if sun || M_XENIX /* native sun unix C compiler */
# define _LEN(x) strlen(x)
char *sprintf();
# else /* ansi C definition */
# define _LEN(x) x
int sprintf();
# endif
int sscanf();
int vfprintf();
int vprintf();
int vsprintf();
int fgetc();
int fputc();
int fputs();
int puts();
int ungetc();
size_t fread();
size_t fwrite();
int fseek();
long int ftell();
void perror();
# endif /* prototypes */
# endif /* ansi C or unix system V C */
#endif /* on unix || M_XENIX || sun || _IBMR2 */
#endif /* FCIO_DEFINED */