|
|
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.