1--  Mcode back-end for ortho - Optimization.
2--  Copyright (C) 2006 Tristan Gingold
3--
4--  This program is free software: you can redistribute it and/or modify
5--  it under the terms of the GNU General Public License as published by
6--  the Free Software Foundation, either version 2 of the License, or
7--  (at your option) any later version.
8--
9--  This program is distributed in the hope that it will be useful,
10--  but WITHOUT ANY WARRANTY; without even the implied warranty of
11--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12--  GNU General Public License for more details.
13--
14--  You should have received a copy of the GNU General Public License
15--  along with this program.  If not, see <gnu.org/licenses>.
16with Ortho_Code.Flags;
17
18package body Ortho_Code.Opts is
19   procedure Relabel_Jump (Jmp : O_Enode)
20   is
21      Label : O_Enode;
22      Bb : O_Enode;
23   begin
24      Label := Get_Jump_Label (Jmp);
25      if Get_Expr_Kind (Label) = OE_Label then
26         Bb := O_Enode (Get_Label_Info (Label));
27         if Bb /= O_Enode_Null then
28            Set_Jump_Label (Jmp, Bb);
29         end if;
30      end if;
31   end Relabel_Jump;
32
33   procedure Jmp_To_Bb (Subprg : Subprogram_Data_Acc)
34   is
35      First : O_Enode;
36      Stmt : O_Enode;
37      Prev : O_Enode;
38      Cur_Bb : O_Enode;
39   begin
40      --  Get first statement after entry.
41      First := Get_Stmt_Link (Subprg.E_Entry);
42
43      --  First loop:
44      --  If a label belongs to a BB (ie, is at the beginning of a BB),
45      --  then link it to the BB.
46      Stmt := First;
47      Cur_Bb := O_Enode_Null;
48      loop
49         case Get_Expr_Kind (Stmt) is
50            when OE_Leave =>
51               exit;
52            when OE_BB =>
53               Cur_Bb := Stmt;
54            when OE_Label =>
55               if Cur_Bb /= O_Enode_Null then
56                  Set_Label_Info (Stmt, Int32 (Cur_Bb));
57               end if;
58            when OE_Jump
59              | OE_Jump_T
60              | OE_Jump_F =>
61               --  This handles backward jump.
62               Relabel_Jump (Stmt);
63            when others =>
64               Cur_Bb := O_Enode_Null;
65         end case;
66         Stmt := Get_Stmt_Link (Stmt);
67      end loop;
68
69      --  Second loop:
70      --  Transform jump to label to jump to BB.
71      Stmt := First;
72      Prev := O_Enode_Null;
73      loop
74         case Get_Expr_Kind (Stmt) is
75            when OE_Leave =>
76               exit;
77            when OE_Jump
78              | OE_Jump_T
79              | OE_Jump_F =>
80               --  This handles forward jump.
81               Relabel_Jump (Stmt);
82               --  Update PREV.
83               Prev := Stmt;
84            when OE_Label =>
85               --  Remove the Label.
86               --  Do not update PREV.
87               if Get_Label_Info (Stmt) /= 0 then
88                  Set_Stmt_Link (Prev, Get_Stmt_Link (Stmt));
89               end if;
90            when others =>
91               Prev := Stmt;
92         end case;
93         Stmt := Get_Stmt_Link (Stmt);
94      end loop;
95   end Jmp_To_Bb;
96
97   type Oe_Kind_Bool_Array is array (OE_Kind) of Boolean;
98   Is_Passive_Stmt : constant Oe_Kind_Bool_Array :=
99     (OE_Label | OE_BB | OE_End | OE_Beg => True,
100      others => False);
101
102   --  Return the next statement after STMT which really execute instructions.
103   function Get_Fall_Stmt (Stmt : O_Enode) return O_Enode
104   is
105      Res : O_Enode;
106   begin
107      Res := Stmt;
108      loop
109         Res := Get_Stmt_Link (Res);
110         case Get_Expr_Kind (Res) is
111            when OE_Label
112              | OE_BB
113              | OE_End
114              | OE_Beg =>
115               null;
116            when others =>
117               return Res;
118         end case;
119      end loop;
120   end Get_Fall_Stmt;
121   pragma Unreferenced (Get_Fall_Stmt);
122
123   procedure Thread_Jump (Subprg : Subprogram_Data_Acc)
124   is
125      First : O_Enode;
126      Stmt : O_Enode;
127      Prev, Next : O_Enode;
128      Kind : OE_Kind;
129   begin
130      --  Get first statement after entry.
131      First := Get_Stmt_Link (Subprg.E_Entry);
132
133      --  First loop:
134      --  If a label belongs to a BB (ie, is at the beginning of a BB),
135      --  then link it to the BB.
136      Stmt := First;
137      Prev := O_Enode_Null;
138      loop
139         Next := Get_Stmt_Link (Stmt);
140         Kind := Get_Expr_Kind (Stmt);
141         case Kind is
142            when OE_Leave =>
143               exit;
144            when OE_Jump =>
145               --  Remove the jump if followed by the label.
146               --    * For _T/_F: should convert to a ignore value.
147               --  Discard unreachable statements after the jump.
148               declare
149                  N_Stmt : O_Enode;
150                  P_Stmt : O_Enode;
151                  Label : O_Enode;
152                  Flag_Discard : Boolean;
153                  K_Stmt : OE_Kind;
154               begin
155                  N_Stmt := Next;
156                  P_Stmt := Stmt;
157                  Label := Get_Jump_Label (Stmt);
158                  Flag_Discard := True;
159                  loop
160                     if N_Stmt = Label then
161                        --  Remove STMT.
162                        Set_Stmt_Link (Prev, Next);
163                        exit;
164                     end if;
165                     K_Stmt := Get_Expr_Kind (N_Stmt);
166                     if K_Stmt = OE_Label then
167                        --  Do not discard anymore statements, since they are
168                        --  now reachable.
169                        Flag_Discard := False;
170                     end if;
171                     if not Is_Passive_Stmt (K_Stmt) then
172                        if not Flag_Discard then
173                           --  We have found the next statement.
174                           --  Keep the jump.
175                           Prev := Stmt;
176                           exit;
177                        else
178                           --  Delete insn.
179                           N_Stmt := Get_Stmt_Link (N_Stmt);
180                           Set_Stmt_Link (P_Stmt, N_Stmt);
181                        end if;
182                     else
183                        --  Iterate.
184                        P_Stmt := N_Stmt;
185                        N_Stmt := Get_Stmt_Link (N_Stmt);
186                     end if;
187                  end loop;
188               end;
189            when others =>
190               Prev := Stmt;
191         end case;
192         Stmt := Next;
193      end loop;
194   end Thread_Jump;
195
196   procedure Optimize_Subprg (Subprg : Subprogram_Data_Acc)
197   is
198   begin
199      --  Jump optimisation:
200      --  * discard insns after a OE_JUMP.
201      --  * Remove jump if followed by label
202      --    (through label, BB, comments, end, line)
203      --  * Redirect jump to jump (infinite loop !)
204      --  * Revert jump_t/f if expr is not (XXX)
205      --  * Jmp_t/f L:; jmp L2; L1:  ->  jmp_f/t L2
206      Thread_Jump (Subprg);
207      if Flags.Flag_Opt_BB then
208         Jmp_To_Bb (Subprg);
209      end if;
210   end Optimize_Subprg;
211end Ortho_Code.Opts;
212
213