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