Timestamp:
Apr 27, 2004, 8:39:34 PM (22 years ago)
Author:
bird
Message:

GCC v3.3.3 sources.

Location:
branches/GNU/src/gcc
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/GNU/src/gcc

    • Property svn:ignore
      •  

        old new  
        2626configure.vr
        2727configure.vrs
         28
        2829Makefile
        29 dir.info
        3030lost+found
        3131update.out
  • branches/GNU/src/gcc/libf2c/libI77/open.c

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