optim.p

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

	    repeat
		men := mon^.expr;
		if men^.dependPtrType = basePtrType then begin
		    MarkIt(mon);
		    pen := mon^.parent;
		    while pen <> nil do begin
			if pen^.basePtrType = basePtrType then begin
			    pon := ExprToOpt(pen);
			    if pon <> nil then begin
				MarkIt(pon);
				pen := pon^.parent;
			    end else begin
				pen := nil;
			    end;
			end else begin
			    pen := nil;
			end;
		    end;
		end;
		mon := mon^.nextCongruent;
	    until mon = cseRootExpr[EXPRVAL];
	end;
    end;
end;

function CongruentExpr{(a, b : ExprNode) : boolean};
begin
    CongruentExpr := Congruent(idToOpt[a^.opt],idToOpt[b^.opt]);
end;

function Congruent{(a, b : OptNode) : boolean};
var
    congruent : boolean;
    aen, ben : ExprNode;
begin
    aen := a^.expr;
    ben := b^.expr;
    if aen^.kind <> ben^.kind then begin
	congruent := false;
    end else if (a^.rootCongruent <> nil) and
	    (a^.rootCongruent = b^.rootCongruent)
    then begin
	congruent := true;
    end else begin
	congruent := false;
	case aen^.kind of
	    EXPRNAME,
	    EXPRSET : begin
		ExprError(aen,'Congruent: bad expr kind');
	    end;
	    EXPRSYM : begin
		congruent := aen^.exprSym = ben^.exprSym;
	    end;
	    EXPRCONST : begin
		if aen^.exprConst^.kind <> ben^.exprConst^.kind then begin
		    { not congruent }
		end else begin
		    case aen^.exprConst^.kind of
			DTCHAR : congruent :=
			    aen^.exprConst^.charVal = ben^.exprConst^.charVal;
			DTINTEGER,
			DTCARDINAL : congruent :=
			    aen^.exprConst^.cardVal = ben^.exprConst^.cardVal;
			DTBOOLEAN : congruent :=
			    aen^.exprConst^.boolVal = ben^.exprConst^.boolVal;
			DTREAL, DTLONGREAL : congruent :=
			    aen^.exprConst^.realVal = ben^.exprConst^.realVal;
			DTSET : congruent := (aen^.exprConst^.setVal^.setType =
						ben^.exprConst^.setVal^.setType)
					and (aen^.exprConst^.setVal^.value =
						ben^.exprConst^.setVal^.value);
			DTENUMERATION : congruent :=
			    (aen^.exprConst^.enumVal^.enumType =
					    ben^.exprConst^.enumVal^.enumType)
			    and (aen^.exprConst^.enumVal^.enumOrd =
					    ben^.exprConst^.enumVal^.enumOrd);
			DTSTRING : congruent :=
			    aen^.exprConst^.strVal = ben^.exprConst^.strVal;
			DTPROC : congruent :=
			    aen^.exprConst^.procVal = ben^.exprConst^.procVal;
			DTPOINTER : congruent := true; { nil pointers match }
		    end;
		end;
	    end;
	    EXPRVAR : congruent := aen^.exprVar = ben^.exprVar;
	    EXPRUNOP : begin
		if aen^.exprUnOp = ben^.exprUnOp then begin
		    congruent := CongruentExpr(aen^.opnd,ben^.opnd);
		end;
	    end;
	    EXPRBINOP : begin
		if aen^.exprBinOp = ben^.exprBinOp then begin
		    congruent := CongruentExpr(aen^.opnd1,ben^.opnd1);
		    if congruent then begin
			congruent := CongruentExpr(aen^.opnd2,ben^.opnd2);
		    end else if aen^.exprBinOp in [TKPLUS,TKASTERISK,TKEQUALS,
			TKSHARP,TKNOTEQUAL]
		    then begin
			{ check for reversed operands on commutative operator }
			congruent := CongruentExpr(aen^.opnd1,ben^.opnd2);
			if congruent then begin
			    congruent := CongruentExpr(aen^.opnd2,ben^.opnd1);
			end;
		    end;
		end;
	    end;
	    EXPRSUBSCR : begin
		congruent := CongruentExpr(aen^.arr,ben^.arr);
		if congruent then begin
		    congruent := CongruentExpr(aen^.subsExpr,ben^.subsExpr);
		end;
	    end;
	    EXPRDOT : begin
		congruent := aen^.field = ben^.field;
		if congruent then begin
		    congruent := CongruentExpr(aen^.rec,ben^.rec);
		end;
	    end;
	    EXPRDEREF : congruent := CongruentExpr(aen^.ptr,ben^.ptr);
	    EXPRFUNC : congruent := false;
	    EXPRVAL : begin
		congruent := aen^.exprType = ben^.exprType;
		if congruent then begin
		    congruent := CongruentExpr(aen^.exprVal,ben^.exprVal);
		end;
	    end;
	    EXPRCHECK : begin
		congruent := (aen^.exprCheck = ben^.exprCheck) and
			(aen^.checkVar = ben^.checkVar) and
			(aen^.checkType = ben^.checkType) and
			(aen^.checkLower = ben^.checkLower) and
			(aen^.checkUpper = ben^.checkUpper) and
			(aen^.checkField = ben^.checkField);
		if congruent then begin
		    congruent := CongruentExpr(aen^.checkExpr,ben^.checkExpr);
		end;
	    end;
	end;
    end;
    Congruent := congruent;
end;


function EnterExpr{(en : ExprNode; pen : ExprNode; minTime : OptTime): OptTime};
var
    on, ton : OptNode;
begin
    on := NewOptNode(en,pen);
    if en^.kind = EXPRBINOP then begin
	on^.nonTrivial := true;
	on^.containedNonTrivial := on;
	if en^.exprBinOp = TKPLUS then begin
	    case target of
		TARGETVAX : begin
		    if en^.opnd1^.kind in [EXPRCONST,EXPRVAR] then begin
			ton := ExprToOpt(en^.opnd2);
			on^.nonTrivial := false;
			on^.containedNonTrivial := ton^.containedNonTrivial;
		    end else if en^.opnd2^.kind in [EXPRCONST,EXPRVAR] then begin
			ton := ExprToOpt(en^.opnd1);
			on^.nonTrivial := false;
			on^.containedNonTrivial := ton^.containedNonTrivial;
		    end;
		end;
		TARGETTITAN : begin
		    if en^.opnd1^.kind in [EXPRCONST] then begin
			ton := ExprToOpt(en^.opnd2);
			on^.nonTrivial := false;
			on^.containedNonTrivial := ton^.containedNonTrivial;
		    end else if en^.opnd2^.kind in [EXPRCONST] then begin
			ton := ExprToOpt(en^.opnd1);
			on^.nonTrivial := false;
			on^.containedNonTrivial := ton^.containedNonTrivial;
		    end;
		end;
	    end;
	end else if en^.exprBinOp = TKASTERISK then begin
	    { don't count indexing by address unit size }
	    if en^.operType = addressTypeNode then begin
		if en^.opnd1^.kind = EXPRCONST then begin
		    if en^.opnd1^.exprConst^.kind = DTCARDINAL then begin
			if en^.opnd1^.exprConst^.cardVal = addressUnit
			then begin
			    ton := ExprToOpt(en^.opnd2);
			    on^.nonTrivial := false;
			    on^.containedNonTrivial := ton^.containedNonTrivial;
			end;
		    end;
		end else if en^.opnd2^.kind = EXPRCONST then begin
		    if en^.opnd2^.exprConst^.kind = DTCARDINAL then begin
			if en^.opnd2^.exprConst^.cardVal = addressUnit
			then begin
			    ton := ExprToOpt(en^.opnd1);
			    on^.nonTrivial := false;
			    on^.containedNonTrivial := ton^.containedNonTrivial;
			end;
		    end;
		end;
	    end;
	end;
	EnterClass(cseRootBinOp[en^.exprBinOp],on);
    end else if en^.kind = EXPRUNOP then begin
	on^.nonTrivial := true;
	on^.containedNonTrivial := on;
	EnterClass(cseRootUnOp[en^.exprUnOp],on);
    end else begin
	if en^.kind = EXPRVAR then begin
	    on^.nonTrivial := false;
	    on^.containedNonTrivial := nil;
	end else if en^.kind = EXPRVAL then begin
	    case target of
		TARGETVAX : begin
		    ton := ExprToOpt(en^.exprVal);
		    on^.nonTrivial := false;
		    on^.containedNonTrivial := ton^.containedNonTrivial;
		end;
		TARGETTITAN : begin
		    ton := ExprToOpt(en^.exprVal);
		    if ton^.containedNonTrivial <> nil then begin
			on^.nonTrivial := true;
			on^.containedNonTrivial := on;
		    end else begin
			on^.nonTrivial := false;
			on^.containedNonTrivial := ton^.containedNonTrivial;
		    end;
		end;
	    end;
	end else if en^.kind = EXPRCHECK then begin
	    on^.nonTrivial := true;
	    on^.containedNonTrivial := on;
	end;
	EnterClass(cseRootExpr[en^.kind],on);
    end;
(***
    if TraceOpt then begin
	writeln(output,'EnterExpr: min=',minTime:1,
	    ', def=', on^.rootCongruent^.defineTime:1);
	PrintOptExpr(on);
    end;
***)
    if minTime < 0 then begin
	minTime := -minTime;
	MarkIt(on^.rootEqual);
    end else if on^.rootCongruent^.defineTime < minTime then begin
	on^.rootCongruent^.defineTime := minTime;
    end;
    EnterExpr := on^.rootCongruent^.defineTime;
end;

{ EnterClass:
    Four possibilities:
	No other expr in that class => make sole element of class
	Does not match any element in class => AddToClassList
	Congruent to some element, but not equal => AddToCongruentList
	Equal to some element => AddToEqualList
}
procedure EnterClass{(var root : OptNode; on : OptNode)};
var
    found : boolean;
    search : OptNode;
begin
    if root = nil then begin
	{ make sole element of class }
	AddToClassList(root,on);
    end else begin
	search := root;
	repeat
	    if Congruent(on,search) then begin
		found := true;
	    end else begin
		search := search^.nextClass;
	    end;
	until found or (search = root);
	if not found then begin
	    { new class, add after end of list }
	    AddToClassList(root^.prevClass,on);
	end else begin
	    { found same class, look for congruent }
	    EnterCongruent(search,on);
	end;
    end;
end;

{ add newOne to doubly-linked All list, after prevOne }
procedure AddToAllList{(prevOne, newOne : OptNode)};
var
    nextOne : OptNode;
begin
    nextOne := prevOne^.nextAll;
    newOne^.nextAll := nextOne;
    newOne^.prevAll := prevOne;
    prevOne^.nextAll := newOne;
    nextOne^.prevAll := newOne;
end;

{ add newOne to doubly-linked Active list, after prevOne }
procedure AddToActiveList{(prevOne, newOne : OptNode)};
var
    nextOne : OptNode;
begin
    nextOne := prevOne^.nextActive;
    newOne^.nextActive := nextOne;
    newOne^.prevActive := prevOne;
    prevOne^.nextActive := newOne;
    nextOne^.prevActive := newOne;
end;

{ remove oldOne from doubly-linked Active list }
procedure RemoveFromActiveList{(oldOne : OptNode)};
var
    prevOne, nextOne : OptNode;
begin
    if oldOne^.nextActive <> nil then begin
	nextOne := oldOne^.nextActive;
	prevOne := oldOne^.prevActive;
	prevOne^.nextActive := nextOne;
	nextOne^.prevActive := prevOne;
	oldOne^.nextActive := nil;
	oldOne^.prevActive := nil;
    end;
end;

{ add newOne to doubly-linked Class list, after prevOne }
procedure AddToClassList{(var prevOne : OptNode; newOne : OptNode)};
var
    nextOne : OptNode;
begin
    if prevOne = nil then begin
	prevOne := newOne;
    end else begin
	nextOne := prevOne^.nextClass;
	newOne^.nextClass := nextOne;
	newOne^.prevClass := prevOne;
	prevOne^.nextClass := newOne;
	nextOne^.prevClass := newOne;
    end;
    AddToActiveList(activeExprs^.prevActive,newOne);
end;

procedure EnterCongruent{(root : OptNode; on : OptNode)};
var
    found : boolean;
    search : OptNode;
begin
    search := root;
    found := false;
    repeat
	if (search^.rootEqual <> search) or search^.marked or search^.purged
		or (search^.createLevel > optBlockCeiling)
		or (search^.createLevel < optBlockFloor)
	then begin
	    { not equal }
	    search := search^.nextCongruent;
	end else begin
	    { equal }
	    found := true;
	end;
    until found or (search = root);
    if found then begin
	{ equal }
	AddToEqualList(search,on);
    end else begin
	{ not equal }
	AddToCongruentList(root^.prevCongruent,on);
    end;
end;

{ add newOne to doubly-linked Congruent list, after prevOne }
procedure AddToCongruentList{(prevOne, newOne : OptNode)};
var
    nextOne : OptNode;
begin
    nextOne := prevOne^.nextCongruent;
    newOne^.nextCongruent := nextOne;
    newOne^.prevCongruent := prevOne;
    prevOne^.nextCongruent := newOne;
    nextOne^.prevCongruent := newOne;
    newOne^.rootCongruent := prevOne^.rootCongruent;
    AddToActiveList(activeExprs^.prevActive,newOne);
end;

{ add newOne to doubly-linked Equal list, after prevOne }
procedure AddToEqualList{(prevOne, newOne : OptNode)};
var
    nextOne : OptNode;
begin
    { add to equal list }
    nextOne := prevOne^.nextEqual;
    newOne^.nextEqual := nextOne;
    newOne^.prevEqual := prevOne;
    prevOne^.nextEqual := newOne;
    nextOne^.prevEqual := newOne;
    newOne^.rootEqual := prevOne^.rootEqual;

    { add to congruent list }
    nextOne := prevOne^.nextCongruent;
    newOne^.nextCongruent := nextOne;
    newOne^.prevCongruent := prevOne;
    prevOne^.nextCongruent := newOne;
    nextOne^.prevCongruent := newOne;
    newOne^.rootCongruent := prevOne^.rootCongruent;

    newOne^.rootEqual^.neededCount := newOne^.rootEqual^.neededCount + 1;
    newOne^.rootEqual^.referencedCount := newOne^.rootEqual^.referencedCount + 1;
end;

procedure PrintOptExpr{(on : OptNode)};
var
    en : ExprNode;
begin
    writeln(output,'Expr #',on^.uniqueId:1);
    if on^.parent = nil then begin
	write(output,'    Parent=nil');
    end else begin
	write(output,'    Parent=',on^.parent^.opt:1);
    end;
    writeln(output,', Congruent=',on^.rootCongruent^.uniqueId:1,
	    ', Equal=',on^.rootEqual^.uniqueId:1);
    writeln(output,'    marked=',on^.marked:1,', joinMark=',on^.joinMark:1,
	    ', purged=',on^.purged:1);
    writeln(output,'    createLevel=',on^.createLevel:1,', markLevel=',
	    on^.markLevel:1,', defineTime=',on^.defineTime:1,'/',
	    on^.rootCongruent^.defineTime:1,
	    ', loopNest=',on^.loopNest:1,', usage=',on^.usage:1);
    writeln(output,'    nonTrivial=',on^.nonTrivial:1,
	', eligible=',on^.eligible:1,
	', used=', on^.usedCount:1,', needed=', on^.neededCount:1,
	', referenced=', on^.referencedCount:1,
	', temp=',on^.tempNumber:1);
    if on^.containedNonTrivial <> nil then begin
	writeln(output,'    containedNonTrivial=',
			on^.containedNonTrivial^.uniqueId:1);
    end;
    en := on^.expr;
    if en = nil then begin
	writeln(output,'no expr node');
    end else begin
	write(output,'    line=',en^.lineNumber:1,', file=');
	    WriteString(output,en^.fileName);
	writeln(output);
	write(output,'    expr=');
	    WriteExpr(output,en);
	if en^.baseVar <> nil then begin
	    write(output,', baseVar =');
	    WriteString(output,en^.baseVar^.name);
	end;
	if en^.basePtrType <> nil then begin
	    write(output,', basePtrType =');
	    WriteString(output,en^.basePtrType^.name);
	end;
	writeln(output);
    end;
end;

procedure DumpOptEqual{(root : OptNode)};
var
    on : OptNode;
begin
    on := root;
    write(output,' ':11);
    repeat
	write(output,' ',on^.uniqueId);
	on := on^.nextEqual;
    until on = root;
    writeln(output);
end;

procedure DumpOptCongruent{(root : OptNode)};
var
    on : OptNode;
begin
    on := root;
    repeat
	writeln(output,' ':8,on^.uniqueId);
	DumpOptEqual(on);
	on := on^.nextCongruent;
    until on = root;
end;

procedure DumpOptClass{(root : OptNode)};
var
    on : OptNode;
begin
    on := root;
    repeat
	writeln(output,' ':4,on^.uniqueId);
	DumpOptCongruent(on);
	on := on^.nextClass;;
    until on = root;
end;

procedure DumpOptExprs;
var
    ek : ExprKind;
    token : Token;
    on : OptNode;
begin
(****
    for ek := EXPRBAD to EXPRSET do begin
	if cseRootExpr[ek] <> nil then begin
	    writeln(output,'Class Expr ',ek:1);
	    DumpOptClass(cseRootExpr[ek]);
	end;
    end;
    for token := TKENDOFFILE to TKNULL do begin
	if cseRootUnOp[token] <> nil then begin
	    writeln(output,'Class UnOp ',token:1);
	    DumpOptClass(cseRootUnOp[token]);
	end;
    end;
    for token := TKENDOFFILE to TKNULL do begin
	if cseRootBinOp[token] <> nil then begin
	    writeln(output,'Class BinOp ',token:1);
	    DumpOptClass(cseRootBinOp[token]);
	end;
    end;
    writeln(output);
****)
    writeln(output,'All exprs');
    on := allExprs^.nextAll;
    while on <> allExprs do begin
	PrintOptExpr(on);
	on := on^.nextAll;
    end;
end;