xref: /csrg-svn/usr.bin/pascal/src/put.c (revision 36536)
123528Smckusick /*
223528Smckusick  * Copyright (c) 1980 Regents of the University of California.
323528Smckusick  * All rights reserved.  The Berkeley software License Agreement
423528Smckusick  * specifies the terms and conditions for redistribution.
523528Smckusick  */
6769Speter 
715208Sthien #ifndef lint
8*36536Smckusick static char sccsid[] = "@(#)put.c	5.3 (Berkeley) 01/09/89";
923528Smckusick #endif not lint
10769Speter 
11769Speter #include "whoami.h"
12769Speter #include "opcode.h"
13769Speter #include "0.h"
14769Speter #include "objfmt.h"
15769Speter #ifdef PC
16769Speter #   include	"pc.h"
1710656Speter #   include	"align.h"
1815208Sthien #else
1915208Sthien     short	*obufp	= obuf;
2015208Sthien #endif
21769Speter 
22769Speter /*
23769Speter  * If DEBUG is defined, include the table
24769Speter  * of the printing opcode names.
25769Speter  */
26769Speter #ifdef DEBUG
27769Speter #include "OPnames.h"
28769Speter #endif
29769Speter 
30*36536Smckusick char showit[] = "'x'";
31*36536Smckusick 
32769Speter #ifdef OBJ
33769Speter /*
34769Speter  * Put is responsible for the interpreter equivalent of code
35769Speter  * generation.  Since the interpreter is specifically designed
36769Speter  * for Pascal, little work is required here.
37*36536Smckusick  *
38*36536Smckusick  * FIXME, this should be converted to use <varargs.h> or <stdarg.h>.
39769Speter  */
4015208Sthien /*VARARGS*/
41769Speter put(a)
42769Speter {
43769Speter 	register int *p, i;
44769Speter 	register char *cp;
453077Smckusic 	register short *sp;
463077Smckusic 	register long *lp;
4715208Sthien 	int n, subop, suboppr, op, oldlc;
48769Speter 	char *string;
49769Speter 	static int casewrd;
50769Speter 
51769Speter 	/*
52769Speter 	 * It would be nice to do some more
53769Speter 	 * optimizations here.  The work
54769Speter 	 * done to collapse offsets in lval
55769Speter 	 * should be done here, the IFEQ etc
56769Speter 	 * relational operators could be used
57769Speter 	 * etc.
58769Speter 	 */
5915208Sthien 	oldlc = (int) lc; /* its either this or change put to return a char * */
603317Speter 	if ( !CGENNING )
61769Speter 		/*
62769Speter 		 * code disabled - do nothing
63769Speter 		 */
64769Speter 		return (oldlc);
65769Speter 	p = &a;
66769Speter 	n = *p++;
673077Smckusic 	suboppr = subop = (*p >> 8) & 0377;
68769Speter 	op = *p & 0377;
69769Speter 	string = 0;
70769Speter #ifdef DEBUG
71769Speter 	if ((cp = otext[op]) == NIL) {
72769Speter 		printf("op= %o\n", op);
73769Speter 		panic("put");
74769Speter 	}
75769Speter #endif
76769Speter 	switch (op) {
77769Speter 		case O_ABORT:
78769Speter 			cp = "*";
79769Speter 			break;
802221Smckusic 		case O_AS:
812221Smckusic 			switch(p[1]) {
826594Smckusick 			case 0:
836594Smckusick 				break;
842221Smckusic 			case 2:
852221Smckusic 				op = O_AS2;
866594Smckusick 				n = 1;
872221Smckusic 				break;
882221Smckusic 			case 4:
892221Smckusic 				op = O_AS4;
906594Smckusick 				n = 1;
912221Smckusic 				break;
922221Smckusic 			case 8:
932221Smckusic 				op = O_AS8;
946594Smckusick 				n = 1;
952221Smckusic 				break;
962221Smckusic 			default:
972221Smckusic 				goto pack;
982221Smckusic 			}
993077Smckusic #			ifdef DEBUG
1003077Smckusic 				cp = otext[op];
1013077Smckusic #			endif DEBUG
1022221Smckusic 			break;
10310791Smckusick 		case O_FOR1U:
10410791Smckusick 		case O_FOR2U:
10510791Smckusick 		case O_FOR4U:
10610791Smckusick 		case O_FOR1D:
10710791Smckusick 		case O_FOR2D:
10810791Smckusick 		case O_FOR4D:
10910791Smckusick 			/* relative addressing */
11010791Smckusick 			p[1] -= ( unsigned ) lc + sizeof(short);
11110791Smckusick 			/* try to pack the jump */
11210791Smckusick 			if (p[1] <= 127 && p[1] >= -128) {
11310791Smckusick 				suboppr = subop = p[1];
11410791Smckusick 				p++;
11510791Smckusick 				n--;
11610791Smckusick 			} else {
11710791Smckusick 				/* have to allow for extra displacement */
11810791Smckusick 				p[1] -= sizeof(short);
11910791Smckusick 			}
12010791Smckusick 			break;
1213077Smckusic 		case O_CONG:
1223077Smckusic 		case O_LVCON:
1233077Smckusic 		case O_CON:
124769Speter 		case O_LINO:
125769Speter 		case O_NEW:
126769Speter 		case O_DISPOSE:
1277965Smckusick 		case O_DFDISP:
128769Speter 		case O_IND:
129769Speter 		case O_OFF:
130769Speter 		case O_INX2:
131769Speter 		case O_INX4:
132769Speter 		case O_CARD:
133769Speter 		case O_ADDT:
134769Speter 		case O_SUBT:
135769Speter 		case O_MULT:
136769Speter 		case O_IN:
137769Speter 		case O_CASE1OP:
138769Speter 		case O_CASE2OP:
139769Speter 		case O_CASE4OP:
1401199Speter 		case O_FRTN:
141769Speter 		case O_WRITES:
1423173Smckusic 		case O_WRITEC:
143769Speter 		case O_WRITEF:
144769Speter 		case O_MAX:
145769Speter 		case O_MIN:
146769Speter 		case O_ARGV:
147769Speter 		case O_CTTOT:
148769Speter 		case O_INCT:
149769Speter 		case O_RANG2:
150769Speter 		case O_RSNG2:
151769Speter 		case O_RANG42:
152769Speter 		case O_RSNG42:
1532105Smckusic 		case O_SUCC2:
1542105Smckusic 		case O_SUCC24:
1552105Smckusic 		case O_PRED2:
1562105Smckusic 		case O_PRED24:
157769Speter 			if (p[1] == 0)
158769Speter 				break;
159769Speter 		case O_CON2:
160769Speter 		case O_CON24:
1612221Smckusic 		pack:
16210791Smckusick 			if (p[1] <= 127 && p[1] >= -128) {
163769Speter 				suboppr = subop = p[1];
164769Speter 				p++;
165769Speter 				n--;
166769Speter 				if (op == O_CON2) {
167769Speter 					op = O_CON1;
1683077Smckusic #					ifdef DEBUG
1693077Smckusic 						cp = otext[O_CON1];
1703077Smckusic #					endif DEBUG
171769Speter 				}
172769Speter 				if (op == O_CON24) {
173769Speter 					op = O_CON14;
1743077Smckusic #					ifdef DEBUG
1753077Smckusic 						cp = otext[O_CON14];
1763077Smckusic #					endif DEBUG
177769Speter 				}
178769Speter 			}
179769Speter 			break;
180769Speter 		case O_CON8:
181769Speter 		    {
18215208Sthien 			short	*sp = (short *) (&p[1]);
183769Speter 
184769Speter #ifdef	DEBUG
185769Speter 			if ( opt( 'k' ) )
1863317Speter 			    printf ( "%5d\tCON8\t%22.14e\n" ,
187769Speter 					lc - HEADER_BYTES ,
188769Speter 					* ( ( double * ) &p[1] ) );
189769Speter #endif
1903077Smckusic #			ifdef DEC11
1913077Smckusic 			    word(op);
1923077Smckusic #			else
1933077Smckusic 			    word(op << 8);
1943077Smckusic #			endif DEC11
195769Speter 			for ( i = 1 ; i <= 4 ; i ++ )
196769Speter 			    word ( *sp ++ );
197769Speter 			return ( oldlc );
198769Speter 		    }
199769Speter 		default:
200769Speter 			if (op >= O_REL2 && op <= O_REL84) {
2011883Smckusic 				if ((i = (subop >> INDX) * 5 ) >= 30)
202769Speter 					i -= 30;
203769Speter 				else
204769Speter 					i += 2;
205769Speter #ifdef DEBUG
206769Speter 				string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i];
207769Speter #endif
208769Speter 				suboppr = 0;
209769Speter 			}
210769Speter 			break;
211769Speter 		case O_IF:
212769Speter 		case O_TRA:
213769Speter /*****
214769Speter 			codeline = 0;
215769Speter *****/
2162184Smckusic 			/* relative addressing */
2172184Smckusic 			p[1] -= ( unsigned ) lc + sizeof(short);
2182184Smckusic 			break;
219769Speter 		case O_CONC:
220769Speter #ifdef DEBUG
221*36536Smckusick 			(string = showit)[1] = p[1];
222769Speter #endif
223769Speter 			suboppr = 0;
224769Speter 			op = O_CON1;
2253077Smckusic #			ifdef DEBUG
2263077Smckusic 				cp = otext[O_CON1];
2273077Smckusic #			endif DEBUG
228769Speter 			subop = p[1];
229769Speter 			goto around;
230769Speter 		case O_CONC4:
231769Speter #ifdef DEBUG
232*36536Smckusick 			(string = showit)[1] = p[1];
233769Speter #endif
234769Speter 			suboppr = 0;
235769Speter 			op = O_CON14;
236769Speter 			subop = p[1];
237769Speter 			goto around;
238769Speter 		case O_CON1:
239769Speter 		case O_CON14:
240769Speter 			suboppr = subop = p[1];
241769Speter around:
242769Speter 			n--;
243769Speter 			break;
244769Speter 		case O_CASEBEG:
245769Speter 			casewrd = 0;
246769Speter 			return (oldlc);
247769Speter 		case O_CASEEND:
248769Speter 			if ((unsigned) lc & 1) {
249769Speter 				lc--;
250769Speter 				word(casewrd);
251769Speter 			}
252769Speter 			return (oldlc);
253769Speter 		case O_CASE1:
254769Speter #ifdef DEBUG
255769Speter 			if (opt('k'))
2563317Speter 				printf("%5d\tCASE1\t%d\n"
2573077Smckusic 					, lc - HEADER_BYTES, p[1]);
258769Speter #endif
259769Speter 			/*
260769Speter 			 * this to build a byte size case table
261769Speter 			 * saving bytes across calls in casewrd
262769Speter 			 * so they can be put out by word()
263769Speter 			 */
264769Speter 			lc++;
265769Speter 			if ((unsigned) lc & 1)
2663077Smckusic #				ifdef DEC11
2673077Smckusic 				    casewrd = p[1] & 0377;
2683077Smckusic #				else
2693077Smckusic 				    casewrd = (p[1] & 0377) << 8;
2703077Smckusic #				endif DEC11
271769Speter 			else {
272769Speter 				lc -= 2;
2733077Smckusic #				ifdef DEC11
2743077Smckusic 				    word(((p[1] & 0377) << 8) | casewrd);
2753077Smckusic #				else
2763077Smckusic 				    word((p[1] & 0377) | casewrd);
2773077Smckusic #				endif DEC11
278769Speter 			}
279769Speter 			return (oldlc);
280769Speter 		case O_CASE2:
281769Speter #ifdef DEBUG
282769Speter 			if (opt('k'))
2833317Speter 				printf("%5d\tCASE2\t%d\n"
2843077Smckusic 					, lc - HEADER_BYTES , p[1]);
285769Speter #endif
2863077Smckusic 			word(p[1]);
287769Speter 			return (oldlc);
288769Speter 		case O_PUSH:
2893077Smckusic 			lp = (long *)&p[1];
2903077Smckusic 			if (*lp == 0)
291769Speter 				return (oldlc);
2924025Smckusic 			/* and fall through */
2934025Smckusic 		case O_RANG4:
2944025Smckusic 		case O_RANG24:
2954025Smckusic 		case O_RSNG4:
2964025Smckusic 		case O_RSNG24:
2974025Smckusic 		case O_SUCC4:
2984025Smckusic 		case O_PRED4:
2994025Smckusic 			/* sub opcode optimization */
3004025Smckusic 			lp = (long *)&p[1];
3014025Smckusic 			if (*lp < 128 && *lp >= -128 && *lp != 0) {
3023077Smckusic 				suboppr = subop = *lp;
3034025Smckusic 				p += (sizeof(long) / sizeof(int));
304769Speter 				n--;
305769Speter 			}
306769Speter 			goto longgen;
307769Speter 		case O_TRA4:
308769Speter 		case O_CALL:
3091199Speter 		case O_FSAV:
310769Speter 		case O_GOTO:
311769Speter 		case O_NAM:
312769Speter 		case O_READE:
313769Speter 			/* absolute long addressing */
3143077Smckusic 			lp = (long *)&p[1];
3153077Smckusic 			*lp -= HEADER_BYTES;
316769Speter 			goto longgen;
317769Speter 		case O_RV1:
318769Speter 		case O_RV14:
319769Speter 		case O_RV2:
320769Speter 		case O_RV24:
321769Speter 		case O_RV4:
322769Speter 		case O_RV8:
323769Speter 		case O_RV:
324769Speter 		case O_LV:
3252105Smckusic 			/*
3262105Smckusic 			 * positive offsets represent arguments
3272105Smckusic 			 * and must use "ap" display entry rather
3282105Smckusic 			 * than the "fp" entry
3292105Smckusic 			 */
3302105Smckusic 			if (p[1] >= 0) {
3312105Smckusic 				subop++;
3322105Smckusic 				suboppr++;
3332105Smckusic 			}
3343077Smckusic #			ifdef PDP11
3353077Smckusic 			    break;
3363077Smckusic #			else
3373077Smckusic 			    /*
3383077Smckusic 			     * offsets out of range of word addressing
3393077Smckusic 			     * must use long offset opcodes
3403077Smckusic 			     */
3413077Smckusic 			    if (p[1] < SHORTADDR && p[1] >= -SHORTADDR)
3423077Smckusic 				    break;
3433077Smckusic 			    else {
344769Speter 				op += O_LRV - O_RV;
3453077Smckusic #				ifdef DEBUG
3463077Smckusic 				    cp = otext[op];
3473077Smckusic #				endif DEBUG
3483077Smckusic 			    }
3493077Smckusic 			    /* and fall through */
3503077Smckusic #			endif PDP11
351769Speter 		case O_BEG:
352769Speter 		case O_NODUMP:
353769Speter 		case O_CON4:
354769Speter 		case O_CASE4:
355769Speter 		longgen:
356769Speter 			n = (n << 1) - 1;
35710791Smckusick 			if ( op == O_LRV ) {
358769Speter 				n--;
35910562Smckusick #				if defined(ADDR32) && !defined(DEC11)
36010562Smckusick 				    p[n / 2] <<= 16;
36110562Smckusick #				endif
36210562Smckusick 			}
363769Speter #ifdef DEBUG
3643077Smckusic 			if (opt('k')) {
3653317Speter 				printf("%5d\t%s", lc - HEADER_BYTES, cp+1);
366769Speter 				if (suboppr)
3673077Smckusic 					printf(":%d", suboppr);
3683077Smckusic 				for ( i = 2, lp = (long *)&p[1]; i < n
369769Speter 				    ; i += sizeof ( long )/sizeof ( short ) )
370769Speter 					printf( "\t%D " , *lp ++ );
3713377Speter 				if (i == n) {
3723377Speter 					sp = (short *)lp;
3733377Speter 					printf( "\t%d ", *sp );
3743377Speter 				}
375769Speter 				pchr ( '\n' );
3763077Smckusic 			}
377769Speter #endif
378769Speter 			if ( op != O_CASE4 )
3793077Smckusic #				ifdef DEC11
3803077Smckusic 			    	    word((op & 0377) | subop << 8);
3813077Smckusic #				else
3823077Smckusic 				    word(op << 8 | (subop & 0377));
3833077Smckusic #				endif DEC11
3843077Smckusic 			for ( i = 1, sp = (short *)&p[1]; i < n; i++)
3853077Smckusic 				word ( *sp ++ );
386769Speter 			return ( oldlc );
387769Speter 	}
388769Speter #ifdef DEBUG
389769Speter 	if (opt('k')) {
3903317Speter 		printf("%5d\t%s", lc - HEADER_BYTES, cp+1);
391769Speter 		if (suboppr)
392769Speter 			printf(":%d", suboppr);
393769Speter 		if (string)
394769Speter 			printf("\t%s",string);
395769Speter 		if (n > 1)
396769Speter 			pchr('\t');
397769Speter 		for (i=1; i<n; i++)
3983077Smckusic 			printf("%d ", p[i]);
399769Speter 		pchr('\n');
400769Speter 	}
401769Speter #endif
402769Speter 	if (op != NIL)
4033077Smckusic #		ifdef DEC11
4043077Smckusic 		    word((op & 0377) | subop << 8);
4053077Smckusic #		else
4063077Smckusic 		    word(op << 8 | (subop & 0377));
4073077Smckusic #		endif DEC11
408769Speter 	for (i=1; i<n; i++)
409769Speter 		word(p[i]);
410769Speter 	return (oldlc);
411769Speter }
412769Speter #endif OBJ
413769Speter 
414769Speter /*
415769Speter  * listnames outputs a list of enumerated type names which
416769Speter  * can then be selected from to output a TSCAL
417769Speter  * a pointer to the address in the code of the namelist
418769Speter  * is kept in value[ NL_ELABEL ].
419769Speter  */
420769Speter listnames(ap)
421769Speter 
422769Speter 	register struct nl *ap;
423769Speter {
424769Speter 	struct nl *next;
42515208Sthien #ifdef OBJ
42615208Sthien 	register int oldlc;
42715208Sthien #endif
42815208Sthien 	register int len;
429769Speter 	register unsigned w;
430769Speter 	register char *strptr;
431769Speter 
4323317Speter 	if ( !CGENNING )
433769Speter 		/* code is off - do nothing */
434769Speter 		return(NIL);
435769Speter 	if (ap->class != TYPE)
436769Speter 		ap = ap->type;
437769Speter 	if (ap->value[ NL_ELABEL ] != 0) {
438769Speter 		/* the list already exists */
439769Speter 		return( ap -> value[ NL_ELABEL ] );
440769Speter 	}
441769Speter #	ifdef OBJ
44215208Sthien 	    oldlc = (int) lc; /* same problem as put */
44315208Sthien 	    (void) put(2, O_TRA, lc);
44415208Sthien 	    ap->value[ NL_ELABEL ] = (int) lc;
445769Speter #	endif OBJ
446769Speter #	ifdef PC
44710656Speter 	    putprintf("	.data", 0);
44810656Speter 	    aligndot(A_STRUCT);
44915208Sthien 	    ap -> value[ NL_ELABEL ] = (int) getlab();
45015208Sthien 	    (void) putlab((char *) ap -> value[ NL_ELABEL ] );
451769Speter #	endif PC
452769Speter 	/* number of scalars */
453769Speter 	next = ap->type;
454769Speter 	len = next->range[1]-next->range[0]+1;
455769Speter #	ifdef OBJ
45615208Sthien 	    (void) put(2, O_CASE2, len);
457769Speter #	endif OBJ
458769Speter #	ifdef PC
459769Speter 	    putprintf( "	.word %d" , 0 , len );
460769Speter #	endif PC
461769Speter 	/* offsets of each scalar name */
462769Speter 	len = (len+1)*sizeof(short);
463769Speter #	ifdef OBJ
46415208Sthien 	    (void) put(2, O_CASE2, len);
465769Speter #	endif OBJ
466769Speter #	ifdef PC
467769Speter 	    putprintf( "	.word %d" , 0 , len );
468769Speter #	endif PC
469769Speter 	next = ap->chain;
470769Speter 	do	{
471769Speter 		for(strptr = next->symbol;  *strptr++;  len++)
472769Speter 			continue;
473769Speter 		len++;
474769Speter #		ifdef OBJ
47515208Sthien 		    (void) put(2, O_CASE2, len);
476769Speter #		endif OBJ
477769Speter #		ifdef PC
478769Speter 		    putprintf( "	.word %d" , 0 , len );
479769Speter #		endif PC
480769Speter 	} while (next = next->chain);
481769Speter 	/* list of scalar names */
482769Speter 	strptr = getnext(ap, &next);
483769Speter #	ifdef OBJ
484769Speter 	    do	{
4853077Smckusic #		    ifdef DEC11
4863077Smckusic 			w = (unsigned) *strptr;
4873077Smckusic #		    else
4883077Smckusic 			w = *strptr << 8;
4893077Smckusic #		    endif DEC11
490769Speter 		    if (!*strptr++)
491769Speter 			    strptr = getnext(next, &next);
4923077Smckusic #		    ifdef DEC11
4933077Smckusic 			w |= *strptr << 8;
4943077Smckusic #		    else
4953077Smckusic 			w |= (unsigned) *strptr;
4963077Smckusic #		    endif DEC11
497769Speter 		    if (!*strptr++)
498769Speter 			    strptr = getnext(next, &next);
49915208Sthien 		    word((int) w);
500769Speter 	    } while (next);
501769Speter 	    /* jump over the mess */
50215208Sthien 	    patch((PTR_DCL) oldlc);
503769Speter #	endif OBJ
504769Speter #	ifdef PC
505769Speter 	    while ( next ) {
506769Speter 		while ( *strptr ) {
507769Speter 		    putprintf( "	.byte	0%o" , 1 , *strptr++ );
508769Speter 		    for ( w = 2 ; ( w <= 8 ) && *strptr ; w ++ ) {
509769Speter 			putprintf( ",0%o" , 1 , *strptr++ );
510769Speter 		    }
511769Speter 		    putprintf( "" , 0 );
512769Speter 		}
513769Speter 		putprintf( "	.byte	0" , 0 );
514769Speter 		strptr = getnext( next , &next );
515769Speter 	    }
516769Speter 	    putprintf( "	.text" , 0 );
517769Speter #	endif PC
518769Speter 	return( ap -> value[ NL_ELABEL ] );
519769Speter }
520769Speter 
52115208Sthien char *
522769Speter getnext(next, new)
523769Speter 
524769Speter 	struct nl *next, **new;
525769Speter {
526769Speter 	if (next != NIL) {
527769Speter 		next = next->chain;
528769Speter 		*new = next;
529769Speter 	}
53015208Sthien 	if (next == NLNIL)
531769Speter 		return("");
532769Speter #ifdef OBJ
5333317Speter 	if (opt('k') && CGENNING )
5343317Speter 		printf("%5d\t\t\"%s\"\n", lc-HEADER_BYTES, next->symbol);
5352213Speter #endif OBJ
536769Speter 	return(next->symbol);
537769Speter }
538769Speter 
539769Speter #ifdef OBJ
540769Speter /*
541769Speter  * Putspace puts out a table
542769Speter  * of nothing to leave space
543769Speter  * for the case branch table e.g.
544769Speter  */
545769Speter putspace(n)
546769Speter 	int n;
547769Speter {
548769Speter 	register i;
549769Speter 
5503317Speter 	if ( !CGENNING )
551769Speter 		/*
552769Speter 		 * code disabled - do nothing
553769Speter 		 */
55415208Sthien 		return;
555769Speter #ifdef DEBUG
556769Speter 	if (opt('k'))
5573317Speter 		printf("%5d\t.=.+%d\n", lc - HEADER_BYTES, n);
558769Speter #endif
55930036Smckusick 	for (i = n; i > 0; i -= 2)
560769Speter 		word(0);
561769Speter }
562769Speter 
563769Speter putstr(sptr, padding)
564769Speter 
565769Speter 	char *sptr;
566769Speter 	int padding;
567769Speter {
568769Speter 	register unsigned short w;
569769Speter 	register char *strptr = sptr;
570769Speter 	register int pad = padding;
571769Speter 
5723317Speter 	if ( !CGENNING )
573769Speter 		/*
574769Speter 		 * code disabled - do nothing
575769Speter 		 */
57615208Sthien 		return;
577769Speter #ifdef DEBUG
578769Speter 	if (opt('k'))
5793317Speter 		printf("%5d\t\t\"%s\"\n", lc-HEADER_BYTES, strptr);
580769Speter #endif
581769Speter 	if (pad == 0) {
582769Speter 		do	{
5833077Smckusic #			ifdef DEC11
5843077Smckusic 			    w = (unsigned short) * strptr;
5853077Smckusic #			else
5863077Smckusic 			    w = (unsigned short)*strptr<<8;
5873077Smckusic #			endif DEC11
588769Speter 			if (w)
5893077Smckusic #				ifdef DEC11
5903077Smckusic 				    w |= *++strptr << 8;
5913077Smckusic #				else
5923077Smckusic 				    w |= *++strptr;
5933077Smckusic #				endif DEC11
59415208Sthien 			word((int) w);
595769Speter 		} while (*strptr++);
596769Speter 	} else {
5973077Smckusic #		ifdef DEC11
5983077Smckusic 		    do 	{
5993077Smckusic 			    w = (unsigned short) * strptr;
6003077Smckusic 			    if (w) {
6013077Smckusic 				    if (*++strptr)
6023077Smckusic 					    w |= *strptr << 8;
6033077Smckusic 				    else {
60411885Smckusick 					    w |= ' ' << 8;
6053077Smckusic 					    pad--;
6063077Smckusic 				    }
60715208Sthien 				    word((int) w);
6083077Smckusic 			    }
6093077Smckusic 		    } while (*strptr++);
6103077Smckusic #		else
6113077Smckusic 		    do 	{
6123077Smckusic 			    w = (unsigned short)*strptr<<8;
6133077Smckusic 			    if (w) {
6143077Smckusic 				    if (*++strptr)
6153077Smckusic 					    w |= *strptr;
6163077Smckusic 				    else {
6173077Smckusic 					    w |= ' ';
6183077Smckusic 					    pad--;
6193077Smckusic 				    }
6203077Smckusic 				    word(w);
6213077Smckusic 			    }
6223077Smckusic 		    } while (*strptr++);
6233077Smckusic #		endif DEC11
624769Speter 		while (pad > 1) {
62511885Smckusick #			ifdef DEC11
62611885Smckusick 			    word(' ' | (' ' << 8));
62711885Smckusick #			else
62811885Smckusick 			    word((' ' << 8) | ' ');
62911885Smckusick #			endif DEC11
630769Speter 			pad -= 2;
631769Speter 		}
632769Speter 		if (pad == 1)
6333077Smckusic #			ifdef DEC11
6343077Smckusic 			    word(' ');
6353077Smckusic #			else
63611885Smckusick 			    word(' ' << 8);
6373077Smckusic #			endif DEC11
638769Speter 		else
639769Speter 			word(0);
640769Speter 	}
641769Speter }
642769Speter #endif OBJ
643769Speter 
64415208Sthien #ifndef PC
645769Speter lenstr(sptr, padding)
646769Speter 
647769Speter 	char *sptr;
648769Speter 	int padding;
649769Speter 
650769Speter {
651769Speter 	register int cnt;
652769Speter 	register char *strptr = sptr;
653769Speter 
654769Speter 	cnt = padding;
655769Speter 	do	{
656769Speter 		cnt++;
657769Speter 	} while (*strptr++);
658769Speter 	return((++cnt) & ~1);
659769Speter }
66015208Sthien #endif
661769Speter 
662769Speter /*
663769Speter  * Patch repairs the branch
664769Speter  * at location loc to come
665769Speter  * to the current location.
666769Speter  *	for PC, this puts down the label
667769Speter  *	and the branch just references that label.
668769Speter  *	lets here it for two pass assemblers.
669769Speter  */
670769Speter patch(loc)
67115208Sthien     PTR_DCL loc;
672769Speter {
673769Speter 
674769Speter #	ifdef OBJ
6753077Smckusic 	    patchfil(loc, (long)(lc-loc-2), 1);
676769Speter #	endif OBJ
677769Speter #	ifdef PC
67815208Sthien 	    (void) putlab((char *) loc );
679769Speter #	endif PC
680769Speter }
681769Speter 
682769Speter #ifdef OBJ
683769Speter patch4(loc)
68415208Sthien PTR_DCL loc;
685769Speter {
6863077Smckusic 	patchfil(loc, (long)(lc - HEADER_BYTES), 2);
687769Speter }
688769Speter 
689769Speter /*
6907921Smckusick  * Patchfil makes loc+2 have jmploc
691769Speter  * as its contents.
692769Speter  */
6937921Smckusick patchfil(loc, jmploc, words)
694769Speter 	PTR_DCL loc;
6957921Smckusick 	long jmploc;
6963077Smckusic 	int words;
697769Speter {
698769Speter 	register i;
69915208Sthien 	extern long lseek();
70010562Smckusick 	short val;
701769Speter 
7023317Speter 	if ( !CGENNING )
703769Speter 		return;
704769Speter 	if (loc > (unsigned) lc)
705769Speter 		panic("patchfil");
706769Speter #ifdef DEBUG
707769Speter 	if (opt('k'))
7087921Smckusick 		printf("\tpatch %u %D\n", loc - HEADER_BYTES, jmploc);
709769Speter #endif
7107921Smckusick 	val = jmploc;
711769Speter 	do {
7123077Smckusic #		ifndef DEC11
7133077Smckusic 		    if (words > 1)
7147921Smckusick 			    val = jmploc >> 16;
7153077Smckusic 		    else
7167921Smckusick 			    val = jmploc;
7173077Smckusic #		endif DEC11
718769Speter 		i = ((unsigned) loc + 2 - ((unsigned) lc & ~01777))/2;
71910562Smckusick 		if (i >= 0 && i < 1024) {
7203077Smckusic 			obuf[i] = val;
72110562Smckusick 		} else {
72215208Sthien 			(void) lseek(ofil, (long) loc+2, 0);
72315208Sthien 			write(ofil, (char *) (&val), 2);
72415208Sthien 			(void) lseek(ofil, (long) 0, 2);
725769Speter 		}
726769Speter 		loc += 2;
7273077Smckusic #		ifdef DEC11
7287921Smckusick 		    val = jmploc >> 16;
7293077Smckusic #		endif DEC11
730769Speter 	} while (--words);
731769Speter }
732769Speter 
733769Speter /*
734769Speter  * Put the word o into the code
735769Speter  */
736769Speter word(o)
737769Speter 	int o;
738769Speter {
739769Speter 
740769Speter 	*obufp = o;
741769Speter 	obufp++;
742769Speter 	lc += 2;
743769Speter 	if (obufp >= obuf+512)
744769Speter 		pflush();
745769Speter }
746769Speter 
747769Speter extern char	*obj;
748769Speter /*
749769Speter  * Flush the code buffer
750769Speter  */
751769Speter pflush()
752769Speter {
753769Speter 	register i;
754769Speter 
755769Speter 	i = (obufp - ( ( short * ) obuf ) ) * 2;
75615208Sthien 	if (i != 0 && write(ofil, (char *) obuf, i) != i)
757769Speter 		perror(obj), pexit(DIED);
758769Speter 	obufp = obuf;
759769Speter }
760769Speter #endif OBJ
761769Speter 
762769Speter /*
763769Speter  * Getlab - returns the location counter.
764769Speter  * included here for the eventual code generator.
765769Speter  *	for PC, thank you!
766769Speter  */
76715208Sthien char *
768769Speter getlab()
769769Speter {
770769Speter #	ifdef OBJ
771769Speter 
772769Speter 	    return (lc);
773769Speter #	endif OBJ
774769Speter #	ifdef PC
775769Speter 	    static long	lastlabel;
776769Speter 
77715208Sthien 	    return ( (char *) ++lastlabel );
778769Speter #	endif PC
779769Speter }
780769Speter 
781769Speter /*
782769Speter  * Putlab - lay down a label.
783769Speter  *	for PC, just print the label name with a colon after it.
784769Speter  */
78515208Sthien char *
786769Speter putlab(l)
78715208Sthien 	char *l;
788769Speter {
789769Speter 
790769Speter #	ifdef PC
79115208Sthien 	    putprintf( PREFIXFORMAT , 1 , (int) LABELPREFIX , (int) l );
792769Speter 	    putprintf( ":" , 0 );
793769Speter #	endif PC
794769Speter 	return (l);
795769Speter }
796