[unix-history] / usr / src / cmd / pi / put.c

/* Copyright (c) 1979 Regents of the University of California */

static	char sccsid[] = "@(#)put.c 1.3 10/2/80";

#include "whoami.h"
#include "opcode.h"
#include "0.h"
#include "objfmt.h"
#ifdef PC
#   include	"pc.h"
#endif PC

short	*obufp	= obuf;

/*
 * If DEBUG is defined, include the table
 * of the printing opcode names.
 */
#ifdef DEBUG
#include "OPnames.h"
#endif

#ifdef OBJ
/*
 * Put is responsible for the interpreter equivalent of code
 * generation.  Since the interpreter is specifically designed
 * for Pascal, little work is required here.
 */
put(a)
{
	register int *p, i;
	register char *cp;
	int n, subop, suboppr, op, oldlc, w;
	char *string;
	static int casewrd;

	/*
	 * It would be nice to do some more
	 * optimizations here.  The work
	 * done to collapse offsets in lval
	 * should be done here, the IFEQ etc
	 * relational operators could be used
	 * etc.
	 */
	oldlc = lc;
	if (cgenflg < 0)
		/*
		 * code disabled - do nothing
		 */
		return (oldlc);
	p = &a;
	n = *p++;
	suboppr = subop = (*p>>8) & 0377;
	op = *p & 0377;
	string = 0;
#ifdef DEBUG
	if ((cp = otext[op]) == NIL) {
		printf("op= %o\n", op);
		panic("put");
	}
#endif
	switch (op) {
		case O_ABORT:
			cp = "*";
			break;
		case O_LINO:
/*****
			if (line == codeline)
				return (oldlc);
			codeline = line;
*****/
		case O_NEW:
		case O_DISPOSE:
		case O_AS:
		case O_IND:
		case O_LVCON:
		case O_CON:
		case O_OFF:
		case O_INX2:
		case O_INX4:
		case O_CARD:
		case O_ADDT:
		case O_SUBT:
		case O_MULT:
		case O_IN:
		case O_CASE1OP:
		case O_CASE2OP:
		case O_CASE4OP:
		case O_FRTN:
		case O_WRITES:
		case O_WRITEF:
		case O_MAX:
		case O_MIN:
		case O_PACK:
		case O_UNPACK:
		case O_ARGV:
		case O_CTTOT:
		case O_INCT:
		case O_RANG2:
		case O_RSNG2:
		case O_RANG42:
		case O_RSNG42:
			if (p[1] == 0)
				break;
		case O_CON2:
		case O_CON24:
			if (p[1] < 128 && p[1] >= -128) {
				suboppr = subop = p[1];
				p++;
				n--;
				if (op == O_CON2) {
					op = O_CON1;
					cp = otext[O_CON1];
				}
				if (op == O_CON24) {
					op = O_CON14;
					cp = otext[O_CON14];
				}
			}
			break;
		case O_CON8:
		    {
			short	*sp = &p[1];

#ifdef	DEBUG
			if ( opt( 'k' ) )
			    printf ( ")#%5d\tCON8\t%10.3f\n" ,
					lc - HEADER_BYTES ,
					* ( ( double * ) &p[1] ) );
#endif
			word ( op );
			for ( i = 1 ; i <= 4 ; i ++ )
			    word ( *sp ++ );
			return ( oldlc );
		    }
		default:
			if (op >= O_REL2 && op <= O_REL84) {
				if ((i = (subop >> 1) * 5 ) >= 30)
					i -= 30;
				else
					i += 2;
#ifdef DEBUG
				string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i];
#endif
				suboppr = 0;
			}
			break;
		case O_IF:
		case O_TRA:
/*****
			codeline = 0;
*****/
		case O_FOR1U:
		case O_FOR2U:
		case O_FOR4U:
		case O_FOR1D:
		case O_FOR2D:
		case O_FOR4D:
			/* relative addressing */
			p[1] -= ( unsigned ) lc + 2;
			break;
		case O_CONG:
			i = p[1];
			cp = * ( ( char ** ) &p[2] ) ;
#ifdef DEBUG
			if (opt('k'))
				printf(")#%5d\tCONG:%d\t%s\n",
					lc - HEADER_BYTES, i, cp);
#endif
			if (i <= 127)
				word(O_CON | i << 8);
			else {
				word(O_CON);
				word(i);
			}
			while (i > 0) {
				w = *cp ? *cp++ : ' ';
				w |= (*cp ? *cp++ : ' ') << 8;
				word(w);
				i -= 2;
			}
			return (oldlc);
		case O_CONC:
#ifdef DEBUG
			(string = "'x'")[1] = p[1];
#endif
			suboppr = 0;
			op = O_CON1;
			cp = otext[O_CON1];
			subop = p[1];
			goto around;
		case O_CONC4:
#ifdef DEBUG
			(string = "'x'")[1] = p[1];
#endif
			suboppr = 0;
			op = O_CON14;
			subop = p[1];
			goto around;
		case O_CON1:
		case O_CON14:
			suboppr = subop = p[1];
around:
			n--;
			break;
		case O_CASEBEG:
			casewrd = 0;
			return (oldlc);
		case O_CASEEND:
			if ((unsigned) lc & 1) {
				lc--;
				word(casewrd);
			}
			return (oldlc);
		case O_CASE1:
#ifdef DEBUG
			if (opt('k'))
				printf(")#%5d\tCASE1\t%d\n"
					, lc - HEADER_BYTES
					, ( int ) *( ( long * ) &p[1] ) );
#endif
			/*
			 * this to build a byte size case table 
			 * saving bytes across calls in casewrd
			 * so they can be put out by word()
			 */
			lc++;
			if ((unsigned) lc & 1)
				casewrd = *( ( long * ) &p[1] ) & 0377;
			else {
				lc -= 2;
				word (   casewrd
				       | ( ( int ) *( ( long * ) &p[1] ) << 8 ) );
			}
			return (oldlc);
		case O_CASE2:
#ifdef DEBUG
			if (opt('k'))
				printf(")#%5d\tCASE2\t%d\n"
					, lc - HEADER_BYTES
					, ( int ) *( ( long * ) &p[1] ) );
#endif
			word( ( short ) *( ( long * ) &p[1] ) );
			return (oldlc);
		case O_FCALL:
			if (p[1] == 0)
				goto longgen;
			/* and fall through */
		case O_PUSH:
			if (p[1] == 0)
				return (oldlc);
			if (p[1] < 128 && p[1] >= -128) {
				suboppr = subop = p[1];
				p++;
				n--;
				break;
			}
			goto longgen;
		case O_TRA4:
		case O_CALL:
		case O_FSAV:
		case O_GOTO:
		case O_NAM:
		case O_READE:
			/* absolute long addressing */
			p[1] -= HEADER_BYTES;
			goto longgen;
		case O_RV1:
		case O_RV14:
		case O_RV2:
		case O_RV24:
		case O_RV4:
		case O_RV8:
		case O_RV:
		case O_LV:
			if (p[1] < SHORTADDR && p[1] >= -SHORTADDR)
				break;
			else {
				op += O_LRV - O_RV;
				cp = otext[op];
			}
		case O_BEG:
		case O_NODUMP:
		case O_CON4:
		case O_CASE4:
		case O_RANG4:
		case O_RANG24:
		case O_RSNG4:
		case O_RSNG24:
		longgen:
		    {
			short	*sp = &p[1];
			long	*lp = &p[1];

			n = (n << 1) - 1;
			if ( op == O_LRV )
				n--;
#ifdef DEBUG
			if (opt('k'))
			    {
				printf( ")#%5d\t%s" , lc - HEADER_BYTES , cp+1 );
				if (suboppr)
					printf(":%1d", suboppr);
				for ( i = 1 ; i < n 
				    ; i += sizeof ( long )/sizeof ( short ) )
					printf( "\t%D " , *lp ++ );
				pchr ( '\n' );
			    }
#endif
			if ( op != O_CASE4 )
			    word ( op | subop<<8 );
			for ( i = 1 ; i < n ; i ++ )
			    word ( *sp ++ );
			return ( oldlc );
		    }
	}
#ifdef DEBUG
	if (opt('k')) {
		printf(")#%5d\t%s", lc - HEADER_BYTES, cp+1);
		if (suboppr)
			printf(":%d", suboppr);
		if (string)
			printf("\t%s",string);
		if (n > 1)
			pchr('\t');
		for (i=1; i<n; i++)
			printf("%d ", ( short ) p[i]);
		pchr('\n');
	}
#endif
	if (op != NIL)
		word(op | subop << 8);
	for (i=1; i<n; i++)
		word(p[i]);
	return (oldlc);
}
#endif OBJ
\f
/*
 * listnames outputs a list of enumerated type names which
 * can then be selected from to output a TSCAL
 * a pointer to the address in the code of the namelist
 * is kept in value[ NL_ELABEL ].
 */
listnames(ap)

	register struct nl *ap;
{
	struct nl *next;
	register int oldlc, len;
	register unsigned w;
	register char *strptr;

	if (cgenflg < 0)
		/* code is off - do nothing */
		return(NIL);
	if (ap->class != TYPE)
		ap = ap->type;
	if (ap->value[ NL_ELABEL ] != 0) {
		/* the list already exists */
		return( ap -> value[ NL_ELABEL ] );
	}
#	ifdef OBJ
	    oldlc = lc;
	    put(2, O_TRA, lc);
	    ap->value[ NL_ELABEL ] = lc;
#	endif OBJ
#	ifdef PC
	    putprintf( "	.data" , 0 );
	    putprintf( "	.align 1" , 0 );
	    ap -> value[ NL_ELABEL ] = getlab();
	    putlab( ap -> value[ NL_ELABEL ] );
#	endif PC
	/* number of scalars */
	next = ap->type;
	len = next->range[1]-next->range[0]+1;
#	ifdef OBJ
	    put(2, O_CASE2, len);
#	endif OBJ
#	ifdef PC
	    putprintf( "	.word %d" , 0 , len );
#	endif PC
	/* offsets of each scalar name */
	len = (len+1)*sizeof(short);
#	ifdef OBJ
	    put(2, O_CASE2, len);
#	endif OBJ
#	ifdef PC
	    putprintf( "	.word %d" , 0 , len );
#	endif PC
	next = ap->chain;
	do	{
		for(strptr = next->symbol;  *strptr++;  len++)
			continue;
		len++;
#		ifdef OBJ
		    put(2, O_CASE2, len);
#		endif OBJ
#		ifdef PC
		    putprintf( "	.word %d" , 0 , len );
#		endif PC
	} while (next = next->chain);
	/* list of scalar names */
	strptr = getnext(ap, &next);
#	ifdef OBJ
	    do	{
		    w = (unsigned) *strptr;
		    if (!*strptr++)
			    strptr = getnext(next, &next);
		    w |= *strptr << 8;
		    if (!*strptr++)
			    strptr = getnext(next, &next);
		    word(w);
	    } while (next);
	    /* jump over the mess */
	    patch(oldlc);
#	endif OBJ
#	ifdef PC
	    while ( next ) {
		while ( *strptr ) {
		    putprintf( "	.byte	0%o" , 1 , *strptr++ );
		    for ( w = 2 ; ( w <= 8 ) && *strptr ; w ++ ) {
			putprintf( ",0%o" , 1 , *strptr++ );
		    }
		    putprintf( "" , 0 );
		}
		putprintf( "	.byte	0" , 0 );
		strptr = getnext( next , &next );
	    }
	    putprintf( "	.text" , 0 );
#	endif PC
	return( ap -> value[ NL_ELABEL ] );
}

getnext(next, new)

	struct nl *next, **new;
{
	if (next != NIL) {
		next = next->chain;
		*new = next;
	}
	if (next == NIL)
		return("");
#ifdef OBJ
	if (opt('k') && cgenflg >= 0)
		printf(")#%5d\t\t\"%s\"\n", lc-HEADER_BYTES, next->symbol);
#endif
	return(next->symbol);
}
\f
#ifdef OBJ
/*
 * Putspace puts out a table
 * of nothing to leave space
 * for the case branch table e.g.
 */
putspace(n)
	int n;
{
	register i;

	if (cgenflg < 0)
		/*
		 * code disabled - do nothing
		 */
		return(lc);
#ifdef DEBUG
	if (opt('k'))
		printf(")#%5d\t.=.+%d\n", lc - HEADER_BYTES, n);
#endif
	for (i = even(n); i > 0; i -= 2)
		word(0);
}

putstr(sptr, padding)

	char *sptr;
	int padding;
{
	register unsigned short w;
	register char *strptr = sptr;
	register int pad = padding;

	if (cgenflg < 0)
		/*
		 * code disabled - do nothing
		 */
		return(lc);
#ifdef DEBUG
	if (opt('k'))
		printf(")#%5D\t\t\"%s\"\n", lc-HEADER_BYTES, strptr);
#endif
	if (pad == 0) {
		do	{
			w = (unsigned short) * strptr;
			if (w)
				w |= *++strptr << 8;
			word(w);
		} while (*strptr++);
	} else {
		do 	{
			w = (unsigned short) * strptr;
			if (w) {
				if (*++strptr)
					w |= *strptr << 8;
				else {
					w |= ' ' << 8;
					pad--;
				}
				word(w);
			}
		} while (*strptr++);
		while (pad > 1) {
			word('  ');
			pad -= 2;
		}
		if (pad == 1)
			word(' ');
		else
			word(0);
	}
}
#endif OBJ

lenstr(sptr, padding)

	char *sptr;
	int padding;

{
	register int cnt;
	register char *strptr = sptr;

	cnt = padding;
	do	{
		cnt++;
	} while (*strptr++);
	return((++cnt) & ~1);
}
\f
/*
 * Patch repairs the branch
 * at location loc to come
 * to the current location.
 *	for PC, this puts down the label
 *	and the branch just references that label.
 *	lets here it for two pass assemblers.
 */
patch(loc)
{

#	ifdef OBJ
	    patchfil(loc, lc-loc-2, 1);
#	endif OBJ
#	ifdef PC
	    putlab( loc );
#	endif PC
}

#ifdef OBJ
patch4(loc)
{

	patchfil(loc, lc - HEADER_BYTES, 2);
}

/*
 * Patchfil makes loc+2 have value
 * as its contents.
 */
patchfil(loc, value, words)
	PTR_DCL loc;
	int value, words;
{
	register i;

	if (cgenflg < 0)
		return;
	if (loc > (unsigned) lc)
		panic("patchfil");
#ifdef DEBUG
	if (opt('k'))
		printf(")#\tpatch %u %d\n", loc - HEADER_BYTES, value);
#endif
	do {
		i = ((unsigned) loc + 2 - ((unsigned) lc & ~01777))/2;
		if (i >= 0 && i < 1024)
			obuf[i] = value;
		else {
			lseek(ofil, (long) loc+2, 0);
			write(ofil, &value, 2);
			lseek(ofil, (long) 0, 2);
		}
		loc += 2;
		value = value >> 16;
	} while (--words);
}
\f
/*
 * Put the word o into the code
 */
word(o)
	int o;
{

	*obufp = o;
	obufp++;
	lc += 2;
	if (obufp >= obuf+512)
		pflush();
}

extern char	*obj;
/*
 * Flush the code buffer
 */
pflush()
{
	register i;

	i = (obufp - ( ( short * ) obuf ) ) * 2;
	if (i != 0 && write(ofil, obuf, i) != i)
		perror(obj), pexit(DIED);
	obufp = obuf;
}
#endif OBJ

/*
 * Getlab - returns the location counter.
 * included here for the eventual code generator.
 *	for PC, thank you!
 */
getlab()
{
#	ifdef OBJ

	    return (lc);
#	endif OBJ
#	ifdef PC
	    static long	lastlabel;

	    return ( ++lastlabel );
#	endif PC
}

/*
 * Putlab - lay down a label.
 *	for PC, just print the label name with a colon after it.
 */
putlab(l)
	int l;
{

#	ifdef PC
	    putprintf( PREFIXFORMAT , 1 , LABELPREFIX , l );
	    putprintf( ":" , 0 );
#	endif PC
	return (l);
}
Commit	Line	Data
74e161b0 PK	1	/* Copyright (c) 1979 Regents of the University of California */
74e161b0 PK	2
31cef89c	3	static char sccsid[] = "@(#)put.c 1.3 10/2/80";
74e161b0 PK	4
	5	#include "whoami.h"
	6	#include "opcode.h"
	7	#include "0.h"
	8	#include "objfmt.h"
	9	#ifdef PC
	10	# include "pc.h"
	11	#endif PC
	12
	13	short *obufp = obuf;
	14
	15	/*
	16	* If DEBUG is defined, include the table
	17	* of the printing opcode names.
	18	*/
	19	#ifdef DEBUG
	20	#include "OPnames.h"
	21	#endif
	22
	23	#ifdef OBJ
	24	/*
	25	* Put is responsible for the interpreter equivalent of code
	26	* generation. Since the interpreter is specifically designed
	27	* for Pascal, little work is required here.
	28	*/
	29	put(a)
	30	{
	31	register int *p, i;
	32	register char *cp;
	33	int n, subop, suboppr, op, oldlc, w;
	34	char *string;
	35	static int casewrd;
	36
	37	/*
	38	* It would be nice to do some more
	39	* optimizations here. The work
	40	* done to collapse offsets in lval
	41	* should be done here, the IFEQ etc
	42	* relational operators could be used
	43	* etc.
	44	*/
	45	oldlc = lc;
	46	if (cgenflg < 0)
	47	/*
	48	* code disabled - do nothing
	49	*/
	50	return (oldlc);
	51	p = &a;
	52	n = *p++;
	53	suboppr = subop = (*p>>8) & 0377;
	54	op = *p & 0377;
	55	string = 0;
	56	#ifdef DEBUG
	57	if ((cp = otext[op]) == NIL) {
	58	printf("op= %o\n", op);
	59	panic("put");
	60	}
	61	#endif
	62	switch (op) {
	63	case O_ABORT:
	64	cp = "*";
	65	break;
	66	case O_LINO:
	67	/*****
68	if (line == codeline)
69	return (oldlc);
70	codeline = line;
71	*****/
72	case O_NEW:
73	case O_DISPOSE:
74	case O_AS:
75	case O_IND:
76	case O_LVCON:
77	case O_CON:
78	case O_OFF:
79	case O_INX2:
80	case O_INX4:
81	case O_CARD:
82	case O_ADDT:
83	case O_SUBT:
84	case O_MULT:
85	case O_IN:
86	case O_CASE1OP:
87	case O_CASE2OP:
88	case O_CASE4OP:
c4e911b6	89	case O_FRTN:
74e161b0 PK	90	case O_WRITES:
	91	case O_WRITEF:
	92	case O_MAX:
	93	case O_MIN:
	94	case O_PACK:
	95	case O_UNPACK:
	96	case O_ARGV:
	97	case O_CTTOT:
	98	case O_INCT:
	99	case O_RANG2:
	100	case O_RSNG2:
	101	case O_RANG42:
	102	case O_RSNG42:
	103	if (p[1] == 0)
	104	break;
	105	case O_CON2:
	106	case O_CON24:
	107	if (p[1] < 128 && p[1] >= -128) {
	108	suboppr = subop = p[1];
	109	p++;
	110	n--;
	111	if (op == O_CON2) {
	112	op = O_CON1;
	113	cp = otext[O_CON1];
	114	}
	115	if (op == O_CON24) {
	116	op = O_CON14;
	117	cp = otext[O_CON14];
	118	}
	119	}
	120	break;
	121	case O_CON8:
	122	{
	123	short *sp = &p[1];
	124
	125	#ifdef DEBUG
	126	if ( opt( 'k' ) )
	127	printf ( ")#%5d\tCON8\t%10.3f\n" ,
	128	lc - HEADER_BYTES ,
	129	* ( ( double * ) &p[1] ) );
	130	#endif
	131	word ( op );
	132	for ( i = 1 ; i <= 4 ; i ++ )
	133	word ( *sp ++ );
	134	return ( oldlc );
	135	}
	136	default:
	137	if (op >= O_REL2 && op <= O_REL84) {
	138	if ((i = (subop >> 1) * 5 ) >= 30)
	139	i -= 30;
	140	else
	141	i += 2;
	142	#ifdef DEBUG
	143	string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i];
	144	#endif
	145	suboppr = 0;
	146	}
	147	break;
	148	case O_IF:
	149	case O_TRA:
	150	/*****
	151	codeline = 0;
	152	*****/
	153	case O_FOR1U:
154	case O_FOR2U:
155	case O_FOR4U:
156	case O_FOR1D:
157	case O_FOR2D:
158	case O_FOR4D:
159	/* relative addressing */
160	p[1] -= ( unsigned ) lc + 2;
161	break;
162	case O_CONG:
163	i = p[1];
164	cp = * ( ( char ** ) &p[2] ) ;
165	#ifdef DEBUG
166	if (opt('k'))
167	printf(")#%5d\tCONG:%d\t%s\n",
168	lc - HEADER_BYTES, i, cp);
169	#endif
170	if (i <= 127)
171	word(O_CON \| i << 8);
172	else {
173	word(O_CON);
174	word(i);
175	}
176	while (i > 0) {
177	w = cp ? cp++ : ' ';
178	w \|= (cp ? cp++ : ' ') << 8;
179	word(w);
180	i -= 2;
181	}
182	return (oldlc);
183	case O_CONC:
184	#ifdef DEBUG
185	(string = "'x'")[1] = p[1];
186	#endif
187	suboppr = 0;
188	op = O_CON1;
189	cp = otext[O_CON1];
190	subop = p[1];
191	goto around;
192	case O_CONC4:
193	#ifdef DEBUG
194	(string = "'x'")[1] = p[1];
195	#endif
196	suboppr = 0;
197	op = O_CON14;
198	subop = p[1];
199	goto around;
200	case O_CON1:
201	case O_CON14:
202	suboppr = subop = p[1];
203	around:
204	n--;
205	break;
206	case O_CASEBEG:
207	casewrd = 0;
208	return (oldlc);
209	case O_CASEEND:
210	if ((unsigned) lc & 1) {
211	lc--;
212	word(casewrd);
213	}
214	return (oldlc);
215	case O_CASE1:
216	#ifdef DEBUG
217	if (opt('k'))
218	printf(")#%5d\tCASE1\t%d\n"
219	, lc - HEADER_BYTES
220	, ( int ) ( ( long ) &p[1] ) );
221	#endif
222	/*
223	* this to build a byte size case table
224	* saving bytes across calls in casewrd
225	* so they can be put out by word()
226	*/
227	lc++;
228	if ((unsigned) lc & 1)
40fc1934	229	casewrd = ( ( long ) &p[1] ) & 0377;
74e161b0 PK	230	else {
	231	lc -= 2;
	232	word ( casewrd
	233	\| ( ( int ) ( ( long ) &p[1] ) << 8 ) );
	234	}
	235	return (oldlc);
	236	case O_CASE2:
	237	#ifdef DEBUG
	238	if (opt('k'))
	239	printf(")#%5d\tCASE2\t%d\n"
	240	, lc - HEADER_BYTES
	241	, ( int ) ( ( long ) &p[1] ) );
	242	#endif
	243	word( ( short ) ( ( long ) &p[1] ) );
	244	return (oldlc);
c4e911b6 PK	245	case O_FCALL:
	246	if (p[1] == 0)
	247	goto longgen;
	248	/* and fall through */
74e161b0 PK	249	case O_PUSH:
	250	if (p[1] == 0)
	251	return (oldlc);
	252	if (p[1] < 128 && p[1] >= -128) {
	253	suboppr = subop = p[1];
	254	p++;
	255	n--;
	256	break;
	257	}
	258	goto longgen;
	259	case O_TRA4:
	260	case O_CALL:
c4e911b6	261	case O_FSAV:
74e161b0	262	case O_GOTO:
74e161b0 PK	263	case O_NAM:
	264	case O_READE:
	265	/* absolute long addressing */
	266	p[1] -= HEADER_BYTES;
	267	goto longgen;
	268	case O_RV1:
	269	case O_RV14:
	270	case O_RV2:
	271	case O_RV24:
	272	case O_RV4:
	273	case O_RV8:
	274	case O_RV:
	275	case O_LV:
	276	if (p[1] < SHORTADDR && p[1] >= -SHORTADDR)
	277	break;
	278	else {
	279	op += O_LRV - O_RV;
	280	cp = otext[op];
	281	}
	282	case O_BEG:
	283	case O_NODUMP:
	284	case O_CON4:
	285	case O_CASE4:
	286	case O_RANG4:
	287	case O_RANG24:
	288	case O_RSNG4:
	289	case O_RSNG24:
	290	longgen:
	291	{
	292	short *sp = &p[1];
	293	long *lp = &p[1];
	294
	295	n = (n << 1) - 1;
	296	if ( op == O_LRV )
	297	n--;
	298	#ifdef DEBUG
	299	if (opt('k'))
	300	{
	301	printf( ")#%5d\t%s" , lc - HEADER_BYTES , cp+1 );
	302	if (suboppr)
	303	printf(":%1d", suboppr);
	304	for ( i = 1 ; i < n
	305	; i += sizeof ( long )/sizeof ( short ) )
	306	printf( "\t%D " , *lp ++ );
	307	pchr ( '\n' );
	308	}
	309	#endif
	310	if ( op != O_CASE4 )
	311	word ( op \| subop<<8 );
	312	for ( i = 1 ; i < n ; i ++ )
	313	word ( *sp ++ );
	314	return ( oldlc );
	315	}
	316	}
	317	#ifdef DEBUG
	318	if (opt('k')) {
	319	printf(")#%5d\t%s", lc - HEADER_BYTES, cp+1);
	320	if (suboppr)
	321	printf(":%d", suboppr);
	322	if (string)
	323	printf("\t%s",string);
	324	if (n > 1)
	325	pchr('\t');
	326	for (i=1; i<n; i++)
327	printf("%d ", ( short ) p[i]);
328	pchr('\n');
329	}
330	#endif
331	if (op != NIL)
332	word(op \| subop << 8);
333	for (i=1; i<n; i++)
334	word(p[i]);
335	return (oldlc);
336	}
337	#endif OBJ
338	\f
339	/*
340	* listnames outputs a list of enumerated type names which
341	* can then be selected from to output a TSCAL
342	* a pointer to the address in the code of the namelist
343	* is kept in value[ NL_ELABEL ].
344	*/
345	listnames(ap)
346
347	register struct nl *ap;
348	{
349	struct nl *next;
350	register int oldlc, len;
351	register unsigned w;
352	register char *strptr;
353
354	if (cgenflg < 0)
355	/* code is off - do nothing */
356	return(NIL);
357	if (ap->class != TYPE)
358	ap = ap->type;
359	if (ap->value[ NL_ELABEL ] != 0) {
360	/* the list already exists */
361	return( ap -> value[ NL_ELABEL ] );
362	}
363	# ifdef OBJ
364	oldlc = lc;
365	put(2, O_TRA, lc);
366	ap->value[ NL_ELABEL ] = lc;
367	# endif OBJ
368	# ifdef PC
369	putprintf( " .data" , 0 );
370	putprintf( " .align 1" , 0 );
371	ap -> value[ NL_ELABEL ] = getlab();
372	putlab( ap -> value[ NL_ELABEL ] );
373	# endif PC
374	/* number of scalars */
375	next = ap->type;
376	len = next->range[1]-next->range[0]+1;
377	# ifdef OBJ
378	put(2, O_CASE2, len);
379	# endif OBJ
380	# ifdef PC
381	putprintf( " .word %d" , 0 , len );
382	# endif PC
383	/* offsets of each scalar name */
384	len = (len+1)*sizeof(short);
385	# ifdef OBJ
386	put(2, O_CASE2, len);
387	# endif OBJ
388	# ifdef PC
389	putprintf( " .word %d" , 0 , len );
390	# endif PC
391	next = ap->chain;
392	do {
393	for(strptr = next->symbol; *strptr++; len++)
394	continue;
395	len++;
396	# ifdef OBJ
397	put(2, O_CASE2, len);
398	# endif OBJ
399	# ifdef PC
400	putprintf( " .word %d" , 0 , len );
401	# endif PC
402	} while (next = next->chain);
403	/* list of scalar names */
404	strptr = getnext(ap, &next);
405	# ifdef OBJ
406	do {
407	w = (unsigned) *strptr;
408	if (!*strptr++)
409	strptr = getnext(next, &next);
410	w \|= *strptr << 8;
411	if (!*strptr++)
412	strptr = getnext(next, &next);
413	word(w);
414	} while (next);
415	/* jump over the mess */
416	patch(oldlc);
417	# endif OBJ
418	# ifdef PC
419	while ( next ) {
420	while ( *strptr ) {
421	putprintf( " .byte 0%o" , 1 , *strptr++ );
422	for ( w = 2 ; ( w <= 8 ) && *strptr ; w ++ ) {
423	putprintf( ",0%o" , 1 , *strptr++ );
424	}
425	putprintf( "" , 0 );
426	}
427	putprintf( " .byte 0" , 0 );
428	strptr = getnext( next , &next );
429	}
430	putprintf( " .text" , 0 );
431	# endif PC
432	return( ap -> value[ NL_ELABEL ] );
433	}
434
435	getnext(next, new)
436
437	struct nl next, *new;
438	{
439	if (next != NIL) {
440	next = next->chain;
441	*new = next;
442	}
443	if (next == NIL)
444	return("");
445	#ifdef OBJ
446	if (opt('k') && cgenflg >= 0)
447	printf(")#%5d\t\t\"%s\"\n", lc-HEADER_BYTES, next->symbol);
448	#endif
449	return(next->symbol);
450	}
451	\f
452	#ifdef OBJ
453	/*
454	* Putspace puts out a table
455	* of nothing to leave space
456	* for the case branch table e.g.
457	*/
458	putspace(n)
459	int n;
460	{
461	register i;
462
463	if (cgenflg < 0)
464	/*
465	* code disabled - do nothing
466	*/
467	return(lc);
468	#ifdef DEBUG
469	if (opt('k'))
470	printf(")#%5d\t.=.+%d\n", lc - HEADER_BYTES, n);
471	#endif
472	for (i = even(n); i > 0; i -= 2)
473	word(0);
474	}
475
476	putstr(sptr, padding)
477
478	char *sptr;
479	int padding;
480	{
481	register unsigned short w;
482	register char *strptr = sptr;
483	register int pad = padding;
484
485	if (cgenflg < 0)
486	/*
487	* code disabled - do nothing
488	*/
489	return(lc);
490	#ifdef DEBUG
491	if (opt('k'))
492	printf(")#%5D\t\t\"%s\"\n", lc-HEADER_BYTES, strptr);
493	#endif
494	if (pad == 0) {
495	do {
496	w = (unsigned short) * strptr;
497	if (w)
498	w \|= *++strptr << 8;
499	word(w);
500	} while (*strptr++);
501	} else {
502	do {
503	w = (unsigned short) * strptr;
504	if (w) {
505	if (*++strptr)
506	w \|= *strptr << 8;
507	else {
508	w \|= ' ' << 8;
509	pad--;
510	}
511	word(w);
512	}
513	} while (*strptr++);
514	while (pad > 1) {
515	word(' ');
516	pad -= 2;
517	}
518	if (pad == 1)
519	word(' ');
520	else
521	word(0);
522	}
523	}
524	#endif OBJ
525
526	lenstr(sptr, padding)
527
528	char *sptr;
529	int padding;
530
531	{
532	register int cnt;
533	register char *strptr = sptr;
534
535	cnt = padding;
536	do {
537	cnt++;
538	} while (*strptr++);
539	return((++cnt) & ~1);
540	}
541	\f
542	/*
543	* Patch repairs the branch
544	* at location loc to come
545	* to the current location.
546	* for PC, this puts down the label
547	* and the branch just references that label.
548	* lets here it for two pass assemblers.
549	*/
550	patch(loc)
551	{
552
553	# ifdef OBJ
554	patchfil(loc, lc-loc-2, 1);
555	# endif OBJ
556	# ifdef PC
557	putlab( loc );
558	# endif PC
559	}
560
561	#ifdef OBJ
562	patch4(loc)
563	{
564
565	patchfil(loc, lc - HEADER_BYTES, 2);
566	}
567
568	/*
569	* Patchfil makes loc+2 have value
570	* as its contents.
571	*/
572	patchfil(loc, value, words)
573	PTR_DCL loc;
574	int value, words;
575	{
576	register i;
577
578	if (cgenflg < 0)
579	return;
580	if (loc > (unsigned) lc)
581	panic("patchfil");
582	#ifdef DEBUG
583	if (opt('k'))
584	printf(")#\tpatch %u %d\n", loc - HEADER_BYTES, value);
585	#endif
586	do {
587	i = ((unsigned) loc + 2 - ((unsigned) lc & ~01777))/2;
588	if (i >= 0 && i < 1024)
589	obuf[i] = value;
590	else {
591	lseek(ofil, (long) loc+2, 0);
592	write(ofil, &value, 2);
593	lseek(ofil, (long) 0, 2);
594	}
595	loc += 2;
596	value = value >> 16;
597	} while (--words);
598	}
599	\f
600	/*
601	* Put the word o into the code
602	*/
603	word(o)
604	int o;
605	{
606
607	*obufp = o;
608	obufp++;
609	lc += 2;
610	if (obufp >= obuf+512)
611	pflush();
612	}
613
614	extern char *obj;
615	/*
616	* Flush the code buffer
617	*/
618	pflush()
619	{
620	register i;
621
622	i = (obufp - ( ( short * ) obuf ) ) * 2;
623	if (i != 0 && write(ofil, obuf, i) != i)
624	perror(obj), pexit(DIED);
625	obufp = obuf;
626	}
627	#endif OBJ
628
629	/*
630	* Getlab - returns the location counter.
631	* included here for the eventual code generator.
632	* for PC, thank you!
633	*/
634	getlab()
635	{
636	# ifdef OBJ
637
638	return (lc);
639	# endif OBJ
640	# ifdef PC
641	static long lastlabel;
642
643	return ( ++lastlabel );
644	# endif PC
645	}
646
647	/*
648	* Putlab - lay down a label.
649	* for PC, just print the label name with a colon after it.
650	*/
651	putlab(l)
652	int l;
653	{
654
655	# ifdef PC
656	putprintf( PREFIXFORMAT , 1 , LABELPREFIX , l );
657	putprintf( ":" , 0 );
658	# endif PC
659	return (l);
660	}
661