#include "cs.h"			/*			RDORCH.C	*/
#include <ctype.h>

			       	/* Modification of backslash line-extender 
			     * system so it does not operate if the char
			     * immediately following is printable and not
			     * a ";", or "/".  See label keep_backslash.
			     *
			     * Robin Whittle 7 July 1998.
			     */ 

#ifdef DOSGCC
#include <unistd.h>
#endif
#ifdef sol
#include <unistd.h>
#endif
#ifdef sun
#define   SEEK_SET        0
#define   SEEK_CUR        1
#define   SEEK_END        2
#endif

#define	LINMAX	  1000
#define	LENMAX	  1000L
#define	GRPMAX	  VARGMAX
#define	LBLMAX	  100
#define	STRSPACE  4000

typedef	struct	{
	int	reqline;
	char	*label;
} LBLREQ;

#define MARGS	(5)
typedef	struct MACRO {
  char		*name;
  char		*arg[MARGS];
  int		acnt;
  char		*body;
  struct MACRO  *next;
} MACRO;

static  MACRO   *macros = NULL;

static  long	lenmax = LENMAX;	/* Length of input line buffer  */
static	char	**linadr;		/* adr of each line in text	*/
static  short   *srclin;                /* text no. of expanded lines   */
static	int	curline;		/* current line being examined	*/
static	char	*collectbuf = NULL;	/* splitline collect buffer	*/
static	char	**group;		/* splitline local storage	*/
static	char	**grpsav;		/* copy of above		*/
static  long	grpmax = GRPMAX;	/* Size of group structure      */
static	int	opgrpno;		/* grpno identified as opcode	*/
static	int	linopnum;		/* data for opcode in this line */
static	char	*linopcod;
static	int	linlabels;		/* count of labels this line	*/
static	LBLREQ	*lblreq;
static  int	lblmax;
static	int	lblcnt;
static	int	lgprevdef = 0;
static	int	opnum;			/* opcod data carriers		*/
static	char	*opcod;			/*  (line or subline)		*/
static	ARGLST	*nxtarglist, *nullist;
static  struct spchain {
    char 		*sspace; /* Base of this section */
    char		*ssplim; /* Last char available */
    char		*sspnxt; /* Last char used */
    struct spchain	*next;	 /* Next pool */
} sp_chain;
static	long	space_size;
static  char    *strsav(char *s);
static  void    intyperr(int n, char tfound), printgroups(int count);
static  int     isopcod(char *s);
static  void    lblrequest(char *s), lblfound(char *s);
static  void    lblclear(void), lblchk(void);

int	synterrcnt = 0;

static	FILE	*fp;
struct in_stack {
  short	string;
  short	args;
  char	*body;
  FILE	*file;
  MACRO *mac;
  short line;
};

static struct in_stack inputs[20], *str;
static int pop = 0;		/* Number of macros to pop */
static int ingappop = 1;
static void lexerr(char*);
static int atbol = 1;

#ifdef RESET
#include <string.h>
void orchreset(void)
{
        mfree(linadr); linadr=NULL;
        curline=0;
        group=NULL;
        grpsav=NULL;
        collectbuf=NULL;
        lenmax=LENMAX;
        grpmax=GRPMAX;
        opgrpno=0;
        linopnum=0;
        linopcod=NULL;
        linlabels=0;
        lgprevdef=0;
        synterrcnt=0;
        lblcnt=0;
        opnum=0;
        opcod=NULL;
	if (nxtarglist!=NULL) {
	  mfree(nxtarglist); nxtarglist = NULL;
	}
        if (nullist!=NULL) {
	  mfree(nullist); nullist = NULL;
	}
        space_size=0;
	while (macros) {
	  mfree(macros->body);
	  mfree(macros->name);
	  for (i=0; i<macros->acnt; i++) mfree(macros->arg[i]);
	  macros = macros->next;
	}
	pop = 0;
	ingappop = 1;
}
#endif

ARGLST* copy_arglist(ARGLST *old)
{
    size_t n = sizeof(ARGLST)+ old->count*sizeof(char*)-sizeof(char*);
    ARGLST *nn = (ARGLST*)mmalloc(n);
/*     printf("copy_arglist: %d args\n", old->count); */
    memcpy(nn, old, n);
    memset(old, 0, n);
    return nn;
}

				/* Two functions to read/unread chracters from
				 * a stack of file and macro inputs */

#define ungetorchar(c) if (str->string) str->body--; else ungetc(c, str->file)

int getorchar(void)
{
    int c;
top:
    if (str->string) {
      c= *str->body++;
      if (c == '\0') {
	pop += str->args;
	str--;
	goto top;
      }
    }
    else {
      c = getc(str->file);
      if (c == EOF) {
	if (str == &inputs[0]) return EOF;
	fclose(str->file);
	mfree(str->body);
	str--; goto top;
      }
    }
    if (c == '\n') {
      str->line++; atbol = 1;
    }
    else atbol = 0;
    if (ingappop && pop)
      do {
	MACRO *nn = macros->next;
	int i;
/* 	printf("popping %s\n", macros->name); */
	mfree(macros->name); mfree(macros->body);
	for (i=0; i<macros->acnt; i++)
	  mfree(macros->arg[i]);
	mfree(macros);
	macros = nn;
	pop--;
      } while (pop);
    return c;
}

static	long	ORCHSIZ, ARGSPACE;

void rdorchfile(void)		/* read entire orch file into txt space */
{
	int	c, lincnt;
        int	srccnt;
	char	*cp, *endspace, *ortext;
extern  char    *orchname;
	int	linmax = LINMAX;        /* Maximum number of lines      */

	printf("orch compiler:\n");
	if ((fp = fopen(orchname,"r")) == NULL)
	    dies("cannot open orch file %s",orchname);
	if (fseek(fp, 0L, SEEK_END) != 0)
	    dies("can't find end of file %s",orchname);
	if ((ORCHSIZ = ftell(fp)) <= 0)
	    dies("ftell error on %s",orchname);
	rewind(fp);
	str = inputs;
	str->string = 0;
	str->file = fp;
	str->body = orchname;
	ortext = mmalloc(ORCHSIZ + 1);              /* alloc mem spaces */
	linadr = (char **) mmalloc((long)(LINMAX+1)*sizeof(char **));
	srclin = (short *) mmalloc((long)(LINMAX+1)*sizeof(short));
	sp_chain.sspace = mmalloc(space_size = (long)STRSPACE);
	sp_chain.sspnxt = sp_chain.sspace;
	sp_chain.ssplim = sp_chain.sspace + STRSPACE;
	sp_chain.next = NULL;
	srclin[1] = 1;
	lincnt = srccnt = 1;
	cp = linadr[1] = ortext;
	endspace = ortext + ORCHSIZ + 1;
	strsav("sr");
	group = (char **)mcalloc((GRPMAX+1)*sizeof(char*));
	grpsav= (char **)mcalloc((GRPMAX+1)*sizeof(char*));
        lblreq = (LBLREQ*)mcalloc(LBLMAX*sizeof(LBLREQ));
        lblmax = LBLMAX;

	while ((c = getorchar()) != EOF) {	/* read entire orch file  */
	  if (cp == endspace-1) {	        /* Must extend */
	    char * old = ortext;
	    int i;
	    ortext = mrealloc(ortext, ORCHSIZ += 400);
	    endspace = ortext + ORCHSIZ + 1;
	    printf("Orchestra Text extended to %d\n", ORCHSIZ);
	    for (i=1; i<=lincnt; i++)
	      linadr[i] += (ortext - old); /* Relocate */
	    cp += (ortext - old);
	  }
          *cp++ = c;
          if (c == '\\') {
	  ll:
	    while (isspace(c = getorchar())); /* Ignore spaces */
	    if (c == '\n') {
	      srccnt++;
	    }
	    else if (c == ';') { /* Comment */
	      while ((c = getorchar()) != '\n');
	    }
	    else if (c == '/') { /* C style comment? */
	      for(;;) {
		if (getorchar() == '*') {	/* Yes */
		  while (getorchar()!='*');
		  if (getorchar()=='/') goto ll;
		}
		else {		/* No so error */
		  lexerr("Characters after \\ not comment\n");
		}
	      }
	    }
	    else {			      /* We arrive here because a 
	         			  * backslash was found, but not
					  * followed by a new-line, ";"
					  * or "/" comment - after any
					  * whitespace was skipped.
					  * Rather than continue as if
					  * this is a line-continue 
					  * situation, we assume that
					  * whoever wrote the .orc file
					  * actually wanted a backslash
					  * here - perhaps as part of
					  * a quoted string of some kind.
					  * 
					  * The following code works if
					  * the backslash is immediately
					  * followed by a printable
					  * character that we want to 
					  * retain.  That character has
					  * been read into c by the test 
					  * above for whitespace.
					  * We want to keep it, so we
					  * write it to the output buffer 
					  * and skip over the lines below
					  * which implement the line
					  * continuation actions.
					  *
					  * The original comment at this
					  * place said:
					  */
					  	/* Error here */
	            *cp++ = c;
		    goto keep_backslash;
	    
	    }
	    *(cp-1) = ' ';
	    srccnt++;                       /*      record a fakeline */
	    srclin[++lincnt] = 0;
	    linadr[lincnt] = cp;
	keep_backslash:	
	  }
          else if (c == '\n') {			/* at each new line */
            char *lp = linadr[lincnt];
            while ((c = *lp) == ' ' || c == '\t')
              lp++;
	    if (*lp != '\n' && *lp != ';') {
	      curline = lincnt - 1;
	    }
            srccnt++;
            if (++lincnt >= linmax) {
              printf("too many lines...increasing\n");
              linmax += 100;
              linadr =
                (char **) mrealloc(linadr, (long)(linmax+1)*sizeof(char **));
            }
            srclin[lincnt] = srccnt;
            linadr[lincnt] = cp;		/* record the adrs */
          }
          else if (c == '#' && atbol) {	/* Start Macro definition */
				/* Should also deal with #include here */
            char mname[100];
            int i=0;
            int arg = 0;
            int size = 100;
            MACRO *mm = (MACRO*)mmalloc(sizeof(MACRO));
            cp--;
	    while (isspace(c = getorchar()));
	    if (c=='d') {
	      if ((c = getorchar())!='e' || (c = getorchar())!='f' ||
		  (c = getorchar())!='i' || (c = getorchar())!='n' ||
		  (c = getorchar())!='e') lexerr("Not #define");
	      while (isspace(c = getorchar()));
	      do {
		mname[i++] = c;
	      } while (isalpha(c = getorchar()));
	      mname[i] = '\0';
	      printf("Macro definition for %s\n", mname);
	      mm->name = mmalloc(i+1);
	      strcpy(mm->name, mname);
	      if (c == '(') {	/* arguments */
/* 		printf("M-arguments: "); */
		do {
		  i = 0;
		  while (isalpha(c = getorchar())) mname[i++] = c;
		  mname[i] = '\0';
/* 		  printf("%s\t", mname); */
		  mm->arg[arg] = mmalloc(i+1);
		  strcpy(mm->arg[arg++], mname);
		  if (arg>=MARGS) lexerr("Too many arguments to macro");
		} while (c=='#');
		if (c!=')') printf("macro error\n");
	      }
	      mm->acnt = arg;
	      i = 0;
	      while ((c = getorchar())!= '#'); /* Skip to next # */
	      mm->body = (char*)mmalloc(100);
	      while ((c = getorchar())!= '#') {
		mm->body[i++] = c;
		if (i>= size) mm->body = mrealloc(mm->body, size += 100);
		if (c == '\n') {
		  srccnt++;
		}	      
	      }
	      mm->body[i]='\0';
	      mm->next = macros;
	      macros = mm;
/* 	      printf("Macro %s with %d arguments defined\n", */
/* 		     mm->name, mm->acnt); */
	      c = ' ';
	    }
	    else if (c=='i') {
	      int delim;
	      if ((c = getorchar())!='n' || (c = getorchar())!='c' ||
		  (c = getorchar())!='l' || (c = getorchar())!='u' ||
		  (c = getorchar())!='d' || (c = getorchar())!='e')
		lexerr("Not #include");
	      while (isspace(c = getorchar()));
	      delim = c;
	      i = 0;
	      while ((c=getorchar())!=delim) mname[i++] = c;
	      mname[i]='\0';
	      while ((c=getorchar())!='\n');
	      str++;
	      str->string = 0;
	      str->file = fopen(mname, "r");
	      str->body = (char*)malloc(i);
	      strcpy(str->body, mname);	/* Remember name */
	      str->line = 1;
	    }
	    else if (c=='u') {
	      if ((c = getorchar())!='n' || (c = getorchar())!='d' ||
		  (c = getorchar())!='e' || (c = getorchar())!='f')
		lexerr("Not #undef");
	      while (isspace(c = getorchar()));
	      do {
		mname[i++] = c;
	      } while (isalpha(c = getorchar()));
	      mname[i] = '\0';
	      printf("macro %s undefine\n", mname);
	      if (strcmp(mname, macros->name)==0) {
		MACRO *mm=macros->next;
		mfree(macros->name); mfree(macros->body);
		for (i=0; i<macros->acnt; i++)
		  mfree(macros->arg[i]);
		mfree(macros); macros = mm;
	      }
	      else {
		MACRO *mm = macros;
		MACRO *nn = mm->next;
		while (strcmp(mname, nn->name)!=0) {
		  mm = nn; nn = nn->next;
		  if (nn==NULL) lexerr("Undefining undefined macro");
		}
		mfree(nn->name); mfree(nn->body);
		for (i=0; i<nn->acnt; i++)
		  mfree(nn->arg[i]);
		mm->next = nn->next; mfree(nn);
	      }
	      while (c!='\n') c = getorchar(); /* ignore rest of line */
	    }
	    else {
	      err_printf("Warning: Unknown # option");
	      ungetorchar(c);
	      c = '#';
	    }
	  }
	  else if (c == '$') {
	    char name[100];
	    int i=0;
	    int j;
	    MACRO *mm = macros;
	    ingappop = 0;
	    while (isalpha(c=getorchar())) name[i++] = c;
	    if (c!='.') { ungetorchar(c); }
	    name[i] = '\0';
	    while (mm!=NULL) {	/* Find the definition */
	      if (strcmp(name, mm->name)==0) break;
	      mm = mm->next;
	    }
	    if (mm==NULL) {
	      lexerr("Undefined macro");
	      continue;
	    }
/* 	    printf("Found macro %s required %d arguments\n", */
/* 		   mm->name, mm->acnt); */
				/* Should bind arguments here */
				/* How do I recognise entities?? */
	    if (mm->acnt) {
	      if ((c=getorchar())!='(') lexerr("Syntax error in macro call");
	      for (j=0; j<mm->acnt; j++) {
		char term = (j==mm->acnt-1 ? ')' : '#');
		MACRO* nn = (MACRO*) mmalloc(sizeof(MACRO));
		int size = 100;
		nn->name = mmalloc(strlen(mm->arg[j])+1);
		strcpy(nn->name, mm->arg[j]);
/* 		printf("defining argument %s ", nn->name); */
		i = 0;
		nn->body = (char*)mmalloc(100);
		while ((c = getorchar())!= term) {
		  nn->body[i++] = c;
		  if (i>= size) nn->body = mrealloc(nn->body, size += 100);
		  if (c == '\n') {
		    srccnt++;
		  }	      
		}
		nn->body[i]='\0';
/* 		printf("as...#%s#\n", nn->body); */
		nn->acnt = 0;	/* No arguments for arguments */
		nn->next = macros;
		macros = nn;
	      }
	    }
 	    cp--;		/* Ignore $ sign */
	    str++;
	    str->string = 1; str->body = mm->body; str->args = mm->acnt;
	    str->mac = mm;
	    str->line = 1;
	    ingappop = 1;
	  }
        }
        if (cp >= endspace) {
          die("file too large for ortext space"); /* Ought to extend */
	}
        if (*(cp-1) != '\n')			/* if no final NL,	*/
          *cp++ = '\n';				/*    add one		*/
        else --lincnt;
        linadr[lincnt+1] = NULL;		/* terminate the adrs list */
        printf("%d lines read\n",lincnt);
        fclose(fp);				/* close the file	*/
        curline = 0;				/*   & reset to line 1	*/
	while (macros) {			/* Clear all macros */
	  int i;
	  mfree(macros->body);
	  mfree(macros->name);
	  for (i=0; i<macros->acnt; i++) mfree(macros->arg[i]);
	  macros = macros->next;
	}
	nullist = (ARGLST *) mmalloc(sizeof(ARGLST));	/* nullist is a count only  */
	nullist->count = 0;
	nxtarglist = (ARGLST *) mmalloc(sizeof(ARGLST) + 200*sizeof(char*));
}

static int splitline(void)      /* split next orch line into atomic groups */
{			/* cnt labels this line, and set opgrpno where found */
	int	grpcnt, prvif, logical, condassgn, parens;
	int	c, collecting;
	char	*cp, *lp, *grpp=NULL;

        if (collectbuf == NULL)
	        collectbuf = mcalloc((long)lenmax);
nxtlin:	if ((lp = linadr[++curline]) == NULL)	/* point at next line	*/
		return(0);
	VMSG( printf("LINE %d:\n",curline); )
	linlabels = opgrpno = 0;
	grpcnt = prvif = logical = condassgn = parens = collecting = 0;
	cp = collectbuf;
	while ((c = *lp++) != '\n') {		/* for all chars this line:  */
	    if (cp - collectbuf >= lenmax) {
		int i;
		char *nn = mcalloc(lenmax+LENMAX);
		memcpy(nn, collectbuf, lenmax);	/* Copy data */
		cp = (cp - collectbuf) + nn;    /* Adjust pointer  */
		for (i=0; i<grpcnt; i++) group[i] += (nn-collectbuf);
		mfree(collectbuf);		/* Need to correct grp vector */
		collectbuf = nn;
		lenmax += LENMAX;
/*		err_printf( "SplitLine buffer extended to %d\n", lenmax); */
/*		die("line LENMAX exceeded"); */
	    }
	    if (c == '"') {                     /* quoted string:    */
		if (collecting) {
		    synterrp(lp-1,"unexpected quote character");
		    continue;
		}
		if (grpcnt >= grpmax) {
		    int i;
		    char **nn=(char **)mcalloc((grpmax+GRPMAX+1)*sizeof(char*));
		    for (i=0; i<grpmax; i++) nn[i] = group[i];
		    mfree(group);
		    group = nn;
		    nn =(char **) mcalloc((grpmax+GRPMAX+1)*sizeof(char*));
		    for (i=0; i<grpmax; i++) nn[i] = grpsav[i];
		    mfree(grpsav);
		    grpsav= nn;
		    grpmax += GRPMAX;
/* 		    err_printf( "group extended to %d\n", grpmax); */
/*		    die("GRPMAX overflow");*/
		}
		grpp = group[grpcnt++] = cp;
		*cp++ = c;                      /*  cpy to nxt quote */
		while ((*cp++ = c = *lp++) != '"' && c != '\n');
		if (c == '\n')
		    synterrp(lp-1,"unmatched quotes");
		collecting = 1;                 /*   & resume chking */
		continue;
	    }
	    if (c == ';') {
		while ((c = *lp++) != '\n');	/* comments:  gobble */
		break;				/*    & exit linloop */
	    }
	    if (c == '/' && *lp == '*') { /* C Style comments */
	      char *ll = strstr(++lp, "*/");
	      if (ll == NULL) synterrp(lp-2, "Unmatched comment");
	      lp = ll+2;
	      break;
	    }
	    if (c == ' ' || c == '\t') {		/* spaces, tabs:     */
		if (!opgrpno && collecting) {	/*  those befor args */
		    *cp++ = '\0';		/*  can be delimitrs */
		    collecting = 0;
		    if (strcmp(grpp,"if") == 0) { /* of if opcod */
			strcpy(grpp,"gcgoto");  /* (replace) */
			cp = grpp + 7;
			prvif++;
		    }
		    if (isopcod(grpp))	/*   or maybe others */
			opgrpno = grpcnt;
		}
		continue;			/* now discard blanks*/
	    }
	    if (c == ':' && collecting && grpcnt == linlabels+1) {
		linlabels++;			/* colon in 1st grps */
		*cp++ = '\0';			/*  is also delimitr */
		collecting = 0;			/*  (do not copy it) */
		continue;
	    }
	    if (c == '=' && !opgrpno) {		/* assign befor args */
		if (collecting)			/* can be a delimitr */
		    *cp++ = '\0';
		grpp = group[grpcnt++] = cp;	/* is itslf an opcod */
		*cp++ = c;
		*cp++ = '\0';
		isopcod(grpp);
		opgrpno = grpcnt;
		collecting = 0;			/* & self-delimiting */
		continue;
	    }
	    if (c == ',') {				/* comma:	 */
		if (!collecting)
		    synterrp(lp-1,"misplaced comma");
		if (parens) {
		    synterrp(lp-2,"unbalanced parens");
		    parens = 0;
		}
		*cp++ = '\0';			/*  terminate strng */
		collecting = logical = condassgn = 0;
		continue;
	    }
	    if (prvif && collecting) {		/* for prev "if":    */
		if (strncmp(lp-1,"goto",4) == 0) {/* if found "goto" */
		    *cp++ = '\0';		/*	delimit cond */
		    lp += 3;		/*	& step over  */
		    prvif = collecting = 0;
		    continue;
		}
		else if ((c == 'i' || c == 'k')	/*  if preced i or k */
			 && strncmp(lp,"goto",4) == 0) { /*  before "goto"  */
		    *group[opgrpno-1] = c;  /*     modify gcgoto */
		    isopcod(group[opgrpno-1]);
		    *cp++ = '\0';		/*     then delimit  */
		    lp += 4;			/*	etc	     */
		    prvif = collecting = 0;
		    continue;
		}
	    }
	    if (!collecting++) {		/* remainder are     */
		if (grpcnt >= grpmax) {		/* collectable chars */
		    int i;
		    char **nn =
			(char**)mcalloc((grpmax+GRPMAX+1)*sizeof(char*));
		    for (i=0; i<grpmax; i++) nn[i] = group[i];
		    mfree(group);
		    group = nn;
		    nn =
		        (char **)mcalloc((grpmax+GRPMAX+1)*sizeof(char*));
		    for (i=0; i<grpmax; i++) nn[i] = grpsav[i];
		    mfree(grpsav);
		    grpsav= nn;
		    grpmax += GRPMAX; /* Have increased the group vector */
/* 		    err_printf( "group extended (2) to %d\n", grpmax); */
/* 		    die("GRPMAX overflow"); */
		}
		grpp = group[grpcnt++] = cp;
	    }
	    if ( c >= 'a' && c <= 'z'	    /* establish validity */
		 || c >= '0' && c <= '9'
		 || c == '+' || c == '-'
		 || c == '*' || c == '/'
                 || c == '.' || c == '_'
                 || c >= 'A' && c <= 'Z' /* allow uppercases and underscore in variables */
		 	)
		;
	    else if (c == '(')
		parens++;		    /* and monitor function */
	    else if (c == ')')
		--parens;
	    else if ((c == '>' || c == '<' || c == '='
		      || c == '!' || c == '&' || c == '|')
		     && (prvif || parens) )
		logical++;
	    else if (c == '?' && logical )
		condassgn++;
	    else if (c == ':' && condassgn)
		;
	    else {
		sprintf(errmsg,"illegal character %c",c);
		synterrp(lp-1,errmsg);
	    }
	    *cp++ = c;			        /* then collect the char   */
	}					/*  and loop for next      */
	
	if (!grpcnt)				/* if line was trivial,	   */
		goto nxtlin;			/*	try another	   */
	if (collecting) {			/* if still collecting,    */
		*cp = '\0';			/* 	terminate	   */
		if (!opgrpno)			/*	& chk for opcod	   */
			if (isopcod(grpp))
				opgrpno = grpcnt;
	}
	if (parens)				/* check balanced parens   */
		synterrp(lp-1,"unbalanced parens");  
	if (grpcnt > linlabels && !opgrpno) {	/* if no full line opcod,  */
		synterr("no legal opcode");	/*	complain &	   */
		goto nxtlin;			/*	try another	   */
	}
	linopnum = opnum;			/* else save full line ops */
	linopcod = opcod;
	VMSG( printgroups(grpcnt); )
	POLL_EVENTS();                  /* on Mac/win, allow system events */
	return(grpcnt);
}

static  void    lblclear(void), lblrequest(char *);
static  void	lblfound(char *), lblchk(void);

TEXT *getoptxt(int *init)       /* get opcod and args from current line */
{				/*	returns pntr to a TEXT struct	*/
    static	short	grpcnt = 0, nxtest = 1;
    static	short	xprtstno = 0, polcnt = 0;
    static	short	instrblk = 0, instrcnt = 0;
    static	TEXT	optext;	/* struct to be passed back to caller   */

    extern	char	*tokenstring;
    extern	POLISH	*polish;
    extern	int	tran_nchnls;
    TEXT	*tp;
    char	c, d, str[20], *s, argtyp(char *);
    int		nn, incnt, outcnt;

#ifdef RESET
    if (*init) {
      grpcnt = 0;
      nxtest = 1;
      xprtstno  =  0;
      polcnt  =  0;
      instrblk  =  0;
      instrcnt  =  0;
      *init = 0;
      memset(&optext,0,sizeof(TEXT));
    }
#endif
 tstnxt:
    tp = &optext;
    if (nxtest >= grpcnt) {		/* if done with prevline, */
      if (!(grpcnt = splitline()))	/*    attack next line	  */
	return((TEXT *)0);		/*    (else we're done)	  */
      for (nn=0; nn<grpcnt; nn++)	/*    save the group pntrs */
	grpsav[nn] = group[nn];
      xprtstno = grpcnt - 1;		/*    and reinit indices  */
      nxtest = 0;
      tp->linenum = curline;
    }
    if (linlabels) {
      s = strsav(group[nxtest]);
      lblfound(s);
      tp->opnum = LABEL;
      tp->opcod = s;
      tp->inlist = tp->outlist = nullist;
      linlabels--;
      nxtest++;
      return(tp);
    }
    if (!instrcnt) {			/* send initial "instr 0"    */
      tp->opnum = INSTR;
      tp->opcod = strsav("instr");	/*    to hold global assigns */
      tp->outlist = nullist;
      nxtarglist->count = 1;
      nxtarglist->arg[0] = strsav("0");
      tp->inlist = copy_arglist(nxtarglist);
      instrcnt = instrblk = 1;
      return(tp);
    }					/*  then at 1st real INSTR,  */
    if (instrcnt == 1 && instrblk && opnum == INSTR) {
      tp->opnum = ENDIN;		/*  send an endin to */
      tp->opcod = strsav("endin");	/*  term instr 0 blk */
      tp->outlist = tp->inlist = nullist;
      instrblk = 0;
      instrcnt = 2;
      return(tp);
    }
    while (xprtstno >= 0) {		/* for each arg (last 1st):  */
      if (!polcnt)			/* if not midst of expressn  */
	polcnt = express(group[xprtstno--]);  /* tst nxtarg  */
      if (polcnt < 0) {		     	/* polish but arg only, */
	group[xprtstno+1] = strsav(tokenstring); /* redo ptr */
	polcnt = 0;			/* & contin */
      }
      else if (polcnt) {
	POLISH	*pol;	     		/* for real polish ops, */
	int n;
	pol = &polish[--polcnt];        /*    grab top one      */
	if (isopcod(pol->opcod) == 0) {	/* and check it out  */
	  synterr("illegal opcod from expr anal");
	  goto tstnxt;
	}
	tp->opnum = opnum;		/* ok to send subop */
	tp->opcod = strsav(opcod);
	nxtarglist->count = outcnt = 1;
	nxtarglist->arg[0] = strsav(pol->arg[0]);
	tp->outlist = copy_arglist(nxtarglist);
	n = nxtarglist->count = incnt = pol->incount;
	do  nxtarglist->arg[n-1] = strsav(pol->arg[n]);
	while (--n);
	tp->inlist = copy_arglist(nxtarglist);
	if (!polcnt)			/* last op? hit the grp ptr */
	  group[xprtstno+1] = tp->outlist->arg[0];
	goto spctst;
      }
    }
    if (nxtest < opgrpno-1) {
      c = argtyp(group[nxtest]);		/* use outype	    */
      if (strcmp(linopcod,"=") == 0
	  || strcmp(linopcod,"init") == 0	/*    to modify     */
	  || strcmp(linopcod,"pchmidib") == 0
	  || strcmp(linopcod,"octmidib") == 0	/*    some opcodes  */
	  || strcmp(linopcod,"cpsmidib") == 0
	  || strcmp(linopcod,"midictrl") == 0
	  || (( strcmp(linopcod,"table") == 0	/*    with prefix   */
		|| strcmp(linopcod,"tablei") == 0)
	      && (c == 'i' || c == 'p'))) {
	if (c == 'p')	c = 'i';
	if (c == '?')	c = 'a';  		/* tmp */
	*str = c;
	*(str+1) = '\0';
	if (!(isopcod(strcat(str,linopcod)))) {
	  sprintf(errmsg,"output arg '%s' illegal type",
		  group[nxtest]);
	  synterr(errmsg);    			/* report syntax error     */
	  nxtest = 100;       			/* step way over this line */
	  goto tstnxt;        			/* & go to next            */
	}
	linopnum = opnum;
	linopcod = opcod;
	VMSG( printf("modified opcod: %s\n",opcod); )
	  }
      else if (strcmp(linopcod,"oscil") == 0	/* for OSCIL's     */
	       || strcmp(linopcod,"oscili") == 0) { /*  inarg types -> */
	if ((c = argtyp(group[opgrpno ] )) != 'a') c = 'k';
	if ((d = argtyp(group[opgrpno+1])) != 'a') d = 'k';
	sprintf(str,"%s%c%c",linopcod,c,d);
	isopcod(str); /*  opcode with suffix */
	linopnum = opnum;
	linopcod = opcod;
	VMSG( printf("modified opcod: %s\n",opcod); )
	  c = argtyp(group[nxtest]);  		/* reset outype params */
      }					/* need we reset outype again here ? */
    }
    tp->opnum = linopnum;			/* now use identified	*/
    tp->opcod = strsav(linopcod);		/*   full line opcode	*/
    if (strncmp(linopcod,"out",3) == 0)
      if (tran_nchnls == 1 && strcmp(linopcod,"out" ) != 0
	  || tran_nchnls == 2 && strncmp(linopcod,"outs",4) != 0
	  || tran_nchnls == 4 && strncmp(linopcod,"outq",4) != 0)
	synterr("out inconsistent with global nchnls");
    incnt = outcnt = 0;
    while (nxtest < opgrpno-1)		/* create the out arglist  */
      nxtarglist->arg[outcnt++] = strsav(group[nxtest++]);
    nxtarglist->count = outcnt;
    if (outcnt == 0)
      tp->outlist = nullist;
    else {
      tp->outlist = copy_arglist(nxtarglist); /* & prep ins */
    }
    nxtest++;
    while (nxtest < grpcnt)			/*	& ensuing inargs  */
      nxtarglist->arg[incnt++] = strsav(group[nxtest++]);
    nxtarglist->count = incnt;
    if (incnt==0)
      tp->inlist = nullist;
    else tp->inlist = copy_arglist(nxtarglist);
    grpcnt = 0;				/* all done w. these groups */
	
 spctst:
    tp->xincod = 0;
    if (tp->opnum == INSTR) {			/* for opcod INSTR  */
      if (instrblk)
	synterr("instr blks cannot be nested (missing 'endin'?)");
      else instrblk = 1;
      resetouts();				/* reset #out counts */
      lblclear();				/* restart labelist  */
    }
    else if (tp->opnum == ENDIN) {			/* ENDIN:	*/
      lblchk();				/* chk missed labels */
      if (!instrblk)
	synterr("unmatched endin");
      else instrblk = 0;
    }
    else {					/* for all other opcodes:  */
      extern	 OENTRY	opcodlst[];
      OENTRY	*ep = opcodlst + tp->opnum;
      int	n, nreqd;
      char	tfound, treqd, *types;

      if (!instrblk)
	synterr("misplaced opcode");
      if ((n = incnt) > (nreqd = strlen(types = ep->intypes))) {
	if ((treqd = types[nreqd-1]) == 'n') {/* indef args: */
	  if (!(incnt & 01))	      /* require odd */
	    synterr("missing or extra arg");
	}
	else if (treqd != 'm')		      /* else any no */
	  synterr("too many input args");
      }
      else if (incnt < nreqd) {		/*  or set defaults: */
	do {
	  switch(types[incnt]) {
	  case 'o': nxtarglist->arg[incnt++] = strsav("0");
	    break;
	  case 'p': nxtarglist->arg[incnt++] = strsav("1");
	    break;
	  case 'q': nxtarglist->arg[incnt++] = strsav("10");
	    break;
	  case 'v': nxtarglist->arg[incnt++] = strsav(".5");
	    break;
	  case 'h': nxtarglist->arg[incnt++] = strsav("127");
	    break;
	  case 'j': nxtarglist->arg[incnt++] = strsav("-1");
	    break;
	  case 'm': nreqd--;
	    break;
	  default:  synterr(
			    "insufficient required arguments");
	    goto chkin;
	  }
	} while (incnt < nreqd);
	nxtarglist->count = n = incnt;		/*    in extra space */
	if (tp->inlist == nullist && incnt > 0) {
			  	/*MWB 2/11/97 fixed bug that prevented an
				  opcode with only optional arguments from
				  properly loading defaults */
	  tp->inlist = copy_arglist(nxtarglist);
	}
      }
    chkin:
      if (n>tp->inlist->count) {
	int i;
	size_t m = sizeof(ARGLST)+ (n-1)*sizeof(char*);
	tp->inlist = (ARGLST*)mrealloc(tp->inlist, m);
/* 	printf("extend_arglist by %d args\n", n-tp->inlist->count); */
	for (i=tp->inlist->count; i<n; i++) {
	  tp->inlist->arg[i] = nxtarglist->arg[i];
/* 	  printf("%d = %s:\n", i, tp->inlist->arg[i]); */
	}
	tp->inlist->count = n;
      }
      while (n--) {					/* inargs:   */
	s = tp->inlist->arg[n];
	if (n >= nreqd)			/* det type required */
	  treqd = 'i';		/*   (indef in-type */
	else treqd = types[n];		/*	 or given)   */
	if (treqd == 'l') {		/* if arg takes lbl  */
	  VMSG(printf("treqd = l\n");)
	    lblrequest(s);		/*	req a search */
	    continue;		/*	chk it later */
	}
	tfound = argtyp(s);		/* else get arg type */
	if (tfound != 'c' && tfound != 'p'
	    && tfound != 'S' && !lgprevdef) {
	  sprintf(errmsg,
		  "input arg '%s' used before defined",s);
	  synterr(errmsg);
	}
	VMSG( printf("treqd %c, tfound %c\n",treqd,tfound); )
	  if (tfound == 'a' && n < 4) {	/*JMC added for FOG*/
	    /* 4 for FOF, 8 for FOG */
	    static short xincod[4] = {2,1,4,8};
	    tp->xincod += xincod[n];
	  }
	  switch(treqd) {
	  case 'd': if (tfound != 'd')
	    intyperr(n,tfound);
	  break;
	  case 'w': if (tfound != 'w')
	    intyperr(n,tfound);
	  break;
	  case 'a': if (tfound != 'a')
	    intyperr(n,tfound);
	  break;
	  case 's':
	  case 'x': if (tfound == 'a') {
	    if (tp->outlist != nullist) {
	      char outyp = argtyp(tp->outlist->arg[0]);
	      if (outyp != 'a' && outyp != 'd')
		intyperr(n,tfound);
	    }
	    break;
	  }
	  case 'k': if (tfound == 'k')
	    break;
	  case 'h':
	  case 'i':
	  case 'j':
	  case 'm':
	  case 'n':
	  case 'o':
	  case 'p':
	  case 'q':
	  case 'v': if (treqd != 's'
			&& (tfound == 'i' || tfound == 'p'
			    || tfound == 'c' || tfound == 'r'))
	    break;
	  intyperr(n,tfound);
	  break;
	  case 'S': if (tfound != 'S'
			&& tfound != 'i' && tfound != 'p'
			&& tfound != 'c')
	    intyperr(n,tfound);
	  break;
	  case 'B': if (tfound == 'B')
	    break;
	  case 'b': if (tfound == 'b')
	    break;
	  default:  intyperr(n,tfound);
	    break;
	  }
      }
      VMSG( printf("xincod = %d\n",tp->xincod); )
      if ((n = outcnt) != (int)strlen(types = ep->outypes)
	  && (*types != (char)'m' || !n || n > 4))
	synterr("illegal no of output args");
      while (n--) {					/* outargs:  */
	s = tp->outlist->arg[n];
	treqd = types[n];
	tfound = argtyp(s);			/*  found    */
	VMSG( printf("treqd %c, tfound %c\n",treqd,tfound); )
	if (tfound == 'd' || tfound == 'w')
	  if (lgprevdef) {
	    sprintf(errmsg,
		    "output name previously used, type '%c' must be uniquely defined",
		    tfound);
	    synterr(errmsg);
	  }
	if (tfound == treqd)			/*  as reqd, */
	  continue;
	switch(treqd) {				/*  or else  */
	case 's': if (tfound == 'a' || tfound == 'k')
	  continue;
	break;
	case 'i': if (tfound == 'p')
	  continue;
	break;
	case 'B': if (tfound == 'b')
	  continue;
	break;
	case 'm': if (tfound == 'a')
	  continue;
	break;
	}
	sprintf(errmsg,"output arg '%s' illegal type",s);
	synterr(errmsg);
      }
      if (incnt) {
	if (ep->intypes[0] != 'l')	/* intype defined by 1st inarg */
	  tp->intype = argtyp(tp->inlist->arg[0]);
	else tp->intype = 'l';	/*   (unless label)  */
      }
      if (outcnt)			/* pftype defined by outarg */
	tp->pftype = tfound;
      else tp->pftype = tp->intype;   /*    else by 1st inarg     */
    }
    return(tp);				/* return the text blk */
}

static void intyperr(int n, char tfound)
{
        char *s = grpsav[opgrpno + n];
	char t[10];

	switch(tfound) {
	case 'd':
	case 'w':
	case 'a':
	case 'k':
	case 'i':
	case 'p': t[0] = tfound;
		  t[1] = '\0';
		  break;
	case 'r':
	case 'c': strcpy(t,"const");
		  break;
	case 'S': strcpy(t,"string");
	          break;
	case 'b':
	case 'B': strcpy(t,"boolean");
		  break;
	case '?': strcpy(t,"?");
		  break;
	}
	sprintf(errmsg,"input arg '%s' of type %s not allowed",s,t);
	synterr(errmsg);
}

/* This function has been totally rewritten to use a chain of space pools
 * so there is limit beyond total memory -- JPff March 1995
 */
static char *strsav(char *s)
{
    char	*t, *u;
    struct spchain *pool = &sp_chain;

    while (1) {
				/* Look in the pool */
	t = pool->sspace;
	do {
	    if (*s == *t && strcmp(s,t) == 0) /* srch storage for match */
		return(t);		   /*  & return where found  */
	    while (*t++);
	} while (t < pool->sspnxt);
	if (t != pool->ssplim) break;
	if (pool->next == NULL) break;
/*	err_printf( "Next pool for %s\n", s); */
	pool = pool->next;
    }
    if (strlen(s)+t+1 > pool->ssplim) {
/* 	long n = pool->ssplim - pool->sspnxt; */
	pool->ssplim = pool->sspnxt;
	pool->next = (struct spchain*)mmalloc(sizeof(struct spchain));
/* 	err_printf( */
/* 		"STRSPACE pool extended (for %s) to %ld bytes\n", */
/* 		s, space_size += (STRSPACE-n)); */
	pool = pool->next;
	t = pool->sspnxt = pool->sspace = (char *)mmalloc(STRSPACE);
	pool->ssplim = pool->sspace + STRSPACE;
    }	
    u = t;
	
    while (*t++ = *s++);	/* else enter as new string */
    pool->sspnxt = t;
    return(u);			/* & return with its address */
}

static int isopcod(char *s)	/* tst a string against opcodlst  */
				/*   & set op carriers if matched */
{
extern	 OENTRY	opcodlst[], *oplstend;
         OENTRY	*ep;
	 char	*ename;

	ep = opcodlst;
	while (++ep < oplstend && (ename = ep->opname) != NULL)
		if (strcmp(s,ename) == 0) {		/* on corr match,   */
			opnum = ep - opcodlst;		/*  set op carriers */
			opcod = ename;
			return(1);			/*  & report success */
		}
	return(0);
}

int getopnum(char *s)		/* tst a string against opcodlst  */
 				/*   & return with opnum          */
{
extern	 OENTRY	opcodlst[], *oplstend;
        OENTRY	*ep = opcodlst;

	while (++ep < oplstend && ep->opname != NULL)
		if (strcmp(s,ep->opname) == 0)		/* on corr match,   */
			return(ep - opcodlst);		/*  return w. opnum */
	die("unknown opcode");
	return(0);  /* compiler only */
}

char argtyp(char *s)	/* find arg type:  d, w, a, k, i, c, p, r, S, B, b */
{			/*   also set lgprevdef if !c && !p && !S */
extern int pnum(char *), lgexist(char *);

	char c;

	if (((c = *s) >= '0' && c <= '9')
	  || c == '.' || c == '-' || c == '+')
	  	return('c');				/* const */
	if (pnum(s) >= 0)
		return('p');				/* pnum	*/
	if (c == '"')
		return('S');				/* quoted String */
	lgprevdef = lgexist(s);				/* (lgprev) */
	if (strcmp(s,"sr") == 0 || strcmp(s,"kr") == 0
	 || strcmp(s,"ksmps") == 0 || strcmp(s,"nchnls") == 0)
	 	return('r');				/* rsvd	*/
	if (c == 'd' || c == 'w') /* N.B. d,w NOT YET #TYPE OR GLOBAL */
		return(c);
	if (c == '#')
		c = *(++s);
	if (c == 'g')
		c = *(++s);
	if (c == 'a' || c == 'k' || c == 'i' || c == 'B' || c == 'b')
		return(c);
	else return('?');
}

static void lblclear(void)
{
	lblcnt = 0;
}

static void lblrequest(char *s)
{
    int	req;

    for (req=0; req<lblcnt; req++)
      if (strcmp(lblreq[req].label,s) == 0)
          return;
	lblreq[req].reqline = curline;
	lblreq[req].label =s;
	lblcnt++;
}

static void lblfound(char *s)
{
    int	req;

    for (req=0; req<lblcnt; req++ )
      if (strcmp(lblreq[req].label,s) == 0) {
        if (lblreq[req].reqline == 0)
          synterr("duplicate label");
        goto noprob;
      }
    if (++lblcnt >= lblmax) {
      LBLREQ *tmp = mrealloc(lblreq, lblmax += LBLMAX);
      if (tmp==NULL)
        die("label list is full");
      lblreq = tmp;
    }
    lblreq[req].label = s;
noprob:
    lblreq[req].reqline = 0;
}

static void lblchk(void)
{
    int	req;
    int	n;

    for (req=0; req<lblcnt; req++ )
      if (n = lblreq[req].reqline) {
        char	*s;
        printf("error line %d.  unknown label:\n",n);
        s = linadr[n];
        do {
          putchar(*s);
          if (dribble) putc(*s, dribble);
        } while (*s++ != '\n');
        synterrcnt++;
      }
}

void synterr(char *s)
{
	int	c;
	char	*cp;

	printf("error:  %s",s);
	if ((cp = linadr[curline]) != NULL) {
		printf(", line %d:\n",curline);
		do {
		  putchar((c = *cp++));
		  if (dribble) putc(c, dribble);
		} while (c != '\n');
	}
	else {
	  putchar('\n'); if (dribble) putc('\n', dribble);
	}
	synterrcnt++;
}

void synterrp(char *errp, char *s)
{
	char	*cp;

	synterr(s);
	cp = linadr[curline];
	while (cp < errp) {
	        int ch = *cp++;
		if (ch != '\t') ch = ' ';
		putchar(ch);
		if (dribble) putc(ch, dribble);
	}
	printf("^\n");
}

static void lexerr(char *s)
{
    struct in_stack *curr = str;
    printf("error:  %s",s);
    while (curr!=inputs) {
      if (curr->string) {
	MACRO *mm;
	while (mm != curr->mac) mm = mm->next;
	printf("called from line %d of macro %s\n", curr->line, mm->name);
      }
      else {
	printf("in line %f of file input %s\n", curr->line, curr->body);
      }
      curr--;
    }
}

static void printgroups(int grpcnt)	/*   debugging aid (onto stdout) */
{
    char	c, *cp = group[0];
    printf("groups:\t");
    while (grpcnt--) {
      printf("%s ", cp);
      while (c = *cp++);
    }
    printf("\n");
}