D16Pascal/CaseState.pas at master · Memnarch/D16Pascal · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
unit CaseState;

interface

uses
  Classes, Types, Generics.Collections, CodeElement, WriterIntf;

type
  TCaseStatement = class(TCodeElement)
  private
    FCases: TObjectList<TCodeElement>;
    FRelation: TObjectList<TCodeElement>;
    FElseCase: TObjectList<TCodeElement>;
    FId: string;
    procedure GetJumpTable(AWriter: IWriter);
  public
    constructor Create(); reintroduce;
    destructor Destroy(); override;
    procedure GetDCPUSource(AWriter: IWriter); override;
    property Relation: TObjectList<TCodeElement> read FRelation;
    property Cases: TObjectList<TCodeElement> read FCases;
    property ElseCase: TObjectList<TCodeElement> read FElseCase;
  end;

  TCase = class(TCodeElement)
  private
    FConstValues: TObjectList<TCodeElement>;
  public
    constructor Create(); reintroduce;
    destructor Destroy(); override;
    property ConstValues: TObjectList<TCodeElement> read FConstValues;
  end;

implementation

uses
  SysUtils, Factor, Optimizer;

{ TCaseStatement }

constructor TCaseStatement.Create;
begin
  inherited Create('');
  FRelation := TObjectList<TCodeElement>.Create();
  FCases := TObjectList<TCodeElement>.Create();
  FElseCase := TObjectList<TCodeElement>.Create();
  FId := GetUniqueID();
end;

destructor TCaseStatement.Destroy;
begin
  FRelation.Free;
  FCases.Free;
  FElseCase.Free;
  inherited;
end;

procedure TCaseStatement.GetDCPUSource;
var
  i: Integer;
begin
  AWriter.AddMapping(Self);
  Relation.Items[0].GetDCPUSource(Self);
  OptimizeDCPUCode(Self.FSource, Self.FSource);
  AWriter.WriteList(Self.FSource);
  AWriter.Write('set x, pop');
  GetJumpTable(AWriter);
  for i := 0 to Cases.Count - 1 do
  begin
    AWriter.Write(':case' + IntToStr(i) + FId);
    Cases.Items[i].GetDCPUSource(AWriter);
    AWriter.Write('set pc, ' + 'end' + FId);
  end;
  if ElseCase.Count > 0 then
  begin
    AWriter.Write(':else' + FId);
    ElseCase.Items[0].GetDCPUSource(AWriter);
  end;
  AWriter.Write(':end' + FId);
end;

procedure TCaseStatement.GetJumpTable;
var
  LCase: TCase;
  LFactor: TFactor;
  i, k: Integer;
  LJumpLabel: string;
begin
  for i := 0 to FCases.Count - 1 do
  begin
    LJumpLabel := 'case' + IntToStr(i) + FId;
    LCase := TCase(FCases.Items[i]);
    for k := 0 to LCase.ConstValues.Count - 1 do
    begin
      LFactor := TFactor(LCase.ConstValues.Items[k]);
      if LFactor.IsConstant then
      begin
        AWriter.Write('ife x, ' + LFactor.Value);
      end
      else
      begin
        AWriter.Write('ife x, ' + LFactor.VarDeclaration.DefaultValue);
      end;
      AWriter.Write('set pc, ' + LJumpLabel);
    end;
  end;
  if ElseCase.Count > 0 then
  begin
    AWriter.Write('set pc, ' + 'else' + FId);
  end
  else
  begin
    AWriter.Write('set pc, ' + 'end' + FId);
  end;
end;

{ TCase }

constructor TCase.Create;
begin
  inherited Create('');
  FConstValues := TObjectList<TCodeElement>.Create();
end;

destructor TCase.Destroy;
begin
  FConstValues.Free;
  inherited;
end;

end.