Add copyright

[unix-history] / usr / src / usr.bin / f77 / libI77 / lread.c

diff --git a/usr/src/usr.bin/f77/libI77/lread.c b/usr/src/usr.bin/f77/libI77/lread.c
index cc6cdf0..f217218 100644 (file)
--- a/usr/src/usr.bin/f77/libI77/lread.c
+++ b/usr/src/usr.bin/f77/libI77/lread.c
@@ -1,6 +1,12 @@
 /*
 /*

-char id_lread[] = "@(#)lread.c 1.7";
+ * Copyright (c) 1980 Regents of the University of California.
+ * All rights reserved.  The Berkeley software License Agreement
+ * specifies the terms and conditions for redistribution.

  *
  *

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

  * list directed read
  */
 
  * list directed read
  */
 


@@ -13,24 +19,24 @@ char id_lread[] = "@(#)lread.c      1.7";
 #define EX 8
 #define D 16
 #define EIN 32
 #define EX 8
 #define D 16
 #define EIN 32

-#define isblnk(x)      (ltab[x+1]&B)
-#define issep(x)       (ltab[x+1]&SP)
-#define isapos(x)      (ltab[x+1]&AP)
-#define isexp(x)       (ltab[x+1]&EX)
+#define isblnk(x)      (ltab[x+1]&B)   /* space, tab, newline */
+#define issep(x)       (ltab[x+1]&SP)  /* space, tab, newline, comma */
+#define isapos(x)      (ltab[x+1]&AP)  /* apost., quote mark, \02 */
+#define isexp(x)       (ltab[x+1]&EX)  /* d, e, D, E */

 #define isdigit(x)     (ltab[x+1]&D)
 #define isdigit(x)     (ltab[x+1]&D)

-#define endlinp(x)     (ltab[x+1]&EIN)
+#define endlinp(x)     (ltab[x+1]&EIN) /* EOF, newline, / */

 
 #define GETC(x) (x=(*getn)())
 
 
 #define GETC(x) (x=(*getn)())
 

-char lrd[] = "list read";
-char *lchar;
-double lx,ly;
-int ltype;
+LOCAL char lrd[] = "list read";
+LOCAL char *lchar;
+LOCAL double lx,ly;
+LOCAL int ltype;

 int l_read(),t_getc(),ungetc();
 
 int l_read(),t_getc(),ungetc();
 

-char ltab[128+1] =
-{              EIN, /* offset one for EOF */
-/*   0- 15 */  0,0,AP,0,0,0,0,0,0,B,SP|B|EIN,0,0,0,0,0, /* ^B,TAB,NEWLINE */
+LOCAL char ltab[128+1] =
+{                      EIN,            /* offset one for EOF */
+/*   0- 15 */  0,0,AP,0,0,0,0,0,0,SP|B,SP|B|EIN,0,0,0,0,0, /* ^B,TAB,NEWLINE */

 /*  16- 31 */  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 /*  32- 47 */  SP|B,0,AP,0,0,0,0,AP,0,0,0,0,SP,0,0,EIN, /* space,",',comma,/ */
 /*  48- 63 */  D,D,D,D,D,D,D,D,D,D,0,0,0,0,0,0,        /* digits 0-9 */
 /*  16- 31 */  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 /*  32- 47 */  SP|B,0,AP,0,0,0,0,AP,0,0,0,0,SP,0,0,EIN, /* space,",',comma,/ */
 /*  48- 63 */  D,D,D,D,D,D,D,D,D,D,0,0,0,0,0,0,        /* digits 0-9 */


@@ -57,6 +63,7 @@ s_rsle(a) cilist *a;  /* start read sequential list external */
        return(OK);
 }
 
        return(OK);
 }
 

+LOCAL

 t_getc()
 {      int ch;
        if(curunit->uend) return(EOF);
 t_getc()
 {      int ch;
        if(curunit->uend) return(EOF);


@@ -72,9 +79,9 @@ t_getc()
 e_rsle()
 {
        int ch;
 e_rsle()
 {
        int ch;

-       if(curunit->uend) return(OK);
+       if(curunit->uend) return(EOF);

        while(GETC(ch) != '\n' && ch != EOF);
        while(GETC(ch) != '\n' && ch != EOF);

-       return(OK);
+       return(ch==EOF?EOF:OK);

 }
 
 l_read(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
 }
 
 l_read(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;


@@ -112,6 +119,14 @@ l_read(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
                        ERR(l_CHAR());
                        break;
                }
                        ERR(l_CHAR());
                        break;
                }

+               
+               /* peek at next character; it should be separator or new line */
+               GETC(ch); (*ungetn)(ch,cf);
+               if(!issep(ch) && !endlinp(ch)) {
+                       while(GETC(ch)!= '\n' && ch != EOF);
+                       err(errflag,F_ERLIO,lrd);
+               }
+ 

                if(lquit) return(OK);
                if(leof) err(endflag,EOF,lrd)
                else if(external && ferror(cf)) err(errflag,errno,lrd)
                if(lquit) return(OK);
                if(leof) err(endflag,EOF,lrd)
                else if(external && ferror(cf)) err(errflag,errno,lrd)


@@ -121,6 +136,11 @@ l_read(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
                        ptr->flshort=lx;
                        break;
                case TYLOGICAL:
                        ptr->flshort=lx;
                        break;
                case TYLOGICAL:

+                       if(len == sizeof(short))
+                               ptr->flshort = lx;
+                       else
+                               ptr->flint = lx;
+                       break;

                case TYLONG:
                        ptr->flint=lx;
                        break;
                case TYLONG:
                        ptr->flint=lx;
                        break;


@@ -150,6 +170,7 @@ l_read(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
        return(OK);
 }
 
        return(OK);
 }
 

+LOCAL

 lr_comm()
 {      int ch;
        if(lcount) return(lcount);
 lr_comm()
 {      int ch;
        if(lcount) return(lcount);


@@ -168,6 +189,7 @@ lr_comm()
                return(OK);
 }
 
                return(OK);
 }
 

+LOCAL

 get_repet()
 {      char ch;
        double lc;
 get_repet()
 {      char ch;
        double lc;


@@ -186,27 +208,37 @@ get_repet()
        return(OK);
 }
 
        return(OK);
 }
 

+LOCAL

 l_R(flg) int flg;
 {      double a,b,c,d;
        int da,db,dc,dd;
        int i,ch,sign=0;
        a=b=c=d=0;
        da=db=dc=dd=0;
 l_R(flg) int flg;
 {      double a,b,c,d;
        int da,db,dc,dd;
        int i,ch,sign=0;
        a=b=c=d=0;
        da=db=dc=dd=0;

-       if(flg && lr_comm()) return(OK);
-       da=rd_int(&a);  /* repeat count ? */
-       if(GETC(ch)=='*')
+
+       if( flg )               /* real */

        {
        {

-               if (a <= 0.) return(F_ERNREP);
-               lcount=(int)a;
-               if (nullfld()) return(OK);      /* could be R* */
-               db=rd_int(&b);  /* whole part of number */
+               if(lr_comm()) return(OK);
+               da=rd_int(&a);  /* repeat count ? */
+               if(GETC(ch)=='*')
+               {
+                       if (a <= 0.) return(F_ERNREP);
+                       lcount=(int)a;
+                       if (nullfld()) return(OK);      /* could be R* */
+                       db=rd_int(&b);  /* whole part of number */
+               }
+               else
+               {       (*ungetn)(ch,cf);
+                       db=da;
+                       b=a;
+                       lcount=1;
+               }

        }
        }

-       else
-       {       (*ungetn)(ch,cf);
-               db=da;
-               b=a;
-               lcount=1;
+       else               /* complex */
+       {
+               db=rd_int(&b);

        }
        }

+

        if(GETC(ch)=='.' && isdigit(GETC(ch)))
        {       (*ungetn)(ch,cf);
                dc=rd_int(&c);  /* fractional part of number */
        if(GETC(ch)=='.' && isdigit(GETC(ch)))
        {       (*ungetn)(ch,cf);
                dc=rd_int(&c);  /* fractional part of number */


@@ -241,6 +273,7 @@ l_R(flg) int flg;
        return(OK);
 }
 
        return(OK);
 }
 

+LOCAL

 rd_int(x) double *x;
 {      int ch,sign=0,i=0;
        double y=0.0;
 rd_int(x) double *x;
 {      int ch,sign=0,i=0;
        double y=0.0;


@@ -257,6 +290,7 @@ rd_int(x) double *x;
        return(y==0.0?sign:i); /* 0:[+]&&y==0, -1:-&&y==0, >0:#digits&&y!=0 */
 }
 
        return(y==0.0?sign:i); /* 0:[+]&&y==0, -1:-&&y==0, >0:#digits&&y!=0 */
 }
 

+LOCAL

 l_C()
 {      int ch,n;
        if(lr_comm()) return(OK);
 l_C()
 {      int ch,n;
        if(lr_comm()) return(OK);


@@ -275,6 +309,7 @@ l_C()
        return(OK);
 }
 
        return(OK);
 }
 

+LOCAL

 l_L()
 {
        int ch,n;
 l_L()
 {
        int ch,n;


@@ -293,7 +328,7 @@ l_L()
                lx=0;
                break;
        default:
                lx=0;
                break;
        default:

-               if(isblnk(ch) || issep(ch))
+               if(issep(ch))

                {       (*ungetn)(ch,cf);
                        lx=0;
                        return(OK);
                {       (*ungetn)(ch,cf);
                        lx=0;
                        return(OK);


@@ -302,12 +337,13 @@ l_L()
                else    err(errflag,F_ERLIO,"logical not T or F");
        }
        ltype=TYLOGICAL;
                else    err(errflag,F_ERLIO,"logical not T or F");
        }
        ltype=TYLOGICAL;

-       while(!issep(GETC(ch)) && !isblnk(ch) && !endlinp(ch));
+       while(!issep(GETC(ch)) && !endlinp(ch));

        (*ungetn)(ch,cf);
        return(OK);
 }
 
 #define BUFSIZE        128
        (*ungetn)(ch,cf);
        return(OK);
 }
 
 #define BUFSIZE        128

+LOCAL

 l_CHAR()
 {      int ch,size,i,n;
        char quote,*p;
 l_CHAR()
 {      int ch,size,i,n;
        char quote,*p;


@@ -315,7 +351,7 @@ l_CHAR()
        if(n=get_repet()) return(n);            /* get repeat count */
        if (nullfld()) return(OK);              /* could be R* */
        if(isapos(GETC(ch))) quote=ch;
        if(n=get_repet()) return(n);            /* get repeat count */
        if (nullfld()) return(OK);              /* could be R* */
        if(isapos(GETC(ch))) quote=ch;

-       else if(isblnk(ch) || issep(ch) || ch==EOF || ch=='\n')
+       else if(issep(ch) || ch==EOF || ch=='\n')

        {       if(ch==EOF) return(EOF);
                (*ungetn)(ch,cf);
                return(OK);
        {       if(ch==EOF) return(EOF);
                (*ungetn)(ch,cf);
                return(OK);


@@ -331,7 +367,7 @@ l_CHAR()
        if(lchar==NULL) err(errflag,F_ERSPACE,lrd)
        for(i=0;;)
        {       while( ( (quote && GETC(ch)!=quote) ||
        if(lchar==NULL) err(errflag,F_ERSPACE,lrd)
        for(i=0;;)
        {       while( ( (quote && GETC(ch)!=quote) ||

-                       (!quote && !issep(GETC(ch)) && !isblnk(ch) && !endlinp(ch)) )
+                       (!quote && !issep(GETC(ch)) && !endlinp(ch)) )

                        && ch!='\n' && ch!=EOF && ++i<size )
                                *p++ = ch;
                if(i==size)
                        && ch!='\n' && ch!=EOF && ++i<size )
                                *p++ = ch;
                if(i==size)


@@ -364,6 +400,7 @@ l_CHAR()
        }
 }
 
        }
 }
 

+LOCAL

 t_sep()
 {
        int ch;
 t_sep()
 {
        int ch;


@@ -380,11 +417,12 @@ t_sep()
        return(OK);
 }
 
        return(OK);
 }
 

+LOCAL

 nullfld()      /* look for null field following a repeat count */
 {
        int     ch;
 
 nullfld()      /* look for null field following a repeat count */
 {
        int     ch;
 

-       while(isblnk(GETC(ch)));
+       GETC(ch);

        (*ungetn)(ch,cf);
        if (issep(ch) || endlinp(ch))
                return(YES);
        (*ungetn)(ch,cf);
        if (issep(ch) || endlinp(ch))
                return(YES);