Курсовая работа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.