otree.p

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

end;

function OptFuncProc{(procExpr : ExprNode; params : ExprList; parent : ExprNode)
	:OptTime};
var
    pexp : ExprNode;
    pn : ParamNode;
    proc : ProcNode;
    procType : TypeNode;
    done : boolean;
    time, timep : OptTime;
begin
    procType := procExpr^.exprType;
    done := false;
    
    { beware: type names can be used as both types and funcs }
    if procExpr^.kind = EXPRSYM then begin
	if procExpr^.exprSym^.kind = SYMTYPE then begin
	    time := OptExpr(params^.first,parent,EVALGET);
	    done := true;
	end;
    end;

    { check for builtin function (must be a constant) }
    if done then begin
	{ do nothing }
    end else if procExpr^.kind = EXPRCONST then begin
	if procExpr^.exprConst^.kind = DTPROC then begin
	    proc := procExpr^.exprConst^.procVal;
	    if proc^.builtin <> BIPNOTBIP then begin
	    	time := OptBuiltin(procExpr,proc,params);
	    	done := true;
	    end;
	end;
    end;

    if done then begin
	{ do nothing }
    end else begin
	time := 0;
	if (params = nil) or (procType^.paramList = nil) then begin
	    { do nothing }
	end else begin
	    { first allow expressions to be referenced }
	    pexp := params^.first;
	    pn := procType^.paramList^.first;
	    while pexp <> nil do begin
		case pn^.kind of
		    PARAMVAR, PARAMVALUE : begin
			if pn^.reference then begin
			    timep := OptExpr(pexp,parent,EVALPOINT);
			end else begin
			    timep := OptExpr(pexp,parent,EVALGET);
			end;
		    end;
		    PARAMARRAYVAR,PARAMARRAYVALUE : begin
			timep := OptExpr(pexp,parent,EVALGET);
			time := Latest(time,timep);
			if not pn^.paramType^.nocount then begin
			    pexp := pexp^.next;
			    timep := OptExpr(pexp,parent,EVALGET);
			end;
		    end;
		end;
		time := Latest(time,timep);
		pexp := pexp^.next;
		pn := pn^.next;
	    end;
	    { then mark var parameters as modified }
	    pexp := params^.first;
	    pn := procType^.paramList^.first;
	    while pexp <> nil do begin
		if pn^.kind in [PARAMVAR,PARAMARRAYVAR] then begin
		    MarkOptExpr(pexp);
		end;
		if pn^.kind in [PARAMARRAYVAR,PARAMARRAYVALUE] then begin
		    if not pn^.paramType^.nocount then begin
			pexp := pexp^.next;
		    end;
		end;
		pexp := pexp^.next;
		pn := pn^.next;
	    end;
	end;
	{ for safety, mark everything as changed by procedure call }
	MarkOptAll;
	time := -optTime;
    end;
    OptFuncProc := time;
end;

function OptFuncExpr{(en : ExprNode; mode : EvalMode):OptTime};
var
    func : ExprNode;
    time, timep : OptTime;
begin
    time := OptExpr(en^.func,en,EVALGET);
    timep := OptFuncProc(en^.func,en^.params,en);
    OptFuncExpr := Latest(time,timep);
end;

function OptExpr{(en : ExprNode; pen : ExprNode; mode : EvalMode):OptTime};
var
    time : OptTime;
begin
    time := 0;
    if pen = nil then begin
	exprDepth := 0;
    end else begin
	exprDepth := exprDepth + 1;
    end;
    if en = nil then begin
	ExprError(en,'OptExpr: nil expression?');
    end else if en^.exprType = nil then begin
	ExprError(en,'OptExpr: exprType = nil?');
    end else begin
	case en^.kind of
	    EXPRBAD :	ExprError(en,'OptExpr: found EXPRBAD?');
	    EXPRNAME :	;
	    EXPRSYM :	;
	    EXPRVAR :	time := OptVarExpr(en,mode);
	    EXPRCONST :	;
	    EXPRUNOP :	time := OptUnOpExpr(en,mode);
	    EXPRBINOP :	time := OptBinOpExpr(en,mode);
	    {
	    EXPRSUBSCR :time := OptSubscriptExpr(en,mode);
	    EXPRDOT :	time := OptDotExpr(en,mode);
	    EXPRDEREF :	time := OptDerefExpr(en,mode);
	    }
	    EXPRFUNC :	time := OptFuncExpr(en,mode);
	    EXPRSET :	ExprError(en,'OptExpr: found EXPRSET');
	    EXPRVAL :	time := OptValExpr(en,mode);
	    EXPRCHECK :	time := OptCheckExpr(en,mode);
	end;
	time := EnterExpr(en,pen,time);
    end;
    OptExpr := time;
end;

procedure OptExprS(en : ExprNode; mode : EvalMode);
var
    ignore : OptTime;
begin
    ignore := OptExpr(en,nil,mode);
end;

procedure OptAssignStmt{(stn : StmtNode)};
begin
    OptExprS(stn^.rhs,EVALGET);
    OptExprS(stn^.lhs,EVALPUT);
    MarkOptExpr(stn^.lhs);
end;

procedure OptProcStmt{(stn : StmtNode)};
var
    ignore : OptTime;
begin
    OptExprS(stn^.proc,EVALGET);
    ignore := OptFuncProc(stn^.proc,stn^.params,nil);
end;

procedure OptIfStmt{(stn : StmtNode)};
var
    sol : SaveOptLevel;
begin
    OptExprS(stn^.ifCond,EVALGET);
    StartOptSplit(sol);
    OptStmtList(stn^.thenList);
    NextOptSplit(sol);
    OptStmtList(stn^.elseList);
    EndOptSplit(sol);
end;

procedure OptCase{(stn : StmtNode; caseNode : CaseNode)};
begin
    OptStmtList(caseNode^.stmts);
end;

procedure OptCaseStmt{(stn : StmtNode)};
var
    caseNode : CaseNode;
    sol : SaveOptLevel;
begin
    OptExprS(stn^.caseSel,EVALGET);
    if stn^.cases = nil then begin
	{ do nothing }
    end else begin
	StartOptSplit(sol);
	caseNode := stn^.cases^.first;
	while caseNode <> nil do begin
	    OptCase(stn,caseNode);
	    caseNode := caseNode^.next;
	    NextOptSplit(sol);
	end;
	OptStmtList(stn^.caseElse);
	EndOptSplit(sol);
    end;
end;

procedure OptWhileStmt{(stn : StmtNode)};
var
    sol : SaveOptLevel;
begin
    StartOptLoop(sol);
    OptExprS(stn^.whileCond,EVALGET);
    OptStmtList(stn^.whileBody);
    EndOptLoop(sol,stn^.whilePreEval);
end;

procedure OptRepeatStmt{(stn : StmtNode)};
var
    sol : SaveOptLevel;
begin
    StartOptLoop(sol);
    OptStmtList(stn^.repeatBody);
    OptExprS(stn^.repeatCond,EVALGET);
    EndOptLoop(sol,stn^.repeatPreEval);
end;

procedure OptLoopStmt{(stn : StmtNode)};
var
    sol : SaveOptLevel;
begin
    StartOptLoop(sol);
    OptStmtList(stn^.loopBody);
    EndOptLoop(sol,stn^.loopPreEval);
end;

procedure OptForStmt{(stn : StmtNode)};
var
    sym : Symbol;
    bt : TypeNode;
    error : boolean;
    ien : ExprNode;
    sol : SaveOptLevel;
begin
    OptExprS(stn^.forFrom,EVALGET);
    OptExprS(stn^.forTo,EVALGET);
    if stn^.forBy <> nil then begin
	OptExprS(stn^.forBy,EVALGET);
    end else begin
    end;
    { introduce expr node for loop index }
    ien := NewExprNode(EXPRVAR);
    SameExprLine(ien,stn^.forFrom);
    ien^.exprType := stn^.forIndexVar^.varType;
    ien^.exprVar := stn^.forIndexVar;
    ien^.baseVar := stn^.forIndexVar;
    OptExprS(ien,EVALPUT);
    { mark it to indicate assignment at start of loop }
    MarkOptExpr(ien);
    StartOptLoop(sol);
    OptStmtList(stn^.forBody);
    { look for induction expressions }
    if not OptNind then begin
	AnalyzeForLoop(ien,stn,sol);
    end;
    { mark it to indicate increment at end of loop }
    MarkOptExpr(ien);
    EndOptLoop(sol,stn^.forPreEval);
end;

procedure OptWithStmt{(stn : StmtNode)};
begin
    OptExprS(stn^.withQual,EVALPOINT);
    OptStmtList(stn^.withBody);
end;

procedure OptReturnStmt{(stn : StmtNode)};
begin
    if stn^.returnVal = nil then begin
    end else begin
	OptExprS(stn^.returnVal,EVALGET);
	OptRecursionReturn(currOptProc,stn);
    end;
end;

procedure OptExitStmt{(stn : StmtNode)};
begin
end;

procedure OptStmt{(stn : StmtNode)};
begin
    if stn^.bad then begin
	StmtError(stn,'OptStmt: stmt bad?');
    end;
    case stn^.kind of
	STMTASSIGN :	OptAssignStmt(stn);
	STMTPROC :	OptProcStmt(stn);
	STMTIF :	OptIfStmt(stn);
	STMTWHILE :	OptWhileStmt(stn);
	STMTREPEAT :	OptRepeatStmt(stn);
	STMTLOOP :	OptLoopStmt(stn);
	STMTFOR :	OptForStmt(stn);
	STMTWITH :	OptWithStmt(stn);
	STMTEXIT :	OptExitStmt(stn);
	STMTRETURN :	OptReturnStmt(stn);
	STMTCASE :	OptCaseStmt(stn);
    end;
end;

procedure OptStmtList{(stl : StmtList)};
var
    stn : StmtNode;
begin
    if stl = nil then begin
	{ do nothing }
    end else begin
	stn := stl^.first;
	while stn <> nil do begin
	    OptStmt(stn);
	    stn := stn^.next;
	end;
    end;
end;

procedure OptProc{(pn : ProcNode)};
begin
    currOptProc := pn;
    if pn^.body <> nil then begin
	if TraceOptim then begin
	    write(output,'OptProc ');
	    WriteString(output,pn^.name);
	    writeln(output);
	end;
	StartOptProc;
	OptStmtList(pn^.body);
	OptRecursionProc(pn,pn^.body);
	EndOptProc;
	if TraceOptim then begin
	    DumpOptExprs;
	end;
	CountProc(pn);
    end;
end;

procedure OptModule{(mn : ModuleNode)};
var
    submn : ModuleNode;
    pn : ProcNode;
begin
    submn := mn^.modules^.first;
    while submn <> nil do begin
	OptModule(submn);
	submn := submn^.next;
    end;
    pn := mn^.procs^.first;
    while pn <> nil do begin
	OptProc(pn);
	pn := pn^.next;
    end;
    if mn^.body <> nil then begin
	StartOptProc;
	OptStmtList(mn^.body);
	EndOptProc;
    end;
end;