static const char *i_tem(const char *s)
{ const char *t;
int n,curloc;
if(*s==')') return(s);
if(ne_d(s,&t)) return(t);
if(e_d(s,&t)) return(t);
s=gt_num(s,&n,1);
if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
return(f_s(s,curloc));
}
static const char *f_list(const char *s)
{
for(;*s!=0;)
{ skip(s);
if((s=i_tem(s))==NULL) return(NULL);
skip(s);
if(*s==',') s++;
else if(*s==')')
{ if(--f__parenlvl==0)
{
(void) op_gen(REVERT,f__revloc,0,0);
return(++s);
}
(void) op_gen(GOTO,0,0,0);
return(++s);
}
}
return(NULL);
}
char *i_tem(char *s)
#endif
{
char *t;
int n, curloc;
if (*s == ')') return(s);
if (ne_d(s, &t)) return(t);
if (e_d(s, &t)) return(t);
s = gt_num(s, &n);
if ((curloc = op_gen(STACK, n, 0, 0)) < 0) return(NULL);
return(f_s(s, curloc));
}
static char *
f_list(unit *ftnunit, char *s)
{
for (; *s != 0;) {
skip (s);
if ((s = i_tem (ftnunit, s)) == NULL)
return (NULL);
skip (s);
if (*s == ',')
s++;
else if (*s == ')') {
if (--ftnunit->parenlvl == 0) {
(void) op_gen (ftnunit, REVERT, ftnunit->revloc, 0, 0);
return (++s);
}
(void) op_gen (ftnunit, GOTO, 0, 0, 0);
return (++s);
}
}
return (NULL);
}
static const char *f_s(const char *s, int curloc)
{
skip(s);
if(*s++!='(')
{
return(NULL);
}
if(f__parenlvl++ ==1) f__revloc=curloc;
if(op_gen(RET1,curloc,0,0)<0 ||
(s=f_list(s))==NULL)
{
return(NULL);
}
skip(s);
return(s);
}
static char *
f_s(unit *ftnunit, char *s, int curloc)
{
skip (s);
if (*s++ != '(') {
return (NULL);
}
if (ftnunit->parenlvl++ == 1)
ftnunit->revloc = curloc;
if (op_gen (ftnunit, RET, curloc, 0, 0) < 0 ||
(s = f_list (ftnunit, s)) == NULL) {
return (NULL);
}
skip (s);
return (s);
}
static char *
i_tem(unit *ftnunit, char *s)
{
char *t;
int n, curloc;
if (*s == ')')
return (s);
if (ne_d (ftnunit, s, &t))
return (t);
if (e_d (ftnunit, s, &t))
return (t);
s = gt_num (ftnunit, s, &n);
if ((curloc = op_gen (ftnunit, STACK, n, 0, 0)) < 0)
return (NULL);
return (f_s (ftnunit, s, curloc));
}
const char *
f_s(const char *s, int curloc)
{
skip(s);
if (*s++ != '(')
return NULL;
if (f__parenlvl++ == 1)
f__revloc=curloc;
if ((op_gen(RET1, curloc, 0, 0) < 0) || ((s = f_list(s)) == NULL))
return NULL;
skip(s);
return(s);
}
const char *
i_tem(const char *s)
{
const char *t;
int n;
int curloc;
if (*s == ')')
return s;
if (ne_d(s, &t))
return t;
if (e_d(s, &t))
return t;
s = gt_num(s, &n);
if ((curloc = op_gen(STACK, n, 0, 0)) < 0)
return NULL;
return f_s(s, curloc);
}
e_d(char *s, char **p)
#endif
{ int i,im,n,w,d,e,found=0,x=0;
char *sv=s;
s=gt_num(s,&n,1);
(void) op_gen(STACK,n,0,0);
switch(*s++)
{
default: break;
case 'E':
case 'e': x=1;
case 'G':
case 'g':
found=1;
if (!(s=gt_num(s,&w,0))) {
bad:
*p = 0;
return 1;
}
if(w==0) break;
if(*s=='.') {
if (!(s=gt_num(s+1,&d,0)))
goto bad;
}
else d=0;
if(*s!='E' && *s != 'e')
(void) op_gen(x==1?E:G,w,d,0); /* default is Ew.dE2 */
else {
if (!(s=gt_num(s+1,&e,0)))
goto bad;
(void) op_gen(x==1?EE:GE,w,d,e);
}
break;
case 'O':
case 'o':
i = O;
im = OM;
goto finish_I;
case 'Z':
case 'z':
i = Z;
im = ZM;
goto finish_I;
case 'L':
case 'l':
found=1;
if (!(s=gt_num(s,&w,0)))
goto bad;
if(w==0) break;
(void) op_gen(L,w,0,0);
break;
case 'A':
case 'a':
found=1;
skip(s);
if(*s>='0' && *s<='9')
{ s=gt_num(s,&w,1);
if(w==0) break;
(void) op_gen(AW,w,0,0);
break;
}
(void) op_gen(A,0,0,0);
break;
case 'F':
case 'f':
if (!(s=gt_num(s,&w,0)))
goto bad;
found=1;
if(w==0) break;
if(*s=='.') {
if (!(s=gt_num(s+1,&d,0)))
goto bad;
}
else d=0;
(void) op_gen(F,w,d,0);
break;
case 'D':
case 'd':
found=1;
if (!(s=gt_num(s,&w,0)))
goto bad;
if(w==0) break;
if(*s=='.') {
if (!(s=gt_num(s+1,&d,0)))
goto bad;
}
else d=0;
(void) op_gen(D,w,d,0);
break;
case 'I':
case 'i':
i = I;
im = IM;
finish_I:
if (!(s=gt_num(s,&w,0)))
goto bad;
found=1;
if(w==0) break;
if(*s!='.')
{ (void) op_gen(i,w,0,0);
break;
}
if (!(s=gt_num(s+1,&d,0)))
goto bad;
(void) op_gen(im,w,d,0);
break;
}
if(found==0)
{ f__pc--; /*unSTACK*/
*p=sv;
return(0);
}
*p=s;
return(1);
}
ne_d(char *s, char **p)
#endif
{ int n,x,sign=0;
struct syl *sp;
switch(*s)
{
default:
return(0);
case ':': (void) op_gen(COLON,0,0,0); break;
case '$':
(void) op_gen(NONL, 0, 0, 0); break;
case 'B':
case 'b':
if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
else (void) op_gen(BN,0,0,0);
break;
case 'S':
case 's':
if(*(s+1)=='s' || *(s+1) == 'S')
{ x=SS;
s++;
}
else if(*(s+1)=='p' || *(s+1) == 'P')
{ x=SP;
s++;
}
else x=S;
(void) op_gen(x,0,0,0);
break;
case '/': (void) op_gen(SLASH,0,0,0); break;
case '-': sign=1;
case '+': s++; /*OUTRAGEOUS CODING TRICK*/
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
if (!(s=gt_num(s,&n,0))) {
bad: *p = 0;
return 1;
}
switch(*s)
{
default:
return(0);
case 'P':
case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
case 'X':
case 'x': (void) op_gen(X,n,0,0); break;
case 'H':
case 'h':
sp = &f__syl[op_gen(H,n,0,0)];
sp->p2.s = s + 1;
s+=n;
break;
}
break;
case GLITCH:
case '"':
case '\'':
sp = &f__syl[op_gen(APOS,0,0,0)];
sp->p2.s = s;
if((*p = ap_end(s)) == NULL)
return(0);
return(1);
case 'T':
case 't':
if(*(s+1)=='l' || *(s+1) == 'L')
{ x=TL;
s++;
}
else if(*(s+1)=='r'|| *(s+1) == 'R')
{ x=TR;
s++;
}
else x=T;
if (!(s=gt_num(s+1,&n,0)))
goto bad;
s--;
(void) op_gen(x,n,0,0);
break;
case 'X':
case 'x': (void) op_gen(X,1,0,0); break;
case 'P':
case 'p': (void) op_gen(P,1,0,0); break;
}
s++;
*p=s;
return(1);
}
int
ne_d (unit *ftnunit, char *s, char **p)
{
int n, x, sign = 0;
switch (*s) {
default:
return (0);
case ':':
(void) op_gen (ftnunit, COLON, 0, 0, 0);
break;
case '$':
if (ftnunit->uwrt & WR_OP)
(void) op_gen (ftnunit, NONL, 0, 0, 0);
break;
case 'B':
case 'b':
if (*++s == 'z' || *s == 'Z')
(void) op_gen (ftnunit, BZ, 0, 0, 0);
#ifdef I90
else if (*s == 'n' || *s == 'N')
(void) op_gen (ftnunit, BN, 0, 0, 0);
else {
s--; /* get back to the initial 'B' */
return(0);
}
#else
else
(void) op_gen (ftnunit, BN, 0, 0, 0);
#endif
break;
case 'S':
case 's':
if (*(s + 1) == 's' || *(s + 1) == 'S') {
x = SS;
s++;
} else if (*(s + 1) == 'p' || *(s + 1) == 'P') {
x = SP;
s++;
} else
x = S;
(void) op_gen (ftnunit, x, 0, 0, 0);
break;
case '/':
#ifdef I90
(void) op_gen (ftnunit, SLASH, 1, 0, 0);
#else
(void) op_gen (ftnunit, SLASH, 0, 0, 0);
#endif
break;
case '-':
sign = 1; /* OUTRAGEOUS CODING TRICK */
case '+':
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 MYESC:
s = gt_num (ftnunit, s, &n);
switch (*s) {
default:
return (0);
case 'P':
case 'p':
if (sign) n = -n;
(void) op_gen (ftnunit, P, n, 0, 0);
break;
case 'X':
case 'x':
if (sign) return (0);
(void) op_gen (ftnunit, X, n, 0, 0);
break;
case 'H':
case 'h':
if (sign) return (0);
(void) op_gen (ftnunit, H, n, (long) (s + 1), 0);
s += n;
break;
#ifdef I90
case '/':
if (sign) return (0);
(void) op_gen (ftnunit, SLASH, n, 0, 0);
break;
#endif
}
break;
case MYQUOTE:
case MYHOLL:
case '"':
case '\'':
(void) op_gen (ftnunit, APOS, (long) s, 0, 0);
if ((*p = ap_end (ftnunit, s)) == NULL)
return (0);
return (1);
case 'T':
case 't':
if (*(s + 1) == 'l' || *(s + 1) == 'L') {
x = TL;
s++;
} else if (*(s + 1) == 'r' || *(s + 1) == 'R') {
x = TR;
s++;
} else
x = T;
s = gt_num (ftnunit, s + 1, &n);
s--;
(void) op_gen (ftnunit, x, n, 0, 0);
break;
case 'X':
case 'x':
(void) op_gen (ftnunit, X, 1, 0, 0);
break;
case 'P':
case 'p':
(void) op_gen (ftnunit, P, 1, 0, 0);
break;
}
int
e_d(const char *s, const char **p)
{
int i;
int im;
int n;
int w;
int d;
int e;
int found = 0;
int x = 0;
const char *sv=s;
s = gt_num(s, &n);
(void) op_gen(STACK, n, 0, 0);
switch (*s++) {
default: break;
case 'E':
case 'e': x = 1;
case 'G':
case 'g':
found = 1;
s = gt_num(s, &w);
if (w == 0)
break;
if (*s == '.') {
s++;
s = gt_num(s, &d);
} else
d = 0;
if ((*s != 'E') && (*s != 'e'))
(void) op_gen((x == 1) ? E : G, w, d, 0); /* default is Ew.dE2 */
else {
s++;
s = gt_num(s, &e);
(void) op_gen((x == 1) ? EE : GE, w, d, e);
}
break;
case 'O':
case 'o':
i = O;
im = OM;
goto finish_I;
case 'Z':
case 'z':
i = Z;
im = ZM;
goto finish_I;
case 'L':
case 'l':
found = 1;
s = gt_num(s, &w);
if (w == 0)
break;
(void) op_gen(L, w, 0, 0);
break;
case 'A':
case 'a':
found = 1;
skip(s);
if ((*s >= '0') && (*s <= '9')) {
s = gt_num(s, &w);
if (w == 0)
break;
(void) op_gen(AW, w, 0, 0);
break;
}
(void) op_gen(A, 0, 0, 0);
break;
case 'F':
case 'f':
found = 1;
s = gt_num(s, &w);
if (w == 0)
break;
if (*s == '.') {
s++;
s = gt_num(s, &d);
} else
d = 0;
(void) op_gen(F, w, d, 0);
break;
case 'D':
case 'd':
found = 1;
s = gt_num(s, &w);
if (w == 0)
break;
if (*s == '.') {
s++;
s = gt_num(s, &d);
} else
d = 0;
(void) op_gen(D, w, d, 0);
break;
case 'I':
case 'i':
i = I;
im = IM;
finish_I:
found = 1;
s = gt_num(s, &w);
if (w == 0)
break;
if (*s != '.') {
(void) op_gen(i, w, 0, 0);
break;
}
s++;
s = gt_num(s, &d);
(void) op_gen(im, w, d, 0);
break;
}
if (found == 0) {
f__pc--; /*unSTACK*/
*p = sv;
return 0;
}
*p = s;
return 1;
}
int
ne_d(const char *s, const char **p)
{
int n;
int x;
int sign = 0;
struct syl *sp;
switch (*s) {
default: return 0;
case ':': (void) op_gen(COLON, 0, 0, 0); break;
case '$': (void) op_gen(NONL, 0, 0, 0); break;
case 'B':
case 'b':
if ((*++s=='z') || (*s == 'Z'))
(void) op_gen(BZ, 0, 0, 0);
else
(void) op_gen(BN, 0, 0, 0);
break;
case 'S':
case 's':
if ((*(s + 1) == 's') || (*(s + 1) == 'S')) {
x = SS;
s++;
} else if ((*(s + 1) == 'p') || (*(s + 1) == 'P')) {
x = SP;
s++;
} else
x = S;
(void) op_gen(x, 0, 0, 0);
break;
case '/': (void) op_gen(SLASH, 0, 0, 0); break;
case '-': sign = 1;
case '+': s++; /*OUTRAGEOUS CODING TRICK*/
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
s = gt_num(s, &n);
switch (*s) {
default: return 0;
case 'P':
case 'p': if (sign) n= -n; (void) op_gen(P, n, 0, 0); break;
case 'X':
case 'x': (void) op_gen(X, n, 0, 0); break;
case 'H':
case 'h':
sp = &f__syl[op_gen(H, n, 0, 0)];
*(const char **)&sp->p2 = s + 1;
s += n;
break;
}
break;
case GLITCH:
case '"':
case '\'':
sp = &f__syl[op_gen(APOS, 0, 0, 0)];
*(const char **)&sp->p2 = s;
if ((*p = ap_end(s)) == NULL)
return 0;
return 1;
case 'T':
case 't':
if ((*(s + 1) == 'l') || (*(s + 1) == 'L')) {
x=TL;
s++;
} else if ((*(s + 1) == 'r') || (*(s + 1) == 'R')) {
x=TR;
s++;
} else
x = T;
s=gt_num(s + 1, &n);
s--;
(void) op_gen(x, n, 0, 0);
break;
case 'X':
case 'x': (void) op_gen(X, 1, 0, 0); break;
case 'P':
case 'p': (void) op_gen(P, 1, 0, 0); break;
}
s++;
*p = s;
return 1;
}
