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