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

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

interface

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


type
  TCcAbstractBinaryFlOpsTemplate = class(TCcBinaryOpTemplate)
  protected
    procedure LoadOperand(
      AGenerator: TCcCodeGenerator; AExpr: TObject);
  public
    class function TemplateInfo: TCcCodeTemplateInfo; override;
  end;


  TCcBinaryAssignFlOpsTemplate = class(TCcAbstractBinaryFlOpsTemplate)
  public
    class function TemplateInfo: TCcCodeTemplateInfo; override;

    procedure Generate(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition;
      ALeftType, ARightType: TObject; AOperation: TCcTokenSubType); override;
  end;


  TCcBinaryCompareFlOpsTemplate = class(TCcAbstractBinaryFlOpsTemplate)
  public
    class function TemplateInfo: TCcCodeTemplateInfo; override;

    procedure Generate(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition;
      ALeftType, ARightType: TObject; AOperation: TCcTokenSubType); override;
  end;


  TCcBinaryFlOpsTemplate = class(TCcAbstractBinaryFlOpsTemplate)
  public
    class function TemplateInfo: TCcCodeTemplateInfo; override;

    procedure Generate(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition;
      ALeftType, ARightType: TObject; AOperation: TCcTokenSubType); override;
  end;


implementation

uses
  UCcCodeGeneratorCommands, UCcSyntaxEntries;

const
  COMPARE_CMDS:
    array[TCcTokenCompareOperators] of TCcCommandType = (
      ctSetB, ctSetA, ctSetE, ctSetBE, ctSetAE, ctSetNE
    );


{ TCcAbstractBinaryFlOpsTemplate }

procedure TCcAbstractBinaryFlOpsTemplate.LoadOperand(
  AGenerator: TCcCodeGenerator; AExpr: TObject);
var
  re: TCcExpression;
begin
  re := AExpr as TCcExpression;
  re.Generate(AGenerator);
  if (re.ResultType = etIntegral) then
    AGenerator.Gen(ctFild, 'dword ptr [esp]')
  else
    AGenerator.Gen(ctFld, 'dword ptr [esp]');
  AGenerator.Gen(ctPop, 'eax');
end;


class function TCcAbstractBinaryFlOpsTemplate.TemplateInfo: TCcCodeTemplateInfo;
begin
  FillChar(Result.AllowedArgs, sizeof(Result.AllowedArgs), true);
  Result.AllowedArgs[etIntegral, etIntegral] := false;
end;


{ TCcBinaryAssignFlOpsTemplate }

procedure TCcBinaryAssignFlOpsTemplate.Generate(
  AGenerator: TCcCodeGenerator; APosition: TCcPosition; ALeftType,
  ARightType: TObject; AOperation: TCcTokenSubType);
const
  ASSIGN_FLOPS:
    array[
      tstMulAssign..tstMinusAssign, TCcExpressionType
    ] of TCcCommandType = (
      (ctNop, ctFimul, ctFmul), (ctNop, ctFidiv, ctFdiv),
      (ctNop, ctNop, ctNop), (ctNop, ctFiadd, ctFadd),
      (ctNop, ctFisub, ctFsub)
    );
var
  re, le: TCcExpression;
begin
  re := (ARightType as TCcExpression);
  le := (ALeftType as TCcExpression);

  if AOperation <> tstAssignment then begin
    re.Generate(AGenerator);
    le.GenerateLValue(AGenerator);
    AGenerator.Gen(ctPop, 'eax');
    AGenerator.Gen(ctPush, 'dword ptr [eax]');
    if (le.ResultType = etIntegral) then
      AGenerator.Gen(ctFild, 'dword ptr [esp]')
    else
      AGenerator.Gen(ctFld, 'dword ptr [esp]');
    AGenerator.Gen(ctAdd, 'esp', '4');

    AGenerator.Gen(ctPop, 'ebx');

    AGenerator.Gen(ctPush, 'eax');
    AGenerator.Gen(ctPush, 'ebx');
    AGenerator.Gen(
      ASSIGN_FLOPS[AOperation, re.ResultType], 'dword ptr [esp]');
    AGenerator.Gen(ctPop, 'ebx');
  end
  else begin
    LoadOperand(AGenerator, ARightType);
    le.GenerateLValue(AGenerator);
  end;

  AGenerator.Gen(ctPush, 'eax');
  if le.ResultType = etIntegral then
    AGenerator.Gen(ctFistp, 'dword ptr [esp]')
  else
    AGenerator.Gen(ctFstp, 'dword ptr [esp]');
  AGenerator.Gen(ctPop, 'eax');
  AGenerator.Gen(ctPop, 'ebx');
  AGenerator.Gen(ctMov, 'dword ptr [ebx]', 'eax');
  AGenerator.Gen(ctPush, 'eax');
end;


class function TCcBinaryAssignFlOpsTemplate.TemplateInfo: TCcCodeTemplateInfo;
begin
  Result := inherited TemplateInfo;
  Result.Operations := [
    tstAssignment, tstPlusAssign, tstMinusAssign, tstMulAssign, tstDivAssign];
end;


{ TCcBinaryFlOpsTemplate }

procedure TCcBinaryFlOpsTemplate.Generate(
  AGenerator: TCcCodeGenerator; APosition: TCcPosition;
  ALeftType, ARightType: TObject; AOperation: TCcTokenSubType);
const
  BIN_FLOPS:
    array[
      tstPlus..tstMul, TCcExpressionType
    ] of TCcCommandType = (
      (ctNop, ctFiadd, ctFadd), (ctNop, ctFisub, ctFsub),
      (ctNop, ctFidiv, ctFdiv), (ctNop, ctFimul, ctFmul)
    );
var
  re, le: TCcExpression;
begin
  re := (ARightType as TCcExpression);
  le := (ALeftType as TCcExpression);

  re.Generate(AGenerator);
  le.Generate(AGenerator);

  PrepareFPUArgs(AGenerator, le.ResultType, re.ResultType);
  AGenerator.Gen(BIN_FLOPS[AOperation, re.ResultType], 'dword ptr [esp]');
  AGenerator.Gen(ctPop, 'eax');
  FinishFPUOperation(AGenerator);
end;


class function TCcBinaryFlOpsTemplate.TemplateInfo: TCcCodeTemplateInfo;
begin
  Result := inherited TemplateInfo;
  Result.Operations := [tstPlus..tstMul];
end;


{ TCcBinaryCompareFlOpsTemplate }

procedure TCcBinaryCompareFlOpsTemplate.Generate(
  AGenerator: TCcCodeGenerator; APosition: TCcPosition;
  ALeftType, ARightType: TObject; AOperation: TCcTokenSubType);
var
  re, le: TCcExpression;
begin
  re := (ARightType as TCcExpression);
  le := (ALeftType as TCcExpression);

  LoadOperand(AGenerator, ARightType);
  le.Generate(AGenerator);

  PrepareFPUArgs(AGenerator, le.ResultType, re.ResultType);
  AGenerator.Gen(ctXor, 'eax', 'eax');
  AGenerator.Gen(ctFcomi, 'ST(0)', 'ST(1)');

  AGenerator.Gen(COMPARE_CMDS[AOperation], 'al');

  AGenerator.Gen(ctSub, 'esp', '4').Comment := 'To store junk after comparsion';
  AGenerator.Gen(ctFstp, 'dword ptr [esp]');
  AGenerator.Gen(ctFstp, 'dword ptr [esp]');
  AGenerator.Gen(ctAdd, 'esp', '4');

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


class function TCcBinaryCompareFlOpsTemplate.TemplateInfo: TCcCodeTemplateInfo;
begin
  Result := inherited TemplateInfo;
  Result.Operations := [
    Low(TCcTokenCompareOperators)..High(TCcTokenCompareOperators)];
end;


initialization
  TemplateManager.RegisterTemplate(TCcBinaryAssignFlOpsTemplate.Create);
  TemplateManager.RegisterTemplate(TCcBinaryFlOpsTemplate.Create);
  TemplateManager.RegisterTemplate(TCcBinaryCompareFlOpsTemplate.Create);


end.