libf2c/libI77/err.c

#ifndef NON_UNIX_STDIO
#define _INCLUDE_POSIX_SOURCE	/* for HP-UX */
#define _INCLUDE_XOPEN_SOURCE	/* for HP-UX */
#include <sys/types.h>
#include <sys/stat.h>
#endif
#include "f2c.h"
#ifdef KR_headers
extern char *malloc();
#else
#undef abs
#undef min
#undef max
#include <stdlib.h>
#endif
#include "fio.h"
#include "fmt.h"	/* for struct syl */

/*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)();	/* for formatted input */
void (*f__putn)();	/* for formatted output */
#else
int (*f__getn)(void);	/* for formatted input */
void (*f__putn)(int);	/* for formatted output */
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 */
	"Temporary file name (TMPDIR?) too long"        /* 132 */
};
#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 ",
				(int)(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);
	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, urw;
	extern char *f__r_mode[], *f__w_mode[];

	if (x->urw & 1)
		goto done;
	if (!x->ufnm)
		goto cantread;
	ufmt = x->url ? 0 : x->ufmt;
	loc = ftell(x->ufd);
	urw = 3;
	if (!freopen(x->ufnm, f__w_mode[ufmt|2], x->ufd)) {
		urw = 1;
		if(!freopen(x->ufnm, f__r_mode[ufmt], x->ufd)) {
 cantread:
			errno = 126;
			return 1;
			}
		}
	fseek(x->ufd,loc,SEEK_SET);
	x->urw = urw;
 done:
	x->uwrt = 0;
	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[];

	if (x->urw & 2)
		goto done;
	if (!x->ufnm)
		goto cantwrite;
	ufmt = x->url ? 0 : x->ufmt;
	if (x->uwrt == 3) { /* just did write, rewind */
		if (!(f__cf = x->ufd =
				freopen(x->ufnm,f__w_mode[ufmt],x->ufd)))
			goto cantwrite;
		x->urw = 2;
		}
	else {
		loc=ftell(x->ufd);
		if (!(f__cf = x->ufd =
			freopen(x->ufnm, f__w_mode[ufmt |= 2], x->ufd)))
			{
			x->ufd = NULL;
 cantwrite:
			errno = 127;
			return(1);
			}
		x->urw = 3;
		fseek(x->ufd,loc,SEEK_SET);
		}
 done:
	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;
	}