![[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] / 42BSD / usr.bin / f77 / src / f77pass1|
Return to optim.c CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1 |
1.1 root 1: /* %W% (Berkeley) %G% */
2: #include "defs.h"
3: #include "optim.h"
4:
5:
6:
7: /*
8: * Information buffered for each slot type
9: *
10: * slot type expptr integer pointer
11: *
12: * IFN expr label -
13: * GOTO - label -
14: * LABEL - label -
15: * EQ expr - -
16: * CALL expr - -
17: * CMGOTO expr num labellist*
18: * STOP expr - -
19: * DOHEAD [1] - ctlframe*
20: * ENDDO [1] - ctlframe*
21: * ARIF expr - labellist*
22: * RETURN expr label -
23: * ASGOTO expr - labellist*
24: * PAUSE expr - -
25: * ASSIGN expr label -
26: * SKIOIFN expr label -
27: * SKFRTEMP expr - -
28: *
29: * Note [1]: the nullslot field is a pointer to a fake slot which is
30: * at the end of the slots which may be replaced by this slot. In
31: * other words, it looks like this:
32: * DOHEAD slot
33: * slot \
34: * slot > ordinary IF, GOTO, LABEL slots which implement the DO
35: * slot /
36: * NULL slot
37: */
38:
39:
40: expptr expand();
41:
42: Slotp firstslot = NULL;
43: Slotp lastslot = NULL;
44: int numslots = 0;
45:
46:
47: /*
48: * turns off optimization option
49: */
50:
51: optoff()
52:
53: {
54: flushopt();
55: optimflag = 0;
56: }
57:
58:
59:
60: /*
61: * initializes the code buffer for optimization
62: */
63:
64: setopt()
65:
66: {
67: register Slotp sp;
68:
69: for (sp = firstslot; sp; sp = sp->next)
70: free ( (charptr) sp);
71: firstslot = lastslot = NULL;
72: numslots = 0;
73: }
74:
75:
76:
77: /*
78: * flushes the code buffer
79: */
80:
81: LOCAL int alreadycalled = 0;
82:
83: flushopt()
84: {
85: register Slotp sp;
86: int savelineno;
87:
88: if (alreadycalled) return; /* to prevent recursive call during errors */
89: alreadycalled = 1;
90:
91: if (debugflag[1])
92: showbuffer ();
93:
94: frtempbuff ();
95:
96: savelineno = lineno;
97: for (sp = firstslot; sp; sp = sp->next)
98: {
99: putopt(sp);
100: if(sp->ctlinfo) free ( (charptr) sp->ctlinfo);
101: free ( (charptr) sp);
102: numslots--;
103: }
104: firstslot = lastslot = NULL;
105: numslots = 0;
106: clearbb();
107: lineno = savelineno;
108:
109: alreadycalled = 0;
110: }
111:
112:
113:
114: /*
115: * puts out code for the given slot (from the code buffer)
116: */
117:
118: LOCAL putopt (sp)
119: register Slotp sp;
120: {
121: p2flush();
122: lineno = sp->lineno;
123: switch (sp->type) {
124: case SKNULL:
125: break;
126: case SKIFN:
127: case SKIOIFN:
128: putif(sp->expr, sp->label);
129: break;
130: case SKGOTO:
131: putgoto(sp->label);
132: break;
133: case SKCMGOTO:
134: putcmgo(sp->expr, sp->label, sp->ctlinfo);
135: break;
136: case SKCALL:
137: putexpr(sp->expr);
138: break;
139: case SKSTOP:
140: putexpr (call1 (TYSUBR, "s_stop", sp->expr));
141: break;
142: case SKPAUSE:
143: putexpr (call1 (TYSUBR, "s_paus", sp->expr));
144: break;
145: case SKASSIGN:
146: puteq (sp->expr, mkaddcon(sp->label));
147: break;
148: case SKDOHEAD:
149: case SKENDDO:
150: break;
151: case SKEQ:
152: putexpr(sp->expr);
153: break;
154: case SKARIF:
155: #define LM ((struct Labelblock * *)sp->ctlinfo)[0]->labelno
156: #define LZ ((struct Labelblock * *)sp->ctlinfo)[1]->labelno
157: #define LP ((struct Labelblock * *)sp->ctlinfo)[2]->labelno
158: prarif(sp->expr, LM, LZ, LP);
159: break;
160: case SKASGOTO:
161: putbranch((Addrp) sp->expr);
162: break;
163: case SKLABEL:
164: putlabel(sp->label);
165: break;
166: case SKRETURN:
167: if (sp->expr)
168: {
169: putforce(TYINT, sp->expr);
170: putgoto(sp->label);
171: }
172: else
173: putgoto(sp->label);
174: break;
175: case SKFRTEMP:
176: templist = mkchain (sp->expr,templist);
177: break;
178: default:
179: badthing("SKtype", "putopt", sp->type);
180: break;
181: }
182: }
183:
184:
185:
186: /*
187: * copies one element of the control stack
188: */
189:
190: LOCAL struct Ctlframe *cpframe(p)
191: register char *p;
192: {
193: static int size = sizeof (struct Ctlframe);
194: register int n;
195: register char *q;
196: struct Ctlframe *q0;
197:
198: q0 = ALLOC(Ctlframe);
199: q = (char *) q0;
200: n = size;
201: while(n-- > 0)
202: *q++ = *p++;
203: return( q0);
204: }
205:
206:
207:
208: /*
209: * copies an array of labelblock pointers
210: */
211:
212: LOCAL struct Labelblock **cplabarr(n,arr)
213: struct Labelblock *arr[];
214: int n;
215: {
216: struct Labelblock **newarr;
217: register char *in, *out;
218: register int i,j;
219:
220: newarr = (struct Labelblock **) ckalloc (n * sizeof (char *));
221: for (i = 0; i < n; i++)
222: {
223: newarr[i] = ALLOC (Labelblock);
224: out = (char *) newarr[i];
225: in = (char *) arr[i];
226: j = sizeof (struct Labelblock);
227: while (j-- > 0)
228: *out++ = *in++;
229: }
230: return (newarr);
231: }
232:
233:
234:
235: /*
236: * creates a new slot in the code buffer
237: */
238:
239: LOCAL Slotp newslot()
240: {
241: register Slotp sp;
242:
243: ++numslots;
244: sp = ALLOC( slt );
245: sp->next = NULL ;
246: if (lastslot)
247: {
248: sp->prev = lastslot;
249: lastslot = lastslot->next = sp;
250: }
251: else
252: {
253: firstslot = lastslot = sp;
254: sp->prev = NULL;
255: }
256: sp->lineno = lineno;
257: return (sp);
258: }
259:
260:
261:
262: /*
263: * removes (but not deletes) the specified slot from the code buffer
264: */
265:
266: removeslot (sl)
267: Slotp sl;
268:
269: {
270: if (sl->next)
271: sl->next->prev = sl->prev;
272: else
273: lastslot = sl->prev;
274: if (sl->prev)
275: sl->prev->next = sl->next;
276: else
277: firstslot = sl->next;
278: sl->next = sl->prev = NULL;
279:
280: --numslots;
281: }
282:
283:
284:
285: /*
286: * inserts slot s1 before existing slot s2 in the code buffer;
287: * appends to end of list if s2 is NULL.
288: */
289:
290: insertslot (s1,s2)
291: Slotp s1,s2;
292:
293: {
294: if (s2)
295: {
296: if (s2->prev)
297: s2->prev->next = s1;
298: else
299: firstslot = s1;
300: s1->prev = s2->prev;
301: s2->prev = s1;
302: }
303: else
304: {
305: s1->prev = lastslot;
306: lastslot->next = s1;
307: lastslot = s1;
308: }
309: s1->next = s2;
310:
311: ++numslots;
312: }
313:
314:
315:
316: /*
317: * deletes the specified slot from the code buffer
318: */
319:
320: delslot (sl)
321: Slotp sl;
322:
323: {
324: removeslot (sl);
325:
326: if (sl->ctlinfo)
327: free ((charptr) sl->ctlinfo);
328: frexpr (sl->expr);
329: free ((charptr) sl);
330: numslots--;
331: }
332:
333:
334:
335: /*
336: * inserts a slot before the specified slot; if given NULL, it is
337: * inserted at the end of the buffer
338: */
339:
340: Slotp optinsert (type,p,l,c,currslot)
341: int type;
342: expptr p;
343: int l;
344: int *c;
345: Slotp currslot;
346:
347: {
348: Slotp savelast,new;
349:
350: savelast = lastslot;
351: if (currslot)
352: lastslot = currslot->prev;
353: new = optbuff (type,p,l,c);
354: new->next = currslot;
355: if (currslot)
356: currslot->prev = new;
357: new->lineno = -1; /* who knows what the line number should be ??!! */
358: lastslot = savelast;
359: return (new);
360: }
361:
362:
363:
364: /*
365: * buffers the FRTEMP slots which have been waiting
366: */
367:
368: frtempbuff ()
369:
370: {
371: chainp ht;
372: register Slotp sp;
373:
374: for (ht = holdtemps; ht; ht = ht->nextp)
375: {
376: sp = newslot();
377: /* this slot actually belongs to some previous source line */
378: sp->lineno = sp->lineno - 1;
379: sp->type = SKFRTEMP;
380: sp->expr = (expptr) ht->datap;
381: sp->label = 0;
382: sp->ctlinfo = NULL;
383: }
384: holdtemps = NULL;
385: }
386:
387:
388:
389: /*
390: * puts the given information into a slot at the end of the code buffer
391: */
392:
393: Slotp optbuff (type,p,l,c)
394: int type;
395: expptr p;
396: int l;
397: int *c;
398:
399: {
400: register Slotp sp;
401:
402: if (debugflag[1])
403: {
404: fprintf (diagfile,"-----optbuff-----"); showslottype (type);
405: showexpr (p,0); fprintf (diagfile,"\n");
406: }
407:
408: p = expand (p);
409: sp = newslot();
410: sp->type = type;
411: sp->expr = p;
412: sp->label = l;
413: sp->ctlinfo = NULL;
414: switch (type)
415: {
416: case SKCMGOTO:
417: sp->ctlinfo = (int*) cplabarr (l, (struct Labelblock**) c);
418: break;
419: case SKARIF:
420: sp->ctlinfo = (int*) cplabarr (3, (struct Labelblock**) c);
421: break;
422: case SKDOHEAD:
423: case SKENDDO:
424: sp->ctlinfo = (int*) cpframe ((struct Ctlframe*) c);
425: break;
426: default:
427: break;
428: }
429:
430: frtempbuff ();
431:
432: return (sp);
433: }
434:
435:
436:
437: /*
438: * expands the given expression, if possible (e.g., concat, min, max, etc.);
439: * also frees temporaries when they are indicated as being the last use
440: */
441:
442: #define APPEND(z) \
443: res = res->exprblock.rightp = mkexpr (OPCOMMA, z, newtemp)
444:
445: LOCAL expptr expand (p)
446: tagptr p;
447:
448: {
449: Addrp t;
450: expptr q;
451: Addrp buffmnmx(), buffpower();
452:
453: if (!p)
454: return (ENULL);
455: switch (p->tag)
456: {
457: case TEXPR:
458: p->exprblock.leftp = expand (p->exprblock.leftp);
459: if (p->exprblock.rightp)
460: p->exprblock.rightp = expand (p->exprblock.rightp);
461: switch (p->exprblock.opcode)
462: {
463: expptr temp;
464: case OPCONCAT:
465: t = mktemp (TYCHAR, ICON(lencat(p)));
466: q = (expptr) cpexpr (p->exprblock.vleng);
467: buffcat (cpexpr(t),p);
468: frexpr (t->vleng);
469: t->vleng = q;
470: p = (tagptr) t;
471: break;
472: case OPMIN:
473: case OPMAX:
474: p = (tagptr) buffmnmx (p);
475: break;
476: case OPPOWER:
477: p = (tagptr) buffpower (p);
478: break;
479: default:
480: break;
481: }
482: break;
483:
484: case TLIST:
485: {
486: chainp t;
487: for (t = p->listblock.listp; t; t = t->nextp)
488: t->datap = (tagptr) expand (t->datap);
489: }
490: break;
491:
492: case TTEMP:
493: if (p->tempblock.istemp)
494: frtemp(p);
495: break;
496:
497: default:
498: break;
499: }
500: return ((expptr) p);
501: }
502:
503:
504:
505: /*
506: * local version of routine putcat in putpcc.c, called by expand
507: */
508:
509: LOCAL buffcat(lhs, rhs)
510: register Addrp lhs;
511: register expptr rhs;
512: {
513: int n;
514: Addrp lp, cp;
515:
516: n = ncat(rhs);
517: lp = (Addrp) mkaltmpn(n, TYLENG, PNULL);
518: cp = (Addrp) mkaltmpn(n, TYADDR, PNULL);
519:
520: n = 0;
521: buffct1(rhs, lp, cp, &n);
522:
523: optbuff (SKCALL, call4(TYSUBR, "s_cat", lhs, cp, lp, mkconv(TYLONG, ICON(n))),
524: 0, 0);
525: }
526:
527:
528:
529: /*
530: * local version of routine putct1 in putpcc.c, called by expand
531: */
532:
533: LOCAL buffct1(q, lp, cp, ip)
534: register expptr q;
535: register Addrp lp, cp;
536: int *ip;
537: {
538: int i;
539: Addrp lp1, cp1;
540:
541: if(q->tag==TEXPR && q->exprblock.opcode==OPCONCAT)
542: {
543: buffct1(q->exprblock.leftp, lp, cp, ip);
544: buffct1(q->exprblock.rightp, lp, cp, ip);
545: frexpr(q->exprblock.vleng);
546: free( (charptr) q );
547: }
548: else
549: {
550: i = (*ip)++;
551: lp1 = (Addrp) cpexpr(lp);
552: lp1->memoffset = mkexpr(OPPLUS,lp1->memoffset, ICON(i*SZLENG));
553: cp1 = (Addrp) cpexpr(cp);
554: cp1->memoffset = mkexpr(OPPLUS, cp1->memoffset, ICON(i*SZADDR));
555: optbuff (SKEQ, (mkexpr(OPASSIGN, lp1, cpexpr(q->headblock.vleng))),
556: 0,0);
557: optbuff (SKEQ, (mkexpr(OPASSIGN, cp1, addrof(expand (q)))), 0, 0);
558: }
559: }
560:
561:
562:
563: /*
564: * local version of routine putmnmx in putpcc.c, called by expand
565: */
566:
567: LOCAL Addrp buffmnmx(p)
568: register expptr p;
569: {
570: int op, type;
571: expptr qp;
572: chainp p0, p1;
573: Addrp sp, tp;
574: Addrp newtemp;
575: expptr result, res;
576:
577: if(p->tag != TEXPR)
578: badtag("buffmnmx", p->tag);
579:
580: type = p->exprblock.vtype;
581: op = (p->exprblock.opcode==OPMIN ? OPLT : OPGT );
582: p0 = p->exprblock.leftp->listblock.listp;
583: free( (charptr) (p->exprblock.leftp) );
584: free( (charptr) p );
585:
586: sp = mktemp(type, PNULL);
587: tp = mktemp(type, PNULL);
588: qp = mkexpr(OPCOLON, cpexpr(tp), cpexpr(sp));
589: qp = mkexpr(OPQUEST, mkexpr(op, cpexpr(tp),cpexpr(sp)), qp);
590: qp = fixexpr(qp);
591:
592: newtemp = mktemp (type,PNULL);
593:
594: result = res = mkexpr (OPCOMMA,
595: mkexpr( OPASSIGN, cpexpr(sp), p0->datap ), cpexpr(newtemp));
596:
597: for(p1 = p0->nextp ; p1 ; p1 = p1->nextp)
598: {
599: APPEND (mkexpr( OPASSIGN, cpexpr(tp), p1->datap ));
600: if(p1->nextp)
601: APPEND (mkexpr (OPASSIGN, cpexpr(sp), cpexpr(qp)) );
602: else
603: APPEND (mkexpr (OPASSIGN, cpexpr(newtemp), qp));
604: }
605:
606: frtemp(sp);
607: frtemp(tp);
608: frtemp(newtemp);
609: frchain( &p0 );
610:
611: return ( (Addrp) result);
612: }
613:
614:
615:
616: /*
617: * Local version of putpower routine from putpcc.c, used by expand().
618: */
619:
620: LOCAL Addrp buffpower (p)
621: expptr p;
622: {
623: expptr base;
624: Addrp t1, t2;
625: ftnint k;
626: int type;
627: Addrp newtemp;
628: expptr res,result;
629:
630: if(!ISICON(p->exprblock.rightp) ||
631: (k = p->exprblock.rightp->constblock.const.ci)<2)
632: fatal("buffpower: bad call");
633: base = p->exprblock.leftp;
634:
635: if (k == 2)
636: {
637: expptr prod;
638: prod = mkexpr (OPSTAR,cpexpr(base),cpexpr(base));
639: return ( (Addrp) prod);
640: }
641:
642: type = base->headblock.vtype;
643: newtemp = mktemp (type, PNULL);
644:
645: t1 = mktemp(type, PNULL);
646: t2 = NULL;
647: result = res =
648: mkexpr (OPCOMMA, mkexpr (OPASSIGN,cpexpr(t1),cpexpr(base)),
649: cpexpr (newtemp));
650:
651: for( ; (k&1)==0 && k>2 ; k>>=1 )
652: APPEND (mkexpr (OPSTAREQ,cpexpr(t1),cpexpr(t1)));
653:
654: if(k == 2)
655: {
656: expptr prod;
657: prod = mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1));
658: APPEND (mkexpr (OPASSIGN,cpexpr(newtemp),cpexpr(prod)));
659: }
660: else
661: {
662: t2 = mktemp(type, PNULL);
663: APPEND (mkexpr (OPASSIGN,cpexpr(t2),cpexpr(t1)));
664:
665: for(k>>=1 ; k>1 ; k>>=1)
666: {
667: APPEND (mkexpr (OPSTAREQ,cpexpr(t1),cpexpr(t1)));
668: if(k & 1)
669: APPEND (mkexpr (OPSTAREQ,cpexpr(t2),cpexpr(t1)));
670: }
671: APPEND (mkexpr (OPASSIGN, cpexpr(newtemp), mkexpr(OPSTAR, cpexpr(t2),
672: mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) )));
673: }
674: frexpr(t1);
675: if(t2)
676: frexpr(t2);
677: frexpr(p);
678:
679: return ( (Addrp) result);
680: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.