-- Iir to ortho translator.
-- Copyright (C) 2002 - 2014 Tristan Gingold
--
-- This program 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 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 General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
with Simple_IO;
with Std_Names;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils;
with Vhdl.Canon;
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Vhdl.Utils; use Vhdl.Utils;
with Trans.Chap2;
with Trans.Chap3;
with Trans.Chap4;
with Trans.Chap6;
with Trans.Chap7;
with Trans.Chap9;
with Trans.Chap14;
with Trans_Decls; use Trans_Decls;
with Translation; use Translation;
with Trans.Helpers2; use Trans.Helpers2;
with Trans.Foreach_Non_Composite;
package body Trans.Chap8 is
use Trans.Helpers;
-- The LOCAL_STATE is a local variable read from the frame at entry and
-- written before return. The value INITIAL_STATE (0) is the initial
-- state. For processes, this is the state for the first statement. For
-- subprograms, this is the state at call, before dynamic elaboration of
-- local declarations.
-- Subprograms have more special values:
-- 1: The return state. Finalization is performed.
Local_State : O_Dnode := O_Dnode_Null;
Initial_State : constant State_Type := 0;
-- Return_State : constant State_Value_Type := 1;
-- Next value available.
State_Next : State_Type := Initial_State;
-- Info node to which the state variable is attached. Used to set and save
-- the state variable.
State_Info : Ortho_Info_Acc := null;
-- Statements construct for the state machine. The generated code is:
-- local var STATE: index_type;
-- begin
-- STATE := FRAME.all.STATE;
-- loop
-- case STATE is
-- when 0 => ...
-- when 1 => ...
-- ...
-- end case;
-- end loop;
-- end;
State_Case : Ortho_Nodes.O_Case_Block;
State_Loop : Ortho_Nodes.O_Snode;
function Get_State_Var (Info : Ortho_Info_Acc) return O_Lnode is
begin
case Info.Kind is
when Kind_Object =>
return Get_Var (Info.Object_Var);
when Kind_Subprg =>
return New_Selected_Acc_Value
(New_Obj (Info.Res_Interface), Info.Subprg_State_Field);
when others =>
raise Internal_Error;
end case;
end Get_State_Var;
procedure State_Entry (Info : Ortho_Info_Acc) is
begin
-- Not reentrant.
pragma Assert (not State_Enabled);
State_Info := Info;
-- For optimization, create a copy of the STATE variable.
New_Var_Decl (Local_State, Get_Identifier ("STATE"),
O_Storage_Local, Ghdl_Index_Type);
-- Initialize it from the frame.
New_Assign_Stmt (New_Obj (Local_State),
New_Value (Get_State_Var (Info)));
Start_Loop_Stmt (State_Loop);
Start_Case_Stmt (State_Case, New_Obj_Value (Local_State));
State_Start (0);
State_Next := 0;
end State_Entry;
procedure State_Leave (Parent : Iir) is
begin
pragma Assert (State_Enabled);
if State_Debug then
Start_Choice (State_Case);
New_Default_Choice (State_Case);
Finish_Choice (State_Case);
Chap6.Gen_Program_Error (Parent, Chap6.Prg_Err_Unreach_State);
end if;
Finish_Case_Stmt (State_Case);
Finish_Loop_Stmt (State_Loop);
Local_State := O_Dnode_Null;
State_Info := null;
end State_Leave;
function State_Enabled return Boolean is
begin
return Local_State /= O_Dnode_Null;
end State_Enabled;
function State_Allocate return State_Type is
begin
State_Next := State_Next + 1;
return State_Next;
end State_Allocate;
function State_To_Lit (State : State_Type) return O_Cnode is
begin
return New_Index_Lit (Unsigned_64 (State));
end State_To_Lit;
procedure State_Start (State : State_Type) is
begin
Start_Choice (State_Case);
New_Expr_Choice (State_Case, State_To_Lit (State));
Finish_Choice (State_Case);
end State_Start;
procedure State_Jump (Next_State : State_Type) is
begin
New_Assign_Stmt (New_Obj (Local_State),
New_Lit (State_To_Lit (Next_State)));
end State_Jump;
procedure State_Jump_Force is
begin
New_Next_Stmt (State_Loop);
end State_Jump_Force;
procedure State_Suspend (Next_State : State_Type) is
begin
New_Assign_Stmt (Get_State_Var (State_Info),
New_Lit (State_To_Lit (Next_State)));
New_Return_Stmt;
end State_Suspend;
procedure Translate_Return_Statement (Stmt : Iir_Return_Statement)
is
Subprg_Info : constant Ortho_Info_Acc :=
Get_Info (Chap2.Current_Subprogram);
Expr : constant Iir := Get_Expression (Stmt);
Ret_Type : Iir;
Ret_Info : Type_Info_Acc;
procedure Gen_Return is
begin
if Subprg_Info.Subprg_Exit /= O_Snode_Null then
New_Exit_Stmt (Subprg_Info.Subprg_Exit);
else
New_Return_Stmt;
end if;
end Gen_Return;
procedure Gen_Return_Value (Val : O_Enode) is
begin
if Subprg_Info.Subprg_Exit /= O_Snode_Null then
New_Assign_Stmt (New_Obj (Subprg_Info.Subprg_Result), Val);
New_Exit_Stmt (Subprg_Info.Subprg_Exit);
else
New_Return_Stmt (Val);
end if;
end Gen_Return_Value;
begin
if Expr = Null_Iir then
-- Return in a procedure.
if Get_Suspend_Flag (Chap2.Current_Subprogram) then
State_Jump (State_Return);
State_Jump_Force;
else
Gen_Return;
end if;
return;
end if;
-- Return in a function.
Ret_Type := Get_Return_Type (Chap2.Current_Subprogram);
Ret_Info := Get_Info (Ret_Type);
case Ret_Info.Type_Mode is
when Type_Mode_Scalar
| Type_Mode_Acc
| Type_Mode_Bounds_Acc =>
-- * if the return type is scalar, simply returns.
-- * access: no range.
declare
V : O_Dnode;
R : O_Enode;
begin
-- Always uses a temporary in case of the return expression
-- uses secondary stack. This can happen in constructs like:
-- return my_func (param)(index);
-- FIXME: don't use the temp if not required.
R := Chap7.Translate_Expression (Expr, Ret_Type);
if Has_Stack2_Mark
or else Chap3.Need_Range_Check (Expr, Ret_Type)
then
V := Create_Temp (Ret_Info.Ortho_Type (Mode_Value));
New_Assign_Stmt (New_Obj (V), R);
Stack2_Release;
Chap3.Check_Range (V, Expr, Ret_Type, Expr);
Gen_Return_Value (New_Obj_Value (V));
else
Gen_Return_Value (R);
end if;
end;
when Type_Mode_Unbounded_Array
| Type_Mode_Unbounded_Record =>
-- * if the return type is unconstrained: allocate an area from
-- the secondary stack, copy it to the area, and fill the fat
-- pointer.
-- Evaluate the result.
declare
Val : Mnode;
Area : Mnode;
begin
Area := Dp2M (Subprg_Info.Res_Interface,
Ret_Info, Mode_Value);
Val := Stabilize (Chap7.Translate_Expression (Expr, Ret_Type));
Chap3.Translate_Object_Allocation
(Area, Alloc_Return, Ret_Type,
Chap3.Get_Composite_Bounds (Val));
Chap3.Translate_Object_Copy (Area, Val, Ret_Type);
Gen_Return;
end;
when Type_Mode_Bounded_Records
| Type_Mode_Bounded_Arrays =>
-- * if the return type is a constrained composite type, copy
-- it to the result area.
-- Create a temporary area so that if the expression use
-- stack2, it will be freed before the return (otherwise,
-- the stack area will be lost).
declare
V : Mnode;
begin
Open_Temp;
V := Dp2M (Subprg_Info.Res_Interface, Ret_Info, Mode_Value);
Chap3.Translate_Object_Copy
(V, Chap7.Translate_Expression (Expr, Ret_Type), Ret_Type);
Close_Temp;
Gen_Return;
end;
when Type_Mode_File
| Type_Mode_Unknown
| Type_Mode_Protected =>
raise Internal_Error;
end case;
end Translate_Return_Statement;
-- Translate the condition COND of a control statement.
-- This is special as it frees immediately the stack2 (if needed) because
-- the control statement may prevent the execution of the normal stack2
-- release at the end of the temporary region.
-- As a consequence, this function must be called within a brand new
-- and dedicated temporary region.
-- Use of this function is not needed for processes with state, because
-- the control statement becomes an assignment to the next state.
function Translate_Condition (Cond : Iir) return O_Enode
is
Res : O_Enode;
Res_Var : O_Dnode;
begin
-- As a statement is always wrapped into a temporary region, the
-- stack2 is not used (in the inner region).
pragma Assert (not Has_Stack2_Mark);
-- Translate the condition.
Res := Chap7.Translate_Expression (Cond);
-- If the condition needs stack2, free it now as a inner statement
-- may return (and this skipping the release of stack2).
if Has_Stack2_Mark then
Res_Var := Create_Temp_Init (Std_Boolean_Type_Node, Res);
Stack2_Release;
Res := New_Obj_Value (Res_Var);
end if;
return Res;
end Translate_Condition;
procedure Translate_If_Statement_State_Jumps
(Stmt : Iir; Fall_State : State_Type)
is
Blk : O_If_Block;
Else_Clause : Iir;
begin
Start_If_Stmt
(Blk, Chap7.Translate_Expression (Get_Condition (Stmt)));
State_Jump (State_Allocate);
New_Else_Stmt (Blk);
Else_Clause := Get_Else_Clause (Stmt);
if Else_Clause = Null_Iir then
State_Jump (Fall_State);
else
if Get_Condition (Else_Clause) = Null_Iir then
State_Jump (State_Allocate);
else
Open_Temp;
New_Debug_Line_Stmt (Get_Line_Number (Else_Clause));
Translate_If_Statement_State_Jumps (Else_Clause, Fall_State);
Close_Temp;
end if;
end if;
Finish_If_Stmt (Blk);
end Translate_If_Statement_State_Jumps;
procedure Translate_If_Statement_State (Stmt : Iir)
is
Fall_State : State_Type;
Next_State : State_Type;
Branch : Iir;
begin
Fall_State := State_Allocate;
Next_State := Fall_State;
-- Generate the jumps.
Open_Temp;
Translate_If_Statement_State_Jumps (Stmt, Fall_State);
Close_Temp;
-- Generate statements.
Branch := Stmt;
loop
Next_State := Next_State + 1;
State_Start (Next_State);
Translate_Statements_Chain (Get_Sequential_Statement_Chain (Branch));
State_Jump (Fall_State);
Branch := Get_Else_Clause (Branch);
exit when Branch = Null_Iir;
end loop;
State_Start (Fall_State);
end Translate_If_Statement_State;
procedure Translate_If_Statement_Direct (Stmt : Iir)
is
Blk : O_If_Block;
Else_Clause : Iir;
Cond : O_Enode;
begin
Cond := Translate_Condition
(Strip_Reference_Name (Get_Condition (Stmt)));
Start_If_Stmt (Blk, Cond);
Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
Else_Clause := Get_Else_Clause (Stmt);
if Else_Clause /= Null_Iir then
New_Else_Stmt (Blk);
if Get_Condition (Else_Clause) = Null_Iir then
Translate_Statements_Chain
(Get_Sequential_Statement_Chain (Else_Clause));
else
Open_Temp;
New_Debug_Line_Stmt (Get_Line_Number (Else_Clause));
Translate_If_Statement_Direct (Else_Clause);
Close_Temp;
end if;
end if;
Finish_If_Stmt (Blk);
end Translate_If_Statement_Direct;
procedure Translate_If_Statement (Stmt : Iir) is
begin
if Get_Suspend_Flag (Stmt) then
Translate_If_Statement_State (Stmt);
else
Translate_If_Statement_Direct (Stmt);
end if;
end Translate_If_Statement;
-- Inc or dec ITERATOR according to DIR.
procedure Gen_Update_Iterator (Iterator : Var_Type;
Dir : Direction_Type;
Itype : Iir)
is
Base_Type : constant Iir := Get_Base_Type (Itype);
Op : ON_Op_Kind;
V : O_Enode;
begin
case Get_Kind (Base_Type) is
when Iir_Kind_Integer_Type_Definition =>
V := New_Lit
(New_Signed_Literal
(Get_Ortho_Type (Base_Type, Mode_Value), 1));
when Iir_Kind_Enumeration_Type_Definition =>
declare
List : constant Iir_Flist :=
Get_Enumeration_Literal_List (Base_Type);
Num : Natural;
begin
if Get_Nbr_Elements (List) = 1 then
-- In the case of:
-- type E is ('T')
-- the iterator must have already finished. So it doesn't
-- matter if not incremented.
Num := 0;
else
Num := 1;
end if;
V := New_Lit (Get_Ortho_Literal (Get_Nth_Element (List, Num)));
end;
when others =>
Error_Kind ("gen_update_iterator", Base_Type);
end case;
case Dir is
when Dir_To =>
Op := ON_Add_Ov;
when Dir_Downto =>
Op := ON_Sub_Ov;
end case;
New_Assign_Stmt (Get_Var (Iterator),
New_Dyadic_Op (Op, New_Value (Get_Var (Iterator)), V));
end Gen_Update_Iterator;
function Is_For_Loop_Iterator_Stable (Iterator : Iir) return Boolean
is
Iter_Type : constant Iir := Get_Type (Iterator);
Constraint : constant Iir := Get_Range_Constraint (Iter_Type);
Name : Iir;
begin
case Iir_Kinds_Range_Attribute (Get_Kind (Constraint)) is
when Iir_Kind_Reverse_Range_Array_Attribute =>
-- Need to create a reversed range...
return False;
when Iir_Kind_Range_Array_Attribute =>
Name := Get_Prefix (Constraint);
Name := Get_Base_Name (Name);
case Get_Kind (Name) is
when Iir_Kind_Implicit_Dereference
| Iir_Kind_Dereference =>
return False;
when Iir_Kind_Function_Call =>
if not Is_Fully_Constrained_Type (Get_Type (Name)) then
return False;
end if;
when Iir_Kinds_Object_Declaration =>
null;
when Iir_Kind_Subtype_Declaration =>
null;
when Iir_Kind_Element_Attribute =>
null;
when others =>
Error_Kind ("is_for_loop_iterator_stable(2)", Name);
end case;
return True;
end case;
end Is_For_Loop_Iterator_Stable;
function Get_Iterator_Range_Var (Iterator : Iir) return Mnode
is
Iter_Type : constant Iir := Get_Type (Iterator);
Iter_Type_Info : constant Type_Info_Acc :=
Get_Info (Get_Base_Type (Iter_Type));
It_Info : constant Ortho_Info_Acc := Get_Info (Iterator);
begin
if It_Info.Iterator_Range_Copy then
return Lv2M (Get_Var (It_Info.Iterator_Range),
Iter_Type_Info, Mode_Value,
Iter_Type_Info.B.Range_Type,
Iter_Type_Info.B.Range_Ptr_Type);
else
return Lp2M (Get_Var (It_Info.Iterator_Range),
Iter_Type_Info, Mode_Value,
Iter_Type_Info.B.Range_Type,
Iter_Type_Info.B.Range_Ptr_Type);
end if;
end Get_Iterator_Range_Var;
procedure Translate_For_Loop_Statement_Declaration (Stmt : Iir)
is
Iterator : constant Iir := Get_Parameter_Specification (Stmt);
Iter_Type : constant Iir := Get_Type (Iterator);
Iter_Type_Info : constant Type_Info_Acc :=
Get_Info (Get_Base_Type (Iter_Type));
Constraint : constant Iir := Get_Range_Constraint (Iter_Type);
It_Info : Ortho_Info_Acc;
Range_Type : O_Tnode;
begin
-- Iterator range.
Chap3.Translate_Object_Subtype_Indication (Iterator, False);
-- Iterator variable.
It_Info := Add_Info (Iterator, Kind_Iterator);
It_Info.Iterator_Var := Create_Var
(Create_Var_Identifier (Iterator),
Iter_Type_Info.Ortho_Type (Mode_Value),
O_Storage_Local);
if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
It_Info.Iterator_Right := Create_Var
(Create_Var_Identifier ("IT_RIGHT"),
Iter_Type_Info.Ortho_Type (Mode_Value),
O_Storage_Local);
else
-- The range must be copied if:
-- * the constraint is 'range or 'reverse_range, or 'subtype, or
-- 'element (ie any attribute ?)
-- * the base name is a function_call returning an unbounded value,
-- or a dereference.
-- Note: in case of a dereference, the anonymous object can be
-- deallocated within the loop.
It_Info.Iterator_Range_Copy :=
not Is_For_Loop_Iterator_Stable (Iterator);
if It_Info.Iterator_Range_Copy then
Range_Type := Iter_Type_Info.B.Range_Type;
else
Range_Type := Iter_Type_Info.B.Range_Ptr_Type;
end if;
It_Info.Iterator_Range := Create_Var
(Create_Var_Identifier ("IT_RANGE"), Range_Type, O_Storage_Local);
end if;
end Translate_For_Loop_Statement_Declaration;
procedure Start_For_Loop (Iterator : Iir_Iterator_Declaration;
Cond : out O_Enode)
is
Iter_Type : constant Iir := Get_Type (Iterator);
Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
Iter_Type_Info : constant Ortho_Info_Acc := Get_Info (Iter_Base_Type);
It_Info : constant Ortho_Info_Acc := Get_Info (Iterator);
Constraint : constant Iir := Get_Range_Constraint (Iter_Type);
Dir : Direction_Type;
Op : ON_Op_Kind;
Rng : O_Lnode;
begin
if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
New_Assign_Stmt
(Get_Var (It_Info.Iterator_Var),
Chap7.Translate_Range_Expression_Left (Constraint,
Iter_Base_Type));
Dir := Get_Direction (Constraint);
New_Assign_Stmt
(Get_Var (It_Info.Iterator_Right),
Chap7.Translate_Range_Expression_Right (Constraint,
Iter_Base_Type));
case Dir is
when Dir_To =>
Op := ON_Le;
when Dir_Downto =>
Op := ON_Ge;
end case;
-- Check for at least one iteration.
Cond := New_Compare_Op
(Op, New_Value (Get_Var (It_Info.Iterator_Var)),
New_Value (Get_Var (It_Info.Iterator_Right)),
Ghdl_Bool_Type);
else
Rng := Chap7.Translate_Range (Constraint, Iter_Base_Type);
if It_Info.Iterator_Range_Copy then
Gen_Memcpy (M2Addr (Get_Iterator_Range_Var (Iterator)),
New_Address (Rng, Iter_Type_Info.B.Range_Ptr_Type),
New_Lit (New_Sizeof (Iter_Type_Info.B.Range_Type,
Ghdl_Index_Type)));
else
New_Assign_Stmt
(Get_Var (It_Info.Iterator_Range),
New_Address (Rng, Iter_Type_Info.B.Range_Ptr_Type));
end if;
New_Assign_Stmt
(Get_Var (It_Info.Iterator_Var),
M2E (Chap3.Range_To_Left (Get_Iterator_Range_Var (Iterator))));
-- Before starting the loop, check whether there will be at least
-- one iteration.
Cond := New_Compare_Op
(ON_Gt,
M2E (Chap3.Range_To_Length (Get_Iterator_Range_Var (Iterator))),
New_Lit (Ghdl_Index_0),
Ghdl_Bool_Type);
end if;
end Start_For_Loop;
procedure Exit_Cond_For_Loop (Iterator : Iir; Cond : out O_Enode)
is
Iter_Type : constant Iir := Get_Type (Iterator);
It_Info : constant Ortho_Info_Acc := Get_Info (Iterator);
Constraint : constant Iir := Get_Range_Constraint (Iter_Type);
Val : O_Enode;
begin
-- Check end of loop.
-- Equality is necessary and enough.
if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
Val := New_Value (Get_Var (It_Info.Iterator_Right));
else
Val := M2E (Chap3.Range_To_Right (Get_Iterator_Range_Var (Iterator)));
end if;
Cond := New_Compare_Op (ON_Eq,
New_Value (Get_Var (It_Info.Iterator_Var)), Val,
Ghdl_Bool_Type);
end Exit_Cond_For_Loop;
procedure Update_For_Loop (Iterator : Iir)
is
Iter_Type : constant Iir := Get_Type (Iterator);
Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
It_Info : constant Ortho_Info_Acc := Get_Info (Iterator);
If_Blk1 : O_If_Block;
Deep_Rng : Iir;
Deep_Reverse : Boolean;
begin
-- Update the iterator.
Chap6.Get_Deep_Range_Expression (Iter_Type, Deep_Rng, Deep_Reverse);
if Deep_Rng /= Null_Iir then
if Get_Direction (Deep_Rng) = Dir_To xor Deep_Reverse then
Gen_Update_Iterator (It_Info.Iterator_Var,
Dir_To, Iter_Base_Type);
else
Gen_Update_Iterator (It_Info.Iterator_Var,
Dir_Downto, Iter_Base_Type);
end if;
else
Start_If_Stmt
(If_Blk1, New_Compare_Op
(ON_Eq,
M2E (Chap3.Range_To_Dir (Get_Iterator_Range_Var (Iterator))),
New_Lit (Ghdl_Dir_To_Node),
Ghdl_Bool_Type));
Gen_Update_Iterator (It_Info.Iterator_Var,
Dir_To, Iter_Base_Type);
New_Else_Stmt (If_Blk1);
Gen_Update_Iterator (It_Info.Iterator_Var,
Dir_Downto, Iter_Base_Type);
Finish_If_Stmt (If_Blk1);
end if;
end Update_For_Loop;
Current_Loop : Iir := Null_Iir;
procedure Translate_For_Loop_Statement_State
(Stmt : Iir_For_Loop_Statement)
is
Iterator : constant Iir := Get_Parameter_Specification (Stmt);
It_Info : constant Ortho_Info_Acc := Get_Info (Iterator);
Info : constant Loop_State_Info_Acc := Get_Info (Stmt);
Loop_If : O_If_Block;
Cond : O_Enode;
begin
pragma Assert (It_Info /= null);
Info.Loop_State_Next := State_Allocate;
Info.Loop_State_Exit := State_Allocate;
Info.Loop_State_Body := State_Allocate;
-- Loop header: initialize iterator, skip the whole body in case of
-- null range.
Open_Temp;
Start_For_Loop (Iterator, Cond);
Start_If_Stmt (Loop_If, Cond);
State_Jump (Info.Loop_State_Body);
New_Else_Stmt (Loop_If);
State_Jump (Info.Loop_State_Exit);
Finish_If_Stmt (Loop_If);
Close_Temp;
-- Loop body.
State_Start (Info.Loop_State_Body);
Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
State_Jump (Info.Loop_State_Next);
-- Loop next.
State_Start (Info.Loop_State_Next);
Exit_Cond_For_Loop (Iterator, Cond);
Start_If_Stmt (Loop_If, Cond);
State_Jump (Info.Loop_State_Exit);
New_Else_Stmt (Loop_If);
Update_For_Loop (Iterator);
State_Jump (Info.Loop_State_Body);
Finish_If_Stmt (Loop_If);
-- Exit state, after loop.
State_Start (Info.Loop_State_Exit);
Free_Info (Iterator);
end Translate_For_Loop_Statement_State;
procedure Translate_For_Loop_Statement_Direct
(Stmt : Iir_For_Loop_Statement)
is
Iterator : constant Iir := Get_Parameter_Specification (Stmt);
Loop_Info : Loop_Info_Acc;
-- If around the loop, to check if the loop must be executed.
Loop_If : O_If_Block;
Cond : O_Enode;
begin
Start_Declare_Stmt;
Open_Temp;
Translate_For_Loop_Statement_Declaration (Stmt);
-- Loop header: initialize iterator.
Start_For_Loop (Iterator, Cond);
-- Skip the whole loop in case of null range.
Start_If_Stmt (Loop_If, Cond);
-- Start loop.
-- There are two blocks: one for the exit, one for the next.
Loop_Info := Add_Info (Stmt, Kind_Loop);
Start_Loop_Stmt (Loop_Info.Label_Exit);
Start_Loop_Stmt (Loop_Info.Label_Next);
-- Loop body.
Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
-- Fake 'next' statement.
New_Exit_Stmt (Loop_Info.Label_Next);
Finish_Loop_Stmt (Loop_Info.Label_Next);
-- Exit loop if right bound reached.
Exit_Cond_For_Loop (Iterator, Cond);
Gen_Exit_When (Loop_Info.Label_Exit, Cond);
Update_For_Loop (Iterator);
Finish_Loop_Stmt (Loop_Info.Label_Exit);
Finish_If_Stmt (Loop_If);
Close_Temp;
Free_Info (Stmt);
Finish_Declare_Stmt;
Free_Info (Iterator);
end Translate_For_Loop_Statement_Direct;
procedure Translate_For_Loop_Statement (Stmt : Iir_For_Loop_Statement)
is
Prev_Loop : Iir;
begin
Prev_Loop := Current_Loop;
Current_Loop := Stmt;
if Get_Suspend_Flag (Stmt) then
Translate_For_Loop_Statement_State (Stmt);
else
Translate_For_Loop_Statement_Direct (Stmt);
end if;
Current_Loop := Prev_Loop;
end Translate_For_Loop_Statement;
procedure Translate_While_Loop_Statement (Stmt : Iir_While_Loop_Statement)
is
Cond : constant Iir := Get_Condition (Stmt);
Prev_Loop : Iir;
begin
Prev_Loop := Current_Loop;
Current_Loop := Stmt;
if Get_Suspend_Flag (Stmt) then
declare
Info : constant Loop_State_Info_Acc := Get_Info (Stmt);
Blk : O_If_Block;
begin
Info.Loop_State_Next := State_Allocate;
Info.Loop_State_Exit := State_Allocate;
-- NEXT_STATE:
State_Jump (Info.Loop_State_Next);
State_Start (Info.Loop_State_Next);
if Cond /= Null_Iir then