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