libf2c/libI77/open.c

   1 #include "config.h"
   2 #include "f2c.h"
   3 #include "fio.h"
   4 #include <string.h>
   5 #ifndef NON_POSIX_STDIO
   6 #ifdef MSDOS
   7 #include "io.h"
   8 #else
   9 #include "unistd.h"             /* for access */
  10 #endif
  11 #endif
  12
  13 #undef abs
  14 #undef min
  15 #undef max
  16 #include <stdlib.h>
  17 extern int f__canseek (FILE *);
  18 extern integer f_clos (cllist *);
  19
  20 #ifdef NON_ANSI_RW_MODES
  21 char *f__r_mode[2] = { "r", "r" };
  22 char *f__w_mode[4] = { "w", "w", "r+w", "r+w" };
  23 #else
  24 char *f__r_mode[2] = { "rb", "r" };
  25 char *f__w_mode[4] = { "wb", "w", "r+b", "r+" };
  26 #endif
  27
  28 static char f__buf0[400], *f__buf = f__buf0;
  29 int f__buflen = (int) sizeof (f__buf0);
  30
  31 static void
  32 f__bufadj (int n, int c)
  33 {
  34   unsigned int len;
  35   char *nbuf, *s, *t, *te;
  36
  37   if (f__buf == f__buf0)
  38     f__buflen = 1024;
  39   while (f__buflen <= n)
  40     f__buflen <<= 1;
  41   len = (unsigned int) f__buflen;
  42   if (len != f__buflen || !(nbuf = (char *) malloc (len)))
  43     f__fatal (113, "malloc failure");
  44   s = nbuf;
  45   t = f__buf;
  46   te = t + c;
  47   while (t < te)
  48     *s++ = *t++;
  49   if (f__buf != f__buf0)
  50     free (f__buf);
  51   f__buf = nbuf;
  52 }
  53
  54 int
  55 f__putbuf (int c)
  56 {
  57   char *s, *se;
  58   int n;
  59
  60   if (f__hiwater > f__recpos)
  61     f__recpos = f__hiwater;
  62   n = f__recpos + 1;
  63   if (n >= f__buflen)
  64     f__bufadj (n, f__recpos);
  65   s = f__buf;
  66   se = s + f__recpos;
  67   if (c)
  68     *se++ = c;
  69   *se = 0;
  70   for (;;)
  71     {
  72       fputs (s, f__cf);
  73       s += strlen (s);
  74       if (s >= se)
  75         break;                  /* normally happens the first time */
  76       putc (*s++, f__cf);
  77     }
  78   return 0;
  79 }
  80
  81 void
  82 x_putc (int c)
  83 {
  84   if (f__recpos >= f__buflen)
  85     f__bufadj (f__recpos, f__buflen);
  86   f__buf[f__recpos++] = c;
  87 }
  88
  89 #define opnerr(f,m,s) \
  90   do {if(f) {f__init &= ~2; errno= m;} else opn_err(m,s,a); return(m);} while(0)
  91
  92 static void
  93 opn_err (int m, char *s, olist * a)
  94 {
  95   if (a->ofnm)
  96     {
  97       /* supply file name to error message */
  98       if (a->ofnmlen >= f__buflen)
  99         f__bufadj ((int) a->ofnmlen, 0);
 100       g_char (a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf);
 101     }
 102   f__fatal (m, s);
 103 }
 104
 105 integer
 106 f_open (olist * a)
 107 {
 108   unit *b;
 109   integer rv;
 110   char buf[256], *s, *env;
 111   cllist x;
 112   int ufmt;
 113   FILE *tf;
 114   int fd, len;
 115 #ifndef NON_UNIX_STDIO
 116   int n;
 117 #endif
 118   if (f__init != 1)
 119     f_init ();
 120   f__external = 1;
 121   if (a->ounit >= MXUNIT || a->ounit < 0)
 122     err (a->oerr, 101, "open");
 123   f__curunit = b = &f__units[a->ounit];
 124   if (b->ufd)
 125     {
 126       if (a->ofnm == 0)
 127         {
 128         same:if (a->oblnk)
 129             b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
 130           return (0);
 131         }
 132 #ifdef NON_UNIX_STDIO
 133       if (b->ufnm
 134           && strlen (b->ufnm) == a->ofnmlen
 135           && !strncmp (b->ufnm, a->ofnm, (unsigned) a->ofnmlen))
 136         goto same;
 137 #else
 138       g_char (a->ofnm, a->ofnmlen, buf);
 139       if (f__inode (buf, &n) == b->uinode && n == b->udev)
 140         goto same;
 141 #endif
 142       x.cunit = a->ounit;
 143       x.csta = 0;
 144       x.cerr = a->oerr;
 145       if ((rv = f_clos (&x)) != 0)
 146         return rv;
 147     }
 148   b->url = (int) a->orl;
 149   b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
 150   if (a->ofm == 0)
 151     b->ufmt = 1;
 152   else if (*a->ofm == 'f' || *a->ofm == 'F')
 153     b->ufmt = 1;
 154   else
 155     b->ufmt = 0;
 156   ufmt = b->ufmt;
 157 #ifdef url_Adjust
 158   if (b->url && !ufmt)
 159     url_Adjust (b->url);
 160 #endif
 161   if (a->ofnm)
 162     {
 163       g_char (a->ofnm, a->ofnmlen, buf);
 164       if (!buf[0])
 165         opnerr (a->oerr, 107, "open");
 166     }
 167   else
 168     sprintf (buf, "fort.%ld", (long) a->ounit);
 169   b->uscrtch = 0;
 170   b->uend = 0;
 171   b->uwrt = 0;
 172   b->ufd = 0;
 173   b->urw = 3;
 174   switch (a->osta ? *a->osta : 'u')
 175     {
 176     case 'o':
 177     case 'O':
 178 #ifdef NON_POSIX_STDIO
 179       if (!(tf = fopen (buf, "r")))
 180         opnerr (a->oerr, errno, "open");
 181       fclose (tf);
 182 #else
 183       if (access (buf, 0))
 184         opnerr (a->oerr, errno, "open");
 185 #endif
 186       break;
 187     case 's':
 188     case 'S':
 189       b->uscrtch = 1;
 190 #ifdef HAVE_MKSTEMP             /* Allow use of TMPDIR preferentially. */
 191       env = getenv ("TMPDIR");
 192       if (!env)
 193         env = getenv ("TEMP");
 194       if (!env)
 195         env = "/tmp";
 196       len = strlen (env);
 197       if (len > 256 - (int) sizeof ("/tmp.FXXXXXX"))
 198         err (a->oerr, 132, "open");
 199       strcpy (buf, env);
 200       strcat (buf, "/tmp.FXXXXXX");
 201       fd = mkstemp (buf);
 202       if (fd == -1 || close (fd))
 203         err (a->oerr, 132, "open");
 204 #else /* ! defined (HAVE_MKSTEMP) */
 205 #ifdef HAVE_TEMPNAM             /* Allow use of TMPDIR preferentially. */
 206       s = tempnam (0, buf);
 207       if (strlen (s) >= sizeof (buf))
 208         err (a->oerr, 132, "open");
 209       (void) strcpy (buf, s);
 210       free (s);
 211 #else /* ! defined (HAVE_TEMPNAM) */
 212 #ifdef HAVE_TMPNAM
 213       tmpnam (buf);
 214 #else
 215       (void) strcpy (buf, "tmp.FXXXXXX");
 216       (void) mktemp (buf);
 217 #endif
 218 #endif /* ! defined (HAVE_TEMPNAM) */
 219 #endif /* ! defined (HAVE_MKSTEMP) */
 220       goto replace;
 221     case 'n':
 222     case 'N':
 223 #ifdef NON_POSIX_STDIO
 224       if ((tf = fopen (buf, "r")) || (tf = fopen (buf, "a")))
 225         {
 226           fclose (tf);
 227           opnerr (a->oerr, 128, "open");
 228         }
 229 #else
 230       if (!access (buf, 0))
 231         opnerr (a->oerr, 128, "open");
 232 #endif
 233       /* no break */
 234     case 'r':                   /* Fortran 90 replace option */
 235     case 'R':
 236     replace:
 237       if ((tf = fopen (buf, f__w_mode[0])))
 238         fclose (tf);
 239     }
 240
 241   b->ufnm = (char *) malloc ((unsigned int) (strlen (buf) + 1));
 242   if (b->ufnm == NULL)
 243     opnerr (a->oerr, 113, "no space");
 244   (void) strcpy (b->ufnm, buf);
 245   if ((s = a->oacc) && b->url)
 246     ufmt = 0;
 247   if (!(tf = fopen (buf, f__w_mode[ufmt | 2])))
 248     {
 249       if ((tf = fopen (buf, f__r_mode[ufmt])))
 250         b->urw = 1;
 251       else if ((tf = fopen (buf, f__w_mode[ufmt])))
 252         {
 253           b->uwrt = 1;
 254           b->urw = 2;
 255         }
 256       else
 257         err (a->oerr, errno, "open");
 258     }
 259   b->useek = f__canseek (b->ufd = tf);
 260 #ifndef NON_UNIX_STDIO
 261   if ((b->uinode = f__inode (buf, &b->udev)) == -1)
 262     opnerr (a->oerr, 108, "open");
 263 #endif
 264   if (b->useek)
 265     {
 266       if (a->orl)
 267         FSEEK (b->ufd, 0, SEEK_SET);
 268       else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
 269                && FSEEK (b->ufd, 0, SEEK_END))
 270         opnerr (a->oerr, 129, "open");
 271     }
 272   return (0);
 273 }
 274
 275 int
 276 fk_open (int seq, int fmt, ftnint n)
 277 {
 278   char nbuf[10];
 279   olist a;
 280   int rtn;
 281   int save_init;
 282
 283   (void) sprintf (nbuf, "fort.%ld", (long) n);
 284   a.oerr = 1;
 285   a.ounit = n;
 286   a.ofnm = nbuf;
 287   a.ofnmlen = strlen (nbuf);
 288   a.osta = NULL;
 289   a.oacc = seq == SEQ ? "s" : "d";
 290   a.ofm = fmt == FMT ? "f" : "u";
 291   a.orl = seq == DIR ? 1 : 0;
 292   a.oblnk = NULL;
 293   save_init = f__init;
 294   f__init &= ~2;
 295   rtn = f_open (&a);
 296   f__init = save_init | 1;
 297   return rtn;
 298 }