diff options
Diffstat (limited to 'libf2c')
33 files changed, 527 insertions, 475 deletions
diff --git a/libf2c/ChangeLog b/libf2c/ChangeLog index 0159343124c..1a1dd5a60f7 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 625999d3c65..ac825279db4 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 4f7df49982c..2460a81b368 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 79b6735b13b..95db94f4874 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 04528b50bb8..7ed3fce6b27 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 9d0aa25f1d3..005ac6fc412 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 0af3735da42..6b8dc29b154 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 8fcecb68200..4ede56ac355 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 c0f6795171f..411ce32821e 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 469a64bdcb3..343d7bdff1c 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 ee2a0ee6bf5..a7733a53362 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 8800a18d77b..662cae450dc 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 6fdf19e4654..0cdeb88ae99 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 b806d1ec49d..8456a7f8c6f 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 5c3af4c0854..bbc5bacb821 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 e229e0e3356..3a936592381 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 6050d1e3b30..0b785a95165 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 cb40630059d..56d82ac4b19 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 e9e3b391407..846351d5413 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 22eae3f433d..d56a352dd8c 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 08ea2be7831..abc64099d31 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 4fb14eed29e..c5b922fbfb6 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 5da7dfbb972..bf209f47ed2 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 d7e8491df04..29b7662b106 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 1c165458494..f3a59fdab4d 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 1bb10d9052d..c7d891804b3 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 a24932533c1..ccaad2d3b6f 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 4350fc984f6..477c40f5d3b 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 5adb1a49f08..6cb4e504158 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 d13f78f650b..f8555d79c45 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 0febd52634f..ae3f8178949 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 99c58c92313..12b876cf29a 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 e74898762e9..c3785b4755d 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 |