lang/fortran/lib/libI77/close.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 integer f_clos(a) cllist *a;
   4 {       unit *b;
   5         if(a->cunit >= MXUNIT) return(0);
   6         b= &units[a->cunit];
   7         if(b->ufd==NULL)
   8                 goto done;
   9         if (!a->csta)
  10                 if (b->uscrtch == 1)
  11                         goto delete;
  12                 else
  13                         goto keep;
  14         switch(*a->csta) {
  15                 default:
  16                 keep:
  17                 case 'k':
  18                 case 'K':
  19                         if(b->uwrt == 1)
  20                                 (void) t_runc((alist *)a);
  21                         if(b->ufnm) {
  22                                 (void) fclose(b->ufd);
  23                                 free(b->ufnm);
  24                                 }
  25                         break;
  26                 case 'd':
  27                 case 'D':
  28                 delete:
  29                         if(b->ufnm) {
  30                                 (void) fclose(b->ufd);
  31                                 (void) unlink(b->ufnm); /*SYSDEP*/
  32                                 free(b->ufnm);
  33                                 }
  34                 }
  35         b->ufd=NULL;
  36  done:
  37         b->uend=0;
  38         b->ufnm=NULL;
  39         return(0);
  40         }
  41  void
  42 f_exit()
  43 {       int i;
  44         static cllist xx;
  45         if (!xx.cerr) {
  46                 xx.cerr=1;
  47                 xx.csta=NULL;
  48                 for(i=0;i<MXUNIT;i++)
  49                 {
  50                         xx.cunit=i;
  51                         (void) f_clos(&xx);
  52                 }
  53         }
  54 }
  55 flush_()
  56 {       int i;
  57         for(i=0;i<MXUNIT;i++)
  58                 if(units[i].ufd != NULL) (void) fflush(units[i].ufd);
  59 }