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