Add overflow literal.

8 files changed, 157 insertions, 114 deletions

diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb
index 7169fa32a..6459f70dd 100644
--- a/translate/ghdldrv/ghdllocal.adb
+++ b/translate/ghdldrv/ghdllocal.adb
@@ -34,6 +34,7 @@ with Files_Map;
 with Post_Sems;
 with Disp_Tree;
 with Options;
+with Iirs_Utils; use Iirs_Utils;
 
 package body Ghdllocal is
    --  Version of the IEEE library to use.  This just change pathes.
@@ -273,12 +274,12 @@ package body Ghdllocal is
       case Get_Kind (Unit) is
          when Iir_Kind_Architecture_Body =>
             Put (" of ");
-            Image (Get_Identifier (Get_Entity (Unit)));
+            Image (Get_Entity_Identifier_Of_Architecture (Unit));
             Put (Name_Buffer (1 .. Name_Length));
          when Iir_Kind_Configuration_Declaration =>
             if Id = Null_Identifier then
                Put ("<default> of entity ");
-               Image (Get_Identifier (Get_Library_Unit (Get_Entity (Unit))));
+               Image (Get_Entity_Identifier_Of_Architecture (Unit));
                Put (Name_Buffer (1 .. Name_Length));
             end if;
          when others =>
@@ -580,7 +581,7 @@ package body Ghdllocal is
       return "-s [OPTS] FILEs    Check syntax of FILEs";
    end Get_Short_Help;
 
-   procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean)
+   function Analyze_One_File (File_Name : String) return Iir_Design_File
    is
       use Ada.Text_IO;
       Id : Name_Id;
@@ -588,40 +589,52 @@ package body Ghdllocal is
       Unit : Iir;
       Next_Unit : Iir;
    begin
-      Setup_Libraries (True);
+      Id := Name_Table.Get_Identifier (File_Name);
+      if Flag_Verbose then
+         Put (File_Name);
+         Put_Line (":");
+      end if;
+      Design_File := Libraries.Load_File (Id);
+      if Design_File = Null_Iir then
+         raise Errorout.Compilation_Error;
+      end if;
 
-      --  Parse all files.
-      for I in Files'Range loop
-         Id := Name_Table.Get_Identifier (Files (I).all);
+      Unit := Get_First_Design_Unit (Design_File);
+      while Unit /= Null_Iir loop
          if Flag_Verbose then
-            Put (Files (I).all);
-            Put_Line (":");
+            Put (' ');
+            Disp_Library_Unit (Get_Library_Unit (Unit));
+            New_Line;
          end if;
-         Design_File := Libraries.Load_File (Id);
-         if Design_File /= Null_Iir then
-            Unit := Get_First_Design_Unit (Design_File);
-            while Unit /= Null_Iir loop
-               if Flag_Verbose then
-                  Put (' ');
-                  Disp_Library_Unit (Get_Library_Unit (Unit));
-                  New_Line;
-               end if;
-               -- Sem, canon, annotate a design unit.
-               Back_End.Finish_Compilation (Unit, True);
+         -- Sem, canon, annotate a design unit.
+         Back_End.Finish_Compilation (Unit, True);
 
-               Next_Unit := Get_Chain (Unit);
-               if Errorout.Nbr_Errors = 0 then
-                  Set_Chain (Unit, Null_Iir);
-                  Libraries.Add_Design_Unit_Into_Library (Unit);
-               end if;
+         Next_Unit := Get_Chain (Unit);
+         if Errorout.Nbr_Errors = 0 then
+            Set_Chain (Unit, Null_Iir);
+            Libraries.Add_Design_Unit_Into_Library (Unit);
+         end if;
 
-               Unit := Next_Unit;
-            end loop;
+         Unit := Next_Unit;
+      end loop;
 
-            if Errorout.Nbr_Errors > 0 then
-               raise Errorout.Compilation_Error;
-            end if;
-         end if;
+      if Errorout.Nbr_Errors > 0 then
+         raise Errorout.Compilation_Error;
+      end if;
+
+      return Design_File;
+   end Analyze_One_File;
+
+   procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean)
+   is
+      Design_File : Iir_Design_File;
+      pragma Unreferenced (Design_File);
+   begin
+      Setup_Libraries (True);
+
+      --  Parse all files.
+      for I in Files'Range loop
+         Design_File := Analyze_One_File (Files (I).all);
       end loop;
 
       if Save_Library then
@@ -694,7 +707,6 @@ package body Ghdllocal is
       File : Iir_Design_File;
       Design_Unit : Iir_Design_Unit;
       Lib_Unit : Iir;
-      Ent_Unit : Iir;
       Str : String_Access;
    begin
       if Args'Length /= 0 then
@@ -722,10 +734,10 @@ package body Ghdllocal is
                  | Iir_Kind_Configuration_Declaration =>
                   Delete_Top_Unit (Image (Get_Identifier (Lib_Unit)));
                when Iir_Kind_Architecture_Body =>
-                  Ent_Unit := Get_Entity (Lib_Unit);
-                  Delete_Top_Unit (Image (Get_Identifier (Ent_Unit))
-                                   & '-'
-                                   & Image (Get_Identifier (Lib_Unit)));
+                  Delete_Top_Unit
+                    (Image (Get_Entity_Identifier_Of_Architecture (Lib_Unit))
+                       & '-'
+                       & Image (Get_Identifier (Lib_Unit)));
                when others =>
                   null;
             end case;
diff --git a/translate/ghdldrv/ghdllocal.ads b/translate/ghdldrv/ghdllocal.ads
index 46eff1a14..f197038c3 100644
--- a/translate/ghdldrv/ghdllocal.ads
+++ b/translate/ghdldrv/ghdllocal.ads
@@ -84,6 +84,10 @@ package Ghdllocal is
    --  Setup standard libaries path.  If LOAD is true, then load them now.
    procedure Setup_Libraries (Load : Boolean);
 
+   --  Analyze file FILE_NAME.  Raise Compilation_Error in case of analysis
+   --  error.
+   function Analyze_One_File (File_Name : String) return Iir_Design_File;
+
    --  Setup library, analyze FILES, and if SAVE_LIBRARY is set save the
    --  work library only
    procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean);
diff --git a/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb
index 0b775760e..214f03009 100644
--- a/translate/ghdldrv/ghdlprint.adb
+++ b/translate/ghdldrv/ghdlprint.adb
@@ -26,12 +26,14 @@ with Files_Map;
 with Libraries;
 with Errorout; use Errorout;
 with Iirs; use Iirs;
+with Iirs_Utils; use Iirs_Utils;
 with Tokens;
 with Scanner;
 with Version;
 with Xrefs;
 with Ghdlmain; use Ghdlmain;
 with Ghdllocal; use Ghdllocal;
+with Disp_Vhdl;
 
 package body Ghdlprint is
    type Html_Format_Type is (Html_2, Html_Css);
@@ -566,7 +568,7 @@ package body Ghdlprint is
             when Iir_Kind_Package_Body =>
                Len := Len + 1 + 4; -- add -body
             when Iir_Kind_Architecture_Body =>
-               Id1 := Get_Identifier (Get_Entity (Lib));
+               Id1 := Get_Entity_Identifier_Of_Architecture (Lib);
                Len := Len + 1 + Get_Name_Length (Id1);
             when others =>
                Error_Kind ("build_file_name", Lib);
@@ -599,7 +601,7 @@ package body Ghdlprint is
                Append (Name_Buffer (1 .. Name_Length));
                Append ("-body");
             when Iir_Kind_Architecture_Body =>
-               Image (Get_Identifier (Get_Entity (Lib)));
+               Image (Get_Entity_Identifier_Of_Architecture (Lib));
                Append (Name_Buffer (1 .. Name_Length));
                Append ("-");
                Image (Id);
@@ -938,6 +940,50 @@ package body Ghdlprint is
       end loop;
    end Perform_Action;
 
+   --  Command Reprint.
+   type Command_Reprint is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Reprint; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Reprint) return String;
+   procedure Perform_Action (Cmd : in out Command_Reprint;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Reprint; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--reprint";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Reprint) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--reprint [OPTS] FILEs    Redisplay FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Reprint;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+   begin
+      Setup_Libraries (True);
+
+      --  Parse all files.
+      for I in Args'Range loop
+         Design_File := Analyze_One_File (Args (I).all);
+         Unit := Get_First_Design_Unit (Design_File);
+         while Unit /= Null_Iir loop
+            Disp_Vhdl.Disp_Vhdl (Unit);
+            Unit := Get_Chain (Unit);
+         end loop;
+      end loop;
+   end Perform_Action;
+
+   --  Command html.
    type Command_Html is abstract new Command_Lib with null record;
 
    procedure Decode_Option (Cmd : in out Command_Html;
@@ -1569,6 +1615,7 @@ package body Ghdlprint is
    begin
       Register_Command (new Command_Chop);
       Register_Command (new Command_Lines);
+      Register_Command (new Command_Reprint);
       Register_Command (new Command_PP_Html);
       Register_Command (new Command_Xref_Html);
       Register_Command (new Command_Xref);
diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb
index 676c82824..cded35158 100644
--- a/translate/ghdldrv/ghdlrun.adb
+++ b/translate/ghdldrv/ghdlrun.adb
@@ -240,8 +240,6 @@ package body Ghdlrun is
 
       Def (Trans_Decls.Ghdl_Memcpy,
            Grt.Lib.Ghdl_Memcpy'Address);
-      Def (Trans_Decls.Ghdl_Bound_Check_Failed_L0,
-           Grt.Lib.Ghdl_Bound_Check_Failed_L0'Address);
       Def (Trans_Decls.Ghdl_Bound_Check_Failed_L1,
            Grt.Lib.Ghdl_Bound_Check_Failed_L1'Address);
       Def (Trans_Decls.Ghdl_Malloc0,
diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb
index fcbbecb64..3c10417aa 100644
--- a/translate/grt/grt-lib.adb
+++ b/translate/grt/grt-lib.adb
@@ -188,13 +188,6 @@ package body Grt.Lib is
       Error_E ("");
    end Ghdl_Program_Error;
 
-   procedure Ghdl_Bound_Check_Failed_L0 (Number : Ghdl_Index_Type) is
-   begin
-      Error_C ("bound check failed (#");
-      Error_C (Integer (Number));
-      Error_E (")");
-   end Ghdl_Bound_Check_Failed_L0;
-
    procedure Ghdl_Bound_Check_Failed_L1 (Filename : Ghdl_C_String;
                                          Line: Ghdl_I32)
    is
diff --git a/translate/grt/grt-lib.ads b/translate/grt/grt-lib.ads
index 580406dcc..2c75a90e4 100644
--- a/translate/grt/grt-lib.ads
+++ b/translate/grt/grt-lib.ads
@@ -67,7 +67,6 @@ package Grt.Lib is
    Error_Severity   : constant Integer := 2;
    Failure_Severity : constant Integer := 3;
 
-   procedure Ghdl_Bound_Check_Failed_L0 (Number : Ghdl_Index_Type);
    procedure Ghdl_Bound_Check_Failed_L1 (Filename : Ghdl_C_String;
                                          Line: Ghdl_I32);
 
@@ -113,8 +112,6 @@ private
    pragma Export (C, Ghdl_Psl_Cover_Failed, "__ghdl_psl_cover_failed");
    pragma Export (C, Ghdl_Report, "__ghdl_report");
 
-   pragma Export (C, Ghdl_Bound_Check_Failed_L0,
-                  "__ghdl_bound_check_failed_l0");
    pragma Export (C, Ghdl_Bound_Check_Failed_L1,
                   "__ghdl_bound_check_failed_l1");
    pragma Export (C, Ghdl_Program_Error, "__ghdl_program_error");
diff --git a/translate/trans_decls.ads b/translate/trans_decls.ads
index 9226c582c..20cc445fe 100644
--- a/translate/trans_decls.ads
+++ b/translate/trans_decls.ads
@@ -160,7 +160,6 @@ package Trans_Decls is
 
    --  Procedure called in case of check failed.
    Ghdl_Program_Error : O_Dnode;
-   Ghdl_Bound_Check_Failed_L0 : O_Dnode;
    Ghdl_Bound_Check_Failed_L1 : O_Dnode;
 
    --  Stack 2.
diff --git a/translate/translation.adb b/translate/translation.adb
index 270c707cd..98cf8bccd 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -2008,9 +2008,10 @@ package body Translation is
       --  RANGE_PTR from length LENGTH, which is of type INDEX_TYPE.
       --  This is done according to rules 7.2.4 of LRM93, ie:
       --  direction and left bound of the range is the same of INDEX_TYPE.
-      --  LENGTH and RANGE_PTR are variables.
+      --  LENGTH and RANGE_PTR are variables. LOC is the location in case of
+      --  error.
       procedure Create_Range_From_Length
-        (Index_Type : Iir; Length : O_Dnode; Range_Ptr : O_Dnode);
+        (Index_Type : Iir; Length : O_Dnode; Range_Ptr : O_Dnode; Loc : Iir);
 
    end Chap3;
 
@@ -2330,12 +2331,13 @@ package body Translation is
       procedure Translate_Implicit_Subprogram
         (Subprg : Iir; Infos : in out Implicit_Subprogram_Infos);
 
-      --  Assign EXPR to TARGET.
+      --  Assign EXPR to TARGET.  LOC is the location used to report errors.
       --  FIXME: do the checks.
       procedure Translate_Assign
         (Target : Mnode; Expr : Iir; Target_Type : Iir);
       procedure Translate_Assign
-        (Target : Mnode; Val: O_Enode; Expr : Iir; Target_Type : Iir);
+        (Target : Mnode;
+         Val: O_Enode; Expr : Iir; Target_Type : Iir; Loc : Iir);
 
       --  Find the declaration of the predefined function IMP in type
       --  definition BASE_TYPE.
@@ -9228,7 +9230,7 @@ package body Translation is
       end Create_Range_From_Array_Attribute_And_Length;
 
       procedure Create_Range_From_Length
-        (Index_Type : Iir; Length : O_Dnode; Range_Ptr : O_Dnode)
+        (Index_Type : Iir; Length : O_Dnode; Range_Ptr : O_Dnode; Loc : Iir)
       is
          Iinfo : Type_Info_Acc;
          Op : ON_Op_Kind;
@@ -9294,7 +9296,7 @@ package body Translation is
                           New_Dyadic_Op (Op, Left_Bound, Diff));
 
          --   Check the right bounds is inside the bounds of the index type.
-         Chap3.Check_Range (Var_Right, Null_Iir, Index_Type, Null_Iir);
+         Chap3.Check_Range (Var_Right, Null_Iir, Index_Type, Loc);
          New_Assign_Stmt
            (New_Selected_Acc_Value (New_Obj (Range_Ptr), Iinfo.T.Range_Right),
             New_Obj_Value (Var_Right));
@@ -9378,9 +9380,7 @@ package body Translation is
                   --  Not a full constant declaration (ie a value for an
                   --   already declared constant).
                   --  Must create the declaration.
-                  if Get_Expr_Staticness (El) = Locally
-                    or else Chap7.Is_Static_Constant (El)
-                  then
+                  if Chap7.Is_Static_Constant (El) then
                      Info.Object_Static := True;
                      Info.Object_Var := Create_Global_Const
                        (Create_Identifier (El), Obj_Type, Global_Storage,
@@ -11179,7 +11179,7 @@ package body Translation is
 
          --  Create range from length
          Chap3.Create_Range_From_Length
-           (Index_Type, Var_Length, Var_Range_Ptr);
+           (Index_Type, Var_Length, Var_Range_Ptr, Func);
          New_Assign_Stmt
            (New_Selected_Element (New_Obj (Var_Array),
                                   Base_Info.T.Bounds_Field (Mode_Value)),
@@ -12762,30 +12762,17 @@ package body Translation is
          end case;
       end Get_Array_Ptr_Bound_Length;
 
-      --  There is a uniq number associated which each error.
-      Bound_Error_Number : Unsigned_64 := 0;
-
       procedure Gen_Bound_Error (Loc : Iir)
       is
          Constr : O_Assoc_List;
          Name : Name_Id;
          Line, Col : Natural;
       begin
-         if Loc /= Null_Iir then
-            Files_Map.Location_To_Position
-              (Get_Location (Loc), Name, Line, Col);
+         Files_Map.Location_To_Position (Get_Location (Loc), Name, Line, Col);
 
-            Start_Association (Constr, Ghdl_Bound_Check_Failed_L1);
-            Assoc_Filename_Line (Constr, Line);
-            New_Procedure_Call (Constr);
-         else
-            Start_Association (Constr, Ghdl_Bound_Check_Failed_L0);
-            New_Association
-              (Constr, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
-                                                      Bound_Error_Number)));
-            New_Procedure_Call (Constr);
-            Bound_Error_Number := Bound_Error_Number + 1;
-         end if;
+         Start_Association (Constr, Ghdl_Bound_Check_Failed_L1);
+         Assoc_Filename_Line (Constr, Line);
+         New_Procedure_Call (Constr);
       end Gen_Bound_Error;
 
       procedure Gen_Program_Error (Loc : Iir; Code : Natural)
@@ -13816,21 +13803,21 @@ package body Translation is
       function Is_Static_Constant (Decl : Iir_Constant_Declaration)
                                   return Boolean
       is
-         Expr : Iir;
+         Expr : constant Iir := Get_Default_Value (Decl);
          Atype : Iir;
          Info : Iir;
       begin
-         if Get_Expr_Staticness (Decl) = Locally then
-            --  Should be not necessary.
-            return True;
-         end if;
-
-         Expr := Get_Default_Value (Decl);
-         if Expr = Null_Iir then
+         if Expr = Null_Iir
+           or else Get_Kind (Expr) = Iir_Kind_Overflow_Literal
+         then
             --  Deferred constant.
             return False;
          end if;
 
+         if Get_Expr_Staticness (Decl) = Locally then
+            return True;
+         end if;
+
          --  Only aggregates are handled.
          if Get_Kind (Expr) /= Iir_Kind_Aggregate then
             return False;
@@ -14376,9 +14363,8 @@ package body Translation is
       function Translate_Static_Expression (Expr : Iir; Res_Type : Iir)
         return O_Cnode
       is
-         Expr_Type : Iir;
+         Expr_Type : constant Iir := Get_Type (Expr);
       begin
-         Expr_Type := Get_Type (Expr);
          case Get_Kind (Expr) is
             when Iir_Kind_Integer_Literal
               | Iir_Kind_Enumeration_Literal
@@ -15395,7 +15381,8 @@ package body Translation is
 
       --  Assign EXPR to TARGET.
       procedure Translate_Assign
-        (Target : Mnode; Val : O_Enode; Expr : Iir; Target_Type : Iir)
+        (Target : Mnode;
+         Val : O_Enode; Expr : Iir; Target_Type : Iir; Loc : Iir)
       is
          T_Info : constant Type_Info_Acc := Get_Info (Target_Type);
       begin
@@ -15427,8 +15414,7 @@ package body Translation is
                     (T_Info.Ortho_Ptr_Type (Mode_Value), Val);
                   Chap3.Check_Array_Match
                     (Target_Type, T,
-                     Get_Type (Expr), Dp2M (E, T_Info, Mode_Value),
-                     Null_Iir);
+                     Get_Type (Expr), Dp2M (E, T_Info, Mode_Value), Loc);
                   Chap3.Translate_Object_Copy
                     (T, New_Obj_Value (E), Target_Type);
                end;
@@ -15455,7 +15441,7 @@ package body Translation is
          else
             Open_Temp;
             Val := Chap7.Translate_Expression (Expr, Target_Type);
-            Translate_Assign (Target, Val, Expr, Target_Type);
+            Translate_Assign (Target, Val, Expr, Target_Type, Expr);
             Close_Temp;
          end if;
       end Translate_Assign;
@@ -16176,11 +16162,9 @@ package body Translation is
         (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
         return O_Enode
       is
-         Res_Info : Type_Info_Acc;
-         Expr_Info : Type_Info_Acc;
+         Res_Info : constant Type_Info_Acc := Get_Info (Res_Type);
+         Expr_Info : constant Type_Info_Acc := Get_Info (Expr_Type);
       begin
-         Res_Info := Get_Info (Res_Type);
-         Expr_Info := Get_Info (Expr_Type);
          case Res_Info.Type_Mode is
             when Type_Mode_Array =>
                declare
@@ -16672,13 +16656,11 @@ package body Translation is
 
             when Iir_Kind_Null_Literal =>
                declare
+                  Tinfo : constant Type_Info_Acc := Get_Info (Expr_Type);
+                  Otype : constant O_Tnode := Tinfo.Ortho_Type (Mode_Value);
                   L : O_Dnode;
-                  Otype : O_Tnode;
                   B : Type_Info_Acc;
-                  Tinfo : Type_Info_Acc;
                begin
-                  Tinfo := Get_Info (Expr_Type);
-                  Otype := Tinfo.Ortho_Type (Mode_Value);
                   if Tinfo.Type_Mode = Type_Mode_Fat_Acc then
                      --  Create a fat null pointer.
                      --  FIXME: should be optimized!!
@@ -16700,6 +16682,25 @@ package body Translation is
                   end if;
                end;
 
+            when Iir_Kind_Overflow_Literal =>
+               declare
+                  Tinfo : constant Type_Info_Acc := Get_Info (Expr_Type);
+                  Otype : constant O_Tnode := Tinfo.Ortho_Type (Mode_Value);
+                  L : O_Dnode;
+               begin
+                  --  Generate the error message
+                  Chap6.Gen_Bound_Error (Expr);
+
+                  --  Create a dummy value
+                  L := Create_Temp (Otype);
+                  if Tinfo.Type_Mode = Type_Mode_Fat_Acc then
+                     return New_Address (New_Obj (L),
+                                         Tinfo.Ortho_Ptr_Type (Mode_Value));
+                  else
+                     return New_Obj_Value (L);
+                  end if;
+               end;
+
             when Iir_Kind_Allocator_By_Expression =>
                return Translate_Allocator_By_Expression (Expr);
             when Iir_Kind_Allocator_By_Subtype =>
@@ -17819,7 +17820,7 @@ package body Translation is
                  (New_Obj (Var_Range_Ptr),
                   M2Addr (Chap3.Bounds_To_Range (V_Bounds, Arr_Type, 1)));
                Chap3.Create_Range_From_Length
-                 (Index_Type, Var_Length, Var_Range_Ptr);
+                 (Index_Type, Var_Length, Var_Range_Ptr, Subprg);
                Finish_Declare_Stmt;
             end;
          end if;
@@ -20481,7 +20482,7 @@ package body Translation is
                     (Param,
                      Do_Conversion (In_Conv, Act, Params (Pos)),
                      In_Expr,
-                     Formal_Type);
+                     Formal_Type, El);
                end if;
             elsif Ftype_Info.Type_Mode not in Type_Mode_By_Value then
                --  Passed by reference.
@@ -20546,7 +20547,7 @@ package body Translation is
                   Param := Chap6.Translate_Name (Formal);
                   Formal_Info.Interface_Node := Prev_Node;
                end;
-               Chap7.Translate_Assign (Param, Val, Act, Formal_Type);
+               Chap7.Translate_Assign (Param, Val, Act, Formal_Type, El);
             end if;
             << Continue >> null;
             El := Get_Chain (El);
@@ -20661,7 +20662,7 @@ package body Translation is
                                           Do_Conversion (Out_Conv, Formal,
                                                          Param),
                                           Out_Expr,
-                                          Get_Type (Get_Actual (El)));
+                                          Get_Type (Get_Actual (El)), El);
                elsif Base_Formal /= Formal then
                   --  By individual.
                   --  Copy back.
@@ -20678,7 +20679,7 @@ package body Translation is
                      Formal_Info.Interface_Node := Prev_Node;
                   end;
                   Chap7.Translate_Assign
-                    (Params (Pos), Val, Formal, Get_Type (Act));
+                    (Params (Pos), Val, Formal, Get_Type (Act), El);
                end if;
             end if;
             El := Get_Chain (El);
@@ -21274,7 +21275,7 @@ package body Translation is
 
          --  Set driver.
          Chap7.Translate_Assign
-           (Drv, M2E (Data.Expr), Data.Expr_Node, Targ_Type);
+           (Drv, M2E (Data.Expr), Data.Expr_Node, Targ_Type, Data.Expr_Node);
 
          --  Test if the signal is active.
          Start_If_Stmt
@@ -28327,14 +28328,6 @@ package body Translation is
         (Interfaces, Param, Get_Identifier ("code"), Ghdl_Index_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Program_Error);
 
-      --  procedure __ghdl_bound_check_failed_l0;
-      Start_Procedure_Decl
-        (Interfaces, Get_Identifier ("__ghdl_bound_check_failed_l0"),
-         O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("index"),
-                          Ghdl_Index_Type);
-      Finish_Subprogram_Decl (Interfaces, Ghdl_Bound_Check_Failed_L0);
-
       --  procedure __ghdl_bound_check_failed_l1 (filename : char_ptr_type;
       --                                          line : ghdl_i32);
       Start_Procedure_Decl