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