genpc.p

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

end;

procedure GenAddress{(address : Address)};
begin
    if address.kind = MEMGLOBAL then begin
	GenMt(address.kind);
	Comma;
	GenInteger(0);
	Comma;
	GenInteger(address.gvn^.number);
    end else if (address.kind = MEMFAST) and (address.proc^.tempMap <> nil)
    then begin
	GenMt(address.kind);
	Comma;
	GenInteger(address.proc^.tempMap^.map[trunc(address.offset) div WORDSIZE]);
	Comma;
	GenInteger(address.proc^.block);
    end else begin
	GenMt(address.kind);
	Comma;
	GenInteger(address.offset);
	Comma;
	GenInteger(address.proc^.block);
    end;
end;

procedure GenVarT{(vn : VarNode; tn : TypeNode; mode : EvalMode)};
begin
    if vn^.address.kind = MEMGLOBAL then begin
	case mode of
	    EVALGET : GenOp(PCLDO);
	    EVALPUT : GenOp(PCSRO);
	    EVALPOINT : GenOp(PCLAO);
	end;
	if mode <> EVALPOINT then begin
	    GenT(tn);
	    Comma;
	end;
	GenInteger(SizeOf(tn));
	Comma;
	GenAddress(vn^.address);
	EndLine;
    end else begin
	case mode of
	    EVALGET : GenOp(PCLOD);
	    EVALPUT : GenOp(PCSTR);
	    EVALPOINT : GenOp(PCLDA);
	end;
	if mode <> EVALPOINT then begin
	    GenT(tn);
	    Comma;
	end;
	GenInteger(SizeOf(tn));
	Comma;
	GenInteger(currLevel - vn^.address.level);
	Comma;
	GenAddress(vn^.address);
	EndLine;
    end;
end;

procedure GenVar{(vn : VarNode; mode : EvalMode)};
begin
    GenVarT(vn,vn^.varType,mode);
end;

procedure GenIndirectVar{(varType : TypeNode; mode : EvalMode)};
begin
    if mode in [EVALGET, EVALPUT] then begin
	if mode = EVALGET then begin
	    GenOp(PCIND);
	end else begin
	    GenOp(PCSTO);
	end;
	GenT(varType);
	Comma;
	GenInteger(SizeOf(varType));
	Comma;
	GenInteger(0);
	EndLine;
    end;
end;

procedure GenExprString(expr : ExprNode; mode : EvalMode);
var
    cn : ConstNode;
    i : integer;
begin
    if mode = EVALPUT then begin
	ExprError(expr,'GenExprString: Cannot store into a constant?');
    end else if expr^.exprConst^.kind <> DTSTRING then begin
	ExprError(expr,'GenExprString: not a string?');
    end else begin
	if mode = EVALGET then begin
	    GenOpT(PCLDC,stringTypeNode);
	end else begin
	    GenOpT(PCLCA,stringTypeNode);
	end;
	cn := expr^.exprConst;
	Comma;
	GenInteger(SizeOf(expr^.exprType));
	Comma;
	GenChar('''');
	WriteStringConst(codeFile,cn^.strVal);
	GenChar('''');
	EndLine;
    end;
end;

procedure GenExprConst(expr : ExprNode; mode : EvalMode);
var
    cn : ConstNode;
begin
    cn := expr^.exprConst;
    case cn^.kind of
	DTINTEGER, DTCARDINAL : begin
	    if expr^.exprType = addressTypeNode then begin
		GenOpT(PCLDC,addressTypeNode);
		Comma;
		GenInteger(WORDSIZE);
		Comma;
		GenInteger(cn^.cardVal);
		EndLine;
	    end else if cn^.cardVal < 0 then begin
		GenConstInteger(cn^.cardVal);
	    end else begin
		GenOpT(PCLDC,cardinalTypeNode);
		Comma;
		GenInteger(WORDSIZE);
		Comma;
		GenInteger(cn^.cardVal);
		EndLine;
	    end;
	end;
	DTCHAR : begin
	    if expr^.exprType^.kind <> DTSTRING then begin
		GenOpT(PCLDC,charTypeNode);
	    end else if mode = EVALGET then begin
		{ char masquerading as a string }
		GenOpT(PCLDC,stringTypeNode);
	    end else if mode = EVALPOINT then begin
		{ char masquerading as a string }
		GenOpT(PCLCA,stringTypeNode);
	    end;
	    Comma;
	    GenInteger(SizeOf(expr^.exprType));
	    Comma;
	    GenChar('''');
	    if cn^.charVal in [ord(' ')..ord('~')] then begin
		if chr(cn^.charVal) in ['''','\'] then begin
		    GenChar(chr(cn^.charVal));
		end;
		GenChar(chr(cn^.charVal));
	    end else begin
		GenChar('\');
		GenInteger(cn^.charVal);
		GenChar('\');
	    end;
	    GenChar('''');
	    EndLine;
	end;
	DTBOOLEAN : begin
	    GenConstBoolean(cn^.boolVal);
	end;
	DTREAL,
	DTLONGREAL : begin
	    GenOpT(PCLDC,expr^.exprType);
	    Comma;
	    GenInteger(SizeOf(expr^.exprType));
	    Comma;
	    GenReal(cn^.realVal);
	    EndLine;
	end;
	DTSTRING : begin
	    GenExprString(expr,mode);
	end;
	DTENUMERATION : begin
	    GenOpT(PCLDC,integerTypeNode);
	    Comma;
	    GenInteger(WORDSIZE);
	    Comma;
	    GenInteger(cn^.enumVal^.enumOrd);
	    EndLine;
	end;
	DTPROC : begin
	    GenOpT(PCLDC,procTypeNode);
	    Comma;
	    GenInteger(WORDSIZE);
	    Comma;
	    GenString(cn^.procVal^.globalName);
	    EndLine;
	end;
	DTPOINTER : begin
	    GenOp(PCLDC);
	    GenChar('n');
	    Comma;
	    GenInteger(WORDSIZE);
	    EndLine;
	end;
	DTSET : begin
	    GenOpT(PCLDC,bitsetTypeNode);
	    Comma;
	    GenSet(cn^.setVal);
	    EndLine;
	end;
    end;
end;

procedure GenExprUnOp(expr : ExprNode; mode : EvalMode);
begin
    GenExpr(expr^.opnd,EVALGET);
    if expr^.exprUnOp = TKMINUS then begin
	GenOpTL(PCNEG,expr^.unOperType);	{ unary subtract }
    end else if expr^.exprUnOp = TKPLUS then begin
	{ unary plus }
    end else begin
	GenOpTL(operPcode[expr^.exprUnOp],expr^.unOperType);
    end;
end;

procedure GenExprBinSetOp(expr : ExprNode);
var
    binOp : Token;
begin
    GenExpr(expr^.opnd1,EVALGET);
    GenExpr(expr^.opnd2,EVALGET);
    binOp := expr^.exprBinOp;
    case binOp of
	TKPLUS : begin
	    GenOpT(PCUNI,expr^.operType);
		Comma; GenInteger(SizeOf(expr^.operType));
	    EndLine;
	end;
	TKMINUS : begin
	    GenOpT(PCDIF,expr^.operType);
		Comma; GenInteger(SizeOf(expr^.operType));
	    EndLine;
	end;
	TKASTERISK : begin
	    GenOpT(PCINT,expr^.operType);
		Comma; GenInteger(SizeOf(expr^.operType));
	    EndLine;
	end;
	TKSLASH : begin
	    GenOpT(PCSDF,expr^.operType);
		Comma; GenInteger(SizeOf(expr^.operType));
	    EndLine;
	end;
	TKLSEQUAL : begin
	    GenOpT(PCDIF,expr^.operType);
		Comma; GenInteger(SizeOf(expr^.operType));
	    EndLine;
	    GenOpT(PCLDC,bitsetTypeNode); Comma;
		GenInteger(SizeOf(expr^.operType)); Comma; GenInteger(0);
	    EndLine;
	    GenOpT(PCEQU,expr^.operType);
		Comma; GenInteger(SizeOf(expr^.operType));
	    EndLine;
	end;
	TKEQUALS, TKSHARP, TKNOTEQUAL: begin
	    GenOpT(operPcode[binOp],expr^.operType); Comma;
		GenInteger(SizeOf(expr^.operType));
	    EndLine;
	end;
    end;
end;

procedure GenExprBinOp(expr : ExprNode; mode : EvalMode);
var
    trueLabel, bothLabel : LabelNumber;
    temp : TempNumber;
    minElement : cardinal;
begin
    if expr^.operType^.kind = DTSET then begin
	GenExprBinSetOp(expr);
    end else if expr^.exprBinOp in [TKAND, TKAMPERSAND, TKOR] then begin
	trueLabel := NewLabel;
	bothLabel := NewLabel;
	temp := AllocTemp;
	GenCondition(expr,trueLabel,NULLLABEL);
	GenConstBoolean(false);
	GenOp(PCSAV); GenInteger(temp); Comma; GenChar('m'); EndLine;
	GenOp(PCUJP); GenLabel(bothLabel); EndLine;
	GenLabel(trueLabel); GenOpL(PCLAB);
	GenConstBoolean(true);
	GenOp(PCSAV); GenInteger(temp); Comma; GenChar('r'); EndLine;
	GenLabel(bothLabel); GenOpL(PCLAB);
	GenOp(PCUSE); GenInteger(temp); Comma; GenChar('m'); EndLine;
	FreeTemp(temp);
    end else if expr^.exprBinOp = TKIN then begin
	GenExpr(expr^.opnd1,EVALGET);
	GenExpr(expr^.opnd2,EVALGET);
	GenOpTL(PCINN,expr^.operType);
    end else begin
	GenExpr(expr^.opnd1,EVALGET);
	GenExpr(expr^.opnd2,EVALGET);
	GenOpT(operPcode[expr^.exprBinOp],expr^.operType);
	    Comma; GenInteger(SizeOf(expr^.operType));
	EndLine;
    end;
end;

procedure GenExprVal(expr : ExprNode; mode : EvalMode);
begin
    if expr^.exprVal^.kind = EXPRVAR then begin
	GenVarT(expr^.exprVal^.exprVar,expr^.exprType,EVALGET);
    end else begin
	GenExpr(expr^.exprVal,EVALPOINT);
	GenIndirectVar(expr^.exprType,EVALGET);
    end;
end;

procedure GenExprFunc(expr : ExprNode);
begin
    GenFuncProc(expr^.func,expr^.params);
end;

procedure DoGenExpr{(expr : ExprNode; mode : EvalMode)};
begin
    case mode of
	EVALGET: begin
	    case expr^.kind of
		EXPRBAD : ;
		EXPRVAR :	GenVar(expr^.exprVar,EVALPOINT);
		EXPRCONST :	GenExprConst(expr,EVALGET);
		EXPRUNOP :	GenExprUnOp(expr,EVALGET);
		EXPRBINOP :	GenExprBinOp(expr,EVALGET);
		EXPRFUNC :	GenExprFunc(expr);
		EXPRVAL :	GenExprVal(expr,EVALGET);
		EXPRCHECK :	GenExprCheck(expr,EVALGET);
	    end;
	end;
	EVALPUT, EVALPOINT: begin
	    case expr^.kind of
		EXPRBAD : ;
		EXPRVAR :	GenVar(expr^.exprVar,mode);
		EXPRCONST :	GenExprConst(expr,mode);
		EXPRBINOP :	GenExprBinOp(expr,mode);
		EXPRVAL :	GenExprVal(expr,mode);
		EXPRFUNC :	GenExprFunc(expr);
		EXPRUNOP : begin
		    ExprError(expr,'GenExpr: address an expression?');
		end;
		EXPRCHECK :	GenExprCheck(expr,mode);
	    end;
	end;
    end;
end;

procedure GenExpr{(expr : ExprNode; mode : EvalMode)};
begin
    if expr = nil then begin
	writeln(codeFile,'# NIL expression ',mode);
    end else begin
	if TraceGenpc then begin
	    writeln(codeFile,'# expression ',expr^.kind,' ',mode);
	end;
	if expr^.exprType = nil then begin
	    ExprError(expr,'GenExpr: no type on expression');
	end;
	if optimFlag then begin
	    OptGenExpr(expr,mode,EVALNORMAL);
	end else begin
	    DoGenExpr(expr,mode);
	end;
    end;
end;

procedure GenConstInteger{(i : cardinal)};
begin
    GenOpT(PCLDC,integerTypeNode);
    Comma;
    GenInteger(WORDSIZE);
    Comma;
    GenInteger(i);
    EndLine;
end;

procedure GenConstBoolean{(b : boolean)};
begin
    GenOpT(PCLDC,booleanTypeNode);
    Comma;
    GenInteger(BOOLEANSIZE);
    Comma;
    GenInteger(ord(b));
    EndLine;
end;

procedure GenCondition{(expr : ExprNode; trueLabel,falseLabel : LabelNumber)};
var
    done : boolean;
    fallThrough : LabelNumber;
begin
    done := false;
    if expr^.kind = EXPRUNOP then begin
	if expr^.exprUnOp = TKNOT then begin
	    GenCondition(expr^.opnd,falseLabel,trueLabel);
	    done := true;
	end;
    end else if expr^.kind = EXPRBINOP then begin
	fallThrough := NULLLABEL;
	if expr^.exprBinOp in [TKAND, TKAMPERSAND] then begin
	    if falseLabel = NULLLABEL then begin
		fallThrough := NewLabel;
		falseLabel := fallThrough;
	    end;
	    GenCondition(expr^.opnd1,NULLLABEL,falseLabel);
	    GenCondition(expr^.opnd2,trueLabel,falseLabel);
	    if fallThrough <> NULLLABEL then begin
		GenLabel(fallThrough); GenOpL(PCLAB);
	    end;
	    done := true;
	end else if expr^.exprBinOp = TKOR then begin
	    if trueLabel = NULLLABEL then begin
		fallThrough := NewLabel;
		trueLabel := fallThrough;
	    end;
	    GenCondition(expr^.opnd1,trueLabel,NULLLABEL);
	    GenCondition(expr^.opnd2,trueLabel,falseLabel);
	    if fallThrough <> NULLLABEL then begin
		GenLabel(fallThrough); GenOpL(PCLAB);
	    end;
	    done := true;
	end;
    end;
    if not done then begin
	GenExpr(expr,EVALGET);
	if trueLabel <> NULLLABEL then begin
	    GenOp(PCTJP); GenLabel(trueLabel); EndLine;
	    if falseLabel <> NULLLABEL then begin
		GenOp(PCUJP); GenLabel(falseLabel); EndLine;
	    end;
	end else begin
	    GenOp(PCFJP); GenLabel(falseLabel); EndLine;
	end;
    end;
end;

procedure GenTemp(op : PcodeInst; on : OptNode; en : ExprNode);
var
    addr : Address;
    tn : TypeNode;
begin
    addr.kind := MEMFAST;
    addr.level := currLevel;
    addr.proc := genProc;
    addr.offset := (MAXTSTORAGE + on^.tempNumber) * WORDSIZE;
    if on^.address then begin
	tn := addressTypeNode;
    end else begin
	tn := en^.exprType;
    end;
    GenOpT(op,tn); Comma; GenInteger(WORDSIZE); Comma; GenInteger(0); Comma;
	GenAddress(addr); EndLine;
end;

procedure OptGenExpr{(en : ExprNode; mode : EvalMode; state : EvalState)};
var
    on, ron : OptNode;
begin
    on := ExprToOpt(en);
    ron := on^.rootEqual;
    if (on^.usage <> OUSEINDIVIDUAL) or
	    ((on^.usage = OUSEINDIVIDUAL) and (state <> EVALNORMAL))
    then begin
	if TraceOptim then begin
	    write(output,'OptGenExpr: usage=',on^.usage:1,', mode=',mode:1,
		', state=',state:1,', expr=');
	    WriteExpr(output,en);
	    writeln(output);
	end;
    end;
    case on^.usage of
	OUSEINDIVIDUAL : begin
	    { not subexpression, do normal evaluate }
	    if state = EVALNORMAL then begin
		DoGenExpr(en,mode);
	    end;
	end;
	OUSEGENERATE : begin
	    { either generation or discard of a value, depending on state }
	    if state = EVALPRE then begin
		{ calculate a value for later use }
		if ron^.address then begin
		    DoGenExpr(en,EVALPOINT);
		end else begin
		    DoGenExpr(en,mode);
		end;
		{GenOp(PCSAV); GenInteger(ron^.tempNumber); Comma; GenChar('m');
		EndLine;}
		GenTemp(PCSTR,ron,en);
	    end else begin
		{ finished with saved value }
		{GenOp(PCUSE); GenInteger(ron^.tempNumber); Comma; GenChar('d');
		EndLine;}
	    end;
	end;
	OUSEFIRST : begin
	    { first use of a value, evaluate and copy it }
	    if ron^.address then begin
		DoGenExpr(en,EVALPOINT);
	    end else begin
		DoGenExpr(en,mode);
	    end;
	    {GenOp(PCSAV); GenInteger(ron^.tempNumber); Comma; GenChar('c');
	    EndLine;}
	    GenTemp(PCSTN,ron,en);
	end;
	OUSEMIDDLE : begin
	    { reuse saved value }
	    {GenOp(PCUSE); GenInteger(ron^.tempNumber); Comma; GenChar('c');
	    EndLine;}
	    GenTemp(PCLOD,ron,en);
	end;
	OUSELAST : begin
	    { last use of saved value }
	    {GenOp(PCUSE); GenInteger(ron^.tempNumber); Comma; GenChar('m');
	    EndLine;}
	    GenTemp(PCLOD,ron,en);
	end;
    end;
end;