2.9BSD - /usr/src/lib/libI77/doscan.c

   1: /*
   2: char id_doscan[] = "@(#)doscan.c	1.1";
   3:  *
   4:  * doscan:  Common code for fortran-callable formatted input routines
   5:  * scann, fscann, sscann.
   6:  *
   7:  * Adapted by Bruce R. Julian, USGS, March 1980,
   8:  * from function printn, by James W. Herriot, USGS, Feb 1980.
   9:  *
  10:  * Additions (by JWH) to printf format syntax are:
  11:  *    1. %n(          where "n" is number of iterations to loop
  12:  *    2. %na          where "n" is size of array
  13:  *    3. %n{          shorthand for "%na %(" -- "%(" will use previous n
  14:  *    4. %) -or- %}   end of loop
  15:  * note that "n" above may be a constant of a "^" meaning a parameter.
  16:  *
  17:  * Modified by Bruce R. Julian,  USGS, Mar 1980 to:
  18:  *     - handle double precision arrays
  19:  *     - accept all scanf formats
  20:  *	(Oops! Except assignment suppression.) BRJ 6 Oct 1980
  21:  */
  22: #define MAX  200
  23: #include <stdio.h>
  24: #include <ctype.h>
  25: #include "ioprim.h"
  26: static FILE *File;
  27: static int  Parptr,Subi,Subz,Arr,**Stk,Nitems;
  28: static char Buf[MAX],*Format;
  29: static union {
  30:     char *S;
  31:     char *C;
  32:     long *L;
  33:     double *D;
  34:     int *I;
  35: }
  36: P;
  37: 
  38: FORTINT doscan(farg,format,params)
  39: FILE *farg;
  40: char format[];
  41: long *params;
  42: {
  43:     File = farg;
  44:     Parptr=Arr=0;
  45:     Stk= params;
  46:     Format=format;
  47:     Nitems=0;
  48:     s_recur(0);
  49:     return((FORTINT)Nitems);
  50: }
  51: s_recur(ptr)
  52: int ptr;
  53: {
  54:     int i,n,lev,o;
  55:     char c;
  56: 
  57:     while( (o=s_eatstr(&ptr,&c,&n)) != -1){
  58:         if(o) {
  59:             for(i=0;i<n;i++)s_recur(ptr);
  60:             lev=1;
  61:             while(lev+=s_eatstr(&ptr,&c,&n));
  62:         }
  63:         else{
  64:             switch(c){
  65:             case 's':       /* STRING */
  66:                 s_onepar(1);
  67:                 Nitems += fscanf(File,Buf, P.S);
  68:                 break;
  69:             case 'c':       /* CHARACTER */
  70:                 s_onepar(1);
  71:                 Nitems += fscanf(File,Buf,P.C);
  72:                 break;
  73:             case 'd':       /* INTEGER*2 */
  74:             case 'o':
  75:             case 'x':
  76:                 s_onepar(1);
  77:                 Nitems += fscanf(File,Buf,P.I);
  78:                 break;
  79:             case 'l':       /* INTEGER *4 */
  80:                 s_onepar(2);
  81:                 Nitems += fscanf(File,Buf,P.L);
  82:                 break;
  83:             case 'e':       /* REAL */
  84:             case 'f':
  85:             case 'g':
  86:                 s_onepar(2);
  87:                 Nitems += fscanf(File,Buf,P.D);
  88:                 break;
  89:             case 'L':       /* DOUBLE PRECISION */
  90:                 s_onepar(4);
  91:                 Nitems += fscanf(File, Buf, P.D);
  92:                 break;
  93:             default:
  94:                 Nitems += fscanf(File,Buf     );
  95:                 break;
  96:             }
  97:         }
  98:     }
  99: }
 100: #define Next  (*cc=c=Buf[b++]=Format[(*ptr)++])
 101: s_eatstr(ptr,cc,n)
 102: int *ptr,*n;
 103: char *cc;
 104: {
 105:     int b=0,rtn=0;
 106:     char c;
 107: 
 108:     *n=0;
 109:     switch(Next){
 110:     case '\0':
 111:         (*ptr)--;
 112:         rtn= -1;
 113:         break;
 114:     case '%':
 115:         while(Next=='-'||c=='.'||c>='0'&&c<='9')*n= *n*10+c-'0';
 116:         if(c=='^'){
 117:             s_onepar(0);
 118:             *n= *P.L;
 119:             Next;
 120:         }
 121:         switch(c){
 122:         case '\0':
 123:             (*ptr)--;
 124:         case  '}':
 125:         case  ')':
 126:             rtn= -1;
 127:             break;
 128:         case  '(':
 129:             *n= (!*n && Arr) ? Subz : *n;
 130:             rtn=1;
 131:             break;
 132:         case  '{':
 133:             rtn=1;
 134:         case  'a':
 135:             Subz= *n;
 136:             Arr=1;
 137:             Subi=b=0;
 138:             *cc='%';
 139:             break;
 140:         case  'n':
 141:             c='D';
 142:         case 'D':
 143:         case 'O':
 144:         case 'X':
 145:             *cc=Buf[b-1]='l';
 146:             Buf[b++]=tolower(c);
 147:             break;
 148:         case 'E':
 149:         case 'F':
 150:             *cc='L';
 151:             break;
 152:         case  'l':
 153:             Next;
 154:             if (c == 'e' || c == 'f')   /* DOUBLE PRECISION */
 155:                 *cc='L';
 156:             else                /* INTEGER*4 */
 157:                 *cc='l';
 158:         }
 159:         break;
 160:     default :
 161:         while(Next!='\0' && c!='%');
 162:         (*ptr)--;
 163:         b--;
 164:         *cc='%';
 165:     }
 166:     Buf[b]='\0';
 167:     return(rtn);
 168: }
 169: /* get one param -- atyp = No. of words/array element (ignored if non-array) */
 170: long s_onepar(atyp)
 171: int atyp;
 172: {
 173:     if(Arr && atyp && Subi>=Subz){
 174:         Arr=0;
 175:         Parptr++;
 176:     }
 177:     if(Arr && atyp)P.S=Stk[Parptr] + (Subi++)*atyp;
 178:     else P.S=Stk[Parptr++];
 179: }

Defined functions

Defined variables

Defined macros