implement namelist

SCCS-vsn: usr.bin/f77/libI77/Makefile 5.4
SCCS-vsn: usr.bin/f77/libI77/err.c 5.2
SCCS-vsn: usr.bin/f77/libI77/f_errlist.c 5.2
SCCS-vsn: usr.bin/f77/libI77/f_errno.h 5.2
SCCS-vsn: usr.bin/f77/libI77/fiodefs.h 5.2
SCCS-vsn: usr.bin/f77/libI77/lio.h 5.2
SCCS-vsn: usr.bin/f77/libI77/dolio.c 5.2
SCCS-vsn: usr.bin/f77/libI77/lread.c 5.2
SCCS-vsn: usr.bin/f77/libI77/lwrite.c 5.2

diff --git a/usr/src/usr.bin/f77/libI77/Makefile b/usr/src/usr.bin/f77/libI77/Makefile
index cf0386d..870bd69 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/Makefile
+++ b/usr/src/usr.bin/f77/libI77/Makefile
@@ -3,7 +3,7 @@
 # All rights reserved.  The Berkeley software License Agreement
 # specifies the terms and conditions for redistribution.
 #
 # All rights reserved.  The Berkeley software License Agreement
 # specifies the terms and conditions for redistribution.
 #

-#      @(#)Makefile    5.3 (Berkeley) %G%
+#      @(#)Makefile    5.4 (Berkeley) %G%

 #
 
 # Makefile for f77 I/O lib, libI77.a
 #
 
 # Makefile for f77 I/O lib, libI77.a


@@ -22,7 +22,8 @@ HDRS        = f_errno.h \
                fio.h \
                fiodefs.h \
                format.h \
                fio.h \
                fiodefs.h \
                format.h \

-               lio.h
+               lio.h \
+               nmlio.h

 
 LIBRARY              = libI77.a
 
 
 LIBRARY              = libI77.a
 


@@ -55,13 +56,15 @@ OBJS              = backspace.o \
                rfi.o \
                rsfe.o \
                rsli.o \
                rfi.o \
                rsfe.o \
                rsli.o \

+               rsnmle.o \

                sue.o \
                util.o \
                wdfe.o \
                wfi.o \
                wrtfmt.o \
                wsfe.o \
                sue.o \
                util.o \
                wdfe.o \
                wfi.o \
                wrtfmt.o \
                wsfe.o \

-               wsli.o
+               wsli.o \
+               wsnmle.o

 
 OLDDIR       = $(DESTDIR)/usr/old/lib
 
 
 OLDDIR       = $(DESTDIR)/usr/old/lib
 


@@ -92,13 +95,15 @@ SRCS              = backspace.c \
                rfi.c \
                rsfe.c \
                rsli.c \
                rfi.c \
                rsfe.c \
                rsli.c \

+               rsnmle.c \

                sue.c \
                util.c \
                wdfe.c \
                wfi.c \
                wrtfmt.c \
                wsfe.c \
                sue.c \
                util.c \
                wdfe.c \
                wfi.c \
                wrtfmt.c \
                wsfe.c \

-               wsli.c
+               wsli.c \
+               wsnmle.c

 
 all:           $(LIBRARY) $(LIBRARY_P) libI66.o
 
 
 all:           $(LIBRARY) $(LIBRARY_P) libI66.o
 


@@ -197,3 +202,5 @@ wrtfmt.o:   fio.h f_errno.h fiodefs.h format.h wrtfmt.c
 err.o:         fio.h f_errno.h fiodefs.h err.c
 fmtlib.o:      fio.h f_errno.h fiodefs.h fmtlib.c
 f77_abort.o:   fio.h f_errno.h fiodefs.h f77_abort.c
 err.o:         fio.h f_errno.h fiodefs.h err.c
 fmtlib.o:      fio.h f_errno.h fiodefs.h fmtlib.c
 f77_abort.o:   fio.h f_errno.h fiodefs.h f77_abort.c

+rsnmle.o:      fio.h f_errno.h fiodefs.h lio.h nmlio.h rsnmle.c
+wsnmle.o:      fio.h f_errno.h fiodefs.h lio.h nmlio.h wsnmle.c

diff --git a/usr/src/usr.bin/f77/libI77/dolio.c b/usr/src/usr.bin/f77/libI77/dolio.c
index ea687d9..54b6661 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/dolio.c
+++ b/usr/src/usr.bin/f77/libI77/dolio.c
@@ -3,11 +3,11 @@
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *

- *     @(#)dolio.c     5.1     %G%
+ *     @(#)dolio.c     5.2     %G%

  */
 
 /*
  */
 
 /*

- * list directed i/o common routines
+ * list directed and namelist i/o common routines

  */
 
 #include "fio.h"
  */
 
 #include "fio.h"


@@ -18,8 +18,7 @@ c_le(a,flag) cilist *a;
 {      int n;
        lfname = NULL;
        elist = NO;
 {      int n;
        lfname = NULL;
        elist = NO;

-       sequential=external=formatted= LISTDIRECTED;
-       fmtbuf = "ext list io";
+       sequential=external=YES;

        errflag = a->cierr;
        endflag = a->ciend;
        lunit = a->ciunit;
        errflag = a->cierr;
        endflag = a->ciend;
        lunit = a->ciunit;

diff --git a/usr/src/usr.bin/f77/libI77/err.c b/usr/src/usr.bin/f77/libI77/err.c
index bed9da7..0422b10 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/err.c
+++ b/usr/src/usr.bin/f77/libI77/err.c
@@ -3,7 +3,7 @@
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *

- *     @(#)err.c       5.1     %G%
+ *     @(#)err.c       5.2     %G%

  */
 
 /*
  */
 
 /*


@@ -24,7 +24,8 @@ unit units[MXUNIT];   /*unit table*/
 flag reading;          /*1 if reading,         0 if writing*/
 flag external;         /*1 if external io,     0 if internal */
 flag sequential;       /*1 if sequential io,   0 if direct*/
 flag reading;          /*1 if reading,         0 if writing*/
 flag external;         /*1 if external io,     0 if internal */
 flag sequential;       /*1 if sequential io,   0 if direct*/

-flag formatted;                /*1 if formatted io,    0 if unformatted, -1 if list*/
+flag formatted;                /*1 if formatted io,    0 if unformatted,
+                               -1 if list directed, -2 if namelist */

 char *fmtbuf, *icptr, *icend, *fmtptr;
 int (*doed)(),(*doned)();
 int (*doend)(),(*donewrec)(),(*dorevert)(),(*dotab)();
 char *fmtbuf, *icptr, *icend, *fmtptr;
 int (*doed)(),(*doned)();
 int (*doend)(),(*donewrec)(),(*dorevert)(),(*dotab)();


@@ -84,7 +85,8 @@ fatal(n,s) char *s;
        {       fprintf(stderr,"lately: %s %s %s %s I/O\n",
                        reading?"reading":"writing",
                        sequential?"sequential":"direct",
        {       fprintf(stderr,"lately: %s %s %s %s I/O\n",
                        reading?"reading":"writing",
                        sequential?"sequential":"direct",

-                       formatted>0?"formatted":(formatted<0?"list":"unformatted"),
+                       formatted>0?"formatted":(formatted==0?"unformatted":
+                               (formatted==LISTDIRECTED?"list":"namelist")),

                        external?"external":"internal");
                if (formatted)
                {       if(fmtbuf) prnt_fmt(n);
                        external?"external":"internal");
                if (formatted)
                {       if(fmtbuf) prnt_fmt(n);

diff --git a/usr/src/usr.bin/f77/libI77/f_errlist.c b/usr/src/usr.bin/f77/libI77/f_errlist.c
index 44f8e31..1b0a3dd 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/f_errlist.c
+++ b/usr/src/usr.bin/f77/libI77/f_errlist.c
@@ -3,7 +3,7 @@
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *

- *     @(#)f_errlist.c 5.1     %G%
+ *     @(#)f_errlist.c 5.2     %G%

  */
 
 /*
  */
 
 /*


@@ -37,6 +37,7 @@ char *f_errlist[] =
 /* 122 */      "negative repeat count",
 /* 123 */      "illegal operation for unit",
 /* 124 */      "invalid data for d,e,f, or g format term",
 /* 122 */      "negative repeat count",
 /* 123 */      "illegal operation for unit",
 /* 124 */      "invalid data for d,e,f, or g format term",

+/* 125 */      "illegal input for namelist",

 };
 
 int f_nerr = (sizeof(f_errlist)/sizeof(char *));
 };
 
 int f_nerr = (sizeof(f_errlist)/sizeof(char *));

diff --git a/usr/src/usr.bin/f77/libI77/f_errno.h b/usr/src/usr.bin/f77/libI77/f_errno.h
index fd01d9b..6fa5f23 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/f_errno.h
+++ b/usr/src/usr.bin/f77/libI77/f_errno.h
@@ -3,7 +3,7 @@
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *

- *     @(#)f_errno.h   5.1 (Berkeley) %G%
+ *     @(#)f_errno.h   5.2 (Berkeley) %G%

  */
 
 /*
  */
 
 /*


@@ -42,5 +42,6 @@ extern int f_nerr;
 #define F_ERNREP       122     /* negative repeat count */
 #define F_ERILLOP      123     /* illegal operation for channel or device */
 #define F_ERRFCHR      124     /* invalid data for d,e,f, or g format term */
 #define F_ERNREP       122     /* negative repeat count */
 #define F_ERILLOP      123     /* illegal operation for channel or device */
 #define F_ERRFCHR      124     /* invalid data for d,e,f, or g format term */

+#define F_ERNMLIST     125     /* illegal input for namelist */

 
 #define F_MAXERR       (f_nerr + F_ER)
 
 #define F_MAXERR       (f_nerr + F_ER)

diff --git a/usr/src/usr.bin/f77/libI77/fiodefs.h b/usr/src/usr.bin/f77/libI77/fiodefs.h
index b0de93d..fcda0f3 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/fiodefs.h
+++ b/usr/src/usr.bin/f77/libI77/fiodefs.h
@@ -3,7 +3,7 @@
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *

- *     @(#)fiodefs.h   5.1 (Berkeley) %G%
+ *     @(#)fiodefs.h   5.2 (Berkeley) %G%

  */
 
 /*
  */
 
 /*


@@ -18,6 +18,7 @@
 
 #define GLITCH '\2'    /* special quote for Stu, generated in f77pass1 */
 
 
 #define GLITCH '\2'    /* special quote for Stu, generated in f77pass1 */
 

+#define NAMELIST      -2

 #define LISTDIRECTED  -1
 #define FORMATTED      1
 
 #define LISTDIRECTED  -1
 #define FORMATTED      1
 

diff --git a/usr/src/usr.bin/f77/libI77/lio.h b/usr/src/usr.bin/f77/libI77/lio.h
index 9be1620..0d8618d 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/lio.h
+++ b/usr/src/usr.bin/f77/libI77/lio.h
@@ -3,7 +3,7 @@
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *

- *     @(#)lio.h       5.1 (Berkeley) %G%
+ *     @(#)lio.h       5.2 (Berkeley) %G%

  */
 
 /*
  */
 
 /*


@@ -52,6 +52,8 @@
 #define width(z) ((z!=0.0 && (abs(z)>=LHIGH || abs(z)<LLOW))?LEW:LFW)
 #define dwidth(z) ((z!=0.0 && (abs(z)>=LDHIGH || abs(z)<LLOW))?LDEW:LDFW)
 #define ERR(x) if(n=(x)) err(n>0?errflag:endflag,n,"list io")
 #define width(z) ((z!=0.0 && (abs(z)>=LHIGH || abs(z)<LLOW))?LEW:LFW)
 #define dwidth(z) ((z!=0.0 && (abs(z)>=LDHIGH || abs(z)<LLOW))?LDEW:LDFW)
 #define ERR(x) if(n=(x)) err(n>0?errflag:endflag,n,"list io")

+#define ERRCHK(x)      if(n=(x)) goto got_err;
+#define chk_len(w) if(recpos+w > line_len) PUT('\n');

 
 typedef union
 {      short   flshort;
 
 typedef union
 {      short   flshort;

diff --git a/usr/src/usr.bin/f77/libI77/lread.c b/usr/src/usr.bin/f77/libI77/lread.c
index f217218..50ee840 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/lread.c
+++ b/usr/src/usr.bin/f77/libI77/lread.c
@@ -3,7 +3,7 @@
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *

- *     @(#)lread.c     5.1     %G%
+ *     @(#)lread.c     5.2     %G%

  */
 
 /*
  */
 
 /*


@@ -50,6 +50,8 @@ s_rsle(a) cilist *a;  /* start read sequential list external */
 {
        int n;
        reading = YES;
 {
        int n;
        reading = YES;

+       formatted = LISTDIRECTED;
+       fmtbuf = "ext list io";

        if(n=c_le(a,READ)) return(n);
        l_first = YES;
        lquit = NO;
        if(n=c_le(a,READ)) return(n);
        l_first = YES;
        lquit = NO;

diff --git a/usr/src/usr.bin/f77/libI77/lwrite.c b/usr/src/usr.bin/f77/libI77/lwrite.c
index 3c7ad3e..61e4813 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/lwrite.c
+++ b/usr/src/usr.bin/f77/libI77/lwrite.c
@@ -3,7 +3,7 @@
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *
  * All rights reserved.  The Berkeley software License Agreement
  * specifies the terms and conditions for redistribution.
  *

- *     @(#)lwrite.c    5.1     %G%
+ *     @(#)lwrite.c    5.2     %G%

  */
 
 /*
  */
 
 /*


@@ -20,6 +20,8 @@ s_wsle(a) cilist *a;
 {
        int n;
        reading = NO;
 {
        int n;
        reading = NO;

+       formatted = LISTDIRECTED;
+       fmtbuf = "ext list io";

        if(n=c_le(a,WRITE)) return(n);
        putn = t_putc;
        lioproc = l_write;
        if(n=c_le(a,WRITE)) return(n);
        putn = t_putc;
        lioproc = l_write;


@@ -55,6 +57,7 @@ l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
        double *yy;
        for(i=0;i< *number; i++)
        {
        double *yy;
        for(i=0;i< *number; i++)
        {

+               if( formatted == NAMELIST && i != 0 ) PUT(',');

                switch((int)type)
                {
                case TYSHORT:
                switch((int)type)
                {
                case TYSHORT:


@@ -62,35 +65,35 @@ l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
                        goto xint;
                case TYLONG:
                        x=ptr->flint;
                        goto xint;
                case TYLONG:
                        x=ptr->flint;

-       xint:           ERR(lwrt_I(x));
+       xint:           ERRCHK(lwrt_I(x));

                        break;
                case TYREAL:
                        break;
                case TYREAL:

-                       ERR(lwrt_F(ptr->flreal));
+                       ERRCHK(lwrt_F(ptr->flreal));

                        break;
                case TYDREAL:
                        break;
                case TYDREAL:

-                       ERR(lwrt_D(ptr->fldouble));
+                       ERRCHK(lwrt_D(ptr->fldouble));

                        break;
                case TYCOMPLEX:
                        xx= &(ptr->flreal);
                        y = *xx++;
                        z = *xx;
                        break;
                case TYCOMPLEX:
                        xx= &(ptr->flreal);
                        y = *xx++;
                        z = *xx;

-                       ERR(lwrt_C(y,z));
+                       ERRCHK(lwrt_C(y,z));

                        break;
                case TYDCOMPLEX:
                        yy = &(ptr->fldouble);
                        yd= *yy++;
                        zd = *yy;
                        break;
                case TYDCOMPLEX:
                        yy = &(ptr->fldouble);
                        yd= *yy++;
                        zd = *yy;

-                       ERR(lwrt_DC(yd,zd));
+                       ERRCHK(lwrt_DC(yd,zd));

                        break;
                case TYLOGICAL:
                        if(len == sizeof(short))
                                x = ptr->flshort;
                        else
                                x = ptr->flint;
                        break;
                case TYLOGICAL:
                        if(len == sizeof(short))
                                x = ptr->flshort;
                        else
                                x = ptr->flint;

-                       ERR(lwrt_L(x));
+                       ERRCHK(lwrt_L(x));

                        break;
                case TYCHAR:
                        break;
                case TYCHAR:

-                       ERR(lwrt_A((char *)ptr,len));
+                       ERRCHK(lwrt_A((char *)ptr,len));

                        break;
                default:
                        fatal(F_ERSYS,"unknown type in lwrite");
                        break;
                default:
                        fatal(F_ERSYS,"unknown type in lwrite");


@@ -98,6 +101,10 @@ l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
                ptr = (flex *)((char *)ptr + len);
        }
        return(OK);
                ptr = (flex *)((char *)ptr + len);
        }
        return(OK);

+
+got_err:
+       err( n>0?errflag:endflag,  n,
+               formatted==LISTDIRECTED?"list io":"name list io");

 }
 
 LOCAL
 }
 
 LOCAL


@@ -105,7 +112,7 @@ lwrt_I(in) ftnint in;
 {      int n;
        char buf[16],*p;
        sprintf(buf,"  %ld",(long)in);
 {      int n;
        char buf[16],*p;
        sprintf(buf,"  %ld",(long)in);

-       if(n=chk_len(LINTW)) return(n);
+       chk_len(LINTW);

        for(p=buf;*p;) PUT(*p++)
        return(OK);
 }
        for(p=buf;*p;) PUT(*p++)
        return(OK);
 }


@@ -113,17 +120,26 @@ lwrt_I(in) ftnint in;
 LOCAL
 lwrt_L(ln) ftnint ln;
 {      int n;
 LOCAL
 lwrt_L(ln) ftnint ln;
 {      int n;

-       if(n=chk_len(LLOGW)) return(n);
+       chk_len(LLOGW);

        return(wrt_L(&ln,LLOGW));
 }
 
 LOCAL
 lwrt_A(p,len) char *p; ftnlen len;
 {      int i,n;
        return(wrt_L(&ln,LLOGW));
 }
 
 LOCAL
 lwrt_A(p,len) char *p; ftnlen len;
 {      int i,n;

-       if(n=chk_len(LSTRW)) return(n);
-       PUT(' ')
-       PUT(' ')
-       for(i=0;i<len;i++) PUT(*p++)
+       chk_len(LSTRW);
+       if(formatted == LISTDIRECTED)
+       {
+               PUT(' ')
+               PUT(' ')
+               for(i=0;i<len;i++) PUT(*p++)
+       }
+       else
+       {
+               PUT('\'')
+               for(i=0;i<len;i++) PUT(*p++)
+               PUT('\'')
+       }

        return(OK);
 }
 
        return(OK);
 }
 


@@ -133,7 +149,7 @@ lwrt_F(fn) float fn;
        if(fn==0.0) return(lwrt_0());
        f.pf = fn;
        d = width(fn);
        if(fn==0.0) return(lwrt_0());
        f.pf = fn;
        d = width(fn);

-       if(n=chk_len(d)) return(n);
+       chk_len(d);

        if(d==LFW)
        {
                scale = 0;
        if(d==LFW)
        {
                scale = 0;


@@ -153,7 +169,7 @@ lwrt_D(dn) double dn;
        if(dn==0.0) return(lwrt_0());
        f.pd = dn;
        d = dwidth(dn);
        if(dn==0.0) return(lwrt_0());
        f.pd = dn;
        d = dwidth(dn);

-       if(n=chk_len(d)) return(n);
+       chk_len(d);

        if(d==LDFW)
        {
                scale = 0;
        if(d==LDFW)
        {
                scale = 0;


@@ -170,7 +186,7 @@ lwrt_D(dn) double dn;
 LOCAL
 lwrt_C(a,b) float a,b;
 {      int n;
 LOCAL
 lwrt_C(a,b) float a,b;
 {      int n;

-       if(n=chk_len(LCW)) return(n);
+       chk_len(LCW);

        PUT(' ')
        PUT(' ')
        PUT('(')
        PUT(' ')
        PUT(' ')
        PUT('(')


@@ -184,7 +200,7 @@ lwrt_C(a,b) float a,b;
 LOCAL
 lwrt_DC(a,b) double a,b;
 {      int n;
 LOCAL
 lwrt_DC(a,b) double a,b;
 {      int n;

-       if(n=chk_len(LDCW)) return(n);
+       chk_len(LDCW);

        PUT(' ')
        PUT(' ')
        PUT('(')
        PUT(' ')
        PUT(' ')
        PUT('(')


@@ -198,14 +214,7 @@ lwrt_DC(a,b) double a,b;
 LOCAL
 lwrt_0()
 {      int n; char *z = "  0.";
 LOCAL
 lwrt_0()
 {      int n; char *z = "  0.";

-       if(n=chk_len(4)) return(n);
+       chk_len(4);

        while(*z) PUT(*z++)
        return(OK);
 }
        while(*z) PUT(*z++)
        return(OK);
 }

-
-LOCAL
-chk_len(w)
-{      int n;
-       if(recpos+w > line_len) PUT('\n')
-       return(OK);
-}