optim.p

<B>Digital的Unix操作系统VAX 4.2源码</B>

(*#@(#)optim.p	4.1	Ultrix	7/17/90 *)
(****************************************************************************
 *									    *
 *  Copyright (c) 1984 by						    *
 *  DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts.		    *
 *  All rights reserved.						    *
 * 									    *
 *  This software is furnished under a license and may be used and copied   *
 *  only in  accordance with  the  terms  of  such  license  and with the   *
 *  inclusion of the above copyright notice. This software or  any  other   *
 *  copies thereof may not be provided or otherwise made available to any   *
 *  other person.  No title to and ownership of  the  software is  hereby   *
 *  transferred.							    *
 * 									    *
 *  The information in this software is  subject to change without notice   *
 *  and  should  not  be  construed as  a commitment by DIGITAL EQUIPMENT   *
 *  CORPORATION.							    *
 * 									    *
 *  DIGITAL assumes no responsibility for the use  or  reliability of its   *
 *  software on equipment which is not supplied by DIGITAL.		    *
 * 									    *
$Header: optim.p,v 1.7 84/06/06 13:04:29 powell Exp $
 ****************************************************************************)
#include "globals.h"
#include "const.h"
#include "bexpr.h"
#include "optim.h"
#include "otree.h"
#include "ocount.h"
#include "builtin.h"

const
    NUMOPTEXP = 10000;
var
    optBlockLevel, optBlockCeiling, optBlockFloor : OptBlockLevel;
    activeExprs : OptNode;	{ dummy root for all non-purged expressions }
    allExprs : OptNode;		{ dummy root for all expressions }
    generateUniqueId : integer;
    { the following table is the map from ExprNodes to OptNodes }
    { It is used ONLY to avoid recompilations during development }
    idToOpt : array [0..NUMOPTEXP] of OptNode;
    markItCount : integer;
    addressUnit : cardinal;

function ExprToOpt{(en : ExprNode) : OptNode};
begin
    if en = nil then begin
	ExprToOpt := nil;
    end else begin
	ExprToOpt := idToOpt[en^.opt];
    end;
end;

{ Set up new one expecting no matches }
function NewOptNode(expr, parent : ExprNode) : OptNode;
var
    newOne : OptNode;
begin
    new(newOne);
    newOne^.uniqueId := generateUniqueId;
    if TraceOptim then begin
	writeln('NewOptNode:',newOne^.uniqueId:1);
    end;
    expr^.opt := newOne^.uniqueId;	{ "backward pointer" }
    idToOpt[expr^.opt] := newOne;
    generateUniqueId := generateUniqueId + 1;
    newOne^.nextClass := newOne;
    newOne^.prevClass := newOne;
    newOne^.nextCongruent := newOne;
    newOne^.prevCongruent := newOne;
    newOne^.rootCongruent := newOne;
    newOne^.nextEqual := newOne;
    newOne^.prevEqual := newOne;
    newOne^.rootEqual := newOne;
    newOne^.createLevel := optBlockLevel;
    newOne^.markLevel := 0;
    newOne^.joinMarkLevel := 0;
    newOne^.marked := false;
    newOne^.joinMark := false;
    newOne^.purged := false;
    newOne^.removed := false;
    newOne^.expr := expr;
    newOne^.parent := parent;
    newOne^.tempNumber := NULLTEMP;
    newOne^.usage := OUSEINDIVIDUAL;
    newOne^.nonTrivial := false;
    newOne^.eligible := false;
    newOne^.address := false;
    newOne^.containedNonTrivial := nil;
    newOne^.tailRecursion := false;
    newOne^.loopConsidered := false;
    newOne^.neededCount := 1;
    newOne^.referencedCount := 1;
    newOne^.loopNest := optLoopNest;
    newOne^.usedCount := 0;
    newOne^.defineTime := 0;
    AddToAllList(allExprs^.prevAll,newOne);
    newOne^.nextActive := nil;
    newOne^.prevActive := nil;
    NewOptNode := newOne;
end;


procedure ResetOptimizer;
var
    ek : ExprKind;
    token : Token;
    i : integer;
begin
    for ek := EXPRBAD to EXPRCHECK do begin
	cseRootExpr[ek] := nil;
    end;
    for token := TKENDOFFILE to TKNULL do begin
	cseRootUnOp[token] := nil;
	cseRootBinOp[token] := nil;
    end;
    new(activeExprs);
    activeExprs^.nextActive := activeExprs;
    activeExprs^.prevActive := activeExprs;
    new(allExprs);
    allExprs^.nextAll := allExprs;
    allExprs^.prevAll := allExprs;
    optTime := 1;
end;

procedure InitOptimizer;
var
    i : integer;
begin
    case target of
	TARGETVAX : addressUnit := BYTESIZE;
	TARGETTITAN : addressUnit := WORDSIZE;
    end;
    for i := 0 to NUMOPTEXP do begin
	idToOpt[i] := nil;
    end;
    generateUniqueId := 1;
    optLoopNest := 1;
    ResetOptimizer;
end;

procedure OptJoin;
var
    ron, on : OptNode;
begin
    if TraceOpt then begin
	writeln(output,'Join ',optBlockLevel:1);
    end;
    on := activeExprs^.nextActive;
    markItCount := 0;
    while on <> activeExprs do begin
	if (on^.markLevel >= optBlockLevel) or
		(on^.joinMarkLevel >= optBlockLevel)
	then begin
	    on^.marked := true;
	    on^.markLevel := optBlockLevel;
	    on^.joinMark := false;
	    on^.joinMarkLevel := 0;
	    if TraceMark then begin
		write(output,'<+',on^.uniqueId:1,'>');
		markItCount := markItCount + 1;
		if markItCount > 20 then begin
		    writeln(output);
		    markItCount := 0;
		end;
	    end;
	end;
	on := on^.nextActive;
    end;
end;

procedure OptRefresh;
var
    on, nextActive : OptNode;
begin
    if TraceOpt then begin
	writeln(output,'Refresh ',optBlockLevel:1);
    end;
    markItCount := 0;
    on := activeExprs^.nextActive;
    while on <> activeExprs do begin
	nextActive := on^.nextActive;
	if on^.createLevel >= optBlockCeiling then begin
	    { purge expression }
	    on^.purged := true;
	    RemoveFromActiveList(on);
	    if TraceMark then begin
		write(output,'<X',on^.uniqueId:1,'>');
		markItCount := markItCount + 1;
		if markItCount > 20 then begin
		    writeln(output);
		    markItCount := 0;
		end;
	    end;
	end else if on^.markLevel >= optBlockCeiling then begin
	    on^.joinMark := on^.joinMark or on^.marked;
	    on^.joinMarkLevel := optBlockCeiling;
	    on^.marked := false;
	    on^.markLevel := 0;
	    if TraceMark then begin
		write(output,'<-',on^.uniqueId:1,'>');
		markItCount := markItCount + 1;
		if markItCount > 20 then begin
		    writeln(output);
		    markItCount := 0;
		end;
	    end;
	end;
	on := nextActive;
    end;
end;

{ CopyExpr: duplicate the expression tree (including associated OptNodes)}
{  Make the expressions be at the specified level }
function CopyExpr(en : ExprNode; sol : SaveOptLevel; parent : ExprNode)
	: ExprNode;
var
    on, eon, non, ron, search : OptNode;
    nen, pen, npen : ExprNode;
    npl : ExprList;
    found : boolean;
begin
    nen := NewExprNode(en^.kind);
    SameExprLine(nen,en);
    nen^.exprType := en^.exprType;
    nen^ := en^;	{ copy miscellaneous fields }
    case en^.kind of
	EXPRCONST :	nen^.exprConst := en^.exprConst;
	EXPRVAR :	nen^.exprVar := en^.exprVar;
	EXPRNAME,
	EXPRSYM,
	EXPRSET : ExprError(en,'CopyExpr: unexpected expr');
	EXPRUNOP : begin
	    nen^.opnd := CopyExpr(en^.opnd,sol,nen);
	    nen^.exprUnOp := en^.exprUnOp;
	end;
	EXPRBINOP : begin
	    nen^.opnd1 := CopyExpr(en^.opnd1,sol,nen);
	    nen^.opnd2 := CopyExpr(en^.opnd2,sol,nen);
	    nen^.exprBinOp := en^.exprBinOp;
	    nen^.operType := en^.operType;
	end;
	EXPRSUBSCR : begin
	    nen^.arr := CopyExpr(en^.arr,sol,nen);
	    nen^.subsExpr := CopyExpr(en^.subsExpr,sol,nen);
	    nen^.subsOffset := en^.subsOffset;
	end;
	EXPRDOT : begin
	    nen^.rec := CopyExpr(en^.rec,sol,nen);
	    nen^.fieldName := en^.fieldName;
	    nen^.field := en^.field;
	end;
	EXPRDEREF : begin
	    nen^.ptr := CopyExpr(en^.ptr,sol,nen);
	    nen^.realPtr := en^.realPtr;
	end;
	EXPRFUNC : begin
	    nen^.func := CopyExpr(en^.func,sol,nen);
	    npl := AddToExprList(nil,nil);
	    pen := en^.params^.first;
	    while pen <> nil do begin
		npen := CopyExpr(pen,sol,nen);
		npl := AddToExprList(npl,npen);
		pen := pen^.next;
	    end;
	    nen^.params := npl;
	end;
	EXPRVAL : begin
	    nen^.exprVal := CopyExpr(en^.exprVal,sol,nen);
	end;
	EXPRCHECK : begin
	    nen^.checkExpr := CopyExpr(en^.checkExpr,sol,nen);
	end;
    end;
    on := ExprToOpt(en);
    non := NewOptNode(nen,nil);
    { make it look as if it were created outside the loop }
    non^.createLevel := sol.level;
    non^.address := on^.address;
    non^.nonTrivial := on^.nonTrivial;
    non^.containedNonTrivial := on^.containedNonTrivial;
    non^.eligible := on^.eligible;
    non^.parent := parent;
    ron := on^.rootEqual;
    if TraceOptim then begin
	writeln(output,'CopyExpr: id=',on^.uniqueId:1,'/',
	    ron^.uniqueId:1,' create=',ron^.createLevel:1,
	    ' level=',sol.level:1);
    end;
    { search for an equal expression in the enclosing block }
    search := ron^.rootCongruent;
    found := false;
    repeat
	if (search^.rootEqual <> search) or search^.marked or search^.purged
		or (search^.createLevel > sol.ceiling)
		or (search^.createLevel < sol.floor)
	then begin
	    { not equal }
	    search := search^.nextCongruent;
	end else begin
	    { equal }
	    found := true;
	end;
    until found or (search = ron^.rootCongruent);
    if found then begin
	{ expression is already in outer block, make this another reference }
	AddToEqualList(search,non);
	if search <> ron then begin
	    { Consolidate this equal list with the outer one }
	    if TraceOptim then begin
		writeln(output,'CopyExpr: adding to list');
		PrintOptExpr(search);
		PrintOptExpr(ron);
		PrintOptExpr(non);
	    end;
	    { Add in counts from inner block expression }
	    search^.neededCount := search^.neededCount + ron^.neededCount;
	    search^.referencedCount := search^.referencedCount
					    + ron^.referencedCount;
	    { append the inner equal list to the outer one }
	    { fix up root pointer }
	    eon := ron;
	    repeat
		eon^.rootEqual := search;
		eon := eon^.nextEqual;
	    until eon = ron;
	    { append lists }
	    search^.prevEqual^.nextEqual := ron;
	    ron^.prevEqual^.nextEqual := search;
	    eon := search^.prevEqual;
	    search^.prevEqual := ron^.prevEqual;
	    ron^.prevEqual := eon;
	end;
    end else begin
	{ expression is needed once by pre-evaluation }
	non^.neededCount := ron^.neededCount + 1;
	{ consider pre-evaluation another reference }
	non^.referencedCount := ron^.referencedCount + 1;
	{ make this be the root equal expression }
	eon := ron;
	repeat
	    eon^.rootEqual := non;
	    eon := eon^.nextEqual;
	until eon = ron;
	{ insert new OptNode in front of rootEqual }
	non^.prevEqual := ron^.prevEqual;
	non^.nextEqual := ron;
	ron^.prevEqual^.nextEqual := non;
	ron^.prevEqual := non;
	AddToCongruentList(ron^.rootCongruent^.prevCongruent,non);
    end;
    CopyExpr := nen;
end;

procedure InductionExpr(indexen, patternen : ExprNode; var opnden : ExprNode;
    sol : SaveOptLevel; opnd1 : boolean);
var
    newen, olden, otheren : ExprNode;
    newon, opndon, otheron : OptNode;
    time : OptTime;
    constant : boolean;
    constVal : cardinal;
begin
    opndon := ExprToOpt(opnden);
    if opnd1 then begin
	constant := (patternen^.opnd2^.kind = EXPRCONST)
			and (opnden^.kind = EXPRCONST);
	if constant then begin
	    constVal := OrdOf(patternen^.opnd2^.exprConst);
	end;
    end else begin
	constant := (patternen^.opnd1^.kind = EXPRCONST)
			and (opnden^.kind = EXPRCONST);
	if constant then begin
	    constVal := OrdOf(patternen^.opnd1^.exprConst);
	end;
    end;
    if constant then begin
	case patternen^.exprBinOp of
	    TKPLUS : constVal := constVal + OrdOf(opnden^.exprConst);
	    TKMINUS : constVal := -constVal + OrdOf(opnden^.exprConst);
	    TKASTERISK : constVal := constVal * OrdOf(opnden^.exprConst);
	end;
	ReduceNeededCounts(opndon,1);
	opndon^.purged := true;
	RemoveFromActiveList(opndon);
	{ copy expression node so OptNodes will still be valid }
	olden := NewExprNode(EXPRCONST);
	olden^ := opnden^;
	opnden^.kind := EXPRCONST;
	opnden^.exprConst := CardinalConst(constVal);
	opnden^.exprType := patternen^.exprType;
	time := EnterExpr(opnden,nil,0);
	opndon^.expr := olden;
	opndon^.parent := nil;	{ expr is now detached }
    end else begin
	newen := NewExprNode(EXPRBINOP);
	SameExprLine(newen,opnden);
	newen^.exprBinOp := patternen^.exprBinOp;
	newen^.exprType := patternen^.exprType;
	newen^.operType := patternen^.operType;
	if opnd1 then begin
	    newen^.opnd2 := CopyExpr(patternen^.opnd2,sol,newen);
	    otheren := patternen^.opnd2;
	    newen^.opnd1 := opnden;
	end else begin
	    newen^.opnd1 := CopyExpr(patternen^.opnd1,sol,newen);
	    otheren := patternen^.opnd1;
	    newen^.opnd2 := opnden;
	end;
	otheron := ExprToOpt(otheren);
	opndon^.parent := newen;
	time := Latest(opndon^.rootCongruent^.defineTime,
					otheron^.rootCongruent^.defineTime);
	time := EnterExpr(newen,nil,time);
	newon := ExprToOpt(newen);
	newon^.createLevel := sol.level;
	opnden := newen;
    end;
end;

procedure AnalyzeForLoop{(ien : ExprNode; stn : StmtNode; sol : SaveOptLevel)};
var
    ion, on, opndon, pon, prooton, von, oon : OptNode;
    pen, en, olden, ven : ExprNode;
    possible : boolean;
    opnd1 : boolean;
    time : OptTime;
    itercount : integer;
begin
itercount := 0;
repeat
    if TraceOptim then begin
	if itercount > 0 then begin
	    writeln(output,'**** One More Time');
	end;
	writeln(output,'AnalyzeForLoop');
    end;
    itercount := itercount + 1;
    { index opt node }
    ion := ExprToOpt(ien);
    { parent rootEqual }
    prooton := nil;
    possible := true;
    on := ion;
    repeat
	if on^.parent = nil then begin
	    if TraceOptim then begin
		writeln(output,'nil parent');
		PrintOptExpr(on);
	    end;
	end else if on^.removed then begin
	    if TraceOptim then begin
		writeln(output,'removed');
		PrintOptExpr(on);
	    end;
	end else begin
	    { get assumed value expression }
	    von := ExprToOpt(on^.parent);
	    if von^.uniqueId < ion^.uniqueId then begin
		{ expression created before loop }
		if TraceOptim then begin
		    writeln(output,'irrelevant');
		    PrintOptExpr(von);
		end;
	    end else if (von^.expr^.kind <> EXPRVAL) or (von^.parent = nil)
	    then begin
		{ wrong kind of expression }
		possible := false;
	    end else begin
		{ get candidate induction expression }
		pon := ExprToOpt(von^.parent);
		if prooton <> nil then begin
		    if prooton <> pon^.rootCongruent then begin
			{ two different uses }
			possible := false;
		    end else begin
			{ another identical use }
		    end;
		end else if pon^.expr^.kind <> EXPRBINOP then begin
		    { candidates must be bin op }
		    possible := false;
		end else if not (pon^.expr^.exprBinOp in
			    [TKPLUS,TKASTERISK,TKMINUS])
		then begin
		    { only linear arithmetic operations are allowed }
		    possible := false;
		end else begin
		    opnd1 := pon^.expr^.opnd1 = von^.expr;
		    if opnd1 then begin
			oon := ExprToOpt(pon^.expr^.opnd2);
		    end else begin
			oon := ExprToOpt(pon^.expr^.opnd1);
		    end;
		    possible := not oon^.marked and
			(oon^.rootCongruent^.defineTime <= blockOptTime);
		    if possible then begin
			{ a winner! }
			prooton := pon^.rootCongruent;
		    end;
		end;
		if TraceOptim then begin
		    if possible then begin
			writeln(output,'potential ',pon^.rootCongruent^.defineTime:1,
				':',blockOptTime:1)
		    end else begin
			writeln(output,'ruining ',pon^.rootCongruent^.defineTime:1,
				':',blockOptTime:1)
		    end;
		    PrintOptExpr(pon);
		end;
	    end;
	end;
	on := on^.nextCongruent;
    until not possible or (on = ion);
    possible := possible and (prooton <> nil);
    if possible then begin
	opnd1 := false;
	if prooton^.expr^.opnd1^.kind = EXPRVAL then begin
	    if prooton^.expr^.opnd1^.exprVal^.kind = EXPRVAR then begin
		opnd1 := ien^.exprVar = prooton^.expr^.opnd1^.exprVal^.exprVar;
	    end;
	end;
	if not opnd1 then begin
	    { make sure opnd2 fits }
	    possible := false;
	    if prooton^.expr^.opnd2^.kind = EXPRVAL then begin
		if prooton^.expr^.opnd2^.exprVal^.kind = EXPRVAR then begin
		    possible := ien^.exprVar =