diff options
Diffstat (limited to 'libf2c/libI77/err.c')
| -rw-r--r-- | libf2c/libI77/err.c | 299 |
1 files changed, 299 insertions, 0 deletions
diff --git a/libf2c/libI77/err.c b/libf2c/libI77/err.c new file mode 100644 index 00000000000..12eb9eed9d6 --- /dev/null +++ b/libf2c/libI77/err.c @@ -0,0 +1,299 @@ +#ifndef NON_UNIX_STDIO +#include <sys/types.h> +#include <sys/stat.h> +#endif +#include "f2c.h" +#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS) +#ifdef KR_headers +extern char *malloc(); +#else +#undef abs +#undef min +#undef max +#include <stdlib.h> +#endif +#endif +#include "fio.h" +#include "fmt.h" /* for struct syl */ +#include "rawio.h" /* for fcntl.h, fdopen */ + +/*global definitions*/ +unit f__units[MXUNIT]; /*unit table*/ +int f__init; /*bit 0: set after initializations; + bit 1: set during I/O involving returns to + caller of library (or calls to user code)*/ +cilist *f__elist; /*active external io list*/ +icilist *f__svic; /*active internal io list*/ +flag f__reading; /*1 if reading, 0 if writing*/ +flag f__cplus,f__cblank; +char *f__fmtbuf; +int f__fmtlen; +flag f__external; /*1 if external io, 0 if internal */ +#ifdef KR_headers +int (*f__doed)(),(*f__doned)(); +int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)(); +int (*f__getn)(),(*f__putn)(); /*for formatted io*/ +#else +int (*f__getn)(void),(*f__putn)(int); /*for formatted io*/ +int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*); +int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void); +#endif +flag f__sequential; /*1 if sequential io, 0 if direct*/ +flag f__formatted; /*1 if formatted io, 0 if unformatted*/ +FILE *f__cf; /*current file*/ +unit *f__curunit; /*current unit*/ +int f__recpos; /*place in current record*/ +int f__cursor, f__hiwater, f__scale; +char *f__icptr; + +/*error messages*/ +char *F_err[] = +{ + "error in format", /* 100 */ + "illegal unit number", /* 101 */ + "formatted io not allowed", /* 102 */ + "unformatted io not allowed", /* 103 */ + "direct io not allowed", /* 104 */ + "sequential io not allowed", /* 105 */ + "can't backspace file", /* 106 */ + "null file name", /* 107 */ + "can't stat file", /* 108 */ + "unit not connected", /* 109 */ + "off end of record", /* 110 */ + "truncation failed in endfile", /* 111 */ + "incomprehensible list input", /* 112 */ + "out of free space", /* 113 */ + "unit not connected", /* 114 */ + "read unexpected character", /* 115 */ + "bad logical input field", /* 116 */ + "bad variable type", /* 117 */ + "bad namelist name", /* 118 */ + "variable not in namelist", /* 119 */ + "no end record", /* 120 */ + "variable count incorrect", /* 121 */ + "subscript for scalar variable", /* 122 */ + "invalid array section", /* 123 */ + "substring out of bounds", /* 124 */ + "subscript out of bounds", /* 125 */ + "can't read file", /* 126 */ + "can't write file", /* 127 */ + "'new' file exists", /* 128 */ + "can't append to file", /* 129 */ + "non-positive record number", /* 130 */ + "I/O started while already doing I/O" /* 131 */ +}; +#define MAXERR (sizeof(F_err)/sizeof(char *)+100) + +#ifdef KR_headers +f__canseek(f) FILE *f; /*SYSDEP*/ +#else +f__canseek(FILE *f) /*SYSDEP*/ +#endif +{ +#ifdef NON_UNIX_STDIO + return !isatty(fileno(f)); +#else + struct stat x; + + if (fstat(fileno(f),&x) < 0) + return(0); +#ifdef S_IFMT + switch(x.st_mode & S_IFMT) { + case S_IFDIR: + case S_IFREG: + if(x.st_nlink > 0) /* !pipe */ + return(1); + else + return(0); + case S_IFCHR: + if(isatty(fileno(f))) + return(0); + return(1); +#ifdef S_IFBLK + case S_IFBLK: + return(1); +#endif + } +#else +#ifdef S_ISDIR + /* POSIX version */ + if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) { + if(x.st_nlink > 0) /* !pipe */ + return(1); + else + return(0); + } + if (S_ISCHR(x.st_mode)) { + if(isatty(fileno(f))) + return(0); + return(1); + } + if (S_ISBLK(x.st_mode)) + return(1); +#else + Help! How does fstat work on this system? +#endif +#endif + return(0); /* who knows what it is? */ +#endif +} + + void +#ifdef KR_headers +f__fatal(n,s) char *s; +#else +f__fatal(int n, char *s) +#endif +{ + static int dead = 0; + + if(n<100 && n>=0) perror(s); /*SYSDEP*/ + else if(n >= (int)MAXERR || n < -1) + { fprintf(stderr,"%s: illegal error number %d\n",s,n); + } + else if(n == -1) fprintf(stderr,"%s: end of file\n",s); + else + fprintf(stderr,"%s: %s\n",s,F_err[n-100]); + if (dead) { + fprintf (stderr, "(libf2c f__fatal already called, aborting.)"); + abort(); + } + dead = 1; + if (f__init & 1) { + if (f__curunit) { + fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units); + fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n", + f__curunit->ufnm); + } + else + fprintf(stderr,"apparent state: internal I/O\n"); + if (f__fmtbuf) + fprintf(stderr,"last format: %.*s\n",f__fmtlen,f__fmtbuf); + fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing", + f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted", + f__external?"external":"internal"); + } + f__init &= ~2; /* No longer doing I/O (no more user code to be called). */ + sig_die(" IO", 1); +} +/*initialization routine*/ + VOID +f_init(Void) +{ unit *p; + + if (f__init & 2) + f__fatal (131, "I/O recursion"); + f__init = 1; + p= &f__units[0]; + p->ufd=stderr; + p->useek=f__canseek(stderr); +#ifdef _IOLBF + setvbuf(stderr, (char*)malloc(BUFSIZ+8), _IOLBF, BUFSIZ+8); +#else +#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS) + setbuf(stderr, (char *)malloc(BUFSIZ+8)); +#else + stderr->_flag &= ~_IONBF; +#endif +#endif + p->ufmt=1; + p->uwrt=1; + p = &f__units[5]; + p->ufd=stdin; + p->useek=f__canseek(stdin); + p->ufmt=1; + p->uwrt=0; + p= &f__units[6]; + p->ufd=stdout; + p->useek=f__canseek(stdout); + p->ufmt=1; + p->uwrt=1; +} +#ifdef KR_headers +f__nowreading(x) unit *x; +#else +f__nowreading(unit *x) +#endif +{ + long loc; + int ufmt; + extern char *f__r_mode[]; + + if (!x->ufnm) + goto cantread; + ufmt = x->ufmt; + loc=ftell(x->ufd); + if(freopen(x->ufnm,f__r_mode[ufmt],x->ufd) == NULL) { + cantread: + errno = 126; + return(1); + } + x->uwrt=0; + (void) fseek(x->ufd,loc,SEEK_SET); + return(0); +} +#ifdef KR_headers +f__nowwriting(x) unit *x; +#else +f__nowwriting(unit *x) +#endif +{ + long loc; + int ufmt; + extern char *f__w_mode[]; +#ifndef NON_UNIX_STDIO + int k; +#endif + + if (!x->ufnm) + goto cantwrite; + ufmt = x->ufmt; +#ifdef NON_UNIX_STDIO + ufmt |= 2; +#endif + if (x->uwrt == 3) { /* just did write, rewind */ +#ifdef NON_UNIX_STDIO + if (!(f__cf = x->ufd = + freopen(x->ufnm,f__w_mode[ufmt],x->ufd))) +#else + if (close(creat(x->ufnm,0666))) +#endif + goto cantwrite; + } + else { + loc=ftell(x->ufd); +#ifdef NON_UNIX_STDIO + if (!(f__cf = x->ufd = + freopen(x->ufnm, f__w_mode[ufmt], x->ufd))) +#else + if (fclose(x->ufd) < 0 + || (k = x->uwrt == 2 ? creat(x->ufnm,0666) + : open(x->ufnm,O_WRONLY)) < 0 + || (f__cf = x->ufd = fdopen(k,f__w_mode[ufmt])) == NULL) +#endif + { + x->ufd = NULL; + cantwrite: + errno = 127; + return(1); + } + (void) fseek(x->ufd,loc,SEEK_SET); + } + x->uwrt = 1; + return(0); +} + + int +#ifdef KR_headers +err__fl(f, m, s) int f, m; char *s; +#else +err__fl(int f, int m, char *s) +#endif +{ + if (!f) + f__fatal(m, s); + if (f__doend) + (*f__doend)(); + f__init &= ~2; + return errno = m; + } |