00001 #include "stdlib.h"
00002 #ifndef NON_UNIX_STDIO
00003 #include "sys/types.h"
00004 #include "sys/stat.h"
00005 #endif
00006 #include "f2c.h"
00007 #include "fio.h"
00008 #include "fmt.h"        /* for struct syl */
00009 #include "rawio.h"      /* for fcntl.h, fdopen */
00010 #ifdef NON_UNIX_STDIO
00011 #ifdef KR_headers
00012 extern char *malloc();
00013 #else
00014 #undef abs
00015 #undef min
00016 #undef max
00017 #include "stdlib.h"
00018 #endif
00019 #endif
00020 
00021 /*global definitions*/
00022 unit f__units[MXUNIT];  /*unit table*/
00023 flag f__init;   /*0 on entry, 1 after initializations*/
00024 cilist *f__elist;       /*active external io list*/
00025 icilist *f__svic;       /*active internal io list*/
00026 flag f__reading;        /*1 if reading, 0 if writing*/
00027 flag f__cplus,f__cblank;
00028 char *f__fmtbuf;
00029 flag f__external;       /*1 if external io, 0 if internal */
00030 #ifdef KR_headers
00031 int (*f__doed)(),(*f__doned)();
00032 int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)();
00033 int (*f__getn)(),(*f__putn)();  /*for formatted io*/
00034 #else
00035 int (*f__getn)(void),(*f__putn)(int);   /*for formatted io*/
00036 int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
00037 int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void);
00038 #endif
00039 flag f__sequential;     /*1 if sequential io, 0 if direct*/
00040 flag f__formatted;      /*1 if formatted io, 0 if unformatted*/
00041 FILE *f__cf;    /*current file*/
00042 unit *f__curunit;       /*current unit*/
00043 int f__recpos;  /*place in current record*/
00044 int f__cursor, f__hiwater, f__scale;
00045 char *f__icptr;
00046 
00047 /*error messages*/
00048 char *F_err[] =
00049 {
00050         "error in format",                              /* 100 */
00051         "illegal unit number",                          /* 101 */
00052         "formatted io not allowed",                     /* 102 */
00053         "unformatted io not allowed",                   /* 103 */
00054         "direct io not allowed",                        /* 104 */
00055         "sequential io not allowed",                    /* 105 */
00056         "can't backspace file",                         /* 106 */
00057         "null file name",                               /* 107 */
00058         "can't stat file",                              /* 108 */
00059         "unit not connected",                           /* 109 */
00060         "off end of record",                            /* 110 */
00061         "truncation failed in endfile",                 /* 111 */
00062         "incomprehensible list input",                  /* 112 */
00063         "out of free space",                            /* 113 */
00064         "unit not connected",                           /* 114 */
00065         "read unexpected character",                    /* 115 */
00066         "bad logical input field",                      /* 116 */
00067         "bad variable type",                            /* 117 */
00068         "bad namelist name",                            /* 118 */
00069         "variable not in namelist",                     /* 119 */
00070         "no end record",                                /* 120 */
00071         "variable count incorrect",                     /* 121 */
00072         "subscript for scalar variable",                /* 122 */
00073         "invalid array section",                        /* 123 */
00074         "substring out of bounds",                      /* 124 */
00075         "subscript out of bounds",                      /* 125 */
00076         "can't read file",                              /* 126 */
00077         "can't write file",                             /* 127 */
00078         "'new' file exists",                            /* 128 */
00079         "can't append to file"                          /* 129 */
00080 };
00081 #define MAXERR (sizeof(F_err)/sizeof(char *)+100)
00082 
00083 #ifdef KR_headers
00084 f__canseek(f) FILE *f; /*SYSDEP*/
00085 #else
00086 f__canseek(FILE *f) /*SYSDEP*/
00087 #endif
00088 {
00089 #ifdef NON_UNIX_STDIO
00090         return !isatty(fileno(f));
00091 #else
00092         struct stat x;
00093 
00094         if (fstat(fileno(f),&x) < 0)
00095                 return(0);
00096 #ifdef S_IFMT
00097         switch(x.st_mode & S_IFMT) {
00098         case S_IFDIR:
00099         case S_IFREG:
00100                 if(x.st_nlink > 0)      /* !pipe */
00101                         return(1);
00102                 else
00103                         return(0);
00104         case S_IFCHR:
00105                 if(isatty(fileno(f)))
00106                         return(0);
00107                 return(1);
00108 #ifdef S_IFBLK
00109         case S_IFBLK:
00110                 return(1);
00111 #endif
00112         }
00113 #else
00114 #ifdef S_ISDIR
00115         /* POSIX version */
00116         if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) {
00117                 if(x.st_nlink > 0)      /* !pipe */
00118                         return(1);
00119                 else
00120                         return(0);
00121                 }
00122         if (S_ISCHR(x.st_mode)) {
00123                 if(isatty(fileno(f)))
00124                         return(0);
00125                 return(1);
00126                 }
00127         if (S_ISBLK(x.st_mode))
00128                 return(1);
00129 #else
00130         Help! How does fstat work on this system?
00131 #endif
00132 #endif
00133         return(0);      /* who knows what it is? */
00134 #endif
00135 }
00136 
00137  void
00138 #ifdef KR_headers
00139 f__fatal(n,s) char *s;
00140 #else
00141 f__fatal(int n, char *s)
00142 #endif
00143 {
00144         if(n<100 && n>=0) perror(s); /*SYSDEP*/
00145         else if(n >= (int)MAXERR || n < -1)
00146         {       fprintf(stderr,"%s: illegal error number %d\n",s,n);
00147         }
00148         else if(n == -1) fprintf(stderr,"%s: end of file\n",s);
00149         else
00150                 fprintf(stderr,"%s: %s\n",s,F_err[n-100]);
00151         if (f__curunit) {
00152                 fprintf(stderr,"apparent state: unit %d ",f__curunit-f__units);
00153                 fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
00154                         f__curunit->ufnm);
00155                 }
00156         else
00157                 fprintf(stderr,"apparent state: internal I/O\n");
00158         if (f__fmtbuf)
00159                 fprintf(stderr,"last format: %s\n",f__fmtbuf);
00160         fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing",
00161                 f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted",
00162                 f__external?"external":"internal");
00163         sig_die(" IO", 1);
00164 }
00165 /*initialization routine*/
00166  VOID
00167 f_init(Void)
00168 {       unit *p;
00169 
00170         f__init=1;
00171         p= &f__units[0];
00172         p->ufd=stderr;
00173         p->useek=f__canseek(stderr);
00174 #ifdef NON_UNIX_STDIO
00175         setbuf(stderr, (char *)malloc(BUFSIZ));
00176 #else
00177         stderr->_flag &= ~_IONBF;
00178 #endif
00179         p->ufmt=1;
00180         p->uwrt=1;
00181         p = &f__units[5];
00182         p->ufd=stdin;
00183         p->useek=f__canseek(stdin);
00184         p->ufmt=1;
00185         p->uwrt=0;
00186         p= &f__units[6];
00187         p->ufd=stdout;
00188         p->useek=f__canseek(stdout);
00189         p->ufmt=1;
00190         p->uwrt=1;
00191 }
00192 #ifdef KR_headers
00193 f__nowreading(x) unit *x;
00194 #else
00195 f__nowreading(unit *x)
00196 #endif
00197 {
00198         long loc;
00199         int ufmt;
00200         extern char *f__r_mode[];
00201 
00202         if (!x->ufnm)
00203                 goto cantread;
00204         ufmt = x->ufmt;
00205         loc=ftell(x->ufd);
00206         if(freopen(x->ufnm,f__r_mode[ufmt],x->ufd) == NULL) {
00207  cantread:
00208                 errno = 126;
00209                 return(1);
00210                 }
00211         x->uwrt=0;
00212         (void) fseek(x->ufd,loc,SEEK_SET);
00213         return(0);
00214 }
00215 #ifdef KR_headers
00216 f__nowwriting(x) unit *x;
00217 #else
00218 f__nowwriting(unit *x)
00219 #endif
00220 {
00221         long loc;
00222         int ufmt;
00223         extern char *f__w_mode[];
00224 #ifndef NON_UNIX_STDIO
00225         int k;
00226 #endif
00227 
00228         if (!x->ufnm)
00229                 goto cantwrite;
00230         ufmt = x->ufmt;
00231 #ifdef NON_UNIX_STDIO
00232         ufmt |= 2;
00233 #endif
00234         if (x->uwrt == 3) { /* just did write, rewind */
00235 #ifdef NON_UNIX_STDIO
00236                 if (!(f__cf = x->ufd =
00237                                 freopen(x->ufnm,f__w_mode[ufmt],x->ufd)))
00238 #else
00239                 if (close(creat(x->ufnm,0666)))
00240 #endif
00241                         goto cantwrite;
00242                 }
00243         else {
00244                 loc=ftell(x->ufd);
00245 #ifdef NON_UNIX_STDIO
00246                 if (!(f__cf = x->ufd =
00247                         freopen(x->ufnm, f__w_mode[ufmt], x->ufd)))
00248 #else
00249                 if (fclose(x->ufd) < 0
00250                 || (k = x->uwrt == 2 ? creat(x->ufnm,0666)
00251                                      : open(x->ufnm,O_WRONLY)) < 0
00252                 || (f__cf = x->ufd = fdopen(k,f__w_mode[ufmt])) == NULL)
00253 #endif
00254                         {
00255                         x->ufd = NULL;
00256  cantwrite:
00257                         errno = 127;
00258                         return(1);
00259                         }
00260                 (void) fseek(x->ufd,loc,SEEK_SET);
00261                 }
00262         x->uwrt = 1;
00263         return(0);
00264 }
00265 
00266  int
00267 #ifdef KR_headers
00268 err__fl(f, m, s) int f, m; char *s;
00269 #else
00270 err__fl(int f, int m, char *s)
00271 #endif
00272 {
00273         if (!f)
00274                 f__fatal(m, s);
00275         if (f__doend)
00276                 (*f__doend)();
00277         return errno = m;
00278         }