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