aboutsummaryrefslogtreecommitdiff
path: root/gcc/f/runtime/libI77/err.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/f/runtime/libI77/err.c')
-rw-r--r--gcc/f/runtime/libI77/err.c298
1 files changed, 0 insertions, 298 deletions
diff --git a/gcc/f/runtime/libI77/err.c b/gcc/f/runtime/libI77/err.c
deleted file mode 100644
index 1d0188737be..00000000000
--- a/gcc/f/runtime/libI77/err.c
+++ /dev/null
@@ -1,298 +0,0 @@
-#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;
-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__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;
- }