synth: handle value attribute for physical types

3 files changed, 89 insertions, 12 deletions

diff --git a/src/grt/grt-values.adb b/src/grt/grt-values.adb
index 7a2f09ed5..b2e98f6a0 100644
--- a/src/grt/grt-values.adb
+++ b/src/grt/grt-values.adb
@@ -234,38 +234,40 @@ package body Grt.Values is
       return Value_F64 (S, Len, Pos);
    end Ghdl_Value_F64;
 
-   procedure Ghdl_Value_Physical_Split (Str : Std_String_Ptr;
+   procedure Ghdl_Value_Physical_Split (Str : Std_String_Basep;
+                                        Len : Ghdl_Index_Type;
                                         Is_Real : out Boolean;
                                         Lit_Pos : out Ghdl_Index_Type;
                                         Lit_End : out Ghdl_Index_Type;
                                         Unit_Pos : out Ghdl_Index_Type)
    is
-      S        : constant Std_String_Basep := Str.Base;
-      Len      : Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
+      L : Ghdl_Index_Type;
    begin
       --  LRM 14.1
       --  Leading and trailing whitespace is allowed and ignored.
       Lit_Pos := 0;
-      Remove_Whitespaces (S, Len, Lit_Pos);
+      L := Len;
+      Remove_Whitespaces (Str, L, Lit_Pos);
+      pragma Unreferenced (Len);
 
       --  Split between abstract literal (optionnal) and unit name.
       Lit_End := Lit_Pos;
       Is_Real := False;
-      while Lit_End < Len loop
-         exit when Is_Whitespace (S (Lit_End));
-         if S (Lit_End) = '.' then
+      while Lit_End < L loop
+         exit when Is_Whitespace (Str (Lit_End));
+         if Str (Lit_End) = '.' then
             Is_Real := True;
          end if;
          Lit_End := Lit_End + 1;
       end loop;
-      if Lit_End = Len then
+      if Lit_End = L then
          --  No literal
          Unit_Pos := Lit_Pos;
          Lit_End := 0;
       else
          Unit_Pos := Lit_End + 1;
-         while Unit_Pos < Len loop
-            exit when not Is_Whitespace (S (Unit_Pos));
+         while Unit_Pos < L loop
+            exit when not Is_Whitespace (Str (Unit_Pos));
             Unit_Pos := Unit_Pos + 1;
          end loop;
       end if;
@@ -294,7 +296,8 @@ package body Grt.Values is
       Remove_Whitespaces (S, Len, Lit_Pos);
 
       --  Extract literal and unit
-      Ghdl_Value_Physical_Split (Str, Found_Real, Lit_Pos, Lit_End, Unit_Pos);
+      Ghdl_Value_Physical_Split
+        (S, Len, Found_Real, Lit_Pos, Lit_End, Unit_Pos);
 
       --  Find unit value
       Multiple := null;
diff --git a/src/grt/grt-values.ads b/src/grt/grt-values.ads
index 369c69cfd..8a81d1fbd 100644
--- a/src/grt/grt-values.ads
+++ b/src/grt/grt-values.ads
@@ -31,7 +31,8 @@ package Grt.Values is
    --  Set LIT_POS to the position of the first character of the numeric
    --  literal (after whitespaces are skipped).
    --  Set LIT_END to the position of the next character of the numeric lit.
-   procedure Ghdl_Value_Physical_Split (Str : Std_String_Ptr;
+   procedure Ghdl_Value_Physical_Split (Str : Std_String_Basep;
+                                        Len : Ghdl_Index_Type;
                                         Is_Real : out Boolean;
                                         Lit_Pos : out Ghdl_Index_Type;
                                         Lit_End : out Ghdl_Index_Type;
diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb
index 1119f6ae9..c32601ef1 100644
--- a/src/synth/elab-vhdl_expr.adb
+++ b/src/synth/elab-vhdl_expr.adb
@@ -38,7 +38,9 @@ with Synth.Errors; use Synth.Errors;
 
 with Grt.Types;
 with Grt.Vhdl_Types;
+with Grt.Strings;
 with Grt.To_Strings;
+with Grt.Values;
 with Grt.Vstrings;
 
 package body Elab.Vhdl_Expr is
@@ -99,6 +101,24 @@ package body Elab.Vhdl_Expr is
       return Synth_Subtype_Conversion (null, Vt, Dtype, Bounds, Loc);
    end Exec_Subtype_Conversion;
 
+   --  Return True iff ID = S, case insensitive.
+   function Match_Id (Id : Name_Id; S : String) return Boolean is
+   begin
+      if Name_Table.Get_Name_Length (Id) /= S'Length then
+         return False;
+      end if;
+      declare
+         Img : constant String (S'Range) := Name_Table.Image (Id);
+      begin
+         for I in Img'Range loop
+            if Grt.Strings.To_Lower (S (I)) /= Img (I) then
+               return False;
+            end if;
+         end loop;
+         return True;
+      end;
+   end Match_Id;
+
    function Exec_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node)
                                  return Valtyp
    is
@@ -163,6 +183,59 @@ package body Elab.Vhdl_Expr is
                      return No_Valtyp;
                   end if;
                end;
+            when Iir_Kind_Physical_Type_Definition =>
+               declare
+                  use Grt.Types;
+                  use Grt.Vhdl_Types;
+                  Value1 : String renames Value (First .. Last);
+                  F : constant Ghdl_Index_Type := Ghdl_Index_Type (First);
+                  S : constant Std_String_Basep :=
+                    To_Std_String_Basep (Value1'Address);
+                  Len : constant Ghdl_Index_Type :=
+                    Ghdl_Index_Type (Last - First + 1);
+                  Is_Real : Boolean;
+                  Lit_Pos : Ghdl_Index_Type;
+                  Lit_End : Ghdl_Index_Type;
+                  Unit_Pos : Ghdl_Index_Type;
+                  Unit_F, Unit_L : Positive;
+                  Mult : Int64;
+                  Unit : Iir;
+                  Unit_Id : Name_Id;
+                  Val_F : Grt.To_Strings.Value_F64_Result;
+               begin
+                  Grt.Values.Ghdl_Value_Physical_Split
+                    (S, Len, Is_Real, Lit_Pos, Lit_End, Unit_Pos);
+                  Unit_F := Positive (Unit_Pos + 1);
+
+                  --  Find unit.
+                  Unit_L := Unit_F;
+                  for I in Unit_F .. Last loop
+                     exit when Grt.Strings.Is_Whitespace (Value1 (I));
+                     Unit_L := I;
+                  end loop;
+
+                  Unit := Get_Primary_Unit (Btype);
+                  while Unit /= Null_Iir loop
+                     Unit_Id := Get_Identifier (Unit);
+                     exit when Match_Id (Unit_Id, Value1 (Unit_F .. Unit_L));
+                     Unit := Get_Chain (Unit);
+                  end loop;
+
+                  if Unit = Null_Iir then
+                     Error_Msg_Synth (Syn_Inst, Attr, "incorrect unit name");
+                     return No_Valtyp;
+                  end if;
+                  Mult := Get_Value (Get_Physical_Literal (Unit));
+
+                  if Is_Real then
+                     Val_F := Grt.To_Strings.Value_F64 (S, Lit_End, F);
+                     Val := Int64 (Val_F.Val * Ghdl_F64 (Mult));
+                  else
+                     Val := Int64 (Grt.Values.Value_I64 (S, Lit_End, F))
+                       * Mult;
+                  end if;
+               end;
+
             when others =>
                Error_Msg_Elab (+Attr, "unhandled type for 'value");
                return No_Valtyp;