libf2c/libI77/close.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 #ifdef KR_headers
   4 integer f_clos(a) cllist *a;
   5 #else
   6 #undef abs
   7 #undef min
   8 #undef max
   9 #include <stdlib.h>
  10 #ifdef NON_UNIX_STDIO
  11 #ifndef unlink
  12 #define unlink remove
  13 #endif
  14 #else
  15 #if defined (MSDOS) && !defined (GO32)
  16 #include "io.h"
  17 #else
  18 #ifdef __cplusplus
  19 extern "C" int unlink(const char*);
  20 #else
  21 extern int unlink(const char*);
  22 #endif
  23 #endif
  24 #endif
  25
  26 integer f_clos(cllist *a)
  27 #endif
  28 {       unit *b;
  29
  30         if (f__init & 2)
  31                 f__fatal (131, "I/O recursion");
  32         if(a->cunit >= MXUNIT) return(0);
  33         b= &f__units[a->cunit];
  34         if(b->ufd==NULL)
  35                 goto done;
  36         if (b->uscrtch == 1)
  37                 goto Delete;
  38         if (!a->csta)
  39                 goto Keep;
  40         switch(*a->csta) {
  41                 default:
  42                 Keep:
  43                 case 'k':
  44                 case 'K':
  45                         if(b->uwrt == 1)
  46                                 t_runc((alist *)a);
  47                         if(b->ufnm) {
  48                                 fclose(b->ufd);
  49                                 free(b->ufnm);
  50                                 }
  51                         break;
  52                 case 'd':
  53                 case 'D':
  54                 Delete:
  55                         fclose(b->ufd);
  56                         if(b->ufnm) {
  57                                 unlink(b->ufnm); /*SYSDEP*/
  58                                 free(b->ufnm);
  59                                 }
  60                 }
  61         b->ufd=NULL;
  62  done:
  63         b->uend=0;
  64         b->ufnm=NULL;
  65         return(0);
  66         }
  67  void
  68 #ifdef KR_headers
  69 f_exit()
  70 #else
  71 f_exit(void)
  72 #endif
  73 {       int i;
  74         static cllist xx;
  75         if (! (f__init & 1))
  76                 return;         /* Not initialized, so no open units. */
  77         /* I/O no longer in progress.  If, during an I/O operation (such
  78            as waiting for the user to enter a line), there is an
  79            interrupt (such as ^C to stop the program on a UNIX system),
  80            f_exit() is called, but there is no longer any I/O in
  81            progress.  Without turning off this flag, f_clos() would
  82            think that there is an I/O recursion in this circumstance. */
  83         f__init &= ~2;
  84         if (!xx.cerr) {
  85                 xx.cerr=1;
  86                 xx.csta=NULL;
  87                 for(i=0;i<MXUNIT;i++)
  88                 {
  89                         xx.cunit=i;
  90                         (void) f_clos(&xx);
  91                 }
  92         }
  93 }
  94  int
  95 #ifdef KR_headers
  96 G77_flush_0 ()
  97 #else
  98 G77_flush_0 (void)
  99 #endif
 100 {       int i;
 101         for(i=0;i<MXUNIT;i++)
 102                 if(f__units[i].ufd != NULL && f__units[i].uwrt)
 103                         fflush(f__units[i].ufd);
 104 return 0;
 105 }