genpc.p

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

    skip : boolean;
    sameVar : VarNode;
begin
    if (params <> nil) and (proc^.procType^.paramList <> nil) then begin
	{ first evaluate all parameters (except those that are the same) }
	pn := proc^.procType^.paramList^.first;
	pen := params^.first;
	pnum := 0;
	tempCount := 0;
	while pn <> nil do begin
	    pnum := pnum + 1;
	    skip := false;
	    case pn^.kind of
		PARAMARRAYVALUE, PARAMARRAYVAR : begin
		    if pen^.kind <> EXPRVAL then begin
			{ no good }
		    end else if pen^.exprVal^.kind <> EXPRVAR then begin
			{ no good }
		    end else if pen^.exprVal^.exprVar = pn^.paramVar then begin
			    skip := true;
		    end;
		    if skip then begin
			temps[pnum] := 0;
			pnum := pnum + 1;
			pen := pen^.next;
			temps[pnum] := 0;
		    end else begin
			GenExpr(pen,EVALPOINT);
			tempCount := tempCount + 1;
			temps[pnum] := tempCount;
			GenOp(PCSAV); GenInteger(temps[pnum]); Comma;
				GenChar('m'); EndLine;
			pen := pen^.next;
			pnum := pnum + 1;
			GenExpr(pen,EVALGET);
			tempCount := tempCount + 1;
			temps[pnum] := tempCount;
			GenOp(PCSAV); GenInteger(temps[pnum]); Comma;
				GenChar('m'); EndLine;
		    end;
		end;
		PARAMVAR : begin
		    if pen^.kind <> EXPRVAR then begin
			{ no good }
		    end else if pen^.exprVar = pn^.paramVar then begin
			    skip := true;
		    end;
		    if skip then begin
			temps[pnum] := 0;
		    end else begin
			GenExpr(pen,EVALPOINT);
			tempCount := tempCount + 1;
			temps[pnum] := tempCount;
			GenOp(PCSAV); GenInteger(temps[pnum]); Comma;
				GenChar('m'); EndLine;
		    end;
		end;
		PARAMVALUE : begin
		    if pen^.kind <> EXPRVAL then begin
			{ no good }
		    end else if pen^.exprVal^.kind <> EXPRVAR then begin
			{ no good }
		    end else if pen^.exprVal^.exprVar = pn^.paramVar then begin
			    skip := true;
		    end;
		    if skip then begin
			temps[pnum] := 0;
		    end else begin
			GenExpr(pen,EVALGET);
			tempCount := tempCount + 1;
			temps[pnum] := tempCount;
			GenOp(PCSAV); GenInteger(temps[pnum]); Comma;
				GenChar('m'); EndLine;
		    end;
		end;
	    end;
	    pen := pen^.next;
	    pn := pn^.next;
	end;
	{ now store them into the parameter list }
	pn := proc^.procType^.paramList^.first;
	pen := params^.first;
	pnum := 0;
	while pn <> nil do begin
	    pnum := pnum + 1;
	    skip := false;
	    case pn^.kind of
		PARAMARRAYVALUE, PARAMARRAYVAR : begin
		    if temps[pnum] <> 0 then begin
			GenOp(PCUSE); GenInteger(temps[pnum]); Comma;
				GenChar('m'); EndLine;
			GenVarT(pn^.paramVar,addressTypeNode,EVALPUT);
			pen := pen^.next;
			pnum := pnum + 1;
			GenOp(PCUSE); GenInteger(temps[pnum]); Comma;
				GenChar('m'); EndLine;
			GenVarT(pn^.numElements,cardinalTypeNode,EVALPUT);
		    end else begin
			pen := pen^.next;
		    end;
		end;
		PARAMVAR : begin
		    if temps[pnum] <> 0 then begin
			GenOp(PCUSE); GenInteger(temps[pnum]); Comma;
				GenChar('m'); EndLine;
			GenVarT(pn^.paramVar,addressTypeNode,EVALPUT);
		    end;
		end;
		PARAMVALUE : begin
		    if temps[pnum] <> 0 then begin
			GenOp(PCUSE); GenInteger(temps[pnum]); Comma;
				GenChar('m'); EndLine;
			GenVar(pn^.paramVar,EVALPUT);
		    end;
		end;
	    end;
	    pen := pen^.next;
	    pn := pn^.next;
	end;
    end;
    GenOp(PCUJP); GenLabel(proc^.tailRecursionEntry); EndLine;
end;

procedure GenFuncProc(procExpr : ExprNode; params : ExprList);
var
    proc : ProcNode;
    pn : ParamNode;
    generated : boolean;
    numParams : integer;
    on : OptNode;
begin
    generated := false;
    if procExpr^.kind = EXPRSYM then begin
	if procExpr^.exprSym^.kind = SYMTYPE then begin
	    GenExpr(params^.first,EVALGET);
	    GenOpTL(PCTYP,procExpr^.exprSym^.symType);
	    generated := true;
	end;
    end;
    if generated then begin
	{ do nothing }
    end else if procExpr^.kind <> EXPRCONST then begin
	numParams := GenParamList(procExpr^.exprType,procExpr,params);
	GenOpT(PCCIP,procExpr^.exprType^.funcType); Comma;
	    if procExpr^.exprType^.funcType <> nil then begin
		GenInteger(SizeOf(procExpr^.exprType^.funcType));
	    end else begin
		GenInteger(0);
	    end;
	    Comma;
	    GenInteger(numParams); EndLine;
    end else begin
	proc := procExpr^.exprConst^.procVal;
	if proc^.builtin <> BIPNOTBIP then begin
	    GenBuiltin(proc,params);
	end else begin
	    numParams := 0;
	    if proc^.procType^.paramList <> nil then begin
		pn := proc^.procType^.paramList^.first;
		while pn <> nil do begin
		    numParams := numParams + 1;
		    pn := pn^.next;
		end;
	    end;
	    if optimFlag then begin
		on := ExprToOpt(procExpr);
		if on^.tailRecursion then begin
		    GenTailRecursion(proc,params);
		    generated := true;
		end;
	    end;
	    if not generated then begin
		numParams := GenParamList(proc^.procType,nil,params);
		GenCall(proc^.internalProc,proc^.globalName,
		    proc^.procType,numParams);
	    end;
	end;
    end;
end;

procedure GenStmtProc(stmt : StmtNode);
begin
    GenFuncProc(stmt^.proc,stmt^.params);
end;


procedure GenStmtIf(stmt : StmtNode);
var
    elseLabel, endLabel : LabelNumber;
    elsePresent : boolean;
begin
    elsePresent := stmt^.elseList <> nil;
    if elsePresent then begin
	elsePresent := stmt^.elseList^.first <> nil;
    end;
    endLabel := NewLabel;
    if elsePresent then begin
	elseLabel := NewLabel;
	GenCondition(stmt^.ifCond,NULLLABEL,elseLabel);
	GenStmtList(stmt^.thenList);
	GenOp(PCUJP); GenLabel(endLabel); EndLine;
	GenLabel(elseLabel); GenOpL(PCLAB);
	GenStmtList(stmt^.elseList);
    end else begin
	GenCondition(stmt^.ifCond,NULLLABEL,endLabel);
	GenStmtList(stmt^.thenList);
    end;
    GenLabel(endLabel); GenOpL(PCLAB);
end;

procedure GenCaseTable(tree : CaseTreeNode; minval, maxval : cardinal;
	elseLabel : LabelNumber);
var
    i : cardinal;
begin
    if tree = nil then begin
	i := minval;
	while i <= maxval do begin
	    GenOp(PCCJP); GenLabel(elseLabel); EndLine;
	    i := i + 1;
	end;
    end else begin
	GenCaseTable(tree^.lower,minval,tree^.first-1,elseLabel);
	i := tree^.first;
	while i <= tree^.last do begin
	    GenOp(PCCJP); GenLabel(tree^.caseNode^.pcodeLabel); EndLine;
	    i := i + 1;
	end;
	GenCaseTable(tree^.higher,tree^.last+1,maxval,elseLabel);
    end;
end;

procedure GenStmtCase(stmt : StmtNode);
var
    caseNode : CaseNode;
    top, elseLabel, table, bottom : LabelNumber;
    node : CaseTreeNode;
    minval, maxval : cardinal;
begin
    top := NewLabel;
    elseLabel := NewLabel;
    table := NewLabel;
    bottom := NewLabel;
    writeln(codeFile,'# Case statement');
    GenOp(PCUJP); GenLabel(top); EndLine;
    caseNode := stmt^.cases^.first;
    while caseNode <> nil do begin
	caseNode^.pcodeLabel := NewLabel;
	GenLabel(caseNode^.pcodeLabel); GenOpL(PCLAB);
	GenStmtList(caseNode^.stmts);
	GenOp(PCUJP); GenLabel(bottom); EndLine;
	caseNode := caseNode^.next;
    end;
    GenLabel(elseLabel); GenOpL(PCLAB);
    if stmt^.caseElse = nil then begin
	if genCheckFlag then begin
	    GenOp(PCCHK); GenChar('c'); EndLine;
	end else begin
	    elseLabel := bottom;
	end;
    end else begin
	GenStmtList(stmt^.caseElse);
	GenOp(PCUJP); GenLabel(bottom); EndLine;
    end;
    node := stmt^.caseTree;
    repeat
	minval := node^.first;
	node := node^.lower;
    until node = nil;
    node := stmt^.caseTree;
    repeat
	maxval := node^.last;
	node := node^.higher;
    until node = nil;
    GenLabel(top); GenOpL(PCLAB);
    GenExpr(stmt^.caseSel,EVALGET);
    GenOp(PCXJP); GenLabel(table); Comma; GenLabel(elseLabel); Comma;
	GenInteger(minval); Comma; GenInteger(maxval); EndLine;
    GenLabel(table); GenOpL(PCLAB);
    GenCaseTable(stmt^.caseTree,minval,maxval,elseLabel);
    GenLabel(bottom); GenOpL(PCLAB);
end;

procedure GenPrePostEval(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
	    OptGenExpr(en,EVALGET,state);
	    en := en^.next;
	end;
    end;
end;

procedure GenStmtWhile(stmt : StmtNode);
var
    top, bottom : LabelNumber;
begin
    top := NewLabel;
    bottom := NewLabel;

    GenCondition(stmt^.whileCond,NULLLABEL,bottom);
    GenPrePostEval(stmt^.whilePreEval,EVALPRE);
GenLabel(top); GenOp(PCLAB); GenChar('l'); EndLine;

    loopNestLevel := loopNestLevel + 1;
    GenStmtList(stmt^.whileBody);
    loopNestLevel := loopNestLevel - 1;

    GenCondition(stmt^.whileCond,top,NULLLABEL);

GenLabel(bottom); GenOpL(PCLAB);

    GenPrePostEval(stmt^.whilePreEval,EVALPOST);
end;


procedure GenStmtRepeat(stmt : StmtNode);
var
    top : LabelNumber;
begin
    top := NewLabel;

    GenPrePostEval(stmt^.repeatPreEval,EVALPRE);

GenLabel(top); GenOp(PCLAB); GenChar('l'); EndLine;

    loopNestLevel := loopNestLevel + 1;
    GenStmtList(stmt^.repeatBody);
    loopNestLevel := loopNestLevel - 1;

    GenCondition(stmt^.repeatCond,NULLLABEL,top);

    GenPrePostEval(stmt^.repeatPreEval,EVALPOST);
end;


procedure GenStmtLoop(stmt : StmtNode);
var
    top, bottom : LabelNumber;
    saveExitLabel : LabelNumber;
begin
    top := NewLabel;
    bottom := NewLabel;
    saveExitLabel := exitLabel;
    exitLabel := bottom;

    GenPrePostEval(stmt^.loopPreEval,EVALPRE);
GenLabel(top); GenOp(PCLAB); GenChar('l'); EndLine;

    loopNestLevel := loopNestLevel + 1;
    GenStmtList(stmt^.loopBody);
    loopNestLevel := loopNestLevel - 1;

    GenOp(PCUJP);
    GenLabel(top);
    EndLine;

    GenLabel(bottom);
    GenOpL(PCLAB);
    exitLabel := saveExitLabel;

    GenPrePostEval(stmt^.loopPreEval,EVALPOST);
end;


procedure GenStmtFor(stmt : StmtNode);
var
    top, bottom : LabelNumber;
    increment, first, last : cardinal;
    compareop : PcodeInst;
    cn : ConstNode;
    tn, atn : TypeNode;
    dotest : boolean;
begin
    top := NewLabel;
    bottom := NewLabel;

    if stmt^.forBy = nil then begin
	increment := 1;
    end else begin
	cn := Eval(stmt^.forBy);
	increment := OrdOf(cn);
    end;

    tn := stmt^.forIndexType;

    if increment > 0 then begin
	compareop := PCLEQ;
    end else begin
	compareop := PCGEQ;
    end;


    GenExpr(stmt^.forTo,EVALGET);
    GenVarT(stmt^.forLimitVar,tn,EVALPUT);
    GenExpr(stmt^.forFrom,EVALGET);
    GenVarT(stmt^.forIndexVar,tn,EVALPUT);

    dotest := true;
    if (stmt^.forFrom^.kind = EXPRCONST) and (stmt^.forTo^.kind = EXPRCONST)
    then begin
	first := OrdOf(Eval(stmt^.forFrom));
	last := OrdOf(Eval(stmt^.forTo));
	if first <= last then begin
	    dotest := compareop <> PCLEQ;
	end else begin
	    dotest := compareop <> PCGEQ;
	end;
    end;
    if dotest then begin
	{ see if loop ever executed }
	GenVarT(stmt^.forIndexVar,tn,EVALGET);
	GenVarT(stmt^.forLimitVar,tn,EVALGET);
	atn := BaseType(tn);
	if atn^.kind = DTCARDINAL then begin
	    GenOpTL(compareop,integerTypeNode);
	end else begin
	    GenOpTL(compareop,tn);
	end;
	GenOp(PCFJP);  GenLabel(bottom); EndLine;
    end;

    { evaluate invariants }
    GenPrePostEval(stmt^.forPreEval,EVALPRE);

GenLabel(top); GenOp(PCLAB); GenChar('l'); EndLine;

    loopNestLevel := loopNestLevel + 1;
    GenStmtList(stmt^.forBody);
    loopNestLevel := loopNestLevel - 1;

    GenVarT(stmt^.forIndexVar,tn,EVALPOINT);
    GenOpT(PCLDC,tn); Comma; GenInteger(SizeOf(tn)); Comma;
	    GenInteger(increment); EndLine;
    GenVarT(stmt^.forLimitVar,tn,EVALGET);
    GenOpT(PCFOR,tn); Comma; GenInteger(SizeOf(tn));
	    Comma; GenLabel(top); EndLine;

{*** old way to increment and test 
    GenVarT(stmt^.forIndexVar,tn,EVALGET);
    GenOpT(PCINC,tn); Comma; GenInteger(increment); EndLine;
    GenVarT(stmt^.forIndexVar,tn,EVALPUT);

    GenVarT(stmt^.forIndexVar,tn,EVALGET);
    GenVarT(stmt^.forLimitVar,tn,EVALGET);
    GenOpTL(compareop,tn);
    GenOp(PCTJP);  GenLabel(top); EndLine;
***}

GenLabel(bottom); GenOpL(PCLAB);

    GenPrePostEval(stmt^.forPreEval,EVALPOST);

end;


procedure GenStmtWith(stmt : StmtNode);
begin
    GenExpr(stmt^.withQual,EVALPOINT);
    GenVar(stmt^.withQualNode^.implQual,EVALPUT);
    GenStmtList(stmt^.withBody);
end;


procedure GenStmtReturn(stmt : StmtNode);
var
    on : OptNode;
    doreturn : boolean;
begin
    doreturn := true;
    if stmt^.returnVal <> nil then begin
	GenExpr(stmt^.returnVal,EVALGET);
	{ watch for tail recursion }
	if optimFlag then begin
	    if stmt^.returnVal^.kind = EXPRFUNC then begin
		on := ExprToOpt(stmt^.returnVal^.func);
		if on^.tailRecursion then begin
		    doreturn := false;
		end;
	    end;
	end;
    end;
    if doreturn then begin
	GenOpTL(PCRET,genProc^.procType^.funcType);
    end;
end;


procedure GenStmtExit(stmt : StmtNode);
begin
    GenOp(PCUJP); GenLabel(exitLabel); EndLine;
end;



procedure GenStmt{(stmt : StmtNode)};
begin
    if TraceGenpc then begin
	writeln(codeFile,'# statement ',stmt^.kind);
    end;
    currFile := stmt^.fileName;
    currLine := stmt^.lineNumber;
    StabLine(currFile,currLine);
    if stmt^.bad then begin
	StmtError(stmt,'GenStmt: bad statement?');
    end;
    case stmt^.kind of
	STMTASSIGN :	GenStmtAssign(stmt);
	STMTPROC :	GenStmtProc(stmt);
	STMTIF :	GenStmtIf(stmt);
	STMTCASE :	GenStmtCase(stmt);
	STMTWHILE :	GenStmtWhile(stmt);
	STMTREPEAT :	GenStmtRepeat(stmt);
	STMTLOOP :	GenStmtLoop(stmt);
	STMTFOR :	GenStmtFor(stmt);
	STMTWITH :	GenStmtWith(stmt);
	STMTRETURN :	GenStmtReturn(stmt);
	STMTEXIT :	GenStmtExit(stmt);
    end;
    UpdateTemps;