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