[unix-history] / usr / src / old / pcc / ccom.tahoe / local.c

#ifndef lint
static char sccsid[] = "@(#)local.c	1.3 (Berkeley) %G%";
#endif

# include "pass1.h"

/*	this file contains code which is dependent on the target machine */

NODE *
clocal(p) register NODE *p; {

	/* this is called to do local transformations on
	   an expression tree preparitory to its being
	   written out in intermediate code.
	*/

	/* the major essential job is rewriting the
	   automatic variables and arguments in terms of
	   REG and OREG nodes */
	/* conversion ops which are not necessary are also clobbered here */
	/* in addition, any special features (such as rewriting
	   exclusive or) are easily handled here as well */

	register struct symtab *q;
	register NODE *r;
	register int o;
	register int m, ml;

	switch( o = p->in.op ){

	case NAME:
		if( p->tn.rval < 0 ) { /* already processed; ignore... */
			return(p);
			}
		q = &stab[p->tn.rval];
		switch( q->sclass ){

		case AUTO:
		case PARAM:
			/* fake up a structure reference */
			r = block( REG, NIL, NIL, PTR+STRTY, 0, 0 );
			r->tn.lval = 0;
			r->tn.rval = STKREG;
			p = stref( block( STREF, r, p, 0, 0, 0 ) );
			break;

		case ULABEL:
		case LABEL:
		case STATIC:
			if( q->slevel == 0 ) break;
			p->tn.lval = 0;
			p->tn.rval = -q->offset;
			break;

		case REGISTER:
			p->in.op = REG;
			p->tn.lval = 0;
			p->tn.rval = q->offset;
#ifdef REG_CHAR
			m = p->in.type;
			if( m==CHAR || m==SHORT )
				p->in.type = INT;
			else if( m==UCHAR || m==USHORT )
				p->in.type = UNSIGNED;
#endif
			break;

			}
		break;

	case LT:
	case LE:
	case GT:
	case GE:
		if( ISPTR( p->in.left->in.type ) || ISPTR( p->in.right->in.type ) ){
			p->in.op += (ULT-LT);
			}
		break;

	case PCONV:
		/* do pointer conversions for char and longs */
		ml = p->in.left->in.type;
		if( ( ml==CHAR || ml==UCHAR || ml==SHORT || ml==USHORT ) && p->in.left->in.op != ICON ) break;

		/* pointers all have the same representation; the type is inherited */

	inherit:
		p->in.left->in.type = p->in.type;
		p->in.left->fn.cdim = p->fn.cdim;
		p->in.left->fn.csiz = p->fn.csiz;
		p->in.op = FREE;
		return( p->in.left );

	case SCONV:
		m = p->in.type;
		ml = p->in.left->in.type;
		if(m == FLOAT || m == DOUBLE) {
			if(p->in.left->in.op==SCONV &&
			 (ml == FLOAT || ml == DOUBLE) &&
			 p->in.left->in.left->in.type==m) {
				p->in.op = p->in.left->in.op = FREE;
				return(p->in.left->in.left);
			}
			if(p->in.left->in.op==FCON)
				goto inherit;
			break;
		}
		if(ml == FLOAT || ml == DOUBLE){
			if (p->in.left->in.op == FCON){
				p->in.left->in.op = FREE;
				p->in.op = ICON;
				p->tn.lval = p->in.left->fpn.fval;
				p->tn.rval = NONAME;
				return(p);
			}
			break;
		}
		/* now, look for conversions downwards */

		if( p->in.left->in.op == ICON ){ /* simulate the conversion here */
			CONSZ val;
			val = p->in.left->tn.lval;
			switch( m ){
			case CHAR:
				p->in.left->tn.lval = (char) val;
				break;
			case UCHAR:
				p->in.left->tn.lval = val & 0XFF;
				break;
			case USHORT:
				p->in.left->tn.lval = val & 0XFFFFL;
				break;
			case SHORT:
				p->in.left->tn.lval = (short)val;
				break;
			case UNSIGNED:
				p->in.left->tn.lval = val & 0xFFFFFFFFL;
				break;
			case INT:
				p->in.left->tn.lval = (int)val;
				break;
				}
			p->in.left->in.type = m;
			}
		else {
			/* meaningful ones are conversion of int to char, int to short,
			   and short to char, and unsigned versions thereof */
			if( m==CHAR || m==UCHAR ){
				if( ml!=CHAR && ml!= UCHAR ) break;
				}
			else if( m==SHORT || m==USHORT ){
				if( ml!=CHAR && ml!=UCHAR && ml!=SHORT && ml!=USHORT ) break;
				}
			}

		/* clobber conversion */
		if( tlen(p) == tlen(p->in.left) ) goto inherit;
		p->in.op = FREE;
		return( p->in.left );  /* conversion gets clobbered */

	case QUEST:	/* the right side should be COLON */
		if((r = p->in.right)->in.op == SCONV) {
			p->in.right = r->in.left;
			p->in.type = r->in.left->in.type;
			r->in.left = p;
			return(r);
		}
		return(p);

	case PVCONV:
	case PMCONV:
		if( p->in.right->in.op != ICON ) cerror( "bad conversion", 0);
		p->in.op = FREE;
		return( buildtree( o==PMCONV?MUL:DIV, p->in.left, p->in.right ) );

	case FLD:
		/* make sure that the second pass does not make the
		   descendant of a FLD operator into a doubly indexed OREG */

		if( p->in.left->in.op == UNARY MUL
				&& (r=p->in.left->in.left)->in.op == PCONV)
			if( r->in.left->in.op == PLUS || r->in.left->in.op == MINUS ) 
				if( ISPTR(r->in.type) ) {
					if( ISUNSIGNED(p->in.left->in.type) )
						p->in.left->in.type = UNSIGNED;
					else
						p->in.left->in.type = INT;
				}
		break;
	case FORTCALL: /* arg must be FLOAT */
		if((r = p->in.right)->in.type != FLOAT)
			p->in.right = clocal(makety(r, FLOAT, 0, FLOAT));
		return(p);
	}

	/* if both sides are FLOAT, so is the op */
	if(optype(o)!=LTYPE && p->in.left->in.type==DOUBLE &&
	 (o==UNARY MINUS || optype(o)==BITYPE && p->in.right->in.type==DOUBLE)) {
		r = p->in.left;
		if(r->in.op==SCONV && r->in.left->in.type==FLOAT) {
			if(optype(o)==BITYPE) {
				r = p->in.right;
				if(r->in.op==SCONV && r->in.left->in.type==FLOAT) {
					r->in.op = FREE;
					p->in.right = r->in.left;
				} else if(r->in.op==FCON)
					r->in.type = FLOAT;
				else
					return(p);
			}
			r = p->in.left;
			p->in.left = r->in.left;
		} else if(optype(o)==BITYPE && r->in.op==FCON) {
			r = p->in.right;
			if(!(r->in.op==SCONV && r->in.left->in.type==FLOAT))
				return(p);
			p->in.right = r->in.left;
			p->in.left->in.type = FLOAT;
		} else
			return(p);
		if(p->in.type==DOUBLE) {
			p->in.type = FLOAT;
			r->in.left = p;
			return(r);
		} else {	/* usually logop */
			r->in.op = FREE;
			return(p);
		}
	}
	return(p);
}

andable( p ) NODE *p; {
	return(1);  /* all names can have & taken on them */
	}

cendarg(){ /* at the end of the arguments of a ftn, set the automatic offset */
	autooff = AUTOINIT;
	}

cisreg( t ) TWORD t; { /* is an automatic variable of type t OK for a register variable */

	if( t==INT || t==UNSIGNED || t==LONG || t==ULONG	/* tbl */
#ifdef REG_CHAR
		|| t==CHAR || t==UCHAR || t==SHORT || t==USHORT		/* tbl */
#endif
		|| ISPTR(t)) return (1);			/* wnj */
	return(0);
	}

NODE *
offcon( off, t, d, s ) OFFSZ off; TWORD t; {

	/* return a node, for structure references, which is suitable for
	   being added to a pointer of type t, in order to be off bits offset
	   into a structure */

	register NODE *p;

	/* t, d, and s are the type, dimension offset, and sizeoffset */
	/* in general they  are necessary for offcon, but not on H'well */

	p = bcon(0);
	p->tn.lval = off/SZCHAR;
	return(p);

	}


static inwd	/* current bit offsed in word */;
static CONSZ word	/* word being built from fields */;

incode( p, sz ) register NODE *p; {

	/* generate initialization code for assigning a constant c
		to a field of width sz */
	/* we assume that the proper alignment has been obtained */
	/* inoff is updated to have the proper final value */
	/* we also assume sz  < SZINT */

	inwd += sz;
	if(inwd > SZINT) cerror("incode: field > int");
	word |= (p->tn.lval&((1L<<sz)-1)) << (SZINT-inwd);
	inoff += sz;
	if(inoff%SZINT == 0) {
		printf( "	.long	0x%X\n", word);
		word = inwd = 0;
		}
	}

fincode( d, sz ) double d; register int sz; {
	/*
	 * output code to initialize space of size sz to the value d
	 * the proper alignment has been obtained
	 * inoff is updated to have the proper final value.
	 */

	register struct sh4 {
		unsigned short sh[4];
	} *x;
	float f;

	if(sz == SZFLOAT) {	/* force rounding */
		f = d;
		d = f;
	}

	x = (struct sh4 *)&d;
	printf("	.long	0x%04x%04x", x->sh[0], x->sh[1]);
	if(sz == SZDOUBLE) {
		printf(", 0x%04x%04x", x->sh[2], x->sh[3]);
		printf(" # .double %.17g\n", d);
	} else
		printf(" # .float %.8g\n", d);
	inoff += sz;
	}

cinit( p, sz ) NODE *p; {
	NODE *l;

	/*
	 * as a favor (?) to people who want to write
	 *     int i = 9600/134.5;
	 * we will, under the proper circumstances, do
	 * a coersion here.
	 */
	switch (p->in.type) {
	case INT:
	case UNSIGNED:
		l = p->in.left;
		if (l->in.op != SCONV ||
		    (l->in.left->tn.op != DCON && l->in.left->tn.op != FCON))
			break;
		l->in.op = FREE;
		l = l->in.left;
		l->tn.lval = l->tn.op == DCON ? (long)(l->dpn.dval) :
			(long)(l->fpn.fval);
		l->tn.rval = NONAME;
		l->tn.op = ICON;
		l->tn.type = INT;
		p->in.left = l;
		break;
	}
	/* arrange for the initialization of p into a space of
	size sz */
	/* the proper alignment has been opbtained */
	/* inoff is updated to have the proper final value */
	ecode( p );
	inoff += sz;
	}

vfdzero( n ){ /* define n bits of zeros in a vfd */

	if( n <= 0 ) return;

	inwd += n;
	inoff += n;
	if( inoff%ALINT ==0 ) {
		printf( "	.long	0x%X\n", word );
		word = inwd = 0;
		}
	}

char *
exname( p ) char *p; {
	/* make a name look like an external name in the local machine */

#ifndef FLEXNAMES
	static char text[NCHNAM+1];
#else
	static char text[BUFSIZ+1];
#endif

	register int i;

	text[0] = '_';
#ifndef FLEXNAMES
	for( i=1; *p&&i<NCHNAM; ++i )
#else
	for( i=1; *p; ++i )
#endif
		text[i] = *p++;

	text[i] = '\0';
#ifndef FLEXNAMES
	text[NCHNAM] = '\0';  /* truncate */
#endif

	return( text );
	}

ctype( type )TWORD type;{ /* map types which are not defined on the local machine */
	switch( BTYPE(type) ){

	case LONG:
		MODTYPE(type,INT);
		break;

	case ULONG:
		MODTYPE(type,UNSIGNED);
		}
	return( type );
	}

noinit() { /* curid is a variable which is defined but
	is not initialized (and not a function );
	This routine returns the stroage class for an uninitialized declaration */

	return(EXTERN);

	}

commdec( id ){ /* make a common declaration for id, if reasonable */
	register struct symtab *q;
	OFFSZ off, tsize();

	q = &stab[id];
	printf( "	.comm	%s,", exname( q->sname ) );
	off = tsize( q->stype, q->dimoff, q->sizoff );
	printf( "%d\n" /*CONFMT*/, off/SZCHAR );
	}

prtdcon(p)
	register NODE *p;
{
	register int o = p->in.op;
	int i;

	if (o != DCON && o != FCON)
		return;
	/*
	 * Clobber constants of value zero so
	 * we can generate more efficient code.
	 */
	if ((o == DCON && p->dpn.dval == 0) ||
	    (o == FCON && p->fpn.fval == 0)) {
		p->in.op = ICON;
		p->tn.rval = NONAME;
		return;
	}
	locctr(DATA);
	defalign(o == DCON ? ALDOUBLE : ALFLOAT);
	deflab(i = getlab());
	if (o == FCON)
		fincode(p->fpn.fval, SZFLOAT);
	else
		fincode(p->dpn.dval, SZDOUBLE);
	p->tn.lval = 0;
	p->tn.rval = -i;
	p->in.type = (o == DCON ? DOUBLE : FLOAT);
	p->in.op = NAME;
}

isitfloat( s ) char *s; {
	union cvt {
		double	d;
		int	n[2];
	} cvt;
	double atof();

	/* avoid floating point exception for double -> float conversions */
	dcon = cvt.d = atof(s);
	if( cvt.n[1] == 0 ){
		fcon = dcon;
		return( FCON );
		}
	return( DCON );
	}

ecode( p ) NODE *p; {

	/* walk the tree and write out the nodes.. */

	if( nerrors ) return;
	p2tree( p );
	p2compile( p );
	}

#ifndef ONEPASS
tlen(p) NODE *p; 
{
	switch(p->in.type) {
		case CHAR:
		case UCHAR:
			return(1);
			
		case SHORT:
		case USHORT:
			return(2);
			
		case DOUBLE:
			return(8);
			
		default:
			return(4);
		}
	}
#endif
Commit	Line	Data
b4204852	1	#ifndef lint
895241c8	2	static char sccsid[] = "@(#)local.c 1.3 (Berkeley) %G%";
b4204852 SL	3	#endif
b4204852 SL	4
7b1562c4	5	# include "pass1.h"
b4204852 SL	6
	7	/* this file contains code which is dependent on the target machine */
	8
	9	NODE *
	10	clocal(p) register NODE *p; {
	11
	12	/* this is called to do local transformations on
	13	an expression tree preparitory to its being
	14	written out in intermediate code.
	15	*/
	16
	17	/* the major essential job is rewriting the
	18	automatic variables and arguments in terms of
	19	REG and OREG nodes */
	20	/* conversion ops which are not necessary are also clobbered here */
	21	/* in addition, any special features (such as rewriting
	22	exclusive or) are easily handled here as well */
	23
	24	register struct symtab *q;
	25	register NODE *r;
	26	register int o;
	27	register int m, ml;
	28
	29	switch( o = p->in.op ){
	30
	31	case NAME:
	32	if( p->tn.rval < 0 ) { /* already processed; ignore... */
	33	return(p);
	34	}
	35	q = &stab[p->tn.rval];
	36	switch( q->sclass ){
	37
	38	case AUTO:
	39	case PARAM:
	40	/* fake up a structure reference */
	41	r = block( REG, NIL, NIL, PTR+STRTY, 0, 0 );
	42	r->tn.lval = 0;
	43	r->tn.rval = STKREG;
	44	p = stref( block( STREF, r, p, 0, 0, 0 ) );
	45	break;
	46
	47	case ULABEL:
	48	case LABEL:
	49	case STATIC:
	50	if( q->slevel == 0 ) break;
	51	p->tn.lval = 0;
	52	p->tn.rval = -q->offset;
	53	break;
	54
	55	case REGISTER:
	56	p->in.op = REG;
	57	p->tn.lval = 0;
	58	p->tn.rval = q->offset;
	59	#ifdef REG_CHAR
	60	m = p->in.type;
	61	if( m==CHAR \|\| m==SHORT )
	62	p->in.type = INT;
	63	else if( m==UCHAR \|\| m==USHORT )
	64	p->in.type = UNSIGNED;
	65	#endif
	66	break;
	67
	68	}
	69	break;
70
71	case LT:
72	case LE:
73	case GT:
74	case GE:
75	if( ISPTR( p->in.left->in.type ) \|\| ISPTR( p->in.right->in.type ) ){
76	p->in.op += (ULT-LT);
77	}
78	break;
79
80	case PCONV:
81	/* do pointer conversions for char and longs */
82	ml = p->in.left->in.type;
83	if( ( ml==CHAR \|\| ml==UCHAR \|\| ml==SHORT \|\| ml==USHORT ) && p->in.left->in.op != ICON ) break;
84
85	/* pointers all have the same representation; the type is inherited */
86
87	inherit:
88	p->in.left->in.type = p->in.type;
89	p->in.left->fn.cdim = p->fn.cdim;
90	p->in.left->fn.csiz = p->fn.csiz;
91	p->in.op = FREE;
92	return( p->in.left );
93
94	case SCONV:
95	m = p->in.type;
96	ml = p->in.left->in.type;
97	if(m == FLOAT \|\| m == DOUBLE) {
98	if(p->in.left->in.op==SCONV &&
99	(ml == FLOAT \|\| ml == DOUBLE) &&
100	p->in.left->in.left->in.type==m) {
101	p->in.op = p->in.left->in.op = FREE;
102	return(p->in.left->in.left);
103	}
104	if(p->in.left->in.op==FCON)
105	goto inherit;
106	break;
107	}
108	if(ml == FLOAT \|\| ml == DOUBLE){
109	if (p->in.left->in.op == FCON){
110	p->in.left->in.op = FREE;
111	p->in.op = ICON;
7b1562c4	112	p->tn.lval = p->in.left->fpn.fval;
b4204852 SL	113	p->tn.rval = NONAME;
	114	return(p);
	115	}
	116	break;
	117	}
	118	/* now, look for conversions downwards */
	119
	120	if( p->in.left->in.op == ICON ){ /* simulate the conversion here */
	121	CONSZ val;
	122	val = p->in.left->tn.lval;
	123	switch( m ){
	124	case CHAR:
	125	p->in.left->tn.lval = (char) val;
	126	break;
	127	case UCHAR:
	128	p->in.left->tn.lval = val & 0XFF;
	129	break;
	130	case USHORT:
	131	p->in.left->tn.lval = val & 0XFFFFL;
	132	break;
	133	case SHORT:
	134	p->in.left->tn.lval = (short)val;
	135	break;
	136	case UNSIGNED:
	137	p->in.left->tn.lval = val & 0xFFFFFFFFL;
	138	break;
	139	case INT:
	140	p->in.left->tn.lval = (int)val;
	141	break;
	142	}
	143	p->in.left->in.type = m;
	144	}
	145	else {
	146	/* meaningful ones are conversion of int to char, int to short,
	147	and short to char, and unsigned versions thereof */
	148	if( m==CHAR \|\| m==UCHAR ){
	149	if( ml!=CHAR && ml!= UCHAR ) break;
	150	}
	151	else if( m==SHORT \|\| m==USHORT ){
	152	if( ml!=CHAR && ml!=UCHAR && ml!=SHORT && ml!=USHORT ) break;
	153	}
	154	}
	155
	156	/* clobber conversion */
	157	if( tlen(p) == tlen(p->in.left) ) goto inherit;
	158	p->in.op = FREE;
	159	return( p->in.left ); /* conversion gets clobbered */
	160
	161	case QUEST: /* the right side should be COLON */
	162	if((r = p->in.right)->in.op == SCONV) {
	163	p->in.right = r->in.left;
	164	p->in.type = r->in.left->in.type;
	165	r->in.left = p;
	166	return(r);
	167	}
	168	return(p);
	169
	170	case PVCONV:
	171	case PMCONV:
	172	if( p->in.right->in.op != ICON ) cerror( "bad conversion", 0);
	173	p->in.op = FREE;
	174	return( buildtree( o==PMCONV?MUL:DIV, p->in.left, p->in.right ) );
	175
	176	case FLD:
177	/* make sure that the second pass does not make the
178	descendant of a FLD operator into a doubly indexed OREG */
179
180	if( p->in.left->in.op == UNARY MUL
181	&& (r=p->in.left->in.left)->in.op == PCONV)
182	if( r->in.left->in.op == PLUS \|\| r->in.left->in.op == MINUS )
183	if( ISPTR(r->in.type) ) {
184	if( ISUNSIGNED(p->in.left->in.type) )
185	p->in.left->in.type = UNSIGNED;
186	else
187	p->in.left->in.type = INT;
188	}
189	break;
7b1562c4 SL	190	case FORTCALL: /* arg must be FLOAT */
	191	if((r = p->in.right)->in.type != FLOAT)
	192	p->in.right = clocal(makety(r, FLOAT, 0, FLOAT));
	193	return(p);
	194	}
b4204852 SL	195
	196	/* if both sides are FLOAT, so is the op */
	197	if(optype(o)!=LTYPE && p->in.left->in.type==DOUBLE &&
	198	(o==UNARY MINUS \|\| optype(o)==BITYPE && p->in.right->in.type==DOUBLE)) {
	199	r = p->in.left;
	200	if(r->in.op==SCONV && r->in.left->in.type==FLOAT) {
	201	if(optype(o)==BITYPE) {
	202	r = p->in.right;
	203	if(r->in.op==SCONV && r->in.left->in.type==FLOAT) {
	204	r->in.op = FREE;
	205	p->in.right = r->in.left;
	206	} else if(r->in.op==FCON)
	207	r->in.type = FLOAT;
	208	else
	209	return(p);
	210	}
	211	r = p->in.left;
	212	p->in.left = r->in.left;
	213	} else if(optype(o)==BITYPE && r->in.op==FCON) {
	214	r = p->in.right;
	215	if(!(r->in.op==SCONV && r->in.left->in.type==FLOAT))
	216	return(p);
	217	p->in.right = r->in.left;
	218	p->in.left->in.type = FLOAT;
	219	} else
	220	return(p);
	221	if(p->in.type==DOUBLE) {
	222	p->in.type = FLOAT;
	223	r->in.left = p;
	224	return(r);
	225	} else { /* usually logop */
	226	r->in.op = FREE;
	227	return(p);
	228	}
	229	}
	230	return(p);
	231	}
	232
	233	andable( p ) NODE *p; {
	234	return(1); /* all names can have & taken on them */
	235	}
	236
	237	cendarg(){ /* at the end of the arguments of a ftn, set the automatic offset */
	238	autooff = AUTOINIT;
	239	}
	240
	241	cisreg( t ) TWORD t; { /* is an automatic variable of type t OK for a register variable */
	242
	243	if( t==INT \|\| t==UNSIGNED \|\| t==LONG \|\| t==ULONG /* tbl */
	244	#ifdef REG_CHAR
	245	\|\| t==CHAR \|\| t==UCHAR \|\| t==SHORT \|\| t==USHORT /* tbl */
	246	#endif
	247	\|\| ISPTR(t)) return (1); /* wnj */
	248	return(0);
	249	}
	250
	251	NODE *
	252	offcon( off, t, d, s ) OFFSZ off; TWORD t; {
	253
	254	/* return a node, for structure references, which is suitable for
	255	being added to a pointer of type t, in order to be off bits offset
	256	into a structure */
	257
	258	register NODE *p;
259
260	/* t, d, and s are the type, dimension offset, and sizeoffset */
261	/* in general they are necessary for offcon, but not on H'well */
262
263	p = bcon(0);
264	p->tn.lval = off/SZCHAR;
265	return(p);
266
267	}
268
269
270	static inwd /* current bit offsed in word */;
271	static CONSZ word /* word being built from fields */;
272
273	incode( p, sz ) register NODE *p; {
274
275	/* generate initialization code for assigning a constant c
276	to a field of width sz */
277	/* we assume that the proper alignment has been obtained */
278	/* inoff is updated to have the proper final value */
279	/* we also assume sz < SZINT */
280
281	inwd += sz;
282	if(inwd > SZINT) cerror("incode: field > int");
283	word \|= (p->tn.lval&((1L<<sz)-1)) << (SZINT-inwd);
284	inoff += sz;
285	if(inoff%SZINT == 0) {
7b1562c4	286	printf( " .long 0x%X\n", word);
b4204852 SL	287	word = inwd = 0;
	288	}
	289	}
	290
b4204852 SL	291	fincode( d, sz ) double d; register int sz; {
	292	/*
	293	* output code to initialize space of size sz to the value d
	294	* the proper alignment has been obtained
7b1562c4	295	* inoff is updated to have the proper final value.
b4204852 SL	296	*/
	297
	298	register struct sh4 {
	299	unsigned short sh[4];
	300	} *x;
b4204852 SL	301	float f;
	302
	303	if(sz == SZFLOAT) { /* force rounding */
	304	f = d;
	305	d = f;
	306	}
b4204852 SL	307
	308	x = (struct sh4 *)&d;
	309	printf(" .long 0x%04x%04x", x->sh[0], x->sh[1]);
b4204852 SL	310	if(sz == SZDOUBLE) {
	311	printf(", 0x%04x%04x", x->sh[2], x->sh[3]);
	312	printf(" # .double %.17g\n", d);
	313	} else
	314	printf(" # .float %.8g\n", d);
	315	inoff += sz;
b4204852 SL	316	}
	317
	318	cinit( p, sz ) NODE *p; {
7b1562c4 SL	319	NODE *l;
	320
	321	/*
	322	* as a favor (?) to people who want to write
	323	* int i = 9600/134.5;
	324	* we will, under the proper circumstances, do
	325	* a coersion here.
	326	*/
	327	switch (p->in.type) {
	328	case INT:
	329	case UNSIGNED:
	330	l = p->in.left;
	331	if (l->in.op != SCONV \|\|
	332	(l->in.left->tn.op != DCON && l->in.left->tn.op != FCON))
	333	break;
	334	l->in.op = FREE;
	335	l = l->in.left;
	336	l->tn.lval = l->tn.op == DCON ? (long)(l->dpn.dval) :
	337	(long)(l->fpn.fval);
	338	l->tn.rval = NONAME;
	339	l->tn.op = ICON;
	340	l->tn.type = INT;
	341	p->in.left = l;
	342	break;
	343	}
b4204852 SL	344	/* arrange for the initialization of p into a space of
	345	size sz */
	346	/* the proper alignment has been opbtained */
	347	/* inoff is updated to have the proper final value */
	348	ecode( p );
	349	inoff += sz;
	350	}
	351
	352	vfdzero( n ){ /* define n bits of zeros in a vfd */
	353
	354	if( n <= 0 ) return;
	355
	356	inwd += n;
	357	inoff += n;
	358	if( inoff%ALINT ==0 ) {
7b1562c4	359	printf( " .long 0x%X\n", word );
b4204852 SL	360	word = inwd = 0;
	361	}
	362	}
	363
	364	char *
	365	exname( p ) char *p; {
	366	/* make a name look like an external name in the local machine */
	367
	368	#ifndef FLEXNAMES
	369	static char text[NCHNAM+1];
	370	#else
	371	static char text[BUFSIZ+1];
	372	#endif
	373
	374	register int i;
	375
	376	text[0] = '_';
	377	#ifndef FLEXNAMES
7b1562c4	378	for( i=1; *p&&i<NCHNAM; ++i )
b4204852	379	#else
7b1562c4	380	for( i=1; *p; ++i )
b4204852 SL	381	#endif
b4204852 SL	382	text[i] = *p++;
b4204852 SL	383
	384	text[i] = '\0';
	385	#ifndef FLEXNAMES
	386	text[NCHNAM] = '\0'; /* truncate */
	387	#endif
	388
	389	return( text );
	390	}
	391
	392	ctype( type )TWORD type;{ /* map types which are not defined on the local machine */
	393	switch( BTYPE(type) ){
	394
	395	case LONG:
	396	MODTYPE(type,INT);
	397	break;
	398
	399	case ULONG:
	400	MODTYPE(type,UNSIGNED);
	401	}
	402	return( type );
	403	}
	404
	405	noinit() { /* curid is a variable which is defined but
	406	is not initialized (and not a function );
	407	This routine returns the stroage class for an uninitialized declaration */
	408
	409	return(EXTERN);
	410
	411	}
	412
	413	commdec( id ){ /* make a common declaration for id, if reasonable */
	414	register struct symtab *q;
	415	OFFSZ off, tsize();
	416
	417	q = &stab[id];
	418	printf( " .comm %s,", exname( q->sname ) );
	419	off = tsize( q->stype, q->dimoff, q->sizoff );
895241c8	420	printf( "%d\n" /CONFMT/, off/SZCHAR );
b4204852 SL	421	}
b4204852 SL	422
7b1562c4 SL	423	prtdcon(p)
	424	register NODE *p;
	425	{
	426	register int o = p->in.op;
	427	int i;
	428
	429	if (o != DCON && o != FCON)
	430	return;
	431	/*
	432	* Clobber constants of value zero so
	433	* we can generate more efficient code.
	434	*/
	435	if ((o == DCON && p->dpn.dval == 0) \|\|
	436	(o == FCON && p->fpn.fval == 0)) {
	437	p->in.op = ICON;
	438	p->tn.rval = NONAME;
	439	return;
	440	}
	441	locctr(DATA);
	442	defalign(o == DCON ? ALDOUBLE : ALFLOAT);
	443	deflab(i = getlab());
	444	if (o == FCON)
	445	fincode(p->fpn.fval, SZFLOAT);
	446	else
	447	fincode(p->dpn.dval, SZDOUBLE);
	448	p->tn.lval = 0;
	449	p->tn.rval = -i;
	450	p->in.type = (o == DCON ? DOUBLE : FLOAT);
	451	p->in.op = NAME;
	452	}
b4204852 SL	453
b4204852 SL	454	isitfloat( s ) char *s; {
7b1562c4 SL	455	union cvt {
	456	double d;
	457	int n[2];
	458	} cvt;
b4204852	459	double atof();
7b1562c4 SL	460
	461	/* avoid floating point exception for double -> float conversions */
	462	dcon = cvt.d = atof(s);
	463	if( cvt.n[1] == 0 ){
	464	fcon = dcon;
	465	return( FCON );
	466	}
	467	return( DCON );
b4204852 SL	468	}
	469
	470	ecode( p ) NODE *p; {
	471
	472	/* walk the tree and write out the nodes.. */
	473
	474	if( nerrors ) return;
	475	p2tree( p );
	476	p2compile( p );
	477	}
	478
	479	#ifndef ONEPASS
	480	tlen(p) NODE *p;
	481	{
	482	switch(p->in.type) {
	483	case CHAR:
	484	case UCHAR:
	485	return(1);
	486
	487	case SHORT:
	488	case USHORT:
	489	return(2);
	490
	491	case DOUBLE:
	492	return(8);
	493
	494	default:
	495	return(4);
	496	}
	497	}
	498	#endif