xref: /original-bsd/usr.bin/f77/libI77/err.c (revision 2852c678)
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 
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
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
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
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
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
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