# define NOMORE -1000
# define FLAG1 -1000
# define FLAG2 -2000
# define msize 4000
# define asize 4000

	/* machine types */

# define GCOS 1
# define UNIX 2
# define IBM 3
	/* wishlist */

/*	make the def, and a arrays byte arrays whenever possible
/*	also, yyr1, yyr2, etc..
/*	check for error recovery botch in parser.c
/*	use defines for limits, like yacc


	*/
extern int cin;
extern int cout;

int machine;  /* has machine type */
int *yyact;
int *yypact;
int *yyr1;
int *yyr2;
int *yygo;
int *yypgo;
int mem[ msize ];
int *pmem { mem };
int nterms;
int nnonter;
int nstate;
int nprod;

int *endact;

int a[asize];  /* representation of the parser */
int *maxa;
int pa[350];  /* index into a */
int def[350]; /* defaults*/
int chk[350]; /* checks */
int sym[400] ;  /* terminal symbols */
int temp[400];
int greed[350];
int pgo[350];
int ggreed[100];

int *psym ;  /* pointer to next symbol slot */
int rsym;  /* range of symbols */
int maxoff;  /* maximum offset into a array */

int nxdb 0;
int dfdb 0;
int chkdb 0;
int symdb 0;
int adb 0;
int nentr 0;

int alpha 1;
int beta 1;

int grflg 1;
int origfl 1;
int rflag 0;
int vflag 0;

main( argc, argv ) char *argv[]; {

	register i, *p, j;
	int flag;

	/* get the options, if any */

	if( argc > 1 ){
		for( i=0; j=argv[1][i]; ++i ){
			switch(j){

			case 'g':  grflg = 0; continue;
			case 'o':  origfl = 0; continue;
			case 'r':  rflag = 1; continue;
			case 'v':  vflag = 1; continue;

				}

			}
		}

	/* open the input and output files */

	cin = copen( "yacc.tmp", 'r' );
	if( cin < 0 ) error( "missing yacc.tmp file" );
	cout = copen( rflag ? "y.tab.r" : "y.tab.c", 'w' );
	cflush( cout );
	if( cout < 0 ) error( "missing output file" );

	whereami();  /* determine environment */

	/* read the arrays from yacc.tmp and set parameters */

	i = arget( "int yyact", &yyact );
	nstate = arget( "int yypact", &yypact ) - 2;
	nprod = arget( "int yyr1", &yyr1 ) -  1;
	arget( "int yyr2", &yyr2 );
	arget( "int yygo", &yygo );
	nnonter = arget( "int yypgo", &yypgo ) - 2;
	if( nnonter < 1 ) error( "bad format on yacc.tmp" );
	arget( "yyact", &endact ); /* garbage to copy rest of file */

	/* get the default actions; always reduce or error */

	for( i=0; i<350; ++i ) chk[i] = 0;

	for( i=0; i<nstate; ++i ){

		greed[i] = 0;

		j = 0;
		for( p= &yyact[yypact[i+1]]; *p>>12 == 1; p =+ 2 ){
			if( (*p&07777) > j ) j = *p&07777;
			if( p[1]>>12 == 2 ) ++greed[i];  /* count shifts */
			}
		nentr =+ greed[i];
		greed[i] = alpha*greed[i] + beta*j;

		def[i] = *p&07777;

		if( dfdb ) printf( "State %d, default %d\n", i, def[i] );

		}

	/* initialize ggreed table */

	for( i=1; yypgo[i]>0; ++i ){
		ggreed[i] = 1;
		j = 0;
		for( p= &yygo[yypgo[i]]; *p>0; p =+ 2 ) {
			++ggreed[i];
			if( *p > j ) j = *p;
			chk[ p[1] ] = -i;
			}
		chk[ p[1] ] = -i;
		ggreed[i] = alpha*ggreed[i] + beta*j;
		}

	/* initialize sym table */

	for( i=0; i<400; ++i ) sym[i] = 0;
	psym = sym+1;

	/* find end of yyact */

	endact =  yypact - 1;

	/* make table of tests and symbols */

	for( p=yyact; p<endact; ++p ){

		if( *p>>12 == 1 ){ /* a test */

			j = lsym( *p );

			if( p[1]>>12 == 2 ) { /* a shift */

				i = p[1]&07777;  /* the target state */

				if( chk[i] != 0 && chk[i] != j ){ /* error */
					error("Position %d, state %d, %d onto %d\n",
						p-yyact, i, j, chk[i] );
					}
				chk[i] = j;
				}
			}
		}


	if( chkdb ){

		for( i=0; i<nstate; ++i ){
			if( chk[i] != 0 ) printf( "state %d, check %d\n", i, chk[i] );
			}
		}

	if( symdb ){

		for( p=sym; p<psym; ++p ){
			printf( "%d: symbol %d\n", p-sym, *p );
			}
		}

	/* set nterms to the number actually used + 1 */

	nterms = psym-sym;
	maxoff = origfl ? rsym : nterms; /* actual range of terminal symbol codes */
	if( nstate >= maxoff ) maxoff = nstate+1;

	/* now, prepare to put the shift actions into the a array */

	for( i=0; i<asize; ++i ) a[i] = 0;
	maxa = a;

	for( i=0; i<nstate; ++i ) {
		if( greed[i]==0 && adb>1 ) printf( "State %d: null\n", i );
		pa[i] = FLAG1;
		}

	while( (i = nxti()) != NOMORE ) {
		if( i >= 0 ) stin(i);
		else gin(-i);

		}

	if( adb>2 ){ /* print a array */
		for( p=a; p <= maxa; p =+ 10){
			printf( "%4d  ", p-a );
			for( i=0; i<10; ++i ) printf( "%4d  ", p[i] );
			printf( "\n" );
			}
		}
	/* write out the output appropriate to the language */

	if( rflag ) routput();
	else output();
	summary();
	zaptemp();
	cexit(0);
	}

gin(i){

	register *p, j, flag;

	/* enter gotos on nonterminal i into array a */

	ggreed[i] = 0;

	/* first, fill temp array; 0 has default */

	for( j=0; j<400; ++j ) temp[j] = 0;

	for( p = &yygo[yypgo[i]]; *p >= 0; p =+ 2 ){
		temp[ *p+1 ] = p[1];
		}
	temp[0] = p[1];

	/* now, find a place for it */

	for( p=a; p < &a[asize]; ++p ){
		for( j=0; j<maxoff; ++j ){
			if( temp[j] != 0 && p[j] != 0 ) goto nextgp;
			}
		for( j=0; j<maxoff; ++j ){
			if( temp[j] ) {
				if( maxa < &p[j] ) maxa = &p[j];
				if( maxa > &a[asize] ) error( "a array overflow" );
				p[j] = temp[j];
				}
			}

		pgo[i] = p-a;
		if( adb>1 ) printf( "Nonterminal %d, entry at %d\n" , i, pgo[i] );
		goto nextgi;

		nextgp:  ;
		}

	error( "cannot place goto %d\n", i );

	nextgi:  ;
	}

stin(i){

	register flag, j, *p;

	greed[i] = 0;

	/* enter state i into the a array */

	for( p = &temp[maxoff]; p>=temp; --p ) *p=0;

	for( p= &yyact[yypact[i+1]]; *p>>12==1; p =+ 2 ){
		if( p[1]>>12 == 2 ){ /* shift */
			temp[ lsym(*p) ] = p[1]&07777;
			}
		}

	/* temp array is now filled */
	/* find an acceptable place for temp */

	for( p=a-maxoff; p< &a[asize]; ++p ){

		if( (flag = compat( p, temp) ) > 0 ) continue;
		if( flag ){
			for( j=0; j<nstate; ++j ){
				if( pa[j] == p-a ) goto nextp;
				}
			}

		cpy( p, temp );
		pa[i] = p-a;
		if( adb>1 ) printf( "State %d: entry at %d\n", i, pa[i] );
		goto nexti;

		nextp:  ;
		}

	error( "Error; failure to place state %d\n", i );

	nexti:  ;
	}

lsym( v ){ /* check that v is a known symbol */

	register i, *p;

	i = v&07777;

	if( i > rsym ) rsym = i;

	for( p= sym; p<psym; ++p ) if( *p == i ) return( origfl ? i : p-sym );

	/* make new entry */

	*psym++ = i;

	return( origfl ? i : psym-sym-1 );

	}

compat( p, q ) int *p, *q; {

	register i, j, flag;

	/* is q compatible with p */
	/* if an absolute incompatibility, return 1 */
	/* if q has entries where p is empty, return -1 */
	/* if equal, return 0 */

	flag = 0;
	for( j=0; j<nterms; ++j ){
		i = origfl ? sym[j] : j ;
		if( q[i] == 0 ){
			if( p+i < a ) continue;
			if( chk[p[i]] == i ) return(1);
			}
		else {
			if( p+i < a ) return(1);
			if( p[i] == 0 ) ++flag;
			else if( q[i] != p[i] ) return(1);
			}
		}

	if( flag ) return( -1 );
	else return(0);
	}

cpy( p, q ) int *p, *q; {

	/* copy q into p */

	register i, j;

	for( j=0; j<nterms; ++j ){
		i = origfl ? sym[j] : j;
		if( q[i] == 0 ) continue;
		if( &p[i] > maxa ) maxa = &p[i];
		if( maxa > &a[asize] ) error( "a array overflow" );
		if( p[i] != 0 && p[i] != q[i] ) error( "clobber of p array" );
		p[i] = q[i];
		}
	}

error( s, x, y ) char *s; {

	cflush( 2 );
	cout = 2;
	printf( "Fatal error:" );
	printf( s, x, y );
	printf( "\n" );
	cexit(1);
	}

nxti(){ /* finds the next i */
	register i, max, maxi;

	if( grflg ){ /* be greedy; find the biggest */

		max = 0;

		for( i=1; i<= nnonter; ++i ) if( ggreed[i] >= max ){
			max = ggreed[i];
			maxi = -i;
			}

		for( i=0; i<nstate; ++i ) if( greed[i] >= max ){
			max = greed[i];
			maxi = i;
			}

		if( nxdb ) printf( "nxti = %d, max = %d\n", maxi, max );
		if( max==0 ) return( NOMORE );
		else return( maxi );
		}

	/* not greedy; take the first nonzero one */

	for( i=1; i<= nnonter; ++i ) if( ggreed[i] > 0 ) return( -i );
	for( i=0; i<nstate; ++i ) if( greed[i] > 0 ) return(i);
	return( NOMORE );
	}

summary(){
	/* write summary */

	register i, *p, j;

	if( !vflag ) return;
	i = copen( "y.output", 'a' );
	if( i < 0 ) error( "cannot open y.output" );
	cflush(i);
	cout = i;

	i=0;
	for( p=maxa; p>=a; --p ) {
		if( *p == 0 ) ++i;
		}

	printf( "\nOptimizer summary:\n" );
	printf( "%d table entries, %d zero\n", (maxa-a)+1, i );
	printf( "maximum offset: %d\n", maxoff );

	/* space summary */

	i = pmem-yyact+3;
	j = (maxa-a)+3*nstate+2*(nprod+1)+nnonter+5;
	printf( "Total space estimate(wds.): Old %d, new %d\n", i, j );

	}

output(){ /* this version is for C */

	register i, *p, n;
	int flag;

	/* write out the optimized parser */

	printf( "#\nextern int yychar;\n\n" );
	printf( "int yylast %d;\n", maxa-a+1 );

	/* write the translate function */

	if( !origfl ){
		printf( "yylex(){\n\tswitch( yyolex() ){\n" );
	
		for( p = sym; p<psym; ++p ){
			printf( "\tcase %d: return( %d);\n", *p, p-sym );
			}
	
		printf( "\tdefault: yyerror( \"illegal character\" ); return(%d);\n",
			origfl ? 256 : 1 ) ;
		printf( "\t\t}\n\t}\n\n" );
		}

	/* write the exception function */

	printf( "yyexcp(s){\n\textern int yydef[];\n\tswitch(s){\n" );

	for( i=0; i<nstate; ++i ){

		flag = 0;
		for( p= &yyact[yypact[i+1]]; *p>>12 == 1; p =+ 2 ){

			if( p[1]>>12 != 2 ){

				if( flag++ == 0 ) printf( "\tcase %d:\n", i);

				switch( p[1]>>12 ){
				case 0:  n = 0;  break;
				case 4:  n = -1; break;
				case 3:  n = p[1]&07777; break;
				default: error( "disaster, state %d\n", i );
					}

				printf( "\t\tif( yychar == %d ) return( %d );\n", lsym(*p), n );
				}
			}

		if( flag ){
			printf( "\t\treturn( %d );\n", def[i] );
			def[i] = -2;
			if( pa[i]== -1000 )pa[i] = -2000;  /* need yychar defined for this state */
			}

		}

	printf( "\t\t}\n\t}\n\n" );

	arout( "yyact", a, (maxa-a)+1 );
	arout( "yypact", pa, nstate );
	arout( "yypgo", pgo, nnonter+1 );
	arout( "yyr1", yyr1, nprod+1 );
	arout( "yyr2", yyr2, nprod+1 );
	arout( "yychk", chk, nstate );
	arout( "yydef", def, nstate );

	/* append the optimised parser */

	switch( machine ){

	case UNIX:
		cin = copen( "/usr/yacc/opar.c", 'r' );
		break;
	case GCOS:
		cin = copen( "./yaccopar", 'r' );
		break;
	case IBM:
		cin = copen( "MH2019.yaccopar", 'r' );
		break;
		}

	if( cin < 0 ) error( "cannot open optimized parser file" );
	while( i = getchar() ) putchar(i);

	}

arout( s, v, n ) char *s; int *v, n; {

	register i, j;

	printf( "%s[]{\n", s );
	for( i=0; i<n; ){
		if( i%10 == 0 ) printf( "\n" );
		printf( "%4d", v[i] );
		if( ++i == n ) printf( " };\n" );
		else printf( "," );
		}
	}


arget( s, ppi ) char *s; int **ppi; {

	/* read the input, copying, until an array appears; then
		convert the array into core
	/* s has the begining of the line begining the array
	/*  ppi points to a pointer to the begining of the array
	/*  the function returns the number of elements returned
	*/

	register i;
	register char *p, *q;

	/* search and copy, stopping at the array */

	for( ;; ) {  /* look at each line */

		for( p=s; (i=getchar()) == *p && i != 0 ; ++p );

		/* now, input matches s up to p, and i has first mismatch */

		if( i == 0 ) return( -1 ); /* endfile */
		if( *p != 0 ){ /* no match */
			for( q=s; q<p; ++q ) putchar( *q );
			while( i != '\n' && i != 0 ){
				putchar(i);
				i = getchar();
				}
			if( i == 0 ) return( -1 ); /* endfile */
			putchar( i );
			continue;
			}

		/* we have found the array */

		*ppi = pmem;
		while( getchar() != '{' );
		while( (i=gtnm()) == ',' );
		if( i != '}' ) error( "bad {} match" );
		while( getchar() != '\n' );

		return( pmem - *ppi );

		/* end of loop over lines */

		}

	}

gtnm(){

	register s, val, c;

	/* read and convert an integer from the standard input */
	/* return the terminating character */
	/* blanks, tabs, and newlines are ignored */

	s = 1;
	val = 0;

	while( c = getchar() ){
		if( c == ' ' || c == '\t' || c == '\n' ) continue;
		else if( c <= '9' && c >= '0' ){
			val = val * 10 + c - '0';
			}
		else if ( c == '-' ) s = -1;
		else break;
		}

	*pmem++ = s*val;
	if( pmem > &mem[msize] ) error( "out of space" );
	return( c );

	}

routput(){ /* produce ratfor output (groan! ); */

	register i, n, *p;
	int flag;

	/* produce exception function */

	printf( "integer function yyexcp( s, c )\n" );
	printf( "integer s, c\n" );

	for( i = 0; i<nstate; ++i ){

		flag = 0;
		for( p = &yyact[yypact[i+1]]; *p>>12 == 1; p =+ 2 ){

			if( p[1] >>12 != 2 ){

				if( flag++ == 0 ) printf( "if( s == %d ){\n" , i );

				switch( p[1] >> 12 ){
				case 0: n = 0; break;
				case 4: n = -1; break;
				case 3: n = p[1]&07777; break;
				default: error( "disaster, state %d", i );
					}

				if( flag > 1 ) printf( "else" );
				printf( "if( c== %d ) yyexcp= %d\n", lsym(*p), n );
				}

			}

		if( flag ){
			printf( "else yyexcp = %d\nreturn\n}\n", def[i] );
			def[i] = -2;
			if( pa[i] == -1000 ) pa[i] = -2000;
			}

		}

	printf( "return\nend\n" );

	printf( "integer function yypars( yyargu )\n" );
	printf( "define YYLAST %d\n", (maxa-a)+1 );
	printf( "common /yycomn/ yylval, yyval, yypv, yyvalv(150)\n" );
	printf( "common /yylcom/ yychar, yyerrf, yydebu\n" );
	printf( "integer yyval, yypv, yylval, yychar, yydebu, yynerr, yystat, yyargu\n" );
	printf( "integer yylex, yyexcp, yys(150), yyerrf, yyvalv, yyn, yyj\n" );

	pcom( "yyact", (maxa-a)+1 );
	pcom( "yypact", nstate );
	pcom( "yypgo", nnonter+1 );
	pcom( "yyr1", nprod+1 );
	pcom( "yyr2", nprod+1 );
	pcom( "yychk", nstate );
	pcom( "yydef", nstate );

	farout( "yyact", a, (maxa-a)+1 );
	farout( "yypact", pa, nstate );
	farout( "yypgo", pgo, nnonter+1 );
	farout( "yyr1", yyr1, nprod+1 );
	farout( "yyr2", yyr2, nprod+1 );
	farout( "yychk", chk, nstate );
	farout( "yydef", def, nstate );

	/* copy body of parser */

	switch( machine ){

	case UNIX:
		cin = copen( "/usr/yacc/rpar.r", 'r'  );
		break;
	case GCOS:
		cin = copen( "./yaccrpar", 'r' );
		break;
	case IBM:
		cin = copen( "MH2019.yaccrpar", 'r' );
		break;
		}

	if( cin < 0 ){
		error( "cannot open ratfor parser file" );
		cexit(1);
		}

	while( i=getchar() ) putchar(i);

	}

pcom( s, n ) char *s; {

	printf( "      integer %s(%d)\n", s, n );

	}

farout( s, v, n ) char *s; int *v, n; {

	/* output the array v, size n, as array s, in fortran */

	register i;


	for( i=1; i<=n; ++i ){

		printf( "      data %s(%d)/%d/;\n" , s, i, v[i-1] );

		}

	}

zaptemp(){ /* machine dependent; cream yacc.tmp */
	switch( machine ){

	case UNIX:
		unlink( "yacc.tmp" );
		return;

	case GCOS:
		system( "remo yacc.tmp" );
		return;

	case IBM:
		/* we just leave the temp file alone, to avoid screwups */
		return;
		}

	}

whereami(){ /* sets the variable machine to UNIX, GCOS, or IBM */

  int i;

  i = 1;
  i = i << 30;
  if( i == 0 ) {
    machine = UNIX;
    return;
    }
  i = i << 4;
  if( i == 0 ){
    machine = IBM;
    return;
    }
  machine = GCOS;
  }
