Changeset 1391 for branches/GNU/src/gcc/libf2c/libI77/open.c
- Timestamp:
- Apr 27, 2004, 8:39:34 PM (22 years ago)
- Location:
- branches/GNU/src/gcc
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf2c/libI77/open.c (modified) (2 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
branches/GNU/src/gcc
- Property svn:ignore
-
old new 26 26 configure.vr 27 27 configure.vrs 28 28 29 Makefile 29 dir.info30 30 lost+found 31 31 update.out
-
- Property svn:ignore
-
branches/GNU/src/gcc/libf2c/libI77/open.c
-
Property cvs2svn:cvs-rev
changed from
1.1to1.1.1.2
r1390 r1391 1 /* Define _XOPEN_SOURCE to get tempnam prototype with glibc et al --2 more general than _INCLUDE_XOPEN_SOURCE used elsewhere `for HP-UX'. */3 #define _XOPEN_SOURCE 14 1 #include "config.h" 5 2 #include "f2c.h" … … 10 7 #include "io.h" 11 8 #else 12 #include "unistd.h" /* for access */ 13 #endif 14 #endif 15 16 #ifdef KR_headers 17 extern char *malloc(); 18 #ifdef NON_ANSI_STDIO 19 extern char *mktemp(); 20 #endif 21 extern integer f_clos(); 22 #else 9 #include "unistd.h" /* for access */ 10 #endif 11 #endif 12 23 13 #undef abs 24 14 #undef min 25 15 #undef max 26 16 #include <stdlib.h> 27 extern int f__canseek(FILE*); 28 extern integer f_clos(cllist*); 29 #endif 17 extern int f__canseek (FILE *); 18 extern integer f_clos (cllist *); 30 19 31 20 #ifdef NON_ANSI_RW_MODES 32 char *f__r_mode[2] = {"r", "r"}; 33 char *f__w_mode[4] = {"w", "w", "r+w", "r+w"}; 34 #else 35 char *f__r_mode[2] = {"rb", "r"}; 36 char *f__w_mode[4] = {"wb", "w", "r+b", "r+"}; 37 #endif 38 39 static char f__buf0[400], *f__buf = f__buf0; 40 int f__buflen = (int)sizeof(f__buf0); 41 42 static void 43 #ifdef KR_headers 44 f__bufadj(n, c) int n, c; 45 #else 46 f__bufadj(int n, int c) 47 #endif 48 { 49 unsigned int len; 50 char *nbuf, *s, *t, *te; 51 52 if (f__buf == f__buf0) 53 f__buflen = 1024; 54 while(f__buflen <= n) 55 f__buflen <<= 1; 56 len = (unsigned int)f__buflen; 57 if (len != f__buflen || !(nbuf = (char*)malloc(len))) 58 f__fatal(113, "malloc failure"); 59 s = nbuf; 60 t = f__buf; 61 te = t + c; 62 while(t < te) 63 *s++ = *t++; 64 if (f__buf != f__buf0) 65 free(f__buf); 66 f__buf = nbuf; 67 } 68 69 int 70 #ifdef KR_headers 71 f__putbuf(c) int c; 72 #else 73 f__putbuf(int c) 74 #endif 75 { 76 char *s, *se; 77 int n; 78 79 if (f__hiwater > f__recpos) 80 f__recpos = f__hiwater; 81 n = f__recpos + 1; 82 if (n >= f__buflen) 83 f__bufadj(n, f__recpos); 84 s = f__buf; 85 se = s + f__recpos; 86 if (c) 87 *se++ = c; 88 *se = 0; 89 for(;;) { 90 fputs(s, f__cf); 91 s += strlen(s); 92 if (s >= se) 93 break; /* normally happens the first time */ 94 putc(*s++, f__cf); 95 } 96 return 0; 97 } 98 99 void 100 #ifdef KR_headers 101 x_putc(c) 102 #else 103 x_putc(int c) 104 #endif 105 { 106 if (f__recpos >= f__buflen) 107 f__bufadj(f__recpos, f__buflen); 108 f__buf[f__recpos++] = c; 109 } 21 char *f__r_mode[2] = { "r", "r" }; 22 char *f__w_mode[4] = { "w", "w", "r+w", "r+w" }; 23 #else 24 char *f__r_mode[2] = { "rb", "r" }; 25 char *f__w_mode[4] = { "wb", "w", "r+b", "r+" }; 26 #endif 27 28 static char f__buf0[400], *f__buf = f__buf0; 29 int f__buflen = (int) sizeof (f__buf0); 30 31 static void 32 f__bufadj (int n, int c) 33 { 34 unsigned int len; 35 char *nbuf, *s, *t, *te; 36 37 if (f__buf == f__buf0) 38 f__buflen = 1024; 39 while (f__buflen <= n) 40 f__buflen <<= 1; 41 len = (unsigned int) f__buflen; 42 if (len != f__buflen || !(nbuf = (char *) malloc (len))) 43 f__fatal (113, "malloc failure"); 44 s = nbuf; 45 t = f__buf; 46 te = t + c; 47 while (t < te) 48 *s++ = *t++; 49 if (f__buf != f__buf0) 50 free (f__buf); 51 f__buf = nbuf; 52 } 53 54 int 55 f__putbuf (int c) 56 { 57 char *s, *se; 58 int n; 59 60 if (f__hiwater > f__recpos) 61 f__recpos = f__hiwater; 62 n = f__recpos + 1; 63 if (n >= f__buflen) 64 f__bufadj (n, f__recpos); 65 s = f__buf; 66 se = s + f__recpos; 67 if (c) 68 *se++ = c; 69 *se = 0; 70 for (;;) 71 { 72 fputs (s, f__cf); 73 s += strlen (s); 74 if (s >= se) 75 break; /* normally happens the first time */ 76 putc (*s++, f__cf); 77 } 78 return 0; 79 } 80 81 void 82 x_putc (int c) 83 { 84 if (f__recpos >= f__buflen) 85 f__bufadj (f__recpos, f__buflen); 86 f__buf[f__recpos++] = c; 87 } 110 88 111 89 #define opnerr(f,m,s) \ 112 90 do {if(f) {f__init &= ~2; errno= m;} else opn_err(m,s,a); return(m);} while(0) 113 91 114 static void 115 #ifdef KR_headers 116 opn_err(m, s, a) int m; char *s; olist *a; 117 #else 118 opn_err(int m, char *s, olist *a) 119 #endif 120 { 121 if (a->ofnm) { 122 /* supply file name to error message */ 123 if (a->ofnmlen >= f__buflen) 124 f__bufadj((int)a->ofnmlen, 0); 125 g_char(a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf); 126 } 127 f__fatal(m, s); 92 static void 93 opn_err (int m, char *s, olist * a) 94 { 95 if (a->ofnm) 96 { 97 /* supply file name to error message */ 98 if (a->ofnmlen >= f__buflen) 99 f__bufadj ((int) a->ofnmlen, 0); 100 g_char (a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf); 101 } 102 f__fatal (m, s); 103 } 104 105 integer 106 f_open (olist * a) 107 { 108 unit *b; 109 integer rv; 110 char buf[256], *s, *env; 111 cllist x; 112 int ufmt; 113 FILE *tf; 114 int fd, len; 115 #ifndef NON_UNIX_STDIO 116 int n; 117 #endif 118 if (f__init != 1) 119 f_init (); 120 f__external = 1; 121 if (a->ounit >= MXUNIT || a->ounit < 0) 122 err (a->oerr, 101, "open"); 123 f__curunit = b = &f__units[a->ounit]; 124 if (b->ufd) 125 { 126 if (a->ofnm == 0) 127 { 128 same:if (a->oblnk) 129 b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z'; 130 return (0); 128 131 } 129 130 #ifdef KR_headers131 integer f_open(a) olist *a;132 #else133 integer f_open(olist *a)134 #endif135 { unit *b;136 integer rv;137 char buf[256], *s, *env;138 cllist x;139 int ufmt;140 FILE *tf;141 int fd, len;142 #ifndef NON_UNIX_STDIO143 int n;144 #endif145 if(f__init != 1) f_init();146 f__external = 1;147 if(a->ounit>=MXUNIT || a->ounit<0)148 err(a->oerr,101,"open");149 f__curunit = b = &f__units[a->ounit];150 if(b->ufd) {151 if(a->ofnm==0)152 {153 same: if (a->oblnk)154 b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';155 return(0);156 }157 132 #ifdef NON_UNIX_STDIO 158 if (b->ufnm 159 && strlen(b->ufnm) == a->ofnmlen 160 && !strncmp(b->ufnm, a->ofnm, (unsigned)a->ofnmlen)) 161 goto same; 162 #else 163 g_char(a->ofnm,a->ofnmlen,buf); 164 if (f__inode(buf,&n) == b->uinode && n == b->udev) 165 goto same; 166 #endif 167 x.cunit=a->ounit; 168 x.csta=0; 169 x.cerr=a->oerr; 170 if ((rv = f_clos(&x)) != 0) 171 return rv; 172 } 173 b->url = (int)a->orl; 174 b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z'); 175 if(a->ofm==0) 176 { if(b->url>0) b->ufmt=0; 177 else b->ufmt=1; 178 } 179 else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1; 180 else b->ufmt=0; 181 ufmt = b->ufmt; 133 if (b->ufnm 134 && strlen (b->ufnm) == a->ofnmlen 135 && !strncmp (b->ufnm, a->ofnm, (unsigned) a->ofnmlen)) 136 goto same; 137 #else 138 g_char (a->ofnm, a->ofnmlen, buf); 139 if (f__inode (buf, &n) == b->uinode && n == b->udev) 140 goto same; 141 #endif 142 x.cunit = a->ounit; 143 x.csta = 0; 144 x.cerr = a->oerr; 145 if ((rv = f_clos (&x)) != 0) 146 return rv; 147 } 148 b->url = (int) a->orl; 149 b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z'); 150 if (a->ofm == 0) 151 if ((a->oacc) && (*a->oacc == 'D' || *a->oacc == 'd')) 152 b->ufmt = 0; 153 else 154 b->ufmt = 1; 155 else if (*a->ofm == 'f' || *a->ofm == 'F') 156 b->ufmt = 1; 157 else 158 b->ufmt = 0; 159 ufmt = b->ufmt; 182 160 #ifdef url_Adjust 183 if (b->url && !ufmt) 184 url_Adjust(b->url); 185 #endif 186 if (a->ofnm) { 187 g_char(a->ofnm,a->ofnmlen,buf); 188 if (!buf[0]) 189 opnerr(a->oerr,107,"open"); 190 } 191 else 192 sprintf(buf, "fort.%ld", (long)a->ounit); 193 b->uscrtch = 0; 194 b->uend=0; 195 b->uwrt = 0; 196 b->ufd = 0; 197 b->urw = 3; 198 switch(a->osta ? *a->osta : 'u') 199 { 200 case 'o': 201 case 'O': 161 if (b->url && !ufmt) 162 url_Adjust (b->url); 163 #endif 164 if (a->ofnm) 165 { 166 g_char (a->ofnm, a->ofnmlen, buf); 167 if (!buf[0]) 168 opnerr (a->oerr, 107, "open"); 169 } 170 else 171 sprintf (buf, "fort.%ld", (long) a->ounit); 172 b->uscrtch = 0; 173 b->uend = 0; 174 b->uwrt = 0; 175 b->ufd = 0; 176 b->urw = 3; 177 switch (a->osta ? *a->osta : 'u') 178 { 179 case 'o': 180 case 'O': 202 181 #ifdef NON_POSIX_STDIO 203 if (!(tf = fopen(buf,"r"))) 204 opnerr(a->oerr,errno,"open"); 205 fclose(tf); 206 #else 207 if (access(buf,0)) 208 opnerr(a->oerr,errno,"open"); 209 #endif 210 break; 211 case 's': 212 case 'S': 213 b->uscrtch=1; 214 #ifdef HAVE_MKSTEMP /* Allow use of TMPDIR preferentially. */ 215 env = getenv("TMPDIR"); 216 if (!env) env = getenv("TEMP"); 217 if (!env) env = "/tmp"; 218 len = strlen(env); 219 if (len > 256 - sizeof "/tmp.FXXXXXX") 220 err (a->oerr, 132, "open"); 221 strcpy(buf, env); 222 strcat(buf, "/tmp.FXXXXXX"); 223 fd = mkstemp(buf); 224 if (fd == -1 || close(fd)) 225 err (a->oerr, 132, "open"); 182 if (!(tf = fopen (buf, "r"))) 183 opnerr (a->oerr, errno, "open"); 184 fclose (tf); 185 #else 186 if (access (buf, 0)) 187 opnerr (a->oerr, errno, "open"); 188 #endif 189 break; 190 case 's': 191 case 'S': 192 b->uscrtch = 1; 193 #ifdef HAVE_MKSTEMP /* Allow use of TMPDIR preferentially. */ 194 env = getenv ("TMPDIR"); 195 if (!env) 196 env = getenv ("TEMP"); 197 if (!env) 198 env = "/tmp"; 199 len = strlen (env); 200 if (len > 256 - (int) sizeof ("/tmp.FXXXXXX")) 201 err (a->oerr, 132, "open"); 202 strcpy (buf, env); 203 strcat (buf, "/tmp.FXXXXXX"); 204 fd = mkstemp (buf); 205 if (fd == -1 || close (fd)) 206 err (a->oerr, 132, "open"); 226 207 #else /* ! defined (HAVE_MKSTEMP) */ 227 208 #ifdef HAVE_TEMPNAM /* Allow use of TMPDIR preferentially. */ 228 s = tempnam (0, buf);229 if (strlen (s) >= sizeof (buf))230 err (a->oerr, 132, "open");231 (void) strcpy (buf, s);232 free (s);209 s = tempnam (0, buf); 210 if (strlen (s) >= sizeof (buf)) 211 err (a->oerr, 132, "open"); 212 (void) strcpy (buf, s); 213 free (s); 233 214 #else /* ! defined (HAVE_TEMPNAM) */ 234 215 #ifdef HAVE_TMPNAM 235 tmpnam(buf);236 #else 237 (void) strcpy(buf,"tmp.FXXXXXX");238 (void) mktemp(buf);216 (buf); 217 #else 218 "tmp.FXXXXXX"); 219 (buf); 239 220 #endif 240 221 #endif /* ! defined (HAVE_TEMPNAM) */ 241 222 #endif /* ! defined (HAVE_MKSTEMP) */ 242 goto replace;243 case 'n':244 case 'N':223 goto replace; 224 case 'n': 225 case 'N': 245 226 #ifdef NON_POSIX_STDIO 246 if ((tf = fopen(buf,"r")) || (tf = fopen(buf,"a"))) { 247 fclose(tf); 248 opnerr(a->oerr,128,"open"); 249 } 250 #else 251 if (!access(buf,0)) 252 opnerr(a->oerr,128,"open"); 253 #endif 254 /* no break */ 255 case 'r': /* Fortran 90 replace option */ 256 case 'R': 257 replace: 258 if (tf = fopen(buf,f__w_mode[0])) 259 fclose(tf); 227 if ((tf = fopen (buf, "r")) || (tf = fopen (buf, "a"))) 228 { 229 fclose (tf); 230 opnerr (a->oerr, 128, "open"); 260 231 } 261 262 b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1)); 263 if(b->ufnm==NULL) opnerr(a->oerr,113,"no space"); 264 (void) strcpy(b->ufnm,buf); 265 if ((s = a->oacc) && b->url) 266 ufmt = 0; 267 if(!(tf = fopen(buf, f__w_mode[ufmt|2]))) { 268 if (tf = fopen(buf, f__r_mode[ufmt])) 269 b->urw = 1; 270 else if (tf = fopen(buf, f__w_mode[ufmt])) { 271 b->uwrt = 1; 272 b->urw = 2; 273 } 274 else 275 err(a->oerr, errno, "open"); 276 } 277 b->useek = f__canseek(b->ufd = tf); 232 #else 233 if (!access (buf, 0)) 234 opnerr (a->oerr, 128, "open"); 235 #endif 236 /* no break */ 237 case 'r': /* Fortran 90 replace option */ 238 case 'R': 239 replace: 240 if ((tf = fopen (buf, f__w_mode[0]))) 241 fclose (tf); 242 } 243 244 b->ufnm = (char *) malloc ((unsigned int) (strlen (buf) + 1)); 245 if (b->ufnm == NULL) 246 opnerr (a->oerr, 113, "no space"); 247 (void) strcpy (b->ufnm, buf); 248 if ((s = a->oacc) && b->url) 249 ufmt = 0; 250 if (!(tf = fopen (buf, f__w_mode[ufmt | 2]))) 251 { 252 if ((tf = fopen (buf, f__r_mode[ufmt]))) 253 b->urw = 1; 254 else if ((tf = fopen (buf, f__w_mode[ufmt]))) 255 { 256 b->uwrt = 1; 257 b->urw = 2; 258 } 259 else 260 err (a->oerr, errno, "open"); 261 } 262 b->useek = f__canseek (b->ufd = tf); 278 263 #ifndef NON_UNIX_STDIO 279 if((b->uinode = f__inode(buf,&b->udev)) == -1) 280 opnerr(a->oerr,108,"open"); 281 #endif 282 if(b->useek) 283 if (a->orl) 284 FSEEK(b->ufd, 0, SEEK_SET); 285 else if ((s = a->oacc) && (*s == 'a' || *s == 'A') 286 && FSEEK(b->ufd, 0, SEEK_END)) 287 opnerr(a->oerr,129,"open"); 288 return(0); 289 } 290 #ifdef KR_headers 291 fk_open(seq,fmt,n) ftnint n; 292 #else 293 fk_open(int seq, int fmt, ftnint n) 294 #endif 295 { char nbuf[10]; 296 olist a; 297 int rtn; 298 int save_init; 299 300 (void) sprintf(nbuf,"fort.%ld",(long)n); 301 a.oerr=1; 302 a.ounit=n; 303 a.ofnm=nbuf; 304 a.ofnmlen=strlen(nbuf); 305 a.osta=NULL; 306 a.oacc= seq==SEQ?"s":"d"; 307 a.ofm = fmt==FMT?"f":"u"; 308 a.orl = seq==DIR?1:0; 309 a.oblnk=NULL; 310 save_init = f__init; 311 f__init &= ~2; 312 rtn = f_open(&a); 313 f__init = save_init | 1; 314 return rtn; 315 } 264 if ((b->uinode = f__inode (buf, &b->udev)) == -1) 265 opnerr (a->oerr, 108, "open"); 266 #endif 267 if (b->useek) 268 { 269 if (a->orl) 270 FSEEK (b->ufd, 0, SEEK_SET); 271 else if ((s = a->oacc) && (*s == 'a' || *s == 'A') 272 && FSEEK (b->ufd, 0, SEEK_END)) 273 opnerr (a->oerr, 129, "open"); 274 } 275 return (0); 276 } 277 278 int 279 fk_open (int seq, int fmt, ftnint n) 280 { 281 char nbuf[10]; 282 olist a; 283 int rtn; 284 int save_init; 285 286 (void) sprintf (nbuf, "fort.%ld", (long) n); 287 a.oerr = 1; 288 a.ounit = n; 289 a.ofnm = nbuf; 290 a.ofnmlen = strlen (nbuf); 291 a.osta = NULL; 292 a.oacc = seq == SEQ ? "s" : "d"; 293 a.ofm = fmt == FMT ? "f" : "u"; 294 a.orl = seq == DIR ? 1 : 0; 295 a.oblnk = NULL; 296 save_init = f__init; 297 f__init &= ~2; 298 rtn = f_open (&a); 299 f__init = save_init | 1; 300 return rtn; 301 } -
Property cvs2svn:cvs-rev
changed from
Note:
See TracChangeset
for help on using the changeset viewer.
