From cfda1648f59667a07edd3309613b709e2d9edced Mon Sep 17 00:00:00 2001 From: fx Date: Tue, 23 Jun 1998 14:37:15 +0000 Subject: [PATCH] 1998-06-23 Dave Love * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@20678 138bc75d-0d04-0410-961f-82ee72b054a4 --- libf2c/changes.netlib | 27 ++++++++++++++++++++++++++- libf2c/libI77/backspace.c | 2 +- libf2c/libI77/dfe.c | 2 +- libf2c/libI77/due.c | 2 ++ libf2c/libI77/iio.c | 6 +++--- libf2c/libI77/lread.c | 42 ++++++++++++++++++++++++++++++------------ libf2c/libI77/rsfe.c | 3 +-- libf2c/libI77/sue.c | 4 ++-- libf2c/libI77/wsfe.c | 3 +-- 9 files changed, 67 insertions(+), 24 deletions(-) diff --git a/libf2c/changes.netlib b/libf2c/changes.netlib index ac82527..47d51d7 100644 --- 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 8456a7f..1da686d 100644 --- 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 e4bd565..f8c1fc1 100644 --- 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 9e28eb9..cb80a39 100644 --- 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 d56a352..931f15a 100644 --- 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 c5b922f..24b621d 100644 --- 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 02a9e6d..6660462 100644 --- 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 8f2ea31..eacb1d6 100644 --- 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 279fbf7..b55b142 100644 --- 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; -- 2.7.4