aboutsummaryrefslogtreecommitdiff
path: root/libf2c/libI77/open.c
diff options
context:
space:
mode:
Diffstat (limited to 'libf2c/libI77/open.c')
-rw-r--r--libf2c/libI77/open.c301
1 files changed, 0 insertions, 301 deletions
diff --git a/libf2c/libI77/open.c b/libf2c/libI77/open.c
deleted file mode 100644
index ac1e00e..0000000
--- a/libf2c/libI77/open.c
+++ /dev/null
@@ -1,301 +0,0 @@
-#include "config.h"
-#include "f2c.h"
-#include "fio.h"
-#include <string.h>
-#ifndef NON_POSIX_STDIO
-#ifdef MSDOS
-#include "io.h"
-#else
-#include "unistd.h" /* for access */
-#endif
-#endif
-
-#undef abs
-#undef min
-#undef max
-#include <stdlib.h>
-extern int f__canseek (FILE *);
-extern integer f_clos (cllist *);
-
-#ifdef NON_ANSI_RW_MODES
-char *f__r_mode[2] = { "r", "r" };
-char *f__w_mode[4] = { "w", "w", "r+w", "r+w" };
-#else
-char *f__r_mode[2] = { "rb", "r" };
-char *f__w_mode[4] = { "wb", "w", "r+b", "r+" };
-#endif
-
-static char f__buf0[400], *f__buf = f__buf0;
-int f__buflen = (int) sizeof (f__buf0);
-
-static void
-f__bufadj (int n, int c)
-{
- unsigned int len;
- char *nbuf, *s, *t, *te;
-
- if (f__buf == f__buf0)
- f__buflen = 1024;
- while (f__buflen <= n)
- f__buflen <<= 1;
- len = (unsigned int) f__buflen;
- if (len != f__buflen || !(nbuf = (char *) malloc (len)))
- f__fatal (113, "malloc failure");
- s = nbuf;
- t = f__buf;
- te = t + c;
- while (t < te)
- *s++ = *t++;
- if (f__buf != f__buf0)
- free (f__buf);
- f__buf = nbuf;
-}
-
-int
-f__putbuf (int c)
-{
- char *s, *se;
- int n;
-
- if (f__hiwater > f__recpos)
- f__recpos = f__hiwater;
- n = f__recpos + 1;
- if (n >= f__buflen)
- f__bufadj (n, f__recpos);
- s = f__buf;
- se = s + f__recpos;
- if (c)
- *se++ = c;
- *se = 0;
- for (;;)
- {
- fputs (s, f__cf);
- s += strlen (s);
- if (s >= se)
- break; /* normally happens the first time */
- putc (*s++, f__cf);
- }
- return 0;
-}
-
-void
-x_putc (int c)
-{
- if (f__recpos >= f__buflen)
- f__bufadj (f__recpos, f__buflen);
- f__buf[f__recpos++] = c;
-}
-
-#define opnerr(f,m,s) \
- do {if(f) {f__init &= ~2; errno= m;} else opn_err(m,s,a); return(m);} while(0)
-
-static void
-opn_err (int m, char *s, olist * a)
-{
- if (a->ofnm)
- {
- /* supply file name to error message */
- if (a->ofnmlen >= f__buflen)
- f__bufadj ((int) a->ofnmlen, 0);
- g_char (a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf);
- }
- f__fatal (m, s);
-}
-
-integer
-f_open (olist * a)
-{
- unit *b;
- integer rv;
- char buf[256], *s, *env;
- cllist x;
- int ufmt;
- FILE *tf;
- int fd, len;
-#ifndef NON_UNIX_STDIO
- int n;
-#endif
- if (f__init != 1)
- f_init ();
- f__external = 1;
- if (a->ounit >= MXUNIT || a->ounit < 0)
- err (a->oerr, 101, "open");
- f__curunit = b = &f__units[a->ounit];
- if (b->ufd)
- {
- if (a->ofnm == 0)
- {
- same:if (a->oblnk)
- b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
- return (0);
- }
-#ifdef NON_UNIX_STDIO
- if (b->ufnm
- && strlen (b->ufnm) == a->ofnmlen
- && !strncmp (b->ufnm, a->ofnm, (unsigned) a->ofnmlen))
- goto same;
-#else
- g_char (a->ofnm, a->ofnmlen, buf);
- if (f__inode (buf, &n) == b->uinode && n == b->udev)
- goto same;
-#endif
- x.cunit = a->ounit;
- x.csta = 0;
- x.cerr = a->oerr;
- if ((rv = f_clos (&x)) != 0)
- return rv;
- }
- b->url = (int) a->orl;
- b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
- if (a->ofm == 0)
- if ((a->oacc) && (*a->oacc == 'D' || *a->oacc == 'd'))
- b->ufmt = 0;
- else
- b->ufmt = 1;
- else if (*a->ofm == 'f' || *a->ofm == 'F')
- b->ufmt = 1;
- else
- b->ufmt = 0;
- ufmt = b->ufmt;
-#ifdef url_Adjust
- if (b->url && !ufmt)
- url_Adjust (b->url);
-#endif
- if (a->ofnm)
- {
- g_char (a->ofnm, a->ofnmlen, buf);
- if (!buf[0])
- opnerr (a->oerr, 107, "open");
- }
- else
- sprintf (buf, "fort.%ld", (long) a->ounit);
- b->uscrtch = 0;
- b->uend = 0;
- b->uwrt = 0;
- b->ufd = 0;
- b->urw = 3;
- switch (a->osta ? *a->osta : 'u')
- {
- case 'o':
- case 'O':
-#ifdef NON_POSIX_STDIO
- if (!(tf = fopen (buf, "r")))
- opnerr (a->oerr, errno, "open");
- fclose (tf);
-#else
- if (access (buf, 0))
- opnerr (a->oerr, errno, "open");
-#endif
- break;
- case 's':
- case 'S':
- b->uscrtch = 1;
-#ifdef HAVE_MKSTEMP /* Allow use of TMPDIR preferentially. */
- env = getenv ("TMPDIR");
- if (!env)
- env = getenv ("TEMP");
- if (!env)
- env = "/tmp";
- len = strlen (env);
- if (len > 256 - (int) sizeof ("/tmp.FXXXXXX"))
- err (a->oerr, 132, "open");
- strcpy (buf, env);
- strcat (buf, "/tmp.FXXXXXX");
- fd = mkstemp (buf);
- if (fd == -1 || close (fd))
- err (a->oerr, 132, "open");
-#else /* ! defined (HAVE_MKSTEMP) */
-#ifdef HAVE_TEMPNAM /* Allow use of TMPDIR preferentially. */
- s = tempnam (0, buf);
- if (strlen (s) >= sizeof (buf))
- err (a->oerr, 132, "open");
- (void) strcpy (buf, s);
- free (s);
-#else /* ! defined (HAVE_TEMPNAM) */
-#ifdef HAVE_TMPNAM
- tmpnam (buf);
-#else
- (void) strcpy (buf, "tmp.FXXXXXX");
- (void) mktemp (buf);
-#endif
-#endif /* ! defined (HAVE_TEMPNAM) */
-#endif /* ! defined (HAVE_MKSTEMP) */
- goto replace;
- case 'n':
- case 'N':
-#ifdef NON_POSIX_STDIO
- if ((tf = fopen (buf, "r")) || (tf = fopen (buf, "a")))
- {
- fclose (tf);
- opnerr (a->oerr, 128, "open");
- }
-#else
- if (!access (buf, 0))
- opnerr (a->oerr, 128, "open");
-#endif
- /* no break */
- case 'r': /* Fortran 90 replace option */
- case 'R':
- replace:
- if ((tf = fopen (buf, f__w_mode[0])))
- fclose (tf);
- }
-
- b->ufnm = (char *) malloc ((unsigned int) (strlen (buf) + 1));
- if (b->ufnm == NULL)
- opnerr (a->oerr, 113, "no space");
- (void) strcpy (b->ufnm, buf);
- if ((s = a->oacc) && b->url)
- ufmt = 0;
- if (!(tf = fopen (buf, f__w_mode[ufmt | 2])))
- {
- if ((tf = fopen (buf, f__r_mode[ufmt])))
- b->urw = 1;
- else if ((tf = fopen (buf, f__w_mode[ufmt])))
- {
- b->uwrt = 1;
- b->urw = 2;
- }
- else
- err (a->oerr, errno, "open");
- }
- b->useek = f__canseek (b->ufd = tf);
-#ifndef NON_UNIX_STDIO
- if ((b->uinode = f__inode (buf, &b->udev)) == -1)
- opnerr (a->oerr, 108, "open");
-#endif
- if (b->useek)
- {
- if (a->orl)
- FSEEK (b->ufd, 0, SEEK_SET);
- else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
- && FSEEK (b->ufd, 0, SEEK_END))
- opnerr (a->oerr, 129, "open");
- }
- return (0);
-}
-
-int
-fk_open (int seq, int fmt, ftnint n)
-{
- char nbuf[10];
- olist a;
- int rtn;
- int save_init;
-
- (void) sprintf (nbuf, "fort.%ld", (long) n);
- a.oerr = 1;
- a.ounit = n;
- a.ofnm = nbuf;
- a.ofnmlen = strlen (nbuf);
- a.osta = NULL;
- a.oacc = seq == SEQ ? "s" : "d";
- a.ofm = fmt == FMT ? "f" : "u";
- a.orl = seq == DIR ? 1 : 0;
- a.oblnk = NULL;
- save_init = f__init;
- f__init &= ~2;
- rtn = f_open (&a);
- f__init = save_init | 1;
- return rtn;
-}
generated by cgit v1.1 at 2025-04-10 14:13:13 +0000