diff options
author | jmz <jmz@FreeBSD.org> | 1995-09-28 20:49:15 +0000 |
---|---|---|
committer | jmz <jmz@FreeBSD.org> | 1995-09-28 20:49:15 +0000 |
commit | 88fe667d3502c54a9143eea7b611ec0362bb639c (patch) | |
tree | 2bd4eef14755fc92c0ed2b2ea8abefe3c3081747 /lib/libI77 | |
parent | 3ebc2913631c7b53207cac9503f0a0141f628900 (diff) | |
download | FreeBSD-src-88fe667d3502c54a9143eea7b611ec0362bb639c.zip FreeBSD-src-88fe667d3502c54a9143eea7b611ec0362bb639c.tar.gz |
Update to the 1995/09/20 version. Previous version was 1993/12/17.
Diffstat (limited to 'lib/libI77')
-rw-r--r-- | lib/libI77/Notice | 2 | ||||
-rw-r--r-- | lib/libI77/README | 16 | ||||
-rw-r--r-- | lib/libI77/Version.c | 26 | ||||
-rw-r--r-- | lib/libI77/backspace.c | 20 | ||||
-rw-r--r-- | lib/libI77/dfe.c | 3 | ||||
-rw-r--r-- | lib/libI77/due.c | 4 | ||||
-rw-r--r-- | lib/libI77/fmt.h | 14 | ||||
-rw-r--r-- | lib/libI77/fmtlib.c | 47 | ||||
-rw-r--r-- | lib/libI77/iio.c | 6 | ||||
-rw-r--r-- | lib/libI77/libI77.xsum | 46 | ||||
-rw-r--r-- | lib/libI77/lio.h | 1 | ||||
-rw-r--r-- | lib/libI77/lread.c | 50 | ||||
-rw-r--r-- | lib/libI77/lwrite.c | 68 | ||||
-rw-r--r-- | lib/libI77/open.c | 2 | ||||
-rw-r--r-- | lib/libI77/rdfmt.c | 2 | ||||
-rw-r--r-- | lib/libI77/rsfe.c | 8 | ||||
-rw-r--r-- | lib/libI77/rsne.c | 47 | ||||
-rw-r--r-- | lib/libI77/sfe.c | 12 | ||||
-rw-r--r-- | lib/libI77/sue.c | 12 | ||||
-rw-r--r-- | lib/libI77/wref.c | 36 | ||||
-rw-r--r-- | lib/libI77/wrtfmt.c | 16 | ||||
-rw-r--r-- | lib/libI77/wsle.c | 6 | ||||
-rw-r--r-- | lib/libI77/wsne.c | 2 | ||||
-rw-r--r-- | lib/libI77/xwsne.c | 4 |
24 files changed, 348 insertions, 102 deletions
diff --git a/lib/libI77/Notice b/lib/libI77/Notice index b0dba28..9715a19 100644 --- a/lib/libI77/Notice +++ b/lib/libI77/Notice @@ -1,5 +1,5 @@ /**************************************************************** -Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore. +Copyright 1990 - 1995 by AT&T Bell Laboratories and Bellcore. Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby diff --git a/lib/libI77/README b/lib/libI77/README index 8b19130..6b0558d 100644 --- a/lib/libI77/README +++ b/lib/libI77/README @@ -147,6 +147,10 @@ and an attempt to skip input until the right namelist name is found; to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip. 3. Namelist writes now insert newlines before each variable; to omit this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines. + 4. (Sept. 1995) When looking for the &name that starts namelist +input, lines whose first non-blank character is something other +than &, $, or ? are treated as comment lines and ignored, unless +rsne.c is compiled with -DNo_Namelist_Comments. Nonstandard extension (Feb. 1993) to open: for sequential files, ACCESS='APPEND' (or access='anything else starting with "A" or "a"') @@ -164,6 +168,12 @@ others and thus give no help in finding the bug of reading more than was written. If you wish to have this behavior, compile uio.c with -DPad_UDread . +If you want to be able to catch write failures (e.g., due to a +disk being full) with an ERR= specifier, compile dfe.c, due.c, +sfe.c, sue.c, and wsle.c with -DALWAYS_FLUSH. This will lead to +slower execution and more I/O, but should make ERR= work as +expected, provided fflush returns an error return when its +physical write fails. Carriage controls are meant to be interpreted by the UNIX col program (or a similar program). Sometimes it's convenient to use @@ -172,3 +182,9 @@ If you compile lwrite.c and wsfe.c with -DOMIT_BLANK_CC, formatted external output lines will have an initial ' ' quietly omitted, making use of the col program unnecessary with output that only has ' ' for carriage control. + +The Fortran 77 Standard leaves it up to the implementation whether +formatted writes of floating-point numbers of absolute value < 1 have +a zero before the decimal point. By default, libI77 omits such +superfluous zeros, but you can cause them to appear by compiling +lwrite.c, wref.c, and wrtfmt.c with -DWANT_LEAD_0 . diff --git a/lib/libI77/Version.c b/lib/libI77/Version.c index 3958b77..ebd3f0b 100644 --- a/lib/libI77/Version.c +++ b/lib/libI77/Version.c @@ -1,4 +1,4 @@ -static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 6 Octt. 1994\n"; +static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19950907\n"; /* 2.01 $ format added @@ -198,3 +198,27 @@ wrtfmt.c: INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8 in NAMELISTs. */ /* 6 Oct. 1994: util.c: omit f__mvgbt, as it is never used. */ +/* 2 Nov. 1994: add #ifdef ALWAYS_FLUSH logic. */ +/* 26 Jan. 1995: wref.c: fix glitch in printing the exponent of 0 when + GOOD_SPRINTF_EXPONENT is not #defined. */ +/* 24 Feb. 1995: iio.c: z_getc: insert (unsigned char *) to allow + internal reading of characters with high-bit set + (on machines that sign-extend characters). */ +/* 14 March 1995:lread.c and rsfe.c: adjust s_rsle and s_rsfe to + check for end-of-file (to prevent infinite loops + with empty read statements). */ +/* 26 May 1995: iio.c: z_wnew: fix bug in handling T format items + in internal writes whose last item is written to + an earlier position than some previous item. */ +/* 29 Aug. 1995: backspace.c: adjust MSDOS logic. */ +/* 6 Sept. 1995: Adjust namelist input to treat a subscripted name + whose subscripts do not involve colons similarly + to the name without a subscript: accept several + values, stored in successive elements starting at + the indicated subscript. Adjust namelist output + to quote character strings (avoiding confusion with + arrays of character strings). Adjust f_init calls + for people who don't use libF77's main(); now open and + namelist read statements invoke f_init if needed. */ +/* 7 Sept. 1995: Fix some bugs with -DAllow_TYQUAD (for integer*8). + Add -DNo_Namelist_Comments lines to rsne.c. */ diff --git a/lib/libI77/backspace.c b/lib/libI77/backspace.c index 4213424..3771cd9 100644 --- a/lib/libI77/backspace.c +++ b/lib/libI77/backspace.c @@ -50,14 +50,16 @@ integer f_back(alist *a) #ifdef MSDOS w = -1; #endif - for(ndec = 2;; ndec = 1) + for(ndec = 1;; ndec = 0) { - y = x=ftell(b->ufd); - if(x<sizeof(buf)) x=0; - else x -= sizeof(buf); + 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,(int)(y-x), b->ufd); - for(i=n-ndec;i>=0;i--) + for(i = n - ndec; --i >= 0; ) { if(buf[i]!='\n') continue; #ifdef MSDOS @@ -65,17 +67,17 @@ integer f_back(alist *a) if (buf[j] == '\n') k++; fseek(b->ufd,x,SEEK_SET); - do { + for(;;) if (getc(b->ufd) == '\n') { - --k; - if ((z = ftell(b->ufd)) >= y) { + if ((z = ftell(b->ufd)) >= y && ndec) { if (w == -1) goto break2; break; } + if (--k <= 0) + return 0; w = z; } - } while(k > 0); fseek(b->ufd, w, SEEK_SET); #else fseek(b->ufd,(long)(i+1-n),SEEK_CUR); diff --git a/lib/libI77/dfe.c b/lib/libI77/dfe.c index 669c3bd..86fbe8e 100644 --- a/lib/libI77/dfe.c +++ b/lib/libI77/dfe.c @@ -152,6 +152,5 @@ integer e_rdfe(Void) } integer e_wdfe(Void) { - (void) en_fio(); - return(0); + return en_fio(); } diff --git a/lib/libI77/due.c b/lib/libI77/due.c index 33ee02c..d5ade7a 100644 --- a/lib/libI77/due.c +++ b/lib/libI77/due.c @@ -60,5 +60,9 @@ integer e_rdue(Void) } integer e_wdue(Void) { +#ifdef ALWAYS_FLUSH + if (fflush(f__cf)) + err(f__elist->cierr,errno,"write end"); +#endif return(e_rdue()); } diff --git a/lib/libI77/fmt.h b/lib/libI77/fmt.h index d4810a1..e94bc1c 100644 --- a/lib/libI77/fmt.h +++ b/lib/libI77/fmt.h @@ -80,3 +80,17 @@ extern int f__scale; #define VAL(x) (x!='\n'?x:' ') #define PUT(x) (*f__putn)(x) extern int f__cursor; + +#undef TYQUAD +#ifndef Allow_TYQUAD +#undef longint +#define longint long +#else +#define TYQUAD 14 +#endif + +#ifdef KR_headers +extern char *f__icvt(); +#else +extern char *f__icvt(longint, int*, int*, int); +#endif diff --git a/lib/libI77/fmtlib.c b/lib/libI77/fmtlib.c index 37a4cc5..1c6801e 100644 --- a/lib/libI77/fmtlib.c +++ b/lib/libI77/fmtlib.c @@ -1,28 +1,39 @@ /* @(#)fmtlib.c 1.2 */ #define MAXINTLENGTH 23 + +#include "f2c.h" +#ifndef Allow_TYQUAD +#undef longint +#define longint long +#endif + #ifdef KR_headers -char *f__icvt(value,ndigit,sign, base) long value; int *ndigit,*sign; +char *f__icvt(value,ndigit,sign, base) longint value; int *ndigit,*sign; register int base; #else -char *f__icvt(long value, int *ndigit, int *sign, int base) +char *f__icvt(longint value, int *ndigit, int *sign, int base) #endif { static char buf[MAXINTLENGTH+1]; register int i; - if(value>0) *sign=0; - else if(value<0) - { value = -value; - *sign= 1; - } - else - { *sign=0; - *ndigit=1; - buf[MAXINTLENGTH]='0'; - return(&buf[MAXINTLENGTH]); - } - for(i=MAXINTLENGTH-1;value>0;i--) - { *(buf+i)=(int)(value%base)+'0'; + + if(value > 0) + *sign = 0; + else if (value < 0) { + value = -value; + *sign = 1; + } + else { + *sign = 0; + *ndigit = 1; + buf[MAXINTLENGTH-1] = '0'; + return &buf[MAXINTLENGTH-1]; + } + i = MAXINTLENGTH; + do { + buf[--i] = (value%base) + '0'; value /= base; + } + while(value > 0); + *ndigit = MAXINTLENGTH - i; + return &buf[i]; } - *ndigit=MAXINTLENGTH-1-i; - return(&buf[i+1]); -} diff --git a/lib/libI77/iio.c b/lib/libI77/iio.c index b747826..4c8eb9d 100644 --- a/lib/libI77/iio.c +++ b/lib/libI77/iio.c @@ -10,7 +10,7 @@ z_getc(Void) { if(f__recpos++ < f__svic->icirlen) { if(f__icptr >= f__icend) err(f__svic->iciend,(EOF),"endfile"); - return(*f__icptr++); + return(*(unsigned char *)f__icptr++); } return '\n'; } @@ -95,6 +95,10 @@ integer s_rsfi(icilist *a) z_wnew(Void) { + if (f__recpos < f__hiwater) { + f__icptr += f__hiwater - f__recpos; + f__recpos = f__hiwater; + } while(f__recpos++ < f__svic->icirlen) *f__icptr++ = ' '; f__recpos = 0; diff --git a/lib/libI77/libI77.xsum b/lib/libI77/libI77.xsum index 00a8cb4..c93a190 100644 --- a/lib/libI77/libI77.xsum +++ b/lib/libI77/libI77.xsum @@ -1,41 +1,41 @@ -Notice 15a21790 1184 -README 16b752be 7685 -Version.c 11b93284 9820 -backspace.c 198946cc 1759 +Notice fd29c05f 1184 +README ef678ce5 8578 +Version.c 367e2b0 11141 +backspace.c e29c7ec1 1794 close.c 175acd02 1336 -dfe.c 3c6b216 2903 +dfe.c 16facc04 2891 dolio.c 17595b24 404 -due.c 1bbe319b 1430 +due.c f05f7fa6 1519 endfile.c 12d875dc 3400 err.c fccb27de 6084 f2ch.add fed3bb7b 6056 fio.h e7e8a21c 2315 fmt.c e37e7c2a 7857 -fmt.h 1273f9e8 1628 -fmtlib.c e010030f 582 +fmt.h 7686340 1835 +fmtlib.c f79c9df4 704 fp.h 100fb355 665 -iio.c e04c6615 2258 +iio.c fedbf0b5 2374 ilnw.c fa459169 1049 inquire.c e1059667 2536 -lio.h ffc2e000 1550 -lread.c e220dbce 11416 -lwrite.c 1a82fbe7 4183 +lio.h a087b39 1564 +lread.c 4dfc73b 12130 +lwrite.c 19137b45 4565 makefile e8266f12 1972 -open.c fd6dc333 4485 +open.c 1ef408ec 4512 rawio.h b9d538d 688 -rdfmt.c 1d49cf1d 8344 +rdfmt.c 55975ac 8347 rewind.c 87b080b 408 -rsfe.c c949b09 1299 +rsfe.c 1d79e4a1 1415 rsli.c 1259dfec 1748 -rsne.c ee3a2728 10686 -sfe.c f8a8b265 638 -sue.c ff73457b 1740 +rsne.c f2e2cad1 11466 +sfe.c 45a6968 793 +sue.c ec169681 1803 typesize.c e5660590 319 uio.c fe44d524 1547 util.c f17978be 824 -wref.c 1d4e4539 4108 -wrtfmt.c f41b0c38 8075 +wref.c fbed7e10 4507 +wrtfmt.c 7a73318 8090 wsfe.c 250d1ef 1658 -wsle.c 2f94457 611 -wsne.c fd7a0e2f 438 -xwsne.c 7ac1479 1080 +wsle.c f74ea563 684 +wsne.c ea4dac25 412 +xwsne.c 16641f3c 1135 diff --git a/lib/libI77/lio.h b/lib/libI77/lio.h index 5af9fc4..0123172 100644 --- a/lib/libI77/lio.h +++ b/lib/libI77/lio.h @@ -23,6 +23,7 @@ #define TYLOGICAL1 12 #define TYLOGICAL2 13 #ifdef Allow_TYQUAD +#undef TYQUAD #define TYQUAD 14 #endif diff --git a/lib/libI77/lread.c b/lib/libI77/lread.c index 2da52d8..c14fd5b 100644 --- a/lib/libI77/lread.c +++ b/lib/libI77/lread.c @@ -6,6 +6,12 @@ #include "fp.h" extern char *f__fmtbuf; + +#ifdef Allow_TYQUAD +static longint f__llx; +static int quad_read; +#endif + #ifdef KR_headers extern double atof(); extern char *malloc(), *realloc(); @@ -102,6 +108,9 @@ l_R(int poststar) return(0); f__lcount = 1; } +#ifdef Allow_TYQUAD + f__llx = 0; +#endif f__ltype = 0; exp = 0; havestar = 0; @@ -184,6 +193,22 @@ bad: else sp[1] = 0; f__lx = atof(s); +#ifdef Allow_TYQUAD + if (quad_read && (se = sp - sp1 + exp) > 14 && se < 20) { + /* Assuming 64-bit longint and 32-bit long. */ + if (exp < 0) + sp += exp; + if (sp1 <= sp) { + f__llx = *sp1 - '0'; + while(++sp1 <= sp) + f__llx = 10*f__llx + (*sp1 - '0'); + } + while(--exp >= 0) + f__llx *= 10; + if (*s == '-') + f__llx = -f__llx; + } +#endif } else f__lx = 0.; @@ -280,6 +305,9 @@ l_C(Void) if(ch!=')') errfl(f__elist->cierr,112,"no )"); f__ly = f__lx; f__lx = lz; +#ifdef Allow_TYQUAD + f__llx = 0; +#endif nml_read = nml_save; return(0); } @@ -456,6 +484,8 @@ c_le(a) cilist *a; c_le(cilist *a) #endif { + if(!f__init) + f_init(); f__fmtbuf="list io"; if(a->ciunit>=MXUNIT || a->ciunit<0) err(a->cierr,101,"stler"); @@ -512,13 +542,19 @@ l_read(ftnint *number, char *ptr, ftnlen len, ftnint type) case TYINT1: case TYSHORT: case TYLONG: -#ifdef TYQUAD - case TYQUAD: -#endif case TYREAL: case TYDREAL: ERR(l_R(0)); break; +#ifdef TYQUAD + case TYQUAD: + quad_read = 1; + n = l_R(0); + quad_read = 0; + if (n) + return n; + break; +#endif case TYCOMPLEX: case TYDCOMPLEX: ERR(l_C()); @@ -560,9 +596,10 @@ l_read(ftnint *number, char *ptr, ftnlen len, ftnint type) case TYLONG: Ptr->flint=f__lx; break; -#ifdef TYQUAD +#ifdef Allow_TYQUAD case TYQUAD: - Ptr->fllongint = f__lx; + if (!(Ptr->fllongint = f__llx)) + Ptr->fllongint = f__lx; break; #endif case TYREAL: @@ -602,7 +639,6 @@ integer s_rsle(cilist *a) { int n; - if(!f__init) f_init(); if(n=c_le(a)) return(n); f__reading=1; f__external=1; @@ -613,6 +649,8 @@ integer s_rsle(cilist *a) l_eof = 0; if(f__curunit->uwrt && f__nowreading(f__curunit)) err(a->cierr,errno,"read start"); + if(f__curunit->uend) + err(f__elist->ciend,(EOF),"read start"); l_getc = t_getc; l_ungetc = un_getc; f__doend = xrd_SL; diff --git a/lib/libI77/lwrite.c b/lib/libI77/lwrite.c index ca038cc..5da7dfb 100644 --- a/lib/libI77/lwrite.c +++ b/lib/libI77/lwrite.c @@ -2,7 +2,9 @@ #include "fio.h" #include "fmt.h" #include "lio.h" + ftnint L_len; +int f__Aquote; static VOID donewrec(Void) @@ -23,20 +25,22 @@ t_putc(int c) } static VOID #ifdef KR_headers -lwrt_I(n) long n; +lwrt_I(n) longint n; #else -lwrt_I(long n) +lwrt_I(longint n) #endif { - char buf[LINTW],*p; -#ifdef USE_STRLEN - (void) sprintf(buf," %ld",n); - if(f__recpos+strlen(buf)>=L_len) -#else - if(f__recpos + sprintf(buf," %ld",n) >= L_len) -#endif + char *p; + int ndigit, sign; + + p = f__icvt(n, &ndigit, &sign, 10); + if(f__recpos + ndigit >= L_len) donewrec(); - for(p=buf;*p;PUT(*p++)); + PUT(' '); + if (sign) + PUT('-'); + while(*p) + PUT(*p++); } static VOID #ifdef KR_headers @@ -56,14 +60,42 @@ lwrt_A(p,len) char *p; ftnlen len; lwrt_A(char *p, ftnlen len) #endif { - int i; - if(f__recpos+len>=L_len) + int a; + char *p1, *pe; + + a = 0; + pe = p + len; + if (f__Aquote) { + a = 3; + if (len > 1 && p[len-1] == ' ') { + while(--len > 1 && p[len-1] == ' '); + pe = p + len; + } + p1 = p; + while(p1 < pe) + if (*p1++ == '\'') + a++; + } + if(f__recpos+len+a >= L_len) donewrec(); + if (a #ifndef OMIT_BLANK_CC - if (!f__recpos) - PUT(' '); + || !f__recpos #endif - for(i=0;i<len;i++) PUT(*p++); + ) + PUT(' '); + if (a) { + PUT('\''); + while(p < pe) { + if (*p == '\'') + PUT('\''); + PUT(*p++); + } + PUT('\''); + } + else + while(p < pe) + PUT(*p++); } static int @@ -107,10 +139,12 @@ l_g(char *buf, double n) } sprintf(b, LGFMT, n); switch(*b) { +#ifndef WANT_LEAD_0 case '0': while(b[0] = b[1]) b++; break; +#endif case 'i': case 'I': /* Infinity */ @@ -213,7 +247,7 @@ l_write(ftnint *number, char *ptr, ftnlen len, ftnint type) { #define Ptr ((flex *)ptr) int i; - long x; + longint x; double y,z; real *xx; doublereal *yy; @@ -228,7 +262,7 @@ l_write(ftnint *number, char *ptr, ftnlen len, ftnint type) case TYSHORT: x=Ptr->flshort; goto xint; -#ifdef TYQUAD +#ifdef Allow_TYQUAD case TYQUAD: x = Ptr->fllongint; goto xint; diff --git a/lib/libI77/open.c b/lib/libI77/open.c index 15d887a..75386b9 100644 --- a/lib/libI77/open.c +++ b/lib/libI77/open.c @@ -83,6 +83,8 @@ integer f_open(olist *a) #endif if(a->ounit>=MXUNIT || a->ounit<0) err(a->oerr,101,"open") + if (!f__init) + f_init(); f__curunit = b = &f__units[a->ounit]; if(b->ufd) { if(a->ofnm==0) diff --git a/lib/libI77/rdfmt.c b/lib/libI77/rdfmt.c index 9fd8545..eef745b 100644 --- a/lib/libI77/rdfmt.c +++ b/lib/libI77/rdfmt.c @@ -97,7 +97,7 @@ rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base; #else rd_I(Uint *n, int w, ftnlen len, register int base) #endif -{ long x; +{ longint x; int sign,ch; char s[84], *ps; ps=s; x=0; diff --git a/lib/libI77/rsfe.c b/lib/libI77/rsfe.c index 5d29bee..5ff0a33 100644 --- a/lib/libI77/rsfe.c +++ b/lib/libI77/rsfe.c @@ -6,7 +6,11 @@ xrd_SL(Void) { int ch; if(!f__curunit->uend) - while((ch=getc(f__cf))!='\n' && ch!=EOF); + while((ch=getc(f__cf))!='\n') + if (ch == EOF) { + f__curunit->uend = 1; + break; + } f__cursor=f__recpos=0; return(1); } @@ -69,5 +73,7 @@ integer s_rsfe(cilist *a) /* start */ f__cplus=0; if(f__curunit->uwrt && f__nowreading(f__curunit)) err(a->cierr,errno,"read start"); + if(f__curunit->uend) + err(f__elist->ciend,(EOF),"read start"); return(0); } diff --git a/lib/libI77/rsne.c b/lib/libI77/rsne.c index 66a1c02..ad7ad26 100644 --- a/lib/libI77/rsne.c +++ b/lib/libI77/rsne.c @@ -31,6 +31,7 @@ static hashtab *nl_cache; static n_nlcache; static hashentry **zot; + static int colonseen; extern ftnlen f__typesize[]; extern flag f__lquit; @@ -247,6 +248,7 @@ getdimen(int *chp, dimen *d, ftnlen delta, ftnlen extent, ftnlen *x1) if (!x3) return 123; x2 /= x3; + colonseen = 1; } if (x2 < 0 || x2 >= extent) return 123; @@ -294,7 +296,7 @@ x_rsne(a) cilist *a; x_rsne(cilist *a) #endif { - int ch, got1, k, n, nd, quote; + int ch, got1, k, n, nd, quote, readall; Namelist *nl; static char where[] = "namelist read"; char buf[64]; @@ -316,6 +318,7 @@ x_rsne(cilist *a) top: for(;;) switch(GETC(ch)) { case EOF: + eof: err(a->ciend,(EOF),where0); case '&': case '$': @@ -328,7 +331,13 @@ x_rsne(cilist *a) default: if (ch <= ' ' && ch >= 0) continue; +#ifndef No_Namelist_Comments + while(GETC(ch) != '\n') + if (ch == EOF) + goto eof; +#else errfl(a->cierr, 115, where0); +#endif } have_amp: if (ch = getname(buf,sizeof(buf))) @@ -404,7 +413,7 @@ x_rsne(cilist *a) else size = f__typesize[type]; ivae = size; - iva = 0; + iva = readall = 0; if (ch == '(' /*)*/ ) { dn = dimens; if (!(dims = v->dims)) { @@ -426,6 +435,7 @@ x_rsne(cilist *a) nd = (int)dims[0]; nomax = span = dims[1]; ivae = iva + size*nomax; + colonseen = 0; if (k = getdimen(&ch, dn, size, nomax, &b)) errfl(a->cierr, k, where); no = dn->extent; @@ -447,6 +457,7 @@ x_rsne(cilist *a) } if (ch != ')') errfl(a->cierr, 115, where); + readall = 1 - colonseen; b -= b0; if (b < 0 || b >= nomax) errfl(a->cierr, 125, where); @@ -470,6 +481,8 @@ x_rsne(cilist *a) if (b1 < b0) goto delta_adj; } + if (readall) + goto delta_adj; for(; dn0 < dn; dn0++) { if (dn0->extent != *dims++ || dn0->stride != 1) break; @@ -513,8 +526,34 @@ x_rsne(cilist *a) return k; if (f__lquit == 1) return 0; + if (readall) { + iva += dn0->delta; + if (f__lcount > 0) { + no1 = (ivae - iva)/size; + if (no1 > f__lcount) + no1 = f__lcount; + iva += no1 * dn0->delta; + if (k = l_read(&no1, vaddr + iva, + size, type)) + return k; + } + } mustend: - if (GETC(ch) == '/' || ch == '$' || ch == '&') { + GETC(ch); + if (readall) + if (iva >= ivae) + readall = 0; + else for(;;) { + switch(ch) { + case ' ': + case '\t': + case '\n': + GETC(ch); + continue; + } + break; + } + if (ch == '/' || ch == '$' || ch == '&') { f__lquit = 1; return 0; } @@ -527,6 +566,8 @@ x_rsne(cilist *a) break; } Ungetc(ch,f__cf); + if (readall && !Alpha[ch & 0xff]) + goto readloop; if ((no -= no1) <= 0) break; for(dn1 = dn0; dn1 <= dn; dn1++) { diff --git a/lib/libI77/sfe.c b/lib/libI77/sfe.c index 6dea23a..eea9078 100644 --- a/lib/libI77/sfe.c +++ b/lib/libI77/sfe.c @@ -28,5 +28,15 @@ c_sfe(cilist *a) /* check */ return(0); } integer e_wsfe(Void) -{ return(e_rsfe()); +{ +#ifdef ALWAYS_FLUSH + int n; + 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 } diff --git a/lib/libI77/sue.c b/lib/libI77/sue.c index 21f30bf..b1b8bc3 100644 --- a/lib/libI77/sue.c +++ b/lib/libI77/sue.c @@ -65,11 +65,15 @@ integer s_wsue(cilist *a) } integer e_wsue(Void) { long loc; - (void) fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); + fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); +#ifdef ALWAYS_FLUSH + if (fflush(f__cf)) + err(f__elist->cierr, errno, "write end"); +#endif loc=ftell(f__cf); - (void) fseek(f__cf,f__recloc,SEEK_SET); - (void) fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); - (void) fseek(f__cf,loc,SEEK_SET); + fseek(f__cf,f__recloc,SEEK_SET); + fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf); + fseek(f__cf,loc,SEEK_SET); return(0); } integer e_rsue(Void) diff --git a/lib/libI77/wref.c b/lib/libI77/wref.c index 1ef2c47..eda9a8f 100644 --- a/lib/libI77/wref.c +++ b/lib/libI77/wref.c @@ -23,6 +23,9 @@ wrt_E(ufloat *p, int w, int d, int e, ftnlen len) char buf[FMAX+EXPMAXDIGS+4], *s, *se; int d1, delta, e1, i, sign, signspace; double dd; +#ifdef WANT_LEAD_0 + int insert0 = 0; +#endif #ifndef VAX int e0 = e; #endif @@ -53,6 +56,13 @@ wrt_E(ufloat *p, int w, int d, int e, ftnlen len) } delta = w - (2 /* for the . and the d adjustment above */ + 2 /* for the E+ */ + signspace + d + e); +#ifdef WANT_LEAD_0 + if (f__scale <= 0 && delta > 0) { + delta--; + insert0 = 1; + } + else +#endif if (delta < 0) { nogood: while(--w >= 0) @@ -91,8 +101,13 @@ nogood: se = buf + d + 3; #ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */ if (f__scale != 1 && dd) -#endif sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); +#else + if (dd) + sprintf(se, "%+.2d", atoi(se) + 1 - f__scale); + else + strcpy(se, "+00"); +#endif s = ++se; if (e < 2) { if (*s != '0') @@ -139,6 +154,10 @@ nogood: s = buf; i = f__scale; if (f__scale <= 0) { +#ifdef WANT_LEAD_0 + if (insert0) + PUT('0'); +#endif PUT('.'); for(; i < 0; ++i) PUT('0'); @@ -211,8 +230,10 @@ wrt_F(ufloat *p, int w, int d, ftnlen len) n = sprintf(b = buf, "%#.*f", d, x) + d1; #endif +#ifndef WANT_LEAD_0 if (buf[0] == '0' && d) { ++b; --n; } +#endif if (sign) { /* check for all zeros */ for(s = b;;) { @@ -229,9 +250,16 @@ wrt_F(ufloat *p, int w, int d, ftnlen len) if (sign || f__cplus) ++n; if (n > w) { - while(--w >= 0) - PUT('*'); - return 0; +#ifdef WANT_LEAD_0 + if (buf[0] == '0' && --n == w) + ++b; + else +#endif + { + while(--w >= 0) + PUT('*'); + return 0; + } } for(w -= n; --w >= 0; ) PUT(' '); diff --git a/lib/libI77/wrtfmt.c b/lib/libI77/wrtfmt.c index b08b7a8..545dcb9 100644 --- a/lib/libI77/wrtfmt.c +++ b/lib/libI77/wrtfmt.c @@ -1,12 +1,8 @@ #include "f2c.h" #include "fio.h" #include "fmt.h" + extern int f__cursor; -#ifdef KR_headers -extern char *f__icvt(); -#else -extern char *f__icvt(long, int*, int*, int); -#endif int f__hiwater; icilist *f__svic; char *f__icptr; @@ -151,7 +147,7 @@ wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base; wrt_I(Uint *n, int w, ftnlen len, register int base) #endif { int ndigit,sign,spare,i; - long x; + longint x; char *ans; if(len==sizeof(integer)) x=n->il; else if(len == sizeof(char)) x = n->ic; @@ -179,10 +175,13 @@ wrt_IM(n,w,m,len,base) Uint *n; ftnlen len; int base; wrt_IM(Uint *n, int w, int m, ftnlen len, int base) #endif { int ndigit,sign,spare,i,xsign; - long x; + longint x; char *ans; if(sizeof(integer)==len) x=n->il; else if(len == sizeof(char)) x = n->ic; +#ifdef Allow_TYQUAD + else if (len == sizeof(longint)) x = n->ili; +#endif else x=n->is; ans=f__icvt(x,&ndigit,&sign, base); if(sign || f__cplus) xsign=1; @@ -288,6 +287,9 @@ wrt_G(ufloat *p, int w, int d, int e, ftnlen len) if(x<.1) { if (x != 0.) return(wrt_E(p,w,d,e,len)); +#ifdef WANT_LEAD_0 + i = 1; +#endif goto have_i; } for(;i<=d;i++,up*=10) diff --git a/lib/libI77/wsle.c b/lib/libI77/wsle.c index 470191b..44b6972 100644 --- a/lib/libI77/wsle.c +++ b/lib/libI77/wsle.c @@ -10,7 +10,6 @@ integer s_wsle(cilist *a) #endif { int n; - if(!f__init) f_init(); if(n=c_le(a)) return(n); f__reading=0; f__external=1; @@ -28,9 +27,14 @@ integer e_wsle(Void) { t_putc('\n'); f__recpos=0; +#ifdef ALWAYS_FLUSH + if (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); } diff --git a/lib/libI77/wsne.c b/lib/libI77/wsne.c index c3f0623..0febd52 100644 --- a/lib/libI77/wsne.c +++ b/lib/libI77/wsne.c @@ -11,8 +11,6 @@ s_wsne(cilist *a) { int n; - if(!f__init) - f_init(); if(n=c_le(a)) return(n); f__reading=0; diff --git a/lib/libI77/xwsne.c b/lib/libI77/xwsne.c index 49e6f0e..41c929b 100644 --- a/lib/libI77/xwsne.c +++ b/lib/libI77/xwsne.c @@ -3,6 +3,8 @@ #include "lio.h" #include "fmt.h" +extern int f__Aquote; + static VOID nl_donewrec(Void) { @@ -33,6 +35,7 @@ x_wsne(cilist *a) for(s = nl->name; *s; s++) PUT(*s); PUT(' '); + f__Aquote = 1; vd = nl->vars; vde = vd + nl->nvars; while(vd < vde) { @@ -64,5 +67,6 @@ x_wsne(cilist *a) else if (f__recpos+1 >= L_len) nl_donewrec(); } + f__Aquote = 0; PUT('/'); } |