Скачиваний:
12
Добавлен:
01.05.2014
Размер:
8 Кб
Скачать
{
  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 UCcIntOpsTemplate;

interface

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

type
  TCcAbstractBinaryOpsTemplate = class(TCcBinaryOpTemplate)
  public
    class function TemplateInfo: TCcCodeTemplateInfo; override;
  end;


  TCcAbstractBinarySimpleIntOpsTemplate = class(TCcAbstractBinaryOpsTemplate)
  protected
    procedure InternalGenerate(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition;
      ALeftType, ARightType: TObject;
      AOperation: TCcTokenSubType); virtual; abstract;
  public
    procedure Generate(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition;
      ALeftType, ARightType: TObject; AOperation: TCcTokenSubType); override;
  end;


  TCcBinaryAssignIntOpsTemplate = class(TCcAbstractBinaryOpsTemplate)
  public
    class function TemplateInfo: TCcCodeTemplateInfo; override;

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


  TCcBinaryCompareIntOpsTemplate = class(TCcAbstractBinarySimpleIntOpsTemplate)
  protected
    procedure InternalGenerate(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition;
      ALeftType, ARightType: TObject; AOperation: TCcTokenSubType); override;
  public
    class function TemplateInfo: TCcCodeTemplateInfo; override;
  end;


  TCcBinaryIntOpsTemplate = class(TCcAbstractBinarySimpleIntOpsTemplate)
  protected
    procedure InternalGenerate(
      AGenerator: TCcCodeGenerator; APosition: TCcPosition; ALeftType: TObject;
      ARightType: TObject; AOperation: TCcTokenSubType); override;
  public
    class function TemplateInfo: TCcCodeTemplateInfo; override;
  end;


implementation

uses
  UCcCodeGeneratorCommands, UCcSyntaxEntries;


const
  COMPARE_CMDS:
    array[TCcTokenCompareOperators] of TCcCommandType = (
      ctSetL, ctSetG, ctSetE, ctSetLE, ctSetGE, ctSetNE
    );
  BINOP_CMDS:
    array[TCcTokenBinaryOperators] of TCcCommandType  = (
      ctAnd, ctOr, ctXor, ctAnd, ctOr, ctNop, ctNop, ctShl, ctShr,
      ctAdd, ctSub, ctIdiv, ctImul, ctNop
    );


{ TCcAbstractBinaryOpsTemplate }

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


{ TCcBinaryAssignIntOpsTemplate }

procedure TCcBinaryAssignIntOpsTemplate.Generate(
  AGenerator: TCcCodeGenerator; APosition: TCcPosition; ALeftType,
  ARightType: TObject; AOperation: TCcTokenSubType);
const
  ASSIGN_INTOPS:
    array[TCcTokenAssignmentOperators] of TCcCommandType = (
      ctMov, ctImul, ctIdiv, ctNop, ctAdd, ctSub, ctShl, ctShr, ctAnd, ctXor,
      ctOr
    );

var
  re, le: TCcExpression;
begin
  re := (ARightType as TCcExpression);
  le := (ALeftType as TCcExpression);

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

  AGenerator.Gen(ctPop, 'eax').Comment := 'Getting left operand address';
  AGenerator.Gen(ctPop, 'ebx').Comment := 'Getting right operand';
  if (AOperation = tstRemAssign) then begin
    AGenerator.Gen(ctPush, 'eax');
    AGenerator.Gen(ctMov, 'eax', '[eax]');
    AGenerator.Gen(ctCdq);
    AGenerator.Gen(ctIdiv, 'ebx');
    AGenerator.Gen(ctPop, 'eax');
    AGenerator.Gen(ctMov, '[eax]', 'edx');
  end
  else if (AOperation = tstDivAssign) then begin
    AGenerator.Gen(ctPush, 'eax');
    AGenerator.Gen(ctMov, 'eax', '[eax]');
    AGenerator.Gen(ctIdiv, 'ebx');
    AGenerator.Gen(ctPop, 'ebx');
    AGenerator.Gen(ctMov, '[ebx]', 'eax');
  end
  else
    AGenerator.Gen(ASSIGN_INTOPS[AOperation], '[eax]', 'ebx');
  AGenerator.Gen(ctMov, 'eax', '[eax]').Comment := 'Saving reault of calculation in EAX';
  AGenerator.Gen(ctPush, 'eax').Comment := 'Storing EAX';
end;


class function TCcBinaryAssignIntOpsTemplate.TemplateInfo: TCcCodeTemplateInfo;
begin
  Result := inherited TemplateInfo;
  Result.Operations := [tstAssignment..tstOrAssign];
end;


{ TCcAbstractBinarySimpleIntOpsTemplate }

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

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

  AGenerator.Gen(ctPop, 'eax').Comment := 'Left operand value';
  AGenerator.Gen(ctPop, 'ebx').Comment := 'Right operand value';

  InternalGenerate(AGenerator, APosition, ALeftType, ARightType, AOperation);

  AGenerator.Gen(ctPush, 'eax').Comment := 'Storing result';
end;


{ TCcBinaryCompareIntOpsTemplate }

procedure TCcBinaryCompareIntOpsTemplate.InternalGenerate(
  AGenerator: TCcCodeGenerator; APosition: TCcPosition;
  ALeftType, ARightType: TObject; AOperation: TCcTokenSubType);
begin
  inherited;
  AGenerator.Gen(ctPush, 'ebx');
  AGenerator.Gen(ctXor, 'ebx', 'ebx');
  AGenerator.Gen(ctCmp, 'eax', 'dword ptr [esp]');
  AGenerator.Gen(COMPARE_CMDS[AOperation], 'bl');
  AGenerator.Gen(ctMov, 'eax', 'ebx');
  AGenerator.Gen(ctAdd, 'esp', '4');
end;


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


{ TCcBinaryIntOpsTemplate }

procedure TCcBinaryIntOpsTemplate.InternalGenerate(
  AGenerator: TCcCodeGenerator; APosition: TCcPosition;
  ALeftType, ARightType: TObject; AOperation: TCcTokenSubType);
begin
  // Left  -  eax
  // Right  -  ebx
  case AOperation of
    tstRemainder:
      begin
        AGenerator.Gen(ctCdq);
        AGenerator.Gen(ctIdiv, 'ebx');
        AGenerator.Gen(ctMov, 'eax', 'edx');
      end;
    tstShr, tstShl:
      begin
        AGenerator.Gen(ctMov, 'ecx', 'ebx');
        AGenerator.Gen(BINOP_CMDS[AOperation], 'eax', 'cl');
      end;
    tstDiv:
      begin
        AGenerator.Gen(ctXor, 'edx', 'edx');
        AGenerator.Gen(ctIdiv, 'ebx');
      end;
    else
      AGenerator.Gen(BINOP_CMDS[AOperation], 'eax', 'ebx');
  end;
end;


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


initialization
  TemplateManager.RegisterTemplate(TCcBinaryAssignIntOpsTemplate.Create);
  TemplateManager.RegisterTemplate(TCcBinaryCompareIntOpsTemplate.Create);
  TemplateManager.RegisterTemplate(TCcBinaryIntOpsTemplate.Create);

end.
Соседние файлы в папке CodeGenerator