path: root/src/vhdl/translate/trans-chap6.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 Files_Map;
with Errorout; use Errorout;
with Iirs_Utils; use Iirs_Utils;
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Trans.Chap3;
with Trans.Chap7;
with Trans.Chap14;
with Trans.Helpers2; use Trans.Helpers2;
with Trans_Decls; use Trans_Decls;

package body Trans.Chap6 is
   use Trans.Helpers;

   function Get_Array_Bound_Length
     (Arr : Mnode; Arr_Type : Iir; Dim : Natural) return O_Enode
   is
      Tinfo : constant Type_Info_Acc := Get_Info (Arr_Type);
      Index_Type, Constraint : Iir;
   begin
      if Tinfo.Type_Locally_Constrained then
         Index_Type := Get_Index_Type (Arr_Type, Dim - 1);
         Constraint := Get_Range_Constraint (Index_Type);
         return New_Lit (Chap7.Translate_Static_Range_Length (Constraint));
      else
         return M2E
           (Chap3.Range_To_Length
              (Chap3.Get_Array_Range (Arr, Arr_Type, Dim)));
      end if;
   end Get_Array_Bound_Length;

   procedure Gen_Bound_Error (Loc : Iir)
   is
      Constr    : O_Assoc_List;
      Name      : Name_Id;
      Line, Col : Natural;
   begin
      Files_Map.Location_To_Position (Get_Location (Loc), Name, Line, Col);

      Start_Association (Constr, Ghdl_Bound_Check_Failed);
      Assoc_Filename_Line (Constr, Line);
      New_Procedure_Call (Constr);
   end Gen_Bound_Error;

   procedure Gen_Direction_Error (Loc : Iir)
   is
      Constr    : O_Assoc_List;
      Name      : Name_Id;
      Line, Col : Natural;
   begin
      Files_Map.Location_To_Position (Get_Location (Loc), Name, Line, Col);

      Start_Association (Constr, Ghdl_Direction_Check_Failed);
      Assoc_Filename_Line (Constr, Line);
      New_Procedure_Call (Constr);
   end Gen_Direction_Error;

   procedure Gen_Program_Error (Loc : Iir; Code : Natural)
   is
      Assoc : O_Assoc_List;
   begin
      Start_Association (Assoc, Ghdl_Program_Error);

      if Current_Filename_Node = O_Dnode_Null then
         New_Association (Assoc, New_Lit (New_Null_Access (Char_Ptr_Type)));
         New_Association (Assoc,
                          New_Lit (New_Signed_Literal (Ghdl_I32_Type, 0)));
      else
         Assoc_Filename_Line (Assoc, Get_Line_Number (Loc));
      end if;
      New_Association
        (Assoc, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
         Unsigned_64 (Code))));
      New_Procedure_Call (Assoc);
   end Gen_Program_Error;

   --  Generate code to emit a failure if COND is TRUE, indicating an
   --  index violation for dimension DIM of an array.  LOC is usually
   --  the expression which has computed the index and is used only for
   --  its location.
   procedure Check_Bound_Error (Cond : O_Enode; Loc : Iir; Dim : Natural)
   is
      pragma Unreferenced (Dim);
      If_Blk : O_If_Block;
   begin
      Start_If_Stmt (If_Blk, Cond);
      Gen_Bound_Error (Loc);
      Finish_If_Stmt (If_Blk);
   end Check_Bound_Error;

   procedure Check_Direction_Error (Cond : O_Enode; Loc : Iir)
   is
      If_Blk : O_If_Block;
   begin
      Start_If_Stmt (If_Blk, Cond);
      Gen_Direction_Error (Loc);
      Finish_If_Stmt (If_Blk);
   end Check_Direction_Error;

   --  Return TRUE if an array whose index type is RNG_TYPE indexed by
   --  an expression of type EXPR_TYPE needs a bound check.
   function Need_Index_Check (Expr_Type : Iir; Rng_Type : Iir)
                                 return Boolean
   is
      Rng : Iir;
   begin
      --  Do checks if type of the expression is not a subtype.
      --  FIXME: EXPR_TYPE shound not be NULL_IIR (generate stmt)
      if Expr_Type = Null_Iir then
         return True;
      end if;
      case Get_Kind (Expr_Type) is
         when Iir_Kind_Integer_Subtype_Definition
            | Iir_Kind_Enumeration_Subtype_Definition
            | Iir_Kind_Enumeration_Type_Definition =>
            null;
         when others =>
            return True;
      end case;

      --  No check if the expression has the type of the index.
      if Expr_Type = Rng_Type then
         return False;
      end if;

      --  No check for 'Range or 'Reverse_Range.
      Rng := Get_Range_Constraint (Expr_Type);
      if (Get_Kind (Rng) = Iir_Kind_Range_Array_Attribute
          or Get_Kind (Rng) = Iir_Kind_Reverse_Range_Array_Attribute)
        and then Get_Type (Rng) = Rng_Type
      then
         return False;
      end if;

      return True;
   end Need_Index_Check;

   procedure Get_Deep_Range_Expression
     (Atype : Iir; Rng : out Iir; Is_Reverse : out Boolean)
   is
      T : Iir;
      R : Iir;
   begin
      Is_Reverse := False;

      --  T is an integer/enumeration subtype.
      T := Atype;
      loop
         case Get_Kind (T) is
            when Iir_Kind_Integer_Subtype_Definition
               | Iir_Kind_Enumeration_Subtype_Definition
               | Iir_Kind_Enumeration_Type_Definition =>
               --  These types have a range.
               null;
            when others =>
               Error_Kind ("get_deep_range_expression(1)", T);
         end case;

         R := Get_Range_Constraint (T);
         case Get_Kind (R) is
            when Iir_Kind_Range_Expression =>
               Rng := R;
               return;
            when Iir_Kind_Range_Array_Attribute =>
               null;
            when Iir_Kind_Reverse_Range_Array_Attribute =>
               Is_Reverse := not Is_Reverse;
            when others =>
               Error_Kind ("get_deep_range_expression(2)", R);
         end case;
         T := Get_Index_Subtype (R);
         if T = Null_Iir then
            Rng := Null_Iir;
            return;
         end if;
      end loop;
   end Get_Deep_Range_Expression;

   function Translate_Index_To_Offset (Rng        : Mnode;
                                       Index      : O_Enode;
                                       Index_Expr : Iir;
                                       Range_Type : Iir;
                                       Loc        : Iir)
                                          return O_Enode
   is
      Need_Check   : Boolean;
      Dir          : O_Enode;
      If_Blk       : O_If_Block;
      Res          : O_Dnode;
      Off          : O_Dnode;
      Bound        : O_Enode;
      Cond1, Cond2 : O_Enode;
      Index_Node   : O_Dnode;
      Bound_Node   : O_Dnode;
      Index_Info   : Type_Info_Acc;
      Deep_Rng     : Iir;
      Deep_Reverse : Boolean;
   begin
      Index_Info := Get_Info (Get_Base_Type (Range_Type));
      if Index_Expr = Null_Iir then
         Need_Check := True;
         Deep_Rng := Null_Iir;
         Deep_Reverse := False;
      else
         Need_Check := Need_Index_Check (Get_Type (Index_Expr), Range_Type);
         Get_Deep_Range_Expression (Range_Type, Deep_Rng, Deep_Reverse);
      end if;

      Res := Create_Temp (Ghdl_Index_Type);

      Open_Temp;

      Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));

      Bound := M2E (Chap3.Range_To_Left (Rng));

      if Deep_Rng /= Null_Iir then
         if Get_Direction (Deep_Rng) = Iir_To xor Deep_Reverse then
            --  Direction TO:  INDEX - LEFT.
            New_Assign_Stmt (New_Obj (Off),
                             New_Dyadic_Op (ON_Sub_Ov,
                               Index, Bound));
         else
            --  Direction DOWNTO: LEFT - INDEX.
            New_Assign_Stmt (New_Obj (Off),
                             New_Dyadic_Op (ON_Sub_Ov,
                               Bound, Index));
         end if;
      else
         Index_Node := Create_Temp_Init
           (Index_Info.Ortho_Type (Mode_Value), Index);
         Bound_Node := Create_Temp_Init
           (Index_Info.Ortho_Type (Mode_Value), Bound);
         Dir := M2E (Chap3.Range_To_Dir (Rng));

         --  Non-static direction.
         Start_If_Stmt (If_Blk,
                        New_Compare_Op (ON_Eq, Dir,
                          New_Lit (Ghdl_Dir_To_Node),
                          Ghdl_Bool_Type));
         --  Direction TO:  INDEX - LEFT.
         New_Assign_Stmt (New_Obj (Off),
                          New_Dyadic_Op (ON_Sub_Ov,
                            New_Obj_Value (Index_Node),
                            New_Obj_Value (Bound_Node)));
         New_Else_Stmt (If_Blk);
         --  Direction DOWNTO: LEFT - INDEX.
         New_Assign_Stmt (New_Obj (Off),
                          New_Dyadic_Op (ON_Sub_Ov,
                            New_Obj_Value (Bound_Node),
                            New_Obj_Value (Index_Node)));
         Finish_If_Stmt (If_Blk);
      end if;

      --  Get the offset.
      New_Assign_Stmt
        (New_Obj (Res), New_Convert_Ov (New_Obj_Value (Off),
         Ghdl_Index_Type));

      --  Check bounds.
      if Need_Check then
         Cond1 := New_Compare_Op
           (ON_Lt,
            New_Obj_Value (Off),
            New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
              0)),
            Ghdl_Bool_Type);

         Cond2 := New_Compare_Op
           (ON_Ge,
            New_Obj_Value (Res),
            M2E (Chap3.Range_To_Length (Rng)),
            Ghdl_Bool_Type);
         Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
      end if;

      Close_Temp;

      return New_Obj_Value (Res);
   end Translate_Index_To_Offset;

   --  Translate index EXPR in dimension DIM of thin array into an
   --  offset.
   --  This checks bounds.
   function Translate_Thin_Index_Offset (Index_Type : Iir;
                                         Dim        : Natural;
                                         Expr       : Iir)
                                            return O_Enode
   is
      Index_Range     : constant Iir := Get_Range_Constraint (Index_Type);
      Obound          : O_Cnode;
      Res             : O_Dnode;
      Cond2           : O_Enode;
      Index           : O_Enode;
      Index_Base_Type : Iir;
      V               : Iir_Int64;
      B               : Iir_Int64;
   begin
      B := Eval_Pos (Get_Left_Limit (Index_Range));
      if Get_Expr_Staticness (Expr) = Locally then
         V := Eval_Pos (Eval_Static_Expr (Expr));
         if Get_Direction (Index_Range) = Iir_To then
            B := V - B;
         else
            B := B - V;
         end if;
         return New_Lit
           (New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (B)));
      else
         Index_Base_Type := Get_Base_Type (Index_Type);
         Index := Chap7.Translate_Expression (Expr, Index_Base_Type);

         if Get_Direction (Index_Range) = Iir_To then
            --  Direction TO:  INDEX - LEFT.
            if B /= 0 then
               Obound := Chap7.Translate_Static_Range_Left
                 (Index_Range, Index_Base_Type);
               Index := New_Dyadic_Op (ON_Sub_Ov, Index, New_Lit (Obound));
            end if;
         else
            --  Direction DOWNTO:  LEFT - INDEX.
            Obound := Chap7.Translate_Static_Range_Left
              (Index_Range, Index_Base_Type);
            Index := New_Dyadic_Op (ON_Sub_Ov, New_Lit (Obound), Index);
         end if;

         --  Get the offset.
         Index := New_Convert_Ov (Index, Ghdl_Index_Type);

         --  Since the value is unsigned, both left and right bounds are
         --  checked in the same time.
         if Get_Type (Expr) /= Index_Type then
            Res := Create_Temp_Init (Ghdl_Index_Type, Index);

            Cond2 := New_Compare_Op
              (ON_Ge, New_Obj_Value (Res),
               New_Lit (Chap7.Translate_Static_Range_Length (Index_Range)),
               Ghdl_Bool_Type);
            Check_Bound_Error (Cond2, Expr, Dim);
            Index := New_Obj_Value (Res);
         end if;

         return Index;
      end if;
   end Translate_Thin_Index_Offset;

   function Stabilize_If_Unbounded (Val : Mnode) return Mnode is
   begin
      case Get_Type_Info (Val).Type_Mode is
         when Type_Mode_Unbounded_Array
           | Type_Mode_Unbounded_Record =>
            return Stabilize (Val);
         when others =>
            return Val;
      end case;
   end Stabilize_If_Unbounded;

   --  Note: PREFIX must be stabilized if unbounded.
   function Translate_Indexed_Name_Offset (Prefix : Mnode; Expr : Iir)
                                          return O_Dnode
   is
      Prefix_Type : constant Iir := Get_Type (Get_Prefix (Expr));
      Prefix_Info : constant Type_Info_Acc := Get_Info (Prefix_Type);
      Index_List  : constant Iir_Flist := Get_Index_List (Expr);
      Type_List   : constant Iir_Flist := Get_Index_Subtype_List (Prefix_Type);
      Nbr_Dim     : constant Natural := Get_Nbr_Elements (Index_List);
      Index       : Iir;
      Offset      : O_Dnode;
      R           : O_Enode;
      Length      : O_Enode;
      Itype       : Iir;
      Ibasetype   : Iir;
      Range_Ptr   : Mnode;
   begin
      Offset := Create_Temp (Ghdl_Index_Type);
      for Dim in 1 .. Nbr_Dim loop
         Index := Get_Nth_Element (Index_List, Dim - 1);
         Itype := Get_Index_Type (Type_List, Dim - 1);
         Ibasetype := Get_Base_Type (Itype);
         Open_Temp;
         --  Compute index for the current dimension.
         case Prefix_Info.Type_Mode is
            when Type_Mode_Unbounded_Array =>
               Range_Ptr := Stabilize
                 (Chap3.Get_Array_Range (Prefix, Prefix_Type, Dim));
               R := Translate_Index_To_Offset
                 (Range_Ptr,
                  Chap7.Translate_Expression (Index, Ibasetype),
                  Null_Iir, Itype, Index);
            when Type_Mode_Bounded_Arrays =>
               if Prefix_Info.Type_Locally_Constrained then
                  R := Translate_Thin_Index_Offset (Itype, Dim, Index);
               else
                  --  Manually extract range since there is no infos for
                  --   index subtype.
                  Range_Ptr := Chap3.Bounds_To_Range
                    (Chap3.Get_Composite_Type_Bounds (Prefix_Type),
                     Prefix_Type, Dim);
                  Stabilize (Range_Ptr);
                  R := Translate_Index_To_Offset
                    (Range_Ptr,
                     Chap7.Translate_Expression (Index, Ibasetype),
                     Index, Itype, Index);
               end if;
            when others =>
               raise Internal_Error;
         end case;
         if Dim = 1 then
            --  First dimension.
            New_Assign_Stmt (New_Obj (Offset), R);
         else
            --  If there are more dimension(s) to follow, then multiply
            --  the current offset by the length of the current dimension.
            if Prefix_Info.Type_Locally_Constrained then
               Length := New_Lit (Chap7.Translate_Static_Range_Length
                                  (Get_Range_Constraint (Itype)));
            else
               Length := M2E (Chap3.Range_To_Length (Range_Ptr));
            end if;
            New_Assign_Stmt
              (New_Obj (Offset),
               New_Dyadic_Op (ON_Add_Ov,
                              New_Dyadic_Op (ON_Mul_Ov,
                                             New_Obj_Value (Offset),
                                             Length),
                              R));
         end if;
         Close_Temp;
      end loop;

      return Offset;
   end Translate_Indexed_Name_Offset;

   function Translate_Indexed_Name_By_Offset
     (Prefix : Mnode; Prefix_Type : Iir; Offset : O_Dnode) return Mnode
   is
      El_Type  : constant Iir := Get_Element_Subtype (Prefix_Type);
      El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type);
      Kind     : constant Object_Kind_Type := Get_Object_Kind (Prefix);
      Fat_Res : Mnode;
      Base : Mnode;
      Bounds : Mnode;
   begin
      Base := Chap3.Index_Array (Prefix, Prefix_Type, New_Obj_Value (Offset));

      if Is_Unbounded_Type (El_Tinfo) then
         Fat_Res := Create_Temp (El_Tinfo, Kind);
         Bounds := Chap3.Get_Composite_Bounds (Prefix);
         Bounds := Chap3.Array_Bounds_To_Element_Bounds (Bounds, Prefix_Type);

         --  Assignment to M2Lp works as this is not a copy.
         New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Fat_Res)),
                          M2Addr (Bounds));
         New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Base (Fat_Res)),
                          M2Addr (Base));
         return Fat_Res;
      else
         return Base;
      end if;
   end Translate_Indexed_Name_By_Offset;

   function Translate_Indexed_Name (Prefix : Mnode; Expr : Iir) return Mnode
   is
      Offset : O_Dnode;
      Stable_Prefix : Mnode;
   begin
      Stable_Prefix := Stabilize_If_Unbounded (Prefix);
      Offset := Translate_Indexed_Name_Offset (Stable_Prefix, Expr);
      return Translate_Indexed_Name_By_Offset
        (Stable_Prefix, Get_Type (Get_Prefix (Expr)), Offset);
   end Translate_Indexed_Name;

   type Slice_Name_Data is record
      Off    : Unsigned_64;
      Is_Off : Boolean;

      Unsigned_Diff : O_Dnode;

      --  Variable pointing to the prefix.
      Prefix_Var : Mnode;

      --  Variable pointing to slice.
      Slice_Range : Mnode;
   end record;

   procedure Translate_Slice_Name_Init
     (Prefix : Mnode; Expr : Iir_Slice_Name; Data : out Slice_Name_Data)
   is
      --  Type of the prefix.
      Prefix_Type : constant Iir := Get_Type (Get_Prefix (Expr));

      --  Type info of the prefix.
      Prefix_Info : Type_Info_Acc;

      --  Type of the first (and only) index of the prefix array type.
      Index_Type : constant Iir := Get_Index_Type (Prefix_Type, 0);

      --  Type of the slice.
      Slice_Type : constant Iir := Get_Type (Expr);
      Slice_Info : Type_Info_Acc;

      --  True iff the direction of the slice is known at compile time.
      Static_Range : Boolean;

      --  Suffix of the slice (discrete range).
      Expr_Range : constant Iir := Get_Suffix (Expr);

      --  Variable pointing to the prefix.
      Prefix_Var : Mnode;

      --  Type info of the range base type.
      Index_Info : Type_Info_Acc;

      --  Variables pointing to slice and prefix ranges.
      Slice_Range  : Mnode;
      Prefix_Range : Mnode;

      Diff_Type       : O_Tnode;
      Diff            : O_Dnode;
      Unsigned_Diff   : O_Dnode;
      If_Blk, If_Blk1 : O_If_Block;
   begin
      --  Evaluate slice bounds.
      Chap3.Create_Composite_Subtype (Slice_Type);

      --  The info may have just been created.
      Prefix_Info := Get_Info (Prefix_Type);
      Slice_Info := Get_Info (Slice_Type);

      if Slice_Info.Type_Mode = Type_Mode_Static_Array
        and then Slice_Info.Type_Locally_Constrained
        and then Prefix_Info.Type_Mode = Type_Mode_Static_Array
        and then Prefix_Info.Type_Locally_Constrained
      then
         Data.Is_Off := True;
         Data.Prefix_Var := Prefix;

         --  Both prefix and result are constrained array.
         declare
            Index_Range : constant Iir := Get_Range_Constraint (Index_Type);
            Slice_Index_Type : constant Iir := Get_Index_Type (Slice_Type, 0);
            Slice_Range : constant Iir :=
              Get_Range_Constraint (Slice_Index_Type);
            Prefix_Left, Slice_Left : Iir_Int64;
            Off                     : Iir_Int64;
            Slice_Length            : Iir_Int64;
         begin
            Prefix_Left := Eval_Pos (Get_Left_Limit (Index_Range));
            Slice_Left := Eval_Pos (Get_Left_Limit (Slice_Range));
            Slice_Length := Eval_Discrete_Range_Length (Slice_Range);
            if Slice_Length = 0 then
               --  Null slice.
               Data.Off := 0;
               return;
            end if;
            if Get_Direction (Index_Range) /= Get_Direction (Slice_Range)
            then
               --  This is allowed with vhdl87
               Off := 0;
               Slice_Length := 0;
            else
               --  Both prefix and slice are thin array.
               case Get_Direction (Index_Range) is
                  when Iir_To =>
                     Off := Slice_Left - Prefix_Left;
                  when Iir_Downto =>
                     Off := Prefix_Left - Slice_Left;
               end case;
               if Off < 0 then
                  --  Must have been caught by sem.
                  raise Internal_Error;
               end if;
               if Off + Slice_Length
                 > Eval_Discrete_Range_Length (Index_Range)
               then
                  --  Must have been caught by sem.
                  raise Internal_Error;
               end if;
            end if;
            Data.Off := Unsigned_64 (Off);

            return;
         end;
      end if;

      Data.Is_Off := False;

      --  Save prefix.
      Prefix_Var := Stabilize (Prefix);

      Index_Info := Get_Info (Get_Base_Type (Index_Type));

      --  Save prefix bounds.
      Prefix_Range := Stabilize
        (Chap3.Get_Array_Range (Prefix_Var, Prefix_Type, 1));

      --  Save slice bounds.
      Slice_Range := Stabilize
        (Chap3.Bounds_To_Range (Chap3.Get_Composite_Type_Bounds (Slice_Type),
         Slice_Type, 1));

      --  TRUE if the direction of the slice is known.
      Static_Range := Get_Kind (Expr_Range) = Iir_Kind_Range_Expression;

      --  Check direction against same direction, error if different.
      --  FIXME: what about v87 -> if different then null slice
      if not Static_Range
        or else Get_Kind (Prefix_Type) /= Iir_Kind_Array_Subtype_Definition
      then
         --  Check same direction.
         Check_Direction_Error
           (New_Compare_Op (ON_Neq,
                            M2E (Chap3.Range_To_Dir (Prefix_Range)),
                            M2E (Chap3.Range_To_Dir (Slice_Range)),
                            Ghdl_Bool_Type),
            Expr);
      end if;

      Unsigned_Diff := Create_Temp (Ghdl_Index_Type);

      --  Check if not a null slice.
      --  The bounds of a null slice may be out of range.  So DIFF cannot
      --  be computed by substraction.
      Start_If_Stmt
        (If_Blk, New_Compare_Op (ON_Eq,
                                 M2E (Chap3.Range_To_Length (Slice_Range)),
                                 New_Lit (Ghdl_Index_0),
                                 Ghdl_Bool_Type));
      New_Assign_Stmt (New_Obj (Unsigned_Diff), New_Lit (Ghdl_Index_0));
      New_Else_Stmt (If_Blk);

      --  Use a signed intermediate type to do the substraction.  This is
      --  required for enum types.
      case Type_Mode_Discrete (Index_Info.Type_Mode) is
         when Type_Mode_B1
           | Type_Mode_E8
           | Type_Mode_E32
           | Type_Mode_I32 =>
            Diff_Type := Ghdl_I32_Type;
         when Type_Mode_I64 =>
            Diff_Type := Ghdl_I64_Type;
      end case;

      Diff := Create_Temp (Diff_Type);

      --  Compute the offset in the prefix.
      if not Static_Range then
         Start_If_Stmt
           (If_Blk1, New_Compare_Op (ON_Eq,
                                     M2E (Chap3.Range_To_Dir (Slice_Range)),
                                     New_Lit (Ghdl_Dir_To_Node),
                                     Ghdl_Bool_Type));
      end if;
      if not Static_Range or else Get_Direction (Expr_Range) = Iir_To then
         --  Diff = slice - bounds.
         New_Assign_Stmt
           (New_Obj (Diff),
            New_Dyadic_Op
              (ON_Sub_Ov,
               New_Convert_Ov (M2E (Chap3.Range_To_Left (Slice_Range)),
                               Diff_Type),
               New_Convert_Ov (M2E (Chap3.Range_To_Left (Prefix_Range)),
                               Diff_Type)));
      end if;
      if not Static_Range then
         New_Else_Stmt (If_Blk1);
      end if;
      if not Static_Range or else Get_Direction (Expr_Range) = Iir_Downto
      then
         --  Diff = bounds - slice.
         New_Assign_Stmt
           (New_Obj (Diff),
            New_Dyadic_Op
              (ON_Sub_Ov,
               New_Convert_Ov (M2E (Chap3.Range_To_Left (Prefix_Range)),
                               Diff_Type),
               New_Convert_Ov (M2E (Chap3.Range_To_Left (Slice_Range)),
                               Diff_Type)));
      end if;
      if not Static_Range then
         Finish_If_Stmt (If_Blk1);
      end if;

      --  Note: this also check for overflow.
      New_Assign_Stmt
        (New_Obj (Unsigned_Diff),
         New_Convert_Ov (New_Obj_Value (Diff), Ghdl_Index_Type));

      --  Check bounds.
      declare
         Err_1 : O_Enode;
         Err_2 : O_Enode;
      begin
         --  Bounds error if left of slice is before left of prefix.
         Err_1 := New_Compare_Op
           (ON_Lt,
            New_Obj_Value (Diff),
            New_Lit (New_Signed_Literal (Diff_Type, 0)),
            Ghdl_Bool_Type);
         --  Bounds error if right of slice is after right of prefix.
         Err_2 := New_Compare_Op
           (ON_Gt,
            New_Dyadic_Op (ON_Add_Ov,
                           New_Obj_Value (Unsigned_Diff),
                           M2E (Chap3.Range_To_Length (Slice_Range))),
            M2E (Chap3.Range_To_Length (Prefix_Range)),
            Ghdl_Bool_Type);
         Check_Bound_Error (New_Dyadic_Op (ON_Or, Err_1, Err_2), Expr, 1);
      end;
      Finish_If_Stmt (If_Blk);

      Data.Slice_Range := Slice_Range;
      Data.Prefix_Var := Prefix_Var;
      Data.Unsigned_Diff := Unsigned_Diff;
      Data.Is_Off := False;
   end Translate_Slice_Name_Init;

   function Translate_Slice_Name_Finish
     (Prefix : Mnode; Expr : Iir_Slice_Name; Data : Slice_Name_Data)
         return Mnode
   is
      --  Type of the slice.
      Slice_Type : constant Iir := Get_Type (Expr);
      Slice_Info : constant Type_Info_Acc := Get_Info (Slice_Type);

      --  Object kind of the prefix.
      Kind : constant Object_Kind_Type := Get_Object_Kind (Prefix);

      Res_D : O_Dnode;
   begin
      if Data.Is_Off then
         return Chap3.Slice_Base
           (Prefix, Slice_Type, New_Lit (New_Index_Lit (Data.Off)));
      else
         --  Create the result (fat array) and assign the bounds field.
         case Slice_Info.Type_Mode is
            when Type_Mode_Unbounded_Array =>
               Res_D := Create_Temp (Slice_Info.Ortho_Type (Kind));
               New_Assign_Stmt
                 (New_Selected_Element (New_Obj (Res_D),
                  Slice_Info.B.Bounds_Field (Kind)),
                  New_Value (M2Lp (Data.Slice_Range)));
               New_Assign_Stmt
                 (New_Selected_Element (New_Obj (Res_D),
                                        Slice_Info.B.Base_Field (Kind)),
                  M2E (Chap3.Slice_Base
                         (Chap3.Get_Composite_Base (Prefix),
                          Slice_Type,
                          New_Obj_Value (Data.Unsigned_Diff))));
               return Dv2M (Res_D, Slice_Info, Kind);
            when Type_Mode_Bounded_Arrays =>
               return Chap3.Slice_Base
                 (Chap3.Get_Composite_Base (Prefix),
                  Slice_Type,
                  New_Obj_Value (Data.Unsigned_Diff));
            when others =>
               raise Internal_Error;
         end case;
      end if;
   end Translate_Slice_Name_Finish;

   function Translate_Slice_Name (Prefix : Mnode; Expr : Iir_Slice_Name)
                                     return Mnode
   is
      Data : Slice_Name_Data;
   begin
      Translate_Slice_Name_Init (Prefix, Expr, Data);
      return Translate_Slice_Name_Finish (Data.Prefix_Var, Expr, Data);
   end Translate_Slice_Name;

   function Translate_Interface_Name
     (Inter : Iir; Info : Ortho_Info_Acc; Mode : Object_Kind_Type)
     return Mnode
   is
      Type_Info : constant Type_Info_Acc := Get_Info (Get_Type (Inter));
   begin
      case Info.Kind is
         when Kind_Object =>
            --  For a generic.
            pragma Assert (Mode = Mode_Value);
            return Get_Var (Info.Object_Var, Type_Info, Mode);
         when Kind_Signal =>
            --  For a port.
            if Mode = Mode_Signal then
               return Get_Var (Info.Signal_Sig, Type_Info, Mode_Signal);
            else
               pragma Assert (Info.Signal_Valp /= Null_Var);
               if Type_Info.Type_Mode in Type_Mode_Unbounded then
                  return Get_Var (Info.Signal_Valp, Type_Info, Mode_Value);
               else
                  return Get_Varp (Info.Signal_Valp, Type_Info, Mode_Value);
               end if;
            end if;
         when Kind_Interface =>
            --  For a parameter.
            if Info.Interface_Field (Mode) = O_Fnode_Null then
               --  Normal case: the parameter was translated as an ortho
               --  interface.
               case Info.Interface_Mechanism (Mode) is
                  when Pass_By_Copy =>
                     return Dv2M (Info.Interface_Decl (Mode), Type_Info, Mode);
                  when Pass_By_Address =>
                     --  Parameter is passed by reference.
                     return Dp2M (Info.Interface_Decl (Mode), Type_Info, Mode);
               end case;
            else
               --  The parameter was put somewhere else.
               declare
                  Subprg      : constant Iir := Get_Parent (Inter);
                  Subprg_Info : constant Subprg_Info_Acc :=
                    Get_Info (Subprg);
                  Linter      : O_Lnode;
               begin
                  if Info.Interface_Decl (Mode) = O_Dnode_Null then
                     --  The parameter is passed via a field of the PARAMS
                     --  record parameter.
                     if Subprg_Info.Subprg_Params_Var = Null_Var then
                        --  Direct access to the parameter.
                        Linter := New_Obj (Subprg_Info.Res_Interface);
                     else
                        --  Unnesting case: upscope access.
                        Linter := Get_Var (Subprg_Info.Subprg_Params_Var);
                     end if;
                     Linter := New_Selected_Element
                       (New_Acc_Value (Linter), Info.Interface_Field (Mode));
                  else
                     --  Unnesting case: the parameter was copied in the
                     --  subprogram frame so that nested subprograms can
                     --  reference it.  Use field in FRAME.
                     Linter := New_Selected_Element
                       (Get_Instance_Ref (Subprg_Info.Subprg_Frame_Scope),
                        Info.Interface_Field (Mode));
                  end if;
                  case Info.Interface_Mechanism (Mode) is
                     when Pass_By_Copy =>
                        return Lv2M (Linter, Type_Info, Mode);
                     when Pass_By_Address =>
                        return Lp2M (Linter, Type_Info, Mode);
                  end case;
               end;
            end if;
         when others =>
            raise Internal_Error;
      end case;
   end Translate_Interface_Name;

   function Translate_Selected_Element
     (Prefix : Mnode; El : Iir_Element_Declaration) return Mnode
   is
      El_Type       : constant Iir := Get_Type (El);
      El_Tinfo      : constant Type_Info_Acc := Get_Info (El_Type);
      Kind          : constant Object_Kind_Type := Get_Object_Kind (Prefix);
      Base_El       : constant Iir := Get_Base_Element_Declaration (El);
      El_Info       : Field_Info_Acc;
      Base_Tinfo    : Type_Info_Acc;
      Stable_Prefix : Mnode;
      Base, Res, Fat_Res : Mnode;
      Rec_Layout : Mnode;
      El_Descr : Mnode;
      Box_Field : O_Fnode;
      B : O_Lnode;
   begin
      --  There are 3 cases:
      --  a) the record is bounded (and so is the element).
      --  b) the record is unbounded and the element is bounded
      --  c) the record is unbounded and the element is unbounded.
      --  If the record is unbounded, PREFIX is a fat pointer.
      --  On top of that, the element may be complex.

      --  For record subtypes, there is no info for elements that have not
      --  changed.
      El_Info := Get_Info (El);
      if El_Info = null then
         El_Info := Get_Info (Base_El);
      end if;

      if Is_Unbounded_Type (El_Tinfo) then
         Stable_Prefix := Stabilize (Prefix);

         --  Result is a fat pointer, create it and set bounds.
         --  FIXME: layout for record, bounds for array!
         Fat_Res := Create_Temp (El_Tinfo, Kind);
         El_Descr := Chap3.Record_Layout_To_Element_Layout
           (Chap3.Get_Composite_Bounds (Stable_Prefix), El);
         case El_Tinfo.Type_Mode is
            when Type_Mode_Unbounded_Record =>
               null;
            when Type_Mode_Unbounded_Array =>
               El_Descr := Chap3.Layout_To_Bounds (El_Descr);
            when others =>
               raise Internal_Error;
         end case;
         New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Fat_Res)),
                          M2Addr (El_Descr));
      else
         Stable_Prefix := Prefix;
      end if;

      --  Get the base.
      Base := Chap3.Get_Composite_Base (Stable_Prefix);
      Base_Tinfo := Get_Type_Info (Base);
      Box_Field := Base_Tinfo.S.Box_Field (Kind);

      if (Box_Field = O_Fnode_Null
            or else Get_Type_Staticness (El_Type) /= Locally)
        and then (Is_Complex_Type (El_Tinfo) or Is_Unbounded_Type (El_Tinfo))
      then
         Stabilize (Base);

         if Box_Field /= O_Fnode_Null
           and then Get_Type_Staticness (El_Type) /= Locally
         then
            --  Unbox.
            B := New_Selected_Element (M2Lv (Base), Box_Field);
         else
            B := M2Lv (Base);
         end if;

         --  The element is complex: it's an offset.
         Rec_Layout := Chap3.Get_Composite_Bounds (Stable_Prefix);
         Res := E2M
           (New_Unchecked_Address
              (New_Slice
                   (New_Access_Element
                        (New_Unchecked_Address (M2Lv (Base), Char_Ptr_Type)),
                    Chararray_Type,
                    New_Value
                      (Chap3.Record_Layout_To_Element_Offset
                         (Rec_Layout, El, Kind))),
               El_Tinfo.B.Base_Ptr_Type (Kind)),
            El_Tinfo, Kind);
      else
         --  Normal element.
         B := M2Lv (Base);

         if Box_Field /= O_Fnode_Null
           and then El_Type = Get_Type (Base_El)
         then
            --  Unbox.
            B := New_Selected_Element (B, Box_Field);
         end if;

         Res := Lv2M (New_Selected_Element (B, El_Info.Field_Node (Kind)),
                      El_Tinfo, Kind);
      end if;

      if Is_Unbounded_Type (El_Tinfo) then
         --  Ok, we know that Get_Composite_Base doesn't return a copy.
         New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Base (Fat_Res)),
                          M2Addr (Res));
         return Fat_Res;
      else
         return Res;
      end if;
   end Translate_Selected_Element;

   function Translate_Object_Alias_Name (Name : Iir; Mode : Object_Kind_Type)
                                        return Mnode
   is
      Name_Type : constant Iir := Get_Type (Name);
      Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
      Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
      R : O_Lnode;
      pragma Assert (Mode <= Name_Info.Alias_Kind);
   begin
      --  Alias_Var is not like an object variable, since it is
      --  always a pointer to the aliased object.
      case Type_Info.Type_Mode is
         when Type_Mode_Unbounded_Array =>
            --  Get_Var for Mnode is ok here as an unbounded object is always
            --  a pointer (and so is an alias).
            return Get_Var (Name_Info.Alias_Var (Mode), Type_Info, Mode);
         when Type_Mode_Bounded_Arrays
           | Type_Mode_Bounded_Records
           | Type_Mode_Acc
           | Type_Mode_Bounds_Acc =>
            R := Get_Var (Name_Info.Alias_Var (Mode));
            return Lp2M (R, Type_Info, Mode);
         when Type_Mode_Scalar =>
            R := Get_Var (Name_Info.Alias_Var (Mode));
            if Mode = Mode_Signal then
               return Lv2M (R, Type_Info, Mode_Signal);
            else
               return Lp2M (R, Type_Info, Mode_Value);
            end if;
         when others =>
            raise Internal_Error;
      end case;
   end Translate_Object_Alias_Name;

   function Translate_Name (Name : Iir; Mode : Object_Kind_Type) return Mnode
   is
      Name_Type : constant Iir := Get_Type (Name);
      Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
      Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
   begin
      case Get_Kind (Name) is
         when Iir_Kind_Constant_Declaration
           | Iir_Kind_Variable_Declaration
           | Iir_Kind_File_Declaration =>
            pragma Assert (Mode = Mode_Value);
            return Get_Var (Name_Info.Object_Var, Type_Info, Mode_Value);

         when Iir_Kind_Attribute_Name =>
            return Translate_Name (Get_Named_Entity (Name), Mode);
         when Iir_Kind_Attribute_Value =>
            pragma Assert (Mode = Mode_Value);
            declare
               Attr : constant Iir := Get_Attribute_Specification (Name);
               Val : Iir;
            begin
               if Get_Expr_Staticness (Get_Expression (Attr)) = None then
                  Val := Name;
               else
                  --  If the expression is static, an object is created only
                  --  for the first value.
                  Val := Get_Attribute_Value_Spec_Chain (Attr);
               end if;
               return Get_Var (Get_Info (Val).Object_Var,
                               Type_Info, Mode_Value);
            end;

         when Iir_Kind_Object_Alias_Declaration =>
            --  Alias_Var is not like an object variable, since it is
            --  always a pointer to the aliased object.
            declare
               R : O_Lnode;
            begin
               pragma Assert (Mode <= Name_Info.Alias_Kind);
               case Type_Info.Type_Mode is
                  when Type_Mode_Unbounded_Array =>
                     return Get_Var (Name_Info.Alias_Var (Mode), Type_Info,
                                     Mode);
                  when Type_Mode_Bounded_Arrays
                     | Type_Mode_Bounded_Records
                     | Type_Mode_Acc
                     | Type_Mode_Bounds_Acc =>
                     R := Get_Var (Name_Info.Alias_Var (Mode));
                     return Lp2M (R, Type_Info, Mode);
                  when Type_Mode_Scalar =>
                     R := Get_Var (Name_Info.Alias_Var (Mode));
                     if Mode = Mode_Signal then
                        return Lv2M (R, Type_Info, Mode_Signal);
                     else
                        return Lp2M (R, Type_Info, Mode_Value);
                     end if;
                  when others =>
                     raise Internal_Error;
               end case;
            end;

         when Iir_Kind_Signal_Declaration
           | Iir_Kind_Stable_Attribute
           | Iir_Kind_Quiet_Attribute
           | Iir_Kind_Delayed_Attribute
           | Iir_Kind_Transaction_Attribute
           | Iir_Kind_Guard_Signal_Declaration =>
            if Mode = Mode_Signal then
               return Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal);
            else
               return Get_Var (Name_Info.Signal_Val, Type_Info, Mode_Value);
            end if;

         when Iir_Kind_Interface_Constant_Declaration
           | Iir_Kind_Interface_File_Declaration
           | Iir_Kind_Interface_Variable_Declaration =>
            pragma Assert (Mode = Mode_Value);
            return Translate_Interface_Name (Name, Name_Info, Mode_Value);

         when Iir_Kind_Interface_Signal_Declaration =>
            return Translate_Interface_Name (Name, Name_Info, Mode);

         when Iir_Kind_Indexed_Name =>
            return Translate_Indexed_Name
              (Translate_Name (Get_Prefix (Name), Mode), Name);

         when Iir_Kind_Slice_Name =>
            return Translate_Slice_Name
              (Translate_Name (Get_Prefix (Name), Mode), Name);

         when Iir_Kind_Dereference
           | Iir_Kind_Implicit_Dereference =>
            pragma Assert (Mode = Mode_Value);
            declare
               Prefix : constant Iir := Get_Prefix (Name);
               Prefix_Type : constant Iir := Get_Type (Prefix);
               Pt_Info : constant Type_Info_Acc := Get_Info (Prefix_Type);
               Pfx : O_Enode;
               Pfx_Var : O_Dnode;
            begin
               Pfx := Chap7.Translate_Expression (Prefix);
               if Pt_Info.Type_Mode = Type_Mode_Bounds_Acc then
                  Pfx_Var := Create_Temp_Init
                    (Pt_Info.Ortho_Type (Mode_Value), Pfx);
                  return Chap7.Bounds_Acc_To_Fat_Pointer
                    (Pfx_Var, Prefix_Type);
               else
                  return Lv2M
                    (New_Access_Element
                       (New_Convert_Ov
                          (Pfx, Type_Info.Ortho_Ptr_Type (Mode_Value))),
                     Type_Info, Mode_Value);
               end if;
            end;

         when Iir_Kind_Selected_Element =>
            return Translate_Selected_Element
              (Translate_Name (Get_Prefix (Name), Mode),
               Get_Named_Entity (Name));

         when Iir_Kind_Function_Call =>
            pragma Assert (Mode = Mode_Value);
            --  This can appear as a prefix of a name, therefore, the
            --  result is always a composite type or an access type.
            return Chap7.Translate_Expression (Name);

         when Iir_Kind_Image_Attribute =>
            pragma Assert (Mode = Mode_Value);
            --  Can appear as a prefix.
            return E2M (Chap14.Translate_Image_Attribute (Name),
                        Type_Info, Mode_Value);

         when Iir_Kind_Simple_Name
            | Iir_Kind_Selected_Name =>
            return Translate_Name (Get_Named_Entity (Name), Mode);

         when others =>
            Error_Kind ("translate_name", Name);
      end case;
   end Translate_Name;

   function Get_Signal_Direct_Driver (Sig : Iir) return Mnode
   is
      Info : constant Ortho_Info_Acc := Get_Info (Sig);
      Type_Info : constant Type_Info_Acc := Get_Info (Get_Type (Sig));
   begin
      return Get_Var (Info.Signal_Driver, Type_Info, Mode_Value);
   end Get_Signal_Direct_Driver;

   function Get_Port_Init_Value (Port : Iir) return Mnode
   is
      Info : constant Ortho_Info_Acc := Get_Info (Port);
      Type_Info : constant Type_Info_Acc := Get_Info (Get_Type (Port));
   begin
      return Get_Var (Info.Signal_Val, Type_Info, Mode_Value);
   end Get_Port_Init_Value;

   generic
      with procedure Translate_Signal_Base
        (Name : Iir; Sig : out Mnode; Drv : out Mnode);
   procedure Translate_Signal (Name : Iir; Sig : out Mnode; Drv : out Mnode);

   procedure Translate_Signal (Name : Iir; Sig : out Mnode; Drv : out Mnode) is
   begin
      case Get_Kind (Name) is
         when Iir_Kind_Simple_Name
            | Iir_Kind_Selected_Name =>
            Translate_Signal (Get_Named_Entity (Name), Sig, Drv);
         when Iir_Kind_Signal_Declaration
           | Iir_Kind_Interface_Signal_Declaration
           | Iir_Kind_Stable_Attribute
           | Iir_Kind_Quiet_Attribute
           | Iir_Kind_Delayed_Attribute
           | Iir_Kind_Transaction_Attribute
           | Iir_Kind_Guard_Signal_Declaration
           | Iir_Kind_Object_Alias_Declaration =>
            Translate_Signal_Base (Name, Sig, Drv);
         when Iir_Kind_Slice_Name =>
            declare
               Data    : Slice_Name_Data;
               Pfx_Sig : Mnode;
               Pfx_Drv : Mnode;
            begin
               Translate_Signal (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
               Translate_Slice_Name_Init (Pfx_Sig, Name, Data);
               Sig := Translate_Slice_Name_Finish
                 (Data.Prefix_Var, Name, Data);
               Drv := Translate_Slice_Name_Finish
                 (Pfx_Drv, Name, Data);
            end;
         when Iir_Kind_Indexed_Name =>
            declare
               Prefix  : constant Iir := Get_Prefix (Name);
               Prefix_Type : constant Iir := Get_Type (Prefix);
               Offset  : O_Dnode;
               Pfx_Sig : Mnode;
               Pfx_Drv : Mnode;
            begin
               Translate_Signal (Prefix, Pfx_Sig, Pfx_Drv);
               Pfx_Sig := Stabilize_If_Unbounded (Pfx_Sig);
               Offset := Translate_Indexed_Name_Offset (Pfx_Sig, Name);
               Sig := Translate_Indexed_Name_By_Offset
                 (Pfx_Sig, Prefix_Type, Offset);
               Drv := Translate_Indexed_Name_By_Offset
                 (Pfx_Drv, Prefix_Type, Offset);
            end;
         when Iir_Kind_Selected_Element =>
            declare
               El      : constant Iir := Get_Named_Entity (Name);
               Pfx_Sig : Mnode;
               Pfx_Drv : Mnode;
            begin
               Translate_Signal (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
               Sig := Translate_Selected_Element (Pfx_Sig, El);
               Drv := Translate_Selected_Element (Pfx_Drv, El);
            end;
         when others =>
            Error_Kind ("translate_signal", Name);
      end case;
   end Translate_Signal;

   procedure Translate_Direct_Driver_Base
     (Name : Iir; Sig : out Mnode; Drv : out Mnode) is
   begin
      case Get_Kind (Name) is
         when Iir_Kind_Signal_Declaration
           | Iir_Kind_Interface_Signal_Declaration =>
            declare
               Name_Type : constant Iir := Get_Type (Name);
               Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
               Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
            begin
               Sig := Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal);
               Drv := Get_Var (Name_Info.Signal_Driver, Type_Info, Mode_Value);
            end;
         when Iir_Kind_Object_Alias_Declaration =>
            Translate_Direct_Driver (Get_Name (Name), Sig, Drv);
         when others =>
            Error_Kind ("translate_direct_driver_base", Name);
      end case;
   end Translate_Direct_Driver_Base;

   procedure Translate_Direct_Driver_1 is new
     Translate_Signal (Translate_Signal_Base => Translate_Direct_Driver_Base);

   procedure Translate_Direct_Driver
     (Name : Iir; Sig : out Mnode; Drv : out Mnode)
     renames Translate_Direct_Driver_1;

   procedure Translate_Port_Init_Base
     (Name : Iir; Sig : out Mnode; Drv : out Mnode)
   is
      Name_Type : constant Iir := Get_Type (Name);
      Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
      Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
   begin
      case Get_Kind (Name) is
         when Iir_Kind_Interface_Signal_Declaration =>
            Sig := Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal);
            Drv := Get_Var (Name_Info.Signal_Val, Type_Info, Mode_Value);
         when others =>
            Error_Kind ("translate_direct_driver_base", Name);
      end case;
   end Translate_Port_Init_Base;

   procedure Translate_Port_Init_1 is new
     Translate_Signal (Translate_Signal_Base => Translate_Port_Init_Base);

   procedure Translate_Port_Init
     (Name : Iir; Sig : out Mnode; Init : out Mnode)
     renames Translate_Port_Init_1;

   procedure Translate_Signal_Base
     (Name : Iir; Sig : out Mnode; Val : out Mnode)
   is
      Name_Type : constant Iir := Get_Type (Name);
      Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
      Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
   begin
      case Get_Kind (Name) is
         when Iir_Kind_Signal_Declaration
           | Iir_Kind_Stable_Attribute
           | Iir_Kind_Quiet_Attribute
           | Iir_Kind_Delayed_Attribute
           | Iir_Kind_Transaction_Attribute
           | Iir_Kind_Guard_Signal_Declaration =>
            Sig := Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal);
            Val := Get_Var (Name_Info.Signal_Val, Type_Info, Mode_Value);
         when Iir_Kind_Interface_Signal_Declaration =>
            Sig := Translate_Interface_Name (Name, Name_Info, Mode_Signal);
            Val := Translate_Interface_Name (Name, Name_Info, Mode_Value);
         when Iir_Kind_Object_Alias_Declaration =>
            Sig := Translate_Object_Alias_Name (Name, Mode_Signal);
            Val := Translate_Object_Alias_Name (Name, Mode_Value);
         when others =>
            Error_Kind ("translate_signal_base", Name);
      end case;
   end Translate_Signal_Base;

   procedure Translate_Signal_Name_1 is new
     Translate_Signal (Translate_Signal_Base);

   procedure Translate_Signal_Name
     (Name : Iir; Sig : out Mnode; Val : out Mnode)
     renames Translate_Signal_Name_1;
end Trans.Chap6;