path: root/src/vhdl/translate/trans-chap8.adb

--  Iir to ortho translator.
--  Copyright (C) 2002 - 2014 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 Ada.Text_IO;
with Std_Names;
with Errorout; use Errorout;
with Iir_Chains;
with Canon;
with Evaluation; use Evaluation;
with Std_Package; use Std_Package;
with Iirs_Utils; use Iirs_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_Process =>
            return Get_Var (Info.Process_State);
         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);
      pragma Assert (Get_Info (Parent) = State_Info);

      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 =>
            --  * if the return type is scalar, simply returns.
            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_Acc
           | Type_Mode_Bounds_Acc =>
            --  * access: no range.
            declare
               Res : O_Enode;
            begin
               Res := Chap7.Translate_Expression (Expr, Ret_Type);
               Gen_Return_Value (Res);
            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
                 (E2M (Chap7.Translate_Expression (Expr, Ret_Type),
                  Ret_Info, Mode_Value));
               Chap3.Translate_Object_Allocation
                 (Area, Alloc_Return, Ret_Type,
                  Chap3.Get_Composite_Bounds (Val));
               Chap3.Translate_Object_Copy (Area, M2Addr (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;

   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;
   begin
      Start_If_Stmt
        (Blk, Chap7.Translate_Expression (Strip_Reference_Name
                                            (Get_Condition (Stmt))));

      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;

   function Get_Range_Ptr_Field_Value (O_Range : O_Lnode; Field : O_Fnode)
                                          return O_Enode
   is
   begin
      return New_Value (New_Selected_Element
                        (New_Access_Element (New_Value (O_Range)), Field));
   end Get_Range_Ptr_Field_Value;

   --  Inc or dec ITERATOR according to DIR.
   procedure Gen_Update_Iterator_Common (Val      : Unsigned_64;
                                         Itype    : Iir;
                                         V : out O_Enode)
   is
      Base_Type : constant Iir := Get_Base_Type (Itype);
   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), Integer_64 (Val)));
         when Iir_Kind_Enumeration_Type_Definition =>
            declare
               List : constant Iir_Flist :=
                 Get_Enumeration_Literal_List (Base_Type);
            begin
               --  FIXME: what about type E is ('T') ??
               if Natural (Val) > Get_Nbr_Elements (List) then
                  raise Internal_Error;
               end if;
               V := New_Lit
                 (Get_Ortho_Expr (Get_Nth_Element (List, Natural (Val))));
            end;

         when others =>
            Error_Kind ("gen_update_iterator", Base_Type);
      end case;
   end Gen_Update_Iterator_Common;

   procedure Gen_Update_Iterator (Iterator : O_Dnode;
                                  Dir      : Iir_Direction;
                                  Val      : Unsigned_64;
                                  Itype    : Iir)
   is
      Op        : ON_Op_Kind;
      V         : O_Enode;
   begin
      case Dir is
         when Iir_To =>
            Op := ON_Add_Ov;
         when Iir_Downto =>
            Op := ON_Sub_Ov;
      end case;
      Gen_Update_Iterator_Common (Val, Itype, V);
      New_Assign_Stmt (New_Obj (Iterator),
                       New_Dyadic_Op (Op, New_Obj_Value (Iterator), V));
   end Gen_Update_Iterator;

   procedure Gen_Update_Iterator (Iterator : Var_Type;
                                  Dir      : Iir_Direction;
                                  Val      : Unsigned_64;
                                  Itype    : Iir)
   is
      Op        : ON_Op_Kind;
      V         : O_Enode;
   begin
      case Dir is
         when Iir_To =>
            Op := ON_Add_Ov;
         when Iir_Downto =>
            Op := ON_Sub_Ov;
      end case;
      Gen_Update_Iterator_Common (Val, Itype, V);
      New_Assign_Stmt (Get_Var (Iterator),
                       New_Dyadic_Op (Op, New_Value (Get_Var (Iterator)), V));
   end Gen_Update_Iterator;

   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;
   begin
      --  Iterator range.
      Chap3.Translate_Object_Subtype (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
         It_Info.Iterator_Range := Create_Var
           (Create_Var_Identifier ("IT_RANGE"),
            Iter_Type_Info.B.Range_Ptr_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            : Iir_Direction;
      Op             : ON_Op_Kind;
   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 Iir_To =>
               Op := ON_Le;
            when Iir_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
         New_Assign_Stmt (Get_Var (It_Info.Iterator_Range),
                          New_Address (Chap7.Translate_Range
                                         (Constraint, Iter_Base_Type),
                                       Iter_Type_Info.B.Range_Ptr_Type));
         New_Assign_Stmt
           (Get_Var (It_Info.Iterator_Var),
            Get_Range_Ptr_Field_Value (Get_Var (It_Info.Iterator_Range),
                                       Iter_Type_Info.B.Range_Left));
         --  Before starting the loop, check whether there will be at least
         --  one iteration.
         Cond := New_Compare_Op
           (ON_Gt,
            Get_Range_Ptr_Field_Value (Get_Var (It_Info.Iterator_Range),
                                       Iter_Type_Info.B.Range_Length),
            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);
      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);
      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 := Get_Range_Ptr_Field_Value
           (Get_Var (It_Info.Iterator_Range), Iter_Type_Info.B.Range_Right);
      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);
      Iter_Type_Info : constant Ortho_Info_Acc := Get_Info (Iter_Base_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) = Iir_To xor Deep_Reverse then
            Gen_Update_Iterator (It_Info.Iterator_Var,
                                 Iir_To, 1, Iter_Base_Type);
         else
            Gen_Update_Iterator (It_Info.Iterator_Var,
                                 Iir_Downto, 1, Iter_Base_Type);
         end if;
      else
         Start_If_Stmt
           (If_Blk1, New_Compare_Op
              (ON_Eq,
               Get_Range_Ptr_Field_Value (Get_Var (It_Info.Iterator_Range),
                                          Iter_Type_Info.B.Range_Dir),
               New_Lit (Ghdl_Dir_To_Node),
               Ghdl_Bool_Type));
         Gen_Update_Iterator (It_Info.Iterator_Var,
                              Iir_To, 1, Iter_Base_Type);
         New_Else_Stmt (If_Blk1);
         Gen_Update_Iterator (It_Info.Iterator_Var,
                              Iir_Downto, 1, 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
               Info.Loop_State_Body := State_Allocate;

               --  if COND then
               --    goto BODY_STATE;
               --  else
               --    goto EXIT_STATE;
               --  end if;
               Open_Temp;
               Start_If_Stmt (Blk, Chap7.Translate_Expression (Cond));
               State_Jump (Info.Loop_State_Body);
               New_Else_Stmt (Blk);
               State_Jump (Info.Loop_State_Exit);
               Finish_If_Stmt (Blk);
               Close_Temp;

               --  BODY_STATE:
               State_Start (Info.Loop_State_Body);
            end if;

            Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));

            --  goto NEXT_STATE
            State_Jump (Info.Loop_State_Next);

            --  EXIT_STATE:
            State_Start (Info.Loop_State_Exit);
         end;
      else
         declare
            Info : Loop_Info_Acc;
         begin
            Info := Add_Info (Stmt, Kind_Loop);

            Start_Loop_Stmt (Info.Label_Exit);
            Info.Label_Next := O_Snode_Null;

            Open_Temp;
            if Cond /= Null_Iir then
               Gen_Exit_When
                 (Info.Label_Exit,
                  New_Monadic_Op (ON_Not, Chap7.Translate_Expression (Cond)));
            end if;
            Close_Temp;

            Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));

            Finish_Loop_Stmt (Info.Label_Exit);
         end;
      end if;

      Free_Info (Stmt);
      Current_Loop := Prev_Loop;
   end Translate_While_Loop_Statement;

   procedure Translate_Exit_Next_Statement (Stmt : Iir)
   is
      Cond       : constant Iir := Get_Condition (Stmt);
      If_Blk     : O_If_Block;
      Info       : Ortho_Info_Acc;
      Loop_Label : Iir;
      Loop_Stmt  : Iir;
   begin
      Loop_Label := Get_Loop_Label (Stmt);
      if Loop_Label = Null_Iir then
         Loop_Stmt := Current_Loop;
      else
         Loop_Stmt := Get_Named_Entity (Loop_Label);
      end if;

      Info := Get_Info (Loop_Stmt);

      --  Common part.
      if Cond /= Null_Iir then
         Start_If_Stmt (If_Blk, Chap7.Translate_Expression (Cond));
      end if;

      if Get_Suspend_Flag (Loop_Stmt) then
         --  The corresponding loop is state based.  Jump to the right state.
         case Get_Kind (Stmt) is
            when Iir_Kind_Exit_Statement =>
               State_Jump (Info.Loop_State_Exit);
            when Iir_Kind_Next_Statement =>
               State_Jump (Info.Loop_State_Next);
            when others =>
               raise Internal_Error;
         end case;

         --  Force the jump, so that it would work even if the next/exit is
         --  not immediately within a state construct.  Example:
         --    loop
         --      if cond then
         --        exit;
         --      else
         --        i := i + 1;
         --      end if;
         --      wait for 1 ns;
         --    end loop;
         --  A new state cannot be created here, as the outer construct is the
         --  if statement and not the case statement for the state machine.
         State_Jump_Force;

         if Cond /= Null_Iir then
            Finish_If_Stmt (If_Blk);
         end if;
      else
         case Get_Kind (Stmt) is
            when Iir_Kind_Exit_Statement =>
               New_Exit_Stmt (Info.Label_Exit);
            when Iir_Kind_Next_Statement =>
               if Info.Label_Next /= O_Snode_Null then
                  --  For-loop.
                  New_Exit_Stmt (Info.Label_Next);
               else
                  --  While-loop.
                  New_Next_Stmt (Info.Label_Exit);
               end if;
            when others =>
               raise Internal_Error;
         end case;
         if Cond /= Null_Iir then
            Finish_If_Stmt (If_Blk);
         end if;
      end if;
   end Translate_Exit_Next_Statement;

   procedure Translate_Variable_Aggregate_Assignment
     (Targ : Iir; Targ_Type : Iir; Val : Mnode);

   procedure Translate_Variable_Array_Aggr
     (Targ      : Iir_Aggregate;
      Targ_Type : Iir;
      Val       : Mnode;
      Index     : in out Unsigned_64;
      Dim       : Natural)
   is
      El      : Iir;
      Final   : Boolean;
      El_Type : Iir;
   begin
      Final := Dim = Get_Nbr_Elements (Get_Index_Subtype_List (Targ_Type));
      if Final then
         El_Type := Get_Element_Subtype (Targ_Type);