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: }