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