ghdl 0.25 released

5 files changed, 132 insertions, 14 deletions

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");