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