|
|
1.1 ! root 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: s--; ! 130: op_gen(x,n,0,0); ! 131: break; ! 132: case 'x': op_gen(X,1,0,0); break; ! 133: case 'p': op_gen(P,1,0,0); break; ! 134: } ! 135: s++; ! 136: *p=s; ! 137: return(1); ! 138: } ! 139: e_d(s,p) char *s,**p; ! 140: { int n,w,d,e,found=0,x=0; ! 141: char *sv=s; ! 142: s=gt_num(s,&n); ! 143: op_gen(STACK,n,0,0); ! 144: switch(*s++) ! 145: { ! 146: default: break; ! 147: case 'e': x=1; ! 148: case 'g': ! 149: found=1; ! 150: s=gt_num(s,&w); ! 151: if(w==0) break; ! 152: if(*s=='.') ! 153: { s++; ! 154: s=gt_num(s,&d); ! 155: } ! 156: else d=0; ! 157: if(*s!='E') ! 158: op_gen(x==1?E:G,w,d,0); ! 159: else ! 160: { s++; ! 161: s=gt_num(s,&e); ! 162: op_gen(x==1?EE:GE,w,d,e); ! 163: } ! 164: break; ! 165: case 'o': ! 166: found = 1; ! 167: s = gt_num(s, &w); ! 168: if(w==0) break; ! 169: op_gen(O, w, 0, 0); ! 170: break; ! 171: case 'l': ! 172: found=1; ! 173: s=gt_num(s,&w); ! 174: if(w==0) break; ! 175: op_gen(L,w,0,0); ! 176: break; ! 177: case 'a': ! 178: found=1; ! 179: skip(s); ! 180: if(*s>='0' && *s<='9') ! 181: { s=gt_num(s,&w); ! 182: if(w==0) break; ! 183: op_gen(AW,w,0,0); ! 184: break; ! 185: } ! 186: op_gen(A,0,0,0); ! 187: break; ! 188: case 'f': ! 189: found=1; ! 190: s=gt_num(s,&w); ! 191: if(w==0) break; ! 192: if(*s=='.') ! 193: { s++; ! 194: s=gt_num(s,&d); ! 195: } ! 196: else d=0; ! 197: op_gen(F,w,d,0); ! 198: break; ! 199: case 'd': ! 200: found=1; ! 201: s=gt_num(s,&w); ! 202: if(w==0) break; ! 203: if(*s=='.') ! 204: { s++; ! 205: s=gt_num(s,&d); ! 206: } ! 207: else d=0; ! 208: op_gen(D,w,d,0); ! 209: break; ! 210: case 'i': ! 211: found=1; ! 212: s=gt_num(s,&w); ! 213: if(w==0) break; ! 214: if(*s!='.') ! 215: { op_gen(I,w,0,0); ! 216: break; ! 217: } ! 218: s++; ! 219: s=gt_num(s,&d); ! 220: op_gen(IM,w,d,0); ! 221: break; ! 222: } ! 223: if(found==0) ! 224: { pc--; /*unSTACK*/ ! 225: *p=sv; ! 226: return(0); ! 227: } ! 228: *p=s; ! 229: return(1); ! 230: } ! 231: op_gen(a,b,c,d) ! 232: { struct syl *p= &syl[pc]; ! 233: if(pc>=SYLMX) ! 234: { fprintf(stderr,"format too complicated:\n%s\n", ! 235: fmtbuf); ! 236: abort(); ! 237: } ! 238: p->op=a; ! 239: p->p1=b; ! 240: p->p2=c; ! 241: p->p3=d; ! 242: return(pc++); ! 243: } ! 244: char *gt_num(s,n) char *s; int *n; ! 245: { int m=0,cnt=0; ! 246: char c; ! 247: for(c= *s;;c = *s) ! 248: { if(c==' ') ! 249: { s++; ! 250: continue; ! 251: } ! 252: if(c>'9' || c<'0') break; ! 253: m=10*m+c-'0'; ! 254: cnt++; ! 255: s++; ! 256: } ! 257: if(cnt==0) *n=1; ! 258: else *n=m; ! 259: return(s); ! 260: } ! 261: #define STKSZ 10 ! 262: int cnt[STKSZ],ret[STKSZ],cp,rp; ! 263: flag workdone; ! 264: en_fio() ! 265: { ftnint one=1; ! 266: return(do_fio(&one,NULL,0l)); ! 267: } ! 268: do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr; ! 269: { struct syl *p; ! 270: int n,i; ! 271: for(i=0;i<*number;i++,ptr+=len) ! 272: { ! 273: loop: switch(type_f((p= &syl[pc])->op)) ! 274: { ! 275: default: ! 276: fprintf(stderr,"unknown code in do_fio: %d\n%s\n", ! 277: p->op,fmtbuf); ! 278: err(elist->cierr,100,"do_fio"); ! 279: case NED: ! 280: if((*doned)(p,ptr)) ! 281: { pc++; ! 282: goto loop; ! 283: } ! 284: pc++; ! 285: continue; ! 286: case ED: ! 287: if(cnt[cp]<=0) ! 288: { cp--; ! 289: pc++; ! 290: goto loop; ! 291: } ! 292: if(ptr==NULL) ! 293: return((*doend)()); ! 294: cnt[cp]--; ! 295: workdone=1; ! 296: if((n=(*doed)(p,ptr,len))>0) err(elist->cierr,errno,"fmt"); ! 297: if(n<0) err(elist->ciend,(EOF),"fmt"); ! 298: continue; ! 299: case STACK: ! 300: cnt[++cp]=p->p1; ! 301: pc++; ! 302: goto loop; ! 303: case RET: ! 304: ret[++rp]=p->p1; ! 305: pc++; ! 306: goto loop; ! 307: case GOTO: ! 308: if(--cnt[cp]<=0) ! 309: { cp--; ! 310: rp--; ! 311: pc++; ! 312: goto loop; ! 313: } ! 314: pc=1+ret[rp--]; ! 315: goto loop; ! 316: case REVERT: ! 317: rp=cp=0; ! 318: pc = p->p1; ! 319: if(ptr==NULL) ! 320: return((*doend)()); ! 321: if(!workdone) return(0); ! 322: if((n=(*dorevert)()) != 0) return(n); ! 323: goto loop; ! 324: case COLON: ! 325: if(ptr==NULL) ! 326: return((*doend)()); ! 327: pc++; ! 328: goto loop; ! 329: case S: ! 330: case SS: ! 331: cplus=0; ! 332: pc++; ! 333: goto loop; ! 334: case SP: ! 335: cplus = 1; ! 336: pc++; ! 337: goto loop; ! 338: case P: scale=p->p1; ! 339: pc++; ! 340: goto loop; ! 341: case BN: ! 342: cblank=0; ! 343: pc++; ! 344: goto loop; ! 345: case BZ: ! 346: cblank=1; ! 347: pc++; ! 348: goto loop; ! 349: } ! 350: } ! 351: return(0); ! 352: } ! 353: fmt_bg() ! 354: { ! 355: workdone=cp=rp=pc=cursor=0; ! 356: cnt[0]=ret[0]=0; ! 357: } ! 358: type_f(n) ! 359: { ! 360: switch(n) ! 361: { ! 362: default: ! 363: return(n); ! 364: case RET: ! 365: return(RET); ! 366: case REVERT: return(REVERT); ! 367: case GOTO: return(GOTO); ! 368: case STACK: return(STACK); ! 369: case X: ! 370: case SLASH: ! 371: case APOS: case H: ! 372: case T: case TL: case TR: ! 373: return(NED); ! 374: case F: ! 375: case I: ! 376: case IM: ! 377: case A: case AW: ! 378: case O: ! 379: case L: ! 380: case E: case EE: case D: ! 381: case G: case GE: ! 382: return(ED); ! 383: } ! 384: } ! 385: char *ap_end(s) char *s; ! 386: { char quote; ! 387: quote= *s++; ! 388: for(;*s;s++) ! 389: { if(*s!=quote) continue; ! 390: if(*++s!=quote) return(s); ! 391: } ! 392: err(elist->cierr,100,"bad string"); ! 393: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.