diff options
| -rw-r--r-- | src/grt/grt-values.adb | 25 | ||||
| -rw-r--r-- | src/grt/grt-values.ads | 3 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_expr.adb | 73 |
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; |