-- Mcode back-end for ortho - Optimization.
-- Copyright (C) 2006 Tristan Gingold
--
-- GHDL is free software; you can redistribute it and/or modify it under
-- the terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 2, or (at your option) any later
-- version.
--
-- GHDL 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 General Public License
-- for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Ortho_Code.Flags;
package body Ortho_Code.Opts is
procedure Relabel_Jump (Jmp : O_Enode)
is
Label : O_Enode;
Bb : O_Enode;
begin
Label := Get_Jump_Label (Jmp);
if Get_Expr_Kind (Label) = OE_Label then
Bb := O_Enode (Get_Label_Info (Label));
if Bb /= O_Enode_Null then
Set_Jump_Label (Jmp, Bb);
end if;
end if;
end Relabel_Jump;
procedure Jmp_To_Bb (Subprg : Subprogram_Data_Acc)
is
First : O_Enode;
Stmt : O_Enode;
Prev : O_Enode;
Cur_Bb : O_Enode;
begin
-- Get first statement after entry.
First := Get_Stmt_Link (Subprg.E_Entry);
-- First loop:
-- If a label belongs to a BB (ie, is at the beginning of a BB),
-- then link it to the BB.
Stmt := First;
Cur_Bb := O_Enode_Null;
loop
case Get_Expr_Kind (Stmt) is
when OE_Leave =>
exit;
when OE_BB =>
Cur_Bb := Stmt;
when OE_Label =>
if Cur_Bb /= O_Enode_Null then
Set_Label_Info (Stmt, Int32 (Cur_Bb));
end if;
when OE_Jump
| OE_Jump_T
| OE_Jump_F =>
-- This handles backward jump.
Relabel_Jump (Stmt);
when others =>
Cur_Bb := O_Enode_Null;
end case;
Stmt := Get_Stmt_Link (Stmt);
end loop;
-- Second loop:
-- Transform jump to label to jump to BB.
Stmt := First;
Prev := O_Enode_Null;
loop
case Get_Expr_Kind (Stmt) is
when OE_Leave =>
exit;
when OE_Jump
| OE_Jump_T
| OE_Jump_F =>
-- This handles forward jump.
Relabel_Jump (Stmt);
-- Update PREV.
Prev := Stmt;
when OE_Label =>
-- Remove the Label.
-- Do not update PREV.
if Get_Label_Info (Stmt) /= 0 then
Set_Stmt_Link (Prev, Get_Stmt_Link (Stmt));
end if;
when others =>
Prev := Stmt;
end case;
Stmt := Get_Stmt_Link (Stmt);
end loop;
end Jmp_To_Bb;
type Oe_Kind_Bool_Array is array (OE_Kind) of Boolean;
Is_Passive_Stmt : constant Oe_Kind_Bool_Array :=
(OE_Label | OE_BB | OE_End | OE_Beg => True,
others => False);
-- Return the next statement after STMT which really execute instructions.
function Get_Fall_Stmt (Stmt : O_Enode) return O_Enode
is
Res : O_Enode;
begin
Res := Stmt;
loop
Res := Get_Stmt_Link (Res);
case Get_Expr_Kind (Res) is
when OE_Label
| OE_BB
| OE_End
| OE_Beg =>
null;
when others =>
return Res;
end case;
end loop;
end Get_Fall_Stmt;
pragma Unreferenced (Get_Fall_Stmt);
procedure Thread_Jump (Subprg : Subprogram_Data_Acc)
is
First : O_Enode;
Stmt : O_Enode;
Prev, Next : O_Enode;
Kind : OE_Kind;
begin
-- Get first statement after entry.
First := Get_Stmt_Link (Subprg.E_Entry);
-- First loop:
-- If a label belongs to a BB (ie, is at the beginning of a BB),
-- then link it to the BB.
Stmt := First;
Prev := O_Enode_Null;
loop
Next := Get_Stmt_Link (Stmt);
Kind := Get_Expr_Kind (Stmt);
case Kind is
when OE_Leave =>
exit;
when OE_Jump =>
-- Remove the jump if followed by the label.
-- * For _T/_F: should convert to a ignore value.
-- Discard unreachable statements after the jump.
declare
N_Stmt : O_Enode;
P_Stmt : O_Enode;
Label : O_Enode;
Flag_Discard : Boolean;
K_Stmt : OE_Kind;
begin
N_Stmt := Next;
P_Stmt := Stmt;
Label := Get_Jump_Label (Stmt);
Flag_Discard := True;
loop
if N_Stmt = Label then
-- Remove STMT.
Set_Stmt_Link (Prev, Next);
exit;
end if;
K_Stmt := Get_Expr_Kind (N_Stmt);
if K_Stmt = OE_Label then
-- Do not discard anymore statements, since they are
-- now reachable.
Flag_Discard := False;
end if;
if not Is_Passive_Stmt (K_Stmt) then
if not Flag_Discard then
-- We have found the next statement.
-- Keep the jump.
Prev := Stmt;
exit;
else
-- Delete insn.
N_Stmt := Get_Stmt_Link (N_Stmt);
Set_Stmt_Link (P_Stmt, N_Stmt);
end if;
else
-- Iterate.
P_Stmt := N_Stmt;
N_Stmt := Get_Stmt_Link (N_Stmt);
end if;
end loop;
end;
when others =>
Prev := Stmt;
end case;
Stmt := Next;
end loop;
end Thread_Jump;
procedure Optimize_Subprg (Subprg : Subprogram_Data_Acc)
is
begin
-- Jump optimisation:
-- * discard insns after a OE_JUMP.
-- * Remove jump if followed by label
-- (through label, BB, comments, end, line)
-- * Redirect jump to jump (infinite loop !)
-- * Revert jump_t/f if expr is not (XXX)
-- * Jmp_t/f L:; jmp L2; L1: -> jmp_f/t L2
Thread_Jump (Subprg);
if Flags.Flag_Opt_BB then
Jmp_To_Bb (Subprg);
end if;
end Optimize_Subprg;
end Ortho_Code.Opts;