1 #include "stdlib.h"
2 #include "f2c.h"
3 #include "fio.h"
4 #ifndef NON_UNIX_STDIO
5 #include "sys/types.h"
6 #endif
7 #include "rawio.h"
8
9 #ifdef KR_headers
10 extern char *strcpy();
11 #else
12 #undef abs
13 #undef min
14 #undef max
15 #include "stdlib.h"
16 #include "string.h"
17 #endif
18
19 #ifdef NON_UNIX_STDIO
20 #ifndef unlink
21 #define unlink remove
22 #endif
23 #else
24 #ifdef MSDOS
25 #include "io.h"
26 #endif
27 #endif
28
29 #ifdef NON_UNIX_STDIO
30 extern char *f__r_mode[], *f__w_mode[];
31 #endif
32
33 #ifdef KR_headers
f_end(a)34 integer f_end(a) alist *a;
35 #else
36 integer f_end(alist *a)
37 #endif
38 {
39 unit *b;
40 if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile");
41 b = &f__units[a->aunit];
42 if(b->ufd==NULL) {
43 char nbuf[10];
44 (void) sprintf(nbuf,"fort.%ld",a->aunit);
45 #ifdef NON_UNIX_STDIO
46 { FILE *tf;
47 if (tf = fopen(nbuf, f__w_mode[0]))
48 fclose(tf);
49 }
50 #else
51 close(creat(nbuf, 0666));
52 #endif
53 return(0);
54 }
55 b->uend=1;
56 return(b->useek ? t_runc(a) : 0);
57 }
58
59 static int
60 #ifdef NON_UNIX_STDIO
61 #ifdef KR_headers
copy(from,len,to)62 copy(from, len, to) char *from, *to; register long len;
63 #else
64 copy(FILE *from, register long len, FILE *to)
65 #endif
66 {
67 int k, len1;
68 char buf[BUFSIZ];
69
70 while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) {
71 if (!fwrite(buf, len1, 1, to))
72 return 1;
73 if ((len -= len1) <= 0)
74 break;
75 }
76 return 0;
77 }
78 #else
79 #ifdef KR_headers
80 copy(from, len, to) char *from, *to; register long len;
81 #else
82 copy(char *from, register long len, char *to)
83 #endif
84 {
85 register int n;
86 int k, rc = 0, tmp;
87 char buf[BUFSIZ];
88
89 if ((k = open(from, O_RDONLY)) < 0)
90 return 1;
91 if ((tmp = creat(to,0666)) < 0)
92 return 1;
93 while((n = read(k, buf, len > BUFSIZ ? BUFSIZ : (int)len)) > 0) {
94 if (write(tmp, buf, n) != n)
95 { rc = 1; break; }
96 if ((len -= n) <= 0)
97 break;
98 }
99 close(k);
100 close(tmp);
101 return n < 0 ? 1 : rc;
102 }
103 #endif
104
105 #ifndef L_tmpnam
106 #define L_tmpnam 16
107 #endif
108
109 int
110 #ifdef KR_headers
t_runc(a)111 t_runc(a) alist *a;
112 #else
113 t_runc(alist *a)
114 #endif
115 {
116 char nm[L_tmpnam+12]; /* extra space in case L_tmpnam is tiny */
117 long loc, len;
118 unit *b;
119 #ifdef NON_UNIX_STDIO
120 FILE *bf, *tf;
121 #else
122 FILE *bf;
123 #endif
124 int rc = 0;
125
126 b = &f__units[a->aunit];
127 if(b->url)
128 return(0); /*don't truncate direct files*/
129 loc=ftell(bf = b->ufd);
130 fseek(bf,0L,SEEK_END);
131 len=ftell(bf);
132 if (loc >= len || b->useek == 0 || b->ufnm == NULL)
133 return(0);
134 #ifdef NON_UNIX_STDIO
135 fclose(b->ufd);
136 #else
137 rewind(b->ufd); /* empty buffer */
138 #endif
139 if (!loc) {
140 #ifdef NON_UNIX_STDIO
141 if (!(bf = fopen(b->ufnm, f__w_mode[b->ufmt])))
142 #else
143 if (close(creat(b->ufnm,0666)))
144 #endif
145 rc = 1;
146 if (b->uwrt)
147 b->uwrt = 1;
148 goto done;
149 }
150 #ifdef _POSIX_SOURCE
151 tmpnam(nm);
152 #else
153 strcpy(nm,"tmp.FXXXXXX");
154 mktemp(nm);
155 #endif
156 #ifdef NON_UNIX_STDIO
157 if (!(bf = fopen(b->ufnm, f__r_mode[0]))) {
158 bad:
159 rc = 1;
160 goto done;
161 }
162 if (!(tf = fopen(nm, f__w_mode[0])))
163 goto bad;
164 if (copy(bf, loc, tf)) {
165 bad1:
166 rc = 1;
167 goto done1;
168 }
169 if (!(bf = freopen(b->ufnm, f__w_mode[0], bf)))
170 goto bad1;
171 if (!(tf = freopen(nm, f__r_mode[0], tf)))
172 goto bad1;
173 if (copy(tf, loc, bf))
174 goto bad1;
175 if (f__w_mode[0] != f__w_mode[b->ufmt]) {
176 if (!(bf = freopen(b->ufnm, f__w_mode[b->ufmt|2], bf)))
177 goto bad1;
178 fseek(bf, loc, SEEK_SET);
179 }
180 done1:
181 fclose(tf);
182 unlink(nm);
183 done:
184 f__cf = b->ufd = bf;
185 #else
186 if (copy(b->ufnm, loc, nm)
187 || copy(nm, loc, b->ufnm))
188 rc = 1;
189 unlink(nm);
190 fseek(b->ufd, loc, SEEK_SET);
191 done:
192 #endif
193 if (rc)
194 err(a->aerr,111,"endfile");
195 return 0;
196 }
197