#define isdigit(x) (x>='0' && x<='9')
#define isspace(s) (s==' ')
#define skip(s) while(isspace(*s)) s++
char *f_s(), *f_list(), *i_tem(), *gt_num(), *ap_end();
return((f_s(s
,0)==FMTERR
)? ERROR
: OK
);
char *f_s(s
,curloc
) char *s
;
if(parenlvl
++ ==1) revloc
=curloc
;
op_gen(RET
,curloc
,0,0,s
);
if((s
=f_list(s
))==FMTERR
)
if((s
=i_tem(s
))==FMTERR
) return(FMTERR
);
op_gen(REVERT
,revloc
,0,0,s
);
else op_gen(GOTO
,0,0,0,s
);
if(ne_d(s
,&t
)) return(t
);
curloc
= op_gen(STACK
,n
,0,0,s
);
{ int n
,x
,sign
=0,pp1
,pp2
;
case ':': op_gen(COLON
,(int)('\n'),0,0,s
); break;
case '$': op_gen(DOLAR
,(int)('\0'),0,0,s
); break; /*** NOT STANDARD FORTRAN ***/
case 'z': s
++; op_gen(BZ
,1,0,0,s
); break;
default: op_gen(BN
,0,0,0,s
); break;
case 'p': s
++; x
=SP
; pp1
=1; pp2
=1; break;
case 'u': s
++; x
=SU
; pp1
=0; pp2
=0; break; /*** NOT STANDARD FORTRAN ***/
case 's': s
++; x
=SS
; pp1
=0; pp2
=1; break;
default: x
=S
; pp1
=0; pp2
=1; break;
case '/': op_gen(SLASH
,0,0,0,s
); break;
case '-': sign
=1; s
++; /*OUTRAGEOUS CODING TRICK*/
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
case 'p': if(sign
) n
= -n
; op_gen(P
,n
,0,0,s
); break;
case 'r': if(n
<=1) /*** NOT STANDARD FORTRAN ***/
{ fmtptr
= s
; return(FMTERR
); }
op_gen(R
,n
,0,0,s
); break;
case 't': op_gen(T
,0,n
,0,s
); break; /* NOT STANDARD FORT */
case 'x': op_gen(X
,n
,0,0,s
); break;
case 'h': op_gen(H
,n
,(int)(s
+1),0,s
);
default: fmtptr
= s
; return(0);
case '\'': op_gen(APOS
,(int)s
,0,0,s
);
case 'l': s
++; x
=TL
; break;
case 'r': s
++; x
=TR
; break;
if(isdigit(*(s
+1))) {s
=gt_num(s
+1,&n
); s
--;}
else n
= 0; /* NOT STANDARD FORTRAN, should be error */
fmtptr
= s
; return(FMTERR
);
case 'x': op_gen(X
,1,0,0,s
); break;
case 'p': op_gen(P
,0,0,0,s
); break;
case 'r': op_gen(R
,10,1,0,s
); break; /*** NOT STANDARD FORTRAN ***/
default: fmtptr
= s
; return(0);
|| *s
== '.' /*** '.' is NOT STANDARD FORTRAN ***/
if(c
=='e') n
=EE
; else if(c
=='d') n
=DE
; else n
=GE
;
if(c
=='e') n
=E
; else if(c
=='d') n
=D
; else n
=G
;
op_gen(a
,b
,c
,d
,s
) char *s
;
{ struct syl
*p
= &syl
[pc
];
fatal(100,"format too complex");
fprintf(stderr
,"%3d opgen: %d %d %d %d %c\n",
pc
,a
,b
,c
,d
,*s
==GLITCH
?'"':*s
); /* for debug */
char *gt_num(s
,n
) char *s
; int *n
;
while(isdigit(*s
) || isspace(*s
))
if(*s
==quote
&& *++s
!=quote
) return(s
);