backspace.c, [...]: Update to Netlib version of 1998-06-18.

1998-06-23  Dave Love  <d.love@dl.ac.uk>
* libI77/backspace.c, libI77/dfe.c, libI77/due.c, libI77/iio.c,
libI77/lread.c, libI77/ sfe.c, libI77/sue.c, libI77/wsfe.c: Update
to Netlib version of 1998-06-18.

From-SVN: r20678

diff --git a/libf2c/changes.netlib b/libf2c/changes.netlib
index ac825279db43f9ffa3ade9680385a979a8424247..47d51d748e8d57018c423d928b729186a8c9fef5 100644 (file)
--- a/libf2c/changes.netlib
+++ b/libf2c/changes.netlib
@@ -2392,7 +2392,7 @@ Tue Aug  1 09:25:56 EDT 1995
   Permit real (or double precision) parameters in dimension expressions.
 
 Mon Aug  7 08:04:00 EDT 1995
-  Append "_eqv" rather than just "_" to names that appear in
+  Append "_eqv" rather than just "_" to names that that appear in
 EQUIVALENCE statements as well as structs in f2c.h (to avoid a
 conflict when these names also name common blocks).
 
@@ -2902,3 +2902,28 @@ 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.
+
+Sat May 16 19:08:51 EDT 1998
+  Adjust output of ftnlen constants: rather than appending L,
+prepend (ftnlen).  This should make the resulting C more portable,
+e.g., to systems (such as DEC Alpha Unix systems) on which long
+may be longer than ftnlen.
+  Adjust -r so it also casts REAL expressions passed to intrinsic
+functions to REAL.
+
+Wed May 27 16:02:35 EDT 1998
+  libf2c.zip: tweak description of compiling libf2c for INTEGER*8
+to accord with makefile.u rather than libF77/makefile.
+
+Thu May 28 22:45:59 EDT 1998
+  libi77: backspace.c dfe.c due.c iio.c lread.c rsfe.c sue.c wsfe.c:
+set f__curunit sooner so various error messages will correctly
+identify the I/O unit involved.
+  libf2c.zip: above, plus tweaks to PC makefiles: for some purposes,
+it's still best to compile with -DMSDOS (even for use with NT).
+
+Thu Jun 18 01:22:52 EDT 1998
+  libi77: lread.c: modified so floating-point numbers (containing
+either a decimal point or an exponent field) are treated as errors
+when they appear as list input for integer data.  Compile lread.c with
+-DALLOW_FLOAT_IN_INTEGER_LIST_INPUT to restore the old behavior.

diff --git a/libf2c/libI77/backspace.c b/libf2c/libI77/backspace.c
index 8456a7f8c6f1b39e30df332ff3ede1990b723c5c..1da686dbb488e94caab44d7b61eb4bcd98e96c97 100644 (file)
--- a/libf2c/libI77/backspace.c
+++ b/libf2c/libI77/backspace.c
@@ -11,11 +11,11 @@ integer f_back(alist *a)
        uiolen n;
        FILE *f;
 
+       f__curunit = b = &f__units[a->aunit];   /* curunit for error messages */
        if (f__init & 2)
                f__fatal (131, "I/O recursion");
        if(a->aunit >= MXUNIT || a->aunit < 0)
                err(a->aerr,101,"backspace");
-       f__curunit = b = &f__units[a->aunit];   /* curunit for error messages */
        if(b->useek==0) err(a->aerr,106,"backspace");
        if((f = b->ufd) == NULL) {
                fk_open(1, 1, a->aunit);

diff --git a/libf2c/libI77/dfe.c b/libf2c/libI77/dfe.c
index e4bd5652ce9e7c7db2bda2d5f78b650d60523e54..f8c1fc14675134db0ec644ee36997e86702f6880 100644 (file)
--- a/libf2c/libI77/dfe.c
+++ b/libf2c/libI77/dfe.c
@@ -70,9 +70,9 @@ c_dfe(cilist *a)
        f__formatted=f__external=1;
        f__elist=a;
        f__cursor=f__scale=f__recpos=0;
+       f__curunit = &f__units[a->ciunit];
        if(a->ciunit>MXUNIT || a->ciunit<0)
                err(a->cierr,101,"startchk");
-       f__curunit = &f__units[a->ciunit];
        if(f__curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit))
                err(a->cierr,104,"dfe");
        f__cf=f__curunit->ufd;

diff --git a/libf2c/libI77/due.c b/libf2c/libI77/due.c
index 9e28eb96bda82a54d3314e4148677431c3747052..cb80a39b44d1e1fda8a101028b648bcc0c9c0d9f 100644 (file)
--- a/libf2c/libI77/due.c
+++ b/libf2c/libI77/due.c
@@ -14,6 +14,8 @@ c_due(cilist *a)
        f__sequential=f__formatted=f__recpos=0;
        f__external=1;
        f__curunit = &f__units[a->ciunit];
+       if(a->ciunit>=MXUNIT || a->ciunit<0)
+               err(a->cierr,101,"startio");
        f__elist=a;
        if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due");
        f__cf=f__curunit->ufd;

diff --git a/libf2c/libI77/iio.c b/libf2c/libI77/iio.c
index d56a352dd8cf34b0be8d63c2717ece6b741e109d..931f15aab6310c2b683e677590784eb2055c5bb7 100644 (file)
--- a/libf2c/libI77/iio.c
+++ b/libf2c/libI77/iio.c
@@ -52,11 +52,12 @@ c_si(icilist *a)
        f__init |= 2;
        f__elist = (cilist *)a;
        f__fmtbuf=a->icifmt;
+       f__curunit = 0;
+       f__sequential=f__formatted=1;
+       f__external=0;
        if(pars_f(f__fmtbuf)<0)
                err(a->icierr,100,"startint");
        fmt_bg();
-       f__sequential=f__formatted=1;
-       f__external=0;
        f__cblank=f__cplus=f__scale=0;
        f__svic=a;
        f__icnum=f__recpos=0;
@@ -64,7 +65,6 @@ c_si(icilist *a)
        f__hiwater = 0;
        f__icptr = a->iciunit;
        f__icend = f__icptr + a->icirlen*a->icirnum;
-       f__curunit = 0;
        f__cf = 0;
        return(0);
 }

diff --git a/libf2c/libI77/lread.c b/libf2c/libI77/lread.c
index c5b922fbfb6744a96ba30e1f8d55c73f023c2f81..24b621db15ba97c2eb0342873acfc7bac3c9b1fa 100644 (file)
--- a/libf2c/libI77/lread.c
+++ b/libf2c/libI77/lread.c
@@ -105,10 +105,11 @@ double f__lx,f__ly;
 #define GETC(x) (x=(*l_getc)())
 #define Ungetc(x,y) (*l_ungetc)(x,y)
 
+ static int
 #ifdef KR_headers
-l_R(poststar) int poststar;
+l_R(poststar, reqint) int poststar, reqint;
 #else
-l_R(int poststar)
+l_R(int poststar, int reqint)
 #endif
 {
        char s[FMAX+EXPMAXDIGS+4];
@@ -157,6 +158,10 @@ retry:
                goto retry;
                }
        if (ch == '.') {
+#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
+               if (reqint)
+                       errfl(f__elist->cierr,115,"invalid integer");
+#endif
                GETC(ch);
                if (sp == sp1)
                        while(ch == '0') {
@@ -175,6 +180,10 @@ retry:
        if (issign(ch))
                goto signonly;
        if (havenum && isexp(ch)) {
+#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
+               if (reqint)
+                       errfl(f__elist->cierr,115,"invalid integer");
+#endif
                GETC(ch);
                if (issign(ch)) {
 signonly:
@@ -208,7 +217,7 @@ bad:
                        sp[1] = 0;
                f__lx = atof(s);
 #ifdef Allow_TYQUAD
-               if (quad_read && (se = sp - sp1 + exp) > 14 && se < 20) {
+               if (reqint&2 && (se = sp - sp1 + exp) > 14 && se < 20) {
                        /* Assuming 64-bit longint and 32-bit long. */
                        if (exp < 0)
                                sp += exp;
@@ -263,6 +272,7 @@ rd_count(register int ch)
        return f__lcount <= 0;
        }
 
+ static int
 l_C(Void)
 {      int ch, nml_save;
        double lz;
@@ -299,7 +309,7 @@ l_C(Void)
        Ungetc(ch,f__cf);
        nml_save = nml_read;
        nml_read = 0;
-       if (ch = l_R(1))
+       if (ch = l_R(1,0))
                return ch;
        if (!f__ltype)
                errfl(f__elist->cierr,112,"no real part");
@@ -311,7 +321,7 @@ l_C(Void)
        }
        while(iswhit(GETC(ch)));
        (void) Ungetc(ch,f__cf);
-       if (ch = l_R(1))
+       if (ch = l_R(1,0))
                return ch;
        if (!f__ltype)
                errfl(f__elist->cierr,112,"no imaginary part");
@@ -325,6 +335,8 @@ l_C(Void)
        nml_read = nml_save;
        return(0);
 }
+
+ static int
 l_L(Void)
 {
        int ch;
@@ -370,7 +382,10 @@ l_L(Void)
        (void) Ungetc(ch, f__cf);
        return(0);
 }
+
 #define BUFSIZE        128
+
+ static int
 l_CHAR(Void)
 {      int ch,size,i;
        static char rafail[] = "realloc failure";
@@ -519,12 +534,12 @@ c_le(cilist *a)
        if(f__init != 1) f_init();
        f__init = 3;
        f__fmtbuf="list io";
+       f__curunit = &f__units[a->ciunit];
        f__fmtlen=7;
        if(a->ciunit>=MXUNIT || a->ciunit<0)
                err(a->cierr,101,"stler");
        f__scale=f__recpos=0;
        f__elist=a;
-       f__curunit = &f__units[a->ciunit];
        if(f__curunit->ufd==NULL && fk_open(SEQ,FMT,a->ciunit))
                err(a->cierr,102,"lio");
        f__cf=f__curunit->ufd;
@@ -575,16 +590,19 @@ l_read(ftnint *number, char *ptr, ftnlen len, ftnint type)
                case TYINT1:
                case TYSHORT:
                case TYLONG:
+#ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
+                       ERR(l_R(0,1));
+                       break;
+#endif
                case TYREAL:
                case TYDREAL:
-                       ERR(l_R(0));
+                       ERR(l_R(0,0));
                        break;
 #ifdef TYQUAD
                case TYQUAD:
-                       quad_read = 1;
-                       n = l_R(0);
-                       quad_read = 0;
-                       ERR(n);
+                       n = l_R(0,2);
+                       if (n)
+                               return n;
                        break;
 #endif
                case TYCOMPLEX:
@@ -667,10 +685,10 @@ integer s_rsle(cilist *a)
 {
        int n;
 
-       if(n=c_le(a)) return(n);
        f__reading=1;
        f__external=1;
        f__formatted=1;
+       if(n=c_le(a)) return(n);
        f__lioproc = l_read;
        f__lquit = 0;
        f__lcount = 0;

diff --git a/libf2c/libI77/rsfe.c b/libf2c/libI77/rsfe.c
index 02a9e6d4680a438763d23b22b366d230be8a80bb..666046246918df6490b5a29590bb49e2693bed67 100644 (file)
--- a/libf2c/libI77/rsfe.c
+++ b/libf2c/libI77/rsfe.c
@@ -51,16 +51,15 @@ integer s_rsfe(cilist *a) /* start */
 {      int n;
        if(f__init != 1) f_init();
        f__init = 3;
-       if(n=c_sfe(a)) return(n);
        f__reading=1;
        f__sequential=1;
        f__formatted=1;
        f__external=1;
+       if(n=c_sfe(a)) return(n);
        f__elist=a;
        f__cursor=f__recpos=0;
        f__scale=0;
        f__fmtbuf=a->cifmt;
-       f__curunit= &f__units[a->ciunit];
        f__cf=f__curunit->ufd;
        if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio");
        f__getn= x_getc;

diff --git a/libf2c/libI77/sue.c b/libf2c/libI77/sue.c
index 8f2ea314f306052366c3568c97090452c4da5c7f..eacb1d69b010dd92d6d357af6a9f54526ef4ec32 100644 (file)
--- a/libf2c/libI77/sue.c
+++ b/libf2c/libI77/sue.c
@@ -9,11 +9,11 @@ c_sue(a) cilist *a;
 c_sue(cilist *a)
 #endif
 {
-       if(a->ciunit >= MXUNIT || a->ciunit < 0)
-               err(a->cierr,101,"startio");
        f__external=f__sequential=1;
        f__formatted=0;
        f__curunit = &f__units[a->ciunit];
+       if(a->ciunit >= MXUNIT || a->ciunit < 0)
+               err(a->cierr,101,"startio");
        f__elist=a;
        if(f__curunit->ufd==NULL && fk_open(SEQ,UNF,a->ciunit))
                err(a->cierr,114,"sue");

diff --git a/libf2c/libI77/wsfe.c b/libf2c/libI77/wsfe.c
index 279fbf7e51b308d877cc287e4c8fb2a90afd2e75..b55b1429ee70df38951dbfd276cd66ebf07c6e43 100644 (file)
--- a/libf2c/libI77/wsfe.c
+++ b/libf2c/libI77/wsfe.c
@@ -47,17 +47,16 @@ integer s_wsfe(cilist *a)   /*start*/
 {      int n;
        if(f__init != 1) f_init();
        f__init = 3;
-       if(n=c_sfe(a)) return(n);
        f__reading=0;
        f__sequential=1;
        f__formatted=1;
        f__external=1;
+       if(n=c_sfe(a)) return(n);
        f__elist=a;
        f__hiwater = f__cursor=f__recpos=0;
        f__nonl = 0;
        f__scale=0;
        f__fmtbuf=a->cifmt;
-       f__curunit = &f__units[a->ciunit];
        f__cf=f__curunit->ufd;
        if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio");
        f__putn= x_putc;