|
|
1.1 root 1: #include "f2c.h"
2: #include "fio.h"
3: #include "fmt.h"
4: #define skip(s) while(*s==' ') s++
5: #ifdef interdata
6: #define SYLMX 300
7: #endif
8: #ifdef pdp11
9: #define SYLMX 300
10: #endif
11: #ifdef vax
12: #define SYLMX 300
13: #endif
14: #ifndef SYLMX
15: #define SYLMX 300
16: #endif
17: #define GLITCH '\2'
18: /* special quote character for stu */
19: extern int f__cursor,f__scale;
20: extern flag f__cblank,f__cplus; /*blanks in I and compulsory plus*/
21: struct f__syl f__syl[SYLMX];
22: int f__parenlvl,f__pc,f__revloc;
23:
24: #ifdef KR_headers
25: char *ap_end(s) char *s;
26: #else
27: char *ap_end(char *s)
28: #endif
29: { char quote;
30: quote= *s++;
31: for(;*s;s++)
32: { if(*s!=quote) continue;
33: if(*++s!=quote) return(s);
34: }
35: if(f__elist->cierr) {
36: errno = 100;
37: return(NULL);
38: }
39: f__fatal(100, "bad string");
40: /*NOTREACHED*/ return 0;
41: }
42: #ifdef KR_headers
43: op_gen(a,b,c,d)
44: #else
45: op_gen(int a, int b, int c, int d)
46: #endif
47: { struct f__syl *p= &f__syl[f__pc];
48: if(f__pc>=SYLMX)
49: { fprintf(stderr,"format too complicated:\n");
50: sig_die(f__fmtbuf, 1);
51: }
52: p->op=a;
53: p->p1=b;
54: p->p2=c;
55: p->p3=d;
56: return(f__pc++);
57: }
58: #ifdef KR_headers
59: char *f_list();
60: char *gt_num(s,n) char *s; int *n;
61: #else
62: char *f_list(char*);
63: char *gt_num(char *s, int *n)
64: #endif
65: { int m=0,f__cnt=0;
66: char c;
67: for(c= *s;;c = *s)
68: { if(c==' ')
69: { s++;
70: continue;
71: }
72: if(c>'9' || c<'0') break;
73: m=10*m+c-'0';
74: f__cnt++;
75: s++;
76: }
77: if(f__cnt==0) *n=1;
78: else *n=m;
79: return(s);
80: }
81: #ifdef KR_headers
82: char *f_s(s,curloc) char *s;
83: #else
84: char *f_s(char *s, int curloc)
85: #endif
86: {
87: skip(s);
88: if(*s++!='(')
89: {
90: return(NULL);
91: }
92: if(f__parenlvl++ ==1) f__revloc=curloc;
93: if(op_gen(RET1,curloc,0,0)<0 ||
94: (s=f_list(s))==NULL)
95: {
96: return(NULL);
97: }
98: skip(s);
99: return(s);
100: }
101: #ifdef KR_headers
102: ne_d(s,p) char *s,**p;
103: #else
104: ne_d(char *s, char **p)
105: #endif
106: { int n,x,sign=0;
107: struct f__syl *sp;
108: switch(*s)
109: {
110: default:
111: return(0);
112: case ':': (void) op_gen(COLON,0,0,0); break;
113: case '$':
114: (void) op_gen(NONL, 0, 0, 0); break;
115: case 'B':
116: case 'b':
117: if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
118: else (void) op_gen(BN,0,0,0);
119: break;
120: case 'S':
121: case 's':
122: if(*(s+1)=='s' || *(s+1) == 'S')
123: { x=SS;
124: s++;
125: }
126: else if(*(s+1)=='p' || *(s+1) == 'P')
127: { x=SP;
128: s++;
129: }
130: else x=S;
131: (void) op_gen(x,0,0,0);
132: break;
133: case '/': (void) op_gen(SLASH,0,0,0); break;
134: case '-': sign=1;
135: case '+': s++; /*OUTRAGEOUS CODING TRICK*/
136: case '0': case '1': case '2': case '3': case '4':
137: case '5': case '6': case '7': case '8': case '9':
138: s=gt_num(s,&n);
139: switch(*s)
140: {
141: default:
142: return(0);
143: case 'P':
144: case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
145: case 'X':
146: case 'x': (void) op_gen(X,n,0,0); break;
147: case 'H':
148: case 'h':
149: sp = &f__syl[op_gen(H,n,0,0)];
150: *(char **)&sp->p2 = s + 1;
151: s+=n;
152: break;
153: }
154: break;
155: case GLITCH:
156: case '"':
157: case '\'':
158: sp = &f__syl[op_gen(APOS,0,0,0)];
159: *(char **)&sp->p2 = s;
160: if((*p = ap_end(s)) == NULL)
161: return(0);
162: return(1);
163: case 'T':
164: case 't':
165: if(*(s+1)=='l' || *(s+1) == 'L')
166: { x=TL;
167: s++;
168: }
169: else if(*(s+1)=='r'|| *(s+1) == 'R')
170: { x=TR;
171: s++;
172: }
173: else x=T;
174: s=gt_num(s+1,&n);
175: s--;
176: (void) op_gen(x,n,0,0);
177: break;
178: case 'X':
179: case 'x': (void) op_gen(X,1,0,0); break;
180: case 'P':
181: case 'p': (void) op_gen(P,1,0,0); break;
182: }
183: s++;
184: *p=s;
185: return(1);
186: }
187: #ifdef KR_headers
188: e_d(s,p) char *s,**p;
189: #else
190: e_d(char *s, char **p)
191: #endif
192: { int i,im,n,w,d,e,found=0,x=0;
193: char *sv=s;
194: s=gt_num(s,&n);
195: (void) op_gen(STACK,n,0,0);
196: switch(*s++)
197: {
198: default: break;
199: case 'E':
200: case 'e': x=1;
201: case 'G':
202: case 'g':
203: found=1;
204: s=gt_num(s,&w);
205: if(w==0) break;
206: if(*s=='.')
207: { s++;
208: s=gt_num(s,&d);
209: }
210: else d=0;
211: if(*s!='E' && *s != 'e')
212: (void) op_gen(x==1?E:G,w,d,0); /* default is Ew.dE2 */
213: else
214: { s++;
215: s=gt_num(s,&e);
216: (void) op_gen(x==1?EE:GE,w,d,e);
217: }
218: break;
219: case 'O':
220: case 'o':
221: i = O;
222: im = OM;
223: goto finish_I;
224: case 'Z':
225: case 'z':
226: i = Z;
227: im = ZM;
228: goto finish_I;
229: case 'L':
230: case 'l':
231: found=1;
232: s=gt_num(s,&w);
233: if(w==0) break;
234: (void) op_gen(L,w,0,0);
235: break;
236: case 'A':
237: case 'a':
238: found=1;
239: skip(s);
240: if(*s>='0' && *s<='9')
241: { s=gt_num(s,&w);
242: if(w==0) break;
243: (void) op_gen(AW,w,0,0);
244: break;
245: }
246: (void) op_gen(A,0,0,0);
247: break;
248: case 'F':
249: case 'f':
250: found=1;
251: s=gt_num(s,&w);
252: if(w==0) break;
253: if(*s=='.')
254: { s++;
255: s=gt_num(s,&d);
256: }
257: else d=0;
258: (void) op_gen(F,w,d,0);
259: break;
260: case 'D':
261: case 'd':
262: found=1;
263: s=gt_num(s,&w);
264: if(w==0) break;
265: if(*s=='.')
266: { s++;
267: s=gt_num(s,&d);
268: }
269: else d=0;
270: (void) op_gen(D,w,d,0);
271: break;
272: case 'I':
273: case 'i':
274: i = I;
275: im = IM;
276: finish_I:
277: found=1;
278: s=gt_num(s,&w);
279: if(w==0) break;
280: if(*s!='.')
281: { (void) op_gen(i,w,0,0);
282: break;
283: }
284: s++;
285: s=gt_num(s,&d);
286: (void) op_gen(im,w,d,0);
287: break;
288: }
289: if(found==0)
290: { f__pc--; /*unSTACK*/
291: *p=sv;
292: return(0);
293: }
294: *p=s;
295: return(1);
296: }
297: #ifdef KR_headers
298: char *i_tem(s) char *s;
299: #else
300: char *i_tem(char *s)
301: #endif
302: { char *t;
303: int n,curloc;
304: if(*s==')') return(s);
305: if(ne_d(s,&t)) return(t);
306: if(e_d(s,&t)) return(t);
307: s=gt_num(s,&n);
308: if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
309: return(f_s(s,curloc));
310: }
311: #ifdef KR_headers
312: char *f_list(s) char *s;
313: #else
314: char *f_list(char *s)
315: #endif
316: {
317: for(;*s!=0;)
318: { skip(s);
319: if((s=i_tem(s))==NULL) return(NULL);
320: skip(s);
321: if(*s==',') s++;
322: else if(*s==')')
323: { if(--f__parenlvl==0)
324: {
325: (void) op_gen(REVERT,f__revloc,0,0);
326: return(++s);
327: }
328: (void) op_gen(GOTO,0,0,0);
329: return(++s);
330: }
331: }
332: return(NULL);
333: }
334:
335: #ifdef KR_headers
336: pars_f(s) char *s;
337: #else
338: pars_f(char *s)
339: #endif
340: {
341: f__parenlvl=f__revloc=f__pc=0;
342: if(f_s(s,0) == NULL)
343: {
344: return(-1);
345: }
346: return(0);
347: }
348: #define STKSZ 10
349: int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp;
350: flag f__workdone, f__nonl;
351:
352: #ifdef KR_headers
353: type_f(n)
354: #else
355: type_f(int n)
356: #endif
357: {
358: switch(n)
359: {
360: default:
361: return(n);
362: case RET1:
363: return(RET1);
364: case REVERT: return(REVERT);
365: case GOTO: return(GOTO);
366: case STACK: return(STACK);
367: case X:
368: case SLASH:
369: case APOS: case H:
370: case T: case TL: case TR:
371: return(NED);
372: case F:
373: case I:
374: case IM:
375: case A: case AW:
376: case O: case OM:
377: case L:
378: case E: case EE: case D:
379: case G: case GE:
380: case Z: case ZM:
381: return(ED);
382: }
383: }
384: #ifdef KR_headers
385: integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
386: #else
387: integer do_fio(ftnint *number, char *ptr, ftnlen len)
388: #endif
389: { struct f__syl *p;
390: int n,i;
391: for(i=0;i<*number;i++,ptr+=len)
392: {
393: loop: switch(type_f((p= &f__syl[f__pc])->op))
394: {
395: default:
396: fprintf(stderr,"unknown code in do_fio: %d\n%s\n",
397: p->op,f__fmtbuf);
398: err(f__elist->cierr,100,"do_fio");
399: case NED:
400: if((*f__doned)(p))
401: { f__pc++;
402: goto loop;
403: }
404: f__pc++;
405: continue;
406: case ED:
407: if(f__cnt[f__cp]<=0)
408: { f__cp--;
409: f__pc++;
410: goto loop;
411: }
412: if(ptr==NULL)
413: return((*f__doend)());
414: f__cnt[f__cp]--;
415: f__workdone=1;
416: if((n=(*f__doed)(p,ptr,len))>0)
417: errfl(f__elist->cierr,errno,"fmt");
418: if(n<0)
419: err(f__elist->ciend,(EOF),"fmt");
420: continue;
421: case STACK:
422: f__cnt[++f__cp]=p->p1;
423: f__pc++;
424: goto loop;
425: case RET1:
426: f__ret[++f__rp]=p->p1;
427: f__pc++;
428: goto loop;
429: case GOTO:
430: if(--f__cnt[f__cp]<=0)
431: { f__cp--;
432: f__rp--;
433: f__pc++;
434: goto loop;
435: }
436: f__pc=1+f__ret[f__rp--];
437: goto loop;
438: case REVERT:
439: f__rp=f__cp=0;
440: f__pc = p->p1;
441: if(ptr==NULL)
442: return((*f__doend)());
443: if(!f__workdone) return(0);
444: if((n=(*f__dorevert)()) != 0) return(n);
445: goto loop;
446: case COLON:
447: if(ptr==NULL)
448: return((*f__doend)());
449: f__pc++;
450: goto loop;
451: case NONL:
452: f__nonl = 1;
453: f__pc++;
454: goto loop;
455: case S:
456: case SS:
457: f__cplus=0;
458: f__pc++;
459: goto loop;
460: case SP:
461: f__cplus = 1;
462: f__pc++;
463: goto loop;
464: case P: f__scale=p->p1;
465: f__pc++;
466: goto loop;
467: case BN:
468: f__cblank=0;
469: f__pc++;
470: goto loop;
471: case BZ:
472: f__cblank=1;
473: f__pc++;
474: goto loop;
475: }
476: }
477: return(0);
478: }
479: en_fio(Void)
480: { ftnint one=1;
481: return(do_fio(&one,(char *)NULL,(ftnint)0));
482: }
483: VOID
484: fmt_bg(Void)
485: {
486: f__workdone=f__cp=f__rp=f__pc=f__cursor=0;
487: f__cnt[0]=f__ret[0]=0;
488: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.