[unix-history] / usr / src / libexec / pcc / ccom.vax / local.c

#ifndef lint
static char *sccsid ="@(#)local.c	1.17 (Berkeley) 5/11/88";
#endif lint

# 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 = (q->sclass==AUTO?STKREG:ARGREG);
			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;
			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 */

		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 == ml)
			goto clobber;
		o = p->in.left->in.op;
		if(m == FLOAT || m == DOUBLE) {
			if(o==SCONV &&
			 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);
				}
			/* see makety() for constant conversions */
			break;
			}
		if(ml == FLOAT || ml == DOUBLE){
			if(o != FCON && o != DCON)
				break;
			ml = ISUNSIGNED(m) ? UNSIGNED : INT; /* LONG? */
			r = block( ICON, (NODE *)NULL, (NODE *)NULL, ml, 0, 0 );
			if( o == FCON )
				r->tn.lval = ml == INT ?
					(int) p->in.left->fpn.fval :
					(unsigned) p->in.left->fpn.fval;
			else
				r->tn.lval = ml == INT ?
					(int) p->in.left->dpn.dval :
					(unsigned) p->in.left->dpn.dval;
			r->tn.rval = NONAME;
			p->in.left->in.op = FREE;
			p->in.left = r;
			o = ICON;
			if( m == ml )
				goto clobber;
			}
		/* now, look for conversions downwards */

		if( o == 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
			break;

	clobber:
		p->in.op = FREE;
		return( p->in.left );  /* conversion gets clobbered */

	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 RS:
	case ASG RS:
		/* convert >> to << with negative shift count */
		/* only if type of left operand is not unsigned */

		if( ISUNSIGNED(p->in.left->in.type) ) break;
		if( p->in.right->in.op != UNARY MINUS )
			p->in.right = buildtree( UNARY MINUS, p->in.right, NIL );
		else {
			r = p->in.right;
			p->in.right = p->in.right->in.left;
			r->in.op = FREE;
		}
		if( p->in.op == RS ) p->in.op = LS;
		else p->in.op = ASG LS;
		break;

	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 = UCHAR;
					else
						p->in.left->in.type = CHAR;
				}
		break;
		}

	return(p);
	}

/*ARGSUSED*/
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 */

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

/*ARGSUSED*/
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 VAX */

	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 */

	inoff += sz;
	if(nerrors) return;
	if((sz+inwd) > SZINT) cerror("incode: field > int");
	word |= ((unsigned)(p->tn.lval<<(32-sz))) >> (32-sz-inwd);
	inwd += sz;
	if(inoff%SZINT == 0) {
		printf( "	.long	0x%lx\n", word);
		word = inwd = 0;
		}
	}

fincode( d, sz ) double d; {
	/* 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 */
	/* on the target machine, write it out in octal! */


	if(!nerrors)
	printf("	%s	0%c%.20e\n", sz == SZDOUBLE ? ".double" : ".float",
		sz == SZDOUBLE ? 'd' : 'f', 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 coercion 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;

	inoff += n;
	if (nerrors) return;
	inwd += n;
	if( inoff%ALINT ==0 ) {
		printf( "	.long	0x%lx\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();

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

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;
}

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(SZSHORT/SZCHAR);
			
		case DOUBLE:
			return(SZDOUBLE/SZCHAR);
			
		default:
			return(SZINT/SZCHAR);
		}
	}
#endif
Commit	Line	Data
4d89f1ac	1	#ifndef lint
ca67e7b4	2	static char *sccsid ="@(#)local.c 1.17 (Berkeley) 5/11/88";
4d89f1ac RC	3	#endif lint
4d89f1ac RC	4
13105c45	5	# include "pass1.h"
fd18d838 ML	6
	7	/* this file contains code which is dependent on the target machine */
	8
	9	NODE *
31bdb7a0	10	clocal(p) register NODE *p; {
fd18d838 ML	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;
31bdb7a0 DS	26	register int o;
31bdb7a0 DS	27	register int m, ml;
fd18d838 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 = (q->sclass==AUTO?STKREG:ARGREG);
	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	break;
	60
	61	}
	62	break;
	63
31bdb7a0 DS	64	case LT:
	65	case LE:
	66	case GT:
	67	case GE:
	68	if( ISPTR( p->in.left->in.type ) \|\| ISPTR( p->in.right->in.type ) ){
	69	p->in.op += (ULT-LT);
	70	}
	71	break;
	72
fd18d838 ML	73	case PCONV:
	74	/* do pointer conversions for char and longs */
	75	ml = p->in.left->in.type;
	76	if( ( ml==CHAR \|\| ml==UCHAR \|\| ml==SHORT \|\| ml==USHORT ) && p->in.left->in.op != ICON ) break;
	77
	78	/* pointers all have the same representation; the type is inherited */
	79
fd18d838 ML	80	p->in.left->in.type = p->in.type;
	81	p->in.left->fn.cdim = p->fn.cdim;
	82	p->in.left->fn.csiz = p->fn.csiz;
	83	p->in.op = FREE;
	84	return( p->in.left );
	85
	86	case SCONV:
31bdb7a0 DS	87	m = p->in.type;
	88	ml = p->in.left->in.type;
	89	if(m == ml)
	90	goto clobber;
4d89f1ac	91	o = p->in.left->in.op;
31bdb7a0 DS	92	if(m == FLOAT \|\| m == DOUBLE) {
	93	if(o==SCONV &&
	94	ml == DOUBLE &&
	95	p->in.left->in.left->in.type==m) {
	96	p->in.op = p->in.left->in.op = FREE;
	97	return(p->in.left->in.left);
	98	}
	99	/* see makety() for constant conversions */
	100	break;
	101	}
	102	if(ml == FLOAT \|\| ml == DOUBLE){
	103	if(o != FCON && o != DCON)
	104	break;
	105	ml = ISUNSIGNED(m) ? UNSIGNED : INT; /* LONG? */
	106	r = block( ICON, (NODE )NULL, (NODE )NULL, ml, 0, 0 );
4d89f1ac	107	if( o == FCON )
31bdb7a0 DS	108	r->tn.lval = ml == INT ?
	109	(int) p->in.left->fpn.fval :
	110	(unsigned) p->in.left->fpn.fval;
4d89f1ac	111	else
31bdb7a0 DS	112	r->tn.lval = ml == INT ?
	113	(int) p->in.left->dpn.dval :
	114	(unsigned) p->in.left->dpn.dval;
4d89f1ac RC	115	r->tn.rval = NONAME;
	116	p->in.left->in.op = FREE;
	117	p->in.left = r;
31bdb7a0 DS	118	o = ICON;
	119	if( m == ml )
	120	goto clobber;
4d89f1ac	121	}
fd18d838 ML	122	/* now, look for conversions downwards */
fd18d838 ML	123
31bdb7a0	124	if( o == ICON ){ /* simulate the conversion here */
fd18d838 ML	125	CONSZ val;
	126	val = p->in.left->tn.lval;
	127	switch( m ){
	128	case CHAR:
	129	p->in.left->tn.lval = (char) val;
	130	break;
	131	case UCHAR:
	132	p->in.left->tn.lval = val & 0XFF;
	133	break;
	134	case USHORT:
	135	p->in.left->tn.lval = val & 0XFFFFL;
	136	break;
	137	case SHORT:
	138	p->in.left->tn.lval = (short)val;
	139	break;
	140	case UNSIGNED:
	141	p->in.left->tn.lval = val & 0xFFFFFFFFL;
	142	break;
	143	case INT:
	144	p->in.left->tn.lval = (int)val;
	145	break;
	146	}
	147	p->in.left->in.type = m;
	148	}
31bdb7a0	149	else
472582a4	150	break;
fd18d838	151
31bdb7a0	152	clobber:
fd18d838 ML	153	p->in.op = FREE;
	154	return( p->in.left ); /* conversion gets clobbered */
	155
	156	case PVCONV:
	157	case PMCONV:
	158	if( p->in.right->in.op != ICON ) cerror( "bad conversion", 0);
	159	p->in.op = FREE;
	160	return( buildtree( o==PMCONV?MUL:DIV, p->in.left, p->in.right ) );
	161
	162	case RS:
	163	case ASG RS:
	164	/* convert >> to << with negative shift count */
	165	/* only if type of left operand is not unsigned */
	166
	167	if( ISUNSIGNED(p->in.left->in.type) ) break;
4d89f1ac RC	168	if( p->in.right->in.op != UNARY MINUS )
	169	p->in.right = buildtree( UNARY MINUS, p->in.right, NIL );
	170	else {
	171	r = p->in.right;
	172	p->in.right = p->in.right->in.left;
	173	r->in.op = FREE;
	174	}
fd18d838 ML	175	if( p->in.op == RS ) p->in.op = LS;
	176	else p->in.op = ASG LS;
	177	break;
	178
	179	case FLD:
	180	/* make sure that the second pass does not make the
	181	descendant of a FLD operator into a doubly indexed OREG */
	182
	183	if( p->in.left->in.op == UNARY MUL
	184	&& (r=p->in.left->in.left)->in.op == PCONV)
	185	if( r->in.left->in.op == PLUS \|\| r->in.left->in.op == MINUS )
	186	if( ISPTR(r->in.type) ) {
	187	if( ISUNSIGNED(p->in.left->in.type) )
c30a740a	188	p->in.left->in.type = UCHAR;
fd18d838	189	else
c30a740a	190	p->in.left->in.type = CHAR;
fd18d838 ML	191	}
	192	break;
	193	}
	194
	195	return(p);
	196	}
	197
dd27ff22	198	/ARGSUSED/
fd18d838 ML	199	andable( p ) NODE *p; {
	200	return(1); /* all names can have & taken on them */
	201	}
	202
	203	cendarg(){ /* at the end of the arguments of a ftn, set the automatic offset */
	204	autooff = AUTOINIT;
	205	}
	206
	207	cisreg( t ) TWORD t; { /* is an automatic variable of type t OK for a register variable */
	208
	209	#ifdef TRUST_REG_CHAR_AND_REG_SHORT
	210	if( t==INT \|\| t==UNSIGNED \|\| t==LONG \|\| t==ULONG /* tbl */
	211	\|\| t==CHAR \|\| t==UCHAR \|\| t==SHORT /* tbl */
	212	\|\| t==USHORT \|\| ISPTR(t)) return(1); /* tbl */
	213	#else
	214	if( t==INT \|\| t==UNSIGNED \|\| t==LONG \|\| t==ULONG /* wnj */
4d89f1ac RC	215	#ifdef SPRECC
	216	\|\| t==FLOAT
	217	#endif
fd18d838 ML	218	\|\| ISPTR(t)) return (1); /* wnj */
	219	#endif
	220	return(0);
	221	}
	222
dd27ff22	223	/ARGSUSED/
fd18d838 ML	224	NODE *
	225	offcon( off, t, d, s ) OFFSZ off; TWORD t; {
	226
	227	/* return a node, for structure references, which is suitable for
	228	being added to a pointer of type t, in order to be off bits offset
	229	into a structure */
	230
	231	register NODE *p;
	232
	233	/* t, d, and s are the type, dimension offset, and sizeoffset */
dd27ff22	234	/* in general they are necessary for offcon, but not on VAX */
fd18d838 ML	235
	236	p = bcon(0);
	237	p->tn.lval = off/SZCHAR;
	238	return(p);
	239
	240	}
	241
	242
	243	static inwd /* current bit offsed in word */;
31bdb7a0	244	static CONSZ word /* word being built from fields */;
fd18d838 ML	245
	246	incode( p, sz ) register NODE *p; {
	247
	248	/* generate initialization code for assigning a constant c
	249	to a field of width sz */
	250	/* we assume that the proper alignment has been obtained */
	251	/* inoff is updated to have the proper final value */
	252	/* we also assume sz < SZINT */
	253
c30a740a	254	inoff += sz;
31bdb7a0	255	if(nerrors) return;
fd18d838 ML	256	if((sz+inwd) > SZINT) cerror("incode: field > int");
	257	word \|= ((unsigned)(p->tn.lval<<(32-sz))) >> (32-sz-inwd);
	258	inwd += sz;
fd18d838	259	if(inoff%SZINT == 0) {
31bdb7a0	260	printf( " .long 0x%lx\n", word);
fd18d838 ML	261	word = inwd = 0;
	262	}
	263	}
	264
	265	fincode( d, sz ) double d; {
	266	/* output code to initialize space of size sz to the value d */
	267	/* the proper alignment has been obtained */
	268	/* inoff is updated to have the proper final value */
	269	/* on the target machine, write it out in octal! */
	270
	271
c30a740a	272	if(!nerrors)
fd18d838 ML	273	printf(" %s 0%c%.20e\n", sz == SZDOUBLE ? ".double" : ".float",
	274	sz == SZDOUBLE ? 'd' : 'f', d);
	275	inoff += sz;
	276	}
	277
	278	cinit( p, sz ) NODE *p; {
03f4d7a6 KM	279	NODE *l;
	280
	281	/*
	282	* as a favor (?) to people who want to write
	283	* int i = 9600/134.5;
	284	* we will, under the proper circumstances, do
31bdb7a0	285	* a coercion here.
03f4d7a6 KM	286	*/
	287	switch (p->in.type) {
	288	case INT:
	289	case UNSIGNED:
	290	l = p->in.left;
13105c45 RC	291	if (l->in.op != SCONV \|\|
	292	(l->in.left->tn.op != DCON && l->in.left->tn.op != FCON))
	293	break;
03f4d7a6 KM	294	l->in.op = FREE;
03f4d7a6 KM	295	l = l->in.left;
13105c45 RC	296	l->tn.lval = l->tn.op == DCON ? (long)(l->dpn.dval) :
13105c45 RC	297	(long)(l->fpn.fval);
03f4d7a6 KM	298	l->tn.rval = NONAME;
	299	l->tn.op = ICON;
	300	l->tn.type = INT;
	301	p->in.left = l;
	302	break;
	303	}
	304	/* arrange for the initialization of p into a space of size sz */
fd18d838 ML	305	/* the proper alignment has been opbtained */
	306	/* inoff is updated to have the proper final value */
	307	ecode( p );
	308	inoff += sz;
	309	}
	310
	311	vfdzero( n ){ /* define n bits of zeros in a vfd */
	312
	313	if( n <= 0 ) return;
	314
c30a740a	315	inoff += n;
e324b298	316	if (nerrors) return;
fd18d838	317	inwd += n;
fd18d838	318	if( inoff%ALINT ==0 ) {
31bdb7a0	319	printf( " .long 0x%lx\n", word );
fd18d838 ML	320	word = inwd = 0;
	321	}
	322	}
	323
	324	char *
	325	exname( p ) char *p; {
	326	/* make a name look like an external name in the local machine */
	327
	328	#ifndef FLEXNAMES
	329	static char text[NCHNAM+1];
	330	#else
	331	static char text[BUFSIZ+1];
	332	#endif
	333
31bdb7a0	334	register int i;
fd18d838 ML	335
	336	text[0] = '_';
	337	#ifndef FLEXNAMES
88bb0c9f	338	for( i=1; *p&&i<NCHNAM; ++i )
fd18d838	339	#else
88bb0c9f	340	for( i=1; *p; ++i )
fd18d838 ML	341	#endif
fd18d838 ML	342	text[i] = *p++;
fd18d838 ML	343
	344	text[i] = '\0';
	345	#ifndef FLEXNAMES
	346	text[NCHNAM] = '\0'; /* truncate */
	347	#endif
	348
	349	return( text );
	350	}
	351
4d89f1ac RC	352	ctype( type ) TWORD type;
4d89f1ac RC	353	{ /* map types which are not defined on the local machine */
fd18d838 ML	354	switch( BTYPE(type) ){
	355
	356	case LONG:
	357	MODTYPE(type,INT);
	358	break;
	359
	360	case ULONG:
	361	MODTYPE(type,UNSIGNED);
	362	}
	363	return( type );
	364	}
	365
4d89f1ac	366	noinit() { /* curid is a variable which is defined but
fd18d838 ML	367	is not initialized (and not a function );
	368	This routine returns the stroage class for an uninitialized declaration */
	369
	370	return(EXTERN);
	371
	372	}
	373
	374	commdec( id ){ /* make a common declaration for id, if reasonable */
	375	register struct symtab *q;
	376	OFFSZ off, tsize();
	377
e324b298	378	if (nerrors) return;
fd18d838 ML	379	q = &stab[id];
	380	printf( " .comm %s,", exname( q->sname ) );
	381	off = tsize( q->stype, q->dimoff, q->sizoff );
	382	printf( CONFMT, off/SZCHAR );
31bdb7a0	383	putchar( '\n' );
fd18d838 ML	384	}
fd18d838 ML	385
31bdb7a0 DS	386	prtdcon(p)
	387	register NODE *p;
	388	{
	389	register int o = p->in.op;
	390	int i;
fd18d838	391
31bdb7a0 DS	392	if (o != DCON && o != FCON)
	393	return;
	394	/*
	395	* Clobber constants of value zero so
	396	* we can generate more efficient code.
	397	*/
	398	if ((o == DCON && p->dpn.dval == 0) \|\|
	399	(o == FCON && p->fpn.fval == 0)) {
	400	p->in.op = ICON;
	401	p->tn.rval = NONAME;
	402	return;
fd18d838	403	}
31bdb7a0 DS	404	locctr(DATA);
	405	defalign(o == DCON ? ALDOUBLE : ALFLOAT);
	406	deflab(i = getlab());
	407	if (o == FCON)
	408	fincode(p->fpn.fval, SZFLOAT);
	409	else
	410	fincode(p->dpn.dval, SZDOUBLE);
	411	p->tn.lval = 0;
	412	p->tn.rval = -i;
	413	p->in.type = (o == DCON ? DOUBLE : FLOAT);
	414	p->in.op = NAME;
	415	}
fd18d838	416
fd18d838 ML	417	ecode( p ) NODE *p; {
	418
	419	/* walk the tree and write out the nodes.. */
	420
	421	if( nerrors ) return;
	422	p2tree( p );
	423	p2compile( p );
	424	}
fd18d838 ML	425
	426	#ifndef ONEPASS
	427	tlen(p) NODE *p;
	428	{
	429	switch(p->in.type) {
	430	case CHAR:
	431	case UCHAR:
	432	return(1);
	433
	434	case SHORT:
	435	case USHORT:
1504b363	436	return(SZSHORT/SZCHAR);
fd18d838 ML	437
fd18d838 ML	438	case DOUBLE:
1504b363	439	return(SZDOUBLE/SZCHAR);
fd18d838 ML	440
fd18d838 ML	441	default:
1504b363	442	return(SZINT/SZCHAR);
fd18d838 ML	443	}
	444	}
	445	#endif