00001 #include "f2c.h"
00002 #include "fio.h"
00003
00004
00005
00006
00007 #ifdef MSDOS
00008 #undef NO_TRUNCATE
00009 #define NO_TRUNCATE
00010 #endif
00011
00012 #ifndef NO_TRUNCATE
00013 #include "unistd.h"
00014 #endif
00015
00016 #ifdef KR_headers
00017 extern char *strcpy();
00018 extern FILE *tmpfile();
00019 #else
00020 #undef abs
00021 #undef min
00022 #undef max
00023 #include "stdlib.h"
00024 #include "string.h"
00025 #ifdef __cplusplus
00026 extern "C" {
00027 #endif
00028 #endif
00029
00030 extern char *f__r_mode[], *f__w_mode[];
00031
00032 #ifdef KR_headers
00033 integer f_end(a) alist *a;
00034 #else
00035 integer f_end(alist *a)
00036 #endif
00037 {
00038 unit *b;
00039 FILE *tf;
00040
00041 if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile");
00042 b = &f__units[a->aunit];
00043 if(b->ufd==NULL) {
00044 char nbuf[10];
00045 sprintf(nbuf,"fort.%ld",(long)a->aunit);
00046 if (tf = FOPEN(nbuf, f__w_mode[0]))
00047 fclose(tf);
00048 return(0);
00049 }
00050 b->uend=1;
00051 return(b->useek ? t_runc(a) : 0);
00052 }
00053
00054 #ifdef NO_TRUNCATE
00055 static int
00056 #ifdef KR_headers
00057 copy(from, len, to) FILE *from, *to; register long len;
00058 #else
00059 copy(FILE *from, register long len, FILE *to)
00060 #endif
00061 {
00062 int len1;
00063 char buf[BUFSIZ];
00064
00065 while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) {
00066 if (!fwrite(buf, len1, 1, to))
00067 return 1;
00068 if ((len -= len1) <= 0)
00069 break;
00070 }
00071 return 0;
00072 }
00073 #endif
00074
00075 int
00076 #ifdef KR_headers
00077 t_runc(a) alist *a;
00078 #else
00079 t_runc(alist *a)
00080 #endif
00081 {
00082 OFF_T loc, len;
00083 unit *b;
00084 int rc;
00085 FILE *bf;
00086 #ifdef NO_TRUNCATE
00087 FILE *tf;
00088 #endif
00089
00090 b = &f__units[a->aunit];
00091 if(b->url)
00092 return(0);
00093 loc=FTELL(bf = b->ufd);
00094 FSEEK(bf,(OFF_T)0,SEEK_END);
00095 len=FTELL(bf);
00096 if (loc >= len || b->useek == 0)
00097 return(0);
00098 #ifdef NO_TRUNCATE
00099 if (b->ufnm == NULL)
00100 return 0;
00101 rc = 0;
00102 fclose(b->ufd);
00103 if (!loc) {
00104 if (!(bf = FOPEN(b->ufnm, f__w_mode[b->ufmt])))
00105 rc = 1;
00106 if (b->uwrt)
00107 b->uwrt = 1;
00108 goto done;
00109 }
00110 if (!(bf = FOPEN(b->ufnm, f__r_mode[0]))
00111 || !(tf = tmpfile())) {
00112 #ifdef NON_UNIX_STDIO
00113 bad:
00114 #endif
00115 rc = 1;
00116 goto done;
00117 }
00118 if (copy(bf, (long)loc, tf)) {
00119 bad1:
00120 rc = 1;
00121 goto done1;
00122 }
00123 if (!(bf = FREOPEN(b->ufnm, f__w_mode[0], bf)))
00124 goto bad1;
00125 rewind(tf);
00126 if (copy(tf, (long)loc, bf))
00127 goto bad1;
00128 b->uwrt = 1;
00129 b->urw = 2;
00130 #ifdef NON_UNIX_STDIO
00131 if (b->ufmt) {
00132 fclose(bf);
00133 if (!(bf = FOPEN(b->ufnm, f__w_mode[3])))
00134 goto bad;
00135 FSEEK(bf,(OFF_T)0,SEEK_END);
00136 b->urw = 3;
00137 }
00138 #endif
00139 done1:
00140 fclose(tf);
00141 done:
00142 f__cf = b->ufd = bf;
00143 #else
00144 if (b->urw & 2)
00145 fflush(b->ufd);
00146 #ifndef FTRUNCATE
00147 #define FTRUNCATE ftruncate
00148 #endif
00149 rc = FTRUNCATE(fileno(b->ufd), loc);
00150
00151
00152 FSEEK(b->ufd, (OFF_T)0, SEEK_END);
00153 #endif
00154 if (rc)
00155 err(a->aerr,111,"endfile");
00156 return 0;
00157 }
00158 #ifdef __cplusplus
00159 }
00160 #endif