aboutsummaryrefslogtreecommitdiff
path: root/libf2c
diff options
context:
space:
mode:
authorCraig Burley <burley@gnu.org>1998-05-19 06:52:03 -0400
committerDave Love <fx@gcc.gnu.org>1998-05-19 10:52:03 +0000
commita843efa0d4ff93324077fbd8b1fc57ed8f4b57f0 (patch)
treec4e8e02849cc5a16fa5bc00db65b9b2aa8561eaf /libf2c
parentdeec641e31ba6af1cf67f72546486d5b8c37ee69 (diff)
downloadgcc-a843efa0d4ff93324077fbd8b1fc57ed8f4b57f0.zip
gcc-a843efa0d4ff93324077fbd8b1fc57ed8f4b57f0.tar.gz
gcc-a843efa0d4ff93324077fbd8b1fc57ed8f4b57f0.tar.bz2
Update to Netlib version of 1998-04-20
From-SVN: r19877
Diffstat (limited to 'libf2c')
-rw-r--r--libf2c/ChangeLog14
-rw-r--r--libf2c/changes.netlib54
-rw-r--r--libf2c/libF77/Version.c2
-rw-r--r--libf2c/libF77/dtime_.c2
-rw-r--r--libf2c/libF77/etime_.c2
-rw-r--r--libf2c/libF77/h_dnnt.c3
-rw-r--r--libf2c/libF77/h_nint.c3
-rw-r--r--libf2c/libF77/i_dnnt.c3
-rw-r--r--libf2c/libF77/i_nint.c3
-rw-r--r--libf2c/libF77/main.c18
-rw-r--r--libf2c/libF77/s_paus.c6
-rw-r--r--libf2c/libF77/signal1.h012
-rw-r--r--libf2c/libI77/Version.c22
-rw-r--r--libf2c/libI77/backspace.c90
-rw-r--r--libf2c/libI77/close.c9
-rw-r--r--libf2c/libI77/dfe.c48
-rw-r--r--libf2c/libI77/endfile.c114
-rw-r--r--libf2c/libI77/err.c78
-rw-r--r--libf2c/libI77/fio.h13
-rw-r--r--libf2c/libI77/iio.c22
-rw-r--r--libf2c/libI77/ilnw.c6
-rw-r--r--libf2c/libI77/lread.c2
-rw-r--r--libf2c/libI77/lwrite.c16
-rw-r--r--libf2c/libI77/open.c224
-rw-r--r--libf2c/libI77/rawio.h4
-rw-r--r--libf2c/libI77/sfe.c15
-rw-r--r--libf2c/libI77/util.c2
-rw-r--r--libf2c/libI77/wrtfmt.c28
-rw-r--r--libf2c/libI77/wsfe.c55
-rw-r--r--libf2c/libI77/wsle.c15
-rw-r--r--libf2c/libI77/wsne.c2
-rw-r--r--libf2c/libU77/Version.c2
-rw-r--r--libf2c/readme.netlib113
33 files changed, 527 insertions, 475 deletions
diff --git a/libf2c/ChangeLog b/libf2c/ChangeLog
index 0159343..1a1dd5a 100644
--- a/libf2c/ChangeLog
+++ b/libf2c/ChangeLog
@@ -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
diff --git a/libf2c/changes.netlib b/libf2c/changes.netlib
index 625999d..ac82527 100644
--- a/libf2c/changes.netlib
+++ b/libf2c/changes.netlib
@@ -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.
diff --git a/libf2c/libF77/Version.c b/libf2c/libF77/Version.c
index 4f7df49..2460a81 100644
--- a/libf2c/libF77/Version.c
+++ b/libf2c/libF77/Version.c
@@ -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.
diff --git a/libf2c/libF77/dtime_.c b/libf2c/libF77/dtime_.c
index 79b6735..95db94f 100644
--- a/libf2c/libF77/dtime_.c
+++ b/libf2c/libF77/dtime_.c
@@ -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
diff --git a/libf2c/libF77/etime_.c b/libf2c/libF77/etime_.c
index 04528b5..7ed3fce 100644
--- a/libf2c/libF77/etime_.c
+++ b/libf2c/libF77/etime_.c
@@ -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
diff --git a/libf2c/libF77/h_dnnt.c b/libf2c/libF77/h_dnnt.c
index 9d0aa25..005ac6f 100644
--- a/libf2c/libF77/h_dnnt.c
+++ b/libf2c/libF77/h_dnnt.c
@@ -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));
}
diff --git a/libf2c/libF77/h_nint.c b/libf2c/libF77/h_nint.c
index 0af3735..6b8dc29 100644
--- a/libf2c/libF77/h_nint.c
+++ b/libf2c/libF77/h_nint.c
@@ -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));
}
diff --git a/libf2c/libF77/i_dnnt.c b/libf2c/libF77/i_dnnt.c
index 8fcecb6..4ede56a 100644
--- a/libf2c/libF77/i_dnnt.c
+++ b/libf2c/libF77/i_dnnt.c
@@ -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));
}
diff --git a/libf2c/libF77/i_nint.c b/libf2c/libF77/i_nint.c
index c0f6795..411ce32 100644
--- a/libf2c/libF77/i_nint.c
+++ b/libf2c/libF77/i_nint.c
@@ -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));
}
diff --git a/libf2c/libF77/main.c b/libf2c/libF77/main.c
index 469a64b..343d7bd 100644
--- a/libf2c/libF77/main.c
+++ b/libf2c/libF77/main.c
@@ -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
diff --git a/libf2c/libF77/s_paus.c b/libf2c/libF77/s_paus.c
index ee2a0ee..a7733a5 100644
--- a/libf2c/libF77/s_paus.c
+++ b/libf2c/libF77/s_paus.c
@@ -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;
}
diff --git a/libf2c/libF77/signal1.h0 b/libf2c/libF77/signal1.h0
index 8800a18..662cae4 100644
--- a/libf2c/libF77/signal1.h0
+++ b/libf2c/libF77/signal1.h0
@@ -12,8 +12,12 @@
#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
diff --git a/libf2c/libI77/Version.c b/libf2c/libI77/Version.c
index 6fdf19e..0cdeb88 100644
--- a/libf2c/libI77/Version.c
+++ b/libf2c/libI77/Version.c
@@ -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. */
diff --git a/libf2c/libI77/backspace.c b/libf2c/libI77/backspace.c
index b806d1e..8456a7f 100644
--- a/libf2c/libI77/backspace.c
+++ b/libf2c/libI77/backspace.c
@@ -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;
}
diff --git a/libf2c/libI77/close.c b/libf2c/libI77/close.c
index 5c3af4c..bbc5bac 100644
--- a/libf2c/libI77/close.c
+++ b/libf2c/libI77/close.c
@@ -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);
}
diff --git a/libf2c/libI77/dfe.c b/libf2c/libI77/dfe.c
index e229e0e..3a93659 100644
--- a/libf2c/libI77/dfe.c
+++ b/libf2c/libI77/dfe.c
@@ -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();
-}
diff --git a/libf2c/libI77/endfile.c b/libf2c/libI77/endfile.c
index 6050d1e..0b785a9 100644
--- a/libf2c/libI77/endfile.c
+++ b/libf2c/libI77/endfile.c
@@ -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;
diff --git a/libf2c/libI77/err.c b/libf2c/libI77/err.c
index cb40630..56d82ac 100644
--- a/libf2c/libI77/err.c
+++ b/libf2c/libI77/err.c
@@ -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
diff --git a/libf2c/libI77/fio.h b/libf2c/libI77/fio.h
index e9e3b39..846351d 100644
--- a/libf2c/libI77/fio.h
+++ b/libf2c/libI77/fio.h
@@ -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
diff --git a/libf2c/libI77/iio.c b/libf2c/libI77/iio.c
index 22eae3f..d56a352 100644
--- a/libf2c/libI77/iio.c
+++ b/libf2c/libI77/iio.c
@@ -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;
}
diff --git a/libf2c/libI77/ilnw.c b/libf2c/libI77/ilnw.c
index 08ea2be..abc6409 100644
--- a/libf2c/libI77/ilnw.c
+++ b/libf2c/libI77/ilnw.c
@@ -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
diff --git a/libf2c/libI77/lread.c b/libf2c/libI77/lread.c
index 4fb14ee..c5b922f 100644
--- a/libf2c/libI77/lread.c
+++ b/libf2c/libI77/lread.c
@@ -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:
diff --git a/libf2c/libI77/lwrite.c b/libf2c/libI77/lwrite.c
index 5da7dfb..bf209f4 100644
--- a/libf2c/libI77/lwrite.c
+++ b/libf2c/libI77/lwrite.c
@@ -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);
}
diff --git a/libf2c/libI77/open.c b/libf2c/libI77/open.c
index d7e8491..29b7662 100644
--- a/libf2c/libI77/open.c
+++ b/libf2c/libI77/open.c
@@ -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
diff --git a/libf2c/libI77/rawio.h b/libf2c/libI77/rawio.h
index 1c16545..f3a59fd 100644
--- a/libf2c/libI77/rawio.h
+++ b/libf2c/libI77/rawio.h
@@ -1,6 +1,4 @@
-#ifdef KR_headers
-extern FILE *fdopen();
-#else
+#ifndef KR_headers
#if defined (MSDOS) && !defined (GO32)
#include "io.h"
#ifndef WATCOM
diff --git a/libf2c/libI77/sfe.c b/libf2c/libI77/sfe.c
index 1bb10d9..c7d8918 100644
--- a/libf2c/libI77/sfe.c
+++ b/libf2c/libI77/sfe.c
@@ -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();
}
diff --git a/libf2c/libI77/util.c b/libf2c/libI77/util.c
index a249325..ccaad2d 100644
--- a/libf2c/libI77/util.c
+++ b/libf2c/libI77/util.c
@@ -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
diff --git a/libf2c/libI77/wrtfmt.c b/libf2c/libI77/wrtfmt.c
index 4350fc9..477c40f 100644
--- a/libf2c/libI77/wrtfmt.c
+++ b/libf2c/libI77/wrtfmt.c
@@ -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;
diff --git a/libf2c/libI77/wsfe.c b/libf2c/libI77/wsfe.c
index 5adb1a4..6cb4e50 100644
--- a/libf2c/libI77/wsfe.c
+++ b/libf2c/libI77/wsfe.c
@@ -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
diff --git a/libf2c/libI77/wsle.c b/libf2c/libI77/wsle.c
index d13f78f..f8555d7 100644
--- a/libf2c/libI77/wsle.c
+++ b/libf2c/libI77/wsle.c
@@ -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);
}
diff --git a/libf2c/libI77/wsne.c b/libf2c/libI77/wsne.c
index 0febd52..ae3f817 100644
--- a/libf2c/libI77/wsne.c
+++ b/libf2c/libI77/wsne.c
@@ -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))
diff --git a/libf2c/libU77/Version.c b/libf2c/libU77/Version.c
index 99c58c9..12b876c 100644
--- a/libf2c/libU77/Version.c
+++ b/libf2c/libU77/Version.c
@@ -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>
diff --git a/libf2c/readme.netlib b/libf2c/readme.netlib
index e748987..c3785b4 100644
--- a/libf2c/readme.netlib
+++ b/libf2c/readme.netlib
@@ -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