Курсовая работа1 / CodeGenerator / UCcCodeGenerator

{
C-like language compiler v0.1.0.485

12 november 2007

Copyright (C) 2006, 2007 Igor Krooshch
rheo.ikro@gmail.com

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
}

unit UCcCodeGenerator;

{$DEFINE CC_OPTIMIZE}

interface

uses
SysUtils, Classes,
UCcLabelStack, UCcCodeGeneratorCommands;

type
TCcMasmDirs = record
Bin: string;
Lib: string;
Include: string;
end;

TCcCodeGeneratorState = (cgsSimple, cgsProcedure);

TCcCodeGenerator = class
private
FMasmDirs: TCcMasmDirs;
FUseFPU: boolean;
FState: TCcCodeGeneratorState;
FList: TList;
FGlobalList: TList;
FProcedures: TList;

FCurrentStrConst: integer;

FFuncReturnLabel: string;

FCurrentProc: string;

FLabels: array[TCcLabelType] of integer;
FLists: array[TCcCodeGeneratorState] of TList;

FLabelStack: TCcLabelStack;

procedure Optimize;

procedure CheckFPUUse(ACommand: TCcCommandType);
private
procedure LoadExeStub(AList: TStringList);
procedure CreateBuildBat(const ADir, AFileName: string);

procedure LoadMasmSettings;
public
constructor Create;
destructor Destroy; override;

function GenerateStrConst: string;

procedure InitControlBlock(ABreak, AContinue: TCcLabel);
procedure GenBreak;
procedure GenContinue;
procedure FinishControlBlock;

function Gen(
ACommand: TCcCommandType; const AOperand: string): TCcCommand; overload;
function Gen(
ACommand: TCcCommandType;
const ALeft, ARight: string): TCcCommand; overload;
function Gen(ACommand: TCcCommandType): TCcCommand; overload;
function Gen(AText: string; AGlobal: boolean): TCcCommand; overload;
function Gen(AText: string): TCcCommand; overload;

procedure OutputLabel(ALabel: string; const AComment: string = '');

function GenerateLabel(
ALabelType: TCcLabelType; const AOutput: boolean = true;
const AComment: string = ''): string;

procedure StartProc(const AProcName: string; ASymTable: TObject);
procedure EndProc;

procedure WriteOutput(
const AFileName: string; const AOptimize: boolean = true);

property CurrentReturnLabel: string read FFuncReturnLabel;
end;

function FormatVarName(const AVarName: string): string;
function FormatProcName(const AProcName: string): string;

implementation

uses
StrUtils, Types, IniFiles,
UCcSymbols;


function FormatVarName(const AVarName: string): string;
begin
Result := Format('v_%s', [AVarName]);
end;


function FormatProcName(const AProcName: string): string;
begin
Result := Format('p_%s', [AProcName]);
end;


{ TCcCodeGenerator }

constructor TCcCodeGenerator.Create;
begin
FUseFPU := false;
FLabelStack := TCcLabelStack.Create;
FList := TList.Create;
FGlobalList := TList.Create;
FProcedures := TList.Create;

FLists[cgsSimple] := FList;
FLists[cgsProcedure] := FProcedures;

FState := cgsSimple;

FillChar(FLabels, SizeOf(FLabels), 0);

FCurrentProc := '';
FCurrentStrConst := 0;

LoadMasmSettings;
end;


destructor TCcCodeGenerator.Destroy;

procedure destroyList(AList: TList);
var
i: integer;
begin
for i := 0 to AList.Count - 1 do
TCcCommand(AList[i]).Free;
AList.Free;
end;

begin
destroyList(FProcedures);
destroyList(FGlobalList);
destroyList(FList);
FLabelStack.Free;
inherited;
end;


procedure TCcCodeGenerator.EndProc;
begin
OutputLabel(FFuncReturnLabel);
Gen(ctMov, 'esp', 'ebp');
Gen(ctPop, 'ebp');
Gen(ctRet);
Gen(Format('%s endp', [FCurrentProc]));
Gen('');
end;


function TCcCodeGenerator.Gen(
AText: string; AGlobal: boolean): TCcCommand;
begin
Result := TCcVarDeclaration.Create(AText, AGlobal);
if AGlobal then
FGlobalList.Add(Result)
else
FList.Add(Result);
end;


function TCcCodeGenerator.Gen(
ACommand: TCcCommandType; const AOperand: string): TCcCommand;
begin
CheckFPUUse(ACommand);
Result := TCcOneOperandCommand.Create(ACommand, AOperand);
FLists[FState].Add(Result);
end;


function TCcCodeGenerator.Gen(
ACommand: TCcCommandType;
const ALeft, ARight: string): TCcCommand;
begin
CheckFPUUse(ACommand);
Result := TCcTwoOperandsCommand.Create(ACommand, ALeft, ARight);
FLists[FState].Add(Result);
end;


function TCcCodeGenerator.Gen(ACommand: TCcCommandType): TCcCommand;
begin
Result := TCcCommand.Create(ACommand);
FLists[FState].Add(Result);
end;


procedure TCcCodeGenerator.FinishControlBlock;
begin
FLabelStack.Pop;
end;


function TCcCodeGenerator.Gen(AText: string): TCcCommand;
begin
Result := TCcHeader.Create(AText);
FLists[FState].Add(Result);
end;


procedure TCcCodeGenerator.GenBreak;
begin
Gen(ctJmp, FLabelStack.Get(lsitBreak), 'Break');
end;


procedure TCcCodeGenerator.GenContinue;
begin
Gen(ctJmp, FLabelStack.Get(lsitContinue), 'Continue');
end;


function TCcCodeGenerator.GenerateLabel(
ALabelType: TCcLabelType; const AOutput: boolean;
const AComment: string): string;
const
LABEL_PREFIX: array[TCcLabelType] of string = (
'Func', 'If', 'While', 'For', 'DoWhile');
begin
Inc(FLabels[ALabelType]);
Result := Format('_lbl%s%d', [LABEL_PREFIX[ALabelType], FLabels[ALabelType]]);
if AOutput then
OutputLabel(Result, AComment);
end;


procedure TCcCodeGenerator.InitControlBlock(ABreak, AContinue: TCcLabel);
begin
FLabelStack.Push(ABreak, AContinue);
end;


procedure TCcCodeGenerator.OutputLabel(ALabel: string; const AComment: string);
begin
Gen(Format('%s:', [ALabel])).Comment := AComment;
end;


procedure TCcCodeGenerator.StartProc(
const AProcName: string; ASymTable: TObject);
begin
FCurrentProc := FormatProcName(AProcName);
FState := cgsProcedure;
FFuncReturnLabel := GenerateLabel(ltFunc, false);
Gen(Format('%s proc', [FCurrentProc]));
Gen(ctPush, 'ebp');
Gen(ctMov, 'ebp', 'esp');
end;


procedure TCcCodeGenerator.WriteOutput(
const AFileName: string; const AOptimize: boolean);
const
FPU_INIT: array[boolean] of string = ('', 'Finit');

var
f, f2: TStringList;
i: integer;
d: string;
begin
f := nil;
try
f2 := TStringList.Create;
LoadExeStub(f2);
d := ExtractFilePath(AFileName);
if (d = '') then
d := ExtractFilePath(ParamStr(0));
CreateBuildBat(d, AFileName);

f := TStringList.Create;
for i := 0 to FGlobalList.Count - 1 do
TCcCommand(FGlobalList[i]).WriteOutput(f);
f2.Text := AnsiReplaceStr(f2.Text, '{$GLOBAL_DATA$}', f.Text);

f.Clear;
if AOptimize then begin
writeln('Optimization...');
Optimize;
end;

for i := 0 to FProcedures.Count - 1 do
TCcCommand(FProcedures[i]).WriteOutput(f);
f2.Text := AnsiReplaceStr(f2.Text, '{$PROCEDURES$}', f.Text);
f2.Text := AnsiReplaceStr(f2.Text, '{$FPU_INIT$}', FPU_INIT[FUseFPU]);

f2.Text := AnsiReplaceStr(f2.Text, '{$LIB$}', FMasmDirs.Lib);
f2.Text := AnsiReplaceStr(f2.Text, '{$INCLUDE$}', FMasmDirs.Include);

writeln('Writting output code...');
f2.SaveToFile(AFileName);
finally
f.Free;
end;
end;


procedure TCcCodeGenerator.Optimize;
begin
// Тут был кусок кода вызова оптимизатора :)
end;


procedure TCcCodeGenerator.LoadExeStub(AList: TStringList);
var
rs: TResourceStream;
begin
rs := nil;
try
rs := TResourceStream.Create(hInstance, 'EXESTUB', RT_RCDATA);
AList.LoadFromStream(rs);
finally
FreeAndNil(rs);
end;
end;


procedure TCcCodeGenerator.LoadMasmSettings;

function correctPath(const AStr: string): string;
begin
Result := AStr;
if Result[Length(Result)] = '\' then
Delete(Result, Length(Result), 1);
end;

var
ini: TIniFile;
begin
ini := nil;
try
ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'cc.config');
FMasmDirs.Bin := correctPath(ini.ReadString('Masm', 'Bin', '\masm\bin'));
FMasmDirs.Lib := correctPath(ini.ReadString('Masm', 'Lib', '\masm\lib'));
FMasmDirs.Include :=
correctPath(ini.ReadString('Masm', 'Include', '\masm\include'));
finally
FreeAndNil(ini);
end;
end;


procedure TCcCodeGenerator.CreateBuildBat(const ADir, AFileName: string);
var
s: TStringList;
begin
s := nil;
try
s := TStringList.Create;
s.Add(
Format(
'%s\ml /c /coff /Cp /nologo /Fm /Zi /Zd ' + AFileName, [FMasmDirs.Bin]
)
);

s.Add(
Format(
'%s\link /SUBSYSTEM:CONSOLE /DEBUG /VERSION:4.0 /LIBPATH:%s ' +
ChangeFileExt(AFileName, '.obj'), [FMasmDirs.Bin, FMasmDirs.Lib]
)
);
s.SaveToFile(
ADir + ChangeFileExt(ExtractFileName(AFileName), '.build.bat'));
finally
s.Free;
end;
end;


function TCcCodeGenerator.GenerateStrConst: string;
begin
Inc(FCurrentStrConst);
Result := Format('sc_%d', [FCurrentStrConst]);
end;


procedure TCcCodeGenerator.CheckFPUUse(ACommand: TCcCommandType);
begin
if (not FUseFPU) and (ACommand in [ctFld..ctFcomi]) then
FUseFPU := true;
end;


end.