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