xref: /original-bsd/old/pcc/ccom.tahoe/local2.c (revision a9c19d04) 
1 #ifndef lint
2 static char sccsid[] = "@(#)local2.c	1.10 (Berkeley) 04/24/87";
3 #endif
4 
5 # include "pass2.h"
6 # include <ctype.h>
7 
8 # define putstr(s)	fputs((s), stdout)
9 # define ISCHAR(p)	(p->in.type == UCHAR || p->in.type == CHAR)
10 
11 # ifdef FORT
12 int ftlab1, ftlab2;
13 # endif
14 /* a lot of the machine dependent parts of the second pass */
15 
16 # define BITMASK(n) ((1L<<n)-1)
17 
18 # ifndef ONEPASS
19 where(c){
20 	fprintf( stderr, "%s, line %d: ", filename, lineno );
21 	}
22 # endif
23 
24 lineid( l, fn ) char *fn; {
25 	/* identify line l and file fn */
26 	printf( "#	line %d, file %s\n", l, fn );
27 	}
28 
29 int ent_mask;
30 
31 eobl2(){
32 	register OFFSZ spoff;	/* offset from stack pointer */
33 #ifndef FORT
34 	extern int ftlab1, ftlab2;
35 #endif
36 
37 	spoff = maxoff;
38 	spoff /= SZCHAR;
39 	SETOFF(spoff,4);
40 #ifdef FORT
41 #ifndef FLEXNAMES
42 	printf( "	.set	.F%d,%d\n", ftnno, spoff );
43 #else
44 	/* SHOULD BE L%d ... ftnno but must change pc/f77 */
45 	printf( "	.set	LF%d,%d\n", ftnno, spoff );
46 #endif
47 	printf( "	.set	LWM%d,0x%x\n", ftnno, ent_mask&0x1ffc|0x1000);
48 #else
49 	printf( "	.set	L%d,0x%x\n", ftnno, ent_mask&0x1ffc);
50 	printf( "L%d:\n", ftlab1);
51 	if( maxoff > AUTOINIT )
52 		printf( "	subl3	$%d,fp,sp\n", spoff);
53 	printf( "	jbr 	L%d\n", ftlab2);
54 #endif
55 	ent_mask = 0;
56 	maxargs = -1;
57 	}
58 
59 struct hoptab { int opmask; char * opstring; } ioptab[] = {
60 
61 	PLUS,	"add",
62 	MINUS,	"sub",
63 	MUL,	"mul",
64 	DIV,	"div",
65 	MOD,	"div",
66 	OR,	"or",
67 	ER,	"xor",
68 	AND,	"and",
69 	-1,	""    };
70 
71 hopcode( f, o ){
72 	/* output the appropriate string from the above table */
73 
74 	register struct hoptab *q;
75 
76 	if(asgop(o))
77 		o = NOASG o;
78 	for( q = ioptab;  q->opmask>=0; ++q ){
79 		if( q->opmask == o ){
80 			if(f == 'E')
81 				printf( "e%s", q->opstring);
82 			else
83 				printf( "%s%c", q->opstring, tolower(f));
84 			return;
85 			}
86 		}
87 	cerror( "no hoptab for %s", opst[o] );
88 	}
89 
90 char *
91 rnames[] = {  /* keyed to register number tokens */
92 
93 	"r0", "r1",
94 	"r2", "r3", "r4", "r5",
95 	"r6", "r7", "r8", "r9", "r10", "r11",
96 	"r12", "fp", "sp", "pc",
97 	};
98 
99 /* output register name and update entry mask */
100 char *
101 rname(r)
102 	register int r;
103 {
104 
105 	ent_mask |= 1<<r;
106 	return(rnames[r]);
107 }
108 
109 int rstatus[] = {
110 	SAREG|STAREG, SAREG|STAREG,
111 	SAREG|STAREG, SAREG|STAREG, SAREG|STAREG, SAREG|STAREG,
112 	SAREG, SAREG, SAREG, SAREG, SAREG, SAREG,
113 	SAREG, SAREG, SAREG, SAREG,
114 	};
115 
116 tlen(p) NODE *p;
117 {
118 	switch(p->in.type) {
119 		case CHAR:
120 		case UCHAR:
121 			return(1);
122 
123 		case SHORT:
124 		case USHORT:
125 			return(2);
126 
127 		case DOUBLE:
128 			return(8);
129 
130 		default:
131 			return(4);
132 		}
133 }
134 
135 anyfloat(p, q)
136 	NODE *p, *q;
137 {
138 	register TWORD tp, tq;
139 
140 	tp = p->in.type;
141 	tq = q->in.type;
142 	return (tp == FLOAT || tp == DOUBLE || tq == FLOAT || tq == DOUBLE);
143 }
144 
145 prtype(n) NODE *n;
146 {
147 	switch (n->in.type)
148 		{
149 
150 		case DOUBLE:
151 			putchar('d');
152 			return;
153 
154 		case FLOAT:
155 			putchar('f');
156 			return;
157 
158 		case INT:
159 		case UNSIGNED:
160 			putchar('l');
161 			return;
162 
163 		case SHORT:
164 		case USHORT:
165 			putchar('w');
166 			return;
167 
168 		case CHAR:
169 		case UCHAR:
170 			putchar('b');
171 			return;
172 
173 		default:
174 			if ( !ISPTR( n->in.type ) ) cerror("zzzcode- bad type");
175 			else {
176 				putchar('l');
177 				return;
178 				}
179 		}
180 }
181 
182 zzzcode( p, c ) register NODE *p; {
183 	register int m;
184 	int val;
185 	switch( c ){
186 
187 	case 'N':  /* logical ops, turned into 0-1 */
188 		/* use register given by register 1 */
189 		cbgen( 0, m=getlab(), 'I' );
190 		deflab( p->bn.label );
191 		printf( "	clrl	%s\n", rname(getlr( p, '1' )->tn.rval) );
192 		deflab( m );
193 		return;
194 
195 	case 'P':
196 		cbgen( p->in.op, p->bn.label, c );
197 		return;
198 
199 	case 'A':	/* assignment and load (integer only) */
200 		{
201 		register NODE *l, *r;
202 
203 		if (xdebug) eprint(p, 0, &val, &val);
204 		r = getlr(p, 'R');
205 		if (optype(p->in.op) == LTYPE || p->in.op == UNARY MUL) {
206 			l = resc;
207 			l->in.type = INT;
208 		} else
209 			l = getlr(p, 'L');
210 		if(r->in.type==FLOAT || r->in.type==DOUBLE
211 		 || l->in.type==FLOAT || l->in.type==DOUBLE)
212 			cerror("float in ZA");
213 		if (r->in.op == ICON)
214 			if(r->in.name[0] == '\0') {
215 				if (r->tn.lval == 0) {
216 					putstr("clr");
217 					prtype(l);
218 					putchar('\t');
219 					adrput(l);
220 					return;
221 				}
222 				if (r->tn.lval < 0 && r->tn.lval >= -63) {
223 					putstr("mneg");
224 					prtype(l);
225 					r->tn.lval = -r->tn.lval;
226 					goto ops;
227 				}
228 #ifdef MOVAFASTER
229 			} else {
230 				putstr("movab\t");
231 				acon(r);
232 				putchar(',');
233 				adrput(l);
234 				return;
235 #endif MOVAFASTER
236 			}
237 
238 		if (l->in.op == REG) {
239 			if( tlen(l) < tlen(r) ) {
240 				putstr(!ISUNSIGNED(l->in.type)?
241 					"cvt": "movz");
242 				prtype(l);
243 				putchar('l');
244 				goto ops;
245 			} else
246 				l->in.type = INT;
247 		}
248 		if (tlen(l) == tlen(r)) {
249 			putstr("mov");
250 			prtype(l);
251 			goto ops;
252 		} else if (tlen(l) > tlen(r) && ISUNSIGNED(r->in.type))
253 			putstr("movz");
254 		else
255 			putstr("cvt");
256 		prtype(r);
257 		prtype(l);
258 	ops:
259 		putchar('\t');
260 		adrput(r);
261 		putchar(',');
262 		adrput(l);
263 		return;
264 		}
265 
266 	case 'B':	/* get oreg value in temp register for shift */
267 		{
268 		register NODE *r;
269 		if (xdebug) eprint(p, 0, &val, &val);
270 		r = p->in.right;
271 		if( tlen(r) == sizeof(int) && r->in.type != FLOAT )
272 			putstr("movl");
273 		else {
274 			putstr(ISUNSIGNED(r->in.type) ? "movz" : "cvt");
275 			prtype(r);
276 			putchar('l');
277 			}
278 		return;
279 		}
280 
281 	case 'C':	/* num bytes pushed on arg stack */
282 		{
283 		extern int gc_numbytes;
284 		extern int xdebug;
285 
286 		if (xdebug) printf("->%d<-",gc_numbytes);
287 
288 		printf("call%c	$%d",
289 		 (p->in.left->in.op==ICON && gc_numbytes<60)?'f':'s',
290 		 gc_numbytes+4);
291 		/* dont change to double (here's the only place to catch it) */
292 		if(p->in.type == FLOAT)
293 			rtyflg = 1;
294 		return;
295 		}
296 
297 	case 'D':	/* INCR and DECR */
298 		zzzcode(p->in.left, 'A');
299 		putstr("\n	");
300 
301 	case 'E':	/* INCR and DECR, FOREFF */
302  		if (p->in.right->tn.lval == 1)
303 			{
304 			putstr(p->in.op == INCR ? "inc" : "dec");
305 			prtype(p->in.left);
306 			putchar('\t');
307 			adrput(p->in.left);
308 			return;
309 			}
310 		putstr(p->in.op == INCR ? "add" : "sub");
311 		prtype(p->in.left);
312 		putstr("2	");
313 		adrput(p->in.right);
314 		putchar(',');
315 		adrput(p->in.left);
316 		return;
317 
318 	case 'F':	/* masked constant for fields */
319 		printf(ACONFMT, (p->in.right->tn.lval&((1<<fldsz)-1))<<fldshf);
320 		return;
321 
322 	case 'H':	/* opcode for shift */
323 		if(p->in.op == LS || p->in.op == ASG LS)
324 			putstr("shll");
325 		else if(ISUNSIGNED(p->in.left->in.type))
326 			putstr("shrl");
327 		else
328 			putstr("shar");
329 		return;
330 
331 	case 'L':	/* type of left operand */
332 	case 'R':	/* type of right operand */
333 		{
334 		register NODE *n;
335 		extern int xdebug;
336 
337 		n = getlr ( p, c);
338 		if (xdebug) printf("->%d<-", n->in.type);
339 
340 		prtype(n);
341 		return;
342 		}
343 
344 	case 'M': {  /* initiate ediv for mod and unsigned div */
345 		register char *r;
346 		m = getlr(p, '1')->tn.rval;
347 		r = rname(m);
348 		printf("\tclrl\t%s\n\tmovl\t", r);
349 		adrput(p->in.left);
350 		printf(",%s\n", rname(m+1));
351 		if(!ISUNSIGNED(p->in.type)) { 	/* should be MOD */
352 			m = getlab();
353 			printf("\tjgeq\tL%d\n\tmnegl\t$1,%s\n", m, r);
354 			deflab(m);
355 		}
356 		return;
357 	}
358 
359 	case 'T': {	/* rounded structure length for arguments */
360 		int size = p->stn.stsize;
361 		SETOFF( size, 4);
362 		printf("movab	-%d(sp),sp", size);
363 		return;
364 	}
365 
366 	case 'S':  /* structure assignment */
367 		stasg(p);
368 		break;
369 
370 	case 'X':	/* multiplication for short and char */
371 		if (ISUNSIGNED(p->in.left->in.type))
372 			printf("\tmovz");
373 		else
374 			printf("\tcvt");
375 		zzzcode(p, 'L');
376 		printf("l\t");
377 		adrput(p->in.left);
378 		printf(",");
379 		adrput(&resc[0]);
380 		printf("\n");
381 		if (ISUNSIGNED(p->in.right->in.type))
382 			printf("\tmovz");
383 		else
384 			printf("\tcvt");
385 		zzzcode(p, 'R');
386 		printf("l\t");
387 		adrput(p->in.right);
388 		printf(",");
389 		adrput(&resc[1]);
390 		printf("\n");
391 		return;
392 
393 	case 'U':		/* SCONV */
394 	case 'V':		/* SCONV with FORCC */
395 		sconv(p, c == 'V');
396 		break;
397 
398 	case 'Z':
399 		p = p->in.right;
400 		switch (p->in.type) {
401 		case SHORT: {
402 			short w = p->tn.lval;
403 			p->tn.lval = w;
404 			break;
405 		}
406 		case CHAR: {
407 			char c = p->tn.lval;
408 			p->tn.lval = c;
409 			break;
410 		}
411 		}
412 		printf("$%d", p->tn.lval);
413 		break;
414 
415 	default:
416 		cerror( "illegal zzzcode" );
417 	}
418 }
419 
420 #define	MOVB(dst, src, off) { \
421 	putstr("\tmovb\t"); upput(src, off); putchar(','); \
422 	upput(dst, off); putchar('\n'); \
423 }
424 #define	MOVW(dst, src, off) { \
425 	putstr("\tmovw\t"); upput(src, off); putchar(','); \
426 	upput(dst, off); putchar('\n'); \
427 }
428 #define	MOVL(dst, src, off) { \
429 	putstr("\tmovl\t"); upput(src, off); putchar(','); \
430 	upput(dst, off); putchar('\n'); \
431 }
432 /*
433  * Generate code for a structure assignment.
434  */
435 stasg(p)
436 	register NODE *p;
437 {
438 	register NODE *l, *r;
439 	register int size;
440 
441 	switch (p->in.op) {
442 	case STASG:			/* regular assignment */
443 		l = p->in.left;
444 		r = p->in.right;
445 		break;
446 	case STARG:			/* place arg on the stack */
447 		l = getlr(p, '3');
448 		r = p->in.left;
449 		break;
450 	default:
451 		cerror("STASG bad");
452 		/*NOTREACHED*/
453 	}
454 	/*
455 	 * Pun source for use in code generation.
456 	 */
457 	switch (r->in.op) {
458 	case ICON:
459 		r->in.op = NAME;
460 		break;
461 	case REG:
462 		r->in.op = OREG;
463 		break;
464 	default:
465 		cerror( "STASG-r" );
466 		/*NOTREACHED*/
467 	}
468 	size = p->stn.stsize;
469 	if (size <= 0 || size > 65535)
470 		cerror("structure size out of range");
471 	/*
472 	 * Generate optimized code based on structure size
473 	 * and alignment properties....
474 	 */
475 	switch (size) {
476 
477 	case 1:
478 		putstr("\tmovb\t");
479 	optimized:
480 		adrput(r);
481 		putchar(',');
482 		adrput(l);
483 		putchar('\n');
484 		break;
485 
486 	case 2:
487 		if (p->stn.stalign != 2) {
488 			MOVB(l, r, SZCHAR);
489 			putstr("\tmovb\t");
490 		} else
491 			putstr("\tmovw\t");
492 		goto optimized;
493 
494 	case 4:
495 		if (p->stn.stalign != 4) {
496 			if (p->stn.stalign != 2) {
497 				MOVB(l, r, 3*SZCHAR);
498 				MOVB(l, r, 2*SZCHAR);
499 				MOVB(l, r, 1*SZCHAR);
500 				putstr("\tmovb\t");
501 			} else {
502 				MOVW(l, r, SZSHORT);
503 				putstr("\tmovw\t");
504 			}
505 		} else
506 			putstr("\tmovl\t");
507 		goto optimized;
508 
509 	case 6:
510 		if (p->stn.stalign != 2)
511 			goto movblk;
512 		MOVW(l, r, 2*SZSHORT);
513 		MOVW(l, r, 1*SZSHORT);
514 		putstr("\tmovw\t");
515 		goto optimized;
516 
517 	case 8:
518 		if (p->stn.stalign == 4) {
519 			MOVL(l, r, SZLONG);
520 			putstr("\tmovl\t");
521 			goto optimized;
522 		}
523 		/* fall thru...*/
524 
525 	default:
526 	movblk:
527 		/*
528 		 * Can we ever get a register conflict with R1 here?
529 		 */
530 		putstr("\tmovab\t");
531 		adrput(l);
532 		putstr(",r1\n\tmovab\t");
533 		adrput(r);
534 		printf(",r0\n\tmovl\t$%d,r2\n\tmovblk\n", size);
535 		rname(R2);
536 		break;
537 	}
538 	/*
539 	 * Reverse above pun for reclaim.
540 	 */
541 	if (r->in.op == NAME)
542 		r->in.op = ICON;
543 	else if (r->in.op == OREG)
544 		r->in.op = REG;
545 }
546 
547 /*
548  * Output the address of the second item in the
549  * pair pointed to by p.
550  */
551 upput(p, size)
552 	register NODE *p;
553 {
554 	CONSZ save;
555 
556 	if (p->in.op == FLD)
557 		p = p->in.left;
558 	switch (p->in.op) {
559 
560 	case NAME:
561 	case OREG:
562 		save = p->tn.lval;
563 		p->tn.lval += size/SZCHAR;
564 		adrput(p);
565 		p->tn.lval = save;
566 		break;
567 
568 	case REG:
569 		if (size == SZLONG) {
570 			putstr(rname(p->tn.rval+1));
571 			break;
572 		}
573 		/* fall thru... */
574 
575 	default:
576 		cerror("illegal upper address op %s size %d",
577 		    opst[p->tn.op], size);
578 		/*NOTREACHED*/
579 	}
580 }
581 
582 /*
583  * Generate code for storage conversions.
584  */
585 sconv(p, forcc)
586 	NODE *p;
587 {
588 	register NODE *l, *r;
589 	register wfrom, wto;
590 	int oltype;
591 
592 	l = getlr(p, '1');
593 	oltype = l->in.type, l->in.type = r->in.type;
594 	r = getlr(p, 'L');
595 	wfrom = tlen(r), wto = tlen(l);
596 	if (wfrom == wto)		/* e.g. int -> unsigned */
597 		goto done;
598 	/*
599 	 * Conversion in registers requires care
600 	 * as cvt and movz instruction don't work
601 	 * as expected (they end up as plain mov's).
602 	 */
603 	if (l->in.op == REG && r->in.op == REG) {
604 		if ((wfrom < wto && ISUNSIGNED(r->in.type)) ||
605 		    (wto < wfrom && ISUNSIGNED(l->in.type))) {
606 			/* unsigned, mask */
607 			if (r->tn.rval != l->tn.rval) {
608 				printf("\tandl3\t$%d,", (1<<(wto*SZCHAR))-1);
609 				adrput(r);
610 				putchar(',');
611 			} else
612 				printf("\tandl2\t$%d,", (1<<(wto*SZCHAR))-1);
613 			adrput(l);
614 		} else {				/* effect sign-extend */
615 			printf("\tpushl\t"); adrput(r);
616 			printf("\n\tcvt"); prtype(l);
617 			printf("l\t%d(sp),", sizeof (int) - wto); adrput(l);
618 			printf("\n\tmovab\t4(sp),sp");
619 		}
620 		/*
621 		 * If condition codes are required then we must generate a
622 		 * test of the appropriate type.
623 		 */
624 		if (forcc) {
625 			printf("\n\tcmp");
626 			prtype(l);
627 			putchar('\t');
628 			adrput(l);
629 			printf(",$0");
630 		}
631 	} else {
632 		/*
633 		 * Conversion with at least one parameter in memory.
634 		 */
635 		if (wfrom < wto) {		/* expanding datum */
636 			if (ISUNSIGNED(r->in.type)) {
637 				printf("\tmovz");
638 				prtype(r);
639 				/*
640 				 * If target is a register, generate
641 				 * movz?l so optimizer can compress
642 				 * argument pushes.
643 				 */
644 				if (l->in.op == REG)
645 					putchar('l');
646 				else
647 					prtype(l);
648 			} else {
649 				printf("\tcvt");
650 				prtype(r), prtype(l);
651 			}
652 			putchar('\t');
653 			adrput(r);
654 		} else {			/* shrinking dataum */
655 			int off = wfrom - wto;
656 			if (l->in.op == REG) {
657 				printf("\tmovz");
658 				prtype(l);
659 				putchar('l');
660 			} else {
661 				printf("\tcvt");
662 				prtype(l), prtype(r);
663 			}
664 			putchar('\t');
665 			switch (r->in.op) {
666 			case NAME: case OREG:
667 				r->tn.lval += off;
668 				adrput(r);
669 				r->tn.lval -= off;
670 				break;
671 			case REG: case ICON: case UNARY MUL:
672 				adrput(r);
673 				break;
674 			default:
675 				cerror("sconv: bad shrink op");
676 				/*NOTREACHED*/
677 			}
678 		}
679 		putchar(',');
680 		adrput(l);
681 	}
682 	putchar('\n');
683 done:
684 	l->in.type = oltype;
685 }
686 
687 rmove( rt, rs, t ) TWORD t;{
688 	printf( "	movl	%s,%s\n", rname(rs), rname(rt) );
689 	if(t==DOUBLE)
690 		printf( "	movl	%s,%s\n", rname(rs+1), rname(rt+1) );
691 	}
692 
693 struct respref
694 respref[] = {
695 	INTAREG|INTBREG,	INTAREG|INTBREG,
696 	INAREG|INBREG,	INAREG|INBREG|SOREG|STARREG|STARNM|SNAME|SCON,
697 	INTEMP,	INTEMP,
698 	FORARG,	FORARG,
699 	INTEMP,	INTAREG|INAREG|INTBREG|INBREG|SOREG|STARREG|STARNM,
700 	0,	0 };
701 
702 setregs(){ /* set up temporary registers */
703 	fregs = 6;	/* tbl- 6 free regs on Tahoe (0-5) */
704 	}
705 
706 #ifndef szty
707 szty(t) TWORD t;{ /* size, in registers, needed to hold thing of type t */
708 	return(t==DOUBLE ? 2 : 1 );
709 	}
710 #endif
711 
712 rewfld( p ) NODE *p; {
713 	return(1);
714 	}
715 
716 callreg(p) NODE *p; {
717 	return( R0 );
718 	}
719 
720 base( p ) register NODE *p; {
721 	register int o = p->in.op;
722 
723 	if( (o==ICON && p->in.name[0] != '\0')) return( 100 ); /* ie no base reg */
724 	if( o==REG ) return( p->tn.rval );
725     if( (o==PLUS || o==MINUS) && p->in.left->in.op == REG && p->in.right->in.op==ICON)
726 		return( p->in.left->tn.rval );
727     if( o==OREG && !R2TEST(p->tn.rval) && (p->in.type==INT || p->in.type==UNSIGNED || ISPTR(p->in.type)) )
728 		return( p->tn.rval + 0200*1 );
729 	return( -1 );
730 	}
731 
732 offset( p, tyl ) register NODE *p; int tyl; {
733 
734 	if(tyl > 8) return( -1 );
735 	if( tyl==1 && p->in.op==REG && (p->in.type==INT || p->in.type==UNSIGNED) ) return( p->tn.rval );
736 	if( (p->in.op==LS && p->in.left->in.op==REG && (p->in.left->in.type==INT || p->in.left->in.type==UNSIGNED) &&
737 	      (p->in.right->in.op==ICON && p->in.right->in.name[0]=='\0')
738 	      && (1<<p->in.right->tn.lval)==tyl))
739 		return( p->in.left->tn.rval );
740 	return( -1 );
741 	}
742 
743 makeor2( p, q, b, o) register NODE *p, *q; register int b, o; {
744 	register NODE *t;
745 	register int i;
746 	NODE *f;
747 
748 	p->in.op = OREG;
749 	f = p->in.left; 	/* have to free this subtree later */
750 
751 	/* init base */
752 	switch (q->in.op) {
753 		case ICON:
754 		case REG:
755 		case OREG:
756 			t = q;
757 			break;
758 
759 		case MINUS:
760 			q->in.right->tn.lval = -q->in.right->tn.lval;
761 		case PLUS:
762 			t = q->in.right;
763 			break;
764 
765 		case UNARY MUL:
766 			t = q->in.left->in.left;
767 			break;
768 
769 		default:
770 			cerror("illegal makeor2");
771 	}
772 
773 	p->tn.lval = t->tn.lval;
774 #ifndef FLEXNAMES
775 	for(i=0; i<NCHNAM; ++i)
776 		p->in.name[i] = t->in.name[i];
777 #else
778 	p->in.name = t->in.name;
779 #endif
780 
781 	/* init offset */
782 	p->tn.rval = R2PACK( (b & 0177), o, (b>>7) );
783 
784 	tfree(f);
785 	return;
786 	}
787 
788 canaddr( p ) NODE *p; {
789 	register int o = p->in.op;
790 
791 	if( o==NAME || o==REG || o==ICON || o==OREG || (o==UNARY MUL && shumul(p->in.left)) ) return(1);
792 	return(0);
793 	}
794 
795 #ifndef shltype
796 shltype( o, p ) register NODE *p; {
797 	return( o== REG || o == NAME || o == ICON || o == OREG || ( o==UNARY MUL && shumul(p->in.left)) );
798 	}
799 #endif
800 
801 flshape( p ) NODE *p; {
802 	register int o = p->in.op;
803 
804 	if( o==NAME || o==REG || o==ICON || o==OREG || (o==UNARY MUL && shumul(p->in.left)) ) return(1);
805 	return(0);
806 	}
807 
808 shtemp( p ) register NODE *p; {
809 	if( p->in.op == STARG ) p = p->in.left;
810 	return( p->in.op==NAME || p->in.op ==ICON || p->in.op == OREG || (p->in.op==UNARY MUL && shumul(p->in.left)) );
811 	}
812 
813 shumul( p ) register NODE *p; {
814 	register int o;
815 	extern int xdebug;
816 
817 	if (xdebug) {
818 		 printf("\nshumul:op=%d,lop=%d,rop=%d", p->in.op, p->in.left->in.op, p->in.right->in.op);
819 		printf(" prname=%s,plty=%d, prlval=%D\n", p->in.right->in.name, p->in.left->in.type, p->in.right->tn.lval);
820 		}
821 
822 	o = p->in.op;
823 	if(( o == NAME || (o == OREG && !R2TEST(p->tn.rval)) || o == ICON )
824 	 && p->in.type != PTR+DOUBLE)
825 		return( STARNM );
826 
827 	return( 0 );
828 	}
829 
830 special( p, shape ) register NODE *p; {
831 	if( shape==SIREG && p->in.op == OREG && R2TEST(p->tn.rval) ) return(1);
832 	else return(0);
833 }
834 
835 adrcon( val ) CONSZ val; {
836 	printf(ACONFMT, val);
837 	}
838 
839 conput( p ) register NODE *p; {
840 	switch( p->in.op ){
841 
842 	case ICON:
843 		acon( p );
844 		return;
845 
846 	case REG:
847 		putstr(rname(p->tn.rval));
848 		return;
849 
850 	default:
851 		cerror( "illegal conput" );
852 		}
853 	}
854 
855 insput( p ) NODE *p; {
856 	cerror( "insput" );
857 	}
858 
859 adrput( p ) register NODE *p; {
860 	register int r;
861 	/* output an address, with offsets, from p */
862 
863 	if( p->in.op == FLD ){
864 		p = p->in.left;
865 		}
866 	switch( p->in.op ){
867 
868 	case NAME:
869 		acon( p );
870 		return;
871 
872 	case ICON:
873 		/* addressable value of the constant */
874 		putchar('$');
875 		acon( p );
876 		return;
877 
878 	case REG:
879 		putstr(rname(p->tn.rval));
880 		if(p->in.type == DOUBLE)	/* for entry mask */
881 			(void) rname(p->tn.rval+1);
882 		return;
883 
884 	case OREG:
885 		r = p->tn.rval;
886 		if( R2TEST(r) ){ /* double indexing */
887 			register int flags;
888 
889 			flags = R2UPK3(r);
890 			if( flags & 1 ) putchar('*');
891 			if( p->tn.lval != 0 || p->in.name[0] != '\0' ) acon(p);
892 			if( R2UPK1(r) != 100) printf( "(%s)", rname(R2UPK1(r)) );
893 			printf( "[%s]", rname(R2UPK2(r)) );
894 			return;
895 			}
896 		if( r == FP && p->tn.lval > 0 ){  /* in the argument region */
897 			if( p->in.name[0] != '\0' ) werror( "bad arg temp" );
898 			printf( CONFMT, p->tn.lval );
899 			putstr( "(fp)" );
900 			return;
901 			}
902 		if( p->tn.lval != 0 || p->in.name[0] != '\0') acon( p );
903 		printf( "(%s)", rname(p->tn.rval) );
904 		return;
905 
906 	case UNARY MUL:
907 		/* STARNM or STARREG found */
908 		if( tshape(p, STARNM) ) {
909 			putchar( '*' );
910 			adrput( p->in.left);
911 			}
912 		return;
913 
914 	default:
915 		cerror( "illegal address" );
916 		return;
917 
918 		}
919 
920 	}
921 
922 acon( p ) register NODE *p; { /* print out a constant */
923 
924 	if( p->in.name[0] == '\0' ){
925 		printf( CONFMT, p->tn.lval);
926 		return;
927 	} else {
928 #ifndef FLEXNAMES
929 		printf( "%.8s", p->in.name );
930 #else
931 		putstr(p->in.name);
932 #endif
933 		if (p->tn.lval != 0) {
934 			putchar('+');
935 			printf(CONFMT, p->tn.lval);
936 		}
937 	}
938 	}
939 
940 genscall( p, cookie ) register NODE *p; {
941 	/* structure valued call */
942 	return( gencall( p, cookie ) );
943 	}
944 
945 genfcall( p, cookie ) register NODE *p; {
946 	register NODE *p1;
947 	register int m;
948 	static char *funcops[6] = {
949 		"sin", "cos", "sqrt", "exp", "log", "atan"
950 	};
951 
952 	/* generate function opcodes */
953 	if(p->in.op==UNARY FORTCALL && p->in.type==FLOAT &&
954 	 (p1 = p->in.left)->in.op==ICON &&
955 	 p1->tn.lval==0 && p1->in.type==INCREF(FTN|FLOAT)) {
956 #ifdef FLEXNAMES
957 		p1->in.name++;
958 #else
959 		strcpy(p1->in.name, p1->in.name[1]);
960 #endif
961 		for(m=0; m<6; m++)
962 			if(!strcmp(p1->in.name, funcops[m]))
963 				break;
964 		if(m >= 6)
965 			uerror("no opcode for fortarn function %s", p1->in.name);
966 	} else
967 		uerror("illegal type of fortarn function");
968 	p1 = p->in.right;
969 	p->in.op = FORTCALL;
970 	if(!canaddr(p1))
971 		order( p1, INAREG|INBREG|SOREG|STARREG|STARNM );
972 	m = match( p, INTAREG|INTBREG );
973 	return(m != MDONE);
974 }
975 
976 /* tbl */
977 int gc_numbytes;
978 /* tbl */
979 
980 gencall( p, cookie ) register NODE *p; {
981 	/* generate the call given by p */
982 	register NODE *p1, *ptemp;
983 	register int temp, temp1;
984 	register int m;
985 
986 	if( p->in.right ) temp = argsize( p->in.right );
987 	else temp = 0;
988 
989 	if( p->in.op == STCALL || p->in.op == UNARY STCALL ){
990 		/* set aside room for structure return */
991 
992 		if( p->stn.stsize > temp ) temp1 = p->stn.stsize;
993 		else temp1 = temp;
994 		}
995 
996 	if( temp > maxargs ) maxargs = temp;
997 	SETOFF(temp1,4);
998 
999 	if( p->in.right ){ /* make temp node, put offset in, and generate args */
1000 		ptemp = talloc();
1001 		ptemp->in.op = OREG;
1002 		ptemp->tn.lval = -1;
1003 		ptemp->tn.rval = SP;
1004 #ifndef FLEXNAMES
1005 		ptemp->in.name[0] = '\0';
1006 #else
1007 		ptemp->in.name = "";
1008 #endif
1009 		ptemp->in.rall = NOPREF;
1010 		ptemp->in.su = 0;
1011 		genargs( p->in.right, ptemp );
1012 		ptemp->in.op = FREE;
1013 		}
1014 
1015 	p1 = p->in.left;
1016 	if( p1->in.op != ICON ){
1017 		if( p1->in.op != REG ){
1018 			if( p1->in.op != OREG || R2TEST(p1->tn.rval) ){
1019 				if( p1->in.op != NAME ){
1020 					order( p1, INAREG );
1021 					}
1022 				}
1023 			}
1024 		}
1025 
1026 /* tbl
1027 	setup gc_numbytes so reference to ZC works */
1028 
1029 	gc_numbytes = temp&(0x3ff);
1030 
1031 	p->in.op = UNARY CALL;
1032 	m = match( p, INTAREG|INTBREG );
1033 
1034 	return(m != MDONE);
1035 	}
1036 
1037 /* tbl */
1038 char *
1039 ccbranches[] = {
1040 	"eql",
1041 	"neq",
1042 	"leq",
1043 	"lss",
1044 	"geq",
1045 	"gtr",
1046 	"lequ",
1047 	"lssu",
1048 	"gequ",
1049 	"gtru",
1050 	};
1051 /* tbl */
1052 
1053 cbgen( o, lab, mode ) { /*   printf conditional and unconditional branches */
1054 
1055 		if(o != 0 && (o < EQ || o > UGT ))
1056 			cerror( "bad conditional branch: %s", opst[o] );
1057 		printf( "	j%s	L%d\n",
1058 		 o == 0 ? "br" : ccbranches[o-EQ], lab );
1059 	}
1060 
1061 nextcook( p, cookie ) NODE *p; {
1062 	/* we have failed to match p with cookie; try another */
1063 	if( cookie == FORREW ) return( 0 );  /* hopeless! */
1064 	if( !(cookie&(INTAREG|INTBREG)) ) return( INTAREG|INTBREG );
1065 	if( !(cookie&INTEMP) && asgop(p->in.op) ) return( INTEMP|INAREG|INTAREG|INTBREG|INBREG );
1066 	return( FORREW );
1067 	}
1068 
1069 lastchance( p, cook ) NODE *p; {
1070 	/* forget it! */
1071 	return(0);
1072 	}
1073 
1074 optim2( p ) register NODE *p; {
1075 # ifdef ONEPASS
1076 	/* do local tree transformations and optimizations */
1077 # define RV(p) p->in.right->tn.lval
1078 # define nncon(p)	((p)->in.op == ICON && (p)->in.name[0] == 0)
1079 	register int o, i;
1080 	register NODE *l, *r;
1081 
1082 	switch (o = p->in.op) {
1083 
1084 	case DIV: case ASG DIV:
1085 	case MOD: case ASG MOD:
1086 		/*
1087 		 * Change unsigned mods and divs to
1088 		 * logicals (mul is done in mip & c2)
1089 		 */
1090 		if (ISUNSIGNED(p->in.left->in.type) && nncon(p->in.right) &&
1091 		    (i = ispow2(RV(p))) >= 0) {
1092 			if (o == DIV || o == ASG DIV) {
1093 				p->in.op = RS;
1094 				RV(p) = i;
1095 			} else {
1096 				p->in.op = AND;
1097 				RV(p)--;
1098 			}
1099 			if (asgop(o))
1100 				p->in.op = ASG p->in.op;
1101 		}
1102 		return;
1103 
1104 	case SCONV:
1105 		l = p->in.left;
1106 		/* clobber conversions w/o side effects */
1107 		if (!anyfloat(p, l) && l->in.op != PCONV &&
1108 		    tlen(p) == tlen(l)) {
1109 			if (l->in.op != FLD)
1110 				l->in.type = p->in.type;
1111 			ncopy(p, l);
1112 			l->in.op = FREE;
1113 		}
1114 		return;
1115 
1116 	case ASSIGN:
1117 		/*
1118 		 * Try to zap storage conversions of non-float items.
1119 		 */
1120 		r = p->in.right;
1121 		if (r->in.op == SCONV && !anyfloat(r->in.left, r)) {
1122 			int wdest, wconv, wsrc;
1123 			wdest = tlen(p->in.left);
1124 			wconv = tlen(r);
1125 			/*
1126 			 * If size doesn't change across assignment or
1127 			 * conversion expands src before shrinking again
1128 			 * due to the assignment, delete conversion so
1129 			 * code generator can create optimal code.
1130 			 */
1131 			if (wdest == wconv ||
1132 			 (wdest == (wsrc = tlen(r->in.left)) && wconv > wsrc)) {
1133 				p->in.right = r->in.left;
1134 				r->in.op = FREE;
1135 			}
1136 		}
1137 		return;
1138 	}
1139 # endif
1140 }
1141 
1142 struct functbl {
1143 	int fop;
1144 	char *func;
1145 } opfunc[] = {
1146 	DIV,		"udiv",
1147 	ASG DIV,	"udiv",
1148 	0
1149 };
1150 
1151 hardops(p)  register NODE *p; {
1152 	/* change hard to do operators into function calls.  */
1153 	register NODE *q;
1154 	register struct functbl *f;
1155 	register int o;
1156 	register TWORD t, t1, t2;
1157 
1158 	o = p->in.op;
1159 
1160 	for( f=opfunc; f->fop; f++ ) {
1161 		if( o==f->fop ) goto convert;
1162 	}
1163 	return;
1164 
1165 	convert:
1166 	t = p->in.type;
1167 	t1 = p->in.left->in.type;
1168 	t2 = p->in.right->in.type;
1169 
1170 	if (!((ISUNSIGNED(t1) && !(ISUNSIGNED(t2))) ||
1171 	     ( t2 == UNSIGNED))) return;
1172 
1173 	/* need to rewrite tree for ASG OP */
1174 	/* must change ASG OP to a simple OP */
1175 	if( asgop( o ) ) {
1176 		q = talloc();
1177 		q->in.op = NOASG ( o );
1178 		q->in.rall = NOPREF;
1179 		q->in.type = p->in.type;
1180 		q->in.left = tcopy(p->in.left);
1181 		q->in.right = p->in.right;
1182 		p->in.op = ASSIGN;
1183 		p->in.right = q;
1184 		zappost(q->in.left); /* remove post-INCR(DECR) from new node */
1185 		fixpre(q->in.left);	/* change pre-INCR(DECR) to +/-	*/
1186 		p = q;
1187 
1188 	}
1189 	/* turn logicals to compare 0 */
1190 	else if( logop( o ) ) {
1191 		ncopy(q = talloc(), p);
1192 		p->in.left = q;
1193 		p->in.right = q = talloc();
1194 		q->in.op = ICON;
1195 		q->in.type = INT;
1196 #ifndef FLEXNAMES
1197 		q->in.name[0] = '\0';
1198 #else
1199 		q->in.name = "";
1200 #endif
1201 		q->tn.lval = 0;
1202 		q->tn.rval = 0;
1203 		p = p->in.left;
1204 	}
1205 
1206 	/* build comma op for args to function */
1207 	t1 = p->in.left->in.type;
1208 	t2 = 0;
1209 	if ( optype(p->in.op) == BITYPE) {
1210 		q = talloc();
1211 		q->in.op = CM;
1212 		q->in.rall = NOPREF;
1213 		q->in.type = INT;
1214 		q->in.left = p->in.left;
1215 		q->in.right = p->in.right;
1216 		t2 = p->in.right->in.type;
1217 	} else
1218 		q = p->in.left;
1219 
1220 	p->in.op = CALL;
1221 	p->in.right = q;
1222 
1223 	/* put function name in left node of call */
1224 	p->in.left = q = talloc();
1225 	q->in.op = ICON;
1226 	q->in.rall = NOPREF;
1227 	q->in.type = INCREF( FTN + p->in.type );
1228 #ifndef FLEXNAMES
1229 		strcpy( q->in.name, f->func );
1230 #else
1231 		q->in.name = f->func;
1232 #endif
1233 	q->tn.lval = 0;
1234 	q->tn.rval = 0;
1235 
1236 	}
1237 
1238 zappost(p) NODE *p; {
1239 	/* look for ++ and -- operators and remove them */
1240 
1241 	register int o, ty;
1242 	register NODE *q;
1243 	o = p->in.op;
1244 	ty = optype( o );
1245 
1246 	switch( o ){
1247 
1248 	case INCR:
1249 	case DECR:
1250 			q = p->in.left;
1251 			p->in.right->in.op = FREE;  /* zap constant */
1252 			ncopy( p, q );
1253 			q->in.op = FREE;
1254 			return;
1255 
1256 		}
1257 
1258 	if( ty == BITYPE ) zappost( p->in.right );
1259 	if( ty != LTYPE ) zappost( p->in.left );
1260 }
1261 
1262 fixpre(p) NODE *p; {
1263 
1264 	register int o, ty;
1265 	o = p->in.op;
1266 	ty = optype( o );
1267 
1268 	switch( o ){
1269 
1270 	case ASG PLUS:
1271 			p->in.op = PLUS;
1272 			break;
1273 	case ASG MINUS:
1274 			p->in.op = MINUS;
1275 			break;
1276 		}
1277 
1278 	if( ty == BITYPE ) fixpre( p->in.right );
1279 	if( ty != LTYPE ) fixpre( p->in.left );
1280 }
1281 
1282 NODE * addroreg(l) NODE *l;
1283 				/* OREG was built in clocal()
1284 				 * for an auto or formal parameter
1285 				 * now its address is being taken
1286 				 * local code must unwind it
1287 				 * back to PLUS/MINUS REG ICON
1288 				 * according to local conventions
1289 				 */
1290 {
1291 	cerror("address of OREG taken");
1292 }
1293 
1294 # ifndef ONEPASS
1295 main( argc, argv ) char *argv[]; {
1296 	return( mainp2( argc, argv ) );
1297 	}
1298 # endif
1299 
1300 strip(p) register NODE *p; {
1301 	NODE *q;
1302 
1303 	/* strip nodes off the top when no side effects occur */
1304 	for( ; ; ) {
1305 		switch( p->in.op ) {
1306 		case SCONV:			/* remove lint tidbits */
1307 			q = p->in.left;
1308 			ncopy( p, q );
1309 			q->in.op = FREE;
1310 			break;
1311 		/* could probably add a few more here */
1312 		default:
1313 			return;
1314 			}
1315 		}
1316 	}
1317 
1318 myreader(p) register NODE *p; {
1319 	strip( p );		/* strip off operations with no side effects */
1320 	walkf( p, hardops );	/* convert ops to function calls */
1321 	canon( p );		/* expands r-vals for fileds */
1322 	walkf( p, optim2 );
1323 	}
1324