Minor rework of overflow in physical units: defer until execution.

2 files changed, 37 insertions, 79 deletions

diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 3a95517..4ad2a99 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -355,9 +355,8 @@ package body Trans.Chap3 is
 
    procedure Translate_Physical_Type (Def : Iir_Physical_Type_Definition)
    is
-      Info : Type_Info_Acc;
+      Info : constant Type_Info_Acc := Get_Info (Def);
    begin
-      Info := Get_Info (Def);
       case Get_Type_Precision (Def) is
          when Precision_32 =>
             Info.Ortho_Type (Mode_Value) := New_Signed_Type (32);
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 6497f42..06d5e6a 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -484,8 +484,7 @@ package body Trans.Chap7 is
       end case;
    exception
       when Constraint_Error =>
-         --  Can be raised by Get_Physical_Unit_Value because of the kludge
-         --  on staticness.
+         --  Can be raised by Get_Physical_Value.
          Error_Msg_Elab ("numeric literal not in range", Expr);
          return New_Signed_Literal (Res_Type, 0);
    end Translate_Numeric_Literal;
@@ -3725,6 +3724,28 @@ package body Trans.Chap7 is
      (Sig : Mnode; Sig_Type : Iir; Val : Mnode)
          renames Translate_Signal_Assign_Driving;
 
+   function Translate_Overflow_Literal (Expr : Iir) return O_Enode
+   is
+      Expr_Type : constant Iir := Get_Type (Expr);
+      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, for type checking.  But never
+      --  executed.
+      L := Create_Temp (Otype);
+      if Tinfo.Type_Mode in Type_Mode_Fat then
+         --  For fat pointers or arrays.
+         return New_Address (New_Obj (L),
+                             Tinfo.Ortho_Ptr_Type (Mode_Value));
+      else
+         return New_Obj_Value (L);
+      end if;
+   end Translate_Overflow_Literal;
+
    function Translate_Expression (Expr : Iir; Rtype : Iir := Null_Iir)
                                  return O_Enode
    is
@@ -3745,64 +3766,20 @@ package body Trans.Chap7 is
             | Iir_Kind_Floating_Point_Literal =>
             return New_Lit (Translate_Static_Expression (Expr, Rtype));
 
-         when Iir_Kind_Physical_Int_Literal =>
-            declare
-               Unit      : Iir;
-               Unit_Info : Object_Info_Acc;
-            begin
-               Unit := Get_Unit_Name (Expr);
-               Unit_Info := Get_Info (Unit);
-               if Unit_Info = null then
-                  return New_Lit
-                    (Translate_Static_Expression (Expr, Rtype));
-               else
-                  --  Time units might be not locally static.
-                  return New_Dyadic_Op
-                    (ON_Mul_Ov,
-                     New_Lit (New_Signed_Literal
-                       (Get_Ortho_Type (Expr_Type, Mode_Value),
-                            Integer_64 (Get_Value (Expr)))),
-                     New_Value (Get_Var (Unit_Info.Object_Var)));
-               end if;
-            end;
-
-         when Iir_Kind_Physical_Fp_Literal =>
-            declare
-               Unit      : Iir;
-               Unit_Info : Object_Info_Acc;
-               L, R      : O_Enode;
-            begin
-               Unit := Get_Unit_Name (Expr);
-               Unit_Info := Get_Info (Unit);
-               if Unit_Info = null then
-                  return New_Lit
-                    (Translate_Static_Expression (Expr, Rtype));
-               else
-                  --  Time units might be not locally static.
-                  L := New_Lit
-                    (New_Float_Literal
-                       (Ghdl_Real_Type, IEEE_Float_64 (Get_Fp_Value (Expr))));
-                  R := New_Convert_Ov
-                    (New_Value (Get_Var (Unit_Info.Object_Var)),
-                     Ghdl_Real_Type);
-                  return New_Convert_Ov
-                    (New_Dyadic_Op (ON_Mul_Ov, L, R),
-                     Get_Ortho_Type (Expr_Type, Mode_Value));
-               end if;
-            end;
-
-         when Iir_Kind_Unit_Declaration =>
+         when Iir_Kind_Physical_Int_Literal
+           | Iir_Kind_Physical_Fp_Literal
+           | Iir_Kind_Unit_Declaration =>
             declare
-               Unit_Info : Object_Info_Acc;
+               Otype : constant O_Tnode :=
+                 Get_Ortho_Type (Expr_Type, Mode_Value);
+               Val : Iir_Int64;
             begin
-               Unit_Info := Get_Info (Expr);
-               if Unit_Info = null then
-                  return New_Lit
-                    (Translate_Static_Expression (Expr, Rtype));
-               else
-                  --  Time units might be not locally static.
-                  return New_Value (Get_Var (Unit_Info.Object_Var));
-               end if;
+               Val := Get_Physical_Value (Expr);
+               return New_Lit (New_Signed_Literal (Otype, Integer_64 (Val)));
+            exception
+               when Constraint_Error =>
+                  Warning_Msg_Elab ("physical literal out of range", Expr);
+                  return Translate_Overflow_Literal (Expr);
             end;
 
          when Iir_Kind_String_Literal8
@@ -3886,25 +3863,7 @@ package body Trans.Chap7 is
             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, for type checking.  But never
-               --  executed.
-               L := Create_Temp (Otype);
-               if Tinfo.Type_Mode in Type_Mode_Fat then
-                  --  For fat pointers or arrays.
-                  return New_Address (New_Obj (L),
-                                      Tinfo.Ortho_Ptr_Type (Mode_Value));
-               else
-                  return New_Obj_Value (L);
-               end if;
-            end;
+            return Translate_Overflow_Literal (Expr);
 
          when Iir_Kind_Parenthesis_Expression =>
             return Translate_Expression (Get_Expression (Expr), Rtype);