Разработка компилятора подмножества языка Паскаль на язык Ассемблера

Result := MakeSymbolStr(iRuleNum)

else Result := Lexem.LexInfoStr;

end;

destructor TSymbol.Destroy;

var i: integer;

begin

if SymbInfo.SymbType = SYMB_SYNT then

with SymbInfo.LexList do

begin

for i:=Count-1 downto 0 do TSymbol(Items[i]).Free;

Free;

end;

inherited Destroy;

end;

destructor TSymbStack.Destroy;

begin

Clear;

inherited Destroy;

end;

procedure TSymbStack.Clear;

var i: integer;

begin

for i:=Count-1 downto 0 do TSymbol(Items[i]).Free;

inherited Clear;

end;

function TSymbStack.GetSymbol(iIdx: integer): TSymbol;

begin

Result := TSymbol(Items[iIdx]);

end;

function TSymbStack.TopLexem: TLexem;

var i: integer;

begin

Result := nil;

for i:=Count-1 downto 0 do

if Symbols[i].SymbType = SYMB_LEX then

begin

Result := Symbols[i].Lexem;

Break;

end;

end;

function TSymbStack.Push(lex: TLexem): TSymbol;

begin

Result := TSymbol.CreateLex(lex);

Add(Result);

end;

function TSymbStack.MakeTopSymb: TSymbol;

var

symCur: TSymbol;

SymbArr: TSymbArray;

i,iSymbN: integer;

sRuleStr: string;

procedure AddToRule(const sStr: string;

sym: TSymbol);

begin

symCur := sym;

SymbArr[iSymbN] := Symbols[i];

sRuleStr := sStr + sRuleStr;

Delete(i);

Inc(iSymbN);

end;

begin

Result := nil;

iSymbN := 0;

symCur := nil;

sRuleStr := '';

for i:=Count-1 downto 0 do

begin

if Symbols[i].SymbType = SYMB_SYNT then

AddToRule(Symbols[i].SymbolStr,symCur)

else

if symCur = nil then

AddToRule(LexTypeInfo(Symbols[i].Lexem.LexType),

Symbols[i])

else

if GramMatrix[Symbols[i].Lexem.LexType,

symCur.Lexem.LexType] = '=' then

AddToRule(LexTypeInfo(Symbols[i].Lexem.LexType),

Symbols[i])

else

Break;

if iSymbN > RULE_LENGTH then Break;

end;

if iSymbN <> 0 then

begin

for i:=1 to RULE_NUM do

if GramRules[i] = sRuleStr then

begin

Result := TSymbol.CreateSymb(i,iSymbN,SymbArr);

Add(Result);

Break;

end;

if Result = nil then

for i:=0 to iSymbN-1 do SymbArr[i].Free;

end;

end;

function BuildSyntList(

const listLex: TLexList{входная таблица лексем};

symbStack: TSymbStack{стек для работы алгоритма}

): TSymbol;

var

i,iCnt: integer;

lexStop: TLexem;

lexTCur: TLexType;{тип текущей лексемы}

cRule: char;{текущее отношение предшествования}

begin

Result := nil;

iCnt := listLex.Count-1;

lexStop := TLexem.CreateInfo('Начало файла',0,0,0);

try

symbStack.Push(lexStop);

i := 0;

while i<=iCnt do

begin

lexTCur := symbStack.TopLexem.LexType;

if (lexTCur = LEX_START)

and (listLex[i].LexType = LEX_START) then Break;

cRule := GramMatrix[lexTCur,listLex[i].LexType];

cRule := CorrectRule(cRule,lexTCur,

listLex[i].LexType,symbStack);

case cRule of

'<','=':

begin

symbStack.Push(listLex[i]);

Inc(i);

end;

'>':

if symbStack.MakeTopSymb = nil then

begin

Result := TSymbol.CreateLex(listLex[i]);

Break;

end;

else

begin

Result := TSymbol.CreateLex(listLex[i]);

Break;

end;

end{case};

end{while};

if Result = nil then

begin

if symbStack.Count = 2 then

Result := symbStack[1]

else Result := TSymbol.CreateLex(listLex[iCnt]);

end;

finally

lexStop.Free;

end;

end;

end.

unit TblElem;

interface

type

TAddVarInfo = class(TObject)

public

procedure SetInfo(iIdx: integer; iInfo: longint);

virtual; abstract;

function GetInfo(iIdx: integer): longint;

virtual; abstract;

property Info[iIdx: integer]: longint

read GetInfo write SetInfo; default;

end;

TVarInfo = class(TObject)

protected

sName: string;

pInfo: TAddVarInfo;

minEl,maxEl: TVarInfo;

public

constructor Create(const sN: string);

destructor Destroy; override;

procedure SetInfo(pI: TAddVarInfo);

procedure ClearInfo;

procedure ClearAllInfo;

property VarName: string read sName;

property Info: TAddVarInfo read pInfo write SetInfo;

function AddElCnt(const sAdd: string;

var iCnt: integer): TVarInfo;

function AddElem(const sAdd: string): TVarInfo;

function FindElCnt(const sN: string;

var iCnt: integer): TVarInfo;

function FindElem(const sN: string): TVarInfo;

function GetElList(const sLim,sInp,sOut: string): string;

end;

function Upper(const x:string): string;

implementation

uses SysUtils;

{$IFDEF REGNAME}

function Upper(const x:string): string;

begin Result := UpperCase(x); end;

{$ELSE}

function Upper(const x:string): string;

begin Result := x; end;

{$ENDIF}

constructor TVarInfo.Create(const sN: string);

begin

inherited Create;

sName := sN;

pInfo := nil;

minEl := nil;

maxEl := nil;

end;

destructor TVarInfo.Destroy;

begin

ClearAllInfo;

minEl.Free;

maxEl.Free;

inherited Destroy;

end;

function TVarInfo.GetElList(const sLim{разделитель списка},

sInp,sOut{имена, не включаемые в строку}: string): string;

var sAdd: string;

begin

Result := '';

if (Upper(sName) <> Upper(sInp))

and (Upper(sName) <> Upper(sOut)) then Result := sName;

if minEl <> nil then

begin

sAdd := minEl.GetElList(sLim,sInp,sOut);

if sAdd <> '' then

begin

if Result <> '' then Result := Result + sLim + sAdd

else Result := sAdd;

end;

end;

if maxEl <> nil then

begin

sAdd := maxEl.GetElList(sLim,sInp,sOut);

if sAdd <> '' then

begin

if Result <> '' then Result := Result + sLim + sAdd

else Result := sAdd;

end;

end;

end;

procedure TVarInfo.SetInfo(pI: TAddVarInfo);

begin

pInfo := pI;

end;

procedure TVarInfo.ClearInfo;

begin

pInfo.Free;

pInfo := nil;

end;

procedure TVarInfo.ClearAllInfo;

begin

if minEl <> nil then minEl.ClearAllInfo;

if maxEl <> nil then maxEl.ClearAllInfo;

pInfo.Free;

pInfo := nil;

end;

function TVarInfo.AddElCnt(const sAdd: string;

var iCnt: integer): TVarInfo;

var i: integer;

begin

Inc(iCnt);

i := StrComp(PChar(Upper(sAdd)),PChar(Upper(sName)));

if i < 0 then

begin

if minEl <> nil then

Result := minEl.AddElCnt(sAdd,iCnt)

else

begin

Result := TVarInfo.Create(sAdd);

minEl := Result;

end;

end

else

if i > 0 then

begin

if maxEl <> nil then

Result := maxEl.AddElCnt(sAdd,iCnt)

else

begin

Result := TVarInfo.Create(sAdd);

maxEl := Result;

end;

end

else Result := Self;

end;

function TVarInfo.AddElem(const sAdd: string): TVarInfo;

var iCnt: integer;

begin

Result := AddElCnt(sAdd,iCnt);

end;

function TVarInfo.FindElCnt(const sN: string;

var iCnt: integer): TVarInfo;

var i: integer;

begin

Inc(iCnt);

i := StrComp(PChar(Upper(sN)),PChar(Upper(sName)));

if i < 0 then

begin

if minEl <> nil then Result := minEl.FindElCnt(sN,iCnt)

else Result := nil;

end

else

if i > 0 then

begin

if maxEl <> nil then Result := maxEl.FindElCnt(sN,iCnt)

else Result := nil;

end

else Result := Self;

end;

function TVarInfo.FindElem(const sN: string): TVarInfo;

var iCnt: integer;

begin

Result := FindElCnt(sN,iCnt);

end;

end.

unit Triads;

interface

uses Classes, TblElem, LexElem, TrdType;

type

TTriad = class;

TOpType = (OP_CONST, OP_VAR, OP_LINK);

TOperand = record

case OpType: TOpType of

OP_CONST: (ConstVal: integer);

OP_VAR: (VarLink: TVarInfo);

OP_LINK: (TriadNum: integer);

end;

TOpArray = array[1..2] of TOperand;

TTriad = class(TObject)

private

TriadType: TTriadType;

Operands: TOpArray;

public

Info: longint;

IsLinked: Boolean;

constructor Create(Typ: TTriadType; const Ops: TOpArray);

function GetOperand(iIdx: integer): TOperand;

procedure SetOperand(iIdx: integer; Op: TOperand);

function GetLink(iIdx: integer): integer;

procedure SetLink(iIdx: integer; TrdN: integer);

function GetOpType(iIdx: integer): TOpType;

procedure SetOpType(iIdx: integer; OpT: TOpType);

function GetConstVal(iIdx: integer): integer;

procedure SetConstVal(iIdx: integer; iVal: integer);

property TrdType: TTriadType read TriadType;

property Opers[iIdx: integer]: TOperand read GetOperand

write SetOperand; default;

property Links[iIdx: integer]: integer read GetLink

write SetLink;

property OpTypes[iIdx: integer]: TOpType read GetOpType

write SetOpType;

property Values[iIdx: integer]: integer read GetConstVal

write SetConstVal;

function IsEqual(Trd1: TTriad): Boolean;

function MakeString(i: integer): string;

end;

TTriadList = class(TList)

public

procedure Clear; override;

destructor Destroy; override;

procedure WriteToList(list: TStrings);

procedure DelTriad(iIdx: integer);

function GetTriad(iIdx: integer): TTriad;

property Triads[iIdx: integer]: TTriad read GetTriad;

default;

end;

procedure DelTriadTypes(listTriad: TTriadList;

TrdType: TTriadType);

implementation

uses SysUtils, FncTree, LexType;

constructor TTriad.Create(Typ: TTriadType;

const Ops: TOpArray);

var i: integer;

begin

inherited Create;

TriadType := Typ;

for i:=1 to 2 do Operands[i] := Ops[i];

Info := 0;

IsLinked := False;

end;

function TTriad.GetOperand(iIdx: integer): TOperand;

begin

Result := Operands[iIdx];

end;

procedure TTriad.SetOperand(iIdx: integer; Op: TOperand);

begin

Operands[iIdx] := Op;

end;

function TTriad.GetLink(iIdx: integer): integer;

begin

Result := Operands[iIdx].TriadNum;

end;

procedure TTriad.SetLink(iIdx: integer; TrdN: integer);

begin

Operands[iIdx].TriadNum := TrdN;

end;

function TTriad.GetOpType(iIdx: integer): TOpType;

begin

Result := Operands[iIdx].OpType;

end;

function TTriad.GetConstVal(iIdx: integer): integer;

begin

Result := Operands[iIdx].ConstVal;

end;

procedure TTriad.SetConstVal(iIdx: integer; iVal: integer);

begin

Operands[iIdx].ConstVal := iVal;

end;

procedure TTriad.SetOpType(iIdx: integer; OpT: TOpType);

begin

Operands[iIdx].OpType := OpT;

end;

function IsEqualOp(const Op1,Op2: TOperand): Boolean;

begin

Result := (Op1.OpType = Op2.OpType);

if Result then

case Op1.OpType of

OP_CONST: Result := (Op1.ConstVal = Op2.ConstVal);

OP_VAR: Result := (Op1.VarLink = Op2.VarLink);

OP_LINK: Result := (Op1.TriadNum = Op2.TriadNum);

end;

end;

function TTriad.IsEqual(Trd1: TTriad): Boolean;

begin

Result := (TriadType = Trd1.TriadType)

and IsEqualOp(Operands[1],Trd1[1])

and IsEqualOp(Operands[2],Trd1[2]);

end;

function GetOperStr(Op: TOperand): string;

begin

case Op.OpType of

OP_CONST: Result := IntToStr(Op.ConstVal);

OP_VAR: Result := Op.VarLink.VarName;

OP_LINK: Result := '^'+ IntToStr(Op.TriadNum+1);

end{case};

end;

function TTriad.MakeString(i: integer): string;

begin

Result := Format('%d:'#9'%s (%s, %s)',

[i+1,TriadStr[TriadType],

GetOperStr(Opers[1]),GetOperStr(Opers[2])]);

end;

destructor TTriadList.Destroy;

begin

Clear;

inherited Destroy;

end;

procedure TTriadList.Clear;

var i: integer;

begin

for i:=Count-1 downto 0 do TTriad(Items[i]).Free;

inherited Clear;

end;

procedure TTriadList.DelTriad(iIdx: integer);

begin

if iIdx < Count-1 then

TTriad(Items[iIdx+1]).IsLinked :=

TTriad(Items[iIdx+1]).IsLinked

or TTriad(Items[iIdx]).IsLinked;

TTriad(Items[iIdx]).Free;

Delete(iIdx);

end;

function TTriadList.GetTriad(iIdx: integer): TTriad;

begin

Result := TTriad(Items[iIdx]);

end;

procedure TTriadList.WriteToList(list: TStrings);

var

i,iCnt: integer;

begin

list.Clear;

iCnt := Count-1;

for i:=0 to iCnt do

list.Add(TTriad(Items[i]).MakeString(i));

end;

procedure DelTriadTypes(listTriad: TTriadList;

TrdType: TTriadType);

var

i,j,iCnt,iDel: integer;

listNum: TList;

Trd: TTriad;

begin

iDel := 0;

iCnt := listTriad.Count-1;

listNum := TList.Create;

try

for i:=0 to iCnt do

begin

listNum.Add(TObject(iDel));

if listTriad[i].TriadType = TrdType then Inc(iDel);

end;

for i:=iCnt downto 0 do

begin

Trd := listTriad[i];

if Trd.TriadType = TrdType then listTriad.DelTriad(i)

else

for j:=1 to 2 do

if Trd[j].OpType = OP_LINK then

Trd.Links[j] :=

Trd.Links[j] - integer(listNum[Trd.Links[j]]);

end;

finally listNum.Free;

end;

end;

end.

unit TrdType;

interface

const

NAME_PROG = 'MyCurs';

NAME_INPVAR = 'InpVar';

NAME_RESULT = 'Result';

NAME_FUNCT = 'CompileTest';

NAME_TYPE = 'integer';

type

TTriadType = (TRD_IF, TRD_OR, TRD_XOR, TRD_AND, TRD_NOT,

TRD_LT, TRD_GT, TRD_EQ, TRD_NEQ,

TRD_ADD, TRD_SUB, TRD_UMIN, TRD_ASSIGN,

TRD_JMP, TRD_CONST, TRD_SAME, TRD_NOP);

TTriadStr = array[TTriadType] of string;

const

TriadStr: TTriadStr =

('if','or','xor','and','not',

'<','>','=','<>','+','-','-',':=',

'jmp','C','same','nop');

TriadLineSet : set of TTriadType =

[TRD_OR, TRD_XOR, TRD_AND, TRD_NOT, TRD_ADD, TRD_SUB,

TRD_LT, TRD_GT, TRD_EQ, TRD_NEQ, TRD_UMIN];

implementation

end.

unit TrdOpt;

interface

uses Classes, TblElem, LexElem, TrdType, Triads;

type

TConstInfo = class(TAddVarInfo)

protected

iConst: longint;

constructor Create(iInfo: longint);

public

function GetInfo(iIdx: integer): longint; override;

procedure SetInfo(iIdx: integer; iInfo: longint);

override;

end;

TDepInfo = class(TAddVarInfo)

protected

iDep: longint;

constructor Create(iInfo: longint);

public

function GetInfo(iIdx: integer): longint; override;

procedure SetInfo(iIdx: integer; iInfo: longint);

override;

end;

procedure OptimizeConst(listTriad: TTriadList);

procedure OptimizeSame(listTriad: TTriadList);

implementation

uses SysUtils, FncTree, LexType, TrdCalc;

constructor TConstInfo.Create(iInfo: longint);

begin

inherited Create;

iConst := iInfo;

end;

procedure TConstInfo.SetInfo(iIdx: integer;

iInfo: longint);

begin

iConst := iInfo;

end;

function TConstInfo.GetInfo(iIdx: integer): longint;

begin

Result := iConst;

end;

function TestOperConst(Op: TOperand; listTriad: TTriadList;

var iConst: integer): Boolean;

var pInfo: TConstInfo;

begin

Result := False;

case Op.OpType of

OP_CONST:

begin

iConst := Op.ConstVal;

Result := True;

end;

OP_VAR:

begin

pInfo := TConstInfo(Op.VarLink.Info);

if pInfo <> nil then

begin

iConst := pInfo[0];

Result := True;

end;

end;

OP_LINK:

begin

if listTriad[Op.TriadNum].TrdType = TRD_CONST

then

begin

iConst := listTriad[Op.TriadNum][1].ConstVal;

Result := True;

end;

end;

end{case};

end;

procedure OptimizeConst(listTriad: TTriadList);

var

i,j,iCnt,iOp1,iOp2: integer;

Ops: TOpArray;

Trd: TTriad;

begin

ClearTreeInfo;

Ops[1].OpType := OP_CONST;

Ops[2].OpType := OP_CONST;

Ops[2].ConstVal := 0;

iCnt := listTriad.Count-1;

for i:=0 to iCnt do

begin

Trd := listTriad[i];

if Trd.TrdType in TriadLineSet then

begin

for j:=1 to 2 do

if (Trd[j].OpType = OP_LINK)

and (listTriad[Trd.Links[j]].TrdType = TRD_CONST)

then

begin

Trd.OpTypes[j] := OP_CONST;

Trd.Values[j] :=

listTriad[Trd.Links[j]][1].ConstVal;

end;

end

else

if Trd.TrdType = TRD_IF then

begin

if (Trd[1].OpType = OP_LINK)

and (listTriad[Trd.Links[1]].TrdType = TRD_CONST)

then

begin

Trd.OpTypes[1] := OP_CONST;

Trd.Values[1] :=

listTriad[Trd.Links[1]][1].ConstVal;

end;

end

else

if Trd.TrdType = TRD_ASSIGN then

begin

if (Trd[2].OpType = OP_LINK)

and (listTriad[Trd.Links[2]].TrdType = TRD_CONST)

then

begin

Trd.OpTypes[2] := OP_CONST;

Trd.Values[2] :=

listTriad[Trd.Links[2]][1].ConstVal;

end;

end;

if Trd.IsLinked then ClearTreeInfo;

if Trd.TrdType = TRD_ASSIGN then

begin

if TestOperConst(Trd[2],listTriad,iOp2) then

Trd[1].VarLink.Info := TConstInfo.Create(iOp2);

end

else

if Trd.TrdType in TriadLineSet then

begin

if TestOperConst(Trd[1],listTriad,iOp1)

and TestOperConst(Trd[2],listTriad,iOp2) then

begin

Ops[1].ConstVal :=

CalcTriad(Trd.TrdType,iOp1,iOp2);

listTriad.Items[i] := TTriad.Create(TRD_CONST,Ops);

listTriad[i].IsLinked := Trd.IsLinked;

Trd.Free;

end;

end;

end;

end;

constructor TDepInfo.Create(iInfo: longint);

begin

inherited Create;

iDep := iInfo;

end;

procedure TDepInfo.SetInfo(iIdx: integer; iInfo: longint);

begin

iDep := iInfo;

end;

function TDepInfo.GetInfo(iIdx: integer): longint;

begin

Result := iDep;

end;

function CalcDepOp(listTriad: TTriadList;

Op: TOperand): longint;

begin

Result := 0;

case Op.OpType of

OP_VAR:

if Op.VarLink.Info <> nil then Result :=

Op.VarLink.Info.Info[0];

OP_LINK:

Result := listTriad[Op.TriadNum].Info;

end{case};

end;

function CalcDep(listTriad: TTriadList;

Trd: TTriad): longint;

var iDepTmp: longint;

begin

Result := CalcDepOp(listTriad,Trd[1]);

iDepTmp := CalcDepOp(listTriad,Trd[2]);

if iDepTmp > Result then Result := iDepTmp+1

else Inc(Result);

Trd.Info := Result;

end;

procedure OptimizeSame(listTriad: TTriadList);

var

i,j,iStart,iCnt,iNum: integer;

Ops: TOpArray;

Trd: TTriad;

begin

iStart := 0;

ClearTreeInfo;

iCnt := listTriad.Count-1;

Ops[1].OpType := OP_LINK;

Ops[2].OpType := OP_CONST;

Ops[2].ConstVal := 0;

for i:=0 to iCnt do

begin

Trd := listTriad[i];

if Trd.IsLinked then

begin

ClearTreeInfo;

iStart := i;

end;

for j:=1 to 2 do

if Trd[j].OpType = OP_LINK then

begin

iNum := Trd[j].TriadNum;

if listTriad[iNum].TrdType = TRD_SAME then

Trd.Links[j] := listTriad[iNum].Links[1];

end;

if Trd.TrdType = TRD_ASSIGN then

begin

Trd[1].VarLink.Info := TDepInfo.Create(i+1);

end

else

if Trd.TrdType in TriadLineSet then

begin

CalcDep(listTriad,Trd);

for j:=iStart to i-1 do

begin

if Trd.IsEqual(listTriad[j])

and (Trd.Info = listTriad[j].Info) then

begin

Ops[1].TriadNum := j;

listTriad.Items[i] :=

TTriad.Create(TRD_SAME,Ops);

listTriad[i].IsLinked := Trd.IsLinked;

Trd.Free;

Break;

end;

end;

end{if};

end{for};

end;

end.

unit TrdCalc;

interface

uses TrdType;

function CalcTriad(Triad: TTriadType;

iOp1,iOp2: integer): integer;

implementation

function CalcTriad(Triad: TTriadType;

iOp1,iOp2: integer): integer;

begin

Result := 0;

case Triad of

TRD_OR: Result := (iOp1 or iOp2) and 1;

TRD_XOR: Result := (iOp1 xor iOp2) and 1;

TRD_AND: Result := (iOp1 and iOp2) and 1;

TRD_NOT: Result := (not iOp1) and 1;

TRD_LT: if iOp1<iOp2 then Result := 1

else Result := 0;

TRD_GT: if iOp1>iOp2 then Result := 1

else Result := 0;

TRD_EQ: if iOp1=iOp2 then Result := 1

else Result := 0;

TRD_NEQ: if iOp1<>iOp2 then Result := 1

else Result := 0;

TRD_ADD: Result := iOp1 + iOp2;

TRD_SUB: Result := iOp1 - iOp2;

TRD_UMIN: Result := -iOp2;

end;

end;

end.

unit TrdMake;

interface

uses LexElem, Triads, SyntSymb;

function MakeTriadList(symbTop: TSymbol;

listTriad: TTriadList): TLexem;

implementation

uses LexType, TrdType;

function GetLexem(symbOp: TSymbol): TLexem;

begin

case symbOp.Rule of

0: Result := symbOp.Lexem;

27,28: Result := symbOp[0].Lexem;

19,26: Result := GetLexem(symbOp[1])

else Result := nil;

end;

end;

function MakeTriadListNOP(symbTop: TSymbol;

listTriad: TTriadList): TLexem;

var

Opers: TOpArray;

iIns1,iIns2,iIns3: integer;

function MakeOperand(

iOp{номер операнда},

iSymOp{порядковый номер символа в синт. конструкции},

iMin{минимальная позиция триады в списке},

iSymErr{номер лексемы, на которой

позиционировать ошибку}: integer;

var iIns: integer{индекс триады в списке}): TLexem;

var lexTmp: TLexem;

begin

lexTmp := GetLexem(symbTop[iSymOp]);

if lexTmp <> nil then

with lexTmp do

begin

if LexType = LEX_VAR then

begin

if VarInfo.VarName = NAME_RESULT then

begin

Result := lexTmp;

Exit;

end;

Opers[iOp].OpType := OP_VAR;

Opers[iOp].VarLink := VarInfo;

end

else

if LexType = LEX_CONST then

begin

Opers[iOp].OpType := OP_CONST;

Opers[iOp].ConstVal := ConstVal;

end

else

begin

Result := lexTmp;

Exit;

end;

iIns := iMin;

Result := nil;

end

else

begin

Result := MakeTriadListNOP(symbTop[iSymOp],listTriad);

if Result <> nil then Exit;

iIns := listTriad.Count;

if iIns <= iMin then

begin

Result := symbTop[iSymErr].Lexem;

Exit;

end;

Opers[iOp].OpType := OP_LINK;

Opers[iOp].TriadNum := iIns-1;

end;

end;

function MakeOperation(

Trd: TTriadType{тип создаваемой триады}): TLexem;

begin

Result := MakeOperand(1{op},0{sym},listTriad.Count,

1{sym err},iIns1);

if Result <> nil then Exit;

Result := MakeOperand(2{op},2{sym},iIns1,

1{sym err},iIns2);

if Result <> nil then Exit;

listTriad.Add(TTriad.Create(Trd,Opers));

end;

begin

case symbTop.Rule of

5:{'if(B)EelseE'}

begin

Result := MakeOperand(1{op},2{sym},listTriad.Count,

1{sym err},iIns1);

if Result <> nil then Exit;

Opers[2].OpType := OP_LINK;

Opers[2].TriadNum := 0;

listTriad.Add(TTriad.Create(TRD_IF,Opers));

Result := MakeOperand(2{op},4{sym},iIns1,

3{sym err},iIns2);

if Result <> nil then Exit;

Opers[1].OpType := OP_CONST;

Opers[1].ConstVal := 1;

Opers[2].OpType := OP_LINK;

Opers[2].TriadNum := 0;

listTriad.Add(TTriad.Create(TRD_JMP,Opers));

listTriad[iIns1].Links[2] := iIns2+1;

Result := MakeOperand(2{op},6{sym},iIns2,

5{sym err},iIns3);

if Result <> nil then Exit;

listTriad[iIns2].Links[2] := iIns3;

end;

6:{'if(B)E'}

begin

Result := MakeOperand(1{op},2{sym},listTriad.Count,

1{sym err},iIns1);

if Result <> nil then Exit;

Opers[2].OpType := OP_LINK;

Opers[2].TriadNum := 0;

listTriad.Add(TTriad.Create(TRD_IF,Opers));

Result := MakeOperand(2{op},4{sym},iIns1,

3{sym err},iIns2);

if Result <> nil then Exit;

listTriad[iIns1].Links[2] := iIns2;

end;

8:{'while(B)doE'}

begin

iIns3 := listTriad.Count;

Result := MakeOperand(1{op},2{sym},iIns3,

1{sym err},iIns1);

if Result <> nil then Exit;

Opers[2].OpType := OP_LINK;

Opers[2].TriadNum := 0;

listTriad.Add(TTriad.Create(TRD_IF,Opers));

Result := MakeOperand(2{op},5{sym},iIns1,

4{sym err},iIns2);

if Result <> nil then Exit;

Opers[1].OpType := OP_CONST;

Opers[1].ConstVal := 1;

Opers[2].OpType := OP_LINK;

Opers[2].TriadNum := iIns3;

{ Создаем триаду типа "JMP" }

listTriad.Add(TTriad.Create(TRD_JMP,Opers));

listTriad[iIns1].Links[2] := iIns2+1;

end;

9:{'a:=E'}

begin

if symbTop[0].Lexem.LexType <> LEX_VAR then

begin

Result := symbTop[0].Lexem;

Exit;

end;

if (symbTop[0].Lexem.VarName = NAME_INPVAR)

or (symbTop[0].Lexem.VarName = NAME_RESULT) then

begin

Result := symbTop[0].Lexem;

Exit;

end;

Opers[1].OpType := OP_VAR;

Opers[1].VarLink := symbTop[0].Lexem.VarInfo;

Result := MakeOperand(2{op},2{sym},listTriad.Count,

1{sym err},iIns1);

if Result <> nil then Exit;

listTriad.Add(TTriad.Create(TRD_ASSIGN,Opers));

end;

10:{'BorB'} Result := MakeOperation(TRD_OR);

11:{'BxorB'} Result := MakeOperation(TRD_XOR);

13:{'BandB'} Result := MakeOperation(TRD_AND);

15:{'E<E'} Result := MakeOperation(TRD_LT);

16:{'E>E'} Result := MakeOperation(TRD_GT);

17:{'E=E'} Result := MakeOperation(TRD_EQ);

18:{'E<>E'} Result := MakeOperation(TRD_NEQ);

21:{'E-E'} Result := MakeOperation(TRD_SUB);

22:{'E+E'} Result := MakeOperation(TRD_ADD);

20:{not(B)}

begin

Result := MakeOperand(1{op},2{sym},listTriad.Count,

1{sym err},iIns1);

if Result <> nil then Exit;

Opers[2].OpType := OP_CONST;

Opers[2].ConstVal := 0;

listTriad.Add(TTriad.Create(TRD_NOT,Opers));

end;

24:{uminE}

begin

Result := MakeOperand(2{op},1{sym},listTriad.Count,

0{sym err},iIns1);

if Result <> nil then Exit;

Opers[1].OpType := OP_CONST;

Opers[1].ConstVal := 0;

listTriad.Add(TTriad.Create(TRD_UMIN,Opers));

end;

1,7,19,26:{'progEend.','beginEend','(E)','(B)'}

Result := MakeTriadListNOP(symbTop[1],listTriad);

3:{E;E}

begin

Result := MakeTriadListNOP(symbTop[0],listTriad);

if Result <> nil then Exit;

Result := MakeTriadListNOP(symbTop[2],listTriad);

end;

27,28: Result := nil;

else Result := MakeTriadListNOP(symbTop[0],listTriad);

end{case Rule};

end;

function MakeTriadList(symbTop: TSymbol;

listTriad: TTriadList): TLexem;

var

i: integer;

Opers: TOpArray;

Trd: TTriad;

begin

Result := MakeTriadListNOP(symbTop,listTriad);

if Result = nil then

with listTriad do

begin

Opers[1].OpType := OP_CONST;

Opers[1].ConstVal := 0;

Opers[2].OpType := OP_CONST;

Opers[2].ConstVal := 0;

Add(TTriad.Create(TRD_NOP,Opers));

for i:=Count-1 downto 0 do

begin

Trd := Triads[i];

if Trd.TrdType in [TRD_IF,TRD_JMP] then

begin

if Trd.OpTypes[2] = OP_LINK then

listTriad[Trd.Links[2]].IsLinked := True;

end;

end;

end;

end;

end.

unit TrdAsm;

interface

uses Classes, TrdType, Triads;

const

TEMP_VARNAME = '_Tmp';

NUM_PROCREG = 6;

function MakeRegisters(listTriad: TTriadList): integer;

function MakeAsmCode(listTriad: TTriadList;

listCode: TStrings;

flagOpt: Boolean): integer;

implementation

uses SysUtils;

function MakeRegisters(listTriad: TTriadList): integer;

var

i,j,iR,iCnt,iNum : integer;

listReg: TList;

begin

Result := 0;

listReg := TList.Create;

if listReg <> nil then

try

for i:=listTriad.Count-1 downto 0 do

listTriad[i].Info := 0;

for i:=listTriad.Count-1 downto 0 do

for j:=1 to 2 do

if ((listTriad[i].TrdType in TriadLineSet)

or (listTriad[i].TrdType = TRD_IF) and (j = 1)

or (listTriad[i].TrdType = TRD_ASSIGN) and (j = 2))

and (listTriad[i][j].OpType = OP_LINK) then

begin

iNum := listTriad[i][j].TriadNum;

if (listTriad[iNum].Info = 0) and (iNum <> i-1) then

begin

iCnt := listReg.Count-1;

for iR:=0 to iCnt do

begin

if longint(listReg[iR]) >= i then

begin

listReg[iR] := TObject(iNum);

listTriad[iNum].Info := iR+1;

Break;

end;

end;

if listTriad[iNum].Info = 0 then

begin

listReg.Add(TObject(iNum));

listTriad[iNum].Info := listReg.Count;

end;

end;

end;

Result := listReg.Count - (NUM_PROCREG-1);

finally listReg.Free;

end;

end;

function GetRegName(iInfo: integer): string;

begin

case iInfo of

0: Result := 'eax';

1: Result := 'ebx';

2: Result := 'ecx';

3: Result := 'edx';

4: Result := 'esi';

5: Result := 'edi';

else Result :=

Format('%s%d',[TEMP_VARNAME,iInfo-NUM_PROCREG]);

end{case};

end;

function GetOpName(i: integer; listTriad: TTriadList;

iOp: integer): string;

var

iNum: integer;

Triad: TTriad;

begin

Triad := listTriad[i];

case Triad[iOp].OpType of

OP_CONST: Result := IntToStr(Triad[iOp].ConstVal);

OP_VAR:

begin

Result := Triad[iOp].VarLink.VarName;

if Result = NAME_FUNCT then Result := NAME_RESULT;

end;

else

begin

iNum := Triad[iOp].TriadNum;

if iNum = i-1 then Result := ''

else

begin

iNum := listTriad[iNum].Info;

if iNum = 0 then Result := ''

else Result := GetRegName(iNum);

end;

end;

end{case};

end;

function MakeMove(const sReg,{имя регистра}

sPrev,{предыдущая команда}

sVal{предыдущая величина в eax}: string;

flagOpt: Boolean{флаг оптимизации}): string;

begin

if (Pos(Format(#9'mov'#9'%s,eax',[sReg]),sPrev) = 1)

or (sVal = sReg) then

begin

Result := '';

Exit;

end;

if flagOpt then

begin

if sReg = '0' then

begin

if sVal = '-1' then

Result := #9'inc'#9'eax'

else

if sVal = '1' then

Result := #9'dec'#9'eax'

else

Result := #9'xor'#9'eax,eax'

end

else

if sReg = '1' then

begin

if sVal = '-1' then

Result := #9'neg'#9'eax'

else

if sVal = '0' then

Result := #9'inc'#9'eax'

else

Result := #9'xor'#9'eax,eax'#13#10#9'inc'#9'eax';

end

else

if sReg = '-1' then

begin

if sVal = '1' then

Result := #9'neg'#9'eax'

else

if sVal = '0' then

Result := #9'dec'#9'eax'

else

Result := #9'xor'#9'eax,eax'#13#10#9'dec'#9'eax';

end

else Result := Format(#9'mov'#9'eax,%s',[sReg]);

end

else Result := Format(#9'mov'#9'eax,%s',[sReg]);

end;

function MakeOpcode(i: integer;{номер текущей триады}

listTriad: TTriadList;{список триад}

const sOp,sReg,{код операции и операнд}

sPrev,{предыдущая команда}

sVal{предыдущая величина в eax}: string;

flagOpt: Boolean{флаг оптимизации}): string;

var Triad: TTriad;{текущая триада}

begin

Triad := listTriad[i];

if flagOpt then

begin

if sReg = '0' then

begin

case Triad.TrdType of

TRD_AND:

Result := MakeMove('0',sPrev,sVal,flagOpt);

TRD_OR,TRD_ADD,TRD_SUB: Result := #9#9;

else Result := Format(#9'%s'#9'eax,%s',[sOp,sReg]);

end{case};

end

else

if sReg = '1' then

begin

case Triad.TrdType of

TRD_OR:

Result := MakeMove('1',sPrev,sVal,flagOpt);

TRD_AND: Result := #9#9;

TRD_ADD: Result := #9'inc'#9'eax';

TRD_SUB: Result := #9'dec'#9'eax';

else Result := Format(#9'%s'#9'eax,%s',[sOp,sReg]);

end{case};

end

else

if sReg = '-1' then

begin

case Triad.TrdType of

TRD_ADD: Result := #9'dec'#9'eax';

TRD_SUB: Result := #9'inc'#9'eax';

else Result := Format(#9'%s'#9'eax,%s',[sOp,sReg]);

end{case};

end

else Result := Format(#9'%s'#9'eax,%s',[sOp,sReg]);

end

else Result := Format(#9'%s'#9'eax,%s',[sOp,sReg]);

Result := Result + Format(#9'{ %s }',

[Triad.MakeString(i)]);

end;

function MakeAsmCode(

listTriad: TTriadList;{входной список триад}

listCode: TStrings;{список строк рез. кода}

flagOpt: Boolean{флаг оптимизации}): integer;

var

i,iCnt: integer;{счетчик и переменная цикла}

sR: string;{строка для имени регистра}

sPrev,sVal: string;

procedure TakePrevAsm;

var j: integer;

begin

j := listCode.Count;

if j > 0 then

begin

sPrev := listCode[j-1];

sVal := StrPas(PChar(listCode.Objects[j-1]));

end

else

begin

sPrev := '';

sVal := '';

end;

end;

procedure MakeOper1(const sOp,{код операции}

sAddOp: string;{код доп. операции}

iOp: integer{номер операнда в триаде});

var sReg{строка для имени регистра}: string;

begin

TakePrevAsm;

sReg := GetOpName(i,listTriad,iOp);

if sReg <> '' then

begin

sReg := MakeMove(sReg,sPrev,sVal,flagOpt);

if sReg <> '' then listCode.Add(sReg);

end;

listCode.Add(Format(#9'%s'#9'eax'#9'{ %s }',

[sOp,listTriad[i].MakeString(i)]));

if sAddOp <> '' then

listCode.Add(Format(#9'%s'#9'eax,1',[sAddOp]));

if listTriad[i].Info <> 0 then

begin

sReg := GetRegName(listTriad[i].Info);

listCode.AddObject(Format(#9'mov'#9'%s,eax',[sReg]),

TObject(PChar(sReg)));

end;

end;

procedure MakeOper2(const sOp,

sAddOp: string{код доп. операции});

var sReg1,sReg2{строки для имен регистров}: string;

begin

TakePrevAsm;

sReg1 := GetOpName(i,listTriad,1);

sReg2 := GetOpName(i,listTriad,2);

if (sReg1 = '') or (sReg1 = sVal) then

listCode.Add(MakeOpCode(i,listTriad,sOp,sReg2,

sPrev,sVal,flagOpt))

else

if (sReg2 = '') or (sReg2 = sVal) then

begin

listCode.Add(MakeOpCode(i,listTriad,sOp,sReg1,

sPrev,sVal,flagOpt));

if sAddOp <> '' then

listCode.Add(Format(#9'%s'#9'eax',[sAddOp]));

end

else

begin

sReg1 := MakeMove(sReg1,sPrev,sVal,flagOpt);

if sReg1 <> '' then listCode.Add(sReg1);

listCode.Add(MakeOpCode(i,listTriad,sOp,sReg2,

sPrev,sVal,flagOpt));

end;

if listTriad[i].Info <> 0 then

begin

sReg1 := GetRegName(listTriad[i].Info);

listCode.AddObject(Format(#9'mov'#9'%s,eax',[sReg1]),

TObject(PChar(sReg1)));

end;

end;

procedure MakeCompare(const sOp: string

var sReg1,sReg2{строки для имен регистров}: string;

begin

TakePrevAsm;

sReg1 := GetOpName(i,listTriad,1);

sReg2 := GetOpName(i,listTriad,2);

if sReg1 = '' then

listCode.Add(Format(#9'cmp'#9'eax,%s'#9'{ %s }',

[sReg2,listTriad[i].MakeString(i)]))

else

if sReg2 = '' then

listCode.Add(Format(#9'cmp'#9'%s,eax'#9'{ %s }',

[sReg1,listTriad[i].MakeString(i)]))

else

begin

sReg1 := MakeMove(sReg1,sPrev,sVal,flagOpt);

if sReg1 <> '' then listCode.Add(sReg1);

listCode.Add(Format(#9'cmp'#9'eax,%s'#9'{ %s }',

[sReg2,listTriad[i].MakeString(i)]));

end;

listCode.Add(Format(#9'set%s'#9'al',[sOp]));

listCode.Add(#9'and'#9'eax,1');

if listTriad[i].Info <> 0 then

begin

sReg1 := GetRegName(listTriad[i].Info);

listCode.AddObject(Format(#9'mov'#9'%s,eax',[sReg1]),

TObject(PChar(sReg1)));

end;

end;

begin

iCnt := listTriad.Count-1;

for i:=0 to iCnt do

begin

if listTriad[i].IsLinked then

listCode.Add(Format('@M%d:',[i+1]));

case listTriad[i].TrdType of

TRD_IF:

begin

if listTriad[i][1].OpType = OP_CONST then

begin

if listTriad[i][1].ConstVal = 0 then

listCode.Add(Format(#9'jmp'#9'@M%d'#9'{ %s }',

[listTriad[i][2].TriadNum+1,

listTriad[i].MakeString(i)]));

end

else

begin

sR := GetOpName(i,listTriad,1);

if sR = '' then

(* listCode.Add(#9'test'#9'eax,eax') *)

else

listCode.Add(Format(#9'cmp'#9'%s,0',[sR]));

listCode.Add(Format(#9'jnz'#9'@F%d'#9'{ %s }',

[i,listTriad[i].MakeString(i)]));

listCode.Add(Format(#9'jmp'#9'@M%d',

[listTriad[i][2].TriadNum+1]));

listCode.Add(Format('@F%d:',[i]));

end;

end;

TRD_OR: MakeOper2('or','');

TRD_XOR: MakeOper2('xor','');

TRD_AND: MakeOper2('and','');

TRD_NOT: MakeOper1('not','and',1);

TRD_LT: MakeCompare('l');

TRD_GT: MakeCompare('g');

TRD_EQ: MakeCompare('e');

TRD_NEQ: MakeCompare('ne');

TRD_ADD: MakeOper2('add','');

TRD_SUB: MakeOper2('sub','neg');

TRD_UMIN: MakeOper1('neg','',2);

TRD_ASSIGN:

begin

TakePrevAsm;

sR := GetOpName(i,listTriad,2);

if sR <> '' then

begin

sVal := MakeMove(sR,sPrev,sVal,flagOpt);

if sVal <> '' then listCode.Add(sVal);

end;

sVal := listTriad[i][1].VarLink.VarName;

if sVal = NAME_FUNCT then sVal := NAME_RESULT;

sVal := Format(#9'mov'#9'%s,eax'#9'{ %s }',

[sVal,listTriad[i].MakeString(i)]);

listCode.AddObject(sVal,TObject(PChar(sR)));

end;

TRD_JMP: listCode.Add(

Format(#9'jmp'#9'@M%d'#9'{ %s }',

[listTriad[i][2].TriadNum+1,

listTriad[i].MakeString(i)]));

TRD_NOP: listCode.Add(Format(#9'nop'#9#9'{ %s }',

[listTriad[i].MakeString(i)]));

end{case};

end{for};

Result := listCode.Count;

end;

end.

Размещено на Allbest.ru