![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to optim.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1|
Return to optim.c CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 |
1.1 root 1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: */
6:
7: #ifndef lint
8: static char sccsid[] = "@(#)optim.c 5.2 (Berkeley) 6/9/85";
9: #endif not lint
10:
11: /*
12: * optim.c
13: *
14: * Miscellaneous optimizer routines, f77 compiler pass 1.
15: *
16: * UCSD Chemistry modification history:
17: *
18: * $Log: optim.c,v $
19: * Revision 1.2 86/02/12 15:28:39 rcs
20: * 4.3 F77. C. Keating.
21: *
22: * Revision 2.12 85/06/08 22:57:01 donn
23: * Prevent core dumps -- bug in optinsert was causing lastslot to be wrong
24: * when a slot was inserted at the end of the buffer.
25: *
26: * Revision 2.11 85/03/18 08:05:05 donn
27: * Prevent warnings about implicit conversions.
28: *
29: * Revision 2.10 85/02/12 20:13:00 donn
30: * Resurrected the hack in 2.6.1.1 to avoid creating a temporary when
31: * there is a concatenation on the rhs of an assignment, and threw out
32: * all the code dealing with starcat(). It seems that we can't use a
33: * temporary because the lhs as well as the rhs may have nonconstant length.
34: *
35: * Revision 2.9 85/01/18 00:53:52 donn
36: * Missed a call to free() in the last change...
37: *
38: * Revision 2.8 85/01/18 00:50:03 donn
39: * Fixed goof made when modifying buffmnmx() to explicitly call expand().
40: *
41: * Revision 2.7 85/01/15 18:47:35 donn
42: * Changes to allow character*(*) variables to appear in concatenations in
43: * the rhs of an assignment statement.
44: *
45: * Revision 2.6 84/12/16 21:46:27 donn
46: * Fixed bug that prevented concatenations from being run together. Changed
47: * buffpower() to not touch exponents greater than 64 -- let putpower do them.
48: *
49: * Revision 2.5 84/10/29 08:41:45 donn
50: * Added hack to flushopt() to prevent the compiler from trying to generate
51: * intermediate code after an error.
52: *
53: * Revision 2.4 84/08/07 21:28:00 donn
54: * Removed call to p2flush() in putopt() -- this allows us to make better use
55: * of the buffering on the intermediate code file.
56: *
57: * Revision 2.3 84/08/01 16:06:24 donn
58: * Forced expand() to expand subscripts.
59: *
60: * Revision 2.2 84/07/19 20:21:55 donn
61: * Decided I liked the expression tree algorithm after all. The algorithm
62: * which repeatedly squares temporaries is now checked in as rev. 2.1.
63: *
64: * Revision 1.3.1.1 84/07/10 14:18:18 donn
65: * I'm taking this branch off the trunk -- it works but it's not as good as
66: * the old version would be if it worked right.
67: *
68: * Revision 1.5 84/07/09 22:28:50 donn
69: * Added fix to buffpower() to prevent it chasing after huge exponents.
70: *
71: * Revision 1.4 84/07/09 20:13:59 donn
72: * Replaced buffpower() routine with a new one that generates trees which can
73: * be handled by CSE later on.
74: *
75: * Revision 1.3 84/05/04 21:02:07 donn
76: * Added fix for a bug in buffpower() that caused func(x)**2 to turn into
77: * func(x) * func(x). This bug had already been fixed in putpower()...
78: *
79: * Revision 1.2 84/03/23 22:47:21 donn
80: * The subroutine argument temporary fixes from Bob Corbett didn't take into
81: * account the fact that the code generator collects all the assignments to
82: * temporaries at the start of a statement -- hence the temporaries need to
83: * be initialized once per statement instead of once per call.
84: *
85: */
86:
87: #include "defs.h"
88: #include "optim.h"
89:
90:
91:
92: /*
93: * Information buffered for each slot type
94: *
95: * slot type expptr integer pointer
96: *
97: * IFN expr label -
98: * GOTO - label -
99: * LABEL - label -
100: * EQ expr - -
101: * CALL expr - -
102: * CMGOTO expr num labellist*
103: * STOP expr - -
104: * DOHEAD [1] - ctlframe*
105: * ENDDO [1] - ctlframe*
106: * ARIF expr - labellist*
107: * RETURN expr label -
108: * ASGOTO expr - labellist*
109: * PAUSE expr - -
110: * ASSIGN expr label -
111: * SKIOIFN expr label -
112: * SKFRTEMP expr - -
113: *
114: * Note [1]: the nullslot field is a pointer to a fake slot which is
115: * at the end of the slots which may be replaced by this slot. In
116: * other words, it looks like this:
117: * DOHEAD slot
118: * slot \
119: * slot > ordinary IF, GOTO, LABEL slots which implement the DO
120: * slot /
121: * NULL slot
122: */
123:
124:
125: expptr expand();
126:
127: Slotp firstslot = NULL;
128: Slotp lastslot = NULL;
129: int numslots = 0;
130:
131:
132: /*
133: * turns off optimization option
134: */
135:
136: optoff()
137:
138: {
139: flushopt();
140: optimflag = 0;
141: }
142:
143:
144:
145: /*
146: * initializes the code buffer for optimization
147: */
148:
149: setopt()
150:
151: {
152: register Slotp sp;
153:
154: for (sp = firstslot; sp; sp = sp->next)
155: free ( (charptr) sp);
156: firstslot = lastslot = NULL;
157: numslots = 0;
158: }
159:
160:
161:
162: /*
163: * flushes the code buffer
164: */
165:
166: LOCAL int alreadycalled = 0;
167:
168: flushopt()
169: {
170: register Slotp sp;
171: int savelineno;
172:
173: if (alreadycalled) return; /* to prevent recursive call during errors */
174: alreadycalled = 1;
175:
176: if (debugflag[1])
177: showbuffer ();
178:
179: frtempbuff ();
180:
181: savelineno = lineno;
182: for (sp = firstslot; sp; sp = sp->next)
183: {
184: if (nerr == 0)
185: putopt (sp);
186: else
187: frexpr (sp->expr);
188: if(sp->ctlinfo) free ( (charptr) sp->ctlinfo);
189: free ( (charptr) sp);
190: numslots--;
191: }
192: firstslot = lastslot = NULL;
193: numslots = 0;
194: clearbb();
195: lineno = savelineno;
196:
197: alreadycalled = 0;
198: }
199:
200:
201:
202: /*
203: * puts out code for the given slot (from the code buffer)
204: */
205:
206: LOCAL putopt (sp)
207: register Slotp sp;
208: {
209: lineno = sp->lineno;
210: switch (sp->type) {
211: case SKNULL:
212: break;
213: case SKIFN:
214: case SKIOIFN:
215: putif(sp->expr, sp->label);
216: break;
217: case SKGOTO:
218: putgoto(sp->label);
219: break;
220: case SKCMGOTO:
221: putcmgo(sp->expr, sp->label, sp->ctlinfo);
222: break;
223: case SKCALL:
224: putexpr(sp->expr);
225: break;
226: case SKSTOP:
227: putexpr (call1 (TYSUBR, "s_stop", sp->expr));
228: break;
229: case SKPAUSE:
230: putexpr (call1 (TYSUBR, "s_paus", sp->expr));
231: break;
232: case SKASSIGN:
233: puteq (sp->expr,
234: intrconv(sp->expr->headblock.vtype, mkaddcon(sp->label)));
235: break;
236: case SKDOHEAD:
237: case SKENDDO:
238: break;
239: case SKEQ:
240: putexpr(sp->expr);
241: break;
242: case SKARIF:
243: #define LM ((struct Labelblock * *)sp->ctlinfo)[0]->labelno
244: #define LZ ((struct Labelblock * *)sp->ctlinfo)[1]->labelno
245: #define LP ((struct Labelblock * *)sp->ctlinfo)[2]->labelno
246: prarif(sp->expr, LM, LZ, LP);
247: break;
248: case SKASGOTO:
249: putbranch((Addrp) sp->expr);
250: break;
251: case SKLABEL:
252: putlabel(sp->label);
253: break;
254: case SKRETURN:
255: if (sp->expr)
256: {
257: putforce(TYINT, sp->expr);
258: putgoto(sp->label);
259: }
260: else
261: putgoto(sp->label);
262: break;
263: case SKFRTEMP:
264: templist = mkchain (sp->expr,templist);
265: break;
266: default:
267: badthing("SKtype", "putopt", sp->type);
268: break;
269: }
270:
271: /*
272: * Recycle argument temporaries here. This must get done on a
273: * statement-by-statement basis because the code generator
274: * makes side effects happen at the start of a statement.
275: */
276: argtemplist = hookup(argtemplist, activearglist);
277: activearglist = CHNULL;
278: }
279:
280:
281:
282: /*
283: * copies one element of the control stack
284: */
285:
286: LOCAL struct Ctlframe *cpframe(p)
287: register char *p;
288: {
289: static int size = sizeof (struct Ctlframe);
290: register int n;
291: register char *q;
292: struct Ctlframe *q0;
293:
294: q0 = ALLOC(Ctlframe);
295: q = (char *) q0;
296: n = size;
297: while(n-- > 0)
298: *q++ = *p++;
299: return( q0);
300: }
301:
302:
303:
304: /*
305: * copies an array of labelblock pointers
306: */
307:
308: LOCAL struct Labelblock **cplabarr(n,arr)
309: struct Labelblock *arr[];
310: int n;
311: {
312: struct Labelblock **newarr;
313: register char *in, *out;
314: register int i,j;
315:
316: newarr = (struct Labelblock **) ckalloc (n * sizeof (char *));
317: for (i = 0; i < n; i++)
318: {
319: newarr[i] = ALLOC (Labelblock);
320: out = (char *) newarr[i];
321: in = (char *) arr[i];
322: j = sizeof (struct Labelblock);
323: while (j-- > 0)
324: *out++ = *in++;
325: }
326: return (newarr);
327: }
328:
329:
330:
331: /*
332: * creates a new slot in the code buffer
333: */
334:
335: LOCAL Slotp newslot()
336: {
337: register Slotp sp;
338:
339: ++numslots;
340: sp = ALLOC( slt );
341: sp->next = NULL ;
342: if (lastslot)
343: {
344: sp->prev = lastslot;
345: lastslot = lastslot->next = sp;
346: }
347: else
348: {
349: firstslot = lastslot = sp;
350: sp->prev = NULL;
351: }
352: sp->lineno = lineno;
353: return (sp);
354: }
355:
356:
357:
358: /*
359: * removes (but not deletes) the specified slot from the code buffer
360: */
361:
362: removeslot (sl)
363: Slotp sl;
364:
365: {
366: if (sl->next)
367: sl->next->prev = sl->prev;
368: else
369: lastslot = sl->prev;
370: if (sl->prev)
371: sl->prev->next = sl->next;
372: else
373: firstslot = sl->next;
374: sl->next = sl->prev = NULL;
375:
376: --numslots;
377: }
378:
379:
380:
381: /*
382: * inserts slot s1 before existing slot s2 in the code buffer;
383: * appends to end of list if s2 is NULL.
384: */
385:
386: insertslot (s1,s2)
387: Slotp s1,s2;
388:
389: {
390: if (s2)
391: {
392: if (s2->prev)
393: s2->prev->next = s1;
394: else
395: firstslot = s1;
396: s1->prev = s2->prev;
397: s2->prev = s1;
398: }
399: else
400: {
401: s1->prev = lastslot;
402: lastslot->next = s1;
403: lastslot = s1;
404: }
405: s1->next = s2;
406:
407: ++numslots;
408: }
409:
410:
411:
412: /*
413: * deletes the specified slot from the code buffer
414: */
415:
416: delslot (sl)
417: Slotp sl;
418:
419: {
420: removeslot (sl);
421:
422: if (sl->ctlinfo)
423: free ((charptr) sl->ctlinfo);
424: frexpr (sl->expr);
425: free ((charptr) sl);
426: numslots--;
427: }
428:
429:
430:
431: /*
432: * inserts a slot before the specified slot; if given NULL, it is
433: * inserted at the end of the buffer
434: */
435:
436: Slotp optinsert (type,p,l,c,currslot)
437: int type;
438: expptr p;
439: int l;
440: int *c;
441: Slotp currslot;
442:
443: {
444: Slotp savelast,new;
445:
446: savelast = lastslot;
447: if (currslot)
448: lastslot = currslot->prev;
449: new = optbuff (type,p,l,c);
450: new->next = currslot;
451: if (currslot)
452: currslot->prev = new;
453: new->lineno = -1; /* who knows what the line number should be ??!! */
454: if (currslot)
455: lastslot = savelast;
456: return (new);
457: }
458:
459:
460:
461: /*
462: * buffers the FRTEMP slots which have been waiting
463: */
464:
465: frtempbuff ()
466:
467: {
468: chainp ht;
469: register Slotp sp;
470:
471: for (ht = holdtemps; ht; ht = ht->nextp)
472: {
473: sp = newslot();
474: /* this slot actually belongs to some previous source line */
475: sp->lineno = sp->lineno - 1;
476: sp->type = SKFRTEMP;
477: sp->expr = (expptr) ht->datap;
478: sp->label = 0;
479: sp->ctlinfo = NULL;
480: }
481: holdtemps = NULL;
482: }
483:
484:
485:
486: /*
487: * puts the given information into a slot at the end of the code buffer
488: */
489:
490: Slotp optbuff (type,p,l,c)
491: int type;
492: expptr p;
493: int l;
494: int *c;
495:
496: {
497: register Slotp sp;
498:
499: if (debugflag[1])
500: {
501: fprintf (diagfile,"-----optbuff-----"); showslottype (type);
502: showexpr (p,0); fprintf (diagfile,"\n");
503: }
504:
505: p = expand (p);
506: sp = newslot();
507: sp->type = type;
508: sp->expr = p;
509: sp->label = l;
510: sp->ctlinfo = NULL;
511: switch (type)
512: {
513: case SKCMGOTO:
514: sp->ctlinfo = (int*) cplabarr (l, (struct Labelblock**) c);
515: break;
516: case SKARIF:
517: sp->ctlinfo = (int*) cplabarr (3, (struct Labelblock**) c);
518: break;
519: case SKDOHEAD:
520: case SKENDDO:
521: sp->ctlinfo = (int*) cpframe ((struct Ctlframe*) c);
522: break;
523: default:
524: break;
525: }
526:
527: frtempbuff ();
528:
529: return (sp);
530: }
531:
532:
533:
534: /*
535: * expands the given expression, if possible (e.g., concat, min, max, etc.);
536: * also frees temporaries when they are indicated as being the last use
537: */
538:
539: #define APPEND(z) \
540: res = res->exprblock.rightp = mkexpr (OPCOMMA, z, newtemp)
541:
542: LOCAL expptr expand (p)
543: tagptr p;
544:
545: {
546: Addrp t;
547: expptr q;
548: expptr buffmnmx(), buffpower();
549:
550: if (!p)
551: return (ENULL);
552: switch (p->tag)
553: {
554: case TEXPR:
555: switch (p->exprblock.opcode)
556: {
557: case OPASSIGN: /* handle a = b // c */
558: if (p->exprblock.vtype != TYCHAR)
559: goto standard;
560: q = p->exprblock.rightp;
561: if (!(q->tag == TEXPR &&
562: q->exprblock.opcode == OPCONCAT))
563: goto standard;
564: t = (Addrp) expand(p->exprblock.leftp);
565: frexpr(p->exprblock.vleng);
566: free( (charptr) p );
567: p = (tagptr) q;
568: goto cat;
569: case OPCONCAT:
570: t = mktemp (TYCHAR, ICON(lencat(p)));
571: cat:
572: q = (expptr) cpexpr (p->exprblock.vleng);
573: buffcat (cpexpr(t),p);
574: frexpr (t->vleng);
575: t->vleng = q;
576: p = (tagptr) t;
577: break;
578: case OPMIN:
579: case OPMAX:
580: p = (tagptr) buffmnmx (p);
581: break;
582: case OPPOWER:
583: p = (tagptr) buffpower (p);
584: break;
585: default:
586: standard:
587: p->exprblock.leftp =
588: expand (p->exprblock.leftp);
589: if (p->exprblock.rightp)
590: p->exprblock.rightp =
591: expand (p->exprblock.rightp);
592: break;
593: }
594: break;
595:
596: case TLIST:
597: {
598: chainp t;
599: for (t = p->listblock.listp; t; t = t->nextp)
600: t->datap = (tagptr) expand (t->datap);
601: }
602: break;
603:
604: case TTEMP:
605: if (p->tempblock.istemp)
606: frtemp(p);
607: break;
608:
609: case TADDR:
610: p->addrblock.memoffset = expand( p->addrblock.memoffset );
611: break;
612:
613: default:
614: break;
615: }
616: return ((expptr) p);
617: }
618:
619:
620:
621: /*
622: * local version of routine putcat in putpcc.c, called by expand
623: */
624:
625: LOCAL buffcat(lhs, rhs)
626: register Addrp lhs;
627: register expptr rhs;
628: {
629: int n;
630: Addrp lp, cp;
631:
632: n = ncat(rhs);
633: lp = (Addrp) mkaltmpn(n, TYLENG, PNULL);
634: cp = (Addrp) mkaltmpn(n, TYADDR, PNULL);
635:
636: n = 0;
637: buffct1(rhs, lp, cp, &n);
638:
639: optbuff (SKCALL, call4(TYSUBR, "s_cat", lhs, cp, lp, mkconv(TYLONG, ICON(n))),
640: 0, 0);
641: }
642:
643:
644:
645: /*
646: * local version of routine putct1 in putpcc.c, called by expand
647: */
648:
649: LOCAL buffct1(q, lp, cp, ip)
650: register expptr q;
651: register Addrp lp, cp;
652: int *ip;
653: {
654: int i;
655: Addrp lp1, cp1;
656:
657: if(q->tag==TEXPR && q->exprblock.opcode==OPCONCAT)
658: {
659: buffct1(q->exprblock.leftp, lp, cp, ip);
660: buffct1(q->exprblock.rightp, lp, cp, ip);
661: frexpr(q->exprblock.vleng);
662: free( (charptr) q );
663: }
664: else
665: {
666: i = (*ip)++;
667: lp1 = (Addrp) cpexpr(lp);
668: lp1->memoffset = mkexpr(OPPLUS,lp1->memoffset, ICON(i*SZLENG));
669: cp1 = (Addrp) cpexpr(cp);
670: cp1->memoffset = mkexpr(OPPLUS, cp1->memoffset, ICON(i*SZADDR));
671: optbuff (SKEQ, (mkexpr(OPASSIGN, lp1, cpexpr(q->headblock.vleng))),
672: 0,0);
673: optbuff (SKEQ, (mkexpr(OPASSIGN, cp1, addrof(expand (q)))), 0, 0);
674: }
675: }
676:
677:
678:
679: /*
680: * local version of routine putmnmx in putpcc.c, called by expand
681: */
682:
683: LOCAL expptr buffmnmx(p)
684: register expptr p;
685: {
686: int op, type;
687: expptr qp;
688: chainp p0, p1;
689: Addrp sp, tp;
690: Addrp newtemp;
691: expptr result, res;
692:
693: if(p->tag != TEXPR)
694: badtag("buffmnmx", p->tag);
695:
696: type = p->exprblock.vtype;
697: op = (p->exprblock.opcode==OPMIN ? OPLT : OPGT );
698: qp = expand(p->exprblock.leftp);
699: if(qp->tag != TLIST)
700: badtag("buffmnmx list", qp->tag);
701: p0 = qp->listblock.listp;
702: free( (charptr) qp );
703: free( (charptr) p );
704:
705: sp = mktemp(type, PNULL);
706: tp = mktemp(type, PNULL);
707: qp = mkexpr(OPCOLON, cpexpr(tp), cpexpr(sp));
708: qp = mkexpr(OPQUEST, mkexpr(op, cpexpr(tp),cpexpr(sp)), qp);
709: qp = fixexpr(qp);
710:
711: newtemp = mktemp (type,PNULL);
712:
713: result = res = mkexpr (OPCOMMA,
714: mkexpr( OPASSIGN, cpexpr(sp), p0->datap ), cpexpr(newtemp));
715:
716: for(p1 = p0->nextp ; p1 ; p1 = p1->nextp)
717: {
718: APPEND (mkexpr( OPASSIGN, cpexpr(tp), p1->datap ));
719: if(p1->nextp)
720: APPEND (mkexpr (OPASSIGN, cpexpr(sp), cpexpr(qp)) );
721: else
722: APPEND (mkexpr (OPASSIGN, cpexpr(newtemp), qp));
723: }
724:
725: frtemp(sp);
726: frtemp(tp);
727: frtemp(newtemp);
728: frchain( &p0 );
729:
730: return (result);
731: }
732:
733:
734:
735: /*
736: * Called by expand() to eliminate exponentiations to integer constants.
737: */
738: LOCAL expptr buffpower( p )
739: expptr p;
740: {
741: expptr base;
742: Addrp newtemp;
743: expptr storetemp = ENULL;
744: expptr powtree();
745: expptr result;
746: ftnint exp;
747:
748: if ( ! ISICON( p->exprblock.rightp ) )
749: fatal( "buffpower: bad non-integer exponent" );
750:
751: base = expand(p->exprblock.leftp);
752: exp = p->exprblock.rightp->constblock.const.ci;
753: if ( exp < 2 )
754: fatal( "buffpower: bad exponent less than 2" );
755:
756: if ( exp > 64 ) {
757: /*
758: * Let's be reasonable, here... Let putpower() do the job.
759: */
760: p->exprblock.leftp = base;
761: return ( p );
762: }
763:
764: /*
765: * If the base is not a simple variable, evaluate it and copy the
766: * result into a temporary.
767: */
768: if ( ! (base->tag == TADDR && ISCONST( base->addrblock.memoffset )) ) {
769: newtemp = mktemp( base->headblock.vtype, PNULL );
770: storetemp = mkexpr( OPASSIGN,
771: cpexpr( (expptr) newtemp ),
772: cpexpr( base ) );
773: base = (expptr) newtemp;
774: }
775:
776: result = powtree( base, exp );
777:
778: if ( storetemp != ENULL )
779: result = mkexpr( OPCOMMA, storetemp, result );
780: frexpr( p );
781:
782: return ( result );
783: }
784:
785:
786:
787: /*
788: * powtree( base, exp ) -- Create a tree of multiplications which computes
789: * base ** exp. The tree is built so that CSE will compact it if
790: * possible. The routine works by creating subtrees that compute
791: * exponents which are powers of two, then multiplying these
792: * together to get the result; this gives a log2( exp ) tree depth
793: * and lots of subexpressions which can be eliminated.
794: */
795: LOCAL expptr powtree( base, exp )
796: expptr base;
797: register ftnint exp;
798: {
799: register expptr r = ENULL, r1;
800: register int i;
801:
802: for ( i = 0; exp; ++i, exp >>= 1 )
803: if ( exp & 1 )
804: if ( i == 0 )
805: r = (expptr) cpexpr( base );
806: else {
807: r1 = powtree( base, 1 << (i - 1) );
808: r1 = mkexpr( OPSTAR, r1, cpexpr( r1 ) );
809: r = (r ? mkexpr( OPSTAR, r1, r ) : r1);
810: }
811:
812: return ( r );
813: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.