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