/* 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 #endif /* #include -- 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)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 */