translate, grt: add lib function for div and rem.

Do not rely on hardware exceptions to catch division by 0, they are caught
in windows by the c handler and not propagated

6 files changed, 148 insertions, 8 deletions

diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index bfa095307..3f96bf456 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -386,6 +386,14 @@ package body Ghdlrun is
            Grt.Lib.Ghdl_I32_Exp'Address);
       Def (Trans_Decls.Ghdl_I64_Exp,
            Grt.Lib.Ghdl_I64_Exp'Address);
+      Def (Trans_Decls.Ghdl_I32_Div,
+           Grt.Lib.Ghdl_I32_Div'Address);
+      Def (Trans_Decls.Ghdl_I64_Div,
+           Grt.Lib.Ghdl_I64_Div'Address);
+      Def (Trans_Decls.Ghdl_I32_Mod,
+           Grt.Lib.Ghdl_I32_Mod'Address);
+      Def (Trans_Decls.Ghdl_I64_Mod,
+           Grt.Lib.Ghdl_I64_Mod'Address);
       Def (Trans_Decls.Ghdl_Check_Stack_Allocation,
            Grt.Lib.Ghdl_Check_Stack_Allocation'Address);
 
diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb
index f69da860f..ec64f810f 100644
--- a/src/grt/grt-lib.adb
+++ b/src/grt/grt-lib.adb
@@ -271,6 +271,50 @@ package body Grt.Lib is
       return Res;
    end Ghdl_I64_Exp;
 
+   function Ghdl_I32_Div (L, R : Ghdl_I32) return Ghdl_I32
+   is
+      pragma Suppress (Overflow_Check);
+   begin
+      if R = 0 then
+         Error ("division by 0");
+      elsif R = -1 and L = Ghdl_I32'First then
+         Error ("overflow in division");
+      end if;
+      return L / R;
+   end Ghdl_I32_Div;
+
+   function Ghdl_I64_Div (L, R : Ghdl_I64) return Ghdl_I64
+   is
+      pragma Suppress (Overflow_Check);
+   begin
+      if R = 0 then
+         Error ("division by 0");
+      elsif R = -1 and L = Ghdl_I64'First then
+         Error ("overflow in division");
+      end if;
+      return L / R;
+   end Ghdl_I64_Div;
+
+   function Ghdl_I32_Mod (L, R : Ghdl_I32) return Ghdl_I32
+   is
+      pragma Suppress (Overflow_Check);
+   begin
+      if R = 0 then
+         Error ("division by 0");
+      end if;
+      return L mod R;
+   end Ghdl_I32_Mod;
+
+   function Ghdl_I64_Mod (L, R : Ghdl_I64) return Ghdl_I64
+   is
+      pragma Suppress (Overflow_Check);
+   begin
+      if R = 0 then
+         Error ("division by 0");
+      end if;
+      return L mod R;
+   end Ghdl_I64_Mod;
+
    procedure Ghdl_Check_Stack_Allocation (Size : Ghdl_Index_Type)
    is
       Bt : Backtrace_Addrs;
diff --git a/src/grt/grt-lib.ads b/src/grt/grt-lib.ads
index f8e7f0a7a..0210057fa 100644
--- a/src/grt/grt-lib.ads
+++ b/src/grt/grt-lib.ads
@@ -69,6 +69,12 @@ package Grt.Lib is
    function Ghdl_I32_Exp (V : Ghdl_I32; E : Std_Integer) return Ghdl_I32;
    function Ghdl_I64_Exp (V : Ghdl_I64; E : Std_Integer) return Ghdl_I64;
 
+   function Ghdl_I32_Div (L, R : Ghdl_I32) return Ghdl_I32;
+   function Ghdl_I64_Div (L, R : Ghdl_I64) return Ghdl_I64;
+
+   function Ghdl_I32_Mod (L, R : Ghdl_I32) return Ghdl_I32;
+   function Ghdl_I64_Mod (L, R : Ghdl_I64) return Ghdl_I64;
+
    --  Called before allocation of large (complex) objects.
    procedure Ghdl_Check_Stack_Allocation (Size : Ghdl_Index_Type);
 
@@ -141,6 +147,12 @@ private
    pragma Export (C, Ghdl_I64_Exp, "__ghdl_i64_exp");
    pragma Export (C, Ghdl_Real_Exp, "__ghdl_real_exp");
 
+   pragma Export (C, Ghdl_I32_Div, "__ghdl_i32_div");
+   pragma Export (C, Ghdl_I64_Div, "__ghdl_i64_div");
+
+   pragma Export (C, Ghdl_I32_Mod, "__ghdl_i32_mod");
+   pragma Export (C, Ghdl_I64_Mod, "__ghdl_i64_mod");
+
    pragma Export (C, Ghdl_Std_Ulogic_To_Boolean_Array,
                   "__ghdl_std_ulogic_to_boolean_array");
 
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 0ecd59f34..b9be2c390 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -1130,8 +1130,8 @@ package body Trans.Chap7 is
       Iir_Predefined_Integer_Minus => ON_Sub_Ov,
       Iir_Predefined_Integer_Mul => ON_Mul_Ov,
       Iir_Predefined_Integer_Rem => ON_Rem_Ov,
-      Iir_Predefined_Integer_Mod => ON_Mod_Ov,
-      Iir_Predefined_Integer_Div => ON_Div_Ov,
+      Iir_Predefined_Integer_Mod => ON_Nil,
+      Iir_Predefined_Integer_Div => ON_Nil,
       Iir_Predefined_Integer_Absolute => ON_Abs_Ov,
       Iir_Predefined_Integer_Negation => ON_Neg_Ov,
 
@@ -2334,6 +2334,31 @@ package body Trans.Chap7 is
       return New_Convert_Ov (New_Obj_Value (Res), Res_Otype);
    end Translate_Predefined_Std_Ulogic_Array_Match;
 
+   --  Div/mod/rem intrinsic (to handle 0 and overflow).
+   function Translate_Predefined_Div (Expr : Iir_Function_Declaration;
+                                      Div32 : O_Dnode;
+                                      Div64 : O_Dnode;
+                                      Left_Tree, Right_Tree : O_Enode;
+                                      Res_Otype : O_Tnode) return O_Enode
+   is
+      Expr_Tinfo : constant Type_Info_Acc := Get_Info (Get_Type (Expr));
+      Opr : O_Dnode;
+      Etype : O_Tnode;
+      Res : O_Enode;
+   begin
+      case Type_Mode_Integers (Expr_Tinfo.Type_Mode) is
+         when Type_Mode_I32 =>
+            Opr := Div32;
+            Etype := Ghdl_I32_Type;
+         when Type_Mode_I64 =>
+            Opr := Div64;
+            Etype := Ghdl_I64_Type;
+      end case;
+      Res := Translate_Lib_Operator (New_Convert_Ov (Left_Tree, Etype),
+                                     New_Convert_Ov (Right_Tree, Etype), Opr);
+      return New_Convert_Ov (Res, Res_Otype);
+   end Translate_Predefined_Div;
+
    function Translate_Predefined_Operator
      (Expr : Iir_Function_Declaration; Left, Right : Iir; Res_Type : Iir)
      return O_Enode
@@ -2594,6 +2619,28 @@ package body Trans.Chap7 is
                end if;
             end if;
 
+         when Iir_Predefined_Integer_Div =>
+            if Get_Kind (Right) /= Iir_Kind_Integer_Literal
+              or else Get_Value (Right) in -1 .. 0
+            then
+               return Translate_Predefined_Div
+                 (Expr, Ghdl_I32_Div, Ghdl_I64_Div,
+                  Left_Tree, Right_Tree, Res_Otype);
+            else
+               return New_Dyadic_Op (ON_Div_Ov, Left_Tree, Right_Tree);
+            end if;
+
+         when Iir_Predefined_Integer_Mod =>
+            if Get_Kind (Right) /= Iir_Kind_Integer_Literal
+              or else Get_Value (Right) = 0
+            then
+               return Translate_Predefined_Div
+                 (Expr, Ghdl_I32_Mod, Ghdl_I64_Mod,
+                  Left_Tree, Right_Tree, Res_Otype);
+            else
+               return New_Dyadic_Op (ON_Mod_Ov, Left_Tree, Right_Tree);
+            end if;
+
          when Iir_Predefined_Physical_Integer_Div =>
             return New_Dyadic_Op (ON_Div_Ov, Left_Tree,
                                   New_Convert_Ov (Right_Tree, Res_Otype));
@@ -6348,8 +6395,6 @@ package body Trans.Chap7 is
             | Iir_Predefined_Integer_Plus
             | Iir_Predefined_Integer_Minus
             | Iir_Predefined_Integer_Mul
-            | Iir_Predefined_Integer_Div
-            | Iir_Predefined_Integer_Mod
             | Iir_Predefined_Integer_Rem
             | Iir_Predefined_Floating_Equality
             | Iir_Predefined_Floating_Inequality
@@ -6378,6 +6423,11 @@ package body Trans.Chap7 is
             pragma Assert (Predefined_To_Onop (Kind) /= ON_Nil);
             return;
 
+         when Iir_Predefined_Integer_Div
+            | Iir_Predefined_Integer_Mod =>
+            --  Intrinsic
+            return;
+
          when Iir_Predefined_Boolean_Nand
             | Iir_Predefined_Boolean_Nor
             | Iir_Predefined_Boolean_Xnor
diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads
index 1aac95cff..5587a3339 100644
--- a/src/vhdl/translate/trans_decls.ads
+++ b/src/vhdl/translate/trans_decls.ads
@@ -182,6 +182,10 @@ package Trans_Decls is
    Ghdl_Real_Exp : O_Dnode;
    Ghdl_I32_Exp : O_Dnode;
    Ghdl_I64_Exp : O_Dnode;
+   Ghdl_I32_Div : O_Dnode;
+   Ghdl_I64_Div : O_Dnode;
+   Ghdl_I32_Mod : O_Dnode;
+   Ghdl_I64_Mod : O_Dnode;
 
    --  Procedure called in case of check failed.
    Ghdl_Program_Error : O_Dnode;
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index 5325e6276..cbca05a6a 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -1200,10 +1200,8 @@ package body Translation is
       Start_Function_Decl
         (Interfaces, Get_Identifier ("__ghdl_real_exp"), O_Storage_External,
          Std_Real_Otype);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("left"),
-                          Std_Real_Otype);
-      New_Interface_Decl (Interfaces, Param, Get_Identifier ("right"),
-                          Std_Integer_Otype);
+      New_Interface_Decl (Interfaces, Param, Wki_Left, Std_Real_Otype);
+      New_Interface_Decl (Interfaces, Param, Wki_Right, Std_Integer_Otype);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Real_Exp);
 
       --  function __ghdl_i32_exp (left : ghdl_i32;
@@ -1226,6 +1224,30 @@ package body Translation is
       New_Interface_Decl (Interfaces, Param, Wki_Right, Std_Integer_Otype);
       Finish_Subprogram_Decl (Interfaces, Ghdl_I64_Exp);
 
+      declare
+         procedure Create_Div_Subprogram
+           (Name : String; T : O_Tnode; Decl : out O_Dnode) is
+         begin
+            Start_Function_Decl
+              (Interfaces, Get_Identifier (Name), O_Storage_External, T);
+            New_Interface_Decl (Interfaces, Param, Wki_Left, T);
+            New_Interface_Decl (Interfaces, Param, Wki_Right, T);
+            Finish_Subprogram_Decl (Interfaces, Decl);
+         end Create_Div_Subprogram;
+      begin
+         --  function __ghdl_i32_div (left, right : ghdl_i32) return ghdl_i32;
+         Create_Div_Subprogram ("__ghdl_i32_div", Ghdl_I32_Type, Ghdl_I32_Div);
+
+         --  function __ghdl_i64_div (left, right : ghdl_i64) return ghdl_i64;
+         Create_Div_Subprogram ("__ghdl_i64_div", Ghdl_I64_Type, Ghdl_I64_Div);
+
+         --  function __ghdl_i32_mod (left, right : ghdl_i32) return ghdl_i32;
+         Create_Div_Subprogram ("__ghdl_i32_mod", Ghdl_I32_Type, Ghdl_I32_Mod);
+
+         --  function __ghdl_i64_mod (left, right : ghdl_i64) return ghdl_i64;
+         Create_Div_Subprogram ("__ghdl_i64_mod", Ghdl_I64_Type, Ghdl_I64_Mod);
+      end;
+
       --  procedure __ghdl_image_b1 (res : std_string_ptr_node;
       --                             val : ghdl_bool_type;
       --                             rti : ghdl_rti_access);