1 #include "f2c.h"
2 #include "fio.h"
3
4 #ifdef KR_headers
5 extern char *strcpy();
6 extern FILE *tmpfile();
7 #else
8 #undef abs
9 #undef min
10 #undef max
11 #include "stdlib.h"
12 #include "string.h"
13 #endif
14
15 extern char *f__r_mode[], *f__w_mode[];
16
17 #ifdef KR_headers
f_end(a)18 integer f_end(a) alist *a;
19 #else
20 integer f_end(alist *a)
21 #endif
22 {
23 unit *b;
24 FILE *tf;
25
26 if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile");
27 b = &f__units[a->aunit];
28 if(b->ufd==NULL) {
29 char nbuf[10];
30 sprintf(nbuf,"fort.%ld",a->aunit);
31 if ((tf = fopen(nbuf, f__w_mode[0])))
32 fclose(tf);
33 return(0);
34 }
35 b->uend=1;
36 return(b->useek ? t_runc(a) : 0);
37 }
38
39 static int
40 #ifdef KR_headers
copy(from,len,to)41 copy(from, len, to) FILE *from, *to; register long len;
42 #else
43 copy(FILE *from, register long len, FILE *to)
44 #endif
45 {
46 int len1;
47 char buf[BUFSIZ];
48
49 while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) {
50 if (!fwrite(buf, len1, 1, to))
51 return 1;
52 if ((len -= len1) <= 0)
53 break;
54 }
55 return 0;
56 }
57
58 int
59 #ifdef KR_headers
t_runc(a)60 t_runc(a) alist *a;
61 #else
62 t_runc(alist *a)
63 #endif
64 {
65 long loc, len;
66 unit *b;
67 FILE *bf, *tf;
68 int rc = 0;
69
70 b = &f__units[a->aunit];
71 if(b->url)
72 return(0); /*don't truncate direct files*/
73 loc=ftell(bf = b->ufd);
74 fseek(bf,0L,SEEK_END);
75 len=ftell(bf);
76 if (loc >= len || b->useek == 0 || b->ufnm == NULL)
77 return(0);
78 fclose(b->ufd);
79 if (!loc) {
80 if (!(bf = fopen(b->ufnm, f__w_mode[b->ufmt])))
81 rc = 1;
82 if (b->uwrt)
83 b->uwrt = 1;
84 goto done;
85 }
86 if (!(bf = fopen(b->ufnm, f__r_mode[0]))
87 || !(tf = tmpfile())) {
88 #ifdef NON_UNIX_STDIO
89 bad:
90 #endif
91 rc = 1;
92 goto done;
93 }
94 if (copy(bf, loc, tf)) {
95 bad1:
96 rc = 1;
97 goto done1;
98 }
99 if (!(bf = freopen(b->ufnm, f__w_mode[0], bf)))
100 goto bad1;
101 rewind(tf);
102 if (copy(tf, loc, bf))
103 goto bad1;
104 b->urw = 2;
105 #ifdef NON_UNIX_STDIO
106 if (b->ufmt) {
107 fclose(bf);
108 if (!(bf = fopen(b->ufnm, f__w_mode[3])))
109 goto bad;
110 fseek(bf,0L,SEEK_END);
111 b->urw = 3;
112 }
113 #endif
114 done1:
115 fclose(tf);
116 done:
117 f__cf = b->ufd = bf;
118 if (rc)
119 err(a->aerr,111,"endfile");
120 return 0;
121 }
122