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


cleanst()
{
register ptr p, q;
ptr pjunk;
int i;
register struct stentry *s;
struct stentry **hp;

TEST fprintf(diagfile, "\n");

clcomm();

for(hp = hashtab ; hp<hashend ; ++hp)
    while( s = *hp )
	{
	if( q = ((struct stentry *)s)->varp )
		{
		if( ((struct headbits *)q)->blklevel > 0 )
			{
			TEST fprintf(diagfile, "remove %s from st\n", ((struct stentry *)s)->namep);
			switch(((struct headbits *)q)->tag)
				{
				case TNAME:
					frvar(q);
					break;

				case TSTRUCT:
					frtype(q);
					break;

				case TDEFINE:
					frdef(q);
					break;

				case TLABEL:
					cfree(q);
					break;

				default:
					sprintf(msg, "cleanst: illegal entry tag %d, ptr %o, name %s.",
						((struct headbits *)q)->tag, q, ((struct stentry *)s)->namep);
					fatal(msg);
				}
			}
		else if( ((struct headbits *)q)->tag == TNAME )
			{
			((struct varblock *)q)->vdcldone = 0;
			((struct varblock *)q)->vnamedone = 0;
			((struct varblock *)q)->vextbase = 0;
			for(i = 0 ; i<NFTNTYPES ; ++i)
				((struct varblock *)q)->vbase[i] = 0;
			}
		}
	if(((struct headbits *)s)->blklevel > 0)
		name(((struct stentry *)s)->namep,-1);
	else	break;
	}

for(p = (ptr)gonelist ; p ; p = ((struct chain *)p)->nextp)
	frvar(((struct chain *)p)->datap);
frchain(&gonelist);

if(hidlist) fatal("cleanst: hidlist not empty");
for(p = (ptr)hidlist ; p ; p = ((struct chain *)p)->nextp)
	frvar(((struct chain *)p)->datap);
frchain(&hidlist);

for(p = (ptr)tempvarlist ; p ; p = ((struct chain *)p)->nextp)
	frvar(((struct chain *)p)->datap);
frchain(&tempvarlist);

for(p = (ptr)temptypelist ; p ; p = ((struct chain *)p)->nextp)
	if(((struct headbits *)((struct chain *)p)->datap)->blklevel > 0)
		frtype(((struct chain *)p)->datap);
frchain(&temptypelist);

q = (ptr)&arrays;
for(p = arrays ; p ; p = ((struct chain *)q)->nextp)
	if(((struct chain *)p)->datap == 0)
		{
		((struct chain *)q)->nextp = ((struct chain *)p)->nextp;
		((struct chain *)p)->nextp = 0;
		pjunk = p;
		frchain(&pjunk);
		}
	else	q = p;
}



frvar(p)
register ptr p;
{
register ptr q, qn;

if(p==0) return;

switch(((struct headbits *)p)->tag)
	{
	case TSTRUCT:
		frtype(p);
		return;

	case TDEFINE:
		frdef(p);
		return;

	case TNAME:
	case TTEMP:
		if(q = ((struct varblock *)p)->vdim)
		    for(q = ((struct chain *)q)->datap ; q ; q = qn)
			{
			if(((struct dimblock *)q)->lowerb) frexpr(((struct dimblock *)q)->lowerb);
			frexpr(((struct dimblock *)q)->upperb);
			qn = ((struct dimblock *)q)->nextp;
			cfree(q);
			}
		
		if(((struct varblock *)p)->vdim)
			((struct chain *)((struct varblock *)p)->vdim)->datap = 0;
		if(((struct varblock *)p)->vtype == TYCHAR)
			frexpr(((struct varblock *)p)->vtypep);
		frexpblock(p);
		return;

	default:
		badtag("frvar",((struct headbits *)p)->tag);
	}
}


frtype(p)
register ptr p;
{
register ptr q;

if(p==0 || ((struct headbits *)p)->tag!=TSTRUCT)
	fatal("frtype: bad argument");
for(q = ((struct typeblock *)p)->strdesc ; q; q = ((struct chain *)q)->nextp)
	frvar(((struct chain *)q)->datap);
frchain( &(((struct typeblock *)p)->strdesc) );
cfree(p);
}



frdef(p)
ptr p;
{
cfree(((struct defblock *)p)->valp);
cfree(p);
}



frexpr(p)
register ptr p;
{
register ptr q;

if(p == 0) return;

switch(((struct headbits *)p)->tag)
	{
	case TAROP:
	case TRELOP:
	case TLOGOP:
	case TASGNOP:
	case TREPOP:
	case TCALL:
		frexpr(((struct exprblock *)p)->rightp);


	case TNOTOP:
	case TNEGOP:
		frexpr(((struct exprblock *)p)->leftp);
		break;

	case TCONST:
		cfree(((struct exprblock *)p)->leftp);
		if(((struct varblock *)p)->vtype == TYCHAR)
			frexpr(((struct varblock *)p)->vtypep);
		if(((struct exprblock *)p)->rightp)
			cfree(((struct exprblock *)p)->rightp);
		break;

	case TLIST:
		for(q = ((struct exprblock *)p)->leftp ; q ; q = ((struct chain *)q)->nextp)
			frexpr(((struct chain *)q)->datap);
		frchain( &(((struct exprblock *)p)->leftp) );
		break;

	case TTEMP:
	case TNAME:
	case TFTNBLOCK:
		if(((struct varblock *)p)->vsubs)
			frexpr(((struct varblock *)p)->vsubs);
		if(((struct varblock *)p)->voffset)
			frexpr(((struct varblock *)p)->voffset);

	case TERROR:
/*debug*/ case TIOSTAT:
		break;

	default:
		badtag("frexpr", ((struct headbits *)p)->tag);
	}
frexpblock(p);
}




clcomm()	/* clean up common lists */
{
ptr p, oldp, q;

for(oldp = (ptr)&commonlist ; p = ((struct chain *)oldp)->nextp ;  )
	{
	q = ((struct chain *)p)->datap;

	if(((struct headbits *)q)->blklevel > 0)
		{
		frchain( &(((struct comentry *)q)->comchain) );
		cfree(q);
		((struct chain *)oldp)->nextp = ((struct chain *)p)->nextp;
		cfree(p);
		}
	else   oldp = p;
	}
}
