ocount.p

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

		end;
	    end;
	    SortArray(0,maxindex);
	    if TraceOptim then begin
		writeln(output,'Reassign storage after');
		for index := 0 to maxindex do begin
		    writeln(output,index:3,refCount[index].count:5,
			    trunc(refCount[index].offset) div WORDSIZE:5,' ',
			    refCount[index].addressed);
		end;
	    end;
	    new(tm);
	    tm^.numReg := -1;
	    for index := 0 to MAXTEMPSTORAGE do begin
		tm^.map[index] := -1;
	    end;
	    for index := 0 to maxindex do begin
		ireg := trunc(refCount[index].offset) div WORDSIZE;
		tm^.map[ireg] := index * WORDSIZE;
		if (refCount[index].count >= MINCOUNTFORREG) and
			not refCount[index].addressed and (index > tm^.numReg)
		then begin
		    tm^.numReg := index;
		end;
	    end;
	    proc^.mem^.maximum[MEMFAST] := proc^.mem^.maximum[MEMFAST]
			    + maxTemp * WORDSIZE;
	    if TraceOptim then begin
		writeln(output,'Reassign storage map ',tm^.numReg:1);
		for index := 0 to MAXTEMPSTORAGE do begin
		    if tm^.map[index] <> -1 then begin
			if index < maxindex - maxTemp then begin
			    writeln(output,'T',index:3,
				trunc(tm^.map[index]) div WORDSIZE:5);
			end else begin
			    writeln(output,'O',index:3,
				trunc(tm^.map[index]) div WORDSIZE:5);
			end;
		    end;
		end;
	    end;
	    proc^.tempMap := tm;
	end;
	TARGETTITAN : begin
	    new(tm);
	    tm^.numReg := maxTemp;
	    proc^.tempMap := tm;
	end;
    end;
end;

procedure CountProc {(proc : ProcNode)};
var
    code : CodeNode;
begin
    InitCounts;
    code := proc^.code^.first;
    while code <> nil do begin
	CountStmtList(code^.stmts);
	code := code^.next;
    end;
    UpdateTemps;
    if inUseTemps <> [] then begin
	Error('CountProc: temps in use after processing');
    end;
    ReassignStorage(proc);
end;

procedure CountStmtList{(stmts : StmtList)};
var
    stmt : StmtNode;
begin
    if stmts <> nil then begin
	stmt := stmts^.first;
	while stmt <> nil do begin
	    CountStmt(stmt);
	    stmt := stmt^.next;
	end;
    end;
end;

procedure CountStmtAssign(stmt : StmtNode);
var
    done : boolean;
    lhson, rhson, teston : OptNode;
begin
    done := false;
    if stmt^.rhs^.kind <> EXPRBINOP then begin
	{ not a bin op }
    end else if not (stmt^.rhs^.exprBinOp in [TKPLUS,TKASTERISK,TKMINUS])
	or not (stmt^.rhs^.operType^.kind in [DTPOINTER,DTINTEGER,DTCARDINAL])
    then begin
	{ not a good bin op }
    end else if stmt^.rhs^.opnd1^.kind <> EXPRVAL then begin
	{ first operand not a variable }
    end else begin
	lhson := ExprToOpt(stmt^.lhs);
	rhson := ExprToOpt(stmt^.rhs);
	teston := ExprToOpt(stmt^.rhs^.opnd1^.exprVal);
	if rhson^.neededCount <> 1 then begin
	    { expression is reused }
	end else if lhson^.rootEqual = teston^.rootEqual then begin
	    { a := a op b }
	    stmt^.assignOp := stmt^.rhs^.exprBinOp;
	    { don't need to evaluate lhs }
	    ReduceExprNeededCounts(stmt^.lhs,1);
	    CountExpr(stmt^.rhs^.opnd1^.exprVal,EVALGET);
	    CountExpr(stmt^.rhs^.opnd2,EVALGET);
	    done := true;
	end;
    end;
    if not done then begin
	CountExpr(stmt^.rhs,EVALGET);
	CountExpr(stmt^.lhs,EVALPUT);
    end;
end;

procedure CountParamList(procType : TypeNode; procVariable : ExprNode;
	params : ExprList);
var
    pn : ParamNode;
    pen : ExprNode;
begin
    if procVariable <> nil then begin
	{ invocation of procedure variable, make it first parameter }
	CountExpr(procVariable,EVALGET);
    end;
    if (params = nil) or (procType^.paramList = nil) then begin
	{ do nothing }
    end else begin
	pen := params^.first;
	pn := procType^.paramList^.first;
	while pen <> nil do begin
	    case pn^.kind of
		PARAMVALUE : begin
		    if pn^.reference then begin
			CountExpr(pen,EVALPOINT);
		    end else begin
			CountExpr(pen,EVALGET);
		    end;
		end;
		PARAMVAR : begin
		    CountExpr(pen,EVALPOINT);
		end;
		PARAMARRAYVALUE, PARAMARRAYVAR : begin
		    CountExpr(pen,EVALGET);
		    if not pn^.paramType^.nocount then begin
			pen := pen^.next;
			CountExpr(pen,EVALGET);
		    end;
		end;
	    end;
	    pen := pen^.next;
	    pn := pn^.next;
	end;
    end;
end;

procedure CountFuncProc(procExpr : ExprNode; params : ExprList);
var
    proc : ProcNode;
    generated : boolean;
begin
    generated := false;
    if procExpr^.kind = EXPRSYM then begin
	if procExpr^.exprSym^.kind = SYMTYPE then begin
	    CountExpr(params^.first,EVALGET);
	    generated := true;
	end;
    end;
    if generated then begin
	{ do nothing }
    end else if procExpr^.kind <> EXPRCONST then begin
	CountParamList(procExpr^.exprType,procExpr,params);
    end else begin
	proc := procExpr^.exprConst^.procVal;
	if proc^.builtin <> BIPNOTBIP then begin
	    CountBuiltin(proc,params);
	end else begin
	    CountParamList(proc^.procType,nil,params);
	end;
    end;
end;

procedure CountStmtProc(stmt : StmtNode);
begin
    CountFuncProc(stmt^.proc,stmt^.params);
end;


procedure CountStmtIf(stmt : StmtNode);
begin
    CountExpr(stmt^.ifCond,EVALGET);
    CountStmtList(stmt^.thenList);
    CountStmtList(stmt^.elseList);
end;

procedure CountStmtCase(stmt : StmtNode);
var
    caseNode : CaseNode;
begin
    CountExpr(stmt^.caseSel,EVALGET);
    caseNode := stmt^.cases^.first;
    while caseNode <> nil do begin
	CountStmtList(caseNode^.stmts);
	caseNode := caseNode^.next;
    end;
    if stmt^.caseElse = nil then begin
    end else begin
	CountStmtList(stmt^.caseElse);
    end;
end;

procedure CountPrePostEval(el : ExprList;state : EvalState);
var
    en : ExprNode;
begin
    if el = nil then begin
	{ do nothing }
    end else begin
	en := el^.first;
	while en <> nil do begin
	    CommonSubExpr(en,EVALGET,state);
	    en := en^.next;
	end;
    end;
end;

procedure CountStmtWhile(stmt : StmtNode);
begin
    CountExpr(stmt^.whileCond,EVALGET);
    CountPrePostEval(stmt^.whilePreEval,EVALPRE);
    CountStmtList(stmt^.whileBody);
    CountPrePostEval(stmt^.whilePreEval,EVALPOST);
end;

procedure CountStmtRepeat(stmt : StmtNode);
begin
    CountPrePostEval(stmt^.repeatPreEval,EVALPRE);
    CountStmtList(stmt^.repeatBody);
    CountExpr(stmt^.repeatCond,EVALGET);
    CountPrePostEval(stmt^.repeatPreEval,EVALPOST);
end;

procedure CountStmtLoop(stmt : StmtNode);
begin
    CountPrePostEval(stmt^.loopPreEval,EVALPRE);
    CountStmtList(stmt^.loopBody);
    CountPrePostEval(stmt^.loopPreEval,EVALPOST);
end;

procedure CountStmtFor(stmt : StmtNode);
begin
    CountExpr(stmt^.forTo,EVALGET);
    CountVar(stmt^.forLimitVar,stmt^.forTo,1);
    CountExpr(stmt^.forFrom,EVALGET);
    CountVar(stmt^.forIndexVar,stmt^.forFrom,1);

    CountPrePostEval(stmt^.forPreEval,EVALPRE);
    CountStmtList(stmt^.forBody);
    CountVar(stmt^.forIndexVar,stmt^.forFrom,LOOPBIAS);
    CountVar(stmt^.forLimitVar,stmt^.forFrom,LOOPBIAS);
    CountPrePostEval(stmt^.forPreEval,EVALPOST);
end;

procedure CountStmtWith(stmt : StmtNode);
begin
    CountExpr(stmt^.withQual,EVALPOINT);
    CountVar(stmt^.withQualNode^.implQual,stmt^.withQual,1);
    CountStmtList(stmt^.withBody);
end;

procedure CountStmtReturn(stmt : StmtNode);
begin
    if stmt^.returnVal <> nil then begin
	CountExpr(stmt^.returnVal,EVALGET);
    end;
end;

procedure CountStmtExit(stmt : StmtNode);
begin
end;

procedure CountStmt{(stmt : StmtNode)};
begin
    case stmt^.kind of
	STMTASSIGN :	CountStmtAssign(stmt);
	STMTPROC :	CountStmtProc(stmt);
	STMTIF :	CountStmtIf(stmt);
	STMTCASE :	CountStmtCase(stmt);
	STMTWHILE :	CountStmtWhile(stmt);
	STMTREPEAT :	CountStmtRepeat(stmt);
	STMTLOOP :	CountStmtLoop(stmt);
	STMTFOR :	CountStmtFor(stmt);
	STMTWITH :	CountStmtWith(stmt);
	STMTRETURN :	CountStmtReturn(stmt);
	STMTEXIT :	CountStmtExit(stmt);
    end;
    UpdateTemps;
end;

procedure CountVar{(vn : VarNode; en : ExprNode; weight : integer)};
var
    on : OptNode;
    index : integer;
begin
    if vn^.address.kind = MEMFAST then begin
	index := trunc(vn^.address.offset) div WORDSIZE;
	on := ExprToOpt(en);
	refCount[index].count := refCount[index].count
		    + on^.loopNest * on^.referencedCount * weight;
    end;
end;

procedure CheckVarRef(vn : VarNode; mode : EvalMode);
var
    index : integer;
begin
    if (mode = EVALPOINT) and (vn^.address.kind = MEMFAST) then begin
	if TraceOptim then begin
	    write(output,'Addressed ');
	    WriteString(output,vn^.name);
	    writeln(output);
	end;
	index := trunc(vn^.address.offset) div WORDSIZE;
	refCount[index].addressed := true;
    end;
end;

procedure CountExprSym(expr : ExprNode; mode : EvalMode);
var
    sym : Symbol;
begin
    sym := expr^.exprSym;
    if sym^.kind = SYMVAR then begin
	ExprErrorName(expr,sym^.name,'CountExprSym: EXPRSYM is a SYMVAR?');
	CountVar(sym^.symVar,expr,1);
    end else begin
	ExprErrorName(expr,sym^.name,'CountExprSym: Symbol is not a variable?');
    end;
end;

procedure CountExprConst(expr : ExprNode; mode : EvalMode);
begin
end;

procedure CountExprUnOp(expr : ExprNode; mode : EvalMode);
begin
    CountExpr(expr^.opnd,EVALGET);
end;

procedure CountExprBinOp(expr : ExprNode);
begin
    CountExpr(expr^.opnd1,EVALGET);
    CountExpr(expr^.opnd2,EVALGET);
end;

procedure CountExprSubscr(expr : ExprNode; mode : EvalMode);
begin
    CountExpr(expr^.subsExpr,EVALGET);
    CountExpr(expr^.arr,EVALPOINT);
end;

procedure CountExprDot(expr : ExprNode; mode : EvalMode);
begin
    CountExpr(expr^.rec,EVALPOINT);
end;

procedure CountExprDeref(expr : ExprNode; mode : EvalMode);
begin
    CountExpr(expr^.ptr,EVALGET);
end;

procedure CountExprVal(expr : ExprNode; mode : EvalMode);
begin
    CountExpr(expr^.exprVal,EVALGET);
end;

procedure CountExprCheck(expr : ExprNode; mode : EvalMode);
begin
    CountExpr(expr^.checkExpr,mode);
end;

procedure CountExprFunc(expr : ExprNode);
begin
    CountFuncProc(expr^.func,expr^.params);
end;

procedure DoCountExpr{(expr : ExprNode; mode : EvalMode)};
begin
    case expr^.kind of
	EXPRBAD : ;
	EXPRVAR :	CheckVarRef(expr^.exprVar,mode);
	EXPRSYM :	CountExprSym(expr,EVALGET);
	EXPRCONST :	CountExprConst(expr,EVALGET);
	EXPRUNOP :	CountExprUnOp(expr,EVALGET);
	EXPRBINOP :	CountExprBinOp(expr);
	EXPRSUBSCR :	CountExprSubscr(expr,EVALGET);
	EXPRDOT :	CountExprDot(expr,EVALGET);
	EXPRDEREF :	CountExprDeref(expr,EVALGET);
	EXPRFUNC :	CountExprFunc(expr);
	EXPRVAL :	CountExprVal(expr,EVALGET);
	EXPRCHECK :	CountExprCheck(expr,EVALGET);
    end;
end;

procedure CountExpr{(expr : ExprNode; mode : EvalMode)};
begin
    if expr = nil then begin
	ExprError(expr,'CountExpr: nil expression');
    end else begin
	CommonSubExpr(expr,mode,EVALNORMAL);
    end;
end;