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

{
  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 UCcCodeTemplate;

interface

{
  Code Templates
  --------------
    Этот набор классов предназначен для облегчения генерации кода, в частности -
  для генерации кода бинарных операция. Предполагается, что после выполнения
  проведуры генерации в верщине стека будет лежать результат операции
}

uses
  SysUtils, Classes,
  UCcCodeGenerator, UCcParser, UCcTokenizer,
  UCcSyntaxEntriesTypes, UCcBuffer;

type
  TCcCodeTemplateArgs = set of TCcExpressionType;

  TCcCodeTemplate = class;

  TCcCodeTemplateManager = class
  private
    FList: TList;
    procedure UnregisterTemplates;
  public
    constructor Create;
    destructor Destroy; override;

    function Generate(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition;
      ALeft, ARight: TObject; AOperation: TCcTokenSubType): boolean;

    procedure GenerateWithException(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition;
      ALeft, ARight: TObject; AOperation: TCcTokenSubType);

    procedure RegisterTemplate(ATemplate: TCcCodeTemplate);
  end;


  TCcCodeTemplateInfo = record
    Operations: TCcTokenSubTypes;
    // AllowedArgs[Left, Right]
    AllowedArgs: array[etIntegral..etFloat, etIntegral..etFloat] of boolean;
  end;


  TCcCodeTemplate = class
  public
    class function TemplateInfo: TCcCodeTemplateInfo; virtual; abstract;
  end;


  TCcBinaryOpTemplate = class(TCcCodeTemplate)
  protected
    procedure PrepareFPUArgs(
      AGenerator: TCcCodeGenerator;
      ALeftType, ARightType: TCcExpressionType;
      const ALeftIsLValue: boolean = false); virtual;
    procedure FinishFPUOperation(
      AGenerator: TCcCodeGenerator;
      const ALeftIsLValue: boolean = false;
      const AIntOutput: boolean = false); virtual;
  public
    procedure Generate(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition;
      ALeftType, ARightType: TObject;
      AOperation: TCcTokenSubType); virtual; abstract;
  end;


  function TemplateManager: TCcCodeTemplateManager;


implementation

uses
  UCcCodeGeneratorCommands, UCcSyntaxEntries, UCcSymanticConsts;


var
  _templateManager: TCcCodeTemplateManager = nil;


function TemplateManager: TCcCodeTemplateManager;
begin
  if _templateManager = nil then
    _templateManager := TCcCodeTemplateManager.Create;
  Result := _templateManager;
end;


{ TCcCodeTemplateManager }

constructor TCcCodeTemplateManager.Create;
begin
  FList := TList.Create;
end;


destructor TCcCodeTemplateManager.Destroy;
begin
  UnregisterTemplates;
  FreeAndNil(FList);
  inherited;
end;


function TCcCodeTemplateManager.Generate(
  AGenerator: TCcCodeGenerator; APosition: TCcPosition;
  ALeft, ARight: TObject; AOperation: TCcTokenSubType): boolean;
var
  l, r: TCcExpression;
  i: integer;
  ct: TCcBinaryOpTemplate;
  found: boolean;
begin
  l := ALeft as TCcExpression;
  r := ARight as TCcExpression;
  found := false;
  for i := 0 to FList.Count - 1 do begin
    ct := TCcBinaryOpTemplate(FList[i]);
    if
      (AOperation in ct.TemplateInfo.Operations) and
      (ct.TemplateInfo.AllowedArgs[l.ResultType][r.ResultType])
    then begin
      found := true;
      ct.Generate(AGenerator, APosition, ALeft, ARight, AOperation);
      Break;
    end;
  end;
  Result := found;
end;


procedure TCcCodeTemplateManager.GenerateWithException(
  AGenerator: TCcCodeGenerator; APosition: TCcPosition; ALeft, ARight: TObject;
  AOperation: TCcTokenSubType);
begin
  if not Generate(AGenerator, APosition, ALeft, ARight, AOperation) then
    SymanticError(APosition, SCcSymanticUnsupportedOperation);
end;


procedure TCcCodeTemplateManager.RegisterTemplate(ATemplate: TCcCodeTemplate);
begin
  FList.Add(ATemplate);
end;


procedure TCcCodeTemplateManager.UnregisterTemplates;
var
  i: integer;
begin
  for i := 0 to FList.Count - 1 do
    TObject(FList[i]).Free;
  FList.Clear;
end;


{ TCcBinaryOpTemplate }

procedure TCcBinaryOpTemplate.FinishFPUOperation(
  AGenerator: TCcCodeGenerator; const ALeftIsLValue: boolean;
  const AIntOutput: boolean);
begin
  if ALeftIsLValue then
    AGenerator.Gen(ctPop, 'ecx');
  AGenerator.Gen(ctPush, 'eax');
  if AIntOutput then
    AGenerator.Gen(ctFistp, 'dword ptr [esp]')
  else
    AGenerator.Gen(ctFstp, 'dword ptr [esp]');
  AGenerator.Gen(ctMov, 'eax', 'dword ptr [esp]');
  if ALeftIsLValue then
    AGenerator.Gen(ctMov, '[ecx]', 'eax');

  AGenerator.Gen(ctPop, 'ecx');
  AGenerator.Gen(ctPush, 'eax');      
end;


procedure TCcBinaryOpTemplate.PrepareFPUArgs(
  AGenerator: TCcCodeGenerator; ALeftType, ARightType: TCcExpressionType;
  const ALeftIsLValue: boolean);
var
  ct: TCcCommandType;
begin
  if ALeftIsLValue then begin
    AGenerator.Gen(ctPop, 'ecx');  // левый
    AGenerator.Gen(ctPush, 'dword ptr [ecx]')
  end;

  if ALeftType = etIntegral then
    ct := ctFild
  else
    ct := ctFld;

  AGenerator.Gen(ct, 'dword ptr [esp]');
  AGenerator.Gen(ctPop, 'eax');
end;


initialization

finalization
  FreeAndNil(_templateManager);


end.