libf2c/libI77/err.c

   1 #include "config.h"
   2 #ifndef NON_UNIX_STDIO
   3 #define _INCLUDE_POSIX_SOURCE   /* for HP-UX */
   4 #define _INCLUDE_XOPEN_SOURCE   /* for HP-UX */
   5 #include <sys/types.h>
   6 #include <sys/stat.h>
   7 #endif
   8 #include "f2c.h"
   9 #undef abs
  10 #undef min
  11 #undef max
  12 #include <stdlib.h>
  13 #include "fio.h"
  14 #include "fmt.h"                /* for struct syl */
  15
  16 /*global definitions*/
  17 unit f__units[MXUNIT];          /*unit table */
  18 int f__init;                    /*bit 0: set after initializations;
  19                                    bit 1: set during I/O involving returns to
  20                                    caller of library (or calls to user code) */
  21 cilist *f__elist;               /*active external io list */
  22 icilist *f__svic;               /*active internal io list */
  23 flag f__reading;                /*1 if reading, 0 if writing */
  24 flag f__cplus, f__cblank;
  25 char *f__fmtbuf;
  26 int f__fmtlen;
  27 flag f__external;               /*1 if external io, 0 if internal */
  28 int (*f__getn) (void);          /* for formatted input */
  29 void (*f__putn) (int);          /* for formatted output */
  30 int (*f__doed) (struct syl *, char *, ftnlen), (*f__doned) (struct syl *);
  31 int (*f__dorevert) (void), (*f__donewrec) (void), (*f__doend) (void);
  32 flag f__sequential;             /*1 if sequential io, 0 if direct */
  33 flag f__formatted;              /*1 if formatted io, 0 if unformatted */
  34 FILE *f__cf;                    /*current file */
  35 unit *f__curunit;               /*current unit */
  36 int f__recpos;                  /*place in current record */
  37 int f__cursor, f__hiwater, f__scale;
  38 char *f__icptr;
  39
  40 /*error messages*/
  41 char *F_err[] = {
  42   "error in format",            /* 100 */
  43   "illegal unit number",        /* 101 */
  44   "formatted io not allowed",   /* 102 */
  45   "unformatted io not allowed", /* 103 */
  46   "direct io not allowed",      /* 104 */
  47   "sequential io not allowed",  /* 105 */
  48   "can't backspace file",       /* 106 */
  49   "null file name",             /* 107 */
  50   "can't stat file",            /* 108 */
  51   "unit not connected",         /* 109 */
  52   "off end of record",          /* 110 */
  53   "truncation failed in endfile",       /* 111 */
  54   "incomprehensible list input",        /* 112 */
  55   "out of free space",          /* 113 */
  56   "unit not connected",         /* 114 */
  57   "read unexpected character",  /* 115 */
  58   "bad logical input field",    /* 116 */
  59   "bad variable type",          /* 117 */
  60   "bad namelist name",          /* 118 */
  61   "variable not in namelist",   /* 119 */
  62   "no end record",              /* 120 */
  63   "variable count incorrect",   /* 121 */
  64   "subscript for scalar variable",      /* 122 */
  65   "invalid array section",      /* 123 */
  66   "substring out of bounds",    /* 124 */
  67   "subscript out of bounds",    /* 125 */
  68   "can't read file",            /* 126 */
  69   "can't write file",           /* 127 */
  70   "'new' file exists",          /* 128 */
  71   "can't append to file",       /* 129 */
  72   "non-positive record number", /* 130 */
  73   "I/O started while already doing I/O",        /* 131 */
  74   "Temporary file name (TMPDIR?) too long"      /* 132 */
  75 };
  76 #define MAXERR (sizeof(F_err)/sizeof(char *)+100)
  77
  78 int
  79 f__canseek (FILE * f) /*SYSDEP*/
  80 {
  81 #ifdef NON_UNIX_STDIO
  82   return !isatty (fileno (f));
  83 #else
  84   struct stat x;
  85
  86   if (fstat (fileno (f), &x) < 0)
  87     return (0);
  88 #ifdef S_IFMT
  89   switch (x.st_mode & S_IFMT)
  90     {
  91     case S_IFDIR:
  92     case S_IFREG:
  93       if (x.st_nlink > 0)       /* !pipe */
  94         return (1);
  95       else
  96         return (0);
  97     case S_IFCHR:
  98       if (isatty (fileno (f)))
  99         return (0);
 100       return (1);
 101 #ifdef S_IFBLK
 102     case S_IFBLK:
 103       return (1);
 104 #endif
 105     }
 106 #else
 107 #ifdef S_ISDIR
 108   /* POSIX version */
 109   if (S_ISREG (x.st_mode) || S_ISDIR (x.st_mode))
 110     {
 111       if (x.st_nlink > 0)       /* !pipe */
 112         return (1);
 113       else
 114         return (0);
 115     }
 116   if (S_ISCHR (x.st_mode))
 117     {
 118       if (isatty (fileno (f)))
 119         return (0);
 120       return (1);
 121     }
 122   if (S_ISBLK (x.st_mode))
 123     return (1);
 124 #else
 125   Help ! How does fstat work on this system ?
 126 #endif
 127 #endif
 128     return (0);                 /* who knows what it is? */
 129 #endif
 130 }
 131
 132 void
 133 f__fatal (int n, char *s)
 134 {
 135   static int dead = 0;
 136
 137   if (n < 100 && n >= 0)
 138     perror (s);
 139   /*SYSDEP*/
 140   else if (n >= (int) MAXERR || n < -1)
 141     {
 142       fprintf (stderr, "%s: illegal error number %d\n", s, n);
 143     }
 144   else if (n == -1)
 145     fprintf (stderr, "%s: end of file\n", s);
 146   else
 147     fprintf (stderr, "%s: %s\n", s, F_err[n - 100]);
 148   if (dead)
 149     {
 150       fprintf (stderr, "(libf2c f__fatal already called, aborting.)");
 151       abort ();
 152     }
 153   dead = 1;
 154   if (f__init & 1)
 155     {
 156       if (f__curunit)
 157         {
 158           fprintf (stderr, "apparent state: unit %d ",
 159                    (int) (f__curunit - f__units));
 160           fprintf (stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
 161                    f__curunit->ufnm);
 162         }
 163       else
 164         fprintf (stderr, "apparent state: internal I/O\n");
 165       if (f__fmtbuf)
 166         fprintf (stderr, "last format: %.*s\n", f__fmtlen, f__fmtbuf);
 167       fprintf (stderr, "lately %s %s %s %s",
 168                f__reading ? "reading" : "writing",
 169                f__sequential ? "sequential" : "direct",
 170                f__formatted ? "formatted" : "unformatted",
 171                f__external ? "external" : "internal");
 172     }
 173   f__init &= ~2;                /* No longer doing I/O (no more user code to be called). */
 174   sig_die (" IO", 1);
 175 }
 176
 177 /*initialization routine*/
 178 void
 179 f_init (void)
 180 {
 181   unit *p;
 182
 183   if (f__init & 2)
 184     f__fatal (131, "I/O recursion");
 185   f__init = 1;
 186   p = &f__units[0];
 187   p->ufd = stderr;
 188   p->useek = f__canseek (stderr);
 189   p->ufmt = 1;
 190   p->uwrt = 1;
 191   p = &f__units[5];
 192   p->ufd = stdin;
 193   p->useek = f__canseek (stdin);
 194   p->ufmt = 1;
 195   p->uwrt = 0;
 196   p = &f__units[6];
 197   p->ufd = stdout;
 198   p->useek = f__canseek (stdout);
 199   p->ufmt = 1;
 200   p->uwrt = 1;
 201 }
 202
 203 int
 204 f__nowreading (unit * x)
 205 {
 206   off_t loc;
 207   int ufmt, urw;
 208   extern char *f__r_mode[], *f__w_mode[];
 209
 210   if (x->urw & 1)
 211     goto done;
 212   if (!x->ufnm)
 213     goto cantread;
 214   ufmt = x->url ? 0 : x->ufmt;
 215   loc = FTELL (x->ufd);
 216   urw = 3;
 217   if (!freopen (x->ufnm, f__w_mode[ufmt | 2], x->ufd))
 218     {
 219       urw = 1;
 220       if (!freopen (x->ufnm, f__r_mode[ufmt], x->ufd))
 221         {
 222         cantread:
 223           errno = 126;
 224           return 1;
 225         }
 226     }
 227   FSEEK (x->ufd, loc, SEEK_SET);
 228   x->urw = urw;
 229 done:
 230   x->uwrt = 0;
 231   return 0;
 232 }
 233
 234 int
 235 f__nowwriting (unit * x)
 236 {
 237   off_t loc;
 238   int ufmt;
 239   extern char *f__w_mode[];
 240
 241   if (x->urw & 2)
 242     goto done;
 243   if (!x->ufnm)
 244     goto cantwrite;
 245   ufmt = x->url ? 0 : x->ufmt;
 246   if (x->uwrt == 3)
 247     {                           /* just did write, rewind */
 248       if (!(f__cf = x->ufd = freopen (x->ufnm, f__w_mode[ufmt], x->ufd)))
 249         goto cantwrite;
 250       x->urw = 2;
 251     }
 252   else
 253     {
 254       loc = FTELL (x->ufd);
 255       if (!(f__cf = x->ufd = freopen (x->ufnm, f__w_mode[ufmt |= 2], x->ufd)))
 256         {
 257           x->ufd = NULL;
 258         cantwrite:
 259           errno = 127;
 260           return (1);
 261         }
 262       x->urw = 3;
 263       FSEEK (x->ufd, loc, SEEK_SET);
 264     }
 265 done:
 266   x->uwrt = 1;
 267   return 0;
 268 }
 269
 270 int
 271 err__fl (int f, int m, char *s)
 272 {
 273   if (!f)
 274     f__fatal (m, s);
 275   if (f__doend)
 276     (*f__doend) ();
 277   f__init &= ~2;
 278   return errno = m;
 279 }