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