/* compile module, begun 6/6/91 r. shine */
#include <stdio.h>
#include <stdlib.h>
#include <signal.h>
#include <setjmp.h>
#include "ana_structures.h"
#define maxlinelength 256
 /* null terminated versions of scanc and spanc */
#define scancn(s,t,mask) \
	 while ( ( *s != '\0') && (( t[(int) *s] & mask ) ==  0)) s++;
#define spancn(sd,t,mask) \
	 while ( ( *s != '\0') && (( t[(int) *s] & mask ) !=  0)) s++;
#define scanc(sd,t,mask) \
	 while ( (sd.n > 0) && (( t[(int) *sd.p] & mask ) ==  0)) \
	 { sd.p++; sd.n--; } 
#define spanc(sd,t,mask) \
	 while ( (sd.n > 0) && (( t[(int) *sd.p] & mask ) !=  0)) \
	 { sd.p++; sd.n--; }
#define scan_tok \
	 while ( (tok2.n >= 0) && (( ptab[(int) *tok2.p] & 255 ) ==  0)) \
	 { tok2.p++; tok2.n--; } 
#define SYM_FLAG 163
#define ANA_FUN_FLAG 164
#define ANA_ADD_OPN 0
#define ANA_SUB_OPN 1
#define ANA_MUL_OPN 2
#define ANA_DIV_OPN 3
#define ANA_MOD_OPN 4
#define ANA_MAX_OPN 5
#define ANA_MIN_OPN 6
#define ANA_REL_OPN 7
#define ANA_LOG_OPN 13
#define ANA_NEG_FUN 0
#define ANA_ZERO_SYM 4
 /*STAB2:
	 ;THE OPERAND TABLE
	 ; 1 * / ^ %
	 ; 2 + - > <
	 ; 4 RELATIONAL (6 OF THEM)
	 ; 8 LOGICAL (3 OF THEM)
 */
 byte stab2[256]={0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,1,0,0,0,0,1,2,0,2,0,1,
 0,0,0,0,0,0,0,0,0,0,0,0,2,0,2,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,4,4,4,4,4,4,8,8,8,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
 /*some declarations */
 extern void push(int i);
 extern int pop();
 extern byte stab[];
 extern byte ptab[];
 //extern byte tab_trans[];
 extern byte line[],line2[];
 extern struct	sdesc	cur_line,tok2,tok3,psym,psym1,token;
 extern	jmp_buf	sjbuf;
 /*------------------------------------------------------------------------- */
byte *insert_sym_num(i,s)
 int i; byte *s;
 {
 int j;
 *s++ = SYM_FLAG;
 /*store a dissected 16 bit sym # in 4 chars */
 for (j=0;j<4;j++) { *s++ = i & 15;	i=i/16; }
 return s;					/*return ptr */
 }
 /*------------------------------------------------------------------------- */
int decode_sym_num(s)			/*decode string s, return sym # */
 byte *s;
 {
 int j;
 if ( *s != SYM_FLAG && *s != ANA_FUN_FLAG ) {
 for (j=0;j<20;j++) { fprintf(stderr, "%d ",*s++); } fprintf(stderr, "\n");
 compiler_error(1); }
 s++;
 j = (int)(*s++); j += ((int)*s++)*16;j +=((int)*s++)*256;j +=((int)*s++)*4096;
 return j;
 }
 /*------------------------------------------------------------------------- */
int compiler_error(n)			/*eventually will handle errors */
 int n;
 {
 fprintf(stderr, "compiler error: ");
 switch (n) {
 case 1: fprintf(stderr, "in decode_sym_num, expected symbol not found\n"); break;
 case 2: fprintf(stderr, "in scanx\n"); break;
 case 3: fprintf(stderr, "illegal symbol in compile string\n"); break;
 case 4: fprintf(stderr, "invalid subscript construction\n"); break;
 case 5: fprintf(stderr, "invalid subscript limits\n"); break;
 case 6: fprintf(stderr, "what caused this?\n"); break;
 case 7: fprintf(stderr, "bad transpose specifier in subscript\n"); break;
 case 8: fprintf(stderr, "user subroutine name conflicts with ANA internal name\n");
 break;
 case 9: fprintf(stderr, "userfunction name conflicts with ANA internal name\n");
 break;
 case 10: fprintf(stderr, "binary operand misplaced\n"); break;
 case 11: fprintf(stderr, "double operand\n"); break;
 case 12: fprintf(stderr, "\n"); break;
 default: fprintf(stderr, "undefined error code\n"); break;
 }
 longjmp(sjbuf, 1);
 }					/*end of compiler_error */
 /*------------------------------------------------------------------------- */
int compile_tok()			/*compile a string in token */
			/*token is a counted string, not null term. */
 {
 int i,iq,j,jq,flag=0,ntype,n, hexflag;
 union scalar sval;
 byte code[300];
 byte *s, *pq, *s2, c;
				 /*copy a deblanked version of token into
				 a null terminated string code */
 s=token.p;		pq=token.p;
 for (i=0;i < token.n;i++) if ( *pq != ' ') *s++ = *pq++; else pq++;
 token.n = s - token.p;			/* what's left */
 /*fprintf(stderr, "deblanked string in compile_tok ="); printcs(&token);fprintf(stderr, "\n");*/
			 /*start of code replacing old SHUF1 */
 /*copy from token to code string. converting as we go */
 s=code;
 /*fprintf(stderr, "current s = %d\n",(int) s);
 fprintf(stderr, "token.n = %d\n",token.n);*/
 if (token.n <= 0 ) return -1;
 while ( token.n) {				/*main loop */
 /*fprintf(stderr, "token.n = %d\n",token.n);*/
 s2=s;				/*scan to symbol, copy as we go */
 while ( (token.n > 0) && (( stab[(int) *token.p] & 15 ) ==  0))
 { *s++ = *token.p++; token.n--; } 
 if ( s != s2 ) flag++;			/*if anything before, set flag */
					 /*check if anything left */
 /*fprintf(stderr, "token.n = %d\n",token.n);*/
 if ( token.n <= 0) break;			/*jump out if done */
 iq = stab[ (int) *token.p];			/*what did we find ? */
 /*fprintf(stderr, "iq = %d\n",iq);*/
 if ( iq == 2 || iq == 4 ) {			/* a letter */
 /*fprintf(stderr, "a letter\n");*/
 s2=s;				/*span over symbol and copy as we go */
 while ( (token.n > 0) && (( stab[(int) *token.p] & 7 ) !=  0))
 { *s++ = *token.p++; token.n--; } 
 *s = '\0';			/*terminate s2, a substring of code */
			 /*this leaves symbol in s2, with null at end */
			 /*token.p pts to next, a ( ? */
 if ( token.n <= 0 ||  *token.p != '(' ) {	/*not a function case */
 i = find_sym(s2);				/*get symbol # for this guy */
 /*now substitute coded sym. # in the string, replacing original starting at
 s2, generally of different size */
 /*fprintf(stderr, "current s = %d\n",(int) s);*/
 s=s2;  s=insert_sym_num(i,s);
 /*fprintf(stderr, "current s,s2 = %d, %d\n",(int) s,(int) s2);*/
	 }
 else {						/*a function or subscript */
 if ( (i=find_fun(s2)) != -1 ) {		/*a function in table */
  /*insert coded version, replace sym flag with func flag */
 s=s2; s=insert_sym_num(i,s); *s2 = ANA_FUN_FLAG; }	
 else {						/*subscript case */
						 /*or as yet undefined fn*/
 /*we insert a subc fn code and use the symbol (in s2) as the first arg */
 /*fprintf(stderr, "looking for subscript symbol\n");*/
 i = find_sym(s2);				/*get symbol # for this guy */
 /*may have to convert to a class 7 but would like to handle differently, so
 leave undefines alone for a while */
 s=s2; s=insert_sym_num(ANA_SUBSC_FUN,s); *s2 = ANA_FUN_FLAG;
 *s++ = *token.p++; token.n--;			/*include the ( */
 s=insert_sym_num(i,s);				/*the symbol as first arg */	
 *s++=',';					/*add a comma */
 }						/*end of subscript case */
 }
 }						/*end of letter case */
 else if ( iq == 1 ) {				/*a number case */
 s2=s;				/*span over digits and copy as we go */
				 /*into a null terminated piece of code */
 hexflag = 10;	/* set to 16 if we decide it is hex */
 while (token.n > 0) {
 if ( stab[(int) *token.p] == 1) { *s++ = *token.p++; token.n--; } 
	 /* could be more if there is a a-f, or x */
 else {
 if ( stab[(int) *token.p] == 2) {
 /* if an x, set hexflag */
	 switch (*token.p) {
	 case 'X': hexflag = 16; *s++ = *token.p++; token.n--; break;
 /* if a d or e, a following sign is passed on if non hex */
	 case 'D':
	 case 'E': *s++ = *token.p++; token.n--;
	   if (hexflag != 16) {
	   if ( *token.p == '+' || *token.p == '-' )
		 {*s++ = *token.p++; token.n--; }	/*pass on sign*/
	   }
	   break;
	 default: *s++ = *token.p++; token.n--; break;
	 }
 }  else break;		/* no more legal digits or whatever */
 }
 
 }					/*end of span over exp */
 *s = '\0';			/*terminate s2, a substring of code */
 r_num(s2,&sval,&ntype,hexflag);	/*returns the scalar and type */
 i=create_fixed(&sval,ntype);	/*put into a sym, return sym # */		
 s=s2;
 s=insert_sym_num(i,s);	}			/*end of number case */
 else if ( iq == 8 ) {				/*already a coded symbol */
 for (i=0;i<5;i++) { *s++ = *token.p++; token.n--; } /* always 5 */
 }						/*end of code symbol case */
 }	/*end of while loop (old SHUF1 code) */
 n = s - code; s=code;		/*get count, put s at start */
				 /* check for common case of just 1 symbol */
 if (n == 5) return decode_sym_num(s);
 return scanx(s,n);			/*return result from scanx */
 }	/* end of compile_tok */
 /*------------------------------------------------------------------------- */
int r_num(s,x,ntype,hexflag)		/*convert ascii string to binary */
 /* 2/2/93 patch to remove octal option (i.e., leading 0 => octal)
 need to redo the whole thing some day */
 int *ntype;
 union scalar *x;
 char *s;	/*null terminated*/
 {
 int flag;
 char *pq,c;
 /*we make the scalar either a long, float, or double - depending on what is
 in the string */
 pq=s; flag=0;
 if (hexflag == 16 ) {
 /* d and e are hex digits so can't be exponent */
 *ntype=2; x->l= strtoul(s, (char **) NULL, hexflag); /* note unsigned */
 return 1;	/* and we leave, the hex case is special because unsigned */
 } else {
 while (c = *pq++) {
  if (c == 'D') { *(--pq)='E'; *ntype=4; x->d=atof(s); return 1; }
  if (c =='E' || c=='.') flag=1; } }
 if (flag) { *ntype=3; x->f=(float) atof(s);}
 else      { *ntype=2; x->l= strtol(s, (char **) NULL, hexflag);}
 return 1;
 }
 /*------------------------------------------------------------------------- */
int comc(s)				/*compile a clean sequence */
struct sdesc *s;
 /*      ;COMPILE A "CLEANED" SEQUENCE IN TOKEN_CNT
        ;NO ('S OR FUNCTIONS OR SUBSCRIPTS
        ;Apply normal rules for operation order
        ;we assume there are no imbedded blanks !
        ;note that leading operands are special cases
        ;only + and - are legal, and - causes the negation function
        ;to be used, + is ignored
*/
 {
 struct sdesc sd, sd2;
 byte c, *pq;
 int iq,i,gotta;
 sd.p = s->p;	sd.n = s->n;
 /*first look for double (or more) operand constructions, OK if leading + - */
 while ( sd.n ) {
   scanc(sd,stab2,15);
   if (sd.n == 0) break;
   if (sd.n-- == 0) compiler_error(10); /*can't be at start! */
   while (1) {
   sd.p++;		if ( stab2[ (int) *sd.p] != 0 )	{	/*2 in a row */
   if ( *sd.p == '+' ) *sd.p = ' ';
   else  { if ( *sd.p != '-' ) compiler_error(11);
   /*got a unary -, replace with a neg_edb */
   *sd.p = ' ';	sd.p++;  i = decode_sym_num(sd.p);	push(i);
   i = create_edb(193,1,ANA_NEG_FUN);
   sd.p = insert_sym_num(i,sd.p);	if ( (sd.n -= 6) <= 0 ) break;
   }
   } else break;
   }
 }
 /*done with double operand pass, do a deblank */
 sd.p = s->p;	sd.n = s->n;
 sd.n=debbie(sd.p,sd.n);		/*deblank it */
 /*look for ^ operators first */
 sd2.n = sd.n;	sd2.p = sd.p;
 gotta=0;
 while (sd.n--) if (*sd.p++ == '^') {			/* got a ^ */
	 gotta=1;
	 if (--sd.p == sd2.p)	compiler_error(10); /*can't be at start! */
	 pq = sd.p - 5;	sd.p++;	i=decode_sym_num(pq);	push(i);
	 i=decode_sym_num(sd.p);	push(i);
	 i = create_edb(193,2,ANA_POW_FUN);
	 sd.p = insert_sym_num(i,sd.p);
	 for (i=0;i<6;i++) *pq++ = ' ';	sd.n -= 5;
 }
 if (gotta) sd2.n=debbie(sd2.p,sd2.n);	/*reset, deblank */
 sd.n = sd2.n;	sd.p = sd2.p;		/*reset sd*/
 /*look for * type operators second */
 gotta=0;
 while (sd.n--) if (stab2[ (int) *sd.p++] == 1) {		/* got one */
	 gotta=1;
	 if (--sd.p == sd2.p)	compiler_error(10); /*can't be at start! */
	 /*find out who did it */
	 switch ( *sd.p ) {
	 case '*': iq = ANA_MUL_OPN; break;
	 case '/': iq = ANA_DIV_OPN; break;
	 default:  iq = ANA_MOD_OPN; break;
	 }
	 pq = sd.p - 5;	sd.p++;	i=decode_sym_num(pq);	push(i);
	 i=decode_sym_num(sd.p);	push(i);
	 i = create_edb(192,2,iq);
	 sd.p = insert_sym_num(i,sd.p);
	 for (i=0;i<6;i++) *pq++ = ' ';	sd.n -= 5;
 }
 if (gotta) sd2.n=debbie(sd2.p,sd2.n);	/*reset, deblank */
 sd.n = sd2.n;	sd.p = sd2.p;		/*reset sd*/
 /*look for + type operators third */
 gotta=0;
 while (sd.n--) if (stab2[ (int) *sd.p++] == 2) {		/* got one */
	 gotta=1;
	 if (--sd.p == sd2.p)	{		/*at start, may be OK */
	 if ( *sd.p == '+' ) *sd.p++ = ' ';	/* 4/9/93 bug: didn't have ++ */
	 else  { if ( *sd.p != '-' ) compiler_error(10);
	 /*got a unary -, replace with a neg_edb */
	 *sd.p = ' ';	sd.p++;  i = decode_sym_num(sd.p);	push(i);
	 i = create_edb(193,1,ANA_NEG_FUN);
	 sd.p = insert_sym_num(i,sd.p);	sd.n -= 5; }
	 } else {
	 /*find out who did it */
	 switch ( *sd.p ) {
	 case '+': iq = ANA_ADD_OPN; break;
	 case '-': iq = ANA_SUB_OPN; break;
	 case '>': iq = ANA_MAX_OPN; break;
	 default:  iq = ANA_MIN_OPN; break;
	 }
	 pq = sd.p - 5;	sd.p++;	i=decode_sym_num(pq);	push(i);
	 i=decode_sym_num(sd.p);	push(i);
	 i = create_edb(192,2,iq);
	 sd.p = insert_sym_num(i,sd.p);
	 for (i=0;i<6;i++) *pq++ = ' ';	sd.n -= 5;
	 }
 }
 if (gotta) sd2.n=debbie(sd2.p,sd2.n);	/*reset, deblank */
 sd.n = sd2.n;	sd.p = sd2.p;		/*reset sd*/
 /*look for relational type operators fourth */
 gotta=0;
 while (sd.n--) if (stab2[ (int) *sd.p++] == 4) {		/* got one */
	 gotta=1;
	 if (--sd.p == sd2.p)	compiler_error(10); /*can't be at start! */
	 /*find out who did it */
	 iq = (int) *sd.p -225 + ANA_REL_OPN;
	 pq = sd.p - 5;	sd.p++;	i=decode_sym_num(pq);	push(i);
	 i=decode_sym_num(sd.p);	push(i);
	 i = create_edb(192,2,iq);
	 sd.p = insert_sym_num(i,sd.p);
	 for (i=0;i<6;i++) *pq++ = ' ';	sd.n -= 5;
 }
 if (gotta) sd2.n=debbie(sd2.p,sd2.n);	/*reset, deblank */
 sd.n = sd2.n;	sd.p = sd2.p;		/*reset sd*/
 /*look for logical type operators fifth */
 gotta=0;
 while (sd.n--) if (stab2[ (int) *sd.p++] == 8) {		/* got one */
	 gotta=1;
	 if (--sd.p == sd2.p)	compiler_error(10); /*can't be at start! */
	 /*find out who did it */
	 iq = (int) *sd.p -231 + ANA_LOG_OPN;
	 pq = sd.p - 5;	sd.p++;	i=decode_sym_num(pq);	push(i);
	 i=decode_sym_num(sd.p);	push(i);
	 i = create_edb(192,2,iq);
	 sd.p = insert_sym_num(i,sd.p);
	 for (i=0;i<6;i++) *pq++ = ' ';	sd.n -= 5;
	 }
 if (gotta) sd2.n=debbie(sd2.p,sd2.n);	/*reset, deblank */
 sd.n = sd2.n;	sd.p = sd2.p;		/*reset sd*/
 /*that's all we do, but room for more! */
 }					/*end of comc */
 /*------------------------------------------------------------------------- */
int debbie(s,n)				/*moves blanks to end of string,
					returns # of unblank chars */
 byte *s; int n;
 {
 struct sdesc sd,sd2;
 sd.p=sd2.p=s;	sd2.n=n;	
 while ( sd2.n-- ) if (*sd2.p != ' ') { *sd.p++ = *sd2.p++; }
	 else sd2.p++;
 sd.n=sd.p-s;		/*count for shifted, deblanked section */
 while (sd.p < sd2.p) *sd.p++ =' ';	/*fill end with blanks */
 return sd.n;
 }
 /*------------------------------------------------------------------------- */
int check_subsc(s,n)	/*just checks a subsc arg for special operands */
 byte *s; int n;
 {
 byte c;
 /*save a lot of trouble by checking for any : or > in the args here, we
 return 1 if any are found */
 while (n) {
 if ( *s == '>')	return 1;	/*only unary > counts here, so must be
				 at beginning or after a : */
 if ( *s == '*')	return 1;	/*only unary * counts here, so must be
				 at beginning or after a : */
 if ( *s == '+')	return 1;	/*only unary + counts here, so must be
				 at beginning or after a : */
 while (n)  { if ( *s == ':') return 1; n--; if (*s++ == ',') break; }
 }
 return 0;	
 }
 /*------------------------------------------------------------------------- */
int printss(s, n)
 char	*s;
 int	n;
 {
 byte	c;
 int	i;
 for (i=0;i<n;i++) { c= *(s+i); fprintf(stderr, "%d ",c); } fprintf(stderr, "\n");
 return 1;
 }
 /*------------------------------------------------------------------------- */
int compile_subsc(s,n)  /*compile a "complicated" subscript argument */
 byte *s; int n;
 {
 struct sdesc sd2,sd, save;
 byte	c;
 int	i,iq,narg,ibeg,iend,ic,it,pflag;
 /*fprintf(stderr, "starting compile_subsc\n");*/
 /*for (i=0;i<n;i++) { c= *(s+i); fprintf(stderr, "%d ",c); } fprintf(stderr, "\n");*/
 sd2.n = n;	sd2.p = s;
 /*the first arg is the symbol from which we are subscripting*/
 getarg(&sd2);
 /*fprintf(stderr, "first result =\n");*/
 /*printss(token.p, token.n);*/
 i = scanx(token.p,token.n);	/*compile this arg */
 narg=1;	push(i);
 s = sd2.p;	n = sd2.n;	/*set these to second argument */
 /*replace each general subscript with a special desc. array */
 /*there are 2 passes over the remaining arguments */
 /*the first just compiles the expressions divided by colons and passes over
 the unary >'s */
 while ( sd2.n ) {				/*loop over args */
 getarg(&sd2);			/*puts arg in global struct token */
 /*fprintf(stderr, "arg result =\n");*/
 /*printss(token.p, token.n);*/
 if (token.n)	{		/*ck for null args. */
				 /*compile this arg */
 if (token.n == 1 ) {		/*1 character case, only * or + legal */
 if ( (c = *token.p) != '*' && c != '+' ) compiler_error(4); }
 else {				/*all the rest of the cases */
 /*subscript fields are divided by :'s, the unary > is only valid if it is
 the first thing in a field, for first pass we just skip over these >'s */
 while (token.n > 0) {
 if ( *token.p == '>' ) { token.p++; token.n--; }
 /*look for a colon (or reach the end) */
 sd.p = token.p;
 while ( token.n-- ) {
 /* break on a colon OK unless we get inside a function */
 if ( *token.p == ANA_FUN_FLAG) {token.p++;
			 /* must find the bracketing parenthesis */
	 if (token.n <= 0 ) compiler_error(4);
	 while (token.n--) { if (*token.p++ == '(') break; }
	 pflag = 1;
	 if (token.n <= 0 ) compiler_error(4);
	 while (token.n--) { if (*token.p == '(') pflag++;
		 if (*token.p++ == ')') { pflag--; if (pflag == 0) break;}
	 }
 if (token.n <= 0) break;	
 } else if ( *token.p++ == ':') break;
 }
 sd.n = token.p - sd.p; if ( sd.n > 0 && *(token.p-1) == ':') sd.n--;
					 /*should not include : */
 
 /*fprintf(stderr, "starting scanx from compile_subsc\n");*/
 /*fprintf(stderr, "sd.n = %d\n", sd.n);*/
 if (sd.n == 1 ) {		/*1 character case, only * or + legal */
 c = *sd.p;
 if ( c != '*' && c != '+' ) compiler_error(4); }
 else {	save.p = token.p;	save.n = token.n;
 scanx(sd.p,sd.n);	/*compile this field */
 token.p = save.p;	token.n = save.n; }
 /*fprintf(stderr, "end of scanx from compile_subsc, token.n = %d\n", token.n);*/
 }
 }
 } 			/*for nulls, just skip over until second pass  */
 }
 /*done with first pass, restore sdesc and deblank for pass 2 */
 sd2.n = n;	sd2.p = s;
 sd2.n=debbie(sd2.p,sd2.n);		/*deblank it */
 /*second pass */
 while ( sd2.n > 0) {				/*loop over args */
 getarg(&sd2);			/*puts arg in global struct token */
 if (token.n)	{		/*ck for null args. */
 /*each arg is either a simple subscript or a generalized type, the simples
 always have just one symbol so use this as discriminator */
 if (token.n == 5 && *token.p == SYM_FLAG) {		/* the simple case */
 i=decode_sym_num(token.p);
 } else {					/*generalized case */
 ibeg=4; iend=2; ic=4; it=2;			/*defaults */
 /*scan fields, keep track */
 iq = 0;
 /*subscript fields are divided by :'s */
 while (token.n > 0) {
 sd.p = token.p;
 while ( token.n ) if ( *token.p == ':') break; else { token.p++; token.n--;}
 sd.n = token.p - sd.p;
 if ( sd.n > 0 && *(token.p) == ':') {
 /* sd.n--; token.p++; token.n--;} */	/* bug!, changed 8/23/94 to line below */
 token.p++; token.n--;}
					 /*should not include : */
 /* what's in this field ? */
 if ( sd.n == 1 ) {			/*single characters, + or * allowed */
 switch ( *sd.p ) {
 case '+' : ic=1; /*fprintf(stderr, "caught the +\n");*/  break;
 case '*' : /*fprintf(stderr, "caught the *\n");*/ if (iq > 1) compiler_error(5); break;
 default: compiler_error(6); break;
 }
 } else {				/*not a single character */
 if ( *sd.p == '>') {			/*transpose case, unary > */
 sd.p++; sd.n--; if (sd.n != 5 && *sd.p != SYM_FLAG) compiler_error(7);
 it=decode_sym_num(sd.p); } else {
 /* only remaining legal case is a single symbol, could be beg or end */
 if (sd.n != 5 || *sd.p != SYM_FLAG) compiler_error(4);
 i=decode_sym_num(sd.p); if (iq > 1) compiler_error(5);
 if (iq == 0) ibeg=i; else iend=i;   }
 }
 iq++;
 }
 i = create_subsc_edb(ibeg,iend,ic,it);
 }
 } else i = ANA_ZERO_SYM;	/*for nulls, give them the zero symbol */
 narg++;	push(i);			/*count and push it */
 }
 /* scanx creates the edb and blanks the area */
 /*fprintf(stderr, "done with compile_subsc, narg = %d\n", narg);*/
 return narg;
 }
 /*------------------------------------------------------------------------- */
int scanx(s,n)			/*re-entrant compiler, returns sym # */
 byte *s; int n;
 {
 byte *s2, *pq,c;
 struct sdesc sd,sd2,sd3;
 int i,j,iq,jq,pflag,narg;
 /*fprintf(stderr, "start scanx, n = %d\n",n);*/
 /*for (i=0;i<n;i++) { c= *(s+i); fprintf(stderr, "%d  ",c); } fprintf(stderr, "\n");*/
 sd.p=s;	sd.n=n;			/*use our own private string desc. */
					/*keep s and n to restore sd*/
 while ( sd.n > 5 ) {
 sd2.p=sd.p;	sd2.n=sd.n;
 scanc(sd,stab,20);				/*scan to a separator */
 
 /*if (sd.n>0) fprintf(stderr, "scanx 'separator' %1.1s, %d\n",sd.p,*sd.p);*/
 if ( sd.n > 0 && *sd.p != ')' ) {		/*still unclean */
 /*look for a ( or a func */
 if (*sd.p == '(' ) {				/*find mate and re-enter */
 /* fprintf(stderr, "found paren\n"); */
 pflag=1;	*sd.p++ =' ';	sd.n--;		sd2.p=sd.p;	sd2.n=sd.n;
 while ( sd.n ) { if (*sd.p == '(' ) pflag++;
	 else 	{  if (*sd.p == ')' )  if (--pflag == 0) break;}
	 sd.p++; sd.n--; }
 if (*sd.p == ')' ) { *sd.p = ' '; 
 /* fprintf(stderr, "found mate\n"); */
 }	/*blank only if really a ) */
 sd2.n = sd2.n - sd.n;
 /*for (i=0;i<n;i++) { c= *(s+i); fprintf(stderr, "%d  ",c); } fprintf(stderr, "\n");*/
 i = scanx(sd2.p,sd2.n);			/*but we don't use symbol # here */
 /*for (i=0;i<n;i++) { c= *(s+i); fprintf(stderr, "%d  ",c); } fprintf(stderr, "\n");*/
 sd.p=s;	sd.n=n;			/*restore original input */
 sd.n=debbie(sd.p,sd.n);		/*deblank it */
 /*for (i=0;i<n;i++) { c= *(s+i); fprintf(stderr, "%d  ",c); } fprintf(stderr, "\n");*/
 }						/*end of bracketing parens */
 else if (*sd.p != ANA_FUN_FLAG) compiler_error(3);	/*oops */
 else {						/*function of some sort */
 sd3.p=sd.p;	iq=decode_sym_num(sd.p);	/*get func #, keep in iq */
						 /*keep ptr in sd3 */
 sd.p +=5;
 /*probably don't need to check count below, but be sure */
 sd.n -=5;	while (sd.n-- ) if (*sd.p++ == '(' ) break;
	 /*sd.p now should pt to beginning of args, span parens */
 *(sd.p-1) = ' ';				/*first blank that ( */
 pflag=1;	sd2.p=sd.p;	sd2.n=sd.n;
 while ( sd.n ) {	if (*sd.p == '(' ) pflag++;
		 else  { if (*sd.p == ')' )  if (--pflag == 0) break; }
		 sd.p++; sd.n--; }
 if (*sd.p == ')' ) *sd.p = ' ';		/*blank only if really a ) */
 sd2.n = sd2.n - sd.n;			/*sd2 should now be the arg list */
 narg=0;	sd3.n = sd.p - sd3.p;			/*narg is arg counter */
 /*before we go on, check if a special case, only such is subscript fn */
 /*and we can handle "simple" subscripts without special handling */
 if ( (iq == ANA_SUBSC_FUN) && check_subsc(sd2.p,sd2.n))
 narg = compile_subsc(sd2.p,sd2.n);
 else {						/*normal function line */
 /*fprintf(stderr, "scanx doing a function, sd3.n=%d, sd3.p=%d\n",sd3.n,sd3.p);*/
 while ( sd2.n > 0 ) {				/*loop over args */
 getarg(&sd2);			/*puts arg in global struct token */
 if (token.n)	{		/*ck for null args. */
 /*fprintf(stderr, "scanx the argument\n");*/
 i = scanx(token.p,token.n);	/*compile this arg */
 } else iq = ANA_ZERO_SYM;	/*for nulls, give them the zero symbol */
 narg++;	push(i);		/*count and push it */
 }
 }
 /* got all the arguments, now set up the edb */
 i = create_edb(193,narg,iq);
 /*fprintf(stderr, "sd3.p before insert_sym=%d, sd3.n=%d\n",sd3.p,sd3.n);*/
 sd3.p = insert_sym_num(i,sd3.p);	sd3.n -=5;
 /*fprintf(stderr, "sd3.p after insert_sym=%d, sd3.n=%d\n",sd3.p,sd3.n);*/
 while (sd3.n > 0) { *sd3.p++ = ' '; sd3.n--;}	/*blank all the rest */
 sd.p=s;	sd.n=n;			/*restore original input */
 sd.n=debbie(sd.p,sd.n);		/*deblank it */
 }
 }
 else  { if ( sd.n > 0 ) {			/*just a ), blank it */
 *sd.p++ =' ';	sd2.n = sd.p - sd2.p; }		/*size */
 /* check here to catch some fatal constructions, first deblank */
 sd2.n=debbie(sd2.p,sd2.n);
 /*fprintf(stderr, "deblanked string in scanx:"); printcs(&sd2); fprintf(stderr, "\n");*/
 /*for (i=0;i<n;i++) { c= *(s+i); fprintf(stderr, "%d  ",c); } fprintf(stderr, "\n");*/
 
 if ( *sd2.p != SYM_FLAG ) { if ( stab2[(int) *sd2.p] == 0 )
	 compiler_error(2); }		/*if func., let it go for now */
 else  if (sd2.n != 5) { if  ( stab2[(int) *(sd2.p+5)] == 0 )
	 compiler_error(2); }	/*more than 5 OK only if an operator next*/
				 /*now compile this "clean" section */
 comc(&sd2);			/*seperate subroutine because kinda long */
 sd.p=s;	sd.n=n;			/*restore original input */
 /*for (i=0;i<n;i++) { c= *(s+i); fprintf(stderr, "%d ",c); } fprintf(stderr, "\n");*/
 sd.n=debbie(sd.p,sd.n);		/*deblank it */
 /*fprintf(stderr, "sd.n = %d, string in comc:", sd.n); printcs(&sd2); fprintf(stderr, "\n");*/
 }
 };					/*finished when down to 1 sym */
 /*fprintf(stderr, "done with scanx\n");*/
 return decode_sym_num(sd.p);		/*return the sym # */
 }					/*end of scanx */
 /*------------------------------------------------------------------------- */