Update to Netlib version of 1998-04-20
authorCraig Burley <burley@gnu.org>
Tue, 19 May 1998 10:52:03 +0000 (06:52 -0400)
committerDave Love <fx@gcc.gnu.org>
Tue, 19 May 1998 10:52:03 +0000 (10:52 +0000)
From-SVN: r19877

33 files changed:
libf2c/ChangeLog
libf2c/changes.netlib
libf2c/libF77/Version.c
libf2c/libF77/dtime_.c
libf2c/libF77/etime_.c
libf2c/libF77/h_dnnt.c
libf2c/libF77/h_nint.c
libf2c/libF77/i_dnnt.c
libf2c/libF77/i_nint.c
libf2c/libF77/main.c
libf2c/libF77/s_paus.c
libf2c/libF77/signal1.h0
libf2c/libI77/Version.c
libf2c/libI77/backspace.c
libf2c/libI77/close.c
libf2c/libI77/dfe.c
libf2c/libI77/endfile.c
libf2c/libI77/err.c
libf2c/libI77/fio.h
libf2c/libI77/iio.c
libf2c/libI77/ilnw.c
libf2c/libI77/lread.c
libf2c/libI77/lwrite.c
libf2c/libI77/open.c
libf2c/libI77/rawio.h
libf2c/libI77/sfe.c
libf2c/libI77/util.c
libf2c/libI77/wrtfmt.c
libf2c/libI77/wsfe.c
libf2c/libI77/wsle.c
libf2c/libI77/wsne.c
libf2c/libU77/Version.c
libf2c/readme.netlib

index 0159343124c76983eb338587e97aa7f2c99fdacd..1a1dd5a60f75b8e6feafd8bbb81c529bfbac5f79 100644 (file)
@@ -1,3 +1,17 @@
+Fri May  1 11:57:45 1998  Craig Burley  <burley@gnu.org>
+
+       Update to Netlib version of 1998-04-20:
+       * libF77/dtime_.c, libF77/etime_.c, libF77/h_dnnt.c,
+       libF77/h_nint.c, libF77/i_dnnt.c, libF77/i_nint.c,
+       libF77/main.c, libF77/s_paus.c, libF77/signal1.h0,
+       libI77/backspace.c, libI77/close.c, libI77/dfe.c,
+       libI77/endfile.c, libI77/err.c, libI77/fio.h,
+       libI77/iio.c, libI77/ilnw.c, libI77/lread.c,
+       libI77/lwrite.c, libI77/open.c, libI77/rawio.h,
+       libI77/sfe.c, libI77/util.c, libI77/wrtfmt.c,
+       libI77/wsfe.c, libI77/wsle.c, libI77/wsne.c:
+       See changes.netlib for info.
+
 Sun Apr 26 09:13:41 1998  Craig Burley  <burley@gnu.org>
 
        * libU77/hostnm_.c (G77_hostnm_0): Fix off-by-one error
index 625999d3c654da8cc95b14143692280dc9f3abe3..ac825279db43f9ffa3ade9680385a979a8424247 100644 (file)
@@ -2848,3 +2848,57 @@ invisible on other machines.
 
 Sun Sep 21 22:05:19 EDT 1997
   libf77: [de]time_.c (Unix systems only): change return type to double.
+
+Thu Dec  4 22:10:09 EST 1997
+  Fix bug with handling large blocks of comments (over 4k); parts of the
+second and subsequent blocks were likely to be lost (not copied into
+comments in the resulting C).  Allow comment lines to be longer before
+breaking them.
+
+Mon Jan 19 17:19:27 EST 1998
+  makefile: change the rule for making gram.c to one for making gram1.c;
+henceforth, asking netlib to "send all from f2c/src" will bring you a
+working gram.c.  Nowadays there are simply too many broken versions of
+yacc floating around.
+  libi77: backspace.c: for b->ufmt==0, change sizeof(int) to
+sizeof(uiolen).  On machines where this would make a difference, it is
+best for portability to compile libI77 with -DUIOLEN_int, which will
+render the change invisible.
+
+Tue Feb 24 08:35:33 EST 1998
+  makefile: remove gram.c from the "make clean" rule.
+
+Wed Feb 25 08:29:39 EST 1998
+  makefile: change CFLAGS assignment to -O; add "veryclean" rule.
+
+Wed Mar  4 13:13:21 EST 1998
+  libi77: open.c: fix glitch in comparing file names under
+-DNON_UNIX_STDIO.
+
+Mon Mar  9 23:56:56 EST 1998
+  putpcc.c: omit an unnecessary temporary variable in computing
+(expr)**3.
+  libf77, libi77: minor tweaks to make some C++ compilers happy;
+Version.c not changed.
+
+Wed Mar 18 18:08:47 EST 1998
+  libf77: minor tweaks to [ed]time_.c; Version.c not changed.
+  libi77: endfile.c, open.c: acquire temporary files from tmpfile(),
+unless compiled with -DNON_ANSI_STDIO, which uses mktemp().
+New buffering scheme independent of NON_UNIX_STDIO for handling T
+format items.  Now -DNON_UNIX_STDIO is no longer be necessary for
+Linux, and libf2c no longer causes stderr to be buffered -- the former
+setbuf or setvbuf call for stderr was to make T format items work.
+open.c: use the Posix access() function to check existence or
+nonexistence of files, except under -DNON_POSIX_STDIO, where trial
+fopen calls are used.  In open.c, fix botch in changes of 19980304.
+  libf2c.zip: the PC makefiles are now set for NT/W95, with comments
+about changes for DOS.
+
+Fri Apr  3 17:22:12 EST 1998
+  Adjust fix of 19960913 to again permit substring notation on
+character variables in data statements.
+
+Sun Apr  5 19:26:50 EDT 1998
+  libi77: wsfe.c: make $ format item work: this was lost in the changes
+of 17 March 1998.
index 4f7df49982c1ff8fa2ca82439554b57dd27d06c3..2460a81b3685b5b926455e3a0959e392e8700a4b 100644 (file)
@@ -3,7 +3,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19970919\n";
 /*
 */
 
-char __G77_LIBF77_VERSION__[] = "0.5.22";
+char __G77_LIBF77_VERSION__[] = "0.5.23-19980501";
 
 /*
 2.00   11 June 1980.  File version.c added to library.
index 79b6735b13b5dfa0a13a2ca3e08699ff6a860fed..95db94f4874b395b11970ecb666727b6b6017287 100644 (file)
@@ -1,5 +1,7 @@
 #include "time.h"
 #ifndef USE_CLOCK
+#define _INCLUDE_POSIX_SOURCE  /* for HP-UX */
+#define _INCLUDE_XOPEN_SOURCE  /* for HP-UX */
 #include "sys/types.h"
 #include "sys/times.h"
 #endif
index 04528b50bb8999e4698d3a1aa2b292b1a1f702d1..7ed3fce6b271cd6123ed137d0b898ffc8b093d2a 100644 (file)
@@ -1,5 +1,7 @@
 #include "time.h"
 #ifndef USE_CLOCK
+#define _INCLUDE_POSIX_SOURCE  /* for HP-UX */
+#define _INCLUDE_XOPEN_SOURCE  /* for HP-UX */
 #include "sys/types.h"
 #include "sys/times.h"
 #endif
index 9d0aa25f1d321c0b6b656646168a58599df8e42a..005ac6fc41245a322793062e5ff59aca320bae6d 100644 (file)
@@ -9,6 +9,5 @@ shortint h_dnnt(x) doublereal *x;
 shortint h_dnnt(doublereal *x)
 #endif
 {
-return( (*x)>=0 ?
-       floor(*x + .5) : -floor(.5 - *x) );
+return (shortint)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
 }
index 0af3735da42f7beafc856f494abb1fd6b1dea544..6b8dc29b1542c3f0adbd846e5c2ca27060799a42 100644 (file)
@@ -9,6 +9,5 @@ shortint h_nint(x) real *x;
 shortint h_nint(real *x)
 #endif
 {
-return( (*x)>=0 ?
-       floor(*x + .5) : -floor(.5 - *x) );
+return (shortint)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
 }
index 8fcecb6820078fe141a5a842619ea63276f6599e..4ede56ac35596db45333866e663f51c344b34f49 100644 (file)
@@ -9,6 +9,5 @@ integer i_dnnt(x) doublereal *x;
 integer i_dnnt(doublereal *x)
 #endif
 {
-return( (*x)>=0 ?
-       floor(*x + .5) : -floor(.5 - *x) );
+return (integer)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
 }
index c0f6795171f9fea48ada8288fa48e2cd886ad346..411ce32821e3e1241226cb0e6df1915fadba5b80 100644 (file)
@@ -9,6 +9,5 @@ integer i_nint(x) real *x;
 integer i_nint(real *x)
 #endif
 {
-return( (*x)>=0 ?
-       floor(*x + .5) : -floor(.5 - *x) );
+return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
 }
index 469a64bdcb3d3d1db2d34d55dcb32365bf5c5bbc..343d7bdff1c7727c585ddad580651fa5f3d6b257 100644 (file)
@@ -50,38 +50,44 @@ extern int MAIN__(void);
 #define Int int
 #endif
 
-static VOID sigfdie(Int n)
+static VOID sigfdie(Sigarg)
 {
+Use_Sigarg;
 sig_die("Floating Exception", 1);
 }
 
 
-static VOID sigidie(Int n)
+static VOID sigidie(Sigarg)
 {
+Use_Sigarg;
 sig_die("IOT Trap", 1);
 }
 
 #ifdef SIGQUIT
-static VOID sigqdie(Int n)
+static VOID sigqdie(Sigarg)
 {
+Use_Sigarg;
 sig_die("Quit signal", 1);
 }
 #endif
 
 
-static VOID sigindie(Int n)
+static VOID sigindie(Sigarg)
 {
+Use_Sigarg;
 sig_die("Interrupt", 0);
 }
 
-static VOID sigtdie(Int n)
+static VOID sigtdie(Sigarg)
 {
+Use_Sigarg;
 sig_die("Killed", 0);
 }
 
 #ifdef SIGTRAP
-static VOID sigtrdie(Int n)
+static VOID sigtrdie(Sigarg)
 {
+Use_Sigarg;
 sig_die("Trace trap", 1);
 }
 #endif
index ee2a0ee6bf5aaa5d33f15b118e4777ddc1e9d93b..a7733a533620109671f7e0b7a72c838406c61f49 100644 (file)
@@ -2,6 +2,7 @@
 #include "f2c.h"
 #define PAUSESIG 15
 
+#include "signal1.h"
 #ifdef KR_headers
 #define Void /* void */
 #define Int /* int */
@@ -12,7 +13,6 @@
 #undef min
 #undef max
 #include <stdlib.h>
-#include "signal1.h"
 #ifdef __cplusplus
 extern "C" {
 #endif
@@ -22,8 +22,8 @@ extern int getpid(void), isatty(int), pause(void);
 extern VOID f_exit(Void);
 
  static VOID
-waitpause(Int n)
-{      n = n; /* shut up compiler warning */
+waitpause(Sigarg)
+{      Use_Sigarg;
        return;
        }
 
index 8800a18d77b49c8e031761bf91bad8f4318df0cc..662cae450dc4cedec2d43e991ad828cfa71981e9 100644 (file)
 #ifdef KR_headers
 #define Sigarg_t
 #else
+#ifdef __cplusplus
+#define Sigarg_t ...
+#else
 #define Sigarg_t int
 #endif
+#endif
 #endif /*Sigarg_t*/
 
 #ifdef USE_SIG_PF      /* compile with -DUSE_SIG_PF under IRIX */
@@ -23,3 +27,11 @@ typedef Sigret_t (*sig_pf)(Sigarg_t);
 #endif
 
 #define signal1(a,b) signal(a,(sig_pf)b)
+
+#ifdef __cplusplus
+#define Sigarg ...
+#define Use_Sigarg
+#else
+#define Sigarg Int n
+#define Use_Sigarg n = n       /* shut up compiler warning */
+#endif
index 6fdf19e4654a48b4028e19b26e7e9432ee42fb52..0cdeb88ae99b1f8f56c7bf0aa2affa7549dced26 100644 (file)
@@ -1,9 +1,9 @@
-static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19970916\n";
+static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19980405\n";
 
 /*
 */
 
-char __G77_LIBI77_VERSION__[] = "0.5.22";
+char __G77_LIBI77_VERSION__[] = "0.5.23-19980502";
 
 /*
 2.01   $ format added
@@ -267,6 +267,24 @@ wrtfmt.c:
 /* 16 Sept. 1997:fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines
                 with 64-bit pointers and 32-bit ints that did not 64-bit
                 align struct syl (e.g., Linux on the DEC Alpha). */
+/* 19 Jan. 1998: backspace.c: for b->ufmt==0, change sizeof(int) to
+                sizeof(uiolen).  On machines where this would make a
+                difference, it is best for portability to compile libI77 with
+                -DUIOLEN_int (which will render the change invisible). */
+/* 4 March 1998: open.c: fix glitch in comparing file names under
+               -DNON_UNIX_STDIO */
+/* 17 March 1998: endfile.c, open.c: acquire temporary files from tmpfile(),
+                unless compiled with -DNON_ANSI_STDIO, which uses mktemp().
+                New buffering scheme independent of NON_UNIX_STDIO for
+                handling T format items.  Now -DNON_UNIX_STDIO is no
+                longer be necessary for Linux, and libf2c no longer
+                causes stderr to be buffered -- the former setbuf or
+                setvbuf call for stderr was to make T format items work.
+                open.c: use the Posix access() function to check existence
+                or nonexistence of files, except under -DNON_POSIX_STDIO,
+                where trial fopen calls are used. */
+/* 5 April 1998: wsfe.c: make $ format item work: this was lost in the
+                changes of 17 March 1998. */
 
 
 
index b806d1ec49ddfa4b3ea19ca9cdcbd5b55de7b8d6..8456a7f8c6f1b39e30df332ff3ede1990b723c5c 100644 (file)
@@ -7,21 +7,17 @@ integer f_back(a) alist *a;
 integer f_back(alist *a)
 #endif
 {      unit *b;
-       int i, ndec;
+       long v, w, x, y, z;
        uiolen n;
-#if defined (MSDOS) && !defined (GO32)
-       int j, k;
-       long w, z;
-#endif
-       long x, y;
-       char buf[32];
+       FILE *f;
+
        if (f__init & 2)
                f__fatal (131, "I/O recursion");
        if(a->aunit >= MXUNIT || a->aunit < 0)
                err(a->aerr,101,"backspace");
-       b= &f__units[a->aunit];
+       f__curunit = b = &f__units[a->aunit];   /* curunit for error messages */
        if(b->useek==0) err(a->aerr,106,"backspace");
-       if(b->ufd==NULL) {
+       if((f = b->ufd) == NULL) {
                fk_open(1, 1, a->aunit);
                return(0);
                }
@@ -36,67 +32,41 @@ integer f_back(alist *a)
                }
        if(b->url>0)
        {
-               x=ftell(b->ufd);
+               x=ftell(f);
                y = x % b->url;
                if(y == 0) x--;
                x /= b->url;
                x *= b->url;
-               (void) fseek(b->ufd,x,SEEK_SET);
+               (void) fseek(f,x,SEEK_SET);
                return(0);
        }
 
        if(b->ufmt==0)
-       {       (void) fseek(b->ufd,-(long)sizeof(uiolen),SEEK_CUR);
-               (void) fread((char *)&n,sizeof(uiolen),1,b->ufd);
-               (void) fseek(b->ufd,-(long)n-2*sizeof(uiolen),SEEK_CUR);
+       {       fseek(f,-(long)sizeof(uiolen),SEEK_CUR);
+               fread((char *)&n,sizeof(uiolen),1,f);
+               fseek(f,-(long)n-2*sizeof(uiolen),SEEK_CUR);
                return(0);
        }
-#if defined (MSDOS) && !defined (GO32)
-       w = -1;
-#endif
-       for(ndec = 1;; ndec = 0)
-       {
-               y = x = ftell(b->ufd);
-               if(x < sizeof(buf))
-                       x = 0;
-               else
-                       x -= sizeof(buf);
-               (void) fseek(b->ufd,x,SEEK_SET);
-               n=fread(buf,1,(size_t)(y-x), b->ufd);
-               for(i = n - ndec; --i >= 0; )
-               {
-                       if(buf[i]!='\n') continue;
-#if defined (MSDOS) && !defined (GO32)
-                       for(j = k = 0; j <= i; j++)
-                               if (buf[j] == '\n')
-                                       k++;
-                       fseek(b->ufd,x,SEEK_SET);
-                       for(;;)
-                               if (getc(b->ufd) == '\n') {
-                                       if ((z = ftell(b->ufd)) >= y && ndec) {
-                                               if (w == -1)
-                                                       goto break2;
-                                               break;
-                                               }
-                                       if (--k <= 0)
-                                               return 0;
-                                       w = z;
-                                       }
-                       fseek(b->ufd, w, SEEK_SET);
-#else
-                       fseek(b->ufd,(long)(i+1-n),SEEK_CUR);
-#endif
-                       return(0);
+       w = x = ftell(f);
+       z = 0;
+ loop:
+       while(x) {
+               x -= x < 64 ? x : 64;
+               fseek(f,x,SEEK_SET);
+               for(y = x; y < w; y++) {
+                       if (getc(f) != '\n')
+                               continue;
+                       v = ftell(f);
+                       if (v == w) {
+                               if (z)
+                                       goto break2;
+                               goto loop;
+                               }
+                       z = v;
+                       }
+               err(a->aerr,(EOF),"backspace");
                }
-#if defined (MSDOS) && !defined (GO32)
  break2:
-#endif
-               if(x==0)
-                       {
-                       (void) fseek(b->ufd, 0L, SEEK_SET);
-                       return(0);
-                       }
-               else if(n<=0) err(a->aerr,(EOF),"backspace");
-               (void) fseek(b->ufd, x, SEEK_SET);
-       }
+       fseek(f, z, SEEK_SET);
+       return 0;
 }
index 5c3af4c085409e7d87ba84f9906f6714419a3b7e..bbc5bacb821d921f87c5048d546cb6830e71df0d 100644 (file)
@@ -33,11 +33,10 @@ integer f_clos(cllist *a)
        b= &f__units[a->cunit];
        if(b->ufd==NULL)
                goto done;
+       if (b->uscrtch == 1)
+               goto Delete;
        if (!a->csta)
-               if (b->uscrtch == 1)
-                       goto Delete;
-               else
-                       goto Keep;
+               goto Keep;
        switch(*a->csta) {
                default:
                Keep:
@@ -53,8 +52,8 @@ integer f_clos(cllist *a)
                case 'd':
                case 'D':
                Delete:
+                       fclose(b->ufd);
                        if(b->ufnm) {
-                               fclose(b->ufd);
                                unlink(b->ufnm); /*SYSDEP*/
                                free(b->ufnm);
                                }
index e229e0e3356ca34f465172335fc360ee69cfba90..3a9365923810a446e17c8a3d5a57bc4464c2dd5e 100644 (file)
@@ -31,41 +31,30 @@ y_getc(Void)
        }
        err(f__elist->cierr,errno,"readingd");
 }
-#ifdef KR_headers
-y_putc(c)
-#else
-y_putc(int c)
-#endif
-{
-       f__recpos++;
-       if(f__recpos <= f__curunit->url || f__curunit->url==1)
-               putc(c,f__cf);
-       else
-               err(f__elist->cierr,110,"dout");
-       return(0);
-}
+
+ static int
 y_rev(Void)
-{      /*what about work done?*/
-       if(f__curunit->url==1 || f__recpos==f__curunit->url)
-               return(0);
-       while(f__recpos<f__curunit->url)
-               (*f__putn)(' ');
-       f__recpos=0;
+{
+       if (f__recpos < f__hiwater)
+               f__recpos = f__hiwater;
+       if (f__curunit->url > 1)
+               while(f__recpos < f__curunit->url)
+                       (*f__putn)(' ');
+       if (f__recpos)
+               f__putbuf(0);
+       f__recpos = 0;
        return(0);
 }
+
+ static int
 y_err(Void)
 {
        err(f__elist->cierr, 110, "dfe");
 }
 
+ static int
 y_newrec(Void)
 {
-       if(f__curunit->url == 1 || f__recpos == f__curunit->url) {
-               f__hiwater = f__recpos = f__cursor = 0;
-               return(1);
-       }
-       if(f__hiwater > f__recpos)
-               f__recpos = f__hiwater;
        y_rev();
        f__hiwater = f__cursor = 0;
        return(1);
@@ -132,7 +121,7 @@ integer s_wdfe(cilist *a)
        if(n=c_dfe(a)) return(n);
        if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
                err(a->cierr,errno,"startwrt");
-       f__putn = y_putc;
+       f__putn = x_putc;
        f__doed = w_ed;
        f__doned= w_ned;
        f__dorevert = y_err;
@@ -146,11 +135,6 @@ integer s_wdfe(cilist *a)
 integer e_rdfe(Void)
 {
        f__init = 1;
-       (void) en_fio();
+       en_fio();
        return(0);
 }
-integer e_wdfe(Void)
-{
-       f__init = 1;
-       return en_fio();
-}
index 6050d1e3b3034ff3c196480b1132645921bf161f..0b785a95165d972b9a86c99b17737805d5586c48 100644 (file)
@@ -1,10 +1,9 @@
 #include "f2c.h"
 #include "fio.h"
-#include <sys/types.h>
-#include "rawio.h"
 
 #ifdef KR_headers
 extern char *strcpy();
+extern FILE *tmpfile();
 #else
 #undef abs
 #undef min
@@ -13,19 +12,7 @@ extern char *strcpy();
 #include <string.h>
 #endif
 
-#ifdef NON_UNIX_STDIO
-#ifndef unlink
-#define unlink remove
-#endif
-#else
-#if defined (MSDOS) && !defined (GO32)
-#include "io.h"
-#endif
-#endif
-
-#ifdef NON_UNIX_STDIO
 extern char *f__r_mode[], *f__w_mode[];
-#endif
 
 #ifdef KR_headers
 integer f_end(a) alist *a;
@@ -34,21 +21,17 @@ integer f_end(alist *a)
 #endif
 {
        unit *b;
+       FILE *tf;
+
        if (f__init & 2)
                f__fatal (131, "I/O recursion");
        if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile");
        b = &f__units[a->aunit];
        if(b->ufd==NULL) {
                char nbuf[10];
-               (void) sprintf(nbuf,"fort.%ld",a->aunit);
-#ifdef NON_UNIX_STDIO
-               { FILE *tf;
-                       if (tf = fopen(nbuf, f__w_mode[0]))
-                               fclose(tf);
-                       }
-#else
-               close(creat(nbuf, 0666));
-#endif
+               sprintf(nbuf,"fort.%ld",a->aunit);
+               if (tf = fopen(nbuf, f__w_mode[0]))
+                       fclose(tf);
                return(0);
                }
        b->uend=1;
@@ -56,14 +39,13 @@ integer f_end(alist *a)
 }
 
  static int
-#ifdef NON_UNIX_STDIO
 #ifdef KR_headers
-copy(from, len, to) char *from, *to; register long len;
+copy(from, len, to) FILE *from, *to; register long len;
 #else
 copy(FILE *from, register long len, FILE *to)
 #endif
 {
-       int k, len1;
+       int len1;
        char buf[BUFSIZ];
 
        while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) {
@@ -74,36 +56,6 @@ copy(FILE *from, register long len, FILE *to)
                }
        return 0;
        }
-#else
-#ifdef KR_headers
-copy(from, len, to) char *from, *to; register long len;
-#else
-copy(char *from, register long len, char *to)
-#endif
-{
-       register size_t n;
-       int k, rc = 0, tmp;
-       char buf[BUFSIZ];
-
-       if ((k = open(from, O_RDONLY)) < 0)
-               return 1;
-       if ((tmp = creat(to,0666)) < 0)
-               return 1;
-       while((n = read(k, buf, (size_t) (len > BUFSIZ ? BUFSIZ : (int)len))) > 0) {
-               if (write(tmp, buf, n) != n)
-                       { rc = 1; break; }
-               if ((len -= n) <= 0)
-                       break;
-               }
-       close(k);
-       close(tmp);
-       return n < 0 ? 1 : rc;
-       }
-#endif
-
-#ifndef L_tmpnam
-#define L_tmpnam 16
-#endif
 
  int
 #ifdef KR_headers
@@ -112,14 +64,9 @@ t_runc(a) alist *a;
 t_runc(alist *a)
 #endif
 {
-       char nm[L_tmpnam+12];   /* extra space in case L_tmpnam is tiny */
        long loc, len;
        unit *b;
-#ifdef NON_UNIX_STDIO
        FILE *bf, *tf;
-#else
-       FILE *bf;
-#endif
        int rc = 0;
 
        b = &f__units[a->aunit];
@@ -130,36 +77,20 @@ t_runc(alist *a)
        len=ftell(bf);
        if (loc >= len || b->useek == 0 || b->ufnm == NULL)
                return(0);
-#ifdef NON_UNIX_STDIO
        fclose(b->ufd);
-#else
-       rewind(b->ufd); /* empty buffer */
-#endif
        if (!loc) {
-#ifdef NON_UNIX_STDIO
                if (!(bf = fopen(b->ufnm, f__w_mode[b->ufmt])))
-#else
-               if (close(creat(b->ufnm,0666)))
-#endif
                        rc = 1;
                if (b->uwrt)
                        b->uwrt = 1;
                goto done;
                }
-#ifdef _POSIX_SOURCE
-       tmpnam(nm);
-#else
-       strcpy(nm,"tmp.FXXXXXX");
-       mktemp(nm);
-#endif
-#ifdef NON_UNIX_STDIO
-       if (!(bf = fopen(b->ufnm, f__r_mode[0]))) {
+       if (!(bf = fopen(b->ufnm, f__r_mode[0]))
+        || !(tf = tmpfile())) {
  bad:
                rc = 1;
                goto done;
                }
-       if (!(tf = fopen(nm, f__w_mode[0])))
-               goto bad;
        if (copy(bf, loc, tf)) {
  bad1:
                rc = 1;
@@ -167,28 +98,23 @@ t_runc(alist *a)
                }
        if (!(bf = freopen(b->ufnm, f__w_mode[0], bf)))
                goto bad1;
-       if (!(tf = freopen(nm, f__r_mode[0], tf)))
-               goto bad1;
+       rewind(tf);
        if (copy(tf, loc, bf))
                goto bad1;
-       if (f__w_mode[0] != f__w_mode[b->ufmt]) {
-               if (!(bf = freopen(b->ufnm, f__w_mode[b->ufmt|2], bf)))
-                       goto bad1;
-               fseek(bf, loc, SEEK_SET);
+       b->urw = 2;
+#ifdef NON_UNIX_STDIO
+       if (b->ufmt) {
+               fclose(bf);
+               if (!(bf = fopen(b->ufnm, f__w_mode[3])))
+                       goto bad;
+               fseek(bf,0L,SEEK_END);
+               b->urw = 3;
                }
+#endif
 done1:
        fclose(tf);
-       unlink(nm);
 done:
        f__cf = b->ufd = bf;
-#else
-       if (copy(b->ufnm, loc, nm)
-        || copy(nm, loc, b->ufnm))
-               rc = 1;
-       unlink(nm);
-       fseek(b->ufd, loc, SEEK_SET);
-done:
-#endif
        if (rc)
                err(a->aerr,111,"endfile");
        return 0;
index cb40630059da50d90e7bd4f34b2cd7a3ceae87d3..56d82ac4b19ee29ea9efcb62640c3b046a2354a3 100644 (file)
@@ -1,9 +1,10 @@
 #ifndef NON_UNIX_STDIO
+#define _INCLUDE_POSIX_SOURCE  /* for HP-UX */
+#define _INCLUDE_XOPEN_SOURCE  /* for HP-UX */
 #include <sys/types.h>
 #include <sys/stat.h>
 #endif
 #include "f2c.h"
-#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS)
 #ifdef KR_headers
 extern char *malloc();
 #else
@@ -12,10 +13,8 @@ extern char *malloc();
 #undef max
 #include <stdlib.h>
 #endif
-#endif
 #include "fio.h"
 #include "fmt.h"       /* for struct syl */
-#include "rawio.h"     /* for fcntl.h, fdopen */
 
 /*global definitions*/
 unit f__units[MXUNIT]; /*unit table*/
@@ -32,9 +31,11 @@ flag f__external;    /*1 if external io, 0 if internal */
 #ifdef KR_headers
 int (*f__doed)(),(*f__doned)();
 int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)();
-int (*f__getn)(),(*f__putn)(); /*for formatted io*/
+int (*f__getn)();      /* for formatted input */
+void (*f__putn)();     /* for formatted output */
 #else
-int (*f__getn)(void),(*f__putn)(int);  /*for formatted io*/
+int (*f__getn)(void);  /* for formatted input */
+void (*f__putn)(int);  /* for formatted output */
 int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
 int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void);
 #endif
@@ -188,15 +189,6 @@ f_init(Void)
        p= &f__units[0];
        p->ufd=stderr;
        p->useek=f__canseek(stderr);
-#ifdef _IOLBF
-       setvbuf(stderr, (char*)malloc(BUFSIZ+8), _IOLBF, BUFSIZ+8);
-#else
-#if defined (NON_UNIX_STDIO) || defined (MISSING_FILE_ELEMS)
-       setbuf(stderr, (char *)malloc(BUFSIZ+8));
-#else
-       stderr->_flag &= ~_IONBF;
-#endif
-#endif
        p->ufmt=1;
        p->uwrt=1;
        p = &f__units[5];
@@ -217,21 +209,29 @@ f__nowreading(unit *x)
 #endif
 {
        long loc;
-       int ufmt;
-       extern char *f__r_mode[];
+       int ufmt, urw;
+       extern char *f__r_mode[], *f__w_mode[];
 
+       if (x->urw & 1)
+               goto done;
        if (!x->ufnm)
                goto cantread;
-       ufmt = x->ufmt;
-       loc=ftell(x->ufd);
-       if(freopen(x->ufnm,f__r_mode[ufmt],x->ufd) == NULL) {
+       ufmt = x->url ? 0 : x->ufmt;
+       loc = ftell(x->ufd);
+       urw = 3;
+       if (!freopen(x->ufnm, f__w_mode[ufmt|2], x->ufd)) {
+               urw = 1;
+               if(!freopen(x->ufnm, f__r_mode[ufmt], x->ufd)) {
  cantread:
-               errno = 126;
-               return(1);
+                       errno = 126;
+                       return 1;
+                       }
                }
-       x->uwrt=0;
-       (void) fseek(x->ufd,loc,SEEK_SET);
-       return(0);
+       fseek(x->ufd,loc,SEEK_SET);
+       x->urw = urw;
+ done:
+       x->uwrt = 0;
+       return 0;
 }
 #ifdef KR_headers
 f__nowwriting(x) unit *x;
@@ -242,46 +242,34 @@ f__nowwriting(unit *x)
        long loc;
        int ufmt;
        extern char *f__w_mode[];
-#ifndef NON_UNIX_STDIO
-       int k;
-#endif
 
+       if (x->urw & 2)
+               goto done;
        if (!x->ufnm)
                goto cantwrite;
-       ufmt = x->ufmt;
-#ifdef NON_UNIX_STDIO
-       ufmt |= 2;
-#endif
+       ufmt = x->url ? 0 : x->ufmt;
        if (x->uwrt == 3) { /* just did write, rewind */
-#ifdef NON_UNIX_STDIO
                if (!(f__cf = x->ufd =
                                freopen(x->ufnm,f__w_mode[ufmt],x->ufd)))
-#else
-               if (close(creat(x->ufnm,0666)))
-#endif
                        goto cantwrite;
+               x->urw = 2;
                }
        else {
                loc=ftell(x->ufd);
-#ifdef NON_UNIX_STDIO
                if (!(f__cf = x->ufd =
-                       freopen(x->ufnm, f__w_mode[ufmt], x->ufd)))
-#else
-               if (fclose(x->ufd) < 0
-               || (k = x->uwrt == 2 ? creat(x->ufnm,0666)
-                                    : open(x->ufnm,O_WRONLY)) < 0
-               || (f__cf = x->ufd = fdopen(k,f__w_mode[ufmt])) == NULL)
-#endif
+                       freopen(x->ufnm, f__w_mode[ufmt |= 2], x->ufd)))
                        {
                        x->ufd = NULL;
  cantwrite:
                        errno = 127;
                        return(1);
                        }
-               (void) fseek(x->ufd,loc,SEEK_SET);
+               x->urw = 3;
+               fseek(x->ufd,loc,SEEK_SET);
                }
+ done:
        x->uwrt = 1;
-       return(0);
+       return 0;
 }
 
  int
index e9e3b3914077e3b7aea456d1597fd5023cadabdc..846351d5413fecb9597e9d44c1baf7a3cdc020dd 100644 (file)
@@ -37,7 +37,7 @@ typedef struct
        int url;        /*0=sequential*/
        flag useek;     /*true=can backspace, use dir, ...*/
        flag ufmt;
-       flag uprnt;
+       flag urw;       /* (1 for can read) | (2 for can write) */
        flag ublnk;
        flag uend;
        flag uwrt;      /*last io was write*/
@@ -50,17 +50,21 @@ extern flag f__reading,f__external,f__sequential,f__formatted;
 #undef Void
 #ifdef KR_headers
 #define Void /*void*/
-extern int (*f__getn)(),(*f__putn)();  /*for formatted io*/
+extern int (*f__getn)();       /* for formatted input */
+extern void (*f__putn)();      /* for formatted output */
+extern void x_putc();
 extern long f__inode();
 extern VOID sig_die();
 extern int (*f__donewrec)(), t_putc(), x_wSL();
-extern int c_sfe(), err__fl(), xrd_SL();
+extern int c_sfe(), err__fl(), xrd_SL(), f__putbuf();
 #else
 #define Void void
 #ifdef __cplusplus
 extern "C" {
 #endif
-extern int (*f__getn)(void),(*f__putn)(int);   /*for formatted io*/
+extern int (*f__getn)(void);   /* for formatted input */
+extern void (*f__putn)(int);   /* for formatted output */
+extern void x_putc(int);
 extern long f__inode(char*,int*);
 extern void sig_die(char*,int);
 extern void f__fatal(int,char*);
@@ -75,6 +79,7 @@ extern int c_sfe(cilist*), z_rnew(void);
 extern int isatty(int);
 extern int err__fl(int,int,char*);
 extern int xrd_SL(void);
+extern int f__putbuf(int);
 #ifdef __cplusplus
        }
 #endif
index 22eae3f433dd181b01e886549a2236c5c5736ba3..d56a352dd8cf34b0be8d63c2717ece6b741e109d 100644 (file)
@@ -14,17 +14,16 @@ z_getc(Void)
                }
        return '\n';
 }
+
+ void
 #ifdef KR_headers
 z_putc(c)
 #else
 z_putc(int c)
 #endif
 {
-       if(f__icptr >= f__icend) err(f__svic->icierr,110,"inwrite");
-       if(f__recpos++ < f__svic->icirlen)
+       if (f__icptr < f__icend && f__recpos++ < f__svic->icirlen)
                *f__icptr++ = c;
-       else    err(f__svic->icierr,110,"recend");
-       return 0;
 }
 z_rnew(Void)
 {
@@ -139,10 +138,17 @@ integer e_wsfi(Void)
        f__init &= ~2;
        n = en_fio();
        f__fmtbuf = NULL;
-       if(f__icnum >= f__svic->icirnum
-       || !f__recpos && f__icnum)
-               return(n);
+       if(f__svic->icirnum != 1
+        && (f__icnum >  f__svic->icirnum
+        || (f__icnum == f__svic->icirnum && (f__recpos | f__hiwater))))
+               err(f__svic->icierr,110,"inwrite");
+       if (f__recpos < f__hiwater)
+               f__recpos = f__hiwater;
+       if (f__recpos >= f__svic->icirlen)
+               err(f__svic->icierr,110,"recend");
+       if (!f__recpos && f__icnum)
+               return n;
        while(f__recpos++ < f__svic->icirlen)
                *f__icptr++ = ' ';
-       return(n);
+       return n;
 }
index 08ea2be7831e5bd9195c0e2f7689e8d110553aee..abc64099d313f4523a8d7e75e3a561e7f0bd6a74 100644 (file)
@@ -6,9 +6,9 @@ extern char *f__icend;
 extern icilist *f__svic;
 extern int f__icnum;
 #ifdef KR_headers
-extern int z_putc();
+extern void z_putc();
 #else
-extern int z_putc(int);
+extern void z_putc(int);
 #endif
 
  static int
@@ -19,7 +19,7 @@ z_wSL(Void)
        return z_rnew();
        }
 
- VOID
+ static void
 #ifdef KR_headers
 c_liw(a) icilist *a;
 #else
index 4fb14eed29ec51b70cdee0dfe987d2058395b0ff..c5b922fbfb6744a96ba30e1f8d55c73f023c2f81 100644 (file)
@@ -622,7 +622,7 @@ l_read(ftnint *number, char *ptr, ftnlen len, ftnint type)
                        break;
                case TYLOGICAL:
                case TYLONG:
-                       Ptr->flint=f__lx;
+                       Ptr->flint = (ftnint)f__lx;
                        break;
 #ifdef Allow_TYQUAD
                case TYQUAD:
index 5da7dfbb972a372692abe34ad66663071632cbff..bf209f47ed201c4bcfbd9be0366c79f876ef4087 100644 (file)
@@ -13,16 +13,6 @@ donewrec(Void)
                (*f__donewrec)();
        }
 
-#ifdef KR_headers
-t_putc(c)
-#else
-t_putc(int c)
-#endif
-{
-       f__recpos++;
-       putc(c,f__cf);
-       return(0);
-}
  static VOID
 #ifdef KR_headers
 lwrt_I(n) longint n;
@@ -184,10 +174,12 @@ l_put(register char *s)
 #endif
 {
 #ifdef KR_headers
-       register int c, (*pn)() = f__putn;
+       register void (*pn)() = f__putn;
 #else
-       register int c, (*pn)(int) = f__putn;
+       register void (*pn)(int) = f__putn;
 #endif
+       register int c;
+
        while(c = *s++)
                (*pn)(c);
        }
index d7e8491df04a8e47090ee1decdb79fe13d19ee62..29b7662b106adf9b350cb8bd0521b51ec153d7f5 100644 (file)
@@ -1,14 +1,19 @@
-#ifndef NON_UNIX_STDIO
-#include <sys/types.h>
-#include <sys/stat.h>
-#endif
 #include "f2c.h"
 #include "fio.h"
 #include <string.h>
-#include "rawio.h"
+#ifndef NON_POSIX_STDIO
+#ifdef MSDOS
+#include "io.h"
+#else
+#include "unistd.h"    /* for access */
+#endif
+#endif
 
 #ifdef KR_headers
-extern char *malloc(), *mktemp();
+extern char *malloc();
+#ifdef NON_ANSI_STDIO
+extern char *mktemp();
+#endif
 extern integer f_clos();
 #else
 #undef abs
@@ -27,44 +32,97 @@ 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
 #ifdef KR_headers
-f__isdev(s) char *s;
+f__bufadj(n, c) int n, c;
 #else
-f__isdev(char *s)
+f__bufadj(int n, int c)
 #endif
 {
-#ifdef NON_UNIX_STDIO
-       int i, j;
+       unsigned int len;
+       char *nbuf, *s, *t, *te;
 
-       i = open(s,O_RDONLY);
-       if (i == -1)
-               return 0;
-       j = isatty(i);
-       close(i);
-       return j;
+       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
+#ifdef KR_headers
+f__putbuf(c) int c;
 #else
-       struct stat x;
+f__putbuf(int c)
+#endif
+{
+       char *s, *se;
+       int n;
 
-       if(stat(s, &x) == -1) return(0);
-#ifdef S_IFMT
-       switch(x.st_mode&S_IFMT) {
-               case S_IFREG:
-               case S_IFDIR:
-                       return(0);
+       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
+#ifdef KR_headers
+x_putc(c)
 #else
-#ifdef S_ISREG
-       /* POSIX version */
-       if(S_ISREG(x.st_mode) || S_ISDIR(x.st_mode))
-               return(0);
-       else
-#else
-       Help! How does stat work on this system?
-#endif
+x_putc(int c)
 #endif
-               return(1);
+{
+       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
+#ifdef KR_headers
+opn_err(m, s, a) int m; char *s; olist *a;
+#else
+opn_err(int m, char *s, olist *a)
 #endif
-}
+{
+       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);
+       }
+
 #ifdef KR_headers
 integer f_open(a) olist *a;
 #else
@@ -75,11 +133,9 @@ integer f_open(olist *a)
        char buf[256], *s;
        cllist x;
        int ufmt;
-#ifdef NON_UNIX_STDIO
        FILE *tf;
-#else
+#ifndef NON_UNIX_STDIO
        int n;
-       struct stat stb;
 #endif
        if(f__init != 1) f_init();
        if(a->ounit>=MXUNIT || a->ounit<0)
@@ -95,7 +151,7 @@ integer f_open(olist *a)
 #ifdef NON_UNIX_STDIO
                if (b->ufnm
                 && strlen(b->ufnm) == a->ofnmlen
-                && !strncmp(b->ufnm, b->ufnm, (unsigned)a->ofnmlen))
+                && !strncmp(b->ufnm, a->ofnm, (unsigned)a->ofnmlen))
                        goto same;
 #else
                g_char(a->ofnm,a->ofnmlen,buf);
@@ -124,25 +180,32 @@ integer f_open(olist *a)
        if (a->ofnm) {
                g_char(a->ofnm,a->ofnmlen,buf);
                if (!buf[0])
-                       err(a->oerr,107,"open");
+                       opnerr(a->oerr,107,"open");
                }
        else
                sprintf(buf, "fort.%ld", 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_UNIX_STDIO
-               if(access(buf,0))
+#ifdef NON_POSIX_STDIO
+               if (!(tf = fopen(buf,"r")))
+                       opnerr(a->oerr,errno,"open");
+               fclose(tf);
 #else
-               if(stat(buf,&stb))
+               if (access(buf,0))
+                       opnerr(a->oerr,errno,"open");
 #endif
-                       err(a->oerr,errno,"open");
                break;
         case 's':
         case 'S':
                b->uscrtch=1;
+#ifdef NON_ANSI_STDIO
 #ifdef HAVE_TEMPNAM            /* Allow use of TMPDIR preferentially. */
                s = tempnam (0, buf);
                if (strlen (s) >= sizeof (buf))
@@ -158,71 +221,64 @@ integer f_open(olist *a)
 #endif
 #endif /* ! defined (HAVE_TEMPNAM) */
                goto replace;
+#else
+               if (!(b->ufd = tmpfile()))
+                       opnerr(a->oerr,errno,"open");
+               b->ufnm = 0;
+#ifndef NON_UNIX_STDIO
+               b->uinode = b->udev = -1;
+#endif
+               b->useek = 1;
+               return 0;
+#endif
+
        case 'n':
        case 'N':
-#ifdef NON_UNIX_STDIO
-               if(!access(buf,0))
+#ifdef NON_POSIX_STDIO
+               if ((tf = fopen(buf,"r")) || (tf = fopen(buf,"a"))) {
+                       fclose(tf);
+                       opnerr(a->oerr,128,"open");
+                       }
 #else
-               if(!stat(buf,&stb))
+               if (!access(buf,0))
+                       opnerr(a->oerr,128,"open");
 #endif
-                       err(a->oerr,128,"open");
                /* no break */
        case 'r':       /* Fortran 90 replace option */
        case 'R':
+#ifdef NON_ANSI_STDIO
  replace:
-#ifdef NON_UNIX_STDIO
+#endif
                if (tf = fopen(buf,f__w_mode[0]))
                        fclose(tf);
-#else
-               (void) close(creat(buf, 0666));
-#endif
        }
 
        b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
-       if(b->ufnm==NULL) err(a->oerr,113,"no space");
+       if(b->ufnm==NULL) opnerr(a->oerr,113,"no space");
        (void) strcpy(b->ufnm,buf);
-       b->uend=0;
-       b->uwrt = 0;
-#ifdef NON_UNIX_STDIO
-       if ((s = a->oacc) && (*s == 'd' || *s == 'D'))
+       if ((s = a->oacc) && b->url)
                ufmt = 0;
-#endif
-       if(f__isdev(buf))
-       {       b->ufd = fopen(buf,f__r_mode[ufmt]);
-               if(b->ufd==NULL) err(a->oerr,errno,buf);
-       }
-       else {
-               if(!(b->ufd = fopen(buf, f__r_mode[ufmt]))) {
-#ifdef NON_UNIX_STDIO
-                       if (b->ufd = fopen(buf, f__w_mode[ufmt|2]))
-                               b->uwrt = 2;
-                       else if (b->ufd = fopen(buf, f__w_mode[ufmt]))
-                               b->uwrt = 1;
-                       else
-#else
-                       if ((n = open(buf,O_WRONLY)) >= 0)
-                               b->uwrt = 2;
-                       else {
-                               n = creat(buf, 0666);
-                               b->uwrt = 1;
-                               }
-                       if (n < 0
-                       || (b->ufd = fdopen(n, f__w_mode[ufmt])) == NULL)
-#endif
-                               err(a->oerr, errno, "open");
+       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;
                        }
-       }
-       b->useek=f__canseek(b->ufd);
+               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)
-               err(a->oerr,108,"open");
+       if((b->uinode = f__inode(buf,&b->udev)) == -1)
+               opnerr(a->oerr,108,"open");
 #endif
        if(b->useek)
                if (a->orl)
                        rewind(b->ufd);
                else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
                        && fseek(b->ufd, 0L, SEEK_END))
-                               err(a->oerr,129,"open");
+                               opnerr(a->oerr,129,"open");
        return(0);
 }
 #ifdef KR_headers
index 1c16545849468e014bb2c5681b503196f7637439..f3a59fdab4dc11e2fc4723e7f8103f6647127b38 100644 (file)
@@ -1,6 +1,4 @@
-#ifdef KR_headers
-extern FILE *fdopen();
-#else
+#ifndef KR_headers
 #if defined (MSDOS) && !defined (GO32)
 #include "io.h"
 #ifndef WATCOM
index 1bb10d9052dc650eb73cfe26043e552df0e09fa6..c7d891804b394a8119d255237656c2da51abf50d 100644 (file)
@@ -8,10 +8,6 @@ integer e_rsfe(Void)
 {      int n;
        f__init = 1;
        n=en_fio();
-       if (f__cf == stdout)
-               fflush(stdout);
-       else if (f__cf == stderr)
-               fflush(stderr);
        f__fmtbuf=NULL;
        return(n);
 }
@@ -30,15 +26,14 @@ c_sfe(cilist *a) /* check */
 }
 integer e_wsfe(Void)
 {
-#ifdef ALWAYS_FLUSH
        int n;
        f__init = 1;
        n = en_fio();
        f__fmtbuf=NULL;
-       if (!n && fflush(f__cf))
-               err(f__elist->cierr, errno, "write end");
        return n;
-#else
-       return(e_rsfe());
-#endif
+}
+
+integer e_wdfe(Void)
+{
+       return en_fio();
 }
index a24932533c13cc661d6ce5d244fda2aed7ec1f7d..ccaad2d3b6f2e0b6f757d7a6631096ef3fd72ec2 100644 (file)
@@ -1,4 +1,6 @@
 #ifndef NON_UNIX_STDIO
+#define _INCLUDE_POSIX_SOURCE  /* for HP-UX */
+#define _INCLUDE_XOPEN_SOURCE  /* for HP-UX */
 #include <sys/types.h>
 #include <sys/stat.h>
 #endif
index 4350fc984f61d4339ec46493825e677eec2eb9bb..477c40f5d3ba20f6aeafb9fdbea44ab625504bbd 100644 (file)
@@ -40,43 +40,23 @@ mv_cur(Void)        /* shouldn't use fseek because it insists on calling fflush */
                }
                return(0);
        }
-       if(cursor > 0) {
+       if (cursor > 0) {
                if(f__hiwater <= f__recpos)
                        for(;cursor>0;cursor--) (*f__putn)(' ');
                else if(f__hiwater <= f__recpos + cursor) {
-#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
-                       if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf))
-                               f__cf->_ptr += f__hiwater - f__recpos;
-                       else
-#endif
-                               (void) fseek(f__cf, (long) (f__hiwater - f__recpos), SEEK_CUR);
                        cursor -= f__hiwater - f__recpos;
                        f__recpos = f__hiwater;
                        for(; cursor > 0; cursor--)
                                (*f__putn)(' ');
                }
                else {
-#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
-                       if(f__cf->_ptr + cursor < buf_end(f__cf))
-                               f__cf->_ptr += cursor;
-                       else
-#endif
-                               (void) fseek(f__cf, (long)cursor, SEEK_CUR);
                        f__recpos += cursor;
                }
        }
-       if(cursor<0)
+       else if (cursor < 0)
        {
-               if(cursor+f__recpos<0) err(f__elist->cierr,110,"left off");
-#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
-               if(f__cf->_ptr + cursor >= f__cf->_base)
-                       f__cf->_ptr += cursor;
-               else
-#endif
-               if(f__curunit && f__curunit->useek)
-                       (void) fseek(f__cf,(long)cursor,SEEK_CUR);
-               else
-                       err(f__elist->cierr,106,"fmt");
+               if(cursor + f__recpos < 0)
+                       err(f__elist->cierr,110,"left off");
                if(f__hiwater < f__recpos)
                        f__hiwater = f__recpos;
                f__recpos += cursor;
index 5adb1a49f08ba55a2f4a18dbea1ca86de8783ac7..6cb4e50415847c64a2da98dbeac35a5078b4ae2b 100644 (file)
@@ -4,49 +4,38 @@
 #include "fmt.h"
 extern int f__hiwater;
 
-#ifdef KR_headers
-x_putc(c)
-#else
-x_putc(int c)
-#endif
-{
-       /* this uses \n as an indicator of record-end */
-       if(c == '\n' && f__recpos < f__hiwater) {       /* fseek calls fflush, a loss */
-#if ! defined (NON_UNIX_STDIO) && ! defined (MISSING_FILE_ELEMS)
-               if(f__cf->_ptr + f__hiwater - f__recpos < buf_end(f__cf))
-                       f__cf->_ptr += f__hiwater - f__recpos;
-               else
-#endif
-                       (void) fseek(f__cf, (long)(f__hiwater - f__recpos), SEEK_CUR);
-       }
-#ifdef OMIT_BLANK_CC
-       if (!f__recpos++ && c == ' ')
-               return c;
-#else
-       f__recpos++;
-#endif
-       return putc(c,f__cf);
-}
 x_wSL(Void)
 {
-       (*f__putn)('\n');
-       f__recpos=0;
-       f__cursor = 0;
-       f__hiwater = 0;
-       return(1);
+       int n = f__putbuf('\n');
+       f__hiwater = f__recpos = f__cursor = 0;
+       return(n == 0);
 }
+
+ static int
 xw_end(Void)
 {
-       if(f__nonl == 0)
-               (*f__putn)('\n');
+       int n;
+
+       if(f__nonl) {
+               f__putbuf(n = 0);
+               fflush(f__cf);
+               }
+       else
+               n = f__putbuf('\n');
        f__hiwater = f__recpos = f__cursor = 0;
-       return(0);
+       return n;
 }
+
+ static int
 xw_rev(Void)
 {
-       if(f__workdone) (*f__putn)('\n');
+       int n = 0;
+       if(f__workdone) {
+               n = f__putbuf('\n');
+               f__workdone = 0;
+               }
        f__hiwater = f__recpos = f__cursor = 0;
-       return(f__workdone=0);
+       return n;
 }
 
 #ifdef KR_headers
index d13f78f650b670b93a64a4f27e630cd3b93ba11b..f8555d79c45538d823052b20125d5395fceac992 100644 (file)
@@ -2,6 +2,7 @@
 #include "fio.h"
 #include "fmt.h"
 #include "lio.h"
+#include "string.h"
 
 #ifdef KR_headers
 integer s_wsle(a) cilist *a;
@@ -14,7 +15,7 @@ integer s_wsle(cilist *a)
        f__reading=0;
        f__external=1;
        f__formatted=1;
-       f__putn = t_putc;
+       f__putn = x_putc;
        f__lioproc = l_write;
        L_len = LINE;
        f__donewrec = x_wSL;
@@ -25,17 +26,13 @@ integer s_wsle(cilist *a)
 
 integer e_wsle(Void)
 {
+       int n;
        f__init = 1;
-       t_putc('\n');
+       n = f__putbuf('\n');
        f__recpos=0;
 #ifdef ALWAYS_FLUSH
-       if (fflush(f__cf))
+       if (!n && fflush(f__cf))
                err(f__elist->cierr, errno, "write end");
-#else
-       if (f__cf == stdout)
-               fflush(stdout);
-       else if (f__cf == stderr)
-               fflush(stderr);
 #endif
-       return(0);
+       return(n);
        }
index 0febd52634fd690eacb6c1ca9ee44206cb1445d9..ae3f8178949cfbf9da2e8453ffa34d7d446f59d5 100644 (file)
@@ -16,7 +16,7 @@ s_wsne(cilist *a)
        f__reading=0;
        f__external=1;
        f__formatted=1;
-       f__putn = t_putc;
+       f__putn = x_putc;
        L_len = LINE;
        f__donewrec = x_wSL;
        if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
index 99c58c9231369d92c24342e7b08d37151668622c..12b876cf29a3b03a80e223b4430a1819916bce52 100644 (file)
@@ -1,6 +1,6 @@
 static char junk[] = "\n@(#) LIBU77 VERSION 19970919\n";
 
-char __G77_LIBU77_VERSION__[] = "0.5.22";
+char __G77_LIBU77_VERSION__[] = "0.5.23-19980501";
 
 #include <stdio.h>
 
index e74898762e9aaa2136438d5864c2c66f5171bf67..c3785b4755d7c62bded605283ca5b1d9a19ea96a 100644 (file)
@@ -77,18 +77,17 @@ f2c/src     Source for the converter itself, including a file of checksums
                mailsize 200k
                send exec.c expr.c format.c format_data.c from f2c/src
 
-       If you have trouble generating gram.c, you can ask netlib to
-               send gram.c from f2c/src
-       Then `xsum gram.c` should report
-               gram.c  5529f4f 58745
-       Alternatively, if you have bison, you might get a working
-       gram.c by saying
-               make gram.c YACC=bison YFLAGS=-y
-       (but please do not complain if this gives a bad gram.c).
-
-NOTE:  For now, you may exercise f2c by sending netlib a message whose
-       first line is "execute f2c" and whose remaining lines are
-       the Fortran 77 source that you wish to have converted.
+       The makefile used to generate gram.c; now we distribute a
+       working gram.c, and you must say
+               make gram1.c
+               mv gram1.c gram.c
+       if you want to generate your own gram.c -- there are just too
+       many broken variants of yacc floating around nowadays for
+       generation of gram.c to be the default.
+
+NOTE:  You may exercise f2c by sending netlib@netlib.bell-labs.com
+       a message whose first line is "execute f2c" and whose remaining
+       lines are the Fortran 77 source that you wish to have converted.
        Return mail brings you the resulting C, with f2c's error
        messages between #ifdef uNdEfInEd and #endif at the end.
        (To understand line numbers in the error messages, regard
@@ -168,15 +167,22 @@ FTP:      All the material described above is now available by anonymous
                cd /netlib/f2c/src
                binary
                prompt
-               mget *.Z
+               mget *.gz
 
-       to get all the .Z files in src.  You must uncompress the .Z
+       to get all the .gz files in src.  You must uncompress the .gz
        files once you have a copy of them, e.g., by
 
-               uncompress *.Z
+               gzip -dN *.gz
+
+       You can also get the entire f2c tree as a tar file:
+
+               ftp://netlib.bell-labs.com/netlib/f2c.tar
+
+       (which is a synthetic file -- created on the fly and not visible
+       to ftp's "ls" or "dir" commands).
 
        Subdirectory msdos contains two PC versions of f2c,
-       f2c.exe.Z and f2cx.exe.Z; the latter uses extended memory.
+       f2c.exe.gz and f2cx.exe.gz; the latter uses extended memory.
        The README in that directory provides more details.
 
        Changes appear first in the f2c files available by E-mail
@@ -534,41 +540,96 @@ invisible on other machines.
 Sun Sep 21 22:05:19 EDT 1997
   libf77: [de]time_.c (Unix systems only): change return type to double.
 
+Thu Dec  4 22:10:09 EST 1997
+  Fix bug with handling large blocks of comments (over 4k); parts of the
+second and subsequent blocks were likely to be lost (not copied into
+comments in the resulting C).  Allow comment lines to be longer before
+breaking them.
+
+Mon Jan 19 17:19:27 EST 1998
+  makefile: change the rule for making gram.c to one for making gram1.c;
+henceforth, asking netlib to "send all from f2c/src" will bring you a
+working gram.c.  Nowadays there are simply too many broken versions of
+yacc floating around.
+  libi77: backspace.c: for b->ufmt==0, change sizeof(int) to
+sizeof(uiolen).  On machines where this would make a difference, it is
+best for portability to compile libI77 with -DUIOLEN_int, which will
+render the change invisible.
+
+Tue Feb 24 08:35:33 EST 1998
+  makefile: remove gram.c from the "make clean" rule.
+
+Wed Feb 25 08:29:39 EST 1998
+  makefile: change CFLAGS assignment to -O; add "veryclean" rule.
+
+Wed Mar  4 13:13:21 EST 1998
+  libi77: open.c: fix glitch in comparing file names under
+-DNON_UNIX_STDIO.
+
+Mon Mar  9 23:56:56 EST 1998
+  putpcc.c: omit an unnecessary temporary variable in computing
+(expr)**3.
+  libf77, libi77: minor tweaks to make some C++ compilers happy;
+Version.c not changed.
+
+Wed Mar 18 18:08:47 EST 1998
+  libf77: minor tweaks to [ed]time_.c; Version.c not changed.
+  libi77: endfile.c, open.c: acquire temporary files from tmpfile(),
+unless compiled with -DNON_ANSI_STDIO, which uses mktemp().
+New buffering scheme independent of NON_UNIX_STDIO for handling T
+format items.  Now -DNON_UNIX_STDIO is no longer be necessary for
+Linux, and libf2c no longer causes stderr to be buffered -- the former
+setbuf or setvbuf call for stderr was to make T format items work.
+open.c: use the Posix access() function to check existence or
+nonexistence of files, except under -DNON_POSIX_STDIO, where trial
+fopen calls are used.  In open.c, fix botch in changes of 19980304.
+  libf2c.zip: the PC makefiles are now set for NT/W95, with comments
+about changes for DOS.
+
+Fri Apr  3 17:22:12 EST 1998
+  Adjust fix of 19960913 to again permit substring notation on
+character variables in data statements.
+
+Sun Apr  5 19:26:50 EDT 1998
+  libi77: wsfe.c: make $ format item work: this was lost in the changes
+of 17 March 1998.
+
 Current timestamps of files in "all from f2c/src", sorted by time,
 appear below (mm/dd/year hh:mm:ss).  To bring your source up to date,
 obtain source files with a timestamp later than the time shown in your
 version.c.  Note that the time shown in the current version.c is the
 timestamp of the source module that immediately follows version.c below:
 
- 8/05/1997  14:51:56  xsum0.out
- 8/05/1997  14:42:48  version.c
+ 4/03/1998  17:20:55  xsum0.out
+ 4/03/1998  17:15:05  gram.c
+ 4/03/1998  17:15:05  version.c
+ 4/03/1998  17:14:59  gram.dcl
+ 3/09/1998   0:30:23  putpcc.c
+ 2/25/1998   8:18:04  makefile
+12/04/1997  17:44:11  format.c
+12/04/1997  17:44:11  niceprintf.c
+12/04/1997  17:14:05  lex.c
  8/05/1997  10:31:26  malloc.c
  7/24/1997  17:10:55  README
- 7/24/1997  17:00:57  makefile
  7/24/1997  16:06:19  Notice
  7/21/1997  12:58:44  proc.c
- 2/19/1997  13:34:09  lex.c
  2/11/1997  23:39:14  vax.c
 12/22/1996  11:51:22  output.c
 12/04/1996  13:07:53  gram.exec
-10/17/1996  13:10:40  putpcc.c
-10/01/1996  14:36:18  gram.dcl
-10/01/1996  14:36:18  init.c
 10/01/1996  14:36:18  defs.h
+10/01/1996  14:36:18  init.c
 10/01/1996  14:36:17  data.c
  9/17/1996  17:29:44  expr.c
  9/12/1996  12:12:46  equiv.c
  8/27/1996   8:30:32  intr.c
  8/26/1996   9:41:13  sysdep.c
- 7/09/1996  10:41:13  format.c
  7/09/1996  10:40:45  names.c
  7/04/1996   9:58:31  formatdata.c
  7/04/1996   9:55:45  sysdep.h
  7/04/1996   9:55:43  put.c
  7/04/1996   9:55:41  pread.c
- 7/04/1996   9:55:40  parse_args.c
  7/04/1996   9:55:40  p1output.c
- 7/04/1996   9:55:38  niceprintf.c
+ 7/04/1996   9:55:40  parse_args.c
  7/04/1996   9:55:37  misc.c
  7/04/1996   9:55:36  memset.c
  7/04/1996   9:55:36  mem.c