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

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

Defined functions

Defined variables

Defined macros