1: #include "fio.h"
   2: #include "fmt.h"
   3: #define skip(s) while(*s==' ') s++
   4: #ifdef interdata
   5: #define SYLMX 300
   6: #endif
   7: #ifdef pdp11
   8: #define SYLMX 300
   9: #endif
  10: #ifdef vax
  11: #define SYLMX 300
  12: #endif
  13: #define GLITCH '\2'
  14:     /* special quote character for stu */
  15: extern int cursor,scale;
  16: extern flag cblank,cplus;   /*blanks in I and compulsory plus*/
  17: struct syl syl[SYLMX];
  18: int parenlvl,pc,revloc;
  19: char *f_s(),*f_list(),*i_tem(),*gt_num();
  20: pars_f(s) char *s;
  21: {
  22:     parenlvl=revloc=pc=0;
  23:     if((s=f_s(s,0))==NULL)
  24:     {
  25:         return(-1);
  26:     }
  27:     return(0);
  28: }
  29: char *f_s(s,curloc) char *s;
  30: {
  31:     skip(s);
  32:     if(*s++!='(')
  33:     {
  34:         return(NULL);
  35:     }
  36:     if(parenlvl++ ==1) revloc=curloc;
  37:     if(op_gen(RET,curloc,0,0)<0 ||
  38:         (s=f_list(s))==NULL)
  39:     {
  40:         return(NULL);
  41:     }
  42:     skip(s);
  43:     return(s);
  44: }
  45: char *f_list(s) char *s;
  46: {
  47:     for(;*s!=0;)
  48:     {   skip(s);
  49:         if((s=i_tem(s))==NULL) return(NULL);
  50:         skip(s);
  51:         if(*s==',') s++;
  52:         else if(*s==')')
  53:         {   if(--parenlvl==0)
  54:             {
  55:                 op_gen(REVERT,revloc,0,0);
  56:                 return(++s);
  57:             }
  58:             op_gen(GOTO,0,0,0);
  59:             return(++s);
  60:         }
  61:     }
  62:     return(NULL);
  63: }
  64: char *i_tem(s) char *s;
  65: {   char *t;
  66:     int n,curloc;
  67:     if(*s==')') return(s);
  68:     if(ne_d(s,&t)) return(t);
  69:     if(e_d(s,&t)) return(t);
  70:     s=gt_num(s,&n);
  71:     if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
  72:     return(f_s(s,curloc));
  73: }
  74: ne_d(s,p) char *s,**p;
  75: {   int n,x,sign=0;
  76:     char *ap_end();
  77:     switch(*s)
  78:     {
  79:     default: return(0);
  80:     case ':': op_gen(COLON,0,0,0); break;
  81:     case 'b':
  82:         if(*++s=='z') op_gen(BZ,0,0,0);
  83:         else op_gen(BN,0,0,0);
  84:         break;
  85:     case 's':
  86:         if(*(s+1)=='s')
  87:         {   x=SS;
  88:             s++;
  89:         }
  90:         else if(*(s+1)=='p')
  91:         {   x=SP;
  92:             s++;
  93:         }
  94:         else x=S;
  95:         op_gen(x,0,0,0);
  96:         break;
  97:     case '/': op_gen(SLASH,0,0,0); break;
  98:     case '-': sign=1; s++;  /*OUTRAGEOUS CODING TRICK*/
  99:     case '0': case '1': case '2': case '3': case '4':
 100:     case '5': case '6': case '7': case '8': case '9':
 101:         s=gt_num(s,&n);
 102:         switch(*s)
 103:         {
 104:         default: return(0);
 105:         case 'p': if(sign) n= -n; op_gen(P,n,0,0); break;
 106:         case 'x': op_gen(X,n,0,0); break;
 107:         case 'H':
 108:         case 'h': op_gen(H,n,(int)(s+1),0);
 109:             s+=n;
 110:             break;
 111:         }
 112:         break;
 113:     case GLITCH:
 114:     case '"':
 115:     case '\'': op_gen(APOS,(int)s,0,0);
 116:         *p=ap_end(s);
 117:         return(1);
 118:     case 't':
 119:         if(*(s+1)=='l')
 120:         {   x=TL;
 121:             s++;
 122:         }
 123:         else if(*(s+1)=='r')
 124:         {   x=TR;
 125:             s++;
 126:         }
 127:         else x=T;
 128:         s=gt_num(s+1,&n);
 129:         op_gen(x,n,0,0);
 130:         break;
 131:     case 'x': op_gen(X,1,0,0); break;
 132:     case 'p': op_gen(P,1,0,0); break;
 133:     }
 134:     s++;
 135:     *p=s;
 136:     return(1);
 137: }
 138: e_d(s,p) char *s,**p;
 139: {   int n,w,d,e,found=0,x=0;
 140:     char *sv=s;
 141:     s=gt_num(s,&n);
 142:     op_gen(STACK,n,0,0);
 143:     switch(*s++)
 144:     {
 145:     default: break;
 146:     case 'e':   x=1;
 147:     case 'g':
 148:         found=1;
 149:         s=gt_num(s,&w);
 150:         if(w==0) break;
 151:         if(*s=='.')
 152:         {   s++;
 153:             s=gt_num(s,&d);
 154:         }
 155:         else d=0;
 156:         if(*s!='E')
 157:             op_gen(x==1?E:G,w,d,0);
 158:         else
 159:         {   s++;
 160:             s=gt_num(s,&e);
 161:             op_gen(x==1?EE:GE,w,d,e);
 162:         }
 163:         break;
 164:     case 'o':
 165:         found = 1;
 166:         s = gt_num(s, &w);
 167:         if(w==0) break;
 168:         op_gen(O, w, 0, 0);
 169:         break;
 170:     case 'l':
 171:         found=1;
 172:         s=gt_num(s,&w);
 173:         if(w==0) break;
 174:         op_gen(L,w,0,0);
 175:         break;
 176:     case 'a':
 177:         found=1;
 178:         skip(s);
 179:         if(*s>='0' && *s<='9')
 180:         {   s=gt_num(s,&w);
 181:             if(w==0) break;
 182:             op_gen(AW,w,0,0);
 183:             break;
 184:         }
 185:         op_gen(A,0,0,0);
 186:         break;
 187:     case 'f':
 188:         found=1;
 189:         s=gt_num(s,&w);
 190:         if(w==0) break;
 191:         if(*s=='.')
 192:         {   s++;
 193:             s=gt_num(s,&d);
 194:         }
 195:         else d=0;
 196:         op_gen(F,w,d,0);
 197:         break;
 198:     case 'd':
 199:         found=1;
 200:         s=gt_num(s,&w);
 201:         if(w==0) break;
 202:         if(*s=='.')
 203:         {   s++;
 204:             s=gt_num(s,&d);
 205:         }
 206:         else d=0;
 207:         op_gen(D,w,d,0);
 208:         break;
 209:     case 'i':
 210:         found=1;
 211:         s=gt_num(s,&w);
 212:         if(w==0) break;
 213:         if(*s!='.')
 214:         {   op_gen(I,w,0,0);
 215:             break;
 216:         }
 217:         s++;
 218:         s=gt_num(s,&d);
 219:         op_gen(IM,w,d,0);
 220:         break;
 221:     }
 222:     if(found==0)
 223:     {   pc--; /*unSTACK*/
 224:         *p=sv;
 225:         return(0);
 226:     }
 227:     *p=s;
 228:     return(1);
 229: }
 230: op_gen(a,b,c,d)
 231: {   struct syl *p= &syl[pc];
 232:     if(pc>=SYLMX)
 233:     {   fprintf(stderr,"format too complicated:\n%s\n",
 234:             fmtbuf);
 235:         abort();
 236:     }
 237:     p->op=a;
 238:     p->p1=b;
 239:     p->p2=c;
 240:     p->p3=d;
 241:     return(pc++);
 242: }
 243: char *gt_num(s,n) char *s; int *n;
 244: {   int m=0,cnt=0;
 245:     char c;
 246:     for(c= *s;;c = *s)
 247:     {   if(c==' ')
 248:         {   s++;
 249:             continue;
 250:         }
 251:         if(c>'9' || c<'0') break;
 252:         m=10*m+c-'0';
 253:         cnt++;
 254:         s++;
 255:     }
 256:     if(cnt==0) *n=1;
 257:     else *n=m;
 258:     return(s);
 259: }
 260: #define STKSZ 10
 261: int cnt[STKSZ],ret[STKSZ],cp,rp;
 262: flag workdone;
 263: en_fio()
 264: {   ftnint one=1;
 265:     return(do_fio(&one,NULL,0l));
 266: }
 267: do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
 268: {   struct syl *p;
 269:     int n,i;
 270:     for(i=0;i<*number;i++,ptr+=len)
 271:     {
 272: loop:   switch(type_f((p= &syl[pc])->op))
 273:     {
 274:     default:
 275:         fprintf(stderr,"unknown code in do_fio: %d\n%s\n",
 276:             p->op,fmtbuf);
 277:         err(elist->cierr,100,"do_fio");
 278:     case NED:
 279:         if((*doned)(p,ptr))
 280:         {   pc++;
 281:             goto loop;
 282:         }
 283:         pc++;
 284:         continue;
 285:     case ED:
 286:         if(cnt[cp]<=0)
 287:         {   cp--;
 288:             pc++;
 289:             goto loop;
 290:         }
 291:         if(ptr==NULL)
 292:             return((*doend)());
 293:         cnt[cp]--;
 294:         workdone=1;
 295:         if((n=(*doed)(p,ptr,len))>0) err(elist->cierr,errno,"fmt");
 296:         if(n<0) err(elist->ciend,(EOF),"fmt");
 297:         continue;
 298:     case STACK:
 299:         cnt[++cp]=p->p1;
 300:         pc++;
 301:         goto loop;
 302:     case RET:
 303:         ret[++rp]=p->p1;
 304:         pc++;
 305:         goto loop;
 306:     case GOTO:
 307:         if(--cnt[cp]<=0)
 308:         {   cp--;
 309:             rp--;
 310:             pc++;
 311:             goto loop;
 312:         }
 313:         pc=1+ret[rp--];
 314:         goto loop;
 315:     case REVERT:
 316:         rp=cp=0;
 317:         pc = p->p1;
 318:         if(ptr==NULL)
 319:             return((*doend)());
 320:         if(!workdone) return(0);
 321:         if((n=(*dorevert)()) != 0) return(n);
 322:         goto loop;
 323:     case COLON:
 324:         if(ptr==NULL)
 325:             return((*doend)());
 326:         pc++;
 327:         goto loop;
 328:     case S:
 329:     case SS:
 330:         cplus=0;
 331:         pc++;
 332:         goto loop;
 333:     case SP:
 334:         cplus = 1;
 335:         pc++;
 336:         goto loop;
 337:     case P: scale=p->p1;
 338:         pc++;
 339:         goto loop;
 340:     case BN:
 341:         cblank=0;
 342:         pc++;
 343:         goto loop;
 344:     case BZ:
 345:         cblank=1;
 346:         pc++;
 347:         goto loop;
 348:     }
 349:     }
 350:     return(0);
 351: }
 352: fmt_bg()
 353: {
 354:     workdone=cp=rp=pc=cursor=0;
 355:     cnt[0]=ret[0]=0;
 356: }
 357: type_f(n)
 358: {
 359:     switch(n)
 360:     {
 361:     default:
 362:         return(n);
 363:     case RET:
 364:         return(RET);
 365:     case REVERT: return(REVERT);
 366:     case GOTO: return(GOTO);
 367:     case STACK: return(STACK);
 368:     case X:
 369:     case SLASH:
 370:     case APOS: case H:
 371:     case T: case TL: case TR:
 372:         return(NED);
 373:     case F:
 374:     case I:
 375:     case IM:
 376:     case A: case AW:
 377:     case O:
 378:     case L:
 379:     case E: case EE: case D:
 380:     case G: case GE:
 381:         return(ED);
 382:     }
 383: }
 384: char *ap_end(s) char *s;
 385: {   char quote;
 386:     quote= *s++;
 387:     for(;*s;s++)
 388:     {   if(*s!=quote) continue;
 389:         if(*++s!=quote) return(s);
 390:     }
 391:     err(elist->cierr,100,"bad string");
 392: }

Defined functions

ap_end defined in line 384; used 2 times
do_fio defined in line 267; used 1 times
e_d defined in line 138; used 1 times
  • in line 69
en_fio defined in line 263; used 5 times
f_list defined in line 45; used 2 times
f_s defined in line 29; used 3 times
fmt_bg defined in line 352; used 5 times
gt_num defined in line 243; used 17 times
i_tem defined in line 64; used 2 times
ne_d defined in line 74; used 1 times
  • in line 68
op_gen defined in line 230; used 27 times
pars_f defined in line 20; used 5 times
type_f defined in line 357; used 1 times

Defined variables

cnt defined in line 261; used 8 times
cp defined in line 261; used 8 times
parenlvl defined in line 18; used 3 times
pc defined in line 18; used 21 times
ret defined in line 261; used 3 times
revloc defined in line 18; used 3 times
rp defined in line 261; used 5 times
syl defined in line 17; used 2 times
workdone defined in line 262; used 3 times

Defined macros

GLITCH defined in line 13; never used
STKSZ defined in line 260; used 2 times
  • in line 261(2)
SYLMX defined in line 11; used 2 times
skip defined in line 3; used 5 times
Last modified: 1979-05-03
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1146
Valid CSS Valid XHTML 1.0 Strict