static char rcsid[] = "$Header:print.c 12.0$";
#include "defs"

char *ops[ ] = 	{ "", "+", "-", "*", "/", "**",
	".not. ", " .and. ", ".andand.", ".oror.", " .or. ",
	" .eq. ", " .lt. ", " .gt. ", " .le. ", " .ge. ", " .ne. ",
	"(", ")", " = ", ", " };

int opprecs[ ]	= { 0, 7, 7, 8, 8, 9, 5, 4, 4, 3, 3,
		6, 6, 6, 6, 6, 6, 10, 10, 1, 0 };

char *qualops[ ]	= { "", "->", ".", " of ", " sub " };


char *classes[ ]	= { "", "arg ", "valarg ", "static ", "auto ",
			"common ", "mos ", "external ", "statement function " };

char *precs[ ]	= { "", "long " };

char *types[ ]	= { "", "integer ", "real ", "double precision ", "logical ",
			"complex ", "char ", "type " };

char *ftntypes[]	= { "integer ", "real ", "logical ", "complex ",
			"double precision ", 0, 0 };


char *langs[]	= { "pfort", "ratfor", "efl"};


propts()
{
fprintf(diagfile, "Options: ");
fprintf(diagfile, "%s ", langs[langopt]);
fprintf(diagfile, "%s ", (dbgopt ? "debug" : "ndebug") );
fprintf(diagfile, "%s ", (dotsopt? "dotson" : "dotsoff") );
fprintf(diagfile, "\n");
}




prexpr(e)
ptr e;
{
if(e)  prexp1(e, 0,0,0);
}





prexp1(e, prec, subt, leftside)
register ptr e;
int prec, subt, leftside;
{
ptr p, q;
int prec1, needpar;

needpar = 0;

switch(((struct headbits *)e)->tag)
	{
case TERROR:
	break;

case TCONST:
	TEST fprintf(diagfile, "%s", ((struct exprblock *)e)->leftp);
	if(((struct exprblock *)e)->rightp)
		putzcon(e);
	else
		putconst(((struct varblock *)e)->vtype, ((struct exprblock *)e)->leftp);
	break;

case TFTNBLOCK:
	putname(e);
	break;

case TNAME:
	if(((struct varblock *)e)->sthead == 0) fatal("name without entry");
	TEST fprintf(diagfile, "%s", ((struct stentry *)((struct varblock *)e)->sthead)->namep);
	putname(e);
	if(((struct varblock *)e)->vsubs)
		prexp1(((struct varblock *)e)->vsubs, 0,0,0);
	break;

case TTEMP:
	TEST fprintf(diagfile, "(fakename %o)", e);
	putname(e);
	break;

case TLIST:
	if(((struct exprblock *)e)->leftp == 0) break;
	TEST fprintf(diagfile, "( ");
	putic(ICOP, OPLPAR);
	for(p=((struct exprblock *)e)->leftp ; p!=0 ; p = ((struct dimblock *)p)->nextp)
		{
		prexp1(((struct chain *)p)->datap, 0,0,0);
		if(((struct dimblock *)p)->nextp)
			{
			TEST fprintf(diagfile, " , ");
			putic(ICOP, OPCOMMA);
			}
		}
	TEST fprintf(diagfile, " )");
	putic(ICOP, OPRPAR);
	break;

case TSTFUNCT:
	fprintf(diagfile, "statement function ");
	prexp1(((struct exprblock *)e)->leftp, 0,0,0);
	TEST fprintf(diagfile, " = ");
	putic(ICOP, OPEQUALS);
	prexp1(((struct exprblock *)e)->rightp, 0,0,0);
	break;

case TAROP:
	if(((struct headbits *)e)->subtype==OPSTAR && ((struct headbits *)((struct exprblock *)e)->leftp)->tag!=TCONST && ((struct headbits *)((struct exprblock *)e)->rightp)->tag==TCONST)
		{
		q = ((struct exprblock *)e)->leftp;
		((struct exprblock *)e)->leftp = ((struct exprblock *)e)->rightp;
		((struct exprblock *)e)->rightp = q;
		}
case TLOGOP:
	prec1 = opprecs[((struct headbits *)e)->subtype];
	goto print;
case TNOTOP:
	prec1 = 5;
	if(prec > 1)	/* force parens */
		needpar = 1;
	goto print;
case TNEGOP:
	if(prec > 1)	/* force parens */
		needpar = 1;
	prec1 = 8;
	goto print;
case TASGNOP:
	prec1 = 1;
	goto print;
case TRELOP:
	prec1 = 6;
	goto print;
case TCALL:
	prec1 = 10;
	goto print;
case TREPOP:
	prec1 = 2;
	goto print;

print:
	if(prec1 < prec )
		needpar = 1;
	else if(prec1 == prec)
		if(((struct varblock *)e)->needpar)
			needpar = 1;
		else if(subt == ((struct headbits *)e)->subtype)
			needpar |= ! (((struct headbits *)e)->tag==TLOGOP || leftside || subt==0
					|| subt==OPPLUS || subt==OPSTAR);
		else	needpar |=  ! (leftside || subt==OPPLUS || subt==OPSTAR);

	if(needpar)
		{
		putic(ICOP,OPLPAR);
		TEST fprintf(diagfile, "(");
		}

	if(((struct exprblock *)e)->rightp != 0)
		{
		prexp1(((struct exprblock *)e)->leftp, prec1, ((struct headbits *)e)->subtype, 1);
		switch(((struct headbits *)e)->tag) {
		case TASGNOP:
			TEST fprintf(diagfile, "=");
			putic(ICOP, OPEQUALS);
			if(((struct headbits *)e)->subtype != 0)
				prexp1(((struct exprblock *)e)->leftp, prec1, 0, 1);
	
		case TAROP:
		case TNEGOP:
		case TLOGOP:
		case TNOTOP:
		case TRELOP:
			if(((struct headbits *)e)->subtype)
				{
				TEST fprintf(diagfile, " %s ", ops[((struct headbits *)e)->subtype]);
				putic(ICOP, ((struct headbits *)e)->subtype);
				}
			break;
	
		case TCALL:
			TEST fprintf(diagfile, " %s ", qualops[((struct headbits *)e)->subtype]);
			break;
	
		case TREPOP:
			TEST fprintf(diagfile, "$");
			break;
			}

		prexp1(((struct exprblock *)e)->rightp, prec1,((struct headbits *)e)->subtype, 0);
		}
	else	{ /* ((struct exprblock *)e)->rightp == 0 */
		TEST fprintf(diagfile, " %s  ", ops[((struct headbits *)e)->subtype]);
		putic(ICOP, ((struct headbits *)e)->subtype);
		prexp1(((struct exprblock *)e)->leftp, prec1,((struct headbits *)e)->subtype, 0);
		}
	if(needpar)
		{
		putic(ICOP, OPRPAR);
		TEST fprintf(diagfile, ")");
		}
	break;

default:
	badtag("prexp1", ((struct headbits *)e)->tag);
	break;
	}
}
