putpcc.c

来自「<B>Digital的Unix操作系统VAX 4.2源码</B>」· C语言 代码 · 共 1,859 行 · 第 1/3 页

#ifndef lint
static char	*sccsid = " @(#)putpcc.c	1.4	(ULTRIX)	1/15/86";
#endif lint

/************************************************************************
 *									*
 *			Copyright (c) 1986 by				*
 *		Digital Equipment Corporation, Maynard, MA		*
 *			All rights reserved.				*
 *									*
 *   This software is furnished under a license and may be used and	*
 *   copied  only  in accordance with the terms of such license and	*
 *   with the  inclusion  of  the  above  copyright  notice.   This	*
 *   software  or  any  other copies thereof may not be provided or	*
 *   otherwise made available to any other person.  No title to and	*
 *   ownership of the software is hereby transferred.			*
 *									*
 *   This software is  derived  from  software  received  from  the	*
 *   University    of   California,   Berkeley,   and   from   Bell	*
 *   Laboratories.  Use, duplication, or disclosure is  subject  to	*
 *   restrictions  under  license  agreements  with  University  of	*
 *   California and with AT&T.						*
 *									*
 *   The information in this software is subject to change  without	*
 *   notice  and should not be construed as a commitment by Digital	*
 *   Equipment Corporation.						*
 *									*
 *   Digital assumes no responsibility for the use  or  reliability	*
 *   of its software on equipment which is not supplied by Digital.	*
 *									*
 ************************************************************************/

/************************************************************************
*
*			Modification History
*
*	David Metsky		14-Jan-86
*
* 001	Replaced old version with BSD 4.3 version as part of upgrade.
*
*	Based on:	putpcc.c	5.1		6/7/85
*
*************************************************************************/

/*
 * putpcc.c
 *
 * Intermediate code generation for S. C. Johnson C compilers
 * New version using binary polish postfix intermediate
 *
 * University of Utah CS Dept modification history:
 *
 * $Header: putpcc.c,v 3.2 85/03/25 09:35:57 root Exp $
 * $Log:	putpcc.c,v $
 * Revision 3.2  85/03/25  09:35:57  root
 * fseek return -1 on error.
 * 
 * Revision 3.1  85/02/27  19:06:55  donn
 * Changed to use pcc.h instead of pccdefs.h.
 * 
 * Revision 2.12  85/02/22  01:05:54  donn
 * putaddr() didn't know about intrinsic functions...
 * 
 * Revision 2.11  84/11/28  21:28:49  donn
 * Hacked putop() to handle any character expression being converted to int,
 * not just function calls.  Previously it bombed on concatenations.
 * 
 * Revision 2.10  84/11/01  22:07:07  donn
 * Yet another try at getting putop() to work right.  It appears that the
 * second pass can't abide certain explicit conversions (e.g. short to long)
 * so the conversion code in putop() tries to remove them.  I think this
 * version (finally) works.
 * 
 * Revision 2.9  84/10/29  02:30:57  donn
 * Earlier fix to putop() for conversions was insufficient -- we NEVER want to
 * see the type of the left operand of the thing left over from stripping off
 * conversions...
 * 
 * Revision 2.8  84/09/18  03:09:21  donn
 * Fixed bug in putop() where the left operand of an addrblock was being
 * extracted...  This caused an extremely obscure conversion error when
 * an array of longs was subscripted by a short.
 * 
 * Revision 2.7  84/08/19  20:10:19  donn
 * Removed stuff in putbranch that treats STGARG parameters specially -- the
 * bug in the code generation pass that motivated it has been fixed.
 * 
 * Revision 2.6  84/08/07  21:32:23  donn
 * Bumped the size of the buffer for the intermediate code file from 0.5K
 * to 4K on a VAX.
 * 
 * Revision 2.5  84/08/04  20:26:43  donn
 * Fixed a goof in the new putbranch() -- it now calls mkaltemp instead of
 * mktemp().  Correction due to Jerry Berkman.
 * 
 * Revision 2.4  84/07/24  19:07:15  donn
 * Fixed bug reported by Craig Leres in which putmnmx() mistakenly assumed
 * that mkaltemp() returns tempblocks, and tried to free them with frtemp().
 * 
 * Revision 2.3  84/07/19  17:22:09  donn
 * Changed putch1() so that OPPAREN expressions of type CHARACTER are legal.
 * 
 * Revision 2.2  84/07/19  12:30:38  donn
 * Fixed a type clash in Bob Corbett's new putbranch().
 * 
 * Revision 2.1  84/07/19  12:04:27  donn
 * Changed comment headers for UofU.
 * 
 * Revision 1.8  84/07/19  11:38:23  donn
 * Replaced putbranch() routine so that you can ASSIGN into argument variables.
 * The code is from Bob Corbett, donated by Jerry Berkman.
 * 
 * Revision 1.7  84/05/31  00:48:32  donn
 * Fixed an extremely obscure bug dealing with the comparison of CHARACTER*1
 * expressions -- a foulup in the order of COMOP and the comparison caused
 * one operand of the comparison to be garbage.
 * 
 * Revision 1.6  84/04/16  09:54:19  donn
 * Backed out earlier fix for bug where items in the argtemplist were
 * (incorrectly) being given away; this is now fixed in mkargtemp().
 * 
 * Revision 1.5  84/03/23  22:49:48  donn
 * Took out the initialization of the subroutine argument temporary list in
 * putcall() -- it needs to be done once per statement instead of once per call.
 * 
 * Revision 1.4  84/03/01  06:48:05  donn
 * Fixed bug in Bob Corbett's code for argument temporaries that caused an
 * addrblock to get thrown out inadvertently when it was needed for recycling
 * purposes later on.
 * 
 * Revision 1.3  84/02/26  06:32:38  donn
 * Added Berkeley changes to move data definitions around and reduce offsets.
 * 
 * Revision 1.2  84/02/26  06:27:45  donn
 * Added code to catch TTEMP values passed to putx().
 * 
 */

#if FAMILY != PCC
	WRONG put FILE !!!!
#endif

#include "defs.h"
#include <pcc.h>

Addrp putcall(), putcxeq(), putcx1(), realpart();
expptr imagpart();
ftnint lencat();

#define FOUR 4
extern int ops2[];
extern int types2[];

#if HERE==VAX
#define PCC_BUFFMAX 1024
#else
#define PCC_BUFFMAX 128
#endif
static long int p2buff[PCC_BUFFMAX];
static long int *p2bufp		= &p2buff[0];
static long int *p2bufend	= &p2buff[PCC_BUFFMAX];


puthead(s, class)
char *s;
int class;
{
char buff[100];
#if TARGET == VAX
	if(s)
		p2ps("\t.globl\t_%s", s);
#endif
/* put out fake copy of left bracket line, to be redone later */
if( ! headerdone )
	{
#if FAMILY == PCC
	p2flush();
#endif
	headoffset = ftell(textfile);
	prhead(textfile);
	headerdone = YES;
	p2triple(PCCF_FEXPR, (strlen(infname)+FOUR-1)/FOUR, 0);
	p2str(infname);
#if TARGET == PDP11
	/* fake jump to start the optimizer */
	if(class != CLBLOCK)
		putgoto( fudgelabel = newlabel() );
#endif

#if TARGET == VAX
	/* jump from top to bottom */
	if(s!=CNULL && class!=CLBLOCK)
		{
		int proflab = newlabel();
		p2ps("_%s:", s);
		p2pi("\t.word\tLWM%d", procno);
		prsave(proflab);
		p2pi("\tjbr\tL%d", fudgelabel = newlabel());
		}
#endif
	}
}





/* It is necessary to precede each procedure with a "left bracket"
 * line that tells pass 2 how many register variables and how
 * much automatic space is required for the function.  This compiler
 * does not know how much automatic space is needed until the
 * entire procedure has been processed.  Therefore, "puthead"
 * is called at the begining to record the current location in textfile,
 * then to put out a placeholder left bracket line.  This procedure
 * repositions the file and rewrites that line, then puts the
 * file pointer back to the end of the file.
 */

putbracket()
{
long int hereoffset;

#if FAMILY == PCC
	p2flush();
#endif
hereoffset = ftell(textfile);
if(fseek(textfile, headoffset, 0) == -1)
	fatal("fseek failed");
prhead(textfile);
if(fseek(textfile, hereoffset, 0) == -1)
	fatal("fseek failed 2");
}




putrbrack(k)
int k;
{
p2op(PCCF_FRBRAC, k);
}



putnreg()
{
}






puteof()
{
p2op(PCCF_FEOF, 0);
p2flush();
}



putstmt()
{
p2triple(PCCF_FEXPR, 0, lineno);
}




/* put out code for if( ! p) goto l  */
putif(p,l)
register expptr p;
int l;
{
register int k;

if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL)
	{
	if(k != TYERROR)
		err("non-logical expression in IF statement");
	frexpr(p);
	}
else
	{
	putex1(p);
	p2icon( (long int) l , PCCT_INT);
	p2op(PCC_CBRANCH, 0);
	putstmt();
	}
}





/* put out code for  goto l   */
putgoto(label)
int label;
{
p2triple(PCC_GOTO, 1, label);
putstmt();
}


/* branch to address constant or integer variable */
putbranch(p)
register Addrp p;
{
  putex1((expptr) p);
  p2op(PCC_GOTO, PCCT_INT);
  putstmt();
}



/* put out label  l:     */
putlabel(label)
int label;
{
p2op(PCCF_FLABEL, label);
}




putexpr(p)
expptr p;
{
putex1(p);
putstmt();
}




putcmgo(index, nlab, labs)
expptr index;
int nlab;
struct Labelblock *labs[];
{
int i, labarray, skiplabel;

if(! ISINT(index->headblock.vtype) )
	{
	execerr("computed goto index must be integer", CNULL);
	return;
	}

#if TARGET == VAX
	/* use special case instruction */
	vaxgoto(index, nlab, labs);
#else
	labarray = newlabel();
	preven(ALIADDR);
	prlabel(asmfile, labarray);
	prcona(asmfile, (ftnint) (skiplabel = newlabel()) );
	for(i = 0 ; i < nlab ; ++i)
		if( labs[i] )
			prcona(asmfile, (ftnint)(labs[i]->labelno) );
	prcmgoto(index, nlab, skiplabel, labarray);
	putlabel(skiplabel);
#endif
}

putx(p)
expptr p;
{
char *memname();
int opc;
int ncomma;
int type, k;

if (!p)
	return;

switch(p->tag)
	{
	case TERROR:
		free( (charptr) p );
		break;

	case TCONST:
		switch(type = p->constblock.vtype)
			{
			case TYLOGICAL:
				type = tyint;
			case TYLONG:
			case TYSHORT:
				p2icon(p->constblock.const.ci, types2[type]);
				free( (charptr) p );
				break;

			case TYADDR:
				p2triple(PCC_ICON, 1, PCCT_INT|PCCTM_PTR);
				p2word(0L);
				p2name(memname(STGCONST,
					(int) p->constblock.const.ci) );
				free( (charptr) p );
				break;

			default:
				putx( putconst(p) );
				break;
			}
		break;

	case TEXPR:
		switch(opc = p->exprblock.opcode)
			{
			case OPCALL:
			case OPCCALL:
				if( ISCOMPLEX(p->exprblock.vtype) )
					putcxop(p);
				else	putcall(p);
				break;

			case OPMIN:
			case OPMAX:
				putmnmx(p);
				break;


			case OPASSIGN:
				if(ISCOMPLEX(p->exprblock.leftp->headblock.vtype)
				|| ISCOMPLEX(p->exprblock.rightp->headblock.vtype) )
					frexpr( putcxeq(p) );
				else if( ISCHAR(p) )
					putcheq(p);
				else
					goto putopp;
				break;

			case OPEQ:
			case OPNE:
				if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) ||
				    ISCOMPLEX(p->exprblock.rightp->headblock.vtype) )
					{
					putcxcmp(p);
					break;
					}
			case OPLT:
			case OPLE:
			case OPGT:
			case OPGE:
				if(ISCHAR(p->exprblock.leftp))
					{
					putchcmp(p);
					break;
					}
				goto putopp;

			case OPPOWER:
				putpower(p);
				break;

			case OPSTAR:
#if FAMILY == PCC
				/*   m * (2**k) -> m<<k   */
				if(INT(p->exprblock.leftp->headblock.vtype) &&
				   ISICON(p->exprblock.rightp) &&
				   ( (k = log2(p->exprblock.rightp->constblock.const.ci))>0) )
					{
					p->exprblock.opcode = OPLSHIFT;
					frexpr(p->exprblock.rightp);
					p->exprblock.rightp = ICON(k);
					goto putopp;
					}
#endif

			case OPMOD:
				goto putopp;
			case OPPLUS:
			case OPMINUS:
			case OPSLASH:
			case OPNEG:
				if( ISCOMPLEX(p->exprblock.vtype) )
					putcxop(p);
				else	goto putopp;
				break;

			case OPCONV:
				if( ISCOMPLEX(p->exprblock.vtype) )
					putcxop(p);
				else if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) )
					{
					ncomma = 0;
					putx( mkconv(p->exprblock.vtype,
						realpart(putcx1(p->exprblock.leftp,
							&ncomma))));
					putcomma(ncomma, p->exprblock.vtype, NO);
					free( (charptr) p );
					}
				else	goto putopp;
				break;

			case OPNOT:
			case OPOR:
			case OPAND:
			case OPEQV:
			case OPNEQV:
			case OPADDR:
			case OPPLUSEQ:
			case OPSTAREQ:
			case OPCOMMA:
			case OPQUEST:
			case OPCOLON:
			case OPBITOR:
			case OPBITAND:
			case OPBITXOR:
			case OPBITNOT:
			case OPLSHIFT:
			case OPRSHIFT:
		putopp:
				putop(p);
				break;

			case OPPAREN:
				putx (p->exprblock.leftp);
				break;
			default:
				badop("putx", opc);
			}
		break;

	case TADDR:
		putaddr(p, YES);
		break;

	case TTEMP:
		/*
		 * This type is sometimes passed to putx when errors occur
		 *	upstream, I don't know why.
		 */
		frexpr(p);
		break;

	default:
		badtag("putx", p->tag);
	}
}



LOCAL putop(p)
expptr p;
{
int k;
expptr lp, tp;
int pt, lt, tt;
int comma;
Addrp putch1();

switch(p->exprblock.opcode)	/* check for special cases and rewrite */
	{
	case OPCONV:
		tt = pt = p->exprblock.vtype;
		lp = p->exprblock.leftp;
		lt = lp->headblock.vtype;
		if (pt == TYREAL && lt == TYDREAL)
			{
			putx(lp);
			p2op(PCC_SCONV, PCCT_FLOAT);
			return;
			}
		while(p->tag==TEXPR && p->exprblock.opcode==OPCONV &&
		      ( (ISREAL(pt)&&ISREAL(lt)) ||
			(INT(pt)&&(ONEOF(lt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) ))
			{
#if SZINT < SZLONG
			if(lp->tag != TEXPR)
				{
				if(pt==TYINT && lt==TYLONG)
					break;
				if(lt==TYINT && pt==TYLONG)
					break;
				}
#endif

#if TARGET == VAX
			if(pt==TYDREAL && lt==TYREAL)
				{
				if(lp->tag==TEXPR &&
				   lp->exprblock.opcode==OPCONV &&
				   lp->exprblock.leftp->headblock.vtype==TYDREAL)
					{
					putx(lp->exprblock.leftp);
					p2op(PCC_SCONV, PCCT_FLOAT);
					p2op(PCC_SCONV, PCCT_DOUBLE);
					free( (charptr) p );
					return;
					}
				else break;
				}
#endif
			if(lt==TYCHAR && lp->tag==TEXPR)
				{
				int ncomma = 0;
				p->exprblock.leftp = (expptr) putch1(lp, &ncomma);
				putop(p);
				putcomma(ncomma, pt, NO);
				free( (charptr) p );
				return;
				}
			free( (charptr) p );
			p = lp;
			pt = lt;
			if (p->tag == TEXPR)
				{
				lp = p->exprblock.leftp;
				lt = lp->headblock.vtype;
				}
			}
		if(p->tag==TEXPR && p->exprblock.opcode==OPCONV)
			break;
		putx(p);
		if (types2[tt] != types2[pt] &&
		    ! ( (ISREAL(tt)&&ISREAL(pt)) ||
			(INT(tt)&&(ONEOF(pt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) ))
			p2op(PCC_SCONV,types2[tt]);
		return;