1 /*-
2 * Copyright (c) 1980 The Regents of the University of California.
3 * All rights reserved.
4 *
5 * %sccs.include.proprietary.c%
6 */
7
8 #ifndef lint
9 static char sccsid[] = "@(#)err.c 5.4 (Berkeley) 04/12/91";
10 #endif /* not lint */
11
12 /*
13 * fatal(): i/o error routine
14 * flush_(): flush file buffer
15 */
16
17 #include <sys/types.h>
18 #include <sys/stat.h>
19 #include <signal.h>
20 #include "fio.h"
21
22 /*
23 * global definitions
24 */
25
26 unit units[MXUNIT]; /*unit table*/
27 flag reading; /*1 if reading, 0 if writing*/
28 flag external; /*1 if external io, 0 if internal */
29 flag sequential; /*1 if sequential io, 0 if direct*/
30 flag formatted; /*1 if formatted io, 0 if unformatted,
31 -1 if list directed, -2 if namelist */
32 char *fmtbuf, *icptr, *icend, *fmtptr;
33 int (*doed)(),(*doned)();
34 int (*doend)(),(*donewrec)(),(*dorevert)(),(*dotab)();
35 int (*lioproc)();
36 int (*getn)(),(*putn)(),(*ungetn)(); /*for formatted io*/
37 FILE *cf; /*current file structure*/
38 unit *curunit; /*current unit structure*/
39 int lunit; /*current logical unit*/
40 char *lfname; /*current filename*/
41 int recpos; /*place in current record*/
42 ftnint recnum; /* current record number */
43 int reclen; /* current record length */
44 int cursor,scale;
45 int radix;
46 ioflag signit,tab,cplus,cblank,elist,errflag,endflag,lquit,l_first;
47 flag leof;
48 int lcount,line_len;
49 struct ioiflg ioiflg_; /* initialization flags */
50
51 /*error messages*/
52
53 extern int sys_nerr;
54
55 extern char *f_errlist[];
56 extern int f_nerr;
57
58
fatal(n,s)59 fatal(n,s) char *s;
60 {
61 ftnint lu;
62 char *strerror();
63
64 for (lu=1; lu < MXUNIT; lu++)
65 flush_(&lu);
66 if(n<0)
67 fprintf(stderr,"%s: [%d] end of file\n",s,n);
68 else if(n>=0 && n<sys_nerr)
69 fprintf(stderr,"%s: [%d] %s\n",s,n, strerror(n));
70 else if(n>=F_ER && n<F_MAXERR)
71 fprintf(stderr,"%s: [%d] %s\n",s,n,f_errlist[n-F_ER]);
72 else
73 fprintf(stderr,"%s: [%d] unknown error number\n",s,n);
74 if(external)
75 {
76 if(!lfname) switch (lunit)
77 { case STDERR: lfname = "stderr";
78 break;
79 case STDIN: lfname = "stdin";
80 break;
81 case STDOUT: lfname = "stdout";
82 break;
83 default: lfname = "";
84 }
85 fprintf(stderr,"logical unit %d, named '%s'\n",lunit,lfname);
86 }
87 if (elist)
88 { fprintf(stderr,"lately: %s %s %s %s I/O\n",
89 reading?"reading":"writing",
90 sequential?"sequential":"direct",
91 formatted>0?"formatted":(formatted==0?"unformatted":
92 (formatted==LISTDIRECTED?"list":"namelist")),
93 external?"external":"internal");
94 if (formatted)
95 { if(fmtbuf) prnt_fmt(n);
96 if (external)
97 { if(reading && curunit->useek)
98 prnt_ext(); /* print external data */
99 }
100 else prnt_int(); /* print internal array */
101 }
102 }
103 f77_abort(n);
104 }
105
106 LOCAL
prnt_ext()107 prnt_ext()
108 { int ch;
109 int i=1;
110 long loc;
111 fprintf (stderr, "part of last data: ");
112 loc = ftell(curunit->ufd);
113 if(loc)
114 { if(loc==1L) rewind(curunit->ufd);
115 else for(;i<12 && last_char(curunit->ufd)!='\n';i++);
116 while(i--) ffputc(fgetc(curunit->ufd),stderr);
117 }
118 fputc('|',stderr);
119 for(i=0;i<5 && (ch=fgetc(curunit->ufd))!=EOF;i++) ffputc(ch,stderr);
120 fputc('\n',stderr);
121 }
122
123 LOCAL
prnt_int()124 prnt_int()
125 { char *ep;
126 fprintf (stderr,"part of last string: ");
127 ep = icptr - (recpos<12?recpos:12);
128 while (ep<icptr) ffputc(*ep++,stderr);
129 fputc('|',stderr);
130 while (ep<(icptr+5) && ep<icend) ffputc(*ep++,stderr);
131 fputc('\n',stderr);
132 }
133
134 LOCAL
prnt_fmt(n)135 prnt_fmt(n) int n;
136 { int i; char *ep;
137 fprintf(stderr, "format: ");
138 if(n==F_ERFMT)
139 { i = fmtptr - fmtbuf;
140 ep = fmtptr - (i<25?i:25);
141 if(ep != fmtbuf) fprintf(stderr, "... ");
142 i = i + 5;
143 }
144 else
145 { ep = fmtbuf;
146 i = 25;
147 fmtptr = fmtbuf - 1;
148 }
149 while(i && *ep)
150 { ffputc((*ep==GLITCH)?'"':*ep,stderr);
151 if(ep==fmtptr) fputc('|',stderr);
152 ep++; i--;
153 }
154 if(*ep) fprintf(stderr, " ...");
155 fputc('\n',stderr);
156 }
157
158 LOCAL
ffputc(c,f)159 ffputc(c, f)
160 int c;
161 FILE *f;
162 {
163 c &= 0177;
164 if (c < ' ' || c == 0177)
165 {
166 fputc('^', f);
167 c ^= 0100;
168 }
169 fputc(c, f);
170 }
171
172 ftnint
flush_(u)173 flush_(u) ftnint *u;
174 {
175 FILE *F;
176
177 if(not_legal(*u))
178 return(F_ERUNIT);
179 F = units[*u].ufd;
180 if(F)
181 return(fflush(F));
182 else
183 return(F_ERNOPEN);
184 }
185