ghdl 0.25 released

9 files changed, 321 insertions, 80 deletions

diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb
index b08ac82..ed12e2c 100644
--- a/translate/ghdldrv/ghdlrun.adb
+++ b/translate/ghdldrv/ghdlrun.adb
@@ -405,6 +405,8 @@ package body Ghdlrun is
            Grt.Signals.Ghdl_Signal_Simple_Assign_Error'Address);
       Def (Trans_Decls.Ghdl_Signal_Start_Assign_Error,
            Grt.Signals.Ghdl_Signal_Start_Assign_Error'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_Error,
+           Grt.Signals.Ghdl_Signal_Next_Assign_Error'Address);
 
       Def (Trans_Decls.Ghdl_Signal_Start_Assign_Null,
            Grt.Signals.Ghdl_Signal_Start_Assign_Null'Address);
diff --git a/translate/grt/config/win32.c b/translate/grt/config/win32.c
index 18e5a2d..465f929 100644
--- a/translate/grt/config/win32.c
+++ b/translate/grt/config/win32.c
@@ -130,6 +130,23 @@ __ghdl_run_through_longjump (int (*func)(void))
   return res;
 }
 
+#include <math.h>
+
+double acosh (double x)
+{
+  return log (x + sqrt (x*x - 1));
+}
+
+double asinh (double x)
+{
+  return log (x + sqrt (x*x + 1));
+}
+
+double atanh (double x)
+{
+  return log ((1 + x) / (1 - x)) / 2;
+}
+
 #ifndef WITH_GNAT_RUN_TIME
 void __gnat_raise_storage_error(void)
 {
diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb
index 65abdac..3b3f1f3 100644
--- a/translate/grt/grt-lib.adb
+++ b/translate/grt/grt-lib.adb
@@ -84,9 +84,31 @@ package body Grt.Lib is
       Do_Report ("report", Str, Severity, Loc);
    end Ghdl_Report;
 
-   procedure Ghdl_Program_Error is
+   procedure Ghdl_Program_Error (Filename : Ghdl_C_String;
+                                 Line : Ghdl_I32;
+                                 Code : Ghdl_Index_Type)
+   is
    begin
-      Error ("program error");
+      case Code is
+         when 1 =>
+            Error_C ("missing return in function");
+         when 2 =>
+            Error_C ("block already configured");
+         when 3 =>
+            Error_C ("bad configuration");
+         when others =>
+            Error_C ("unknown error code ");
+            Error_C (Integer (Code));
+      end case;
+      Error_C (" at ");
+      if Filename = null then
+         Error_C ("*unknown*");
+      else
+         Error_C (Filename);
+      end if;
+      Error_C (":");
+      Error_C (Integer(Line));
+      Error_E ("");
    end Ghdl_Program_Error;
 
    procedure Ghdl_Bound_Check_Failed_L0 (Number : Ghdl_Index_Type) is
diff --git a/translate/grt/grt-lib.ads b/translate/grt/grt-lib.ads
index bb1723a..2c25ab1 100644
--- a/translate/grt/grt-lib.ads
+++ b/translate/grt/grt-lib.ads
@@ -40,7 +40,9 @@ package Grt.Lib is
 
    --  Program error has occured:
    --  * configuration of an already configured block.
-   procedure Ghdl_Program_Error;
+   procedure Ghdl_Program_Error (Filename : Ghdl_C_String;
+                                 Line : Ghdl_I32;
+                                 Code : Ghdl_Index_Type);
 
    function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32)
      return Ghdl_I32;
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index a165144..113c992 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -271,6 +271,7 @@ package body Grt.Signals is
          Sign.S.Drivers := Realloc (Sign.S.Drivers, Size (Sign.S.Nbr_Drivers));
       end if;
       Trans := new Transaction'(Kind => Trans_Value,
+                                Line => 0,
                                 Time => 0,
                                 Next => null,
                                 Val => Sign.Value);
@@ -595,6 +596,7 @@ package body Grt.Signals is
       end if;
 
       Trans := new Transaction'(Kind => Trans_Value,
+                                Line => 0,
                                 Time => Current_Time + After,
                                 Next => null,
                                 Val => Val);
@@ -605,28 +607,64 @@ package body Grt.Signals is
       Driver.Last_Trans := Trans;
    end Ghdl_Signal_Next_Assign;
 
-   procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr)
+   procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                              File : Ghdl_C_String;
+                                              Line : Ghdl_I32)
    is
       Trans : Transaction_Acc;
    begin
       Trans := new Transaction'(Kind => Trans_Error,
+                                Line => Line,
                                 Time => 0,
-                                Next => null);
+                                Next => null,
+                                File => File);
       Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
    end Ghdl_Signal_Simple_Assign_Error;
 
    procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr;
                                              Rej : Std_Time;
-                                             After : Std_Time)
+                                             After : Std_Time;
+                                             File : Ghdl_C_String;
+                                             Line : Ghdl_I32)
    is
       Trans : Transaction_Acc;
    begin
       Trans := new Transaction'(Kind => Trans_Error,
+                                Line => Line,
                                 Time => 0,
-                                Next => null);
+                                Next => null,
+                                File => File);
       Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
    end Ghdl_Signal_Start_Assign_Error;
 
+   procedure Ghdl_Signal_Next_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                            After : Std_Time;
+                                            File : Ghdl_C_String;
+                                            Line : Ghdl_I32)
+   is
+      Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers;
+      Driver : Driver_Type renames Drv_Ptr (Find_Driver (Sign));
+
+      Trans : Transaction_Acc;
+   begin
+      if After > 0 and then Sign.Flink = null then
+         --  Put SIGN on the future list.
+         Sign.Flink := Future_List;
+         Future_List := Sign;
+      end if;
+
+      Trans := new Transaction'(Kind => Trans_Error,
+                                Line => Line,
+                                Time => Current_Time + After,
+                                Next => null,
+                                File => File);
+      if Trans.Time <= Driver.Last_Trans.Time then
+         Error ("transactions not in ascending order");
+      end if;
+      Driver.Last_Trans.Next := Trans;
+      Driver.Last_Trans := Trans;
+   end Ghdl_Signal_Next_Assign_Error;
+
    procedure Ghdl_Signal_Start_Assign_Null (Sign : Ghdl_Signal_Ptr;
                                             Rej : Std_Time;
                                             After : Std_Time)
@@ -637,6 +675,7 @@ package body Grt.Signals is
          Error ("null transaction for a non-guarded target");
       end if;
       Trans := new Transaction'(Kind => Trans_Null,
+                                Line => 0,
                                 Time => 0,
                                 Next => null);
       Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
@@ -651,6 +690,7 @@ package body Grt.Signals is
          Error ("null transaction for a non-guarded target");
       end if;
       Trans := new Transaction'(Kind => Trans_Null,
+                                Line => 0,
                                 Time => 0,
                                 Next => null);
       Time := Sign.S.Resolv.Disconnect_Time;
@@ -702,6 +742,7 @@ package body Grt.Signals is
 
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_B2, B2 => Val));
@@ -718,6 +759,7 @@ package body Grt.Signals is
    begin
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_B2, B2 => Val));
@@ -771,6 +813,7 @@ package body Grt.Signals is
 
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_E8, E8 => Val));
@@ -787,6 +830,7 @@ package body Grt.Signals is
    begin
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_E8, E8 => Val));
@@ -842,6 +886,7 @@ package body Grt.Signals is
 
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_E32, E32 => Val));
@@ -858,6 +903,7 @@ package body Grt.Signals is
    begin
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_E32, E32 => Val));
@@ -913,6 +959,7 @@ package body Grt.Signals is
 
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_I32, I32 => Val));
@@ -929,6 +976,7 @@ package body Grt.Signals is
    begin
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_I32, I32 => Val));
@@ -984,6 +1032,7 @@ package body Grt.Signals is
 
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_I64, I64 => Val));
@@ -1000,6 +1049,7 @@ package body Grt.Signals is
    begin
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_I64, I64 => Val));
@@ -1055,6 +1105,7 @@ package body Grt.Signals is
 
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_F64, F64 => Val));
@@ -1071,6 +1122,7 @@ package body Grt.Signals is
    begin
       Trans := new Transaction'
         (Kind => Trans_Value,
+         Line => 0,
          Time => 0,
          Next => null,
          Val => Value_Union'(Mode => Mode_F64, F64 => Val));
@@ -1176,6 +1228,7 @@ package body Grt.Signals is
       if Mode /= Mode_Transaction then
          Res.S.Time := Time;
          Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value,
+                                              Line => 0,
                                               Time => 0,
                                               Next => null,
                                               Val => Res.Value);
@@ -1264,6 +1317,7 @@ package body Grt.Signals is
          Future_List := Res;
       end if;
       Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value,
+                                           Line => 0,
                                            Time => 0,
                                            Next => null,
                                            Val => Res.Value);
@@ -1307,6 +1361,16 @@ package body Grt.Signals is
       return To_Ghdl_Value_Ptr (Sig.Ports (Index).Driving_Value'Address);
    end Ghdl_Signal_Read_Port;
 
+   procedure Error_Trans_Error (Trans : Transaction_Acc) is
+   begin
+      Error_C ("range check error on signal at ");
+      Error_C (Trans.File);
+      Error_C (":");
+      Error_C (Natural (Trans.Line));
+      Error_E ("");
+   end Error_Trans_Error;
+   pragma No_Return (Error_Trans_Error);
+
    function Ghdl_Signal_Read_Driver
      (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
      return Ghdl_Value_Ptr
@@ -1323,7 +1387,7 @@ package body Grt.Signals is
          when Trans_Null =>
             return null;
          when Trans_Error =>
-            Error ("range check error on signal");
+            Error_Trans_Error (Trans);
       end case;
    end Ghdl_Signal_Read_Driver;
 
@@ -2472,6 +2536,7 @@ package body Grt.Signals is
          --     R <= transport S after T;
          --  end process;
          Trans := new Transaction'(Kind => Trans_Value,
+                                   Line => 0,
                                    Time => Current_Time + Sig.S.Time,
                                    Next => null,
                                    Val => Pfx.Value);
@@ -2551,7 +2616,7 @@ package body Grt.Signals is
                      when Trans_Null =>
                         Error ("null transaction");
                      when Trans_Error =>
-                        Error ("range check error on signal");
+                        Error_Trans_Error (Trans);
                   end case;
                end if;
             when Drv_One_Resolved
@@ -2671,6 +2736,7 @@ package body Grt.Signals is
                   --  Set driver.
                   Trans := new Transaction'
                     (Kind => Trans_Value,
+                     Line => 0,
                      Time => Current_Time + Sig.S.Time,
                      Next => null,
                      Val => Value_Union'(Mode => Mode_B2, B2 => True));
@@ -2789,7 +2855,7 @@ package body Grt.Signals is
                   when Trans_Null =>
                      Error ("null transaction");
                   when Trans_Error =>
-                     Error ("range check error on signal");
+                     Error_Trans_Error (Trans);
                end case;
                Set_Effective_Value (Sig, Sig.Driving_Value);
 
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
index 69cee8c..9abea65 100644
--- a/translate/grt/grt-signals.ads
+++ b/translate/grt/grt-signals.ads
@@ -38,8 +38,9 @@ package Grt.Signals is
    type Transaction;
    type Transaction_Acc is access Transaction;
    type Transaction (Kind : Transaction_Kind) is record
-      Time : Std_Time;
+      Line : Ghdl_I32;
       Next : Transaction_Acc;
+      Time : Std_Time;
       case Kind is
          when Trans_Value =>
             Val : Value_Union;
@@ -48,7 +49,7 @@ package Grt.Signals is
          when Trans_Error =>
             --  FIXME: should have a location field, to be able to display
             --  a message.
-            null;
+            File : Ghdl_C_String;
       end case;
    end record;
 
@@ -403,10 +404,18 @@ package Grt.Signals is
    procedure Ghdl_Signal_Internal_Checks;
 
    --  Subprograms to be called by generated code.
-   procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr);
+   procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                              File : Ghdl_C_String;
+                                              Line : Ghdl_I32);
    procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr;
                                              Rej : Std_Time;
-                                             After : Std_Time);
+                                             After : Std_Time;
+                                             File : Ghdl_C_String;
+                                             Line : Ghdl_I32);
+   procedure Ghdl_Signal_Next_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                            After : Std_Time;
+                                            File : Ghdl_C_String;
+                                            Line : Ghdl_I32);
 
    procedure Ghdl_Signal_Set_Disconnect (Sign : Ghdl_Signal_Ptr;
                                          Time : Std_Time);
@@ -615,6 +624,8 @@ private
                   "__ghdl_signal_simple_assign_error");
    pragma Export (C, Ghdl_Signal_Start_Assign_Error,
                   "__ghdl_signal_start_assign_error");
+   pragma Export (C, Ghdl_Signal_Next_Assign_Error,
+                  "__ghdl_signal_next_assign_error");
 
    pragma Export (C, Ghdl_Signal_Start_Assign_Null,
                   "__ghdl_signal_start_assign_null");
diff --git a/translate/mcode/dist.sh b/translate/mcode/dist.sh
index 132ba0b..18c09e9 100755
--- a/translate/mcode/dist.sh
+++ b/translate/mcode/dist.sh
@@ -161,6 +161,16 @@ ghdlfilter.adb
 grt-modules.adb
 "
 
+drv_files="
+ghdlcomp.ads
+ghdlcomp.adb
+foreigns.ads
+foreigns.adb
+ghdlrun.adb
+ghdlrun.ads
+ghdl_mcode.adb
+"
+
 for i in $cfiles; do ln -sf $CWD/../../$i $distdir/ghdl/$i; done
 for i in $tfiles; do ln -sf $CWD/../$i $distdir/ghdl/$i; done
 
@@ -172,8 +182,7 @@ for i in $ortho_mcode_files; do
   ln -sf $CWD/../../ortho/mcode/$i $distdir/ortho/$i
 done
 
-for i in $ghdl_files ghdlcomp.ads ghdlcomp.adb \
-  ghdlrun.adb ghdlrun.ads ghdl_mcode.adb; do
+for i in $ghdl_files $drv_files; do
   ln -sf $CWD/../ghdldrv/$i $distdir/ghdldrv/$i
 done
 
diff --git a/translate/mcode/winbuild.bat b/translate/mcode/winbuild.bat
index c400863..7d5b942 100644
--- a/translate/mcode/winbuild.bat
+++ b/translate/mcode/winbuild.bat
@@ -1,3 +1,12 @@
 call windows\compile

+if errorlevel 1 goto end

 call windows\complib

+if errorlevel 1 goto end

 "f:\Program Files\NSIS\makensis" windows\ghdl.nsi

+if errorlevel 1 goto end

+exit /b 0

+

+:end

+echo "Error during compilation"

+exit /b 1

+

diff --git a/translate/translation.adb b/translate/translation.adb
index 37a1074..b1ed787 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -150,7 +150,7 @@ package body Translation is
       Wkie_This, Wkie_Size, Wkie_Res, Wkie_Dir_To, Wkie_Dir_Downto,
       Wkie_Left, Wkie_Right, Wkie_Dir, Wkie_Length, Wkie_Kind, Wkie_Dim,
       Wkie_I, Wkie_Instance, Wkie_Arch_Instance, Wkie_Name, Wkie_Sig,
-      Wkie_Obj, Wkie_Rti, Wkie_Parent
+      Wkie_Obj, Wkie_Rti, Wkie_Parent, Wkie_Filename, Wkie_Line
       );
    type Wk_Ident_Tree_Array is array (Wk_Ident_Type) of O_Ident;
    Wk_Idents : Wk_Ident_Tree_Array;
@@ -173,6 +173,8 @@ package body Translation is
    Wki_Obj : O_Ident renames Wk_Idents (Wkie_Obj);
    Wki_Rti : O_Ident renames Wk_Idents (Wkie_Rti);
    Wki_Parent : O_Ident renames Wk_Idents (Wkie_Parent);
+   Wki_Filename : O_Ident renames Wk_Idents (Wkie_Filename);
+   Wki_Line : O_Ident renames Wk_Idents (Wkie_Line);
 
    --  ALLOCATION_KIND defines the type of memory storage.
    --  ALLOC_STACK means the object is allocated on the local stack and
@@ -582,6 +584,10 @@ package body Translation is
    package Chap8 is
       procedure Translate_Statements_Chain (First : Iir);
 
+      --  Return true if there is a return statement in the chain.
+      function Translate_Statements_Chain_Has_Return (First : Iir)
+                                                     return Boolean;
+
       --  Create a case branch for CHOICE.
       --  Used by case statement and aggregates.
       procedure Translate_Case_Choice
@@ -1982,7 +1988,10 @@ package body Translation is
       procedure Gen_Bound_Error (Loc : Iir);
 
       --  Generate code to emit a program error.
-      procedure Gen_Program_Error (Loc : Iir);
+      Prg_Err_Missing_Return : constant Natural := 1;
+      Prg_Err_Block_Configured : constant Natural := 2;
+      Prg_Err_Dummy_Config : constant Natural := 3;
+      procedure Gen_Program_Error (Loc : Iir; Code : Natural);
 
       --  Generate code to emit a failure if COND is TRUE, indicating an
       --  index violation for dimension DIM of an array.  LOC is usually
@@ -2371,6 +2380,9 @@ package body Translation is
       N2hex : constant Hexstr_Type := "0123456789abcdef";
 
       function Get_Line_Number (Target: Iir) return Natural;
+
+      procedure Assoc_Filename_Line (Assoc : in out O_Assoc_List;
+                                     Line : Natural);
    private
    end Helpers;
    use Helpers;
@@ -3763,6 +3775,16 @@ package body Translation is
            (Get_Location (Target), Name, Line, Col);
          return Line;
       end Get_Line_Number;
+
+      procedure Assoc_Filename_Line (Assoc : in out O_Assoc_List;
+                                     Line : Natural) is
+      begin
+         New_Association (Assoc,
+                          New_Lit (New_Global_Address (Current_Filename_Node,
+                                                       Char_Ptr_Type)));
+         New_Association (Assoc, New_Lit (New_Signed_Literal
+                                          (Ghdl_I32_Type, Integer_64 (Line))));
+      end Assoc_Filename_Line;
    end Helpers;
 
    package body Chap1 is
@@ -4282,7 +4304,8 @@ package body Translation is
             if Fails then
                New_Else_Stmt (If_Blk);
                --  Already configured.
-               Chap6.Gen_Program_Error (Block_Config);
+               Chap6.Gen_Program_Error
+                 (Block_Config, Chap6.Prg_Err_Block_Configured);
             end if;
 
             Finish_If_Stmt (If_Blk);
@@ -4844,6 +4867,8 @@ package body Translation is
          --  and retained.
          Is_Prot : Boolean := False;
 
+         Has_Return : Boolean;
+
          Subprg_Instances : Chap2.Subprg_Instance_Stack;
       begin
          Spec := Get_Subprogram_Specification (Subprg);
@@ -4923,7 +4948,7 @@ package body Translation is
 
          Old_Subprogram := Current_Subprogram;
          Current_Subprogram := Spec;
-         Chap8.Translate_Statements_Chain
+         Has_Return := Chap8.Translate_Statements_Chain_Has_Return
            (Get_Sequential_Statement_Chain (Subprg));
          Current_Subprogram := Old_Subprogram;
 
@@ -4931,6 +4956,12 @@ package body Translation is
             --  FIXME: create a barrier to catch missing return statement.
             if Get_Kind (Spec) = Iir_Kind_Procedure_Declaration then
                New_Exit_Stmt (Info.Subprg_Exit);
+            else
+               if not Has_Return then
+                  --  Missing return
+                  Chap6.Gen_Program_Error
+                    (Subprg, Chap6.Prg_Err_Missing_Return);
+               end if;
             end if;
             Finish_Loop_Stmt (Info.Subprg_Exit);
             Chap4.Final_Declaration_Chain (Subprg, False);
@@ -4943,6 +4974,14 @@ package body Translation is
             if Is_Ortho_Func then
                New_Return_Stmt (New_Obj_Value (Info.Subprg_Result));
             end if;
+         else
+            if Get_Kind (Spec) = Iir_Kind_Function_Declaration
+              and then not Has_Return
+            then
+               --  Missing return
+               Chap6.Gen_Program_Error
+                 (Subprg, Chap6.Prg_Err_Missing_Return);
+            end if;
          end if;
 
          Chap2.Restore_Subprg_Instance (Subprg_Instances);
@@ -12141,12 +12180,7 @@ package body Translation is
               (Get_Location (Loc), Name, Line, Col);
 
             Start_Association (Constr, Ghdl_Bound_Check_Failed_L1);
-            New_Association
-              (Constr, New_Lit (New_Global_Address (Current_Filename_Node,
-                                                    Char_Ptr_Type)));
-            New_Association
-              (Constr, New_Lit (New_Signed_Literal (Ghdl_I32_Type,
-                                                    Integer_64 (Line))));
+            Assoc_Filename_Line (Constr, Line);
             New_Procedure_Call (Constr);
          else
             Start_Association (Constr, Ghdl_Bound_Check_Failed_L0);
@@ -12158,13 +12192,23 @@ package body Translation is
          end if;
       end Gen_Bound_Error;
 
-      procedure Gen_Program_Error (Loc : Iir)
+      procedure Gen_Program_Error (Loc : Iir; Code : Natural)
       is
-         pragma Unreferenced (Loc);
-         Constr : O_Assoc_List;
+         Assoc : O_Assoc_List;
       begin
-         Start_Association (Constr, Ghdl_Program_Error);
-         New_Procedure_Call (Constr);
+         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
@@ -19586,6 +19630,7 @@ package body Translation is
       end Translate_Wait_Statement;
 
       --  Signal assignment.
+      Signal_Assign_Line : Natural;
       procedure Gen_Simple_Signal_Assign_Non_Composite (Targ : Mnode;
                                                         Targ_Type : Iir;
                                                         Val : O_Enode)
@@ -19637,6 +19682,7 @@ package body Translation is
                Start_If_Stmt (If_Blk, Chap3.Not_In_Range (Val2, Targ_Type));
                Start_Association (Assoc, Ghdl_Signal_Simple_Assign_Error);
                New_Association (Assoc, New_Obj_Value (Targ2));
+               Assoc_Filename_Line (Assoc, Signal_Assign_Line);
                New_Procedure_Call (Assoc);
                New_Else_Stmt (If_Blk);
                Start_Association (Assoc, Subprg);
@@ -19765,6 +19811,7 @@ package body Translation is
                New_Association (Assoc, New_Obj_Value (Starg));
                New_Association (Assoc, New_Obj_Value (Data.Reject));
                New_Association (Assoc, New_Obj_Value (Data.After));
+               Assoc_Filename_Line (Assoc, Signal_Assign_Line);
                New_Procedure_Call (Assoc);
                New_Else_Stmt (If_Blk);
                Start_Association (Assoc, Subprg);
@@ -19916,13 +19963,45 @@ package body Translation is
             when others =>
                Error_Kind ("gen_signal_next_assign_non_composite", Targ_Type);
          end case;
-         -- FIXME: check in range.
-         Start_Association (Assoc, Subprg);
-         New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
-                                                 Ghdl_Signal_Ptr));
-         New_Association (Assoc, New_Convert_Ov (M2E (Data.Expr), Conv));
-         New_Association (Assoc, New_Obj_Value (Data.After));
-         New_Procedure_Call (Assoc);
+         if Chap3.Need_Range_Check (Null_Iir, Targ_Type) then
+            declare
+               If_Blk : O_If_Block;
+               V : Mnode;
+               Starg : O_Dnode;
+            begin
+               Open_Temp;
+               V := Stabilize_Value (Data.Expr);
+               Starg := Create_Temp_Init
+                 (Ghdl_Signal_Ptr,
+                  New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
+               Start_If_Stmt
+                 (If_Blk, Chap3.Not_In_Range (M2Dv (V), Targ_Type));
+
+               Start_Association (Assoc, Ghdl_Signal_Next_Assign_Error);
+               New_Association (Assoc, New_Obj_Value (Starg));
+               New_Association (Assoc, New_Obj_Value (Data.After));
+               Assoc_Filename_Line (Assoc, Signal_Assign_Line);
+               New_Procedure_Call (Assoc);
+
+               New_Else_Stmt (If_Blk);
+
+               Start_Association (Assoc, Subprg);
+               New_Association (Assoc, New_Obj_Value (Starg));
+               New_Association (Assoc, New_Convert_Ov (M2E (V), Conv));
+               New_Association (Assoc, New_Obj_Value (Data.After));
+               New_Procedure_Call (Assoc);
+
+               Finish_If_Stmt (If_Blk);
+               Close_Temp;
+            end;
+         else
+            Start_Association (Assoc, Subprg);
+            New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
+                                                    Ghdl_Signal_Ptr));
+            New_Association (Assoc, New_Convert_Ov (M2E (Data.Expr), Conv));
+            New_Association (Assoc, New_Obj_Value (Data.After));
+            New_Procedure_Call (Assoc);
+         end if;
       end Gen_Next_Signal_Assign_Non_Composite;
 
       procedure Gen_Next_Signal_Assign is new Foreach_Non_Composite
@@ -20074,6 +20153,7 @@ package body Translation is
          --  Handle a simple and common case: only one waveform, inertial,
          --  and no time (eg: sig <= expr).
          Value := Get_We_Value (We);
+         Signal_Assign_Line := Get_Line_Number (Value);
          if Get_Chain (We) = Null_Iir
            and then Get_Time (We) = Null_Iir
            and then Get_Delay_Mechanism (Stmt) = Iir_Inertial_Delay
@@ -20161,6 +20241,7 @@ package body Translation is
                      Chap7.Translate_Expression (Get_Time (We),
                                                  Time_Type_Definition));
                   Value := Get_We_Value (We);
+                  Signal_Assign_Line := Get_Line_Number (Value);
                   if Get_Kind (Value) = Iir_Kind_Null_Literal then
                      Val := Mnode_Null;
                   else
@@ -20255,6 +20336,23 @@ package body Translation is
             Stmt := Get_Chain (Stmt);
          end loop;
       end Translate_Statements_Chain;
+
+      function Translate_Statements_Chain_Has_Return (First : Iir)
+                                                     return Boolean
+      is
+         Stmt : Iir;
+         Has_Return : Boolean := False;
+      begin
+         Stmt := First;
+         while Stmt /= Null_Iir loop
+            Translate_Statement (Stmt);
+            if Get_Kind (Stmt) = Iir_Kind_Return_Statement then
+               Has_Return := True;
+            end if;
+            Stmt := Get_Chain (Stmt);
+         end loop;
+         return Has_Return;
+      end Translate_Statements_Chain_Has_Return;
    end Chap8;
 
    package body Chap9 is
@@ -26161,6 +26259,8 @@ package body Translation is
       Wki_Obj := Get_Identifier ("OBJ");
       Wki_Rti := Get_Identifier ("RTI");
       Wki_Parent := Get_Identifier ("parent");
+      Wki_Filename := Get_Identifier ("filename");
+      Wki_Line := Get_Identifier ("line");
 
       Sizetype := New_Unsigned_Type (32);
       New_Type_Decl (Get_Identifier ("__ghdl_size_type"), Sizetype);
@@ -26277,20 +26377,18 @@ package body Translation is
 
       --  Create:
       --  type __ghdl_location is record
-      --     file : __ghdl_str_len_ptr;
-      --     line : integer;
-      --     col : Integer;
+      --     file : char_ptr_type;
+      --     line : ghdl_i32;
+      --     col : ghdl_i32;
       --  end record;
       declare
          Constr : O_Element_List;
       begin
          Start_Record_Type (Constr);
-         New_Record_Field (Constr, Ghdl_Location_Filename_Node,
-                           Get_Identifier ("filename"),
-                           Char_Ptr_Type);
-         New_Record_Field (Constr, Ghdl_Location_Line_Node,
-                           Get_Identifier ("line"),
-                           Ghdl_I32_Type);
+         New_Record_Field
+           (Constr, Ghdl_Location_Filename_Node, Wki_Filename, Char_Ptr_Type);
+         New_Record_Field
+           (Constr, Ghdl_Location_Line_Node, Wki_Line, Ghdl_I32_Type);
          New_Record_Field (Constr, Ghdl_Location_Col_Node,
                            Get_Identifier ("col"),
                            Ghdl_I32_Type);
@@ -26321,13 +26419,18 @@ package body Translation is
       New_Interface_Decl (Interfaces, Param, Wki_Size, Sizetype);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Alloc_Ptr);
 
-      --  procedure __ghdl_program_error -- (loc : __ghdl_location_acc);
+      --  procedure __ghdl_program_error (filename : char_ptr_type;
+      --                                  line : ghdl_i32;
+      --                                  code : ghdl_index_type);
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_program_error"),
          O_Storage_External);
-      --New_Interface_Decl (Interfaces, Param,
-      --                    Get_Identifier ("location"),
-      --                    Ghdl_Location_Ptr_Node);
+      New_Interface_Decl
+        (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl
+        (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
+      New_Interface_Decl
+        (Interfaces, Param, Get_Identifier ("code"), Ghdl_Index_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Program_Error);
 
       --  procedure __ghdl_bound_check_failed_l0;
@@ -26343,10 +26446,8 @@ package body Translation is
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_bound_check_failed_l1"),
          O_Storage_External);
-      New_Interface_Decl
-        (Interfaces, Param, Get_Identifier ("filename"), Char_Ptr_Type);
-      New_Interface_Decl
-        (Interfaces, Param, Get_Identifier ("line"), Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Bound_Check_Failed_L1);
 
       --  Secondary stack subprograms.
@@ -26546,8 +26647,7 @@ package body Translation is
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_init_" & Suffix),
          O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type);
       Finish_Subprogram_Decl (Interfaces, Init_Signal);
 
@@ -26556,8 +26656,7 @@ package body Translation is
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_simple_assign_" & Suffix),
          O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type);
       Finish_Subprogram_Decl (Interfaces, Simple_Assign);
 
@@ -26568,8 +26667,7 @@ package body Translation is
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_" & Suffix),
          O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
                           Std_Time_Type);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
@@ -26584,8 +26682,7 @@ package body Translation is
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_" & Suffix),
          O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
                           Val_Type);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
@@ -26597,8 +26694,7 @@ package body Translation is
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_associate_" & Suffix),
          O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
                           Val_Type);
       Finish_Subprogram_Decl (Interfaces, Associate_Value);
@@ -26608,8 +26704,7 @@ package body Translation is
       Start_Function_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_driving_value_" & Suffix),
          O_Storage_External, Val_Type);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       Finish_Subprogram_Decl (Interfaces, Driving_Value);
    end Create_Signal_Subprograms;
 
@@ -27063,46 +27158,55 @@ package body Translation is
       Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Driving);
 
       --  procedure __ghdl_signal_simple_assign_error
-      --              (sig : __ghdl_signal_ptr);
+      --              (sig : __ghdl_signal_ptr;
+      --               filename : char_ptr_type;
+      --               line : ghdl_i32);
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_simple_assign_error"),
          O_Storage_External);
       New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Simple_Assign_Error);
 
       --  procedure __ghdl_signal_start_assign_error (sign : __ghdl_signal_ptr;
       --                                              reject : std_time;
-      --                                              after : std_time);
+      --                                              after : std_time;
+      --                                              filename : char_ptr_type;
+      --                                              line : ghdl_i32);
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_error"),
          O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
                           Std_Time_Type);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
                           Std_Time_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Start_Assign_Error);
 
       --  procedure __ghdl_signal_next_assign_error (sig : __ghdl_signal_ptr;
-      --                                             after : std_time);
+      --                                             after : std_time;
+      --                                             filename : char_ptr_type;
+      --                                             line : ghdl_i32);
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_error"),
          O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
                           Std_Time_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Error);
 
-      --  procedure __ghdl_signal_start_assign_null (sign : __ghdl_signal_ptr;
+      --  procedure __ghdl_signal_start_assign_null (sig : __ghdl_signal_ptr;
       --                                             reject : std_time;
       --                                             after : std_time);
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_null"),
          O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
                           Std_Time_Type);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
@@ -27114,8 +27218,7 @@ package body Translation is
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_null"),
          O_Storage_External);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("signal"),
-                          Ghdl_Signal_Ptr);
+      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
                           Std_Time_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Null);
@@ -27839,7 +27942,7 @@ package body Translation is
          Finish_Subprogram_Decl (Inter_List, Subprg);
 
          Start_Subprogram_Body (Subprg);
-         Chap6.Gen_Program_Error (Arch);
+         Chap6.Gen_Program_Error (Arch, Chap6.Prg_Err_Dummy_Config);
          Finish_Subprogram_Body;
 
          Pop_Identifier_Prefix (Arch_Mark);