contrib/libf2c/libI77/err.c

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