00001 #include "f2c.h"
00002 #include "fio.h"
00003 #include "fmt.h"
00004 #define skip(s) while(*s==' ') s++
00005 #ifdef interdata
00006 #define SYLMX 300
00007 #endif
00008 #ifdef pdp11
00009 #define SYLMX 300
00010 #endif
00011 #ifdef vax
00012 #define SYLMX 300
00013 #endif
00014 #ifndef SYLMX
00015 #define SYLMX 300
00016 #endif
00017 #define GLITCH '\2'
00018
00019 extern int f__cursor,f__scale;
00020 extern flag f__cblank,f__cplus;
00021 struct syl f__syl[SYLMX];
00022 int f__parenlvl,f__pc,f__revloc;
00023
00024 #ifdef KR_headers
00025 char *ap_end(s) char *s;
00026 #else
00027 char *ap_end(char *s)
00028 #endif
00029 { char quote;
00030 quote= *s++;
00031 for(;*s;s++)
00032 { if(*s!=quote) continue;
00033 if(*++s!=quote) return(s);
00034 }
00035 if(f__elist->cierr) {
00036 errno = 100;
00037 return(NULL);
00038 }
00039 f__fatal(100, "bad string");
00040 return 0;
00041 }
00042 #ifdef KR_headers
00043 op_gen(a,b,c,d)
00044 #else
00045 op_gen(int a, int b, int c, int d)
00046 #endif
00047 { struct syl *p= &f__syl[f__pc];
00048 if(f__pc>=SYLMX)
00049 { fprintf(stderr,"format too complicated:\n");
00050 sig_die(f__fmtbuf, 1);
00051 }
00052 p->op=a;
00053 p->p1=b;
00054 p->p2=c;
00055 p->p3=d;
00056 return(f__pc++);
00057 }
00058 #ifdef KR_headers
00059 char *f_list();
00060 char *gt_num(s,n) char *s; int *n;
00061 #else
00062 char *f_list(char*);
00063 char *gt_num(char *s, int *n)
00064 #endif
00065 { int m=0,f__cnt=0;
00066 char c;
00067 for(c= *s;;c = *s)
00068 { if(c==' ')
00069 { s++;
00070 continue;
00071 }
00072 if(c>'9' || c<'0') break;
00073 m=10*m+c-'0';
00074 f__cnt++;
00075 s++;
00076 }
00077 if(f__cnt==0) *n=1;
00078 else *n=m;
00079 return(s);
00080 }
00081 #ifdef KR_headers
00082 char *f_s(s,curloc) char *s;
00083 #else
00084 char *f_s(char *s, int curloc)
00085 #endif
00086 {
00087 skip(s);
00088 if(*s++!='(')
00089 {
00090 return(NULL);
00091 }
00092 if(f__parenlvl++ ==1) f__revloc=curloc;
00093 if(op_gen(RET1,curloc,0,0)<0 ||
00094 (s=f_list(s))==NULL)
00095 {
00096 return(NULL);
00097 }
00098 skip(s);
00099 return(s);
00100 }
00101 #ifdef KR_headers
00102 ne_d(s,p) char *s,**p;
00103 #else
00104 ne_d(char *s, char **p)
00105 #endif
00106 { int n,x,sign=0;
00107 struct syl *sp;
00108 switch(*s)
00109 {
00110 default:
00111 return(0);
00112 case ':': (void) op_gen(COLON,0,0,0); break;
00113 case '$':
00114 (void) op_gen(NONL, 0, 0, 0); break;
00115 case 'B':
00116 case 'b':
00117 if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
00118 else (void) op_gen(BN,0,0,0);
00119 break;
00120 case 'S':
00121 case 's':
00122 if(*(s+1)=='s' || *(s+1) == 'S')
00123 { x=SS;
00124 s++;
00125 }
00126 else if(*(s+1)=='p' || *(s+1) == 'P')
00127 { x=SP;
00128 s++;
00129 }
00130 else x=S;
00131 (void) op_gen(x,0,0,0);
00132 break;
00133 case '/': (void) op_gen(SLASH,0,0,0); break;
00134 case '-': sign=1;
00135 case '+': s++;
00136 case '0': case '1': case '2': case '3': case '4':
00137 case '5': case '6': case '7': case '8': case '9':
00138 s=gt_num(s,&n);
00139 switch(*s)
00140 {
00141 default:
00142 return(0);
00143 case 'P':
00144 case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
00145 case 'X':
00146 case 'x': (void) op_gen(X,n,0,0); break;
00147 case 'H':
00148 case 'h':
00149 sp = &f__syl[op_gen(H,n,0,0)];
00150 *(char **)&sp->p2 = s + 1;
00151 s+=n;
00152 break;
00153 }
00154 break;
00155 case GLITCH:
00156 case '"':
00157 case '\'':
00158 sp = &f__syl[op_gen(APOS,0,0,0)];
00159 *(char **)&sp->p2 = s;
00160 if((*p = ap_end(s)) == NULL)
00161 return(0);
00162 return(1);
00163 case 'T':
00164 case 't':
00165 if(*(s+1)=='l' || *(s+1) == 'L')
00166 { x=TL;
00167 s++;
00168 }
00169 else if(*(s+1)=='r'|| *(s+1) == 'R')
00170 { x=TR;
00171 s++;
00172 }
00173 else x=T;
00174 s=gt_num(s+1,&n);
00175 s--;
00176 (void) op_gen(x,n,0,0);
00177 break;
00178 case 'X':
00179 case 'x': (void) op_gen(X,1,0,0); break;
00180 case 'P':
00181 case 'p': (void) op_gen(P,1,0,0); break;
00182 }
00183 s++;
00184 *p=s;
00185 return(1);
00186 }
00187 #ifdef KR_headers
00188 e_d(s,p) char *s,**p;
00189 #else
00190 e_d(char *s, char **p)
00191 #endif
00192 { int i,im,n,w,d,e,found=0,x=0;
00193 char *sv=s;
00194 s=gt_num(s,&n);
00195 (void) op_gen(STACK,n,0,0);
00196 switch(*s++)
00197 {
00198 default: break;
00199 case 'E':
00200 case 'e': x=1;
00201 case 'G':
00202 case 'g':
00203 found=1;
00204 s=gt_num(s,&w);
00205 if(w==0) break;
00206 if(*s=='.')
00207 { s++;
00208 s=gt_num(s,&d);
00209 }
00210 else d=0;
00211 if(*s!='E' && *s != 'e')
00212 (void) op_gen(x==1?E:G,w,d,0);
00213 else
00214 { s++;
00215 s=gt_num(s,&e);
00216 (void) op_gen(x==1?EE:GE,w,d,e);
00217 }
00218 break;
00219 case 'O':
00220 case 'o':
00221 i = O;
00222 im = OM;
00223 goto finish_I;
00224 case 'Z':
00225 case 'z':
00226 i = Z;
00227 im = ZM;
00228 goto finish_I;
00229 case 'L':
00230 case 'l':
00231 found=1;
00232 s=gt_num(s,&w);
00233 if(w==0) break;
00234 (void) op_gen(L,w,0,0);
00235 break;
00236 case 'A':
00237 case 'a':
00238 found=1;
00239 skip(s);
00240 if(*s>='0' && *s<='9')
00241 { s=gt_num(s,&w);
00242 if(w==0) break;
00243 (void) op_gen(AW,w,0,0);
00244 break;
00245 }
00246 (void) op_gen(A,0,0,0);
00247 break;
00248 case 'F':
00249 case 'f':
00250 found=1;
00251 s=gt_num(s,&w);
00252 if(w==0) break;
00253 if(*s=='.')
00254 { s++;
00255 s=gt_num(s,&d);
00256 }
00257 else d=0;
00258 (void) op_gen(F,w,d,0);
00259 break;
00260 case 'D':
00261 case 'd':
00262 found=1;
00263 s=gt_num(s,&w);
00264 if(w==0) break;
00265 if(*s=='.')
00266 { s++;
00267 s=gt_num(s,&d);
00268 }
00269 else d=0;
00270 (void) op_gen(D,w,d,0);
00271 break;
00272 case 'I':
00273 case 'i':
00274 i = I;
00275 im = IM;
00276 finish_I:
00277 found=1;
00278 s=gt_num(s,&w);
00279 if(w==0) break;
00280 if(*s!='.')
00281 { (void) op_gen(i,w,0,0);
00282 break;
00283 }
00284 s++;
00285 s=gt_num(s,&d);
00286 (void) op_gen(im,w,d,0);
00287 break;
00288 }
00289 if(found==0)
00290 { f__pc--;
00291 *p=sv;
00292 return(0);
00293 }
00294 *p=s;
00295 return(1);
00296 }
00297 #ifdef KR_headers
00298 char *i_tem(s) char *s;
00299 #else
00300 char *i_tem(char *s)
00301 #endif
00302 { char *t;
00303 int n,curloc;
00304 if(*s==')') return(s);
00305 if(ne_d(s,&t)) return(t);
00306 if(e_d(s,&t)) return(t);
00307 s=gt_num(s,&n);
00308 if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
00309 return(f_s(s,curloc));
00310 }
00311 #ifdef KR_headers
00312 char *f_list(s) char *s;
00313 #else
00314 char *f_list(char *s)
00315 #endif
00316 {
00317 for(;*s!=0;)
00318 { skip(s);
00319 if((s=i_tem(s))==NULL) return(NULL);
00320 skip(s);
00321 if(*s==',') s++;
00322 else if(*s==')')
00323 { if(--f__parenlvl==0)
00324 {
00325 (void) op_gen(REVERT,f__revloc,0,0);
00326 return(++s);
00327 }
00328 (void) op_gen(GOTO,0,0,0);
00329 return(++s);
00330 }
00331 }
00332 return(NULL);
00333 }
00334
00335 #ifdef KR_headers
00336 pars_f(s) char *s;
00337 #else
00338 pars_f(char *s)
00339 #endif
00340 {
00341 f__parenlvl=f__revloc=f__pc=0;
00342 if(f_s(s,0) == NULL)
00343 {
00344 return(-1);
00345 }
00346 return(0);
00347 }
00348 #define STKSZ 10
00349 int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp;
00350 flag f__workdone, f__nonl;
00351
00352 #ifdef KR_headers
00353 type_f(n)
00354 #else
00355 type_f(int n)
00356 #endif
00357 {
00358 switch(n)
00359 {
00360 default:
00361 return(n);
00362 case RET1:
00363 return(RET1);
00364 case REVERT: return(REVERT);
00365 case GOTO: return(GOTO);
00366 case STACK: return(STACK);
00367 case X:
00368 case SLASH:
00369 case APOS: case H:
00370 case T: case TL: case TR:
00371 return(NED);
00372 case F:
00373 case I:
00374 case IM:
00375 case A: case AW:
00376 case O: case OM:
00377 case L:
00378 case E: case EE: case D:
00379 case G: case GE:
00380 case Z: case ZM:
00381 return(ED);
00382 }
00383 }
00384 #ifdef KR_headers
00385 integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
00386 #else
00387 integer do_fio(ftnint *number, char *ptr, ftnlen len)
00388 #endif
00389 { struct syl *p;
00390 int n,i;
00391 for(i=0;i<*number;i++,ptr+=len)
00392 {
00393 loop: switch(type_f((p= &f__syl[f__pc])->op))
00394 {
00395 default:
00396 fprintf(stderr,"unknown code in do_fio: %d\n%s\n",
00397 p->op,f__fmtbuf);
00398 err(f__elist->cierr,100,"do_fio");
00399 case NED:
00400 if((*f__doned)(p))
00401 { f__pc++;
00402 goto loop;
00403 }
00404 f__pc++;
00405 continue;
00406 case ED:
00407 if(f__cnt[f__cp]<=0)
00408 { f__cp--;
00409 f__pc++;
00410 goto loop;
00411 }
00412 if(ptr==NULL)
00413 return((*f__doend)());
00414 f__cnt[f__cp]--;
00415 f__workdone=1;
00416 if((n=(*f__doed)(p,ptr,len))>0)
00417 errfl(f__elist->cierr,errno,"fmt");
00418 if(n<0)
00419 err(f__elist->ciend,(EOF),"fmt");
00420 continue;
00421 case STACK:
00422 f__cnt[++f__cp]=p->p1;
00423 f__pc++;
00424 goto loop;
00425 case RET1:
00426 f__ret[++f__rp]=p->p1;
00427 f__pc++;
00428 goto loop;
00429 case GOTO:
00430 if(--f__cnt[f__cp]<=0)
00431 { f__cp--;
00432 f__rp--;
00433 f__pc++;
00434 goto loop;
00435 }
00436 f__pc=1+f__ret[f__rp--];
00437 goto loop;
00438 case REVERT:
00439 f__rp=f__cp=0;
00440 f__pc = p->p1;
00441 if(ptr==NULL)
00442 return((*f__doend)());
00443 if(!f__workdone) return(0);
00444 if((n=(*f__dorevert)()) != 0) return(n);
00445 goto loop;
00446 case COLON:
00447 if(ptr==NULL)
00448 return((*f__doend)());
00449 f__pc++;
00450 goto loop;
00451 case NONL:
00452 f__nonl = 1;
00453 f__pc++;
00454 goto loop;
00455 case S:
00456 case SS:
00457 f__cplus=0;
00458 f__pc++;
00459 goto loop;
00460 case SP:
00461 f__cplus = 1;
00462 f__pc++;
00463 goto loop;
00464 case P: f__scale=p->p1;
00465 f__pc++;
00466 goto loop;
00467 case BN:
00468 f__cblank=0;
00469 f__pc++;
00470 goto loop;
00471 case BZ:
00472 f__cblank=1;
00473 f__pc++;
00474 goto loop;
00475 }
00476 }
00477 return(0);
00478 }
00479 en_fio(Void)
00480 { ftnint one=1;
00481 return(do_fio(&one,(char *)NULL,(ftnint)0));
00482 }
00483 VOID
00484 fmt_bg(Void)
00485 {
00486 f__workdone=f__cp=f__rp=f__pc=f__cursor=0;
00487 f__cnt[0]=f__ret[0]=0;
00488 }
