Go to the documentation of this file.00001 #include "f2c.h"
00002 #include "fio.h"
00003 #ifdef KR_headers
00004 integer f_clos(a) cllist *a;
00005 #else
00006 #undef abs
00007 #undef min
00008 #undef max
00009 #include "stdlib.h"
00010 #ifdef NON_UNIX_STDIO
00011 #ifndef unlink
00012 #define unlink remove
00013 #endif
00014 #else
00015 #ifdef MSDOS
00016 #include "io.h"
00017 #else
00018 #ifdef __cplusplus
00019 extern "C" int unlink(const char*);
00020 #else
00021 extern int unlink(const char*);
00022 #endif
00023 #endif
00024 #endif
00025
00026 #ifdef __cplusplus
00027 extern "C" {
00028 #endif
00029
00030 integer f_clos(cllist *a)
00031 #endif
00032 { unit *b;
00033
00034 if(a->cunit >= MXUNIT) return(0);
00035 b= &f__units[a->cunit];
00036 if(b->ufd==NULL)
00037 goto done;
00038 if (b->uscrtch == 1)
00039 goto Delete;
00040 if (!a->csta)
00041 goto Keep;
00042 switch(*a->csta) {
00043 default:
00044 Keep:
00045 case 'k':
00046 case 'K':
00047 if(b->uwrt == 1)
00048 t_runc((alist *)a);
00049 if(b->ufnm) {
00050 fclose(b->ufd);
00051 free(b->ufnm);
00052 }
00053 break;
00054 case 'd':
00055 case 'D':
00056 Delete:
00057 fclose(b->ufd);
00058 if(b->ufnm) {
00059 unlink(b->ufnm);
00060 free(b->ufnm);
00061 }
00062 }
00063 b->ufd=NULL;
00064 done:
00065 b->uend=0;
00066 b->ufnm=NULL;
00067 return(0);
00068 }
00069 void
00070 #ifdef KR_headers
00071 f_exit()
00072 #else
00073 f_exit(void)
00074 #endif
00075 { int i;
00076 static cllist xx;
00077 if (!xx.cerr) {
00078 xx.cerr=1;
00079 xx.csta=NULL;
00080 for(i=0;i<MXUNIT;i++)
00081 {
00082 xx.cunit=i;
00083 (void) f_clos(&xx);
00084 }
00085 }
00086 }
00087 int
00088 #ifdef KR_headers
00089 flush_()
00090 #else
00091 flush_(void)
00092 #endif
00093 { int i;
00094 for(i=0;i<MXUNIT;i++)
00095 if(f__units[i].ufd != NULL && f__units[i].uwrt)
00096 fflush(f__units[i].ufd);
00097 return 0;
00098 }
00099 #ifdef __cplusplus
00100 }
00101 #endif